Theory Algebra2

(**                Algebra2  
                                  author Hidetsune Kobayashi
                                  Department of Mathematics
                                  Nihon University
                                  hikoba@math.cst.nihon-u.ac.jp
                                  May 3, 2004.
                                  April 6, 2007 (revised)

 chapter 2.  ordered set (continued)
   section 2    Pre elements 
   section 3    Transfinite induction
   section 4.   ordered_set2.  preliminary lemmas for Zorn's lemma 
   section 5.   Zorn's lemma

 chapter 3.  Group Theory. Focused on Jordan Hoelder theorem 
   section 1.    definition of a group 
   section 2.    subgroups
   section 3.    cosets
   section 4.    normal subgroups and quotient groups

  **)

theory Algebra2
imports Algebra1
begin

lemma (in Order) less_and_segment:"b ∈ carrier D ⟹
      (∀a.((a ≺ b ∧ a ∈ carrier D) ⟶ (Q a))) = 
      (∀a∈carrier (Iod D (segment D b)).(Q a))"
apply (rule iffI)
 apply (rule ballI)
 apply (cut_tac segment_sub[of "b"], simp add:Iod_carrier,
        thin_tac "segment D b ⊆ carrier D",
        simp add:segment_def)
apply (rule allI, rule impI, erule conjE)
 apply (cut_tac segment_sub[of "b"], simp add:Iod_carrier,
        thin_tac "segment D b ⊆ carrier D",
        simp add:segment_def)
done

lemma (in Worder) Word_compare2:"⟦Worder E; 
    ¬ (∀a∈carrier D. ∃b∈carrier E. ord_equiv (Iod D (segment D a)) 
                                             (Iod E (segment E b)))⟧ ⟹ 
       ∃c∈carrier D. ord_equiv (Iod D (segment D c))  E"
apply simp 
apply (frule bex_nonempty_set[of "carrier D"],
       frule nonempty_set_sub[of "carrier D" _],
       thin_tac "∃a∈carrier D. ∀b∈carrier E.
           ¬ ord_equiv (Iod D (segment D a)) (Iod E (segment E b))")

apply  (insert ex_minimum,
      frule_tac a = "{x ∈ carrier D. ∀b∈carrier E.
        ¬ ord_equiv (Iod D (segment D x)) (Iod E (segment E b))}" in 
        forall_spec, simp,
      thin_tac "{x ∈ carrier D. ∀b∈carrier E.
       ¬ ord_equiv (Iod D (segment D x)) (Iod E (segment E b))} ≠ {}",
      thin_tac "∀X. X ⊆ carrier D ∧ X ≠ {} ⟶ (∃x. minimum_elem D X x)",
      erule exE)
 apply (frule_tac X = "{x ∈ carrier D. ∀b∈carrier E.
      ¬ ord_equiv (Iod D (segment D x)) (Iod E (segment E b))}" and a = x in 
       minimum_elem_mem, assumption, simp)
  apply (rename_tac d)
 apply (erule conjE, thin_tac "∀b∈carrier E.
             ¬ ord_equiv (Iod D (segment D d)) (Iod E (segment E b))")
 apply (frule_tac d = d in less_minimum) apply simp

 apply (simp add:less_and_segment) 
 apply (cut_tac a = d in segment_Worder)
 apply (frule_tac D = "Iod D (segment D d)" in  Worder.well_ord_compare1 [of _ 
       "E"], assumption+)
 apply (auto simp add: minimum_elem_def Iod_segment_segment)
done

lemma (in Worder) Worder_equiv:"⟦Worder E; 
      ∀a∈carrier D. ∃b∈carrier E.  ord_equiv (Iod D (segment D a)) 
             (Iod E (segment E b));  
      ∀c∈carrier E. ∃d∈carrier D.  ord_equiv (Iod E (segment E c)) 
                    (Iod D (segment D d))⟧ ⟹ ord_equiv D E"
apply (frule well_ord_compare1 [of "E"], assumption+,
       erule disjE, assumption)
apply (erule bexE,
       insert Worder,
       frule_tac x = c in bspec, assumption+,
        thin_tac "∀c∈carrier E. ∃d∈carrier D.
               ord_equiv (Iod E (segment E c)) (Iod D (segment D d))",
       erule bexE)

apply (cut_tac a = d in segment_Worder,
       cut_tac D = E and a = c in Worder.segment_Worder, assumption+,
       frule_tac D = "Iod D (segment D d)" in Worder.Order,
       frule_tac D = "Iod E (segment E c)" in Worder.Order,
       insert Order)
apply (frule_tac D = "D" and E = "Iod E (segment E c)" and 
       F = "Iod D (segment D d)" in Order.ord_equiv_trans, assumption+,
       frule_tac a = d in nonequiv_segment)
apply simp
done

lemma (in Worder) Worder_equiv1:"⟦Worder E; ¬ ord_equiv D E⟧ ⟹
      ¬ ((∀a∈carrier D. ∃b∈carrier E.  
         ord_equiv (Iod D (segment D a)) (Iod E (segment E b))) ∧ 
         (∀c∈carrier E. ∃d∈carrier D.  
         ord_equiv (Iod E (segment E c)) (Iod D (segment D d))))"
apply (rule contrapos_pp, simp+) apply (erule conjE)
apply (frule Worder_equiv [of "E"], assumption+)
apply simp
done 

lemma (in Worder) Word_compare:"Worder E ⟹
 (∃a∈carrier D. ord_equiv (Iod D (segment D a)) E) ∨ ord_equiv D E ∨ 
 (∃b∈carrier E. ord_equiv D (Iod E (segment E b)))"
apply (frule Worder.Order[of "E"],
       case_tac "ord_equiv D E", simp)
 apply (frule Worder_equiv1 [of "E"], assumption+)
 apply simp
 apply (erule disjE) 
 apply (frule Word_compare2 [of  "E"], simp) 
 apply blast 
 apply (cut_tac  Worder.Word_compare2 [of "E" "D"])
apply (thin_tac "∃c∈carrier E. ∀d∈carrier D.
           ¬ ord_equiv (Iod E (segment E c)) (Iod D (segment D d))")
 apply (erule bexE,
        cut_tac a = c in Worder.segment_Worder[of "E"], assumption+, 
        frule_tac D = "Iod E (segment E c)" in Worder.Order,
        insert Order,
        frule_tac D = "Iod E (segment E c)" and E = D in Order.ord_equiv_sym,
        assumption+, blast)
 apply assumption apply (simp add:Worder)
 apply simp
done
      
lemma (in Worder) Word_compareTr1:"⟦Worder E;
      ∃a∈carrier D. ord_equiv (Iod D (segment D a)) E; ord_equiv D E ⟧ ⟹ 
     False"
apply (erule bexE,
       cut_tac a = a in segment_Worder,
       frule_tac D = E in Worder.Order,
       frule_tac D = "Iod D (segment D a)" in Worder.Order,
       frule_tac D = "Iod D (segment D a)" and E = E in Order.ord_equiv_sym,
       assumption+)
apply (insert Order,
       frule_tac D = D and E = E and F = "Iod D (segment D a)" in 
       Order.ord_equiv_trans, assumption+)
 apply (frule_tac a = a in nonequiv_segment, simp)
done  

lemma (in Worder) Word_compareTr2:"⟦Worder E; ord_equiv D E; 
      ∃b∈carrier E. ord_equiv D (Iod E (segment E b))⟧ ⟹ False"
apply (erule bexE)
apply (cut_tac a = b in Worder.segment_Worder [of "E"], assumption+)
apply (cut_tac Worder,
       frule Worder.Order[of "E"])
apply (frule_tac D = "Iod E (segment E b)" in Worder.Order)
apply (frule_tac E = E in ord_equiv_sym, assumption)
apply (meson Worder Worder.Word_compareTr1 ord_equiv_sym)
done

lemma (in Worder) Word_compareTr3:"⟦Worder E; 
      ∃b∈carrier E. ord_equiv D (Iod E (segment E b)); 
      ∃a∈carrier D. ord_equiv (Iod D (segment D a)) E⟧ ⟹ False"  
apply (erule bexE)+
 apply (simp add:ord_equiv_def[of "D"], erule exE)
 (** ord_isom_segment_segment **)
 apply (frule Worder.Torder[of "E"])
 apply (cut_tac a = b in Worder.segment_Worder [of "E"], assumption+,
        frule_tac D = "Iod E (segment E b)" in Worder.Torder,
        frule_tac D = "Iod E (segment E b)" in Worder.Order)
 apply (frule_tac E = "Iod E (segment E b)" and f = f and a = a in 
        ord_isom_segment_segment, assumption+) 
 apply (frule_tac f = f and a = a and E = "Iod E (segment E b)" in 
        ord_isom_mem, assumption+,
        frule Worder.Order[of "E"], 
        frule_tac b = b and a = "f a" in Order.Iod_segment_segment[of "E"],
        assumption+, simp,
        thin_tac "Iod (Iod E (segment E b)) (segment (Iod E (segment E b)) 
        (f a)) =  Iod E (segment E (f a))")

 apply (frule_tac D = "E" and a = b in Order.segment_sub)
        apply (simp add:Order.Iod_carrier[of "E"])
        apply (frule_tac c = "f a" and A = "segment E b" and B = "carrier E"
               in subsetD, assumption+)
  apply (cut_tac a = a in segment_Worder,
         frule_tac D = "Iod D (segment D a)" in Worder.Order,
         cut_tac a = "f a" in Worder.segment_Worder [of "E"], assumption+,
         frule_tac D = "Iod E (segment E (f a))" in Worder.Order) 
apply (
         frule_tac D = "Iod D (segment D a)" and E = "Iod E (segment E (f a))" in Order.ord_equiv, assumption, simp)
 apply (frule_tac D = "Iod D (segment D a)" and E = E in 
                                            Order.ord_equiv_sym, assumption+)
 apply (frule_tac D = E and E = "Iod D (segment D a)" and 
        F = "Iod E (segment E (f a))" in Order.ord_equiv_trans, assumption+)

 apply (simp add:Worder.nonequiv_segment[of "E"])
done 

lemma (in Worder) subset_equiv_segment:"S ⊆ carrier D ⟹ 
      ord_equiv D (Iod D S) ∨ 
      (∃a∈carrier D. ord_equiv (Iod D S) (Iod D (segment D a)))"
apply (frule subset_Worder [of "S"])
 apply (frule Word_compare [of "Iod D S"])

 apply (erule disjE)
 apply (erule bexE)
 apply (cut_tac a = a in segment_Worder,
        frule_tac D = "Iod D (segment D a)" in Worder.Order,
        frule Worder.Order[of "Iod D S"],
        frule_tac D = "Iod D (segment D a)" in Order.ord_equiv_sym[of _ 
                 "Iod D S"], assumption+, blast)

apply (erule disjE) apply simp
 apply (erule bexE)
 apply (frule Worder.Order[of "Iod D S"],
        frule_tac D = "Iod D S" and a = b in Order.segment_sub)
 apply (frule_tac S = "segment (Iod D S) b" in Order.Iod_sub_sub[of "Iod D S" _ "S"])
 apply (simp add:Iod_carrier) apply (simp add:Iod_carrier)
 apply (simp add:Iod_sub_sub[of "S" "S"])
 apply (simp add:Iod_carrier)
 apply (frule_tac S = "segment (Iod D S) b" in Iod_sub_sub[of _ "S"],
         assumption+, simp,
        thin_tac "Iod (Iod D S) (segment (Iod D S) b) = 
                                          Iod D (segment (Iod D S) b)")
 (** to_subset **)
 apply (simp add:ord_equiv_def, erule exE)
 apply (frule_tac A = "segment (Iod D S) b" and B = S and C = "carrier D" in
         subset_trans, assumption+,
        frule_tac c = b in subsetD[of "S" "carrier D"], assumption+)
 apply (frule_tac T = "segment (Iod D S) b" and f = f in to_subset,
         assumption+,
        frule_tac a = b in forall_spec, assumption, 
        thin_tac "∀a. a ∈ carrier D ⟶ a ≼ f a",
        frule_tac T = "segment (Iod D S) b" in Iod_Order,
        cut_tac D = "Iod D S" and a = b in Worder.segment_Worder) 
 apply (simp add:Iod_carrier) 
 apply (frule_tac S = "segment (Iod D S) b" in Iod_sub_sub[of _ "S"],
         assumption+, simp,
        thin_tac "Iod (Iod D S) (segment (Iod D S) b) = 
                                          Iod D (segment (Iod D S) b)")
 apply (insert Order,
        frule_tac E = "Iod D (segment (Iod D S) b)" and f = f and a = b in 
        ord_isom_mem, assumption+,
        simp add:Iod_carrier,
        frule_tac c = "f b" and A = "segment (Iod D S) b" in 
               subsetD[of _ "S"], assumption+,
        simp add:segment_def[of "Iod D S"],
        simp add:Iod_carrier,
        simp add:Iod_less)
 apply (frule_tac c = b in subsetD[of "S" "carrier D"], assumption+,
        frule_tac c = "f b" in subsetD[of "S" "carrier D"], assumption+,
        frule_tac a1 = "f b" and b1 = b in not_less_le[THEN sym], assumption+)
 apply simp
done

definition
  ordinal_number :: "'a Order  ⇒ 'a Order set" where
  "ordinal_number S = {X. Worder X ∧ ord_equiv X S}"

definition
  ODnums :: "'a Order set set" where
  "ODnums = {X. ∃S. Worder S ∧ X = ordinal_number S}"

definition
  ODord :: "['a Order set, 'a Order set] ⇒ bool" (infix ‹⊏› 60) where
  "X ⊏ Y ⟷ (∃x ∈ X. ∃y ∈ Y. (∃c∈carrier y. ord_equiv x (Iod y (segment y c))))"

definition
  ODord_le :: "['a Order set, 'a Order set] ⇒ bool" (infix ‹⊑› 60) where
  "X ⊑ Y ⟷ X = Y ∨ ODord X Y"

definition
  ODrel :: "((('a Order) set) * (('a Order) set)) set" where
  "ODrel = {Z. Z ∈ ODnums × ODnums ∧ ODord_le (fst Z) (snd Z)}" 

definition
  ODnods :: "('a Order set) Order" where
  "ODnods = ⦇carrier = ODnums, rel = ODrel ⦈"

lemma Worder_ord_equivTr:"⟦Worder S; Worder T⟧ ⟹
       ord_equiv S T = (∃f. ord_isom S T f)"
by (frule Worder.Order[of "S"], frule Worder.Order[of "T"],
    simp add:ord_equiv_def)

lemma Worder_ord_isom_mem:"⟦Worder S; Worder T; ord_isom S T f; a ∈ carrier S⟧
     ⟹ f a ∈ carrier T"
by (frule Worder.Order[of "S"], frule Worder.Order[of "T"],
    simp add:Order.ord_isom_mem)

lemma Worder_refl:"Worder S ⟹ ord_equiv S S"
apply (frule_tac Worder.Order [of "S"])
apply (rule Order.ord_equiv_reflex [of "S"], assumption+)
done

lemma Worder_sym:"⟦Worder S; Worder T; ord_equiv S T ⟧ ⟹ ord_equiv T S"
apply (frule_tac Worder.Order [of "S"])
apply (frule_tac Worder.Order [of "T"])
apply (rule Order.ord_equiv_sym [of "S" "T"], assumption+)
done

lemma Worder_trans:"⟦Worder S; Worder T; Worder U; ord_equiv S T; ord_equiv T U⟧ ⟹ ord_equiv S U" 
apply (frule Worder.Order [of "S"],
       frule Worder.Order [of "T"],
       frule Worder.Order [of "U"])
apply (rule Order.ord_equiv_trans [of "S" "T" "U"], assumption+)
done  

lemma ordinal_inc_self:"Worder S ⟹ S ∈ ordinal_number S"
by (simp add:ordinal_number_def, simp add:Worder_refl)

lemma ordinal_number_eq:"⟦Worder D; Worder E⟧ ⟹
               (ord_equiv D E) = (ordinal_number D = ordinal_number E)"
apply (rule iffI)
 apply (simp add:ordinal_number_def)
 apply (rule equalityI)
 apply (rule subsetI) apply simp apply (erule conjE)
 apply (rule_tac S = x and T = D and U = E in Worder_trans,
                       assumption+)
 apply (rule subsetI, simp, erule conjE)
apply (rule_tac S = x and T = E and U = D in Worder_trans,
                       assumption+)  
 apply (rule Worder_sym, assumption+)
apply (simp add:ordinal_number_def)
apply (frule Worder_refl[of "D"],
       frule Worder_refl[of "E"])
apply blast
done

lemma mem_ordinal_number_equiv:"⟦Worder D; 
           X ∈ ordinal_number D⟧ ⟹ ord_equiv X D"
by (simp add:ordinal_number_def)

lemma mem_ordinal_number_Worder:"⟦Worder D; 
           X ∈ ordinal_number D⟧ ⟹ Worder X"
by (simp add:ordinal_number_def)

lemma mem_ordinal_number_Worder1:"⟦x ∈ ODnums; X ∈ x⟧ ⟹ Worder X"
apply (simp add:ODnums_def, erule exE, erule conjE, simp)
apply (rule mem_ordinal_number_Worder, assumption+)
done

lemma mem_ODnums_nonempty:"X ∈ ODnums ⟹ ∃x. x ∈ X"
apply (simp add:ODnums_def, simp add:ordinal_number_def,
       erule exE, erule conjE)
apply (frule_tac S = S in Worder_refl, blast)
done

lemma carr_ODnods:"carrier ODnods = ODnums"
by (simp add:ODnods_def)

lemma ordinal_number_mem_carrier_ODnods:
     "Worder D ⟹ ordinal_number D ∈ carrier ODnods"
by (simp add:ODnods_def ODnums_def, blast)

lemma ordinal_number_mem_ODnums: 
      "Worder D ⟹ ordinal_number D ∈ ODnums"
by (simp add:ODnums_def, blast)

lemma ODordTr1:" ⟦Worder D; Worder E⟧ ⟹ 
       (ODord (ordinal_number D) (ordinal_number E)) =
       (∃b∈ carrier E. ord_equiv D (Iod E (segment E b)))"
apply (rule iffI)
 apply (simp add:ODord_def)
 apply ((erule bexE)+, simp add:ordinal_number_def, (erule conjE)+)
 apply (rename_tac X Y c)

apply (frule_tac S = Y and T = E in Worder_ord_equivTr, assumption,
       simp, erule exE)
apply (frule_tac D = Y in Worder.Order,
       frule_tac D = E in Worder.Order,
       frule_tac D = Y and E = E and f = f and a = c in 
                 Order.ord_isom_segment_segment, assumption+,
       frule_tac S = Y and T = E and f = f and a = c in 
                 Worder_ord_isom_mem, assumption+)
apply (cut_tac D = Y and a = c in Worder.segment_Worder, assumption,
       cut_tac D = E and a = "f c" in Worder.segment_Worder, assumption)
apply (frule_tac S1 = "Iod Y (segment Y c)" and T1 = "Iod E (segment E (f c))" 
       in Worder_ord_equivTr[THEN sym], assumption+)
apply (frule_tac S = X and T = D in Worder_sym, assumption+,
       thin_tac "ord_equiv X D",
       frule_tac S = D and T = X and U = "Iod Y (segment Y c)" in 
                 Worder_trans, assumption+,
       frule_tac S = D and T = "Iod Y (segment Y c)" and 
           U = "Iod E (segment E (f c))" in Worder_trans, assumption+)
apply blast apply blast 

apply (simp add:ODord_def)  
apply (frule ordinal_inc_self[of "D"],
       frule ordinal_inc_self[of "E"], blast)
done

lemma ODord:" ⟦Worder D; d ∈ carrier D⟧ ⟹ 
       ODord (ordinal_number (Iod D (segment D d))) (ordinal_number D)"
apply (cut_tac Worder.segment_Worder[of "D" "d"], 
       subst ODordTr1[of "Iod D (segment D d)" "D"], assumption+,
       frule Worder_refl[of "Iod D (segment D d)"], blast, assumption)
done

lemma ord_less_ODord:"⟦Worder D; c ∈ carrier D; d ∈ carrier D; 
           a = ordinal_number (Iod D (segment D c));
           b = ordinal_number (Iod D (segment D d))⟧ ⟹
                         c ≺⇘D⇙ d =  a ⊏ b"
apply (rule iffI)
apply (frule Worder.Order[of "D"])
apply (simp add:Order.segment_inc) 
apply (frule Order.Iod_carr_segment[THEN sym, of "D" "d"],
       frule eq_set_inc[of "c" "segment D d" "carrier (Iod D (segment D d))"],
       assumption+,
       thin_tac "segment D d = carrier (Iod D (segment D d))",
       thin_tac "c ∈ segment D d")
apply (cut_tac Worder.segment_Worder[of "D" "d"], 
       frule ODord[of "Iod D (segment D d)" "c"], assumption+,
       simp add:Order.Iod_segment_segment, assumption)

apply simp
 apply (frule Worder.segment_Worder[of D c],
        frule Worder.segment_Worder[of D d])
 apply (simp add:ODordTr1[of "Iod D (segment D c)" "Iod D (segment D d)"],
        thin_tac "a = ordinal_number (Iod D (segment D c))",
        thin_tac "b = ordinal_number (Iod D (segment D d))")
 apply (erule bexE)
 apply (frule Worder.Order[of D])

 apply (simp add:Order.Iod_segment_segment)
 apply (simp add:Order.Iod_carr_segment,
        frule Order.segment_sub[of D d],
        frule_tac c = b in subsetD[of "segment D d" "carrier D"], assumption+)
 apply (frule_tac b = b in Worder.segment_unique[of D c], assumption+, simp)
 apply (simp add:Order.segment_inc[THEN sym])
done

lemma ODord_le_ref:"⟦X ∈ ODnums; Y ∈ ODnums; ODord_le X Y; Y ⊑ X ⟧ ⟹
                               X = Y"
apply (simp add:ODnums_def)
 apply ((erule exE)+, (erule conjE)+, rename_tac S T)
 apply (simp add:ODord_le_def)
 apply (erule disjE, simp)
 apply (erule disjE, simp)
 
 apply (simp add:ODordTr1)
 apply (frule_tac D = T and E = S in Worder.Word_compareTr3, assumption+)
 apply (erule bexE)
 apply (frule_tac D = T and a = b in Worder.segment_Worder)
 apply (frule_tac S = S and T = "Iod T (segment T b)" in Worder_sym,
         assumption+) apply blast
 
 apply simp
done

lemma ODord_le_trans:"⟦X ∈ ODnums; Y ∈ ODnums; Z ∈ ODnums; X ⊑ Y; Y ⊑ Z ⟧
                     ⟹  X ⊑ Z" 
apply (simp add:ODord_le_def)
 apply (erule disjE, simp)
 apply (erule disjE, simp)

 apply (simp add:ODnums_def, (erule exE)+, (erule conjE)+)
 apply (rename_tac A B C, simp)
 apply (simp add:ODordTr1,
        thin_tac "X = ordinal_number A",
        thin_tac "Y = ordinal_number B",
        thin_tac "Z = ordinal_number C")
 apply (erule bexE)+

 (* going to apply ord_isom_segment_segment *)
 apply (frule_tac D = B in Worder.Order,
        frule_tac D = C in Worder.Order,
        frule_tac D = C and a = ba in Worder.segment_Worder,
        frule_tac D = "Iod C (segment C ba)" in Worder.Order,
        frule_tac D = B and E = "Iod C (segment C ba)" in 
                  Order.ord_equiv_isom, assumption+, erule exE)
 apply (frule_tac D = B and E = "Iod C (segment C ba)" and f = f in 
         Order.ord_isom_segment_segment, assumption+,
        frule_tac D = B and E = "Iod C (segment C ba)" and f = f and a = b in
         Order.ord_isom_mem, assumption+) 
        (** ord_isom_segment_segment applied **)
 
 apply (simp add:Order.Iod_segment_segment) 
 apply (frule_tac D = B and a = b in Worder.segment_Worder,
        frule_tac D = "Iod B (segment B b)" in Worder.Order,
        frule_tac D = C and a = "f b" in Worder.segment_Worder,
        frule_tac D = "Iod C (segment C (f b))" in Worder.Order)
 apply (frule_tac D = "Iod B (segment B b)" and E = "Iod C (segment C (f b))"
         in  Order.ord_equiv, assumption+)
 apply (frule_tac S = A and T = "Iod B (segment B b)" and 
                  U = "Iod C (segment C (f b))" in Worder_trans, assumption+)
 apply (simp add:Order.Iod_carr_segment)
 apply (frule_tac D = C and a = ba in Order.segment_sub,
        frule_tac c = "f b" and A = "segment C ba" and B = "carrier C" in
        subsetD, assumption+)
 apply blast
done

lemma ordinal_numberTr1:" X ∈ carrier ODnods ⟹ ∃D. Worder D ∧ D ∈ X"
apply (simp add:ODnods_def, simp add:ODnums_def) 
apply (erule exE, erule conjE)
 apply (simp add:ordinal_number_def)
 apply (frule_tac S = S in Worder_refl, blast) 
done

lemma ordinal_numberTr1_1:" X ∈ ODnums ⟹ ∃D. Worder D ∧ D ∈ X"
apply (simp add:ODnums_def, erule exE, erule conjE, 
       simp add:ordinal_number_def)
 apply (frule_tac S = S in Worder_refl, blast) 
done

lemma ordinal_numberTr1_2:"⟦x ∈ ODnums; S ∈ x; T ∈ x⟧ ⟹
                              ord_equiv S T"
by (simp add:ODnums_def, erule exE, erule conjE,
       simp add:ordinal_number_def, (erule conjE)+,
       frule_tac S = T and T = Sa in Worder_sym, assumption, assumption,
       rule_tac S = S and T = Sa and U = T in Worder_trans, assumption+)

lemma ordinal_numberTr2:"⟦Worder D; x = ordinal_number D⟧ ⟹
            D ∈ x"
by (simp add:ordinal_inc_self)

lemma ordinal_numberTr3:"⟦Worder D; Worder F; ord_equiv D F; 
        x = ordinal_number D⟧ ⟹ x = ordinal_number F"
apply (simp add:ordinal_number_def,
        thin_tac "x = {X. Worder X ∧ ord_equiv X D}")
apply (rule equalityI)
 apply (rule subsetI, simp, erule conjE)
 apply (rule_tac S = x and T = D and U = F in Worder_trans, assumption+)
apply (rule subsetI, simp, erule conjE)
 apply (frule Worder_sym [of "D" "F"], assumption+,
        rule_tac S = x and T = F and U = D in Worder_trans, assumption+)
done

lemma ordinal_numberTr4:"⟦Worder D; X ∈ carrier ODnods; D ∈ X ⟧ ⟹
            X = ordinal_number D"
apply (simp add:ODnods_def ODnums_def, erule exE, erule conjE)
apply simp
apply (frule_tac D = S in mem_ordinal_number_equiv[of _ "D"], assumption+,
       frule_tac D = D and E = S in ordinal_number_eq, assumption+)
apply simp
done

lemma ordinal_numberTr5:"⟦x ∈ ODnums; D ∈ x⟧ ⟹ x = ordinal_number D"
apply (frule mem_ordinal_number_Worder1[of x D], assumption+)
apply (rule ordinal_numberTr4[of D x], assumption,
       simp add:ODnods_def, assumption)
done

lemma ordinal_number_ord:"⟦ X ∈ carrier ODnods; Y ∈ carrier ODnods⟧ ⟹
                             ODord X Y ∨ X = Y ∨ ODord Y X"
apply (simp add:ODord_def)
 apply (frule ordinal_numberTr1 [of "X"],
        frule ordinal_numberTr1 [of "Y"], (erule exE)+, rename_tac D E)
 apply (erule conjE)+ 
 apply (frule_tac D = D and E = E in Worder.Word_compare, assumption+)
 apply (erule disjE)+
 apply (erule bexE,
        cut_tac D = D and a = a in Worder.segment_Worder, assumption+,
        frule_tac S = "Iod D (segment D a)" and T = E in Worder_sym, 
        assumption+, blast)

apply (erule disjE) 
 apply (frule_tac D = D and X = X in ordinal_numberTr4, assumption+,
        frule_tac D = E and X = Y in ordinal_numberTr4, assumption+,
        frule_tac D = D and E = E in ordinal_number_eq, assumption+)
 apply simp

apply blast
done 

lemma ODnum_subTr:"⟦Worder D; x = ordinal_number D; y ∈ODnums; y ⊏ x; Y ∈ y⟧
                   ⟹ ∃c∈carrier D. ord_equiv Y (Iod D (segment D c))"
apply simp
 apply (thin_tac "x = ordinal_number D")
 apply (simp add:ODnums_def, erule exE, erule conjE, simp,
        thin_tac "y = ordinal_number S")
 apply (frule_tac D = S and X = Y in mem_ordinal_number_Worder, 
                                                      assumption+)
 apply (frule_tac D = Y and X = "ordinal_number S" in ordinal_numberTr4,
        simp add:ODnods_def ODnums_def, blast, simp)
 apply simp
 apply (thin_tac "Y ∈ ordinal_number Y",
        thin_tac "ordinal_number S = ordinal_number Y")
 apply (simp add:ODordTr1[of "Y" "D"])
done

lemma ODnum_segmentTr:"⟦Worder D; x = ordinal_number D; y ∈ODnums; y ⊏ x⟧ ⟹ 
        ∃c. c∈carrier D ∧ (∀Y∈y. ord_equiv Y (Iod D (segment D c)))"
apply (frule ordinal_numberTr1_1[of "y"], erule exE, erule conjE,
       frule_tac x = x and y = y and Y = Da in ODnum_subTr[of "D" ],
        assumption+, erule bexE)
apply (rule ex_conjI, simp+)

apply (rule ballI)
 apply (frule_tac D = D and a = c in Worder.segment_Worder)
 apply (frule_tac X = Y in mem_ordinal_number_Worder1[of y], assumption)
 apply (subst ordinal_number_eq, assumption+)
 apply (simp add:ordinal_number_eq)
 apply (subst ordinal_numberTr5[THEN sym, of y], assumption+)
 apply (frule_tac D = Da in ordinal_numberTr5[of y], assumption, simp)
done

lemma ODnum_segmentTr1:"⟦Worder D; x = ordinal_number D; y ∈ ODnums; y ⊏ x⟧
        ⟹ ∃c. c ∈ carrier D ∧ (y = ordinal_number (Iod D (segment D c)))"
apply (frule ODnum_segmentTr[of D x y], assumption+, erule exE, erule conjE)
apply (frule mem_ODnums_nonempty[of y], erule exE,
       frule_tac x = xa in bspec, assumption,
       thin_tac "∀Y∈y. ord_equiv Y (Iod D (segment D c))")
 (** going to apply ordinal_number_eq **)
 apply (frule_tac D = xa in ordinal_numberTr5[of y], assumption, simp,
        frule_tac a = c in Worder.segment_Worder[of D],
        rotate_tac -2, frule sym, thin_tac "y = ordinal_number xa", simp,
        frule_tac X = xa in mem_ordinal_number_Worder1[of y], assumption+)
 apply (simp add:ordinal_number_eq) apply blast
done

lemma ODnods_less:"⟦x ∈ carrier ODnods; y ∈ carrier ODnods⟧ ⟹
                       x ≺⇘ODnods⇙ y =  x ⊏ y"
apply (simp add:ODnods_def ole_def oless_def ODrel_def ODord_le_def)
apply (rule iffI)
 apply (erule conjE, erule disjE, simp, assumption, simp)
 apply (simp add:ODord_def, (erule bexE)+)
 apply (rule contrapos_pp, simp+,
        frule_tac x = y and S = ya and T = xa in ordinal_numberTr1_2,
         assumption+)

 apply (simp add:ODnums_def, erule exE, erule conjE, simp,
        frule_tac D = S and X = xa in mem_ordinal_number_Worder, assumption+,
        frule_tac D = S and X = ya in mem_ordinal_number_Worder, assumption+,
        cut_tac D = ya and a = c in Worder.segment_Worder, assumption+)

 apply (frule_tac S = ya and T = xa and U = "Iod ya (segment ya c)" in
        Worder_trans, assumption+,
        frule_tac D = ya and a = c in Worder.nonequiv_segment, assumption+)
 apply simp
done

lemma ODord_less_not_eq:"⟦x ∈ carrier ODnods; y ∈ carrier ODnods; x ⊏ y⟧ ⟹
                          x ≠ y"
apply (rule contrapos_pp, simp+)
apply (frule ordinal_numberTr1[of y], erule exE, erule conjE,
       simp add:ODnods_def)
   (* going to see ord_equiv D (Iod D (segment D c)) for some c,
      at first show ordinal_number D = ordinal_number (Iod D (segment D c)) *)
apply (frule_tac D = D in ordinal_numberTr5[of y], assumption+,
       frule_tac D = D and x = y and y = y in ODnum_segmentTr1, assumption+,
       erule exE, erule conjE, simp,
       frule_tac a = c and D = D in Worder.segment_Worder) (* equality got *)
apply (rotate_tac -4, frule sym, 
       thin_tac "ordinal_number (Iod D (segment D c)) = ordinal_number D",
       simp add:ordinal_number_eq[THEN sym]) (* ord_equiv got *)
apply (frule_tac D = D and a = c in Worder.nonequiv_segment, assumption)
       (**** this is the key lemma ****)
apply simp
done

lemma not_ODord:"⟦a ∈ ODnums; b ∈ ODnums; a ⊏ b⟧ ⟹ ¬ (b ⊑ a)"
apply (rule contrapos_pp, simp+)

apply (simp add:ODord_le_def)
apply (cut_tac x = a and y = b in ODord_less_not_eq,
          simp add:ODnods_def, simp add:ODnods_def, assumption)
apply (erule disjE) apply simp
 (** Show that ord_equiv to segment each other does not happen **) 
 apply (frule ordinal_numberTr1_1[of a],
        frule ordinal_numberTr1_1[of b], (erule exE)+, (erule conjE)+)
 apply (frule_tac D = D in ordinal_numberTr5[of a], assumption,
        frule_tac D = Da in ordinal_numberTr5[of b], assumption, simp)
 apply (frule_tac D = D and E = Da in ODordTr1, assumption+,
        frule_tac D = Da and E = D in ODordTr1, assumption+, simp)
 apply (frule_tac D = D and E = Da in Worder.Word_compareTr3, assumption+)
 apply (erule bexE)+
 apply (frule_tac D = D and a = baa in Worder.segment_Worder,
        frule_tac S = Da and T = "Iod D (segment D baa)" in Worder_sym,
        assumption+) apply blast
 apply assumption
done

lemma Order_ODnods:"Order ODnods"
apply (rule Order.intro)
 apply (simp add:ODnods_def ODrel_def)

 apply (simp add:ODnods_def ODrel_def, simp add:ODord_le_def)
 
 apply (simp add:ODnods_def ODrel_def, simp add:ODord_le_def)
 apply (erule disjE, assumption)
 apply (erule disjE, rule sym, assumption)
 apply (frule_tac a = a and b = b in not_ODord, assumption+)
 apply (simp add:ODord_le_def)

 apply (simp add:ODnods_def ODrel_def)
 apply (rule_tac X = a and Y = b and Z = c in ODord_le_trans, assumption+)
done

lemma Torder_ODnods:"Torder ODnods" 
apply (rule Torder.intro)
apply (cut_tac Order_ODnods, assumption)

 (*** tordered set ***)
 apply (simp add:Torder_axioms_def)
  apply ((rule allI, rule impI)+) 
apply (cut_tac Order_ODnods) 
apply (subst Order.le_imp_less_or_eq[of "ODnods"], assumption+,
       subst Order.le_imp_less_or_eq[of "ODnods"], assumption+)  
apply (simp add:ODnods_less,
       frule_tac X = a and Y = b in ordinal_number_ord, assumption+,
         blast)
done

definition
  ODNmap :: "'a Order ⇒ ('a Order) set ⇒ 'a" where
  "ODNmap D y = (SOME z. (z ∈ carrier D ∧ 
                        (∀Y∈y. ord_equiv Y (Iod D (segment D z)))))" 

lemma ODNmap_mem:"⟦Worder D; x = ordinal_number D; y ∈ ODnums; ODord y x⟧ ⟹ 
      ODNmap D y ∈ carrier D ∧ 
             (∀Y∈y. ord_equiv Y (Iod D (segment D (ODNmap D y))))" 
apply (frule ODnum_segmentTr [of "D" "x" "y"], assumption+)
apply (simp add:ODNmap_def)
apply (rule someI2_ex, assumption+)
done 

lemma ODNmapTr1:"⟦Worder D; x = ordinal_number D; y ∈ ODnums; ODord y x⟧ ⟹ 
                  y = ordinal_number (Iod D (segment D (ODNmap D y)))"
apply (frule ODNmap_mem [of "D" "x" "y"], assumption+, erule conjE,
       frule ODnum_segmentTr1 [of "D" "x" "y"], assumption+)
 apply (erule exE, erule conjE,
        cut_tac D = D and a = c in Worder.segment_Worder, assumption+,
        frule_tac D = "Iod D (segment D c)" and x = y in ordinal_numberTr2,
            assumption+,
        frule_tac x = "Iod D (segment D c)" in bspec, assumption,
         thin_tac "∀Y∈y. ord_equiv Y (Iod D (segment D (ODNmap D y)))",
        cut_tac a = "ODNmap D y" in Worder.segment_Worder[of "D"],
         assumption+)
 apply (frule_tac D = "Iod D (segment D c)" and E = "Iod D (segment D (ODNmap D y))" in ordinal_number_eq, assumption+) apply simp
done

lemma ODNmap_self:"⟦Worder D; c ∈ carrier D;
       a = ordinal_number (Iod D (segment D c))⟧ ⟹ ODNmap D a = c"
apply (simp add:ODNmap_def)
apply (rule someI2_ex, rule ex_conjI, simp)
 apply (rule ballI, 
        cut_tac Worder.segment_Worder[of "D" "c"], 
        rule_tac X = Y in mem_ordinal_number_equiv[of "Iod D (segment D c)"],
        assumption+)

 apply (erule conjE)
 apply (cut_tac Worder.segment_Worder[of "D" "c"], 
        frule ordinal_inc_self[of "Iod D (segment D c)"],
        frule_tac x = "Iod D (segment D c)" in bspec, assumption)
 apply (frule_tac b = x in Worder.segment_unique[of "D" "c" _], assumption+,
        rule sym, assumption, assumption)
done

lemma ODord_ODNmap_less:"⟦Worder D; c ∈ carrier D;
      a = ordinal_number (Iod D (segment D c)); d ∈ carrier D; 
      b = ordinal_number (Iod D (segment D d)); a ⊏ b⟧ ⟹  
      ODNmap D a ≺⇘D⇙ (ODNmap D b)"
apply (frule ODNmap_self [of "D" "c" "a"], assumption+,
       frule ODNmap_self [of "D" "d" "b"], assumption+)
apply simp
apply (subst ord_less_ODord[of D c d a b], assumption+)
 apply simp
done

lemma ODNmap_mem1:" ⟦Worder D; y ∈ segment ODnods (ordinal_number D)⟧
         ⟹ ODNmap D y ∈ carrier D"
apply (frule_tac D = D and x = "ordinal_number D" and y = y in ODNmap_mem,
       simp, 
       frule ordinal_number_mem_carrier_ODnods[of "D"],
       simp add:ODnods_def segment_def) 
 apply (simp add:segment_def,
        frule ordinal_number_mem_carrier_ODnods[of "D"], simp,
        erule conjE, simp add:ODnods_def oless_def ole_def ODrel_def)
 apply (simp add:ODord_le_def, blast, simp)
done

lemma ODnods_segment_inc_ODord:"⟦Worder D; 
       y ∈ segment ODnods (ordinal_number D)⟧ ⟹ ODord y (ordinal_number D)"
 apply (simp add:segment_def,
        frule ordinal_number_mem_carrier_ODnods[of "D"], simp,
        erule conjE, simp add:ODnods_def oless_def ole_def ODrel_def)
 apply ((erule conjE)+, simp add:ODord_le_def)
done

lemma restict_ODNmap_func:"⟦Worder D; x = ordinal_number D⟧ ⟹
      restrict (ODNmap D) (segment ODnods (ordinal_number D))
               ∈ segment ODnods (ordinal_number D) → carrier D"
apply (cut_tac Order_ODnods,
       frule Order.Iod_carr_segment[of "ODnods" "ordinal_number D"],
       frule Order.segment_sub[of "ODnods" "ordinal_number D"])
apply (rule Pi_I, simp,
        (frule Order.Iod_carr_segment[of ODnods "ordinal_number D"], 
         simp,
         thin_tac "carrier (Iod ODnods (segment ODnods (ordinal_number D))) =
                            segment ODnods (ordinal_number D) "),
        rule ODNmap_mem1[of D], assumption+)
done

lemma ODNmap_ord_isom:"⟦Worder D; x = ordinal_number D⟧  ⟹ 
             ord_isom (Iod ODnods (segment ODnods x)) D 
      (λx∈(carrier (Iod ODnods (segment ODnods x))). (ODNmap D x))"
apply (cut_tac Order_ODnods,
       frule Order.Iod_carr_segment[of "ODnods" "ordinal_number D"],
       frule ordinal_number_mem_carrier_ODnods[of D],
       frule Order.segment_sub[of "ODnods" "ordinal_number D"])
       (* above items are preliminary *)
apply (simp add:ord_isom_def)
 apply (rule conjI)
 apply (simp add:ord_inj_def)
 apply (simp add:restict_ODNmap_func[of D x])
 apply (rule conjI)
 apply (subst inj_on_def)  (* show inj_on *)
 apply ((rule ballI)+, rule impI) (* show xa and y is the ordinal_number of
        segments of D *)
  apply (thin_tac "carrier (Iod ODnods (segment ODnods (ordinal_number D))) =
        segment ODnods (ordinal_number D)")
  apply (frule_tac y = xa in ODnods_segment_inc_ODord[of D], assumption+,
         frule_tac y = y in ODnods_segment_inc_ODord[of D], assumption+)
  apply (frule_tac y = y in ODNmapTr1[of D x], assumption+)
  apply (frule_tac c = y in subsetD[of "segment ODnods (ordinal_number D)"
                  "carrier ODnods"], assumption+, simp add:carr_ODnods,
                   simp)
  apply (frule_tac y = xa in ODNmapTr1[of D x], assumption+)
  apply (frule_tac c = xa in subsetD[of "segment ODnods (ordinal_number D)"
                   "carrier ODnods"], assumption+, simp add:carr_ODnods,
                   simp, simp)
  apply (rule ballI)+
   apply (thin_tac "carrier (Iod ODnods (segment ODnods (ordinal_number D))) =
        segment ODnods (ordinal_number D)")
  apply (frule_tac y = a in ODnods_segment_inc_ODord[of D], assumption+,
         frule_tac y = b in ODnods_segment_inc_ODord[of D], assumption+)
  apply (frule_tac y = a in ODNmapTr1[of D x], assumption+)
  apply (frule_tac c = a in subsetD[of "segment ODnods (ordinal_number D)"
                  "carrier ODnods"], assumption+, simp add:carr_ODnods,
                   simp)
  apply (frule_tac y = b in ODNmapTr1[of D x], assumption+)
  apply (frule_tac c = b in subsetD[of "segment ODnods (ordinal_number D)"
                   "carrier ODnods"], assumption+, simp add:carr_ODnods,
                   simp)
  apply (frule_tac c = "ODNmap D a" and d = "ODNmap D b" and a = a and b = b in
             ord_less_ODord[of D],
         frule_tac  x = x and y = a in ODNmap_mem[of D], assumption, 
         frule_tac c = a in subsetD[of "segment ODnods (ordinal_number D)"
                  "carrier ODnods"], assumption+, simp add:carr_ODnods,   
         simp, simp)
  apply (frule_tac  x = x and y = b in ODNmap_mem[of D], assumption, 
         frule_tac c = b in subsetD[of "segment ODnods (ordinal_number D)"
                  "carrier ODnods"], assumption+, simp add:carr_ODnods,   
         simp, simp) apply simp+
   apply (frule_tac c = a in subsetD[of "segment ODnods (ordinal_number D)"
                  "carrier ODnods"], assumption+,
          frule_tac c = b in subsetD[of "segment ODnods (ordinal_number D)"
                  "carrier ODnods"], assumption+) 
  apply (simp add:Order.Iod_less[of "ODnods"])
   apply (simp add:ODnods_less)  (** order_preserving proved **)

 apply (rule surj_to_test) (* show surj_to *)
    apply (simp add:restict_ODNmap_func)
    apply (rule ballI,
           cut_tac D = D and a = b in Worder.segment_Worder, assumption+,
           frule_tac D = "Iod D (segment D b)" in 
                                 ordinal_number_mem_carrier_ODnods,
           frule_tac c = b and a = "ordinal_number (Iod D (segment D b))"
            in ODNmap_self, assumption, simp,
           frule_tac d = b in ODord[of D], assumption,
           frule_tac a = "ordinal_number (Iod D (segment D b))" in 
            Order.segment_inc[of "ODnods" _ "ordinal_number D"], assumption+,
           cut_tac x = "ordinal_number (Iod D (segment D b))" in 
                         ODnods_less[of _ "ordinal_number D"], assumption+,
           simp)
    apply (frule_tac c = b and a = "ordinal_number (Iod D (segment D b))" in
            ODNmap_self[of D], assumption)
     apply simp
    apply  blast
done 

lemma ODnum_equiv_segment:"⟦Worder D; x = ordinal_number D⟧  ⟹ 
         ord_equiv (Iod ODnods (segment ODnods x)) D"
apply (simp add: ord_equiv_def)  
apply (frule ODNmap_ord_isom[of "D" "x"], assumption+, blast)
done

lemma ODnods_sub_carrier:"S ⊆ ODnums ⟹ carrier (Iod ODnods S) = S"
by (simp add:Iod_def)

lemma ODnum_sub_well_ordered:"S ⊆ ODnums ⟹ Worder (Iod ODnods S)"
apply (cut_tac Torder_ODnods,
       cut_tac Order_ODnods)
 apply (frule Torder.Iod_Torder[of "ODnods" S], 
        simp add:carr_ODnods)
apply intro_locales
 apply (simp add:Torder_def, simp add:Torder_def)

 apply (simp add:Worder_axioms_def,
        rule allI, rule impI, erule conjE)  

(** show existence of the minimum_element of X **)
 apply (frule Order.Iod_carrier[of ODnods S],
        simp add:carr_ODnods, simp)
 apply (frule_tac A = X in nonempty_ex, erule exE)
 apply (frule_tac c = x and A = X and B = S in subsetD, assumption+,
        frule_tac c = x and A = S and B = ODnums in subsetD, assumption+)
 apply (frule_tac X = x in ordinal_numberTr1_1, erule exE, erule conjE)
 apply (frule_tac D = D and x = x in ODnum_equiv_segment) 
 apply (rule ordinal_numberTr4, assumption+, simp add:carr_ODnods, assumption)
 apply (frule_tac D = D and T = "Iod ODnods (segment ODnods x)" in
        Worder.equiv_Worder1,
        rule Order.Iod_Order[of ODnods], assumption,
        rule Order.segment_sub, assumption+)
 apply (frule_tac D = "Iod ODnods (segment ODnods x)" in Worder.ex_minimum)
 apply (case_tac "(segment ODnods x) ∩ X ≠ {}")
 apply (frule_tac a = "segment ODnods x ∩ X" in forall_spec)
  apply (simp add:Order.Iod_carr_segment)
  apply (thin_tac "∀X. X ⊆ carrier (Iod ODnods (segment ODnods x)) ∧ X ≠ {}
         ⟶  (∃xa. minimum_elem (Iod ODnods (segment ODnods x)) X xa)")
  apply (erule exE)
 
 apply (simp add:carr_ODnods[THEN sym])
 apply (frule_tac A = X and B = S and C = "carrier ODnods" in subset_trans,
        assumption+)
apply (frule_tac d = x and m = xa and X = X in 
        Torder.segment_minimum_minimum[of ODnods], assumption+,
        simp add:Int_commute, 
        simp add:Order.minimum_elem_sub[of ODnods S], blast)
 apply (simp,
       thin_tac "∀X. X ⊆ carrier (Iod ODnods (segment ODnods x)) ∧ X ≠ {} ⟶
            (∃xa. minimum_elem (Iod ODnods (segment ODnods x)) X xa)")
 apply (frule_tac A = "segment ODnods x" and B = X in no_meet2)
 apply (simp add:carr_ODnods[THEN sym])
 apply (frule_tac A = X and B = S and C = "carrier ODnods" in subset_trans,
        assumption+)
 apply (frule_tac A = X and B = S and C = "carrier ODnods" in subset_trans,
        assumption+)
 apply (simp add:Order.segment_inc[THEN sym, of ODnods])
 apply (rule contrapos_pp, simp+)
 apply (frule_tac x = x in spec,
        thin_tac "∀x. ¬ minimum_elem (Iod ODnods S) X x")
 apply (simp add:minimum_elem_def, erule bexE)
 apply (frule_tac x = xa in bspec, assumption,
        thin_tac "∀a∈X. a ∉ segment ODnods x",
        frule_tac c = xa and A = X and B = "carrier ODnods" in subsetD,
        assumption+)
 apply (simp add:Order.segment_inc[of ODnods, THEN sym],
        frule_tac c = xa and A = X and B = S in subsetD, assumption+)
 apply (simp add:Order.Iod_le[of ODnods S])
 apply (simp add:Torder.not_le_less)
done

section "Pre elements"  

definition
  ExPre :: "_ ⇒ 'a ⇒ bool" where
  "ExPre D a ⟷ (∃x. x ∈ carrier D ∧ x ≺⇘D⇙ a 
                      ∧ ¬ (∃y∈carrier D. x ≺⇘D⇙ y ∧ y ≺⇘D⇙ a))" 
     (* exists pre element *)

definition
  Pre :: "[_ ,  'a] ⇒ 'a" where
  "Pre D a = (SOME x. x ∈ carrier D ∧ 
                           x ≺⇘D⇙ a ∧
                         ¬ (∃y∈carrier D. x ≺⇘D⇙ y ∧ y ≺⇘D⇙ a))"
     (* Pre element of a *)

lemma (in Order) Pre_mem:"⟦a ∈ carrier D; ExPre D a⟧ ⟹
                Pre D a ∈ carrier D"
apply (simp add:ExPre_def)
 apply (subst Pre_def, rule someI2_ex, blast, simp)
done

lemma (in Order) Not_ExPre:"a ∈ carrier D ⟹ ¬ ExPre (Iod D {a}) a"
apply (simp add:ExPre_def,
       rule allI, rule impI, rule impI,
       frule singleton_sub[of "a" "carrier D"])
apply (simp add:Iod_less Iod_carrier)
done

lemma (in Worder) UniquePre:"⟦a ∈ carrier D; ExPre D a;
 a1 ∈ carrier D ∧ a1 ≺ a ∧ ¬ (∃y∈carrier D. (a1 ≺ y ∧ y ≺ a)) ⟧ ⟹
 Pre D a = a1"
apply (simp add:ExPre_def)
apply (subst Pre_def)        (* definition *)
apply (rule someI2_ex, blast)
apply (erule conjE)+
 apply (thin_tac "∃x. x ∈ carrier D ∧ x ≺ a ∧
                           (∀y∈carrier D. x ≺ y ⟶ ¬ y ≺ a)",
        rename_tac z)
 apply (rule contrapos_pp, simp+) 
 apply (frule_tac a = z and b = a1 in less_linear, assumption+,
        simp)
 apply (erule disjE)
 apply (rotate_tac -4,
        frule_tac x = a1 in bspec, assumption+,
        thin_tac "∀y∈carrier D. z ≺ y ⟶ ¬ y ≺ a",
        thin_tac "∀y∈carrier D. a1 ≺ y ⟶ ¬ y ≺ a", simp)

 apply (frule_tac x = z in bspec, assumption+, simp)
done

lemma (in Order) Pre_element:"⟦a ∈ carrier D; ExPre D a⟧ ⟹ 
      Pre D a ∈ carrier D ∧ (Pre D a) ≺ a ∧
            ¬ (∃y∈carrier D. ((Pre D a) ≺ y ∧ y ≺ a))"
apply (simp add:ExPre_def)
apply (subst Pre_def)+
apply (rule someI2_ex)
apply simp+
done

lemma (in Order) Pre_in_segment:"⟦a ∈ carrier D; ExPre D a⟧ ⟹ 
                  Pre D a ∈ segment D a"
by (frule Pre_element[of "a"], assumption+, (erule conjE)+,
    simp add:segment_inc) 

lemma (in Worder) segment_forall:"⟦a ∈ segment D b; b ∈ carrier D; 
      x ∈ segment D b; x ≺ a; ∀y∈segment D b. x ≺ y ⟶ ¬ y ≺ a⟧ ⟹ 
      ∀y∈carrier D. x ≺ y ⟶ ¬ y ≺ a"
apply (cut_tac segment_sub[of b])
apply (rule ballI, rule impI) 
 apply (case_tac "y ∈ segment D b",
         frule_tac x = y in bspec, assumption+, simp)
(***  
        ------------------a---------------b---------------y----------
***)
 apply (thin_tac "∀y∈segment D b. x ≺ y ⟶ ¬ y ≺ a",
         frule subsetD[of "segment D b" "carrier D" "a"], assumption+,
         frule_tac c = x in subsetD[of "segment D b" "carrier D"], assumption+,
         thin_tac "segment D b ⊆ carrier D",
         thin_tac "x ∈ segment D b")
 apply (simp add:segment_inc[THEN sym, of _ "b"]) apply (
         simp add:not_less_le)
 apply (frule_tac c = y in less_le_trans[of a b], assumption+)
 apply (simp add:less_imp_le)
done

lemma (in Worder) segment_Expre:"a ∈ segment D b ⟹
                   ExPre (Iod D (segment D b)) a = ExPre D a"
apply (case_tac "b ∉ carrier D")
 apply (simp add:segment_def Iod_self[THEN sym])

apply simp
apply (cut_tac segment_sub[of "b"],
       frule subsetD[of "segment D b" "carrier D" a], assumption+)
apply (rule iffI)
 apply (simp add:ExPre_def, erule exE, (erule conjE)+)
 apply (simp add:Iod_carrier Iod_less) 
 apply (frule_tac x = x in segment_forall[of "a" "b"], assumption+)
 apply blast

 apply (simp add:ExPre_def, erule exE, (erule conjE)+)
  apply (frule_tac a = a in segment_inc[of _ b], assumption, simp)
  apply (rule contrapos_pp, simp+)  
  apply (frule_tac x = x in spec,
         thin_tac "∀x. x ≺⇘Iod D (segment D b)⇙ a ⟶
             x ∈ carrier (Iod D (segment D b)) ⟶
             (∃y∈carrier (Iod D (segment D b)).
                 x ≺⇘Iod D (segment D b)⇙ y ∧ y ≺⇘Iod D (segment D b)⇙ a)",
         frule_tac a = x in less_trans[of _ a b], assumption+,
         frule_tac a = x in segment_inc[of _ b], assumption+, simp)
  apply (simp add:Iod_carrier Iod_less)
  apply (erule bexE, erule conjE,
       frule_tac c = y in subsetD[of "segment D b" "carrier D"], assumption+) 
  apply (frule_tac x = y in bspec, assumption,
         thin_tac "∀y∈carrier D. x ≺ y ⟶ ¬ y ≺ a", simp)
done

lemma  (in Worder) Pre_segment:"⟦a ∈ segment D b; 
        ExPre (Iod D (segment D b)) a⟧ ⟹ 
        ExPre D a ∧ Pre D a = Pre (Iod D (segment D b)) a"
apply (frule segment_Expre[of "a" "b"], simp)
apply (case_tac "b ∉ carrier D")
      apply (simp add:segment_def, simp add:Iod_self[THEN sym])
      apply simp

apply (cut_tac segment_sub[of "b"],
       frule subsetD[of "segment D b" "carrier D" "a"], assumption+)
     apply (frule_tac a = a and ?a1.0 = "Pre (Iod D (segment D b)) a" in 
            UniquePre, assumption+)
     apply simp
 apply (cut_tac segment_Worder[of "b"]) 
 apply (frule_tac D = "Iod D (segment D b)" in Worder.Order) 
 apply (frule Order.Pre_element[of "Iod D (segment D b)" a],
        simp add:Iod_carrier, assumption, erule conjE, 
        simp add:Iod_carrier, simp add:subsetD, simp add:Iod_less)
 apply (erule conjE, rule ballI)
 apply (case_tac "y ∈ segment D b",
        frule_tac x = y in bspec, assumption,
        thin_tac "∀y∈segment D b. Pre (Iod D (segment D b)) a ≺ y 
                  ⟶ ¬ y ≺ a",
        simp)
  apply (rule impI)
  apply (frule subsetD[of "segment D b" "carrier D" a], assumption+)
  apply (frule_tac a = y in segment_inc[of _ b], assumption+, simp,
         frule segment_inc[of a b], assumption+, simp)
  apply (simp add:not_less_le)
  apply (frule_tac c = y in less_le_trans[of a b], assumption+,
         simp add:less_imp_le)
  apply assumption
done

lemma (in Worder) Pre2segment:"⟦a ∈ carrier D; b ∈ carrier D; b ≺ a; 
                 ExPre D b⟧ ⟹ ExPre (Iod D (segment D a)) b"
apply (frule segment_inc [of b a], assumption+, simp)
apply (simp add:segment_Expre[of b a])
done

lemma (in Worder) ord_isom_Pre1:"⟦Worder E; a ∈ carrier D; ExPre D a; 
                  ord_isom D E f⟧ ⟹ ExPre E (f a)"
apply (simp add:ExPre_def) 
apply (erule exE,
       frule Worder.Order[of "E"],
       erule conjE,
       frule_tac a = x in ord_isom_mem[of "E" "f"], assumption+,
       frule_tac a = a in ord_isom_mem[of "E" "f"], assumption+,
       erule conjE)
 apply (frule_tac a = x in ord_isom_less[of "E" "f" _ "a"], assumption+, simp)
 apply (frule ord_isom_less_forall[of "E" "f"], assumption+)
 apply (frule_tac x = x and a = a in ord_isom_convert[of "E" "f"],
                             assumption+, simp) apply blast
done      (** Here, ord_isom_convert transforms the inequality **)

lemma (in Worder) ord_isom_Pre11:"⟦Worder E; a ∈ carrier D; ord_isom D E f⟧ 
       ⟹ ExPre D a = ExPre E (f a)"
apply (rule iffI)
 apply (simp add:ord_isom_Pre1)
 apply (frule Worder.Order[of "E"],
        frule ord_isom_sym[of "E" "f"], assumption+)
 apply (cut_tac Worder)
  apply (frule Worder_ord_isom_mem[of "D" "E" "f" "a"], assumption+,
         frule Worder.ord_isom_Pre1[of "E" "D" "f a" 
              "invfun (carrier D) (carrier E) f"], assumption+)
 apply (frule ord_isom_func[of "E" "f"], assumption+)
 apply (simp add:ord_isom_def[of "D" "E" "f"] ord_inj_def, (erule conjE)+,
        thin_tac "∀a∈carrier D. ∀b∈carrier D. a ≺ b = f a ≺⇘E⇙ f b")
 apply (simp add:invfun_l)
done

lemma (in Worder) ord_isom_Pre2:"⟦Worder E; a ∈ carrier D; ExPre D a; 
       ord_isom D E f⟧ ⟹ f (Pre D a) = Pre E (f a)" 
apply (frule_tac E = E and a = a and f = f in ord_isom_Pre1, assumption+,
       frule_tac a = a in Pre_element, assumption+, (erule conjE)+)
 apply (frule Worder.Order[of "E"], 
        frule  ord_isom_mem[of "E" "f" "a"], assumption+,
        frule  ord_isom_mem[of "E" "f" "Pre D a"], assumption+,
        simp add:ord_isom_less[of "E" "f" "Pre D a" "a"]) 
 apply (simp add:ord_isom_convert[of E f "Pre D a" a])
 apply (rule Worder.UniquePre[THEN sym, of "E" "f a" "f (Pre D a)"],
        assumption+, simp) 
done

section "Transfinite induction"

lemma (in Worder) transfinite_induction:"⟦minimum_elem D (carrier D) s0; P s0; ∀t∈carrier D. ((∀u∈ segment D t. P u) ⟶ P t)⟧ ⟹ ∀x∈carrier D. P x" 
apply (rule contrapos_pp, simp+)
 apply (frule bex_nonempty_set[of "carrier D"],
        frule nonempty_set_sub[of "carrier D"])
 apply (cut_tac ex_minimum)
 apply (frule_tac a = "{x ∈ carrier D. ¬ P x}" in forall_spec,
        simp,
        thin_tac "∀X. X ⊆ carrier D ∧ X ≠ {} ⟶ (∃x. minimum_elem D X x)")
  apply (thin_tac "∃x∈carrier D. ¬ P x")
  apply (erule exE)
  apply (frule_tac d = x in less_minimum)
  apply (frule_tac X = "{x ∈ carrier D. ¬ P x}" and a = x in minimum_elem_mem,
         assumption+)
  apply (frule_tac c = x and A = "{x ∈ carrier D. ¬ P x}" and B = "carrier D"
          in subsetD, assumption+) 
  apply (frule_tac x = x in bspec, assumption+,
         thin_tac "∀t∈carrier D. (∀u∈segment D t. P u) ⟶ P t")
  apply (simp add:minimum_elem_def, (erule conjE)+) 
  apply (erule bexE, simp add:segment_def)
done

section ‹‹Ordered_set2›. Lemmas to prove Zorn's lemma.›
 
definition
  adjunct_ord ::"[_ , 'a] ⇒ _" where
  "adjunct_ord D a = D ⦇carrier := carrier D ∪ {a},
                       rel := {(x,y). (x, y) ∈ rel D ∨ 
                                     (x ∈ (carrier D ∪ {a}) ∧ y = a)}⦈ " 

lemma (in Order) carrier_adjunct_ord:
        "carrier (adjunct_ord D a) = carrier D ∪ {a}"
by (simp add:adjunct_ord_def)

lemma (in Order) Order_adjunct_ord:"a ∉ carrier D ⟹ 
                                    Order (adjunct_ord D a)"
apply (cut_tac closed)
apply (rule Order.intro)
 apply (rule subsetI)
 apply (unfold split_paired_all)
 apply simp
 apply (simp add:adjunct_ord_def insert_absorb)
 apply blast

 apply (simp add:carrier_adjunct_ord)
 apply (erule disjE)
 apply (simp add:adjunct_ord_def)
 apply (simp add:adjunct_ord_def)
 apply (simp add:refl)

 apply (simp add:adjunct_ord_def)
  apply (erule disjE)+
  apply simp+
  apply (erule disjE) 
  apply (frule_tac c = "(a, b)" in subsetD[of "rel D" "carrier D × carrier D"],
         assumption+)
  apply blast
  apply simp

  apply (erule disjE)+
  apply (cut_tac closed, simp+)
  apply (frule_tac c = "(a, aa)" in subsetD[of "rel D" 
                              "carrier D × carrier D"], assumption+, simp)
  apply (frule_tac c = "(aa, b)" in subsetD[of "rel D" 
                              "carrier D × carrier D"], assumption+, simp)

  apply (erule disjE)
  apply (frule_tac c = "(b, aa)" in subsetD[of "rel D" 
                              "carrier D × carrier D"], assumption+)
  apply simp+

  apply (erule disjE)+
  apply (rule antisym, assumption+)

  apply (frule_tac c = "(aa, b)" in subsetD[of "rel D" 
                              "carrier D × carrier D"], assumption+)
    apply simp 
 
  apply (erule disjE)
  apply (frule_tac c = "(b, aa)" in subsetD[of "rel D" 
                              "carrier D × carrier D"], assumption+,
         simp, simp)  

apply (simp add:adjunct_ord_def)
 apply (erule disjE)+
 apply blast
 apply blast
 apply blast

apply (erule disjE)
 apply simp
 apply (erule disjE)
 apply (frule_tac c = "(b, c)" in subsetD[of "rel D" 
                              "carrier D × carrier D"], assumption+)
       apply simp apply blast
 apply (erule disjE, blast)
 apply (erule disjE) 
 apply simp
 apply (erule disjE)
 apply (frule_tac c = "(a, b)" in subsetD[of "rel D" 
                              "carrier D × carrier D"], assumption+, simp)
 apply (frule_tac c = "(a, b)" in subsetD[of "rel D" 
                              "carrier D × carrier D"], assumption+, simp)
 apply (erule disjE, simp) apply blast
 apply (erule disjE) apply simp
 apply (erule disjE) apply blast
 apply (erule disjE) 
 apply (frule_tac c = "(a, c)" in subsetD[of "rel D" 
                              "carrier D × carrier D"], assumption+, simp)
 apply blast
 apply (erule disjE)+
 apply blast apply blast apply blast
 apply (erule disjE)
 apply (erule disjE)
 apply (frule_tac a = aa and b = b and c = c in trans, assumption+)
         apply simp
   apply blast
 apply (erule disjE) apply simp apply blast
done

lemma (in Order) adjunct_ord_large_a:"⟦Order D; a ∉ carrier D⟧ ⟹ 
                             ∀x∈carrier D. x ≺⇘adjunct_ord D a⇙ a"
apply (rule ballI)          
apply (subst oless_def)
apply (rule conjI)
apply (simp add:ole_def adjunct_ord_def)
apply (rule contrapos_pp, simp+)
done  

lemma carr_Ssegment_adjunct_ord:"⟦Order D; a ∉ carrier D⟧ ⟹ 
                 carrier D = (Ssegment (adjunct_ord D a) a)" 
apply (rule equalityI)
 apply (rule subsetI)
 apply (simp add:Ssegment_def Order.carrier_adjunct_ord)
 apply (simp add:Order.adjunct_ord_large_a)
 
apply (rule subsetI)
 apply (simp add:Ssegment_def Order.carrier_adjunct_ord)
 apply (erule conjE)
 apply (erule disjE, simp add:oless_def)
 apply assumption
done

lemma (in Order) adjunct_ord_selfD:"a ∉ carrier D ⟹
          D = Iod (adjunct_ord D a) (carrier D)"
apply (simp add:Iod_def)
apply (simp add:adjunct_ord_def)
apply (subgoal_tac "rel D = {(aa, b).
              ((aa, b) ∈ rel D ∨ (aa = a ∨ aa ∈ carrier D) ∧ b = a) ∧
              aa ∈ carrier D ∧ b ∈ carrier D}")
apply simp
apply (rule equalityI)
 apply (rule subsetI)
 apply (cut_tac closed,
        frule_tac c = x in subsetD[of "rel D" "carrier D × carrier D"],
        assumption+)
apply auto
done

lemma Ssegment_adjunct_ord:"⟦Order D; a ∉ carrier D⟧ ⟹ 
          D = SIod (adjunct_ord D a) (Ssegment (adjunct_ord D a) a)" 
apply (simp add: carr_Ssegment_adjunct_ord[THEN sym, of "D" "a"])
apply (frule Order.Order_adjunct_ord[of "D" "a"], assumption+)
apply (cut_tac Order.carrier_adjunct_ord[THEN sym, of "D" "a"])
apply (cut_tac Un_upper1[of "carrier D" "{a}"], simp)
apply (subst SIod_self_le[THEN sym, of "adjunct_ord D a" "D"],
        assumption+)
apply (rule ballI)+
apply (frule_tac c = aa in subsetD[of "carrier D" "carrier (adjunct_ord D a)"],
        assumption,
       frule_tac c = b in subsetD[of "carrier D" "carrier (adjunct_ord D a)"],
        assumption)
apply (simp add:Order.le_rel[of "adjunct_ord D a"])
apply (subst adjunct_ord_def, simp)
 apply (case_tac "b = a", simp) apply simp
 apply (simp add:Order.le_rel[of "D"])
apply simp+
done

lemma (in Order) Torder_adjunction:"⟦X ⊆ carrier D; a ∈ carrier D; 
      ∀x∈X. x ≼ a; Torder (Iod D X)⟧ ⟹ Torder (Iod D (X ∪ {a}))"
apply (frule insert_sub[of "X" "carrier D" "a"], assumption)
apply (subst Torder_def)
apply (frule singleton_sub[of "a" "carrier D"],
       frule Un_least[of "X" "carrier D" "{a}"], assumption) 

apply (rule conjI)
 apply (simp add:Iod_Order[of "insert a X"])
 
 apply (subst Torder_axioms_def)
 apply ((rule allI)+, (rule impI)+)
 apply (simp only:Iod_carrier, simp add:Iod_le)
 apply (erule disjE, simp) apply (erule disjE, simp)
 apply (simp add:le_refl) apply blast
 apply (erule disjE, simp)
 apply (simp add:Torder_def, simp add:Torder_axioms_def)
 apply (simp add:Iod_carrier, erule conjE)
 apply (frule_tac a = aa in forall_spec, assumption,
        thin_tac "∀a. a ∈ X ⟶ (∀b. b ∈ X ⟶ a ≼⇘Iod D X⇙ b ∨ b ≼⇘Iod D X⇙ a)",
        frule_tac a = b in forall_spec, assumption,
        thin_tac "∀b. b ∈ X ⟶ aa ≼⇘Iod D X⇙ b ∨ b ≼⇘Iod D X⇙ aa",
        simp add:Iod_le)
done

lemma Torder_Sadjunction:"⟦Order D; X ⊆ carrier D; a ∈ carrier D; 
      ∀x∈X. x ≼⇘D⇙ a; Torder (SIod D X)⟧ ⟹ Torder (SIod D (X ∪ {a}))"
apply (frule insert_sub[of "X" "carrier D" "a"], assumption)
apply (subst Torder_def)
apply (frule singleton_sub[of "a" "carrier D"],
       frule Un_least[of "X" "carrier D" "{a}"], assumption) 

apply (rule conjI)
 apply (simp add:SIod_Order[of _ "insert a X"])
 
 apply (subst Torder_axioms_def)
 apply ((rule allI)+, (rule impI)+)
 apply (simp only:SIod_carrier, simp add:SIod_le)
 apply (erule disjE, simp) apply (erule disjE, simp)
 apply (simp add:Order.le_refl) apply blast
 apply (erule disjE, simp)
 apply (simp add:Torder_def, simp add:Torder_axioms_def)
 apply (simp add:SIod_carrier, erule conjE)
 apply (frule_tac a = aa in forall_spec, assumption,
       thin_tac "∀a. a ∈ X ⟶ (∀b. b ∈ X ⟶ a ≼⇘SIod D X⇙ b ∨ b ≼⇘SIod D X⇙ a)",
       frule_tac a = b in forall_spec, assumption,
       thin_tac "∀b. b ∈ X ⟶ aa ≼⇘SIod D X⇙ b ∨ b ≼⇘SIod D X⇙ aa",
        simp add:SIod_le)
done

lemma (in Torder) Torder_adjunct_ord:"a ∉ carrier D ⟹ 
                                       Torder (adjunct_ord D a)"
apply (frule Order_adjunct_ord[of "a"],
       cut_tac carrier_adjunct_ord[THEN sym, of a],
       cut_tac Un_upper1[of "carrier D" "{a}"], simp,
       frule Order.Torder_adjunction[of "adjunct_ord D a" "carrier D" a],
       assumption+)
 apply (simp add:carrier_adjunct_ord)
 apply (cut_tac adjunct_ord_large_a[of a],
        rule ballI, 
        frule_tac x = x in bspec, assumption,
              thin_tac "∀x∈carrier D. x ≺⇘adjunct_ord D a⇙ a",
        cut_tac insertI1[of a "carrier D"], simp,
        frule_tac c = x in subsetD[of "carrier D" "carrier (adjunct_ord D a)"],
         assumption+,
        simp add:Order.less_imp_le, rule Order,
        assumption+)
 apply (simp add:adjunct_ord_selfD[THEN sym])
prefer 2
 apply (simp add:Order.Iod_self[THEN sym, of "adjunct_ord D a"])
apply (unfold_locales) 
done

lemma (in Order) well_ord_adjunction:"⟦X ⊆ carrier D; a ∈ carrier D; 
      ∀x∈X. x ≼ a; Worder (Iod D X)⟧ ⟹ Worder (Iod D (X ∪ {a}))"
apply (frule insert_sub[of "X" "carrier D" "a"], assumption)
apply (subst Worder_def)
 apply (simp add:Iod_Order)
 apply (frule_tac Torder_adjunction[of X a], assumption+)
 apply (simp add:Worder.Torder)
 apply (simp add:Torder_def)

apply (subst Worder_axioms_def)
 apply (rule allI, rule impI, erule conjE)
 apply (simp add:Iod_carrier)
 apply (cut_tac insert_inc1[of "X" "a"])

 apply (case_tac "Xa ⊆ X")
 apply (simp only:Worder_def, (erule conjE)+) apply (
        simp only:Worder_axioms_def)
 apply (frule_tac a = Xa in forall_spec,
        thin_tac "∀Xa. Xa ⊆ carrier (Iod D X) ∧ Xa ≠ {} ⟶
               (∃x. minimum_elem (Iod D X) Xa x)",
        simp add:Iod_carrier)
 apply (thin_tac "∀Xa. Xa ⊆ carrier (Iod D X) ∧ Xa ≠ {} ⟶
               (∃x. minimum_elem (Iod D X) Xa x)",
        erule exE)
 apply (frule_tac X = Xa and a = x in Order.minimum_elem_sub[of 
         "Iod D (insert a X)" "X"])
  apply (cut_tac insert_inc1[of "X" "a"], simp add:Iod_carrier, assumption+)
 apply (cut_tac insert_inc1[of "X" "a"],
        simp add:Iod_sub_sub) apply blast
 apply (erule conjE,
       frule_tac A = Xa in insert_diff[of _ "a" "X"])
 apply (case_tac "Xa - {a} = {}")
 apply (frule_tac A = Xa in nonempty_ex, erule exE, simp, 
        frule_tac c = x and A = Xa and B = "{a}" in subsetD, assumption+,
        simp, 
        frule_tac A = Xa in singleton_sub[of "a"],
        frule_tac A = Xa and B = "{a}" in equalityI, assumption+, simp)
 apply (simp add:minimum_elem_def)
 apply (cut_tac insert_inc2[of "a" "X"],
        simp add:Iod_le le_refl)

 apply (simp only:Worder_def, (erule conjE)+,
        simp only:Worder_axioms_def)
 apply (frule_tac a = "Xa - {a}" in forall_spec, 
        thin_tac "∀Xa. Xa ⊆ carrier (Iod D X) ∧ Xa ≠ {} ⟶
               (∃x. minimum_elem (Iod D X) Xa x)", simp add:Iod_carrier)
 apply (thin_tac "∀Xa. Xa ⊆ carrier (Iod D X) ∧ Xa ≠ {} ⟶
               (∃x. minimum_elem (Iod D X) Xa x)", erule exE)
 apply (frule_tac Y = Xa and x = x in augmented_set_minimum[of "X" "a"],
        assumption+, blast)
done

lemma well_ord_Sadjunction:"⟦Order D; X ⊆ carrier D; a ∈ carrier D; 
      ∀x∈X. x ≼⇘D⇙ a; Worder (SIod D X)⟧ ⟹ Worder (SIod D (X ∪ {a}))"
apply (frule insert_sub[of "X" "carrier D" "a"], assumption)
apply (subst Worder_def)
 apply (simp add:SIod_Order)
 apply (frule Torder_Sadjunction[of D X a], assumption+)
 apply (simp add:Worder.Torder)
 apply (simp add:Torder_def)

 apply (subst Worder_axioms_def)
 apply (rule allI, rule impI, erule conjE)
 apply (simp add:SIod_carrier)
 apply (cut_tac insert_inc1[of "X" "a"])

 apply (case_tac "Xa ⊆ X")
 apply (simp only:Worder_def, (erule conjE)+) apply (
        simp only:Worder_axioms_def)
 apply (frule_tac a = Xa in forall_spec,
        thin_tac "∀Xa. Xa ⊆ carrier (SIod D X) ∧ Xa ≠ {} ⟶
               (∃x. minimum_elem (SIod D X) Xa x)",
        simp add:SIod_carrier)
 apply (thin_tac "∀Xa. Xa ⊆ carrier (SIod D X) ∧ Xa ≠ {} ⟶
               (∃x. minimum_elem (SIod D X) Xa x)",
        erule exE)
 apply (frule_tac X = Xa and a = x in minimum_elem_Ssub[of 
         "SIod D (insert a X)" "X"])
  apply (cut_tac insert_inc1[of "X" "a"], simp add:SIod_carrier, assumption+)
 apply (cut_tac insert_inc1[of "X" "a"],
        simp add:SIod_sub_sub) apply blast

 apply (erule conjE, frule_tac A = Xa in insert_diff[of _ "a" "X"])
 apply (case_tac "Xa - {a} = {}")
 apply (frule_tac A = Xa in nonempty_ex, erule exE, simp, 
        frule_tac c = x and A = Xa and B = "{a}" in subsetD, assumption+,
        simp, 
        frule_tac A = Xa in singleton_sub[of "a"],
        frule_tac A = Xa and B = "{a}" in equalityI, assumption+, simp)
 apply (simp add:minimum_elem_def)
 apply (cut_tac insert_inc2[of "a" "X"],
        simp add:SIod_le Order.le_refl)

 apply (simp only:Worder_def, (erule conjE)+,
        simp only:Worder_axioms_def)
 apply (frule_tac a = "Xa - {a}" in forall_spec, 
        thin_tac "∀Xa. Xa ⊆ carrier (SIod D X) ∧ Xa ≠ {} ⟶
               (∃x. minimum_elem (SIod D X) Xa x)", simp add:SIod_carrier)
 apply (thin_tac "∀Xa. Xa ⊆ carrier (SIod D X) ∧ Xa ≠ {} ⟶
               (∃x. minimum_elem (SIod D X) Xa x)", erule exE)
 apply (frule_tac Y = Xa and x = x in augmented_Sset_minimum[of "D" "X" "a"],
        assumption+, blast) 
done

lemma (in Worder) Worder_adjunct_ord:"a ∉ carrier D ⟹ 
                                       Worder (adjunct_ord D a)"
apply (frule Torder_adjunct_ord[of a])
 apply (intro_locales)
 apply (simp add:Torder_def)
 apply (simp add:Torder_def)

 apply (cut_tac carrier_adjunct_ord[THEN sym, of a],
       cut_tac Un_upper1[of "carrier D" "{a}"], simp)
 apply (simp add:Torder_def, erule conjE) 
 apply (cut_tac insertI1[of a "carrier D" ])
 apply (frule Order.well_ord_adjunction[of "adjunct_ord D a" "carrier D" a],
        assumption+)
 apply (frule sym, thin_tac "insert a (carrier D) = carrier (adjunct_ord D a)",
        simp)
 apply (cut_tac adjunct_ord_large_a[of a],
        rule ballI, 
        frule_tac x = x in bspec, assumption,
              thin_tac "∀x∈carrier D. x ≺⇘adjunct_ord D a⇙ a",
        cut_tac insertI1[of a "carrier D"], simp,
        frule_tac c = x in subsetD[of "carrier D" "carrier (adjunct_ord D a)"],
         assumption+,
        simp add:Order.less_imp_le, rule Order,
        assumption+)
  apply (simp add:adjunct_ord_selfD[THEN sym])
  prefer 2
  apply (simp add:Order.Iod_self[THEN sym, of "adjunct_ord D a"] Worder_def)
  apply unfold_locales
done
 
section "Zorn's lemma"

definition
  Chain :: "_ ⇒ 'a set ⇒ bool" where
  "Chain D C ⟷ C ⊆ carrier D ∧ Torder (Iod D C)" 

definition
  upper_bound :: "[_, 'a set, 'a] ⇒ bool"
    (‹(3ubı/ _/ _)› [100,101]100) where
  "ub⇘D⇙ S b ⟷ b ∈ carrier D ∧ (∀s∈S. s ≼⇘D⇙ b)" 

definition
  "inductive_set" :: "_ ⇒ bool" where
  "inductive_set D ⟷ (∀C. (Chain D C ⟶ (∃b. ub⇘D⇙ C b)))"

definition
  maximal_element :: "[_, 'a] ⇒ bool"  (‹(maximalı/ _)› [101]100) where
  "maximal⇘D⇙ m ⟷ m ∈ carrier D ∧ (∀b∈carrier D. m ≼⇘D⇙ b ⟶ m = b)"

definition
  upper_bounds::"[_, 'a set] ⇒ 'a set" where
  "upper_bounds D H = {x. ub⇘D⇙ H x}"

definition
  Sup :: "[_, 'a set] ⇒ 'a" where
  "Sup D X = (THE x. minimum_elem D (upper_bounds D X) x)"

definition
  S_inductive_set :: "_ ⇒ bool" where
  "S_inductive_set D ⟷ (∀C. Chain D C ⟶ 
    (∃x∈carrier D. minimum_elem D (upper_bounds D C) x))" 

lemma (in Order) mem_upper_bounds:"⟦X ⊆ carrier D; b ∈ carrier D; 
                 ∀x∈X. x ≼ b⟧ ⟹ ub X b"
apply (simp add:upper_bounds_def upper_bound_def)
done  

lemma (in Order) Torder_Chain:"⟦X ⊆ carrier D; Torder (Iod D X)⟧
       ⟹ Chain D X"
apply (simp add:Chain_def Torder_def) 
done

lemma (in Order) Chain_Torder:"Chain D X ⟹ 
                                   Torder (Iod D X)"
apply (simp add:Chain_def) 
done

lemma (in Order) Chain_sub:"Chain D X ⟹ X ⊆ carrier D"
apply (simp add:Chain_def)
done

lemma (in Order) Chain_sub_Chain:"⟦Chain D X; Y ⊆ X ⟧ ⟹ Chain D Y"
apply (frule Chain_sub[of "X"],
       frule Chain_Torder[of "X"],
       frule Torder.Iod_Torder[of "Iod D X" "Y"], simp add:Iod_carrier)
apply (simp add:Iod_sub_sub[of "Y" "X"],
       frule subset_trans[of "Y" "X" "carrier D"], assumption+)
apply (simp add:Torder_Chain[of "Y"])
done

lemma (in Order) upper_bounds_sub:"X ⊆ carrier D ⟹ 
                           upper_bounds D X ⊆ carrier D"
by (rule subsetI, simp add:upper_bounds_def upper_bound_def)


lemma (in Order) Sup:"⟦X ⊆ carrier D; minimum_elem D (upper_bounds D X) a⟧ ⟹                        Sup D X = a"
apply (subst Sup_def)
apply (rule the_equality, assumption,
       rule_tac ?a1.0 = x in minimum_elem_unique[of "upper_bounds D X" _ "a"])
 apply (rule subsetI, thin_tac "minimum_elem D (upper_bounds D X) a",
        thin_tac "minimum_elem D (upper_bounds D X) x",
        simp add:upper_bounds_def upper_bound_def)
 apply assumption+
done 

lemma (in Worder) Sup_mem:"⟦X ⊆ carrier D; ∃b. ub X b⟧ ⟹ 
                  Sup D X ∈ carrier D"
apply (frule upper_bounds_sub[of "X"],
       frule minimum_elem_mem[of "upper_bounds D X" "Sup D X"],
       simp add:Sup_def, rule theI')
 apply (rule ex_ex1I)
apply (cut_tac ex_minimum)
apply (frule_tac a = "upper_bounds D X" in forall_spec,
        thin_tac "∀X. X ⊆ carrier D ∧ X ≠ {} ⟶ (∃x. minimum_elem D X x)",
        simp, erule exE)
 apply (rule_tac x = b in nonempty[of _ "upper_bounds D X"],
       simp add:upper_bounds_def, assumption,
       rule_tac ?a1.0 = x and ?a2.0 = y in minimum_elem_unique[of 
         "upper_bounds D X"], assumption+,
       simp add:upper_bounds_def upper_bound_def)
done 

lemma (in Order) S_inductive_sup:"⟦S_inductive_set D; Chain D X⟧ ⟹
                             minimum_elem D (upper_bounds D X) (Sup D X)"
 apply (simp add:S_inductive_set_def) 
 apply (frule_tac a = X in forall_spec, assumption,
        thin_tac "∀C. Chain D C ⟶ (∃x∈carrier D. minimum_elem D 
                     (upper_bounds D C) x)")
 apply (erule bexE)
 apply (frule Chain_sub[of "X"])
 apply (frule_tac a = x in  Sup[of "X" ], assumption+)
 apply simp
done 

lemma (in Order) adjunct_Chain:"⟦Chain D X; b ∈ carrier D; ∀x∈X. x ≼ b⟧ ⟹
                 Chain D (insert b X)" 
apply (simp add:Chain_def, erule conjE)
apply (frule Torder_adjunction[of X b], assumption+)
apply simp
done

lemma (in Order) S_inductive_sup_mem:"⟦S_inductive_set D; Chain D X⟧ ⟹
                             Sup D X ∈ carrier D"
apply (frule_tac  X = X in S_inductive_sup, assumption)
apply (simp add:minimum_elem_def, (erule conjE)+,
       simp add:upper_bounds_def, simp add:upper_bound_def)
done

lemma (in Order) S_inductive_Sup_min_bounds:"⟦S_inductive_set D; Chain D X;
       ub X b⟧ ⟹  Sup D X ≼ b"
apply (frule S_inductive_sup[of "X"], assumption+,
       simp add:minimum_elem_def, erule conjE)
apply (frule_tac x = b in bspec,
       simp add:upper_bounds_def, assumption)
done

lemma (in Order) S_inductive_sup_bound:"⟦S_inductive_set D; Chain D X⟧ ⟹
                                        ∀x∈X. x ≼ (Sup D X)"
apply (frule_tac X = X in S_inductive_sup, assumption+) 
apply (rule ballI)
apply (simp add:minimum_elem_def) apply (erule conjE)
 apply (thin_tac "∀x∈upper_bounds D X.  Sup D X ≼ x")
 apply (simp add:upper_bounds_def upper_bound_def) 
done

lemma (in Order) S_inductive_Sup_in_ChainTr:
 "⟦S_inductive_set D; Chain D X; c ∈ carrier (Iod D (insert (Sup D X) X)); 
  Sup D X ∉ X;
   ∀y∈carrier (Iod D (insert (Sup D X) X)). 
    c ≺⇘Iod D (insert (Sup D X) X)⇙ y ⟶ ¬ y ≺⇘Iod D (insert (Sup D X) X)⇙ Sup D X⟧ ⟹ 
    c ∈ upper_bounds D X"
apply (subst upper_bounds_def, simp add:upper_bound_def)
apply (frule Chain_sub[of X],
       frule S_inductive_sup_mem[of X], assumption+,
       frule insert_sub[of X "carrier D" "Sup D X"], assumption)
apply (rule conjI)
 apply (simp add:Iod_carrier,
       frule Chain_sub[of X],
       frule insert_sub[of X "carrier D" "Sup D X"], assumption,
       erule disjE, simp, simp add:subsetD)

apply (rule ballI)
 apply (simp add:Iod_carrier, (erule conjE)+,
        frule S_inductive_sup_bound[of X], assumption+)
 apply (erule disjE, simp)
 apply (frule_tac x = s in bspec, assumption,
        thin_tac "∀y∈X. c ≺⇘Iod D (insert (Sup D X) X)⇙ y ⟶
               ¬ y ≺⇘Iod D (insert (Sup D X) X)⇙ Sup D X",
        frule_tac x = s in bspec, assumption,
        thin_tac "∀x∈X. x ≼ Sup D X") 
 apply (frule insert_sub[of X "carrier D" "Sup D X"], assumption+,
        cut_tac subset_insertI[of X "Sup D X"],
        frule_tac c = s in subsetD[of X "insert (Sup D X) X"], assumption+,
        frule_tac c = c in subsetD[of X "insert (Sup D X) X"], assumption+,
        frule Iod_Order[of "insert (Sup D X) X"])
 apply (subst Iod_le[THEN sym, of "insert (Sup D X) X"], assumption+,
        rule contrapos_pp, (simp del:insert_subset)+)
 apply (frule Torder_adjunction [of "X" "Sup D X"], assumption+,
        rule S_inductive_sup_bound[of X], assumption+, simp add:Chain_Torder)
 apply (frule_tac a = s and b = c in 
                  Torder.not_le_less[of "Iod D (X ∪ {Sup D X})"])
 apply (simp add:Iod_carrier, simp add:subsetD,
        simp add:Iod_carrier)
 apply (thin_tac "c ≺⇘Iod D (insert (Sup D X) X)⇙ Sup D X ⟶
         ¬ Sup D X ≺⇘Iod D (insert (Sup D X) X)⇙ Sup D X")
 apply (simp del:insert_sub,
        frule_tac a = s in 
        Torder.not_less_le[of "Iod D (insert (Sup D X) X)" _ "Sup D X"])
 apply (frule insert_sub[of X "carrier D" "Sup D X"], assumption, 
        simp add:Iod_carrier subsetD,
        frule insert_sub[of X "carrier D" "Sup D X"], assumption,
        simp add:Iod_carrier)
 apply simp
 apply (simp add:Iod_le)
 apply (frule_tac c = s in subsetD[of X "carrier D"], assumption+,
        frule_tac a = s and b = "Sup D X" in le_antisym, assumption+)
 apply simp
done   

lemma (in Order) S_inductive_Sup_in_Chain:"⟦S_inductive_set D; Chain D X;
       ExPre (Iod D (insert (Sup D X) X)) (Sup D X)⟧ ⟹ Sup D X ∈ X"
apply (frule S_inductive_sup_mem[of X], assumption+)
apply (frule Chain_sub[of X],
       frule insert_sub[of X "carrier D" "Sup D X"], assumption)
apply (rule contrapos_pp, (simp del:insert_subset)+)
 apply (frule Iod_Order[of "insert (Sup D X) X"])
 apply (frule Order.Pre_element[of "Iod D (insert (Sup D X) X)" "Sup D X"])
  apply (simp add:Iod_carrier) apply assumption
  apply ((erule conjE)+, simp del:insert_subset)
  apply (frule S_inductive_Sup_in_ChainTr[of X 
               "Pre (Iod D (insert (Sup D X) X)) (Sup D X)"], assumption+)
  apply (simp add:upper_bounds_def)
  apply (frule S_inductive_Sup_min_bounds[of X 
               "Pre (Iod D (insert (Sup D X) X)) (Sup D X)"], assumption+,
         thin_tac "∀y∈carrier (Iod D (insert (Sup D X) X)).
        Pre (Iod D (insert (Sup D X) X)) (Sup D X) ≺⇘Iod D (insert (Sup D X) X)⇙
        y ⟶  ¬ y ≺⇘Iod D (insert (Sup D X) X)⇙ Sup D X")
  apply (frule Order.less_le_trans[of "Iod D (insert (Sup D X) X)" 
      "Pre (Iod D (insert (Sup D X) X)) (Sup D X)"
      "Sup D X" "Pre (Iod D (insert (Sup D X) X)) (Sup D X)"])
  apply assumption+
  
  apply (frule insert_sub[of X "carrier D" "Sup D X"], assumption,
        simp add:Iod_carrier) apply assumption+
   apply (frule insert_sub[of X "carrier D" "Sup D X"], assumption,
        simp add:Iod_carrier Iod_le) 
   apply (simp add:oless_def)
done

lemma (in Order) S_inductive_bounds_compare:"⟦S_inductive_set D; Chain D X1;
       Chain D X2; X1 ⊆ X2⟧ ⟹ upper_bounds D X2 ⊆ upper_bounds D X1 " 
apply (rule subsetI,
       simp add:upper_bounds_def upper_bound_def,
       erule conjE, rule ballI,
       frule_tac c = s in subsetD[of "X1" "X2"], assumption+) 
 apply simp
done

lemma (in Order) S_inductive_sup_compare:"⟦S_inductive_set D; Chain D X1;
       Chain D X2; X1 ⊆ X2⟧ ⟹ Sup D X1 ≼  Sup D X2" 
 apply (frule S_inductive_bounds_compare[of "X1" "X2"], assumption+,
        frule Chain_sub[of "X1"], frule Chain_sub[of "X2"],
        frule upper_bounds_sub[of "X1"], frule upper_bounds_sub[of "X2"])
 apply (rule_tac s = "Sup D X2" and t = "Sup D X1" in 
       compare_minimum_elements[of "upper_bounds D X2" "upper_bounds D X1"],
       assumption+,
       simp add:S_inductive_sup, simp add:S_inductive_sup)
done

definition
  Wa :: "[_, 'a set, 'a ⇒ 'a, 'a] ⇒ bool" where
  "Wa D W g a ⟷ W ⊆ carrier D ∧ Worder (Iod D W) ∧ a ∈ W ∧ (∀x∈W. a ≼⇘D⇙ x) ∧ 
    (∀x∈W. (if (ExPre (Iod D W) x) then  g (Pre (Iod D W) x) = x else
    (if a ≠ x then Sup D (segment (Iod D W) x) = x else a = a)))"

definition 
  WWa :: "[_, 'a ⇒ 'a, 'a] ⇒ 'a set set" where
  "WWa D g a = {W. Wa D W g a}"
 
lemma (in Order) mem_of_WWa:"⟦W ⊆ carrier D; Worder (Iod D W); a ∈ W;
  (∀x∈W. a ≼ x); 
  (∀x∈W. (if (ExPre (Iod D W) x) then  g (Pre (Iod D W) x) = x else
  (if a ≠ x then Sup D (segment (Iod D W) x) = x else a = a)))⟧ ⟹
       W ∈ WWa D g a"
by (simp add:WWa_def, simp add:Wa_def)

lemma (in Order) mem_WWa_then:"W ∈ WWa D g a ⟹ W ⊆ carrier D ∧ 
  Worder (Iod D W) ∧ a ∈ W ∧ (∀x∈W. a ≼ x) ∧ 
  (∀x∈W. (if (ExPre (Iod D W) x) then  g (Pre (Iod D W) x) = x else
  (if a ≠ x then Sup D (segment (Iod D W) x) = x else a = a)))" 
by (simp add:WWa_def Wa_def)
    
lemma (in Order) mem_wwa_Worder:"W ∈ WWa D g a ⟹ Worder (Iod D W)"
by (simp add:WWa_def Wa_def)

lemma (in Order) mem_WWa_sub_carrier:"W ∈ WWa D g a ⟹ W ⊆ carrier D"
by (simp add:WWa_def Wa_def)

lemma (in Order) Union_WWa_sub_carrier:"⋃ (WWa D g a) ⊆ carrier D"
by (rule Union_least[of "WWa D g a" "carrier D"], simp add:mem_WWa_sub_carrier)

lemma (in Order) mem_WWa_inc_a:"W ∈ WWa D g a ⟹ a ∈ W"
by (simp add:WWa_def Wa_def)

lemma (in Order) mem_WWa_Chain:"W ∈ WWa D g a ⟹ Chain D W"
apply (simp add:Chain_def)
 apply (simp add:mem_WWa_sub_carrier)
 apply (frule mem_wwa_Worder[of "W"])
 apply (simp add:Worder.Torder)
done

lemma (in Order) Sup_adjunct_Sup:"⟦S_inductive_set D; 
      f ∈ carrier D → carrier D; a ∈ carrier D; ∀x∈carrier D. x ≼ f x; 
      W ∈ WWa D f a; Sup D W ∉ W⟧
      ⟹ Sup D (insert (Sup D W) W) = Sup D W"
(** use 
             le_antisym
At first applying le_antisym, we see following four items should be proved.
             Sup D W ∈ carrier D
             Sup D (insert (Sup D W) W) ∈ carrier D
             Sup D W ≼ Sup D (insert (Sup D W) W)
             Sup D (insert (Sup D W) W) ≼ Sup D W
To show Sup D W ∈ carrier D, we apply S_inductive_Sup_mem.     
 **)
apply (frule mem_WWa_Chain[of "W"],
       frule S_inductive_sup_bound[of "W"], assumption,
       frule mem_wwa_Worder[of "W"],
       frule mem_WWa_sub_carrier[of "W"],
       frule S_inductive_sup_mem[of "W"], assumption+) 
apply (frule well_ord_adjunction[of "W" "Sup D W"], assumption+, simp,
       frule insert_sub[of "W" "carrier D" "Sup D W"], assumption+,
       frule Worder.Torder[of "Iod D (insert (Sup D W) W)"],
          frule Torder_Chain[of "insert (Sup D W) W"], assumption+,
       frule S_inductive_sup_mem[of "insert (Sup D W) W"], assumption+)
apply (rule le_antisym[of "Sup D (insert (Sup D W) W)" "Sup D W"], assumption+,
       rule S_inductive_Sup_min_bounds[of "insert (Sup D W) W" "Sup D W"],
             assumption+,
       simp add:upper_bound_def, simp add:le_refl)
apply (rule S_inductive_sup_compare[of "W" "insert (Sup D W) W"], assumption+)
apply (simp add:subset_insertI[of "W" "Sup D W"])
done

lemma (in Order) BNTr1:"a ∈ carrier D ⟹ Worder (Iod D {a})"
apply intro_locales
apply (frule singleton_sub[of "a" "carrier D"],
       rule Iod_Order[of "{a}"], assumption)
 apply (simp add:Torder_axioms_def)
 apply (rule allI, rule impI)+
 apply (simp add:Iod_carrier, simp add:Iod_le le_refl)
apply (simp add:Worder_axioms_def)
 apply (rule allI, rule impI, erule conjE, simp add:Iod_carrier) 
 apply (frule_tac A = X in nonempty_ex, erule exE,
        frule_tac c = x and A = X and B = "{a}" in subsetD, assumption+,
        simp, 
        frule_tac A = X in singleton_sub[of "a"],
        frule_tac A = X and B = "{a}" in equalityI, assumption+, simp)
apply (simp add:minimum_elem_def Iod_le le_refl)
done
 
lemma (in Order) BNTr2:"⟦f ∈ carrier D → carrier D;  a ∈ carrier D; 
                         ∀x∈carrier D. x ≼ (f x)⟧ ⟹ {a} ∈ WWa D f a"
apply (simp add:WWa_def Wa_def) 
apply (simp add:Not_ExPre[of "a"])
 apply (simp add:BNTr1 le_refl)
done
 
lemma (in Order) BNTr2_1:"⟦f ∈ carrier D → carrier D;  a ∈ carrier D; 
       ∀x∈carrier D. x ≼ (f x); W ∈ WWa D f a⟧ ⟹ ∀x∈W. a ≼ x"
by (rule ballI, simp add:WWa_def Wa_def)
     
lemma (in Order) BNTr3:"⟦f ∈ carrier D → carrier D; a ∈ carrier D; 
       ∀x∈carrier D. x ≼ (f x); W ∈ WWa D f a⟧ ⟹ minimum_elem (Iod D W) W a"
(** a ∈ W is required by minimum_elem_def and Iod_le *)
apply (frule mem_WWa_inc_a[of W])
apply (subst minimum_elem_def)
 apply simp
 apply (rule ballI)
 apply (frule mem_WWa_sub_carrier[of W f a])
 apply (frule BNTr2_1[of f a W], assumption+)
 apply (simp add:Iod_le)
done

lemma (in Order) Adjunct_segment_sub:"⟦S_inductive_set D; Chain D X⟧ ⟹
       segment (Iod D (insert (Sup D X) X)) (Sup D X) ⊆  X"
 apply (frule S_inductive_sup_mem[of "X"], assumption+,
        frule Chain_sub[of "X"],
        frule insert_sub[of "X" "carrier D" "Sup D X"], assumption)
apply (rule subsetI)
 apply (simp add:segment_def)
 apply (case_tac "Sup D X ∉ carrier (Iod D (insert (Sup D X) X))", simp)
 apply (simp add:Iod_carrier)
 
 apply (simp add:Iod_carrier, erule conjE, simp add:oless_def)
done

lemma (in Order) Adjunct_segment_eq:"⟦S_inductive_set D; Chain D X;
                Sup D X ∉ X⟧ ⟹
       segment (Iod D (insert (Sup D X) X)) (Sup D X) = X"
apply (frule Chain_sub[of "X"],
       frule Adjunct_segment_sub[of "X"], assumption)
apply (rule equalityI, assumption)
apply (frule S_inductive_sup_mem[of "X"], assumption+,
       frule insert_sub[of "X" "carrier D" "Sup D X"], assumption+,
       rule subsetI,
       simp add:segment_def Iod_carrier,
       cut_tac subset_insertI[of "X" "Sup D X"],
       cut_tac insertI1[of "Sup D X" "X"],
       frule_tac c = x in subsetD[of "X" "insert (Sup D X) X"], assumption+)
apply (simp add:Iod_less[of "insert (Sup D X) X"],
       frule S_inductive_sup_bound[of "X"], assumption+,
       frule_tac x = x in bspec, assumption+,
       thin_tac "∀x∈X. x ≼ Sup D X",
       simp add:oless_def)
apply (rule contrapos_pp, simp+)
done

definition
  fixp :: "['a ⇒ 'a, 'a] ⇒ bool" where
  "fixp f a ⟷ f a = a"    (** a is a fixed point of f **)

lemma (in Order) fixp_same:"⟦W1 ⊆ carrier D; W2 ⊆ carrier D; t ∈ W1; 
 b ∈ carrier D; ord_isom (Iod D W1) (Iod (Iod D W2) (segment (Iod D W2) b)) g;
 ∀u∈segment (Iod D W1) t. fixp g u⟧ ⟹ 
          segment (Iod D W1) t = segment (Iod D W2) (g t)"

 apply (frule Iod_Order[of "W1"],
        frule Iod_Order[of "W2"],
        frule Order.segment_sub[of "Iod D W1" "t"],
        frule Order.segment_sub[of "Iod D W2" "b"],
        frule Order.Iod_Order[of "Iod D W2" "segment (Iod D W2) b"], 
        assumption+)
 apply (frule Order.ord_isom_segment_segment[of "Iod D W1" 
               "Iod (Iod D W2) (segment (Iod D W2) b)" g t], assumption+)
       apply (simp add:Iod_carrier, simp add:Iod_carrier)
       apply (frule Order.ord_isom_mem[of "Iod D W1" 
              "Iod (Iod D W2) (segment (Iod D W2) b)" g t], assumption+,
               simp add:Iod_carrier)
       apply (frule Order.Iod_segment_segment[of "Iod D W2" "g t" b],
                           assumption, simp)
       apply (simp add:Iod_sub_sub[of "segment (Iod D W1) t" W1])
       apply (frule Order.segment_sub [of "Iod (Iod D W2) 
                                        (segment (Iod D W2) b)" "g t"])
       apply (simp add:Iod_sub_sub)
       apply (frule subset_trans[of "segment (Iod D W2) b" W2 "carrier D"],
                     assumption+)
       apply (simp add:Iod_carrier)
       apply (frule Order.segment_sub[of "Iod D W2" "g t"], 
              simp add:Iod_carrier[of W2])
       apply (simp add:Iod_sub_sub[of "segment (Iod D W2) (g t)" W2],
              thin_tac "Iod (Iod D (segment (Iod D W2) b))
                       (segment (Iod D (segment (Iod D W2) b)) (g t)) =
                        Iod D (segment (Iod D W2) (g t))")
       apply (frule subset_trans[of "segment (Iod D W1) t" W1 "carrier D"],
              assumption+,
              frule subset_trans[of "segment (Iod D W2) (g t)" W2 "carrier D"],
              assumption+,
              frule Iod_Order[of "segment (Iod D W1) t"],
              frule Iod_Order[of "segment (Iod D W2) (g t)"])
       apply (thin_tac "segment (Iod D (segment (Iod D W2) b)) (g t) ⊆
                          segment (Iod D W2) b",
              thin_tac "segment (Iod D W2) b ⊆ carrier D",
              thin_tac "segment (Iod D W2) (g t) ⊆ W2",
              thin_tac "ord_isom (Iod D W1) (Iod D (segment (Iod D W2) b)) g")
apply (rule equalityI)
 apply (rule subsetI) 
 apply (frule_tac a = x in Order.ord_isom_mem[of "Iod D (segment (Iod D W1) t)"
       "Iod D (segment (Iod D W2) (g t))" 
         "restrict g (carrier (Iod D (segment (Iod D W1) t)))"], assumption+,
        simp add:Iod_carrier, simp add:Iod_carrier, simp add:fixp_def)
apply (metis Order.Iod_carrier [OF Order_axioms])
 apply (rule subsetI)
 apply (frule_tac b = x in Order.ord_isom_surj[of 
         "Iod D (segment (Iod D W1) t)" "Iod D (segment (Iod D W2) (g t))" 
         "restrict g (carrier (Iod D (segment (Iod D W1) t)))"]) 
apply assumption
apply (metis Order.Iod_carrier [OF Order_axioms])
apply (metis Order.Iod_carrier [OF Order_axioms] Order.segment_free [OF Order_axioms])
apply (metis Order.Iod_carrier [OF Order_axioms] fixp_def restrict_apply)
done

lemma (in Order) BNTr4_1:"⟦f ∈ carrier D → carrier D;  a ∈ carrier D; 
     b ∈ carrier D; ∀x∈carrier D. x ≼ (f x); W1 ∈ WWa D f a; W2 ∈ WWa D f a;
     ord_isom (Iod D W1) (Iod D (segment (Iod D W2) b)) g⟧ ⟹ 
     ∀x∈W1. g x = x"
 apply (frule mem_wwa_Worder[of "W1" "f" "a"],
        frule mem_wwa_Worder[of "W2" "f" "a"],
        frule Worder.Order[of "Iod D W2"],
        frule mem_WWa_sub_carrier[of "W2" "f" "a"],
        frule mem_WWa_sub_carrier[of "W1" "f" "a"],
        cut_tac  Worder.segment_Worder[of "Iod D W2" "b"],
        simp add:Worder.Order)
  apply (cut_tac Order.segment_sub[of "Iod D W2" "b"],
                   simp add:Iod_carrier,
         frule subset_trans[of "segment (Iod D W2) b" "W2" "carrier D"],
                   assumption+,
         frule Iod_Order[of "segment (Iod D W2) b"])
  apply (frule Worder.Order[of "Iod D W1"],
         frule Order.ord_isom_onto[of "Iod D W1" 
                      "Iod D (segment (Iod D W2) b)" "g"], assumption+)
  (** transfinite induction **)
  apply (frule Order.ord_isom_minimum[of "Iod D W1" 
         "Iod D (segment (Iod D W2) b)" "g" "W1" "a"], assumption+,
         simp add:Iod_carrier, simp add:Iod_carrier mem_WWa_inc_a,
         simp add:BNTr3)
 apply (frule Order.ord_isom_onto[of "Iod D W1" 
                      "Iod D (segment (Iod D W2) b)" "g"], assumption+,
        simp add:Iod_carrier, frule Worder.Torder[of "Iod D W2"])
 apply (simp add:minimum_elem_sub[THEN sym, of "segment (Iod D W2) b" 
                           "segment (Iod D W2) b"])
      
 apply (simp add:minimum_elem_sub[of "W2" "segment (Iod D W2) b"])
 apply (frule Torder.minimum_segment_of_sub[of "Iod D W2" "W2" "b" "g a"],
        simp add:Iod_carrier, cut_tac subset_self[of "W2"],
        simp add:Iod_sub_sub[of "W2" "W2"],
         thin_tac "minimum_elem (Iod D W2) (segment (Iod D W2) b) (g a)",
        frule BNTr3[of "f" "a" "W2"], assumption+) 
apply (frule Worder.Order[of "Iod D W2"],
        frule Order.minimum_elem_unique[of "Iod D W2" "W2" "g a" "a"],
         simp add:Iod_carrier, assumption+)
 
 apply (simp add:Iod_sub_sub[THEN sym, of "segment (Iod D W2) b" "W2"],
        frule Worder.transfinite_induction[of "Iod D W1" "a" "fixp g"],
        simp add:Iod_carrier, simp add:BNTr3, simp add:fixp_def,
        rule ballI, rule impI)

 apply (frule_tac a = t in Worder_ord_isom_mem[of "Iod D W1" 
          "Iod (Iod D W2) (segment (Iod D W2) b)" "g"], assumption+,
        frule Iod_carrier[THEN sym, of "W2"],
        frule subset_trans[of "segment (Iod D W2) b" "W2" 
                        "carrier (Iod D W2)"], simp,
        thin_tac "W2 = carrier (Iod D W2)",
        simp add:Order.Iod_carrier[of "Iod D W2" "segment (Iod D W2) b"],
        frule_tac c = "g t" in subsetD[of "segment (Iod D W2) b" 
                                   "carrier (Iod D W2)"], assumption+,
        simp add:Iod_carrier)
 apply (case_tac "t = a")
  apply (simp add:fixp_def)
  apply (case_tac "ExPre (Iod D W1) t",
        frule_tac a = t in Worder.ord_isom_Pre1[of "Iod D W1" 
                  "Iod (Iod D W2) (segment (Iod D W2) b)" _ "g"], assumption+,
        simp add:Iod_carrier, assumption+)
  apply (frule_tac a = t in Worder.ord_isom_Pre2[of "Iod D W1"
            "Iod (Iod D W2) (segment (Iod D W2) b)" _ "g"], assumption+,
       simp add:Iod_carrier, assumption+)
  apply (frule_tac a = t in Order.Pre_in_segment[of "Iod D W1"],
        simp add:Iod_carrier, assumption)
  apply (frule_tac x = "Pre (Iod D W1) t" in bspec, assumption,
        thin_tac "∀u∈segment (Iod D W1) t. fixp g u") 
       apply (simp add:fixp_def)
  apply (frule_tac a = "g t" in Worder.Pre_segment[of "Iod D W2" _ "b"],
        simp add:Iod_carrier, assumption+)

 apply (rotate_tac -2, frule sym, thin_tac "Pre (Iod D W1) t =
         Pre (Iod (Iod D W2) (segment (Iod D W2) b)) (g t)", simp,
        thin_tac "Pre (Iod (Iod D W2) (segment (Iod D W2) b)) (g t) =
         Pre (Iod D W1) t")
 apply (erule conjE)
 apply (simp add:WWa_def Wa_def, (erule conjE)+,
        thin_tac "∀x∈W1. a ≼ x", thin_tac "∀x∈W2. a ≼ x",
        thin_tac "∀x∈carrier D. x ≼ f x")
 apply (frule_tac x = t in bspec, assumption+,
        thin_tac "∀x∈W1.
            if ExPre (Iod D W1) x then f (Pre (Iod D W1) x) = x
            else if a ≠ x then Sup D (segment (Iod D W1) x) = x else a = a",
        frule_tac x = "g t" in bspec, assumption+,
        thin_tac "∀x∈W2.
            if ExPre (Iod D W2) x then f (Pre (Iod D W2) x) = x
            else if a ≠ x then Sup D (segment (Iod D W2) x) = x else a = a")
        apply simp
 apply (frule_tac a = t in Worder.ord_isom_Pre11[of "Iod D W1"
                 "Iod (Iod D W2) (segment (Iod D W2) b)" _ "g"], assumption+,
        simp add:Iod_carrier, assumption, simp)

 apply (frule_tac a = "g t" in Worder.segment_Expre[of "Iod D W2" _ "b"],
        assumption, simp,
        thin_tac "¬ ExPre (Iod (Iod D W2) (segment (Iod D W2) b)) (g t)")
 apply (simp add:WWa_def Wa_def, (erule conjE)+)
 apply (rotate_tac -3,
        frule_tac x = t in bspec, assumption,
        thin_tac "∀x∈W1.
            if ExPre (Iod D W1) x then f (Pre (Iod D W1) x) = x
            else if a ≠ x then Sup D (segment (Iod D W1) x) = x else a = a")
 apply (rotate_tac 1,
        frule_tac x = "g t" in bspec, assumption,
        thin_tac "∀x∈W2.
            if ExPre (Iod D W2) x then f (Pre (Iod D W2) x) = x
            else if a ≠ x then Sup D (segment (Iod D W2) x) = x else a = a",
        simp)   
 apply (frule_tac t = t and s = a in not_sym, thin_tac " t ≠ a")
 apply (frule_tac b = t in Order.ord_isom_inj[of "Iod D W1" 
                "Iod (Iod D W2) (segment (Iod D W2) b)" "g" "a"], assumption+,
                simp add:Iod_carrier, simp add:Iod_carrier, simp)
 apply (frule_tac t1 = t in fixp_same[THEN sym, of "W1" "W2" _ "b" "g"], 
        assumption+, simp, simp add:fixp_def)
 apply (rule ballI,
        frule_tac x = x in bspec,
        simp add:subsetD[of "W1" "carrier D"], 
        simp add:Iod_carrier fixp_def)
 apply (simp add:Worder.Order, assumption)
done

lemma (in Order) BNTr4_2:"⟦f ∈ carrier D → carrier D;  a ∈ carrier D; 
       b ∈ carrier D; ∀x∈carrier D. x ≼ (f x); W1 ∈ WWa D f a; W2 ∈ WWa D f a;
       ord_equiv (Iod D W1) (Iod D (segment (Iod D W2) b))⟧ ⟹ 
       W1 = segment (Iod D W2) b" 
apply (simp add:ord_equiv_def,
       erule exE)
 apply (rename_tac g)
 apply (frule mem_wwa_Worder[of "W1" "f" "a"],
        frule mem_wwa_Worder[of "W2" "f" "a"],
        frule Worder.Order[of "Iod D W2"],
        frule mem_WWa_sub_carrier[of "W2" "f" "a"],
        frule mem_WWa_sub_carrier[of "W1" "f" "a"],
        cut_tac a = b in Worder.segment_Worder[of "Iod D W2"], assumption)
 apply (frule Worder.Order[of "Iod D W1"])
 apply (frule_tac D = "Iod (Iod D W2) (segment (Iod D W2) b)" in  Worder.Order)
 apply (frule Worder.Order[of "Iod D W2"])
 apply (frule_tac a = b in Order.segment_sub[of "Iod D W2"], 
        simp add:Iod_carrier)
 apply (frule_tac A = "segment (Iod D W2) b" in subset_trans[of _ "W2"
         "carrier D"], assumption+)
 apply (frule_tac T = "segment (Iod D W2) b" in Iod_Order)
 apply (frule_tac E = "Iod D (segment (Iod D W2) b)" and f = g in  
        Order.ord_isom_func[of "Iod D W1" ], assumption+)
 apply (frule_tac f = g in Order.ord_isom_onto[of "Iod D W1" 
                            "Iod D (segment (Iod D W2) b)"], assumption+)
 apply (simp only:Iod_carrier)
 apply (frule_tac b = b and g = g in BNTr4_1[of "f" "a" _ "W1" "W2"],
                  assumption+)
 apply (simp add:image_def)
done

lemma (in Order) BNTr4:"⟦f ∈ carrier D → carrier D;  a ∈ carrier D; 
       ∀x∈carrier D. x ≼ (f x); W1 ∈ WWa D f a; W2 ∈ WWa D f a; 
       ∃b∈carrier D. ord_equiv (Iod D W1) (Iod D (segment (Iod D W2) b))⟧ ⟹ 
       W1 ⊆ W2" 
apply (erule bexE)
 apply (rename_tac b) 
 apply (frule_tac b = b in BNTr4_2[of "f" "a" _ "W1" "W2"], assumption+)
 apply (frule mem_WWa_sub_carrier[of "W2" "f" "a"],
        frule Iod_Order[of "W2"]) 
 apply (frule_tac a = b in Order.segment_sub[of "Iod D W2"],
        simp add:Iod_carrier)
done

lemma (in Order) Iod_same:"A = B ⟹ Iod D A = Iod D B"
by simp

lemma (in Order) eq_ord_equivTr:"⟦ord_equiv D E; E = F⟧ ⟹ ord_equiv D F"
by simp

lemma (in Order) BNTr5:"⟦f ∈ carrier D → carrier D; a ∈ carrier D; 
      ∀x∈carrier D. x ≼ (f x); W1 ∈ WWa D f a; W2 ∈ WWa D f a;
      ord_equiv (Iod D W1) (Iod D W2)⟧ ⟹ W1 ⊆ W2 " 
 apply (frule mem_WWa_sub_carrier[of "W1" "f" "a"], 
        frule mem_WWa_sub_carrier[of "W2" "f" "a"]) 
 apply (case_tac "W2 = carrier D")
  apply simp
 apply (frule not_sym, thin_tac "W2 ≠ carrier D")
 apply (frule sets_not_eq[of "carrier D" "W2"], assumption, erule bexE)
 apply (frule Iod_Order[of "W2"], 
        frule Iod_Order[of "W1"],
        frule Iod_carrier[THEN sym, of "W2"])
        apply (frule_tac a = aa and A = W2 and B = "carrier (Iod D W2)" in 
              eq_set_not_inc, assumption)
        apply (thin_tac "W2 = carrier (Iod D W2)")
  apply (frule_tac a = aa in Order.segment_free[of "Iod D W2"],
          assumption, simp add:Iod_carrier)
  apply (rule BNTr4[of f a W1 W2], assumption+) (** key **)
  apply (frule_tac a = aa in Order.segment_free[of "Iod D W2"])
         apply (simp add:Iod_carrier)
  apply (simp only:Iod_carrier, 
         rotate_tac -1, frule sym, thin_tac "segment (Iod D W2) aa = W2")
  apply (frule_tac B = "segment (Iod D W2) aa" in 
                   Iod_same[of W2])
  apply (frule_tac F = "Iod D (segment (Iod D W2) aa)" in 
         Order.eq_ord_equivTr[of "Iod D W1" "Iod D W2"], assumption+)
  apply blast
done

lemma (in Order) BNTr6:"⟦f ∈ carrier D → carrier D; a ∈ carrier D;
∀x∈carrier D. x ≼ (f x); W1 ∈ WWa D f a; W2 ∈ WWa D f a; W1 ⊂ W2⟧ ⟹ 
 (∃b∈carrier (Iod D W2). ord_equiv (Iod D W1) (Iod D (segment (Iod D W2) b)))"
apply (frule mem_wwa_Worder[of "W1" "f" "a"],
       frule mem_wwa_Worder[of "W2" "f" "a"])
 apply (frule_tac D = "Iod D W1" and E = "Iod D W2" in Worder.Word_compare, 
        assumption+) (** key 1 **)
 apply (erule disjE)
  apply (erule bexE,
         frule_tac a = aa in Worder.segment_Worder[of "Iod D W1"],
         frule_tac S = "Iod (Iod D W1) (segment (Iod D W1) aa)" in
           Worder_sym[of _ "Iod D W2"], assumption+,
     thin_tac "ord_equiv (Iod (Iod D W1) (segment (Iod D W1) aa)) (Iod D W2)",
         frule BNTr4[of "f" "a" "W2" "W1"], assumption+,
         frule mem_WWa_sub_carrier[of "W1"],
         simp add:Iod_carrier,
         frule_tac c = aa in subsetD[of "W1" "carrier D"], assumption+,
         frule Iod_Order[of "W1"],
         frule_tac a = aa in Order.segment_sub[of "Iod D W1"],
                  simp add:Iod_carrier)
 apply (frule_tac S = "segment (Iod D W1) aa" and T = W1 in Iod_sub_sub,
                  assumption+, simp, blast)
 apply (simp add:subset_contr[of "W1" "W2"])

apply (erule disjE)
 apply (frule Worder_sym[of "Iod D W1" "Iod D W2"], assumption+,
          thin_tac "ord_equiv (Iod D W1) (Iod D W2)",
        frule BNTr5[of "f" "a" "W2" "W1"], assumption+)
  apply (simp add:subset_contr[of "W1" "W2"])

apply (erule bexE,
       frule mem_WWa_sub_carrier[of "W2"],
       simp add:Iod_carrier,
       frule_tac c = b in subsetD[of "W2" "carrier D"], assumption+,
       frule Iod_Order[of "W2"],
       frule_tac a = b in Order.segment_sub[of "Iod D W2"],
       simp add:Iod_carrier,
       frule_tac S = "segment (Iod D W2) b" and T = W2 in Iod_sub_sub,
                  assumption+, simp) 
 apply blast
done

lemma (in Order) BNTr6_1:"⟦f ∈ carrier D → carrier D; a ∈ carrier D;
∀x∈carrier D. x ≼ (f x); W1 ∈ WWa D f a; W2 ∈ WWa D f a; W1 ⊂ W2⟧ ⟹ 
 (∃b∈carrier (Iod D W2). W1 = (segment (Iod D W2) b))"
by (frule_tac BNTr6[of "f" "a" "W1" "W2"], assumption+, erule bexE,
       frule mem_WWa_sub_carrier[of "W2"], simp add:Iod_carrier,
       frule_tac c = b in subsetD[of "W2" "carrier D"], assumption+,
       frule_tac b = b in BNTr4_2[of "f" "a" _ "W1" "W2"], assumption+,
       blast)

lemma (in Order) BNTr7:"⟦f ∈ carrier D → carrier D; a ∈ carrier D;
      ∀x∈carrier D. x ≼ (f x); W1 ∈ WWa D f a; W2 ∈ WWa D f a⟧ ⟹ 
                W1 ⊆ W2 ∨ W2 ⊆ W1"
apply (frule mem_wwa_Worder[of "W1" "f" "a"],
       frule mem_wwa_Worder[of "W2" "f" "a"])
 apply (frule_tac D = "Iod D W1" and E = "Iod D W2" in Worder.Word_compare, 
        assumption+)
 apply (erule disjE, erule bexE)  
apply (frule mem_WWa_sub_carrier[of "W1"],
       frule mem_WWa_sub_carrier[of "W2"],
       frule Iod_Order[of "W1"],
       frule Iod_Order[of "W2"],
       frule_tac a = aa in Order.segment_sub[of "Iod D W1"],
                  simp add:Iod_carrier,
       frule_tac S = "segment (Iod D W1) aa" and T = W1 in Iod_sub_sub,
                  assumption+, simp,
       thin_tac "Iod (Iod D W1) (segment (Iod D W1) aa) =
          Iod D (segment (Iod D W1) aa)",
       frule_tac A = "segment (Iod D W1) aa" in subset_trans[of _ "W1" 
          "carrier D"], assumption+,
       frule_tac T = "segment (Iod D W1) aa" in Iod_Order)
      
 apply (frule_tac D = "Iod D (segment (Iod D W1) aa)" in 
           Order.ord_equiv_sym[of _ "Iod D W2"], assumption+)      
 apply (frule_tac c = aa in subsetD[of "W1" "carrier D"], assumption+)
 apply (frule BNTr4[of "f" "a" "W2" "W1"], assumption+, blast, simp)

apply (erule disjE)
 apply (simp add:BNTr5)
 
apply (frule mem_WWa_sub_carrier[of "W2"], simp add:Iod_carrier)
apply (frule BNTr4[of "f" "a" "W1" "W2"], assumption+)
apply (erule bexE,
       frule mem_WWa_sub_carrier[of "W2"],
       simp add:Iod_carrier,
       frule_tac c = b in subsetD[of "W2" "carrier D"], assumption+,
       frule Iod_Order[of "W2"],
       frule_tac a = b in Order.segment_sub[of "Iod D W2"],
       simp add:Iod_carrier,
       frule_tac S = "segment (Iod D W2) b" and T = W2 in Iod_sub_sub,
          assumption+, simp,
       frule_tac c = b in subsetD[of "W2" "carrier D"], assumption+)
apply blast
apply simp
done  

lemma (in Order) BNTr7_1:"⟦f ∈ carrier D → carrier D; a ∈ carrier D; 
       ∀x∈carrier D. x ≼ f x; x ∈ W; W ∈ WWa D f a; xa ∈ ⋃ (WWa D f a);
         xa ≺⇘Iod D (⋃ (WWa D f a))⇙ x⟧ ⟹ xa ∈ W"
apply (cut_tac Union_WWa_sub_carrier[of "f" "a"],
       frule_tac X = W and C = "WWa D f a" and A = x in UnionI, assumption+,
       simp del:Union_iff add:Iod_less)

 apply (simp only:Union_iff[of "xa" "WWa D f a"], erule bexE, rename_tac W')
 apply (frule_tac ?W1.0 = W and ?W2.0 = W' in BNTr7[of "f" "a"],
           assumption+)
 apply (case_tac "W' ⊆ W", simp add:subsetD[of _ "W"])

apply (simp del:Union_iff)
 apply (frule_tac B = W' in psubsetI[of "W"])
 apply (rule not_sym, assumption)
 apply (thin_tac "W ⊆ W'", thin_tac "W' ≠ W")
 apply (frule_tac ?W2.0 = W' in BNTr6_1[of "f" "a" "W"], assumption+)
 apply (erule bexE)
apply (frule_tac W = W' in mem_WWa_sub_carrier)
       apply (simp add:Iod_carrier)
       apply (frule_tac c = b and A = W' in subsetD[of _ "carrier D"], 
                            assumption+)
  apply (frule_tac W = W' and a = b and y = xa and x = x in segment_inc_less,
          assumption+)
done

lemma (in Order) BNTr7_1_1:"⟦f ∈ carrier D → carrier D; a ∈ carrier D; 
       ∀x∈carrier D. x ≼ f x; x ∈ W; W ∈ WWa D f a; xa ∈ ⋃ (WWa D f a);
         xa ≺ x⟧ ⟹ xa ∈ W" 
apply (cut_tac Union_WWa_sub_carrier[of "f" "a"],
       frule Iod_Order[of "⋃ (WWa D f a)"],
       frule Iod_less[THEN sym, of "⋃ (WWa D f a)" "xa" "x"], assumption+,
       rule UnionI[of "W" "WWa D f a" "x"], assumption+)
apply (simp del:Union_iff, rule BNTr7_1, assumption+)
done

lemma (in Order) BNTr7_2:" ⟦f ∈ carrier D → carrier D; a ∈ carrier D;
    ∀x∈carrier D. x ≼ f x; x ∈ ⋃(WWa D f a); ExPre (Iod D (⋃(WWa D f a))) x ⟧
  ⟹ ∀W∈WWa D f a. (x ∈ W ⟶ ExPre (Iod D W) x )"
apply (cut_tac Union_WWa_sub_carrier[of "f" "a"])
apply (rule ballI, rule impI)
apply (simp only:ExPre_def)
 apply (erule exE, (erule conjE)+)
 apply (simp only:Iod_carrier)
 apply (frule_tac X = W and C = "WWa D f a" and A = x in UnionI, assumption+)
 apply (simp del:Union_iff)
 apply (frule_tac x = W in bspec, assumption,
        thin_tac "∀y∈WWa D f a.
           ∀y∈y. xa ≺⇘Iod D (⋃(WWa D f a))⇙ y ⟶ ¬ y ≺⇘Iod D (⋃(WWa D f a))⇙ x")
 apply (frule_tac W = W and xa = xa in BNTr7_1[of "f" "a" "x"], assumption+,
        frule_tac W = W in mem_WWa_sub_carrier)
 apply (simp del:Union_iff add:Iod_less)
 apply (subgoal_tac "∀y∈W. xa ≺⇘Iod D W⇙ y ⟶ ¬ y ≺⇘Iod D W⇙ x")
 apply (simp only:Iod_carrier)
 apply (subgoal_tac "xa ≺⇘Iod D W⇙ x", blast) 
 apply (simp add:Iod_less)

 apply (rule ballI, rule impI)
 apply (frule_tac x = y in bspec, assumption,
        thin_tac "∀y∈W. xa ≺⇘Iod D (⋃(WWa D f a))⇙ y ⟶ ¬ y ≺⇘Iod D (⋃(WWa D f a))⇙ x",
        frule_tac X = W and C = "WWa D f a" and A = y in UnionI, assumption+)
 apply (simp add:Iod_less)
done

lemma (in Order) BNTr7_3:" ⟦f ∈ carrier D → carrier D; a ∈ carrier D;
    ∀x∈carrier D. x ≼ f x; x ∈ ⋃(WWa D f a); ExPre (Iod D (⋃(WWa D f a))) x ⟧
  ⟹ ∀W∈WWa D f a. (x ∈ W ⟶ Pre (Iod D (⋃(WWa D f a))) x = Pre (Iod D W) x)"
apply (rule ballI)
apply (rule impI)
 apply (rule_tac s = "Pre (Iod D W) x" in 
                   sym[of _ "Pre (Iod D (⋃(WWa D f a))) x"],
        frule_tac W = W in mem_wwa_Worder,
        frule_tac W = W in mem_WWa_sub_carrier,
        frule BNTr7_2[of "f" "a" "x"], assumption+,
        frule_tac x = W in bspec, assumption,
        thin_tac "∀W∈WWa D f a. x ∈ W ⟶ ExPre (Iod D W) x",
        simp) 
 
 apply (rule_tac D = "Iod D W" and a = x and 
        ?a1.0 = "Pre (Iod D (⋃(WWa D f a))) x" in Worder.UniquePre,
        assumption,
        simp add:Iod_carrier, assumption, simp add:Iod_carrier) 
  apply (frule_tac D = "Iod D W" in Worder.Order,
         frule_tac D = "Iod D W" and a = x in Order.Pre_element,
         simp add:Iod_carrier, assumption,
         (erule conjE)+, simp add:Iod_carrier)  
  apply (cut_tac Union_WWa_sub_carrier[of "f" "a"],
         frule Iod_Order[of "⋃(WWa D f a)"],
         frule_tac X = W and A = x in UnionI[of _ "WWa D f a"], assumption+,
         frule_tac D = "Iod D (⋃(WWa D f a))" and a = x in Order.Pre_element,
         simp del:Union_iff add:Iod_carrier, assumption)
 apply (erule conjE)+
 apply (frule_tac W = W and xa = "Pre (Iod D (⋃(WWa D f a))) x" in 
        BNTr7_1[of "f" "a" "x"], assumption+,
        simp only:Iod_carrier, assumption,
        simp del:Union_iff)
 
apply (rule conjI,
       simp del:Union_iff add:Iod_carrier Iod_less,
       rule ballI,
       frule_tac X = W and A = y in UnionI[of _ "WWa D f a"], assumption+,
       thin_tac "∀y∈W. Pre (Iod D W) x ≺⇘Iod D W⇙ y ⟶ ¬ y ≺⇘Iod D W⇙ x")
 apply (simp only:Iod_carrier,
        frule_tac x = y in bspec, assumption,
        thin_tac "∀y∈⋃(WWa D f a).
              Pre (Iod D (⋃(WWa D f a))) x ≺⇘Iod D (⋃(WWa D f a))⇙ y ⟶
              ¬ y ≺⇘Iod D (⋃(WWa D f a))⇙ x")
 apply (simp del:Union_iff add:Iod_less)
done

lemma (in Order) BNTr7_4:"⟦f ∈ carrier D → carrier D; a ∈ carrier D;
         ∀x∈carrier D. x ≼ f x; x ∈ W;  W ∈ WWa D f a⟧ ⟹ 
         ExPre (Iod D (⋃(WWa D f a))) x = ExPre (Iod D W) x"
apply (rule iffI) 
 apply (frule BNTr7_2[of "f" "a" "x"], assumption+)
 apply (frule_tac X = W and A = x in UnionI[of _ "WWa D f a"], assumption+,
        simp)
 
apply (simp only:ExPre_def, erule exE, (erule conjE)+)
apply (cut_tac Union_WWa_sub_carrier[of "f" "a"])
apply (frule mem_WWa_sub_carrier[of "W"], simp only:Iod_carrier,
       frule Iod_Order[of "W"]) apply (
       frule Iod_Order[of "⋃(WWa D f a)"]) apply (
       simp only:Iod_less)
apply (frule_tac X = W and A = xa in UnionI[of _ "WWa D f a"], assumption+,
       frule_tac X = W and A = x in UnionI[of _ "WWa D f a"], assumption+)
 apply (frule_tac T1 = "⋃(WWa D f a)" and a1 = xa and b1 = x in 
                                Iod_less[THEN sym], assumption+)
 apply (subgoal_tac " ¬ (∃y∈⋃(WWa D f a).
                       xa ≺⇘Iod D (⋃(WWa D f a))⇙ y ∧ y ≺⇘Iod D (⋃(WWa D f a))⇙ x)")
 apply blast

 apply (rule contrapos_pp, (simp del:Union_iff)+)
 apply (erule bexE, rename_tac xa W', erule bexE, erule conjE,
        frule_tac X = W' and A = y in UnionI[of _ "WWa D f a"], assumption+)
 apply (frule_tac xa = y in BNTr7_1[of "f" "a" "x" "W"], assumption+)
 apply (frule_tac x = y in bspec, assumption+,
        thin_tac "∀y∈W. xa ≺⇘Iod D W⇙ y ⟶ ¬ y ≺⇘Iod D W⇙ x")
 apply (simp add:Iod_less)
done

lemma (in Order) BNTr7_5:" ⟦f ∈ carrier D → carrier D; a ∈ carrier D;
           ∀x∈carrier D. x ≼ f x; x ∈ W; W ∈ WWa D f a⟧
          ⟹ (segment (Iod D (⋃(WWa D f a))) x) = segment (Iod D W) x"
apply (cut_tac Union_WWa_sub_carrier[of "f" "a"])
apply (frule_tac W = W in mem_WWa_sub_carrier)
apply (frule Iod_Order[of "⋃(WWa D f a)"],
       frule Iod_Order[of "W"])
apply (rule equalityI)
 apply (rule subsetI,
       frule Order.segment_sub[of "Iod D (⋃(WWa D f a))" "x"],
       frule_tac c = xa in subsetD[of "segment (Iod D (⋃(WWa D f a))) x" 
                            "carrier (Iod D (⋃(WWa D f a)))"], assumption+,
       frule_tac X = W and A = x in UnionI[of _ "WWa D f a"], assumption+)
 apply (frule_tac a1 = xa in Order.segment_inc[THEN sym, 
                             of "Iod D (⋃(WWa D f a))" _ "x"],
        assumption, simp add:Iod_carrier, simp del:Union_iff,
        frule_tac xa = xa in BNTr7_1[of "f" "a" "x"], assumption+,
        simp only:Iod_carrier, assumption, simp only:Iod_carrier,
        simp only:Iod_less,
        frule_tac a1 = xa in Iod_less[THEN sym, of "W" _ "x"], 
                   assumption+, simp del:Union_iff,
        subst Order.segment_inc[THEN sym, of "Iod D W" _ "x"], assumption+,
        simp add:Iod_carrier, simp add:Iod_carrier, assumption) 

 apply (rule subsetI,
        frule_tac a1 = xa in Order.segment_inc[THEN sym, of "Iod D W" _ "x"])
 apply (frule Order.segment_sub[of "Iod D W" "x"],
      rule_tac c = xa in subsetD[of "segment (Iod D W) x" "carrier (Iod D W)"],
       assumption+, simp only:Iod_carrier,
      frule_tac W = W in mem_WWa_sub_carrier, frule Iod_Order[of "W"],
      frule Order.segment_sub[of "Iod D W" "x"], simp only:Iod_carrier,
      frule_tac c = xa in subsetD[of "segment (Iod D W) x" "W"],
             simp add:Iod_less)

  apply (frule_tac X = W and A = xa in UnionI[of _ "WWa D f a"], assumption+,
         frule_tac X = W and A = x in UnionI[of _ "WWa D f a"], assumption+,
         subst Order.segment_inc[THEN sym, of "Iod D (⋃(WWa D f a))" _ "x"],
         assumption+, simp only:Iod_carrier, simp only:Iod_carrier,
         simp only:Iod_less)
done

lemma (in Order) BNTr7_6:"⟦f ∈ carrier D → carrier D; 
      a ∈ carrier D; ∀x∈carrier D. x ≼ (f x)⟧  ⟹ a ∈ ⋃(WWa D f a)"
apply (frule BNTr2[of "f" "a"], assumption+,
       frule UnionI[of "{a}" "WWa D f a" "a"]) 
apply (simp, assumption)
done 

lemma (in Order) BNTr7_7:"⟦S_inductive_set D; f ∈ carrier D → carrier D; 
      a ∈ carrier D; ∀x∈carrier D. x ≼ (f x); ∃xa. Wa D xa f a ∧ x ∈ xa⟧ ⟹ 
      x ∈ ⋃(WWa D f a)"
apply (subst Union_iff[of "x" "WWa D f a"])
apply (subst WWa_def, blast)
done

lemma (in Order) BNTr7_8:"⟦S_inductive_set D; f ∈ carrier D → carrier D; a ∈ carrier D; ∀x∈carrier D. x ≼ (f x); ∃xa. Wa D xa f a ∧ x ∈ xa⟧ ⟹ x ∈ carrier D"
apply (erule exE) apply (rename_tac W, erule conjE)
 apply (rule_tac A = W and B = "carrier D" and c = x in subsetD,
        rule_tac W = W in mem_WWa_sub_carrier[of _ "f" "a"])
 apply (simp add:WWa_def, assumption)
done 


lemma (in Order) BNTr7_9:"⟦f ∈ carrier D → carrier D; a ∈ carrier D; 
           ∀x∈carrier D. x ≼ (f x); x ∈ ⋃(WWa D f a) ⟧ ⟹ x ∈ carrier D" 
by (cut_tac Union_WWa_sub_carrier[of "f" "a"],
       rule subsetD[of "⋃(WWa D f a)" "carrier D" "x"], assumption+)

lemma (in Order) BNTr7_10:"⟦S_inductive_set D; f ∈ carrier D → carrier D; 
      a ∈ carrier D; ∀x∈carrier D. x ≼ (f x); W ∈ WWa D f a; Sup D W ∉ W⟧ ⟹
                ¬ ExPre (Iod D (insert (Sup D W) W)) (Sup D W)"
apply (frule mem_WWa_sub_carrier[of "W" "f" "a"])
apply (frule mem_WWa_Chain[of "W" "f" "a"],
       frule S_inductive_sup_mem[of "W"], assumption+,
       frule insert_sub[of "W" "carrier D" "Sup D W"], assumption+,
       cut_tac insertI1[of "Sup D W" "W"],
       cut_tac subset_insertI[of "W" "Sup D W"],
       frule insert_sub[of "W" "carrier D" "Sup D W"], assumption+)
apply (rule contrapos_pp, simp+)
apply (simp add:ExPre_def)
apply (erule exE, (erule conjE)+)
apply (frule forball_contra[of "carrier (Iod D (insert (Sup D W) W))" _ _ _
       "(=) (Sup D W)"],
       thin_tac "∀y∈carrier (Iod D (insert (Sup D W) W)).
            x ≺⇘Iod D (insert (Sup D W) W)⇙ y ⟶
            ¬ y ≺⇘Iod D (insert (Sup D W) W)⇙ Sup D W")
apply (frule well_ord_adjunction[of "W" "Sup D W"], assumption+,
       simp add:S_inductive_sup_bound[of "W"],
       simp add:mem_wwa_Worder[of "W"],
       frule insert_sub[of "W" "carrier D" "Sup D W"], assumption+,
              frule Worder.Torder[of "Iod D (W ∪ {Sup D W})"], simp,
       frule insert_sub[of "W" "carrier D" "Sup D W"], assumption+,
              frule Torder_Chain[of "insert (Sup D W) W"], assumption+,
       frule S_inductive_sup_bound[of "insert (Sup D W) W"], assumption+)
       apply (simp only:Iod_carrier)
apply (rule ballI)
apply (rotate_tac -2,
       frule_tac x = y in bspec, assumption+,
       thin_tac "∀x∈insert (Sup D W) W. x ≼ Sup D (insert (Sup D W) W)",
       cut_tac insertI1[of "Sup D W" "W"],
       simp only:Iod_less)
apply (simp add:Sup_adjunct_Sup, erule disjE)
      apply (frule sym, thin_tac "y = Sup D W", simp)
      apply (frule_tac c = y in subsetD[of "W" "carrier D"], assumption+)  
apply (frule_tac a = y and b = "Sup D W" in le_imp_less_or_eq, assumption+,
       simp) apply (
       thin_tac "y ≼ Sup D W",
       thin_tac "x = Sup D W ∨ x ∈ W")
       apply (erule disjE, simp, simp)

apply (thin_tac "∀y∈carrier (Iod D (insert (Sup D W) W)).
            x ≺⇘Iod D (insert (Sup D W) W)⇙ y ⟶
            ¬ y ≺⇘Iod D (insert (Sup D W) W)⇙ Sup D W")
apply (frule insert_sub[of "W" "carrier D" "Sup D W"], assumption+,
       cut_tac insertI1[of "Sup D W" "W"],
       simp only:Iod_carrier Iod_less) 
apply (frule mem_wwa_Worder[of "W"],
       frule S_inductive_sup_bound[of "W"], assumption+,
       frule well_ord_adjunction[of "W" "Sup D W"], assumption+,
       frule Worder.Torder[of "Iod D (W ∪ {Sup D W})"], simp)
apply (frule forball_contra1,
       thin_tac "∀y∈W. x ≺⇘Iod D (insert (Sup D W) W)⇙ y ⟶ Sup D W = y")
apply (rule ballI)
 apply (rule contrapos_pp, simp+)
 apply (frule_tac b = x in S_inductive_Sup_min_bounds[of "W"], assumption+)
 apply (simp add:upper_bound_def)
 apply (erule disjE, simp add:oless_def)
 apply (simp add:subsetD[of "W" "carrier D"])
 apply (rule ballI)
 apply (thin_tac "∀x∈carrier D. x ≼ f x",
        thin_tac "∀x∈W. x ≼ Sup D W")
 apply (frule_tac x = s in bspec, assumption+,
        thin_tac "∀y∈W. ¬ x ≺⇘Iod D (insert (Sup D W) W)⇙ y")
 apply (frule_tac c = x in subsetD[of "W" "insert (Sup D W) W"], assumption+,
        frule_tac c = s in subsetD[of "W" "insert (Sup D W) W"], assumption+)
 apply (simp add:Iod_not_less_le Iod_le)
 apply (erule disjE, simp add:oless_def,
        frule_tac c = x in subsetD[of "W" "insert (Sup D W) W"], assumption+,
        cut_tac insertI1[of "Sup D W" "W"],
        frule insert_sub[of "W" "carrier D" "Sup D W"], assumption+)
 apply (frule_tac a1 = "Sup D W" and b1 = x in Iod_le[THEN sym, 
                   of "insert (Sup D W) W"], assumption+, simp)
 apply (frule_tac c = x in subsetD[of "W" "insert (Sup D W) W"], assumption+,
        cut_tac insertI1[of "Sup D W" "W"],
        frule insert_sub[of "W" "carrier D" "Sup D W"], assumption+)
 apply (simp only:Iod_not_less_le[THEN sym])
 apply (frule_tac c = x in subsetD[of "W" "insert (Sup D W) W"], assumption+,
        cut_tac insertI1[of "Sup D W" "W"],
        frule insert_sub[of "W" "carrier D" "Sup D W"], assumption+)
 apply (simp add:Iod_less)
done 

lemma (in Order) BNTr7_11:"⟦S_inductive_set D; f ∈ carrier D → carrier D; 
 a ∈ carrier D; b ∈ carrier D; ∀x∈carrier D. x ≼ f x; W ∈ WWa D f a; 
 ∀x∈W. x ≼ b; x ∈ W⟧ ⟹
 ExPre (Iod D (insert b W)) x = ExPre (Iod D W) x"
apply (case_tac "b ∈ W",
         simp add:insert_absorb[of "b" "W"])
apply (frule mem_WWa_sub_carrier[of "W"],
       frule subsetD[of "W" "carrier D" "x"], assumption+,
       frule mem_wwa_Worder[of "W"],
       frule mem_WWa_Chain[of "W" "f" "a"],
       frule well_ord_adjunction[of "W" "b"], assumption+,
       frule insert_sub[of "W" "carrier D" "b"], assumption+,
       cut_tac insertI1[of "b" "W"],
       cut_tac subset_insertI[of "W" "b"])
apply (simp del:insert_iff insert_subset add:Un_commute,
       frule Worder.Torder[of "Iod D (insert b W)"])
apply (rule iffI)
 apply (frule subsetD[of "W" "insert b W" "x"], assumption+,
        frule Iod_Order[of "insert b W"],
        unfold ExPre_def)
 apply (erule exE, (erule conjE)+)
 apply (rule contrapos_pp, (simp del:insert_iff insert_subset)+)
 apply (frule_tac a = xa in forall_spec,
        thin_tac "∀xa. xa ≺⇘Iod D W⇙ x ⟶ xa ∈ carrier (Iod D W) ⟶
               (∃y∈carrier (Iod D W). xa ≺⇘Iod D W⇙ y ∧ y ≺⇘Iod D W⇙ x)")
 apply (simp only:Iod_carrier)
 apply (simp del:insert_subset) apply (cut_tac insertI1[of "b" "W"])
 apply (erule disjE) apply (simp del:insert_iff insert_subset)
 apply (thin_tac "∀x∈carrier D. x ≼ f x")
 apply (frule_tac x = x in bspec, assumption,
        thin_tac "∀x∈W. x ≼ b")
 apply (frule subsetD[of "W" "insert b W" "x"], assumption+,
        frule Iod_carrier[THEN sym, of "insert b W"], 
        frule eq_set_inc[of "x" "insert b W" "carrier (Iod D (insert b W))"],
                      assumption,
        frule eq_set_inc[of "b" "insert b W" "carrier (Iod D (insert b W))"],
                      assumption,
        frule Torder.not_le_less[THEN sym, of "Iod D (insert b W)" "x" "b"], 
                      assumption+,
        thin_tac "insert b W = carrier (Iod D (insert b W))")
  apply (simp del:insert_iff insert_subset add:Iod_le)
  apply (frule_tac c = xa in subsetD[of "W" "insert b W"], assumption+,
         frule subsetD[of "W" "insert b W" "x"], assumption+,
         simp only:Iod_less, simp only:Iod_carrier)
  apply (cut_tac a = xa in insert_iff[of _ "b" "W"],
          simp del:insert_iff insert_subset)
  apply (erule disjE)
  apply (frule Iod_carrier[THEN sym, of "insert b W"])
  apply (frule_tac a = b in eq_set_inc[of _ "insert b W" 
                     "carrier (Iod D (insert b W))"], assumption+,
         frule_tac a = x in eq_set_inc[of _ "insert b W" 
                     "carrier (Iod D (insert b W))"], assumption+,
         thin_tac "insert b W = carrier (Iod D (insert b W))")
  apply (simp del:insert_iff insert_subset add:Torder.not_le_less[THEN sym, 
           of "Iod D (insert b W)" "x" "b"])
  apply (rotate_tac 5,
         frule_tac x = x in bspec, assumption,
         thin_tac "∀x∈W. x ≼ b", simp add:Iod_le)
  apply (thin_tac "xa ∈ insert b W", erule conjE,
         simp del:insert_iff insert_subset,
         thin_tac "∀xa. xa ≺⇘Iod D W⇙ x ⟶
               xa ∈ W ⟶ (∃y∈W. xa ≺⇘Iod D W⇙ y ∧ y ≺⇘Iod D W⇙ x)")
  apply (erule bexE, erule conjE)
  apply (thin_tac "∀x∈carrier D. x ≼ f x",
         thin_tac "∀x∈W. x ≼ b",
         frule_tac x = y in bspec, assumption,
         thin_tac "∀y∈W. xa ≺⇘Iod D (insert b W)⇙ y ⟶ ¬ y ≺⇘Iod D (insert b W)⇙ x",
         frule_tac c = xa in subsetD[of "W" "insert b W"], assumption+,
         frule_tac c = y in subsetD[of "W" "insert b W"], assumption+)
  apply (simp del:insert_iff insert_subset add:Iod_less)

apply (erule exE, (erule conjE)+)
 apply (rule contrapos_pp, (simp del:insert_iff insert_subset)+)
 apply (frule_tac a = xa in forall_spec,
        simp only:Iod_carrier,
        frule_tac c = xa in subsetD[of "W" "insert b W"], assumption+,
        frule_tac c = x in subsetD[of "W" "insert b W"], assumption+,
        simp add:Iod_less)
 apply (simp only:Iod_carrier,
        frule_tac c = xa in subsetD[of "W" "insert b W"], assumption,
        simp del:insert_iff insert_subset add:Iod_less)
 apply (erule disjE, erule conjE) apply (
        frule_tac a = xa in forall_spec,
        thin_tac "∀xa. xa ≺⇘Iod D (insert b W)⇙ x ⟶ xa ∈ insert b W ⟶
       xa ≺ b ∧ b ≺⇘Iod D (insert b W)⇙ x ∨ (∃y∈W. xa ≺ y ∧ y ≺⇘Iod D (insert b W)⇙ x)")
 apply (thin_tac "∀x∈carrier D. x ≼ f x",
        frule_tac x = x in bspec, assumption,
        thin_tac "∀x∈W. x ≼ b",
        frule_tac c = xa in subsetD[of "W" "insert b W"], assumption+, 
        frule_tac c = x in subsetD[of "W" "insert b W"], assumption+,
        simp only:Iod_less)
 apply (thin_tac "∀xa. xa ≺⇘Iod D (insert b W)⇙ x ⟶ xa ∈ insert b W ⟶
       xa ≺ b ∧ b ≺⇘Iod D (insert b W)⇙ x ∨ (∃y∈W. xa ≺ y ∧ y ≺⇘Iod D (insert b W)⇙ x)")
 apply (simp del:insert_iff insert_subset)
 apply (thin_tac "∀x∈carrier D. x ≼ f x",
        frule_tac x = x in bspec, assumption,
        thin_tac "∀x∈W. x ≼ b",
        frule_tac subsetD[of "W" "insert b W" "x"], assumption+,
        frule_tac c = xa in subsetD[of "W" "insert b W"], assumption+,
        frule Iod_carrier[THEN sym, of "insert b W"], 
        frule eq_set_inc[of "x" "insert b W" "carrier (Iod D (insert b W))"],
                      assumption,
        frule eq_set_inc[of "b" "insert b W" "carrier (Iod D (insert b W))"],
                      assumption,
        frule Torder.not_le_less[THEN sym, of "Iod D (insert b W)" "x" "b"], 
                      assumption+,
        thin_tac "insert b W = carrier (Iod D (insert b W))",
        simp add:Iod_le,
        thin_tac "∀xa. xa ≺⇘Iod D (insert b W)⇙ x ⟶ xa ∈ insert b W ⟶
      xa ≺ b ∧ b ≺⇘Iod D (insert b W)⇙ x ∨ (∃y∈W. xa ≺ y ∧ y ≺⇘Iod D (insert b W)⇙ x)")
 apply (erule bexE, erule conjE,
        thin_tac "∀x∈W. x ≼ b",
        frule_tac x = y in bspec, assumption,
        thin_tac "∀y∈W. xa ≺ y ⟶ ¬ y ≺ x",
        frule_tac c = y in subsetD[of "W" "insert b W"], assumption+,
        frule_tac c = x in subsetD[of "W" "insert b W"], assumption+,
        simp add:Iod_less)
done

lemma (in Order) BNTr7_12:"⟦S_inductive_set D; f ∈ carrier D → carrier D; 
 a ∈ carrier D; b ∈ carrier D; ∀x∈carrier D. x ≼ f x; W ∈ WWa D f a; 
 ∀x∈W. x ≼ b; x ∈ W; ExPre (Iod D W) x⟧ ⟹ 
        Pre (Iod D (insert b W)) x = Pre (Iod D W) x"
apply (case_tac "b ∈ W", simp only:insert_absorb)
apply (frule mem_WWa_Chain[of "W"], 
       frule mem_wwa_Worder[of "W"],
       frule mem_WWa_sub_carrier[of "W"],
       frule well_ord_adjunction[of "W" "b"], assumption+,
       simp add:Un_commute[of "W" "{b}"],
       frule insert_sub[of "W" "carrier D" "b"], assumption+,
       cut_tac subset_insertI[of "W" "b"],
       frule subsetD[of "W" "insert b W" "x"], assumption+,
       cut_tac insertI1[of "b" "W"])
apply (rule Worder.UniquePre[of "Iod D (insert b W)" "x" 
                    "Pre (Iod D W) x"], assumption+,
       simp add:Iod_carrier,
       subst BNTr7_11[of "f" "a" "b" "W" "x"], assumption+,
       frule Worder.Order[of "Iod D W"]) 
apply (frule Order.Pre_element[of "Iod D W" "x"],
       simp add:Iod_carrier, assumption)
apply (erule conjE)+
apply (rule conjI)
apply (simp add:Iod_carrier) 
apply (rule conjI)
 apply (simp only:Iod_carrier,
        frule subsetD[of "W" "insert b W" "x"], assumption+,
        frule subsetD[of "W" "insert b W" "Pre (Iod D W) x"], 
        assumption+)
 apply (simp only:Iod_less)
apply (rule contrapos_pp, (simp del:insert_iff insert_subset)+)
 apply (erule bexE) 
 apply (simp only:Iod_carrier,
        frule subsetD[of "W" "insert b W" "Pre (Iod D W) x"], 
        assumption+)
 apply (cut_tac a = y in insert_iff[of _ "b" "W"]) 
 apply (frule_tac P = "y ∈ insert b W" and Q = "y = b ∨ y ∈ W" in 
        eq_prop, assumption+,
        thin_tac "(y ∈ insert b W) = (y = b ∨ y ∈ W)",
        thin_tac "y ∈ insert b W")
 apply (erule disjE,
        thin_tac "∀x∈carrier D. x ≼ f x",
        frule_tac x = x in bspec, assumption,
        thin_tac "∀x∈W. x ≼ b", erule conjE,
        frule Iod_carrier[THEN sym, of "insert b W"],
        frule eq_set_inc[of "x" "insert b W" "carrier (Iod D (insert b W))"],
                      assumption,
        frule eq_set_inc[of "b" "insert b W" "carrier (Iod D (insert b W))"],
                      assumption,
        thin_tac "insert b W = carrier (Iod D (insert b W))",
        simp del:insert_iff insert_subset,
        frule Worder.Torder[of "Iod D (insert b W)"],
         frule Torder.not_le_less[THEN sym, of "Iod D (insert b W)" "x" "b"], 
                      assumption+, simp add:Iod_le)
 apply (rotate_tac -4,
        frule_tac x = y in bspec, assumption,
        thin_tac "∀y∈W. Pre (Iod D W) x ≺⇘Iod D W⇙ y ⟶ ¬ y ≺⇘Iod D W⇙ x",
        frule_tac c = y in subsetD[of "W" "insert b W"], assumption,
        simp add:Iod_less) 
done
        
lemma (in Order) BNTr7_13:"⟦S_inductive_set D; f ∈ carrier D → carrier D; 
   a ∈ carrier D; b ∈ carrier D; ∀x∈carrier D. x ≼ f x; W ∈ WWa D f a; 
   ∀x∈W. x ≼ b; x ∈ W⟧ ⟹ 
        (segment (Iod D (insert b W)) x) = segment (Iod D W) x"
apply (case_tac "b ∈ W", simp add:insert_absorb)
apply (frule mem_wwa_Worder[of "W"],
       frule mem_WWa_sub_carrier[of "W"],
       frule mem_WWa_Chain[of "W"],
       frule insert_sub[of "W" "carrier D" "b"], assumption+,
       frule well_ord_adjunction[of "W" "b"], assumption+,
       simp del:insert_subset add:Un_commute,
       cut_tac subset_insertI[of "W" "b"],
       cut_tac insertI1[of "b" "W"],
       frule Worder.Torder[of "Iod D (insert b W)"])
apply (rule equalityI)
 apply (rule subsetI)
 apply (simp del:insert_iff insert_subset add:segment_def Iod_carrier)
 apply (frule subsetD[of "W" "insert b W" "x"], assumption+,
        simp del:insert_iff insert_subset)
 apply (erule conjE, simp only:Iod_carrier)
 apply (cut_tac a = xa in insert_iff[of _ "b" "W"],
        frule_tac P = "xa ∈ insert b W" and Q = "xa = b ∨ xa ∈ W" in 
        eq_prop, assumption+) 
apply (thin_tac "(xa ∈ insert b W) = (xa = b ∨ xa ∈ W)",
       erule disjE, simp del:insert_iff insert_subset,
       frule Iod_carrier[THEN sym, of "insert b W"], 
       frule eq_set_inc[of "x" "insert b W" "carrier (Iod D (insert b W))"],
                      assumption,
       frule eq_set_inc[of "b" "insert b W" "carrier (Iod D (insert b W))"],
                      assumption,
       thin_tac "insert b W = carrier (Iod D (insert b W))",
       frule Torder.not_le_less[THEN sym, of "Iod D (insert b W)" "x" "b"],
       assumption+, simp add:Iod_le)
apply (frule_tac c = xa in subsetD[of "W" "insert b W"], assumption+,
       frule_tac c = x in subsetD[of "W" "insert b W"], assumption+,
       simp add:Iod_less)

apply (rule subsetI)
 apply (simp del:insert_iff insert_subset add:segment_def,
        simp only:Iod_carrier)
 apply (frule_tac subsetD[of "W" "insert b W" "x"], assumption+,
        simp del:insert_iff insert_subset)
 apply (erule conjE,
        frule_tac c = xa in subsetD[of "W" "insert b W"], assumption+,
        simp add:Iod_less)
done


lemma (in Order) BNTr7_14:"⟦S_inductive_set D; f ∈ carrier D → carrier D; 
      a ∈ carrier D; ∀x∈carrier D. x ≼ (f x); W ∈ WWa D f a⟧ ⟹
            (insert (Sup D W) W) ∈ WWa D f a"
apply (case_tac "Sup D W ∈ W",
       simp add:insert_absorb[of "Sup D W" "W"])
apply (frule mem_WWa_sub_carrier[of "W" "f" "a"],
       frule mem_WWa_Chain[of "W" "f" "a"],
       frule S_inductive_sup_mem[of "W"], assumption+,
       frule insert_sub[of "W" "carrier D" "Sup D W"], assumption+,
       rule mem_of_WWa [of "insert (Sup D W) W" "a" "f"], assumption+,
       frule S_inductive_sup_bound[of "W"], assumption+)
apply (frule well_ord_adjunction[of "W" "Sup D W"], assumption+,
       simp add:mem_wwa_Worder, simp,
       frule mem_WWa_inc_a[of "W" "f" "a"], simp)

apply (rule ballI)
 apply (simp add:WWa_def Wa_def, (erule conjE)+, erule disjE,
        frule S_inductive_sup_bound[of "W"], assumption+,
        simp, simp)

apply (rule ballI)
 apply (simp only:insert_iff)
 apply (erule disjE)
 apply (frule mem_WWa_inc_a[of "W" "f" "a"])
 apply (frule not_eq_outside [of "Sup D W" "W"])
 apply (rotate_tac -1, 
       frule_tac x = a in bspec, assumption+,
       thin_tac "∀b∈W. b ≠ Sup D W")
 apply (frule BNTr7_10[of "f" "a" "W"], assumption+)
 apply (simp del:insert_iff insert_subset add:Adjunct_segment_eq)
 apply (frule S_inductive_sup_bound[of "W"], assumption+)
 apply (subst BNTr7_11[of "f" "a" "Sup D W" "W"], assumption+)
 apply (case_tac "ExPre (Iod D W) x",
        subst BNTr7_12[of "f" "a" "Sup D W" "W"], assumption+)
 apply (simp del:insert_iff insert_subset add:WWa_def) 
 apply (unfold Wa_def, simp)
 apply (simp del:insert_iff insert_subset)
 apply (rule impI) 
 apply (subst BNTr7_13[of "f" "a" "Sup D W" "W"], assumption+)
 apply (simp add:WWa_def Wa_def)
done

lemma (in Order) BNTr7_15:"⟦S_inductive_set D; f ∈ carrier D → carrier D; 
     a ∈ carrier D; ∀x∈carrier D. x ≼ (f x); W ∈ WWa D f a;
     f (Sup D W) ≠ Sup D W⟧ ⟹
     ExPre (Iod D (insert (f (Sup D W)) (insert (Sup D W) W))) (f (Sup D W))"
apply (simp add:ExPre_def)
apply (rule contrapos_pp, simp+)
apply (frule BNTr7_14[of "f" "a" "W"], assumption+)
apply (frule mem_WWa_sub_carrier[of "insert (Sup D W) W" "f" "a"],
      frule mem_WWa_Chain[of "insert (Sup D W) W" "f" "a"],
      frule mem_wwa_Worder[of "insert (Sup D W) W" "f" "a"],
      frule mem_WWa_Chain[of "W" "f" "a"],
      frule S_inductive_sup_mem[of "W"], assumption+,
      frule funcset_mem[of "f" "carrier D" "carrier D" "Sup D W"], assumption+,
      frule insert_sub[of "insert (Sup D W) W" "carrier D" "f (Sup D W)"], 
         assumption+,
      frule S_inductive_sup_bound[of "W"], assumption+)
apply (frule well_ord_adjunction[of "insert (Sup D W) W" "f (Sup D W)"], 
       assumption+,
       rule ballI,
       simp only:insert_iff, erule disjE, simp del:insert_iff insert_subset)
apply (frule_tac x = "Sup D W" in bspec, assumption,
       thin_tac "∀x∈carrier D. x ≼ f x") apply (
       rotate_tac -3,
       frule_tac x = x in bspec, assumption,
       thin_tac "∀x∈W. x ≼ Sup D W") apply (
       frule mem_WWa_sub_carrier[of "W"],
       frule_tac c = x in subsetD[of "W" "carrier D"], assumption+,
       rule_tac a = x in le_trans[of _ "Sup D W" "f (Sup D W)"], assumption+,
       cut_tac insertI1[of "Sup D W" "W"],
       cut_tac insertI1[of "f (Sup D W)" "insert (Sup D W) W"],
       cut_tac subset_insertI[of "insert (Sup D W) W" "f (Sup D W)"],
       frule subsetD[of "insert (Sup D W) W" "insert (f (Sup D W)) 
               (insert (Sup D W) W)" "Sup D W"], assumption+)
apply (frule_tac a = "Sup D W" in forall_spec)
apply (frule_tac x = "Sup D W" in bspec, assumption,
       thin_tac "∀x∈carrier D. x ≼ f x",
       frule not_sym, 
       thin_tac "f (Sup D W) ≠ Sup D W",
       simp del:insert_iff insert_subset 
             add:le_imp_less_or_eq[of "Sup D W" "f (Sup D W)"],
       simp only:Iod_less) 
apply (thin_tac "∀x. x ≺⇘Iod D (insert (f (Sup D W)) (insert (Sup D W) W))⇙ f (Sup D W) ⟶
         x ∈ carrier (Iod D (insert (f (Sup D W)) (insert (Sup D W) W))) ⟶
         (∃y∈carrier (Iod D (insert (f (Sup D W)) (insert (Sup D W) W))).
             x ≺⇘Iod D (insert (f (Sup D W)) (insert (Sup D W) W))⇙ y ∧
             y ≺⇘Iod D (insert (f (Sup D W)) (insert (Sup D W) W))⇙
             f (Sup D W))",
      simp only:Iod_carrier,
      frule True_then[of "∃y∈insert (f (Sup D W)) (insert (Sup D W) W).
         Sup D W ≺⇘Iod D (insert (f (Sup D W)) (insert (Sup D W) W))⇙ y ∧
         y ≺⇘Iod D (insert (f (Sup D W)) (insert (Sup D W) W))⇙ f (Sup D W)"],
      thin_tac "True ⟶
      (∃y∈insert (f (Sup D W)) (insert (Sup D W) W).
         Sup D W ≺⇘Iod D (insert (f (Sup D W)) (insert (Sup D W) W))⇙ y ∧
         y ≺⇘Iod D (insert (f (Sup D W)) (insert (Sup D W) W))⇙ f (Sup D W))",
       erule bexE, erule conjE)
apply (cut_tac a = y in insert_iff[of _ "f (Sup D W)" "insert (Sup D W) W"],
       frule_tac P = "y ∈ insert (f (Sup D W)) (insert (Sup D W) W)" and
                 Q = "y = f (Sup D W) ∨ y ∈ insert (Sup D W) W" in eq_prop,
       assumption+,
       thin_tac "y ∈ insert (f (Sup D W)) (insert (Sup D W) W)",
       thin_tac "(y ∈ insert (f (Sup D W)) (insert (Sup D W) W)) =
         (y = f (Sup D W) ∨ y ∈ insert (Sup D W) W)")
apply (erule disjE, simp add:oless_def)
apply (cut_tac a = y in insert_iff[of _ "Sup D W" "W"],
       frule_tac P = "y ∈ insert (Sup D W) W" and
                 Q = "y = (Sup D W) ∨ y ∈ W" in eq_prop, assumption+,
       thin_tac "y ∈ insert (Sup D W) W",
       thin_tac "y ∈ insert (Sup D W) W = (y = (Sup D W) ∨ y ∈ W)",
       erule disjE, simp add:oless_def,
       simp del:insert_iff insert_subset)
apply (frule_tac x = y in bspec, assumption,
       thin_tac "∀x∈W. x ≼ Sup D W")
apply (frule_tac x = "Sup D W" in bspec, assumption,
       thin_tac "∀x∈carrier D. x ≼ f x",
       cut_tac subset_insertI[of "W" "Sup D W"],
       frule_tac c = y in subsetD[of "W" "insert (Sup D W) W"], assumption+,
       frule_tac c = y in subsetD[of "insert (Sup D W) W"
                  "insert (f (Sup D W)) (insert (Sup D W) W)"], assumption+,
       frule_tac Worder.Torder[of "Iod D (insert (f (Sup D W)) 
                                         (insert (Sup D W) W))"])
apply (frule_tac a1 = y in Torder.not_le_less[THEN sym, of 
       "Iod D (insert (f (Sup D W)) (insert (Sup D W) W))" _ "Sup D W"],
       simp add:Iod_carrier, simp add:Iod_carrier)
apply (simp add:Iod_le)
done
       
lemma (in Order) BNTr7_16:"⟦S_inductive_set D; f ∈ carrier D → carrier D; 
     a ∈ carrier D; ∀x∈carrier D. x ≼ (f x); W ∈ WWa D f a; 
     f (Sup D W) ≠ (Sup D W)⟧ ⟹
     Pre (Iod D (insert (f (Sup D W)) (insert (Sup D W) W))) (f (Sup D W)) = 
          (Sup D W)" 
apply (frule BNTr7_14[of "f" "a" "W"], assumption+,
      frule mem_WWa_sub_carrier[of "insert (Sup D W) W" "f" "a"],
      frule mem_WWa_Chain[of "insert (Sup D W) W" "f" "a"],
      frule mem_wwa_Worder[of "insert (Sup D W) W" "f" "a"],
      frule mem_WWa_Chain[of "W" "f" "a"],
      frule S_inductive_sup_mem[of "W"], assumption+,
      frule funcset_mem[of "f" "carrier D" "carrier D" "Sup D W"], assumption+,
      frule insert_sub[of "insert (Sup D W) W" "carrier D" "f (Sup D W)"], 
         assumption+,
      frule S_inductive_sup_bound[of "W"], assumption+,
      frule well_ord_adjunction[of "insert (Sup D W) W" "f (Sup D W)"], 
      assumption+, rule ballI,
      simp only:insert_iff, erule disjE, simp del:insert_iff insert_subset,
      frule_tac x = "Sup D W" in bspec, assumption,
      thin_tac "∀x∈carrier D. x ≼ f x",
      rotate_tac -3,
      frule_tac x = x in bspec, assumption,
      thin_tac "∀x∈W. x ≼ Sup D W",
      frule mem_WWa_sub_carrier[of "W"],
      frule_tac c = x in subsetD[of "W" "carrier D"], assumption+,
      rule_tac a = x in le_trans[of _ "Sup D W" "f (Sup D W)"], assumption+,
      cut_tac insertI1[of "Sup D W" "W"],
      cut_tac insertI1[of "f (Sup D W)" "insert (Sup D W) W"],
      cut_tac subset_insertI[of "insert (Sup D W) W" "f (Sup D W)"],
      frule subsetD[of "insert (Sup D W) W" "insert (f (Sup D W)) 
               (insert (Sup D W) W)" "Sup D W"], assumption+)
   apply (simp only:Un_commute[of "insert (Sup D W) W" "{f (Sup D W)}"],
          simp only:insert_is_Un[THEN sym])
apply (rule Worder.UniquePre[of "Iod D (insert (f (Sup D W)) 
       (insert (Sup D W) W))" "f (Sup D W)" "Sup D W"], assumption+,
       simp only:Iod_carrier,
       rule BNTr7_15, assumption+,
       rule conjI, simp only:Iod_carrier, rule conjI, simp only:Iod_less,
       frule_tac x = "Sup D W" in bspec, assumption,
       thin_tac "∀x∈carrier D. x ≼ f x", frule not_sym, 
       thin_tac "f (Sup D W) ≠ Sup D W", simp add:oless_def) 
apply (rule contrapos_pp, (simp del:insert_iff insert_subset)+,
       erule bexE, erule conjE)
       apply (simp only:Iod_carrier) apply (
       cut_tac a = y in insert_iff[of _ "f (Sup D W)" "insert (Sup D W) W"],
       frule_tac P = "y ∈ insert (f (Sup D W)) (insert (Sup D W) W)" and 
        Q = "y = f (Sup D W) ∨ y ∈ insert (Sup D W) W" in eq_prop,
        assumption,
       thin_tac "y ∈ insert (f (Sup D W)) (insert (Sup D W) W)",
       thin_tac "y ∈ insert (f (Sup D W)) (insert (Sup D W) W) =
                (y = f (Sup D W) ∨ y ∈ insert (Sup D W) W)",
       erule disjE, simp add:oless_def) apply (
       cut_tac a = y in insert_iff[of _ "Sup D W" "W"],
       frule_tac P = "y ∈ insert (Sup D W) W" and 
        Q = "y = (Sup D W) ∨ y ∈ W" in eq_prop, assumption,
       thin_tac "y ∈ insert (Sup D W) W",
       thin_tac "y ∈ (insert (Sup D W) W) = (y = (Sup D W) ∨ y ∈ W)",
       erule disjE, simp add:oless_def)
apply (frule_tac x = y in bspec, assumption,
       thin_tac "∀x∈W. x ≼ Sup D W",
       cut_tac subset_insertI[of "W" "Sup D W"],
       frule_tac c = y in subsetD[of "W" "insert (Sup D W) W"], assumption,
       frule Worder.Torder[of "Iod D (insert (f (Sup D W)) 
                                     (insert (Sup D W) W))"]) 
apply (frule mem_WWa_sub_carrier[of "W"],
       frule_tac c = y in subsetD[of "W" "carrier D"], assumption+,
       frule_tac c = y in subsetD[of "insert (Sup D W) W" 
             "insert (f (Sup D W)) (insert (Sup D W) W)"], assumption+,
       frule_tac a1 = y in Torder.not_le_less[THEN sym, 
        of "Iod D (insert (f (Sup D W)) (insert (Sup D W) W))" _ "Sup D W"],
       simp add:Iod_carrier, simp add:Iod_carrier)
      apply (simp add:Iod_le)
done

lemma (in Order) BNTr7_17:"⟦S_inductive_set D; f ∈ carrier D → carrier D; 
      a ∈ carrier D; ∀x∈carrier D. x ≼ (f x); W ∈ WWa D f a⟧ ⟹
          (insert (f (Sup D W)) (insert (Sup D W) W)) ∈ WWa D f a"
apply (frule mem_WWa_Chain[of "W"],
       frule S_inductive_sup_mem[of "W"], assumption+)
apply (case_tac "f (Sup D W) = Sup D W",
       simp add:insert_absorb, simp add: BNTr7_14,
       frule not_sym, thin_tac "f (Sup D W) ≠ Sup D W")
apply (frule BNTr7_14[of "f" "a" "W"], assumption+,
      frule mem_WWa_sub_carrier[of "insert (Sup D W) W" "f" "a"],
      frule mem_WWa_Chain[of "insert (Sup D W) W" "f" "a"],
      frule funcset_mem[of "f" "carrier D" "carrier D" "Sup D W"], assumption+,
      frule mem_wwa_Worder[of "insert (Sup D W) W"])
apply (frule insert_sub[of "insert (Sup D W) W" "carrier D" "f (Sup D W)"], 
        assumption+,
       rule mem_of_WWa [of "(insert (f (Sup D W)) (insert (Sup D W) W))" "a"
        "f"], assumption+)
apply (frule well_ord_adjunction[of "insert (Sup D W) W" "f (Sup D W)"],
        assumption+, 
       frule S_inductive_sup_bound[of "W"], assumption+,
             rule ballI, 
             simp only:insert_iff, erule disjE, simp,
       frule_tac x = x in bspec, assumption,
             thin_tac "∀x∈W. x ≼ Sup D W",
       frule_tac x = "Sup D W" in bspec, assumption,
             thin_tac "∀x∈carrier D. x ≼ f x",
       frule mem_WWa_sub_carrier[of "W"],
       frule_tac c = x in subsetD[of "W" "carrier D"], assumption+,
       rule_tac a = x in le_trans[of _ "Sup D W" "f (Sup D W)"], 
             assumption+, simp)
apply (frule mem_WWa_inc_a[of "insert (Sup D W) W" "f" "a"],
       simp)
apply (rule ballI) 
 apply (frule BNTr2_1[of "f" "a" "insert (Sup D W) W"], assumption+,
        cut_tac a = x in insert_iff[of _ "f (Sup D W)" "insert (Sup D W) W"],
        frule_tac P = "x ∈ insert (f (Sup D W)) (insert (Sup D W) W)" and 
         Q = "x = (f (Sup D W)) ∨ x ∈ (insert (Sup D W) W)" in eq_prop, 
                             assumption+,
        thin_tac "x ∈ insert (f (Sup D W)) (insert (Sup D W) W)",  
        thin_tac "(x ∈ insert (f (Sup D W)) (insert (Sup D W) W)) =
         (x = f (Sup D W) ∨ x ∈ insert (Sup D W) W)",
        erule disjE)
 apply (frule_tac x = "Sup D W" in bspec, assumption,
        thin_tac "∀x∈carrier D. x ≼ f x",
        frule_tac x = "Sup D W" in bspec, simp) 
apply (
        thin_tac "∀x∈insert (Sup D W) W. a ≼ x",
        simp add:le_trans[of "a" "Sup D W" "f (Sup D W)"])
apply (frule_tac x = x in bspec, assumption,
       thin_tac "∀x∈insert (Sup D W) W. a ≼ x",
       simp)
apply (rule ballI)          
apply (cut_tac a = x in insert_iff[of _ "f (Sup D W)" "insert (Sup D W) W"],
        frule_tac P = "x ∈ insert (f (Sup D W)) (insert (Sup D W) W)" and 
         Q = "x = (f (Sup D W)) ∨ x ∈ (insert (Sup D W) W)" in eq_prop, 
                             assumption+,
        thin_tac "x ∈ insert (f (Sup D W)) (insert (Sup D W) W)",  
        thin_tac "(x ∈ insert (f (Sup D W)) (insert (Sup D W) W)) =
         (x = f (Sup D W) ∨ x ∈ insert (Sup D W) W)",
        erule disjE)
apply (frule not_sym, thin_tac "Sup D W ≠ f (Sup D W)",
       frule BNTr7_15[of "f" "a" "W"], assumption+,
       simp del:insert_iff insert_subset) 
apply (subst BNTr7_16[of "f" "a" "W"], assumption+, simp,
       frule S_inductive_sup_bound[of "W"], assumption+)
apply (subst BNTr7_11[of "f" "a" "f (Sup D W)" 
                         "insert (Sup D W) W"], assumption+,
       rule ballI,
       thin_tac "x ∈ insert (Sup D W) W", simp only:insert_iff,
       erule disjE,
       frule_tac x = "Sup D W" in bspec, assumption,
       thin_tac "∀x∈carrier D. x ≼ f x",
       simp add:le_antisym,
       frule_tac x = xa in bspec, assumption+,
       thin_tac "∀x∈W. x ≼ Sup D W",
       frule_tac x = "Sup D W" in bspec, assumption,
       thin_tac "∀x∈carrier D. x ≼ f x",
       frule mem_WWa_sub_carrier[of "W"],
       frule_tac c = xa in subsetD[of "W" "carrier D"], assumption+,
       rule_tac a = xa in le_trans[of _ "Sup D W" "f (Sup D W)"],
       assumption+)
apply (case_tac "ExPre (Iod D (insert (Sup D W) W)) x",
       simp del:insert_iff insert_subset,
       subst BNTr7_12[of "f" "a" "f (Sup D W)" "insert (Sup D W) W"],
                assumption+,
       rule ballI, thin_tac "x ∈ insert (Sup D W) W",
              simp only:insert_iff, erule disjE,
         frule_tac x = "Sup D W" in bspec, assumption,
         thin_tac "∀x∈carrier D. x ≼ f x",
         simp add:le_antisym,
         frule_tac x = xa in bspec, assumption+,
              thin_tac "∀x∈W. x ≼ Sup D W",
         frule_tac x = "Sup D W" in bspec, assumption,
              thin_tac "∀x∈carrier D. x ≼ f x",
         frule mem_WWa_sub_carrier[of "W"],
         frule_tac c = xa in subsetD[of "W" "carrier D"], assumption+,
         rule_tac a = xa in le_trans[of _ "Sup D W" "f (Sup D W)"],
               assumption+)
       apply (frule mem_WWa_then[of "insert (Sup D W) W" "f" "a"],
              (erule conjE)+,
              thin_tac "∀x∈insert (Sup D W) W. a ≼ x",
              frule_tac x = x in bspec, assumption,
              thin_tac "∀x∈insert (Sup D W) W.
            if ExPre (Iod D (insert (Sup D W) W)) x
            then f (Pre (Iod D (insert (Sup D W) W)) x) = x
            else if a ≠ x
                 then Sup D (segment (Iod D (insert (Sup D W) W)) x) = x
                 else a = a", simp)
       apply (simp del:insert_iff insert_subset, rule impI)
  apply (subst BNTr7_13[of "f" "a" "f (Sup D W)" "insert (Sup D W) W"],
               assumption+,
         rule ballI, thin_tac "x ∈ insert (Sup D W) W",
              simp only:insert_iff,
         erule disjE,
         frule_tac x = "Sup D W" in bspec, assumption,
              thin_tac "∀x∈carrier D. x ≼ f x",
         simp add:le_antisym,
         frule_tac x = xa in bspec, assumption+,
              thin_tac "∀x∈W. x ≼ Sup D W",
         frule_tac x = "Sup D W" in bspec, assumption,
              thin_tac "∀x∈carrier D. x ≼ f x",
              frule mem_WWa_sub_carrier[of "W"],
              frule_tac c = xa in subsetD[of "W" "carrier D"], assumption+,
              rule_tac a = xa in le_trans[of _ "Sup D W" "f (Sup D W)"],
               assumption+)
       apply (frule mem_WWa_then[of "insert (Sup D W) W" "f" "a"],
              (erule conjE)+,
              thin_tac "∀x∈insert (Sup D W) W. a ≼ x",
             frule_tac x = x in bspec, assumption,
              thin_tac "∀x∈insert (Sup D W) W.
            if ExPre (Iod D (insert (Sup D W) W)) x
            then f (Pre (Iod D (insert (Sup D W) W)) x) = x
            else if a ≠ x
                 then Sup D (segment (Iod D (insert (Sup D W) W)) x) = x
                 else a = a", simp) 
done

lemma (in Order) BNTr8:"⟦f ∈ carrier D → carrier D; a ∈ carrier D; 
          ∀x∈carrier D. x ≼ (f x)⟧ ⟹  ⋃ (WWa D f a) ∈ (WWa D f a)"
apply (cut_tac Union_WWa_sub_carrier[of "f" "a"])
apply (rule mem_of_WWa[of "⋃(WWa D f a)" "a" "f"], simp)
 apply (simp add:Worder_def Torder_def)
 apply (simp add:Iod_Order[of "⋃(WWa D f a)"])
 apply (rule conjI)
 apply (simp add:Torder_axioms_def)
 apply ((rule allI, rule impI)+, simp add:Iod_carrier,
         (erule bexE)+) 
 apply (rename_tac b c X1 X2)
 apply (frule_tac ?W1.0 = X1 and ?W2.0 = X2 in BNTr7[of "f" "a"],
           assumption+)
 apply (erule disjE)
 apply ((frule_tac c = b and A = X1 and B = X2 in subsetD, assumption+),
        (frule_tac W = X2 in mem_wwa_Worder[of _ "f" "a"]),
        (simp add:Worder_def Torder_def, (erule conjE)+,
         simp add:Torder_axioms_def),

       (frule_tac W = X1 in  mem_WWa_sub_carrier[of _ "f" "a"],
        frule_tac W = X2 in  mem_WWa_sub_carrier[of _ "f" "a"],
        simp add:Iod_carrier),
       (frule_tac a = b in forall_spec, assumption,
        thin_tac "∀a. a ∈ X2 ⟶ (∀b. b ∈ X2 ⟶
                                a ≼⇘Iod D X2⇙ b ∨ b ≼⇘Iod D X2⇙ a)",
        frule_tac a = c in forall_spec, assumption,
        thin_tac "∀ba. ba ∈ X2 ⟶ b ≼⇘Iod D X2⇙ ba ∨ ba ≼⇘Iod D X2⇙ b",
        frule_tac X = X1 and A = b in UnionI[of _ "WWa D f a"], assumption+,
        frule_tac X = X2 and A = c in UnionI[of _ "WWa D f a"], assumption+,
        simp add:Iod_le)) 
 apply (frule_tac c = c and A = X2 and B = X1 in subsetD, assumption+,
        frule_tac W = X1 in mem_wwa_Worder[of _ "f" "a"],
        (simp add:Worder_def Torder_def, (erule conjE)+,
         simp add:Torder_axioms_def),

        (frule_tac W = X2 in  mem_WWa_sub_carrier[of _ "f" "a"],
         frule_tac W = X1 in  mem_WWa_sub_carrier[of _ "f" "a"],
         simp add:Iod_carrier,
         frule_tac a = b in forall_spec, assumption),
        thin_tac "∀a. a ∈ X1 ⟶ (∀b. b ∈ X1 ⟶
                                a ≼⇘Iod D X1⇙ b ∨ b ≼⇘Iod D X1⇙ a)",
        (frule_tac a = c in forall_spec, assumption,
         thin_tac "∀ba. ba ∈ X1 ⟶ b ≼⇘Iod D X1⇙ ba ∨ ba ≼⇘Iod D X1⇙ b",
         frule_tac X = X1 and A = b in UnionI[of _ "WWa D f a"], assumption+,
         frule_tac X = X1 and A = c in UnionI[of _ "WWa D f a"], assumption+),
        simp add:Iod_le)

apply (subst Worder_axioms_def)
 apply (rule allI, rule impI, erule conjE)
 apply (frule_tac A = X in nonempty_ex, erule exE)
 apply (simp only:Iod_carrier,
        frule_tac c = x and A = X and B = "⋃(WWa D f a)" in subsetD,
        assumption, simp, erule bexE)
 apply (rename_tac X x W)
 apply (frule_tac W = W in mem_wwa_Worder[of _ "f" "a"],
        simp add:Worder_def Torder_def, erule conjE,
        simp add:Worder_axioms_def, erule conjE)
 apply (frule_tac a = "X ∩ W" in forall_spec,
        thin_tac "∀X. X ⊆ carrier (Iod D W) ∧ X ≠ {} ⟶
            (∃x. minimum_elem (Iod D W) X x)",
        frule_tac W = W in mem_WWa_sub_carrier[of _ "f" "a"],
        simp only:Iod_carrier, simp add:Int_lower2, blast,
        thin_tac "∀X. X ⊆ carrier (Iod D W) ∧ X ≠ {} ⟶
            (∃x. minimum_elem (Iod D W) X x)", erule exE)
 apply (frule_tac W = W in mem_WWa_sub_carrier)
 apply (frule_tac D = "Iod D W" and X = "X ∩ W" and a = xa in 
                      Order.minimum_elem_mem)
 apply (simp add:Iod_carrier)
 apply simp
apply (rule contrapos_pp, (simp del:Union_iff)+, erule conjE)
 apply (simp add:minimum_elem_def)
 apply (frule_tac a = xa in forall_spec, assumption+,
        thin_tac "∀x. x ∈ X ⟶ (∃xa∈X. ¬ x ≼⇘Iod D (⋃(WWa D f a))⇙ xa)",
        erule bexE)
 apply (frule_tac c = xb and A = X and B = "⋃(WWa D f a)" in subsetD,
                 assumption+) 
apply (cut_tac A = xb and C = "WWa D f a" in Union_iff, simp del:Union_iff,
       erule bexE, rename_tac X x W xa xb W',
       frule_tac ?W1.0 = W and ?W2.0 = W' in BNTr7[of "f" "a"], assumption+)
 apply (case_tac "W' ⊆ W",
        frule_tac c = xb and A = W' and B = W in subsetD, assumption+,
        rotate_tac 4,
        frule_tac x = xb in bspec, simp,
        thin_tac "∀x∈X ∩ W. xa ≼⇘Iod D W⇙ x")
 apply (frule Iod_Order[of "⋃(WWa D f a)"], 
        frule_tac X = W and A = xa in UnionI[of _ "WWa D f a"], assumption+,
        simp del:Union_iff add:Iod_le)
 apply (simp del:Union_iff)
 apply (frule_tac c = xa and A = W and B = W' in subsetD, assumption+,
        frule_tac X = W' and A = xa in UnionI[of _ "WWa D f a"], assumption+,
        frule_tac X = W' and A = xb in UnionI[of _ "WWa D f a"], assumption+)
 apply (simp only:Iod_le)
 apply (frule_tac W = W' in mem_wwa_Worder,
        frule_tac D = "Iod D W'" in Worder.Torder,
        frule_tac D = "Iod D W'" in Worder.Order)
 apply (frule_tac W = W' in mem_WWa_sub_carrier,
        frule_tac T1 = W' and a1 = xa and b1 = xb in Iod_le[THEN sym],
        assumption+, simp del:Union_iff)
 apply (frule_tac D = "Iod D W'" and a = xa and b = xb in Torder.not_le_less)
        apply (simp add:Iod_carrier) apply (simp add:Iod_carrier)
 apply (simp del:Union_iff add:Iod_less, thin_tac "¬ xa ≼ xb", 
        thin_tac "¬ xa ≼⇘Iod D W'⇙ xb")
 apply (frule Iod_Order[of "⋃(WWa D f a)"])
 apply (frule_tac a1 = xb and b1 = xa in Iod_less[THEN sym, of "⋃ (WWa D f a)"],
        assumption+, simp del:Union_iff,
        frule_tac x = xa and xa = xb and W = W in BNTr7_1[of "f" "a"], 
                        assumption+,
        frule_tac a1 = xb and b1 = xa and T1 = W in Iod_less[THEN sym],
           assumption+, simp del:Union_iff,
        frule_tac W = W in mem_wwa_Worder,
          frule_tac D = "Iod D W" in Worder.Torder)
   apply (frule_tac D1 = "Iod D W" and a1 = xa and b1 = xb in 
            Torder.not_le_less[THEN sym],
          simp add:Iod_carrier, simp add:Iod_carrier, simp del:Union_iff)
apply (rule BNTr7_6, assumption+)

apply (rule ballI) 
 apply (cut_tac A = x in Union_iff[of _ "WWa D f a"], simp del:Union_iff)
 apply (erule bexE, rename_tac x W)
 apply (simp add:WWa_def Wa_def[of "D" _ "f" "a"])

apply (rule ballI)
apply (case_tac "ExPre (Iod D (⋃(WWa D f a))) x", simp,
       erule bexE, rename_tac x W,
       frule_tac X = W and A = x in UnionI[of _ "WWa D f a"], assumption+,
       frule_tac x = x in BNTr7_2[of "f" "a"], assumption+,
       frule_tac x = W in bspec, assumption,
         thin_tac "∀W∈WWa D f a. x ∈ W ⟶ ExPre (Iod D W) x",
         simp del:Union_iff)
  apply (frule_tac x = x in BNTr7_3[of "f" "a"], assumption+,
         frule_tac x = W in bspec, assumption,
         thin_tac "∀W∈WWa D f a.
              x ∈ W ⟶ Pre (Iod D (⋃(WWa D f a))) x = Pre (Iod D W) x",
         simp del:Union_iff)
  apply (simp add:WWa_def Wa_def)

apply (simp del:Union_iff, rule impI) 
 apply (cut_tac A = x in Union_iff[of _ "WWa D f a"], simp del:Union_iff,
        erule bexE, rename_tac x W,
        frule_tac x = x and W = W in  BNTr7_5[of "f" "a" _], assumption+,
        simp)
 apply (frule_tac x = x and W = W in BNTr7_4[of "f" "a"], assumption+,
        simp del:Union_iff,
        thin_tac "⋃(WWa D f a) ⊆ carrier D",
        thin_tac "∃X∈WWa D f a. x ∈ X",
        thin_tac "segment (Iod D (⋃(WWa D f a))) x = segment (Iod D W) x",
        thin_tac "¬ ExPre (Iod D (⋃(WWa D f a))) x")
 apply (simp add:WWa_def Wa_def)
done

(*
lemma (in Order) BNTr9:"⟦S_inductive_set D; f ∈ carrier D → carrier D; 
           a ∈ carrier D;  ∀x∈carrier D. x ≼ (f x)⟧ ⟹ 
            insert (Sup D (⋃(WWa D f a))) (⋃(WWa D f a)) ∈ WWa D f a"
apply (frule BNTr8[of "f" "a"], assumption+,
       rule BNTr7_14[of "f" "a" "⋃(WWa D f a)"], assumption+)
done

lemma (in Order) S_inductive_postSup_outside:" ⟦S_inductive_set D; 
       Chain D X; b ∈ carrier D; Sup D X ≺ b⟧ ⟹ b ∉ X"
apply (frule S_inductive_sup_mem[of "X"], assumption+)
apply (rule contrapos_pp, simp+)
apply (frule S_inductive_sup_bound[of "X"], assumption,
       frule_tac a = b in bspec, assumption,
       thin_tac "∀x∈X. x ≼ Sup D X",
       frule less_imp_le[of "Sup D X" "b"], assumption+)
apply (frule le_antisym[of "Sup D X" "b"], assumption+, simp add:oless_def)
done

lemma (in Order) S_inductive_adjunct_postSup_mem_WWa:"⟦S_inductive_set D;
      ∀x∈carrier D. x ≼ (f x); W ∈ WWa D f a; b ∈ carrier D; (Sup D W) ≺ b⟧
       ⟹  insert b (insert (Sup D W) W) ∈ WWa D f a"
apply (frule mem_WWa_sub_carrier[of "W"],
       frule mem_WWa_Chain[of "W"],
       frule mem_wwa_Worder[of "W"],
       frule S_inductive_sup_mem[of "W"], assumption+)
apply (rule mem_of_WWa[of "insert b (insert (Sup D W) W)" "a" "f"],
       rule insert_sub[of "insert (Sup D W) W" "carrier D" "b"],
       rule insert_sub[of "W" "carrier D" "Sup D W"], assumption+) 
apply (frule S_inductive_sup_bound[of "W"], assumption+,
       frule insert_sub[of "W" "carrier D" "Sup D W"], assumption+)
apply (frule well_ord_adjunction[of "W" "Sup D W"], assumption+)
apply (frule well_ord_adjunction[of "insert (Sup D W) W" "b"], assumption+)
   apply (rule ballI, simp, erule disjE, simp add:less_imp_le,
          frule_tac a = x in bspec, assumption,
          thin_tac "∀x∈W. x ≼ Sup D W")
   apply (frule_tac c = x in subsetD[of "W" "carrier D"], assumption+,
          frule less_imp_le[of "Sup D W" "b"], assumption+,
          frule_tac a = x in le_trans[of _ "Sup D W" "b"], assumption+,
          simp add:Un_commute[of "W" "{Sup D W}"],
          simp add:Un_commute[of "insert (Sup D W) W" "{b}"])
 apply (cut_tac subset_insertI[of "W" "Sup D W"],
        cut_tac subset_insertI[of "insert (Sup D W) W" "b"],
        frule mem_WWa_inc_a[of "W"], 
        frule subsetD[of "W" "insert (Sup D W) W" "a"], assumption+,
        frule subsetD[of "insert (Sup D W) W" "insert b (insert (Sup D W) W)" 
                       "a"], assumption+)
 apply (rule ballI) apply simp
 apply (erule disjE, simp,
        frule less_imp_le[of "Sup D W" "b"], assumption+,
        frule S_inductive_sup_bound[of "W"], assumption,
        frule mem_WWa_inc_a[of "W"], 
        frule_tac a = a in bspec, assumption,
        frule subsetD[of "W" "carrier D" "a"], assumption+,
        rule le_trans[of "a" "Sup D W" "b"], assumption+)
 apply (erule disjE, simp,
        frule mem_WWa_inc_a[of "W"], 
        frule S_inductive_sup_bound[of "W"], assumption,
        simp, simp  add:WWa_def Wa_def)
 apply (rule ballI)
 apply (simp only:insert_iff)
 apply (erule disjE)*)

lemma (in Order) BNTr10:"⟦S_inductive_set D; f ∈ carrier D → carrier D; 
   a ∈ carrier D;  ∀x∈carrier D. x ≼ (f x)⟧ ⟹
                   (Sup D (⋃(WWa D f a))) ∈ (⋃(WWa D f a))"
apply (frule_tac f = f and a = a in BNTr8, assumption+,
       frule BNTr7_14[of "f" "a" "⋃(WWa D f a)"], assumption+,
       frule mem_family_sub_Un[of "insert (Sup D (⋃(WWa D f a))) (⋃(WWa D f a))"
          "WWa D f a"],
       cut_tac insertI1[of "Sup D (⋃(WWa D f a))" "⋃(WWa D f a)"])
apply (simp add:subsetD)
done         

lemma (in Order) BNTr11:"⟦S_inductive_set D; f ∈ carrier D → carrier D; 
                 a ∈ carrier D;  ∀x∈carrier D. x ≼ (f x)⟧ ⟹ 
                   f (Sup D (⋃(WWa D f a))) = (Sup D (⋃(WWa D f a)))"
apply (frule_tac f = f and a = a in BNTr8, assumption+,
       frule mem_WWa_Chain[of "⋃(WWa D f a)"],
       frule BNTr10[of "f" "a"], assumption+,
       frule S_inductive_sup_mem[of "⋃(WWa D f a)"], assumption)
apply (frule BNTr7_17[of "f" "a" "⋃(WWa D f a)"], assumption+) 
apply (cut_tac insertI1[of "f (Sup D (⋃(WWa D f a)) )" "insert (Sup D (⋃(WWa D f a))) (⋃(WWa D f a))"],
       frule mem_family_sub_Un[of "insert (f (Sup D (⋃(WWa D f a))))
      (insert (Sup D (⋃(WWa D f a))) (⋃(WWa D f a)))" "(WWa D f a)"])
apply (frule subsetD[of "insert (f (Sup D (⋃(WWa D f a)))) 
        (insert (Sup D (⋃(WWa D f a))) (⋃(WWa D f a)))" "⋃(WWa D f a)" "f (Sup D (⋃(WWa D f a)))"],
         assumption+)
apply (frule S_inductive_sup_bound[of "⋃(WWa D f a)"], assumption) 
apply (frule_tac x = "f (Sup D (⋃(WWa D f a)))" in bspec,
       assumption,
       thin_tac "∀x∈⋃(WWa D f a). x ≼ Sup D (⋃(WWa D f a))")
apply (frule_tac x = "Sup D (⋃(WWa D f a))" in bspec, assumption,
       thin_tac "∀x∈carrier D. x ≼ f x")
apply (frule funcset_mem[of "f" "carrier D" "carrier D" "Sup D (⋃(WWa D f a))"],
       assumption+,
       rule le_antisym[of "f (Sup D (⋃(WWa D f a)))" "Sup D (⋃(WWa D f a))"], 
        assumption+)
done

lemma (in Order) Bourbaki_Nakayama:"⟦S_inductive_set D; 
      f ∈ carrier D → carrier D; a ∈ carrier D; ∀x∈carrier D. x ≼ (f x)⟧ ⟹
      ∃x0∈carrier D. f x0 = x0"
apply (frule BNTr8[of "f" "a"], assumption+,
       frule mem_WWa_Chain[of "⋃(WWa D f a)" "f" "a"],
       frule S_inductive_sup_mem[of "⋃(WWa D f a)"], assumption+,
       frule BNTr11[of "f" "a"], assumption+)
apply blast
done

definition
  maxl_fun :: " _  ⇒ 'a ⇒ 'a" where
  "maxl_fun D = (λx∈carrier D. if ∃y. y∈(upper_bounds D {x}) ∧ y ≠ x then
    SOME z. z ∈ (upper_bounds D {x}) ∧ z ≠ x else x)"

lemma (in Order) maxl_funTr:"⟦x ∈ carrier D; 
      ∃y. y ∈ upper_bounds D {x} ∧ y ≠ x⟧ ⟹ 
      (SOME z. z ∈ upper_bounds D {x} ∧ z ≠ x) ∈ carrier D"
apply (rule someI2_ex, assumption+,
       simp add:upper_bounds_def upper_bound_def)
done

lemma (in Order) maxl_fun_func:"maxl_fun D ∈ carrier D → carrier D"
by (simp add:maxl_fun_def maxl_funTr)

lemma (in Order) maxl_fun_gt:"⟦x ∈ carrier D; 
      ∃y∈ carrier D.  x ≼ y ∧ x ≠ y ⟧ ⟹ 
          x ≼ (maxl_fun D x) ∧ (maxl_fun D x) ≠ x"
apply (simp add:maxl_fun_def upper_bounds_def upper_bound_def,
       rule conjI, rule impI)
apply (rule someI2_ex, assumption+, simp,
       erule bexE, blast)
done


lemma (in Order) maxl_fun_maxl:"⟦x ∈ carrier D; maxl_fun D x = x ⟧
      ⟹ maximal x"
apply (rule contrapos_pp, simp+, simp add:maximal_element_def)
apply (frule maxl_fun_gt[of "x"], assumption, erule conjE, simp)
done

lemma (in Order) maxl_fun_asc:"∀x∈carrier D. x ≼ (maxl_fun D x)"
apply (rule ballI)
apply (simp add:maxl_fun_def, rule conjI, rule impI)  
 apply (rule someI2_ex, assumption, simp add:upper_bounds_def upper_bound_def,
        rule impI, rule le_refl, assumption)
done

lemma (in Order) S_inductive_maxl:"⟦S_inductive_set D; carrier D ≠ {}⟧ ⟹ 
          ∃m. maximal m"
apply (frule nonempty_ex [of "carrier D"],
       erule exE, rename_tac a)
 apply (cut_tac maxl_fun_asc, cut_tac maxl_fun_func,
        frule_tac a = a in Bourbaki_Nakayama[of "maxl_fun D" _], assumption+)
 apply (erule bexE,
        frule_tac x = x0 in maxl_fun_maxl, assumption+)
 apply blast
done

lemma (in Order) maximal_mem:"maximal m ⟹ m ∈ carrier D"
by (simp add:maximal_element_def)

definition
  Chains :: " _  ⇒ ('a set) set" where
  "Chains D == {C. Chain D C}"

definition
  family_Torder::" _  ⇒ ('a set) Order"
    (‹(fTo _)› [999]1000) where
  "fTo D = ⦇carrier = Chains D , rel = {Z. Z ∈ (Chains D) × (Chains D) ∧ (fst Z) ⊆ (snd Z)}⦈"

lemma (in Order) Chain_mem_fTo:"Chain D C ⟹ C ∈ carrier (fTo D)"
by (simp add:family_Torder_def Chains_def)

lemma (in Order) fTOrder:"Order (fTo D)"
apply (subst Order_def)
 apply (simp add:family_Torder_def)
 apply auto
done

lemma (in Order) fTo_Order_sub:"⟦A ∈ carrier (fTo D); B ∈ carrier (fTo D)⟧
         ⟹ (A ≼⇘(fTo D)⇙ B) = (A ⊆ B)"
by (subst ole_def, simp add:family_Torder_def)


lemma (in Order) mem_fTo_Chain:"X ∈ carrier (fTo D) ⟹ Chain D X"
by (simp add:family_Torder_def Chains_def)

lemma (in Order) mem_fTo_sub_carrier:"X ∈ carrier (fTo D) ⟹ X ⊆ carrier D"
by (frule mem_fTo_Chain[of "X"], simp add:Chain_sub)

lemma (in Order) Un_fTo_Chain:"Chain (fTo D) CC ⟹ Chain D (⋃ CC)" 
apply (cut_tac fTOrder,
       frule Order.Chain_sub[of "fTo D" "CC"], assumption+,
       cut_tac family_subset_Un_sub[of "CC" "carrier D"],
       subst Chain_def, simp, simp add:Torder_def, simp add:Iod_Order,
       simp add:Torder_axioms_def)
apply ((rule allI, rule impI)+, simp add:Iod_carrier)
apply ((erule bexE)+,
        frule_tac A = X in mem_family_sub_Un[of _ "CC"],
        frule_tac A = Xa in mem_family_sub_Un[of _ "CC"],
        frule_tac c = a and A = X in subsetD[of _ "⋃CC"], assumption+,
        frule_tac c = b and A = Xa in subsetD[of _ "⋃CC"], assumption+,
        simp only:Iod_le,
        frule_tac c = X in subsetD[of "CC" "carrier fTo D"], assumption+,
        frule_tac c = Xa in subsetD[of "CC" "carrier fTo D"], assumption+)
 apply (simp add:Chain_def Torder_def Torder_axioms_def,
        thin_tac "∃X∈CC. a ∈ X", thin_tac "∃X∈CC. b ∈ X",
        (erule conjE)+,
        frule_tac a = X in forall_spec,
        simp only:Order.Iod_carrier[of "fTo D" "CC"],
        thin_tac "∀a. a ∈ carrier (Iod (fTo D) CC) ⟶
            (∀b. b ∈ carrier (Iod (fTo D) CC) ⟶
                 a ≼⇘Iod (fTo D) CC⇙ b ∨ b ≼⇘Iod (fTo D) CC⇙ a)",
        frule_tac a = Xa in forall_spec,
        simp only:Order.Iod_carrier[of "fTo D" "CC"],
        thin_tac "∀b. b ∈ carrier (Iod (fTo D) CC) ⟶
            X ≼⇘Iod (fTo D) CC⇙ b ∨ b ≼⇘Iod (fTo D) CC⇙ X")
   apply (simp add:Order.Iod_le) apply (simp add:fTo_Order_sub)
   apply (frule_tac X = X in mem_fTo_Chain,
          frule_tac X = Xa in mem_fTo_Chain,
          frule_tac X = X in Chain_Torder,
          frule_tac X = Xa in Chain_Torder,
          frule_tac X = X in Chain_sub,
          frule_tac X = Xa in Chain_sub) 
  apply (simp add:Torder_def Torder_axioms_def, (erule conjE)+, 
         simp only:Iod_carrier)
  apply (erule disjE,
      frule_tac c = a and A = X and B = Xa in subsetD, assumption+,
      thin_tac "∀a. a ∈ X ⟶ (∀b. b ∈ X ⟶ a ≼⇘Iod D X⇙ b ∨ b ≼⇘Iod D X⇙ a)",
      frule_tac a = a in forall_spec,
      thin_tac "∀a. a ∈ Xa ⟶ (∀b. b ∈ Xa ⟶ a ≼⇘Iod D Xa⇙ b ∨ b ≼⇘Iod D Xa⇙ a)",
      assumption,
      thin_tac "∀a. a ∈ Xa ⟶ (∀b. b ∈ Xa ⟶ a ≼⇘Iod D Xa⇙ b ∨ b ≼⇘Iod D Xa⇙ a)",
      frule_tac a = b in forall_spec, assumption,
      thin_tac "∀b. b ∈ Xa ⟶ a ≼⇘Iod D Xa⇙ b ∨ b ≼⇘Iod D Xa⇙ a",
      simp add:Iod_le)
   apply (
      frule_tac c = b and A = Xa and B = X in subsetD, assumption+,
      thin_tac "∀a. a ∈ Xa ⟶ (∀b. b ∈ Xa ⟶ a ≼⇘Iod D Xa⇙ b ∨ b ≼⇘Iod D Xa⇙ a)",
      frule_tac a = a in forall_spec,
      thin_tac "∀a. a ∈ X ⟶ (∀b. b ∈ X ⟶ a ≼⇘Iod D X⇙ b ∨ b ≼⇘Iod D X⇙ a)",
      assumption,
      thin_tac "∀a. a ∈ X ⟶ (∀b. b ∈ X ⟶ a ≼⇘Iod D X⇙ b ∨ b ≼⇘Iod D X⇙ a)",
      frule_tac a = b in forall_spec, assumption,
      thin_tac "∀b. b ∈ X ⟶ a ≼⇘Iod D X⇙ b ∨ b ≼⇘Iod D X⇙ a",
      simp add:Iod_le) 
 
 apply (rule ballI,
        frule_tac c = A in subsetD[of "CC" "carrier (fTo D)"], assumption+,
        rule mem_fTo_sub_carrier, assumption+)
done  

lemma (in Order) Un_fTo_Chain_mem_fTo:"Chain (fTo D) CC ⟹
                  (⋃ CC) ∈ carrier (fTo D)" 
apply (frule Un_fTo_Chain[of "CC"], thin_tac "Chain (fTo D) CC")
apply (simp add:family_Torder_def Chains_def)
done

lemma (in Order) Un_upper_bound:"Chain (fTo D) C ⟹
                  ⋃C ∈ upper_bounds (fTo D) C"
apply (simp add:upper_bounds_def upper_bound_def,
       simp add:Un_fTo_Chain_mem_fTo)
apply (rule ballI,
       simp add:ole_def,
       subst family_Torder_def, simp)

apply (cut_tac fTOrder,
       frule Order.Chain_sub[of "fTo D" "C"], assumption,
       frule_tac c = s in subsetD[of "C" "carrier (fTo D)"], assumption+,
       cut_tac Un_fTo_Chain_mem_fTo[of "C"],
       simp add:mem_fTo_Chain Chains_def,
       rule_tac A = s in mem_family_sub_Un[of _ "C"], assumption)
apply assumption
done

lemma (in Order) fTo_conditional_inc_C:"C ∈ carrier (fTo D) ⟹ 
        C ∈ carrier (Iod (fTo D) {S ∈ carrier fTo D. C ⊆ S})"
apply (cut_tac fTOrder,
       cut_tac conditional_subset[of "carrier (fTo D)" "(⊆) C"])
apply (simp add:Order.Iod_carrier)
done

lemma (in Order) fTo_conditional_Un_Chain_mem1:" ⟦C ∈ carrier (fTo D); 
     Chain (Iod (fTo D) {S ∈ carrier (fTo D). C ⊆ S}) Ca; Ca ≠ {}⟧ ⟹
      ⋃Ca ∈ upper_bounds (Iod (fTo D) {S ∈ carrier fTo D. C ⊆ S}) Ca"
 
apply (cut_tac fTOrder,
       cut_tac conditional_subset[of "carrier (fTo D)" "(⊆) C"])

  apply (simp add:upper_bounds_def upper_bound_def)
  apply (subgoal_tac "⋃Ca ∈carrier (Iod (fTo D) {S ∈ carrier (fTo D). C ⊆ S})")
   apply simp
   apply (rule ballI)
   apply (force simp add: Chain_def Order.Iod_carrier Order.Iod_le Union_upper fTo_Order_sub subset_eq)  
  apply (simp add:Order.Iod_carrier[of "fTo D"])
  apply (rule conjI)
   apply (rule Un_fTo_Chain_mem_fTo[of "Ca"])
   apply (force simp add: Chain_def Order.Iod_carrier Order.Iod_sub_sub)
  apply (simp add:Chain_def, erule conjE)
  apply (rule sub_Union[of "Ca" "C"])
  using Order.Iod_carrier by fastforce

lemma (in Order) fTo_conditional_min1:" ⟦C ∈ carrier (fTo D); 
     Chain (Iod (fTo D) {S ∈ carrier (fTo D). C ⊆ S}) Ca; Ca ≠ {}⟧ ⟹
      minimum_elem (Iod (fTo D) {S ∈ carrier fTo D. C ⊆ S})
        (upper_bounds (Iod (fTo D) {S ∈ carrier (fTo D). C ⊆ S}) Ca) (⋃Ca)"
apply (frule fTo_conditional_Un_Chain_mem1[of "C" "Ca"], assumption+,
       simp add:minimum_elem_def)
apply (rule ballI)
 apply (simp add:upper_bounds_def upper_bound_def, (erule conjE)+,
        cut_tac fTOrder,
        cut_tac conditional_subset[of "carrier (fTo D)" "(⊆) C"])
 apply (simp only:Order.Iod_carrier,
        simp only:Order.Iod_le[of "fTo D"])
 apply (frule_tac c = "⋃Ca" in subsetD[of "{S ∈ carrier fTo D. C ⊆ S}"
         "carrier (fTo D)"], assumption+,
        frule_tac c = x in subsetD[of "{S ∈ carrier fTo D. C ⊆ S}"
         "carrier (fTo D)"], assumption+)
  apply (subst Order.fTo_Order_sub, rule Order_axioms, assumption, simp,
         rule_tac C = Ca and B = x in family_subset_Un_sub)
  apply (rule ballI)
  apply (thin_tac "∀s∈Ca. s ≼⇘Iod (fTo D) {S ∈ carrier (fTo D). C ⊆ S}⇙ ⋃Ca",
         frule_tac x = A in bspec, assumption,
         thin_tac "∀s∈Ca. s ≼⇘Iod (fTo D) {S ∈ carrier (fTo D). C ⊆ S}⇙ x")
  apply (frule Order.Iod_Order[of "fTo D" "{S ∈ carrier fTo D. C ⊆ S}"],
                      assumption,
         frule Order.Chain_sub[of "Iod (fTo D) {S ∈ carrier (fTo D). C ⊆ S}"
           "Ca"], assumption,
         simp only:Order.Iod_carrier[of "fTo D" "{S ∈ carrier fTo D. C ⊆ S}"])
  apply (frule_tac c = x in subsetD[of "{x ∈ carrier fTo D. C ⊆ x}"
                             "carrier (fTo D)"], simp,
         frule_tac c = A in subsetD[of "Ca" "{x ∈ carrier fTo D. C ⊆ x}"],
                              assumption+,
         frule_tac a = A and b = x in Order.Iod_le[of "fTo D" 
                   "{x ∈ carrier fTo D. C ⊆ x}"], assumption+)
    apply simp apply (simp add:fTo_Order_sub)
done
 
lemma (in Order) fTo_conditional_Un_Chain_mem2:" ⟦C ∈ carrier (fTo D); 
       Chain (Iod (fTo D) {S ∈ carrier fTo D. C ⊆ S}) Ca; Ca = {}⟧ ⟹
       C ∈ upper_bounds (Iod (fTo D) {S ∈ carrier (fTo D). C ⊆ S}) Ca"
apply (cut_tac fTOrder,
       cut_tac conditional_subset[of "carrier (fTo D)" "(⊆) C"])
apply (simp add:upper_bounds_def upper_bound_def, simp add:Order.Iod_carrier)
done

lemma (in Order) fTo_conditional_min2:" ⟦C ∈ carrier (fTo D); 
     Chain (Iod (fTo D) {S ∈ carrier (fTo D). C ⊆ S}) Ca; Ca = {}⟧ ⟹
      minimum_elem (Iod (fTo D) {S ∈ carrier fTo D. C ⊆ S})
        (upper_bounds (Iod (fTo D) {S ∈ carrier (fTo D). C ⊆ S}) Ca) C"
apply (simp add:minimum_elem_def upper_bounds_def upper_bound_def)
apply (cut_tac fTOrder,
       cut_tac conditional_subset[of "carrier (fTo D)" "(⊆) C"],
       simp add:Order.Iod_carrier)
  by (auto simp add: Order.Iod_le fTo_Order_sub)


lemma (in Order) fTo_S_inductive:"S_inductive_set (fTo D)"
apply (simp add:S_inductive_set_def,
       rule allI, rule impI)
apply (rule contrapos_pp, simp+)
 apply (simp add:minimum_elem_def,
        frule_tac CC = C in Un_fTo_Chain_mem_fTo,
        frule_tac x = "⋃C" in bspec, assumption,
         thin_tac "∀x∈carrier (fTo D).
            x ∈ upper_bounds (fTo D) C ⟶
            (∃xa∈upper_bounds (fTo D) C. ¬ x ≼⇘(fTo D)⇙ xa)")
 apply (frule_tac C = C in Un_upper_bound, simp,
        erule bexE,
        thin_tac "⋃C ∈ upper_bounds (fTo D) C")
 apply (simp add:upper_bounds_def upper_bound_def,
        erule conjE)
 apply (cut_tac C = C and B = x in family_subset_Un_sub)
 apply (rule ballI)
 apply (frule_tac x = A in bspec, assumption,
        thin_tac "∀s∈C. s ≼⇘fTo D⇙ x",
        cut_tac fTOrder,
        frule_tac X = C in Order.Chain_sub[of "fTo D"], assumption+,
        frule_tac c = A and A = C in subsetD[of _ "carrier (fTo D)"],
                        assumption+,
        simp add:fTo_Order_sub)
 apply (simp add:fTo_Order_sub)
done

lemma (in Order) conditional_min_upper_bound:" ⟦C ∈ carrier (fTo D);
      Chain (Iod (fTo D) {S ∈ carrier fTo D. C ⊆ S}) Ca⟧ ⟹ 
      ∃X. minimum_elem (Iod (fTo D) {S ∈ carrier (fTo D). C ⊆ S})
         (upper_bounds (Iod (fTo D) {S ∈ carrier (fTo D). C ⊆ S}) Ca) X"
apply (case_tac "Ca = {}",
        frule fTo_conditional_min2[of "C"], assumption+, blast,
        frule fTo_conditional_min1[of "C"], assumption+, blast)
done

lemma (in Order) Hausdorff_acTr:"C ∈ carrier (fTo D) ⟹
       S_inductive_set (Iod (fTo D) {S. S ∈ (carrier (fTo D)) ∧  C ⊆ S})"
apply (simp add:S_inductive_set_def)
 apply (rule allI, rule impI)
 apply (frule_tac Ca = Ca in conditional_min_upper_bound[of "C"],
         assumption+)
 apply (erule exE, cut_tac fTOrder)
 apply (cut_tac conditional_subset[of "carrier (fTo D)" "(⊆) C"])
 apply (frule Order.Iod_Order[of "fTo D" "{S ∈ carrier fTo D. C ⊆ S}"],
          assumption+)
 apply (frule_tac X = "upper_bounds (Iod (fTo D) 
                              {S ∈ carrier (fTo D). C ⊆ S}) Ca"
   and a = X in 
   Order.minimum_elem_mem[of "Iod (fTo D) {S ∈ carrier (fTo D). C ⊆ S}"])
 apply (simp only:Order.Iod_carrier)
 apply (rule subsetI,
        thin_tac "minimum_elem (Iod (fTo D) {S ∈ carrier (fTo D). C ⊆ S})
         (upper_bounds (Iod (fTo D) {S ∈ carrier (fTo D). C ⊆ S}) Ca) X")
 apply (simp add:upper_bounds_def upper_bound_def, erule conjE)
 apply (simp add:Order.Iod_carrier) apply assumption 
 apply (subgoal_tac "X∈carrier (Iod (fTo D) {S ∈ carrier (fTo D). C ⊆ S}) ")
 apply blast
 apply (frule_tac X = Ca in Order.Chain_sub[of "Iod (fTo D) 
        {S ∈ carrier (fTo D). C ⊆ S}"], assumption,
        frule_tac X = Ca in Order.upper_bounds_sub[of 
         "Iod (fTo D) {S ∈ carrier (fTo D). C ⊆ S}"], assumption)
 apply (thin_tac "minimum_elem (Iod (fTo D) {S ∈ carrier (fTo D). C ⊆ S})
         (upper_bounds (Iod (fTo D) {S ∈ carrier (fTo D). C ⊆ S}) Ca) X")
 apply (rule_tac A = "upper_bounds (Iod (fTo D) {S ∈ carrier (fTo D). C ⊆ S})
        Ca" and B = "carrier (Iod (fTo D) {S ∈ carrier (fTo D). C ⊆ S})" and 
        c = X  in subsetD, assumption+)
done

lemma  satisfy_cond_mem_set:"⟦ x ∈ A; P x ⟧ ⟹ x ∈ {y ∈ A. P y}"
by blast

lemma (in Order) maximal_conditional_maximal:" ⟦C ∈ carrier (fTo D);
       maximal⇘Iod (fTo D) {S ∈ carrier (fTo D). C ⊆ S}⇙ m⟧ ⟹ maximal⇘(fTo D)⇙ m"
apply (unfold maximal_element_def, erule conjE)
apply (cut_tac conditional_subset[of "carrier (fTo D)" "(⊆) C"],
       cut_tac fTOrder,
       frule Order.Iod_Order[of "fTo D" "{x ∈ carrier fTo D. C ⊆ x}"],
       assumption+,
       simp only:Order.Iod_carrier,
       frule subsetD[of "{S ∈ carrier fTo D. C ⊆ S}" 
              "carrier (fTo D)" "m"], assumption+, simp)
apply (rule ballI, rule impI) 
 apply (simp only:fTo_Order_sub,
        frule_tac a = b in forall_spec, simp,
        thin_tac "∀b. b ∈ carrier (fTo D) ∧ C ⊆ b ⟶
             m ≼⇘Iod (fTo D) {S ∈ carrier (fTo D). C ⊆ S}⇙ b ⟶ m = b")
  by (simp add: Order.Iod_le fTo_Order_sub)

lemma (in Order) Hausdorff_ac:"C ∈ carrier (fTo D) ⟹ 
                    ∃M∈carrier (fTo D). C ⊆ M ∧ maximal⇘(fTo D)⇙ M"
apply (frule_tac Hausdorff_acTr[of "C"],
       cut_tac conditional_subset[of "carrier (fTo D)" "(⊆) C"],
       cut_tac fTOrder,
       frule Order.Iod_Order[of "fTo D" "{x ∈ carrier fTo D. C ⊆ x}"],
       assumption+)
apply (frule Order.S_inductive_maxl[of "Iod (fTo D) 
              {S ∈ carrier (fTo D). C ⊆ S}"], assumption+,
       frule fTo_conditional_inc_C[of "C"], simp add:nonempty,
       erule exE,
       frule_tac m = m in Order.maximal_mem[of 
             "Iod (fTo D) {x ∈ carrier (fTo D). C ⊆ x}"], assumption+,
       simp add:Order.Iod_carrier, erule conjE,
       frule_tac m = m in maximal_conditional_maximal[of "C"], assumption+)
apply blast
done

(** g_Zorn_lemma is the Zorn's lemma in general ordered set **)
lemma (in Order) Zorn_lemmaTr:"⟦Chain D C; M ∈ carrier fTo D; C ⊆ M;
           maximal⇘fTo D⇙ M; b ∈ carrier D; ∀s∈M. s ≼ b ⟧ ⟹
            maximal b ∧ b ∈ upper_bounds D C"
apply (simp add:upper_bounds_def upper_bound_def)
apply (rule conjI)
prefer 2
 apply (rule ballI, simp add:subsetD,
        rule contrapos_pp, simp+, simp add:maximal_element_def,
        erule bexE, erule conjE)
 apply (frule_tac X = M in mem_fTo_Chain,
        frule_tac X = M and b = ba in adjunct_Chain, assumption+,
        rule ballI)
 apply (frule_tac x = x in bspec, assumption+,
        thin_tac "∀s∈M. s ≼ b",
        frule_tac X = M in Chain_sub,
        frule_tac c = x in subsetD[of "M" "carrier D"], assumption+,
        rule_tac a = x and b = b and c = ba in le_trans, assumption+)
 apply (cut_tac B = M and a = ba in subset_insertI,
        cut_tac a = ba in insertI1[of _ "M"], 
        cut_tac C = "insert ba M" in Chain_mem_fTo, assumption)
 apply (frule_tac x = "insert ba M" in bspec, assumption,
        thin_tac "∀b∈carrier fTo D. M ≼⇘fTo D⇙ b ⟶ M = b",
        simp del:insert_iff insert_subset add:fTo_Order_sub)
 apply (frule_tac x = ba in bspec, assumption,
        thin_tac "∀s∈M. s ≼ b")
 apply (frule_tac a = b and b = ba in le_antisym, assumption+, simp)
done

lemma (in Order) g_Zorn_lemma1:"⟦inductive_set D; Chain D C⟧ ⟹ ∃m. maximal m ∧ m ∈ upper_bounds D C"
apply (frule Chain_mem_fTo [of "C"],
       frule Hausdorff_ac[of "C"]) 
 apply (erule bexE, erule conjE)
 apply (frule_tac X = M in mem_fTo_Chain)
 apply (simp add:inductive_set_def)
 apply (frule_tac a = M in forall_spec, assumption,
        thin_tac "∀C. Chain D C ⟶ (∃b. ub C b)",
        erule exE, simp add:upper_bound_def, erule conjE)
 apply (frule_tac M = M and b = b in Zorn_lemmaTr[of "C"], assumption+)
 apply blast
done

lemma (in Order) g_Zorn_lemma2:"⟦inductive_set D; a ∈ carrier D⟧ ⟹ 
                 ∃m∈carrier D. maximal m ∧ a ≼ m" 
apply (frule BNTr1 [of "a"],
       frule singleton_sub[of "a" "carrier D"],
       frule_tac  X = "{a}" in Torder_Chain,
       simp add:Worder.Torder)
apply (frule_tac C = "{a}" in g_Zorn_lemma1, assumption+,
       erule exE, erule conjE,
       simp add:upper_bounds_def upper_bound_def)
apply blast
done

lemma (in Order) g_Zorn_lemma3:"inductive_set D ⟹ ∃m∈carrier D. maximal m"
apply (cut_tac Iod_empty_Torder,
       cut_tac empty_subsetI[of "carrier D"],
       frule Torder_Chain[of "{}"], assumption+)
apply (frule_tac  C = "{}" in g_Zorn_lemma1, assumption+,
       simp add:upper_bounds_def upper_bound_def,
       blast)
done

chapter "Group Theory. Focused on Jordan Hoelder theorem"
    

section "Definition of a Group"

record 'a Group = "'a carrier" + 
  top      :: "['a, 'a ] ⇒ 'a" (infixl ‹⋅ı› 70)
  iop      :: "'a  ⇒  'a" (‹ρı _› [81] 80)
  one     :: "'a"   (‹𝟭ı›) 

locale Group =
 fixes G (structure)
 assumes top_closed: "top G ∈ carrier G → carrier G → carrier G"
 and     tassoc : "⟦a ∈ carrier G; b ∈ carrier G; c ∈ carrier G⟧ ⟹
         (a ⋅ b) ⋅ c = a ⋅ (b ⋅ c)"
 and     iop_closed:"iop G ∈ carrier G → carrier G"
 and     l_i :"a ∈ carrier G ⟹  (ρ a) ⋅ a = 𝟭"
 and     unit_closed: "𝟭 ∈ carrier G"
 and     l_unit:"a ∈ carrier G ⟹ 𝟭 ⋅ a = a"


lemma (in Group) mult_closed:"⟦a ∈ carrier G; b ∈ carrier G⟧ ⟹
           a ⋅ b ∈ carrier G"
apply (cut_tac top_closed)
apply (frule funcset_mem[of "(⋅)" "carrier G" "carrier G → carrier G" "a"],
       assumption+,
       frule funcset_mem[of "(⋅) a" "carrier G" "carrier G" "b"],
       assumption+ )
done
    
lemma (in Group) i_closed:"a ∈ carrier G ⟹ (ρ a) ∈ carrier G" 
apply  (cut_tac iop_closed,
       frule funcset_mem[of "iop G" "carrier G" "carrier G" "a"])
apply assumption+
done

lemma (in Group) r_mult_eqn:"⟦a ∈ carrier G; b ∈ carrier G;
       c ∈ carrier G; a = b⟧ ⟹ a ⋅ c = b ⋅ c"
by simp

lemma (in Group) l_mult_eqn:"⟦a ∈ carrier G; b ∈ carrier G;
       c ∈ carrier G; a = b⟧ ⟹ c ⋅ a = c ⋅ b"
by simp

lemma (in Group) r_i:"a ∈ carrier G ⟹
                    a ⋅ (ρ a) = 𝟭 "
apply (frule mult_closed[of "a" "ρ a"],
       simp add:i_closed,
       cut_tac l_unit[of "a"],
       cut_tac unit_closed,
       frule mult_closed[of "𝟭" "a"], assumption+,
       frule i_closed[of "a"],
       frule mult_closed[of "ρ a" "a"], assumption+)

 apply (frule r_mult_eqn[of "(ρ a) ⋅ a" "𝟭" "ρ a"], assumption+,
        simp add:l_i,
        simp add:l_unit[of "ρ a"])

(* (i i a) from the left  *) 
 apply (frule i_closed[of "a"],
        frule i_closed[of "ρ a"],
        frule mult_closed[of "ρ a" "a"], assumption+,
        frule mult_closed[of "(ρ a) ⋅ a" "ρ a"], assumption+,
        frule l_mult_eqn[of "(ρ a) ⋅ a ⋅ (ρ a)" "ρ a" "ρ (ρ a)"],
        assumption+) 
 apply (thin_tac "(ρ a) ⋅ a ⋅ (ρ a) = (ρ a)",
        simp add:l_i[of "ρ a"],
        simp add:tassoc[THEN sym, of "ρ (ρ a)" "(ρ a) ⋅ a" "ρ a"],
        simp add:tassoc[THEN sym, of "ρ (ρ a)" "ρ a" "a"])
 apply (simp add:l_i[of "ρ a"])
apply assumption
done

lemma (in Group) r_unit:"a ∈ carrier G ⟹ a ⋅ 𝟭 = a"
apply (cut_tac unit_closed,
       frule i_closed[of "a"],
       frule mult_closed[of "a" "𝟭"], assumption+)
apply (cut_tac l_i[THEN sym, of "a"],
       simp,
       thin_tac "𝟭 = ρ a ⋅ a")
   
apply (simp add:tassoc[THEN sym] r_i l_unit)
apply assumption
done

lemma (in Group) l_i_unique:"⟦a ∈ carrier G; b ∈ carrier G; 
       b ⋅ a = 𝟭 ⟧ ⟹ (ρ a) = b "
apply (cut_tac unit_closed,
       frule i_closed[of "a"],
       frule mult_closed[of "b" "a"], assumption+)
apply (frule r_mult_eqn[of "b ⋅ a" "𝟭" "ρ a"], assumption+)
apply (thin_tac "b ⋅ a = 𝟭",
       simp add:tassoc[of "b" "a" "ρ a"] r_i)
apply (simp add:l_unit r_unit)
done

lemma (in Group) l_i_i:"a ∈ carrier G ⟹ (ρ (ρ a)) ⋅ (ρ a) = 𝟭"
by (frule i_closed[of "a"],
       cut_tac l_i[of "ρ a"], assumption+) 

lemma (in Group) l_div_eqn:"⟦a ∈ carrier G; x ∈ carrier G; y ∈ carrier G;
        a ⋅ x = a ⋅ y ⟧ ⟹ x = y"
apply (frule mult_closed[of "a" "x"], assumption+,
       frule mult_closed[of "a" "y"], assumption+,
       frule i_closed[of "a"],
       frule l_mult_eqn[of "a ⋅ x" "a ⋅ y" "ρ a"], assumption+)
apply (thin_tac "a ⋅ x = a ⋅ y",
       simp add:tassoc[THEN sym])
apply (simp add:l_i l_unit)
done

lemma (in Group) r_div_eqn:"⟦a ∈ carrier G; x ∈ carrier G; y ∈ carrier G;
   x ⋅ a = y ⋅ a ⟧ ⟹ x = y "
apply (frule mult_closed[of "x" "a"], assumption+,
       frule mult_closed[of "y" "a"], assumption+,
       frule i_closed[of "a"],
       frule r_mult_eqn[of "x ⋅ a" "y ⋅ a" "ρ a"], assumption+)
 apply (thin_tac "x ⋅ a =  y ⋅ a",
        simp add:tassoc, simp add:r_i r_unit)
done

lemma (in Group) l_mult_eqn1:"⟦a ∈ carrier G; x ∈ carrier G;  y ∈ carrier G;
        (ρ a) ⋅ x = (ρ a) ⋅ y⟧  ⟹ x = y "
by (frule i_closed[of "a"], rule l_div_eqn[of "ρ a" "x" "y"], assumption+)
                                        
lemma (in Group) tOp_assocTr41:"⟦a ∈ carrier G; b ∈ carrier G; c ∈ carrier G;
       d ∈ carrier G⟧ ⟹ a ⋅ b ⋅ c ⋅ d = a ⋅ b ⋅ (c ⋅ d)"
by (frule mult_closed[of "a" "b"], assumption+, 
                                   simp add:tassoc[of "a ⋅ b" "c" "d"])

lemma (in Group) tOp_assocTr42:"⟦a ∈ carrier G; b ∈ carrier G; c ∈ carrier G;
      d ∈ carrier G⟧ ⟹ a ⋅ b ⋅ c ⋅ d = a ⋅ (b ⋅ c)⋅ d"
by (simp add:tassoc[of "a" "b" "c"])

lemma (in Group) tOp_assocTr44:"⟦a ∈ carrier G; b ∈ carrier G; c ∈ carrier G;
      d ∈ carrier G ⟧ ⟹ (ρ a) ⋅ b ⋅ ((ρ c) ⋅ d) = 
                                         (ρ  a) ⋅ ((b ⋅ (ρ c)) ⋅ d)"  
apply (frule i_closed[of "a"],
       frule i_closed[of "c"])
apply (simp add:tassoc[of "b" "ρ c" "d"],
       frule mult_closed[of "ρ c" "d"], assumption+,
       simp add:tassoc[THEN sym, of "ρ a" "b" "(ρ c) ⋅ d"])
done

lemma (in Group) tOp_assocTr45:"⟦a ∈ carrier G; b ∈ carrier G; c ∈ carrier G; 
d ∈ carrier G⟧ ⟹ a ⋅ b ⋅ c ⋅ d = a ⋅ (b ⋅ (c ⋅ d))"
apply (frule mult_closed[of "c" "d"], assumption+)
 apply (simp add:tassoc[of "a" "b" "c ⋅ d", THEN sym])
 apply (simp add:tOp_assocTr41)
done
 
lemma (in Group) one_unique:"⟦a ∈ carrier G; x ∈ carrier G;  x ⋅ a = x⟧ ⟹ 
                                a = 𝟭"
apply (frule mult_closed[of "x" "a"], assumption+,
       frule i_closed[of "x"],
       frule l_mult_eqn[of "x ⋅ a" "x" "ρ x"], assumption+)
apply (thin_tac "x ⋅ a = x",
       simp add:tassoc[THEN sym, of "ρ x" "x" "a"],
       simp add:l_i l_unit)
done

lemma (in Group) i_one:"ρ 𝟭 = 𝟭" 
by  (cut_tac unit_closed, frule l_i[of "𝟭"],
     frule i_closed[of "𝟭"], simp add:r_unit)

lemma (in Group) eqn_inv1:"⟦a ∈ carrier G; x ∈ carrier G; a = (ρ x) ⟧ ⟹ 
                       x = (ρ a)"
apply (frule i_closed[of "x"],
       frule l_mult_eqn[of "a" "ρ x" "x"], assumption+,
       thin_tac "a = ρ x", simp add:r_i,
       simp add:l_i_unique[of "a" "x"])
done

lemma (in Group) eqn_inv2:"⟦a ∈ carrier G; x ∈ carrier G;  x ⋅ a = x ⋅ (ρ x)⟧ ⟹
                        x = (ρ a)"
apply (rule eqn_inv1, assumption+)
apply (rule l_div_eqn[of "x" "a" "ρ x"], assumption+,
       simp add:i_closed, assumption)
done

lemma (in Group) r_one_unique:"⟦a ∈ carrier G; x ∈ carrier G; a ⋅ x = a⟧  ⟹
                                 x = 𝟭"
apply (frule mult_closed[of "a" "x"], assumption+,
       frule i_closed[of "a"],
       frule l_mult_eqn[of "a ⋅ x" "a" "ρ a"], assumption+,
       thin_tac "a ⋅ x = a",
       simp add:tassoc[THEN sym] l_i l_unit)
done

lemma (in Group) r_i_unique:"⟦a ∈ carrier G; x ∈ carrier G; a ⋅ x = 𝟭⟧ ⟹
                             x = (ρ a)"
apply (cut_tac unit_closed,
       frule mult_closed[of "a" "x"], assumption+,
       frule i_closed[of "x"],
       frule r_mult_eqn[of "a ⋅ x" "𝟭" "ρ x"], assumption+,
       thin_tac "a ⋅ x = 𝟭",
       simp add:tassoc[of "a" "x" "ρ x"] r_i r_unit l_unit) 
apply (simp add:eqn_inv1)
done

lemma (in Group) iop_i_i:"a ∈ carrier G  ⟹ ρ (ρ a) = a"
apply (frule i_closed[of "a"], frule i_closed[of "ρ a"],
       frule l_i[of "ρ a"],
       frule mult_closed[of "ρ (ρ a)" "ρ a"], assumption+)
apply (cut_tac unit_closed,
       frule r_mult_eqn[of "ρ (ρ a) ⋅ ρ a" "𝟭" "a"], assumption+,
       thin_tac "ρ (ρ a) ⋅ ρ a = 𝟭",
       simp only:tassoc) 
apply (simp add:l_i r_unit l_unit)
done

lemma (in Group) i_ab:"⟦a ∈ carrier G; b ∈ carrier G⟧ ⟹
                            ρ (a ⋅ b) = (ρ b) ⋅ (ρ a)"
apply (frule mult_closed[of "a" "b"], assumption+,
       frule i_closed[of "a ⋅ b"],
       frule i_closed[of "a"], frule i_closed[of "b"],
       frule l_div_eqn[of "a ⋅ b" "ρ (a ⋅ b)" "(ρ b) ⋅ (ρ a)"], assumption+,
       simp add:mult_closed, simp add:r_i[of "a ⋅ b"],
       simp add:tOp_assocTr41[THEN sym], simp add:tOp_assocTr42,
       simp add:r_i r_unit)
apply assumption
done

lemma (in Group) sol_eq_l:"⟦a ∈ carrier G; b ∈ carrier G; x ∈ carrier G;
                   a ⋅ x = b⟧ ⟹ x = (ρ a) ⋅ b"
apply (frule mult_closed[of "a" "x"], assumption+,
       frule i_closed[of "a"],
       frule l_mult_eqn[of "a ⋅ x" "b" "ρ a"], assumption+)
apply (thin_tac "a ⋅ x = b",
       simp add:tassoc[THEN sym],
       simp add:l_i l_unit)
done

lemma (in Group) sol_eq_r:"⟦a ∈ carrier G; b ∈ carrier G; x ∈ carrier G; 
       x ⋅ a = b ⟧ ⟹  x = b ⋅ (ρ a)"
apply (frule mult_closed[of "x" "a"], assumption+,
       frule i_closed[of "a"],
       frule r_mult_eqn[of "x ⋅ a" "b" "ρ a"], assumption+)
apply (thin_tac "x ⋅ a = b",
       simp add:tassoc,
       simp add:r_i r_unit)
done
       
lemma (in Group) r_div_eq:"⟦a ∈ carrier G; b ∈ carrier G; a ⋅ (ρ b) = 𝟭⟧ ⟹
                            a = b"
apply (frule i_closed[of "b"],
       frule mult_closed[of "a" "ρ b"], assumption+,
       cut_tac unit_closed,
       frule r_mult_eqn[of "a ⋅ (ρ b)" "𝟭" "b"], assumption+)
apply (thin_tac "a ⋅ ρ b = 𝟭",
       simp add:tassoc l_i r_i, simp add:l_unit r_unit)
done   

lemma (in Group) l_div_eq:"⟦a ∈ carrier G; b ∈ carrier G; (ρ a) ⋅ b = 𝟭⟧ ⟹
                               a = b"
apply (frule i_closed[of "a"],
       frule mult_closed[of "ρ a" "b"], assumption+,
       cut_tac unit_closed,
       frule l_mult_eqn[of "(ρ a) ⋅ b" "𝟭" "a"], assumption+)
apply (thin_tac "ρ a ⋅ b = 𝟭",
       simp add:tassoc[THEN sym] r_i l_unit r_unit)
done

lemma (in Group) i_m_closed:"⟦a ∈ carrier G ; b ∈ carrier G⟧ ⟹
              (ρ a) ⋅ b ∈ carrier G "
by (rule mult_closed,
       simp add:i_closed, assumption)


section "Subgroups"

definition
  sg ::"[_ , 'a set ] ⇒ bool"  (‹_ » _ › [60, 61]60) where
  "G » H ⟷ H ≠ {} ∧ H ⊆ carrier G ∧ (∀a ∈ H. ∀b ∈ H. a ⋅⇘G⇙ (ρ⇘G⇙ b) ∈ H)" 
 
 (** SG is a set satisfying the condition above. In math textbooks this is 
  called a subgroup and it is also taken as a group with induced structure.**)

definition
   Gp :: "_ ⇒ 'a set ⇒ _"        (‹(♮ı_)› 70) where
   "♮⇘G⇙H ≡ G ⦇ carrier := H, top := top G, iop := iop G, one := one G⦈"     

  (** Gp G H is a group with carrier H, where H is sg **)


definition
  rcs :: "[_ , 'a set, 'a] ⇒ 'a set" (infix ‹∙ı› 70) where
  "H ∙⇘G⇙ a = {b. ∃ h ∈ H. h ⋅⇘G⇙ a = b}"

definition
  lcs :: "[_ , 'a, 'a set] ⇒ 'a set" (infix ‹♢ı› 70) where
  "a ♢⇘G⇙ H = {b. ∃ h ∈ H. a ⋅⇘G⇙ h = b}" 

definition
  nsg :: "_ ⇒ 'a set ⇒ bool"    (‹_ ▹ _› [60,61]60) where
  "G ▹ H ⟷ G » H ∧ (∀x ∈ carrier G. H ∙⇘G⇙ x = x ♢⇘G⇙ H)" 

definition
  set_rcs :: "[_ , 'a set] ⇒ 'a set set" where
  "set_rcs G H = {C. ∃a ∈ carrier G. C = H ∙⇘G⇙ a}"

definition
  c_iop :: "[_ , 'a set]  ⇒ 'a set ⇒ 'a set" where
  "c_iop G H = (λX∈set_rcs G H. {z. ∃ x ∈ X . ∃h ∈ H. h ⋅⇘G⇙ (ρ⇘G⇙ x) = z})"      
 
definition
  c_top :: "[_, 'a set] ⇒ (['a set, 'a set] ⇒ 'a set)" where
  "c_top G H = (λX∈set_rcs G H. λY∈set_rcs G H. 
    {z. ∃x ∈ X. ∃ y ∈ Y. x ⋅⇘G⇙ y = z})" 

lemma (in Group) sg_subset:"G » H ⟹ H ⊆ carrier G"
by (simp add:sg_def)

lemma (in Group) one_Gp_one:"G » H ⟹ 𝟭⇘(Gp G H)⇙ = 𝟭"
by (simp add:Gp_def)

lemma (in Group) carrier_Gp:"G » H ⟹ (carrier (♮H)) = H"
by (simp add:Gp_def)

lemma (in Group) sg_subset_elem:"⟦G » H; h ∈ H ⟧ ⟹ h ∈ carrier G"
by (frule sg_subset [of "H"], simp only:subsetD)

lemma (in Group) sg_mult_closedr:"⟦G » H; x ∈ carrier G; h ∈ H⟧ ⟹
                x ⋅ h ∈ carrier G"
apply (frule sg_subset_elem [of "H" "h"], assumption+)
apply (simp add:mult_closed)
done

lemma (in Group) sg_mult_closedl:"⟦G » H; x ∈ carrier G; h ∈ H⟧ ⟹
                    h ⋅ x ∈ carrier G"
apply (frule sg_subset_elem[of "H" "h"], assumption+)
apply (simp add:mult_closed)
done

lemma (in Group) sg_condTr1:"⟦H ⊆ carrier G; H ≠ {};
                  ∀a. ∀b. a ∈ H ∧ b ∈ H ⟶  a ⋅ (ρ b) ∈ H⟧ ⟹ 𝟭 ∈ H"
apply (frule  nonempty_ex [of "H"], erule exE)
apply (frule_tac x = x in spec,
       thin_tac "∀a b. a ∈ H ∧ b ∈ H ⟶ a ⋅ ρ b ∈ H",
       frule_tac x = x in spec,
       thin_tac "∀b. x ∈ H ∧ b ∈ H ⟶ x ⋅ ρ b ∈ H")
apply (frule_tac c = x in subsetD[of "H" "carrier G"], assumption+,
       simp add:r_i)
done

lemma (in Group) sg_unit_closed:"G » H ⟹ 𝟭 ∈ H"
apply (simp add:sg_def, (erule conjE)+,
       rule sg_condTr1, assumption+, blast)     
done

lemma (in Group) sg_i_closed:"⟦G » H; x ∈ H⟧ ⟹ (ρ x) ∈ H"
apply (frule sg_unit_closed,
       frule sg_subset_elem[of "H" "x"], assumption,
       simp add:sg_def, (erule conjE)+)
apply (frule_tac x = 𝟭 in bspec, assumption,
       rotate_tac -1,
       frule_tac x = x in bspec, assumption,
       thin_tac "∀b∈H. 𝟭 ⋅ ρ b ∈ H",
       thin_tac "∀a∈H. ∀b∈H. a ⋅ ρ b ∈ H")
apply (frule i_closed[of "x"],
       simp add:l_unit)
done

lemma (in Group) sg_mult_closed:"⟦G » H; x ∈ H; y ∈ H⟧ ⟹
                                       x ⋅ y ∈ H" 
apply (frule sg_i_closed[of "H" "y"], assumption,
       simp add:sg_def, (erule conjE)+)
apply (frule_tac x = x in bspec, assumption,
       rotate_tac -1,
       frule_tac x = "ρ y" in bspec, assumption,
       thin_tac "∀b∈H. x ⋅ ρ b ∈ H",
       thin_tac "∀a∈H. ∀b∈H. a ⋅ ρ b ∈ H")
apply (frule subsetD[of "H" "carrier G"], assumption+,
      simp add:iop_i_i)
done

lemma (in Group) nsg_sg: "G ▹ H ⟹ G » H"
by (simp add:nsg_def)

lemma (in Group) nsg_subset:"G ▹ N  ⟹ N ⊆ carrier G"
apply (simp add:nsg_def, (erule conjE)+)
apply (simp add:sg_subset)
done

lemma (in Group) nsg_lr_cst_eq:"⟦G ▹ N; a ∈ carrier G⟧ ⟹
                                     a ♢ N = N ∙ a"
by (simp add: nsg_def)

lemma (in Group) sg_i_m_closed:"⟦G » H; a ∈ H ; b ∈ H⟧ ⟹ (ρ a) ⋅ b ∈ H"
apply (rule sg_mult_closed, assumption+,
       simp add:sg_i_closed, assumption)
done

lemma (in Group) sg_m_i_closed:"⟦G » H; a ∈ H ; b ∈ H ⟧ ⟹ a ⋅ (ρ b) ∈ H"
apply (simp add:sg_def)
done

definition
  sg_gen :: "[_ , 'a set] ⇒ 'a set" where
  "sg_gen G A = ⋂{H. G » H ∧ A ⊆ H}"

lemma (in Group) smallest_sg_gen:"⟦A ⊆ carrier G; G » H; A ⊆ H⟧ ⟹
                                   sg_gen G A ⊆ H"
apply (simp add:sg_gen_def)
apply auto
done

lemma (in Group) special_sg_G: "G » (carrier G)"
apply (simp add:sg_def,
       cut_tac unit_closed, simp add:nonempty)
apply ((rule ballI)+, simp add:mult_closed i_closed)
done

lemma (in Group) special_sg_self: "G = ♮(carrier G)"
by (simp add:Gp_def)

lemma (in Group) special_sg_e: "G » {𝟭}"
apply (simp add:sg_def)
apply (simp add:unit_closed i_one l_unit)
done

lemma (in Group) inter_sgs:"⟦G » H; G » K⟧ ⟹ G » (H ∩ K)"
apply (frule sg_unit_closed[of "H"],
       frule sg_unit_closed[of "K"])
apply (simp add:sg_def)
apply auto
done

lemma (in Group) subg_generated:"A ⊆ carrier G  ⟹ G » (sg_gen G A)"
apply (simp add:sg_def)
apply (rule conjI,
       simp add:sg_gen_def,
       rule ex_nonempty, simp)
 apply (rule contrapos_pp, simp+,
        frule_tac x = 𝟭 in spec,
        thin_tac "∀x. ∃xa. G » xa  ∧ A ⊆ xa ∧ x ∉ xa",
        erule exE, (erule conjE)+,
        frule_tac H = x in sg_unit_closed, simp)

apply (rule conjI)
 apply (cut_tac special_sg_G,
        simp add:sg_gen_def,
        rule subsetI,
        blast)

apply ((rule ballI)+,
       simp add:sg_gen_def,
       rule allI, rule impI,
       frule_tac a = x in forall_spec, assumption,
       thin_tac "∀x. G » x  ∧ A ⊆ x ⟶ a ∈ x",
       frule_tac a = x in forall_spec, assumption,
       thin_tac "∀x. G » x  ∧ A ⊆ x ⟶ b ∈ x")
 apply (simp add:sg_m_i_closed)
done

definition
  Qg :: "[_ , 'a set] ⇒ 
         ⦇carrier:: 'a set set, top:: ['a set, 'a set] ⇒ 'a set,
           iop:: 'a set ⇒ 'a set, one:: 'a set ⦈" where
  "Qg G H = ⦇carrier = set_rcs G H, top = c_top G H, iop = c_iop G H, one = H ⦈"


definition
  Pj :: "[_ , 'a set] ⇒  ( 'a => 'a set)" where
  "Pj G H = (λx ∈ carrier G. H ∙⇘G⇙ x)"        

no_notation inverse_divide (infixl ‹'/› 70)

abbreviation
  QGRP :: "([('a, 'more) Group_scheme, 'a set] => ('a set) Group)"
    (infixl ‹'/› 70) where
  "G / H == Qg G H"
  

definition
  gHom ::"[('a, 'more) Group_scheme, ('b, 'more1) Group_scheme] ⇒ 
           ('a  ⇒ 'b) set" where
  "gHom G F = {f. (f ∈ extensional (carrier G) ∧ f ∈ carrier G → carrier F) ∧
       (∀x ∈ carrier G. ∀y ∈ carrier G. f (x ⋅⇘G⇙ y) = (f x) ⋅⇘F⇙ (f y))}"
 
definition
  gkernel ::"[('a, 'more) Group_scheme , ('b, 'more1) Group_scheme, 'a ⇒ 'b]
            ⇒ 'a set" where
  "gkernel G F f = {x. (x ∈ carrier G) ∧ (f x = 𝟭⇘F⇙)}"


definition
  iim :: "[('a, 'more) Group_scheme, ('b, 'more1) Group_scheme, 'a ⇒ 'b, 
            'b set]  ⇒ 'a set" where
  "iim G F f K = {x. (x ∈ carrier G) ∧ (f x ∈ K)}"

abbreviation
  GKER :: "[('a, 'more) Group_scheme, ('b, 'more1) Group_scheme, 'a ⇒ 'b ] ⇒ 'a set"
    (‹(3gker⇘_,_⇙ _)› [88,88,89]88) where
  "gker⇘G,F⇙ f == gkernel G F f"

definition
  gsurjec :: "[('a, 'more) Group_scheme, ('b, 'more1) Group_scheme, 
             'a ⇒ 'b] ⇒ bool"  (‹(3gsurj⇘_,_⇙ _)› [88,88,89]88) where
  "gsurj⇘F,G⇙ f ⟷ f ∈ gHom F G ∧ surj_to f (carrier F) (carrier G)" 


definition
  ginjec :: "[('a, 'more) Group_scheme, ('b, 'more1) Group_scheme, 
             'a ⇒ 'b]  ⇒ bool"    (‹(3ginj⇘_,_⇙ _)› [88,88,89]88) where
  "ginj⇘F,G⇙ f ⟷ f ∈ gHom F G ∧ inj_on f (carrier F)"

definition
  gbijec :: "[('a, 'm) Group_scheme, ('b, 'm1) Group_scheme, 'a ⇒ 'b]
             ⇒ bool"       (‹(3gbij⇘_,_⇙ _)› [88,88,89]88) where
  "gbij⇘F,G⇙ f ⟷ gsurj⇘F,G⇙ f ∧ ginj⇘F,G⇙ f"

definition
  Ug :: "_  ⇒  ('a, 'more) Group_scheme" where
  "Ug G = ♮⇘G⇙ {𝟭⇘G⇙}"

definition
  Ugp :: "_ ⇒ bool" where
  "Ugp G == Group G ∧ carrier G = {𝟭⇘G⇙}"

definition
  isomorphic :: "[('a, 'm) Group_scheme, ('b, 'm1) Group_scheme]
                         ⇒ bool"   (infix ‹≅› 100) where
  "F ≅ G ⟷ (∃f. gbij⇘F,G⇙ f)"

definition
  constghom :: "[('a, 'm) Group_scheme, ('b, 'm1) Group_scheme] 
                           ⇒ ('a ⇒ 'b)"  (‹('1'⇘_,_⇙)› [88,89]88) where
  "1⇘F,G⇙ = (λx∈carrier F. 𝟭⇘G⇙)" 

definition
  cmpghom :: "[('a, 'm) Group_scheme, 'b ⇒ 'c, 'a ⇒ 'b] ⇒ 'a ⇒ 'c" where
  "cmpghom F g f = compose (carrier F) g f"  

abbreviation
  GCOMP :: "['b ⇒ 'c, ('a, 'm) Group_scheme, 'a ⇒ 'b] ⇒ 'a ⇒ 'c"
    (‹(3_ ∘⇘_⇙ _)› [88, 88, 89]88) where
  "g ∘⇘F⇙ f == cmpghom F g f"

lemma Group_Ugp:"Ugp G ⟹ Group G"
by (simp add:Ugp_def)

lemma (in Group) r_mult_in_sg:"⟦G » H; a ∈ carrier G; x ∈ carrier G; x ⋅ a ∈ H⟧
                              ⟹ ∃h ∈ H. h ⋅ (ρ a) = x"
apply (frule inEx[of "x ⋅ a" "H"],
       erule bexE)
apply (rotate_tac -1, frule sym, thin_tac "y = x ⋅ a",
       frule_tac h = y in sg_subset_elem[of "H"], assumption+,
       frule_tac b1 = y in sol_eq_r[THEN sym, of "a" _ "x"], assumption+)
apply blast
done  

lemma (in Group) r_unit_sg:"⟦G » H; h ∈ H⟧ ⟹ h ⋅ 𝟭 = h"
by (frule sg_subset_elem [of "H" "h"], assumption,
       simp add:r_unit)

lemma (in Group) sg_l_unit:"⟦G » H; h ∈ H⟧ ⟹ 𝟭 ⋅ h = h"
by (frule sg_subset_elem [of "H" "h"], assumption+, simp add:l_unit)

lemma (in Group) sg_l_i:"⟦G » H; x ∈ H ⟧ ⟹ (ρ x) ⋅ x = 𝟭"
by (frule sg_subset_elem[of "H" "x"], assumption+,
       simp add:l_i)

lemma (in Group) sg_tassoc:"⟦G » H; x ∈ H; y ∈ H; z ∈ H⟧ ⟹
                  x ⋅ y ⋅ z = x ⋅ (y ⋅ z)" 
apply (frule sg_subset_elem[of "H" "x"], assumption+,
       frule sg_subset_elem[of "H" "y"], assumption+,
       frule sg_subset_elem[of "H" "z"], assumption+)
apply (simp add:tassoc)
done

lemma (in Group) sg_condition:"⟦H ⊆ carrier G; H ≠ {};
       ∀a. ∀b. a ∈ H ∧ b ∈ H ⟶  a ⋅ (ρ b) ∈ H⟧ ⟹ G » H"
by (simp add:sg_def)

definition
  Gimage :: "[('a, 'm) Group_scheme, ('b, 'm1) Group_scheme, 'a  ⇒ 'b] ⇒
                         ('b, 'm1) Group_scheme" where
  "Gimage F G f = Gp G (f `(carrier F))"
  
abbreviation
  GIMAGE :: "[('a, 'm) Group_scheme, ('b, 'm1) Group_scheme,
        'a ⇒ 'b ] ⇒ ('b, 'm1) Group_scheme"    (‹(3Img⇘_,_⇙ _)› [88,88,89]88) where
  "Img⇘F,G⇙ f == Gimage F G f"

lemma (in Group) Group_Gp:"G » H ⟹ Group (♮ H)" 
apply (simp add:Group_def Gp_def)
apply (simp add:sg_tassoc sg_l_i sg_unit_closed sg_l_unit
         sg_mult_closed sg_i_closed)
done
 
lemma (in Group) Gp_carrier:"G » H ⟹ carrier (Gp G H) = H" 
by (simp add:Gp_def)

lemma (in Group) sg_sg:"⟦G » K; G » H; H ⊆ K⟧ ⟹ Gp G K » H"
apply (simp add:sg_def [of "Gp G K" "H"])
apply (rule conjI, simp add:sg_def)
 apply (simp add:Gp_def)
 apply ((rule ballI)+, simp add:sg_m_i_closed)
done

lemma (in Group) sg_subset_of_subG:"⟦G » K; Gp G K » H⟧ ⟹ H ⊆ K"
by (simp add:sg_def[of "♮ K"], simp add:Gp_def)

lemma const_ghom:"⟦Group F; Group G⟧ ⟹ 1⇘F,G⇙ ∈ gHom F G"
apply (simp add:gHom_def constghom_def)
apply (simp add:Pi_def Group.unit_closed)
apply ((rule ballI)+, 
       cut_tac Group.unit_closed[of "G"],
       simp add:Group.mult_closed Group.l_unit)
apply assumption
done

lemma (in Group) const_gbij:"gbij⇘(♮ {𝟭}),(♮ {𝟭})⇙ (1⇘(♮{𝟭}),(♮{𝟭})⇙)"
apply (cut_tac special_sg_e,
       frule Group_Gp[of "{𝟭}"],
       frule const_ghom[of "♮ {𝟭}" "♮ {𝟭}"], assumption)
apply (simp add:gbijec_def)
apply (rule conjI, simp add:gsurjec_def,
       simp add:surj_to_def Gp_def constghom_def) 
apply (simp add:ginjec_def inj_on_def Gp_def)
done

lemma (in Group) unit_Groups_isom:" (♮ {𝟭}) ≅ (♮ {𝟭})" 
apply (unfold isomorphic_def,
       cut_tac const_gbij, blast)
done

lemma Ugp_const_gHom:"⟦Ugp G; Ugp E⟧ ⟹ (λx∈carrier G. 𝟭⇘E⇙) ∈ gHom G E"
apply (simp add:gHom_def)
 apply (rule conjI)
 apply (rule Pi_I)
 apply (simp add:Group.unit_closed[of "E"] Ugp_def) 
 apply (simp add:Ugp_def, (erule conjE)+)
 apply (cut_tac Group.unit_closed[of "G"], cut_tac Group.unit_closed[of "E"])
 apply (simp add:Group.l_unit) apply assumption+
done

lemma Ugp_const_gbij:"⟦Ugp G; Ugp E⟧ ⟹ gbij⇘G,E⇙ (λx∈carrier G. 𝟭⇘E⇙)"
apply (simp add:gbijec_def)
apply (simp add:gsurjec_def ginjec_def)
apply (simp add:Ugp_const_gHom)
apply (rule conjI)
apply (simp add:surj_to_def, simp add:Ugp_def)

apply (simp add:inj_on_def)
apply ((rule ballI)+, simp add:Ugp_def)
done
                       

lemma Ugps_isomorphic:"⟦Ugp G; Ugp E⟧ ⟹ G ≅ E"
apply (simp add:isomorphic_def)
apply (frule_tac Ugp_const_gbij[of "G" "E"], assumption+)
apply blast
done

lemma (in Group) Gp_mult_induced:"⟦G » L; a ∈ L; b ∈ L⟧  ⟹  
                          a ⋅⇘(Gp G L)⇙ b = a ⋅ b"
by (simp add:Gp_def)

lemma (in Group) sg_i_induced:"⟦G » L; a ∈ L⟧  ⟹ ρ⇘(Gp G L)⇙ a = ρ a"
by (simp add:Gp_def)

lemma (in Group) Gp_mult_induced1:"⟦G » H ; G » K; a ∈ H ∩ K; b ∈ H ∩ K⟧ 
          ⟹ a ⋅⇘♮(H ∩ K)⇙ b = a ⋅⇘(♮H)⇙ b"
by (simp add:Gp_def)

lemma (in Group) Gp_mult_induced2:"⟦G » H ; G » K; a ∈ H ∩ K; b ∈ H ∩ K⟧ 
          ⟹ a ⋅⇘♮(H ∩ K)⇙ b = a ⋅⇘(♮K)⇙ b"
by (simp add:Gp_def)

lemma (in Group) sg_i_induced1:"⟦G » H ; G » K; a ∈ H ∩ K⟧ 
                                     ⟹  ρ⇘♮(H ∩ K)⇙ a = ρ⇘(♮H)⇙ a"
by (simp add:Gp_def)

lemma (in Group) sg_i_induced2:"⟦G » H ; G » K; a ∈ H ∩ K⟧ 
          ⟹  ρ⇘♮(H ∩ K)⇙ a = ρ⇘♮K⇙ a"
by (simp add:Gp_def)

lemma (in Group) subg_sg_sg:"⟦G » K; (Gp G K) » H ⟧ ⟹ G » H" 
apply (frule sg_subset_of_subG[of "K" "H"], assumption+,
       simp add:sg_def [of _ "H"])
apply (simp add:Gp_def[of _ "K"],
       frule sg_subset[of "K"], simp add:subset_trans[of "H" "K" "carrier G"])
done 

lemma (in Group) Gp_inherited:"⟦G » K; G » L; K ⊆ L⟧ ⟹ 
                                Gp (Gp G L) K = Gp G K" 
by (simp add:Gp_def)

section "Cosets"

(* left cosets *)
lemma (in Group) mem_lcs:"⟦G » H; a ∈ carrier G; x ∈ a ♢ H⟧  ⟹ 
                          x ∈ carrier G"
by (simp add: lcs_def, erule bexE,
       frule_tac h = h in sg_mult_closedr[of "H" "a"], assumption+, simp)

lemma (in Group) lcs_subset:"⟦G » H; a ∈ carrier G⟧ ⟹ a ♢ H ⊆ carrier G"
apply (simp add:lcs_def,
       rule subsetI, simp, erule bexE)
apply (frule_tac h = h in sg_subset_elem[of "H"], assumption+,
       frule_tac a = a and b = h in mult_closed, assumption+)
apply simp
done

lemma (in Group) a_in_lcs:"⟦G » H; a ∈ carrier G⟧ ⟹ a ∈ a ♢ H"
apply (simp add: lcs_def,
       rule bexI [of _ "𝟭"],
       subst r_unit, assumption+, simp)
apply (simp add:sg_unit_closed)
done

lemma (in Group) eq_lcs1:"⟦G » H; a ∈ carrier G; b ∈ carrier G;
         x ∈ a ♢ H; a ♢ H = b ♢ H⟧ ⟹  x ∈ b ♢ H"
by simp

lemma (in Group) eq_lcs2:"⟦G » H; a ∈ carrier G; b ∈ carrier G;
                            a ♢ H = b ♢ H⟧ ⟹ a ∈ b ♢ H"
by (frule a_in_lcs[of "H" "a"], assumption+, simp)
 
lemma (in Group) lcs_mem_ldiv:"⟦G » H; a ∈ carrier G; b ∈ carrier G⟧ ⟹ 
                                  (a ∈ b ♢ H) = ((ρ b) ⋅ a ∈ H)"
apply (rule iffI)
apply (simp add: lcs_def, erule bexE)
apply (frule_tac x = h in sol_eq_l[of "b" "a"], assumption+,
       simp add:sg_subset_elem[of "H"], assumption+) 
apply (thin_tac "b ⋅ h = a", simp)

apply (frule_tac x = "(ρ b) ⋅ a" and A = H in inEx,
       erule bexE,
       frule_tac h = y in sg_subset_elem[of "H"], assumption+,
       frule sg_subset_elem[of "H" "(ρ b) ⋅ a"], assumption+)
apply (frule_tac a = y in l_mult_eqn[of _ "(ρ b) ⋅ a" "b"], assumption+,
       frule i_closed[of "b"],
       thin_tac "y = ρ b ⋅ a",
       simp add:tassoc[THEN sym], simp add:r_i l_unit)
apply (rotate_tac -2, frule sym, thin_tac "b ⋅ y = a", simp add:lcs_def,
       blast)
done

(*
lemma (in Group) lcsTr4:"⟦G » H; a ∈ carrier G; b ∈ carrier G;
 x ∈ carrier G⟧ ⟹ (i ((i a) ⋅ b)) ⋅ ((i a) ⋅ x) = (i b) ⋅ x"
apply (frule i_closed[of "a"], frule i_closed[of "b"],
       simp add:i_ab[of "i a" "b"])
apply (frule mult_closed[of "i a" "x"], assumption+,
       simp add:iop_i_i,
       simp add:tassoc[of "i b" "a" "(i a) ⋅ x"],
       simp add:tassoc[THEN sym, of "a" "i a" "x"] r_i l_unit)
done *)

lemma (in Group) lcsTr5:"⟦G » H; a ∈ carrier G; b ∈ carrier G;
                 (ρ a) ⋅ b ∈ H; x ∈ a ♢ H⟧ ⟹ ((ρ b) ⋅ x) ∈ H"
apply (frule mem_lcs[of "H" "a" "x"], assumption+,
       subst lcs_mem_ldiv[THEN sym, of "H" "x" "b"], assumption+,
       simp add:lcs_def, erule bexE)
apply (frule_tac h = h in sg_subset_elem[of "H"], assumption+,
       frule_tac x = h in sol_eq_l[of "a" "x"], assumption+,
       frule sg_i_m_closed[of "H" "(ρ a) ⋅ b" "(ρ a) ⋅ x"], assumption+,
       rotate_tac -1, frule sym, thin_tac "h = ρ a ⋅ x", simp)
apply (frule i_closed[of "a"],
       simp add:i_ab iop_i_i, frule i_closed[of "b"],
       simp add:tassoc[of "ρ b" "a"],
       simp add:tassoc[THEN sym, of "a" "ρ a" "x"] r_i l_unit)
apply (frule inEx[of "(ρ b) ⋅ x"], erule bexE,
       rotate_tac -1, frule sym, thin_tac "y = ρ b ⋅ x",
       frule_tac b = y in sol_eq_l[of "ρ b" _ "x"],
       simp add:sg_subset_elem, assumption+,
       simp add:iop_i_i, blast)
done

lemma (in Group) lcsTr6:"⟦G » H; a ∈ carrier G; b ∈ carrier G;
                         (ρ a) ⋅ b ∈ H; x ∈ a ♢ H⟧ ⟹  x ∈ b ♢ H"
by (frule lcsTr5[of "H" "a" "b" "x"], assumption+,
       subst lcs_mem_ldiv, assumption+, rule mem_lcs, assumption+)

lemma (in Group) lcs_Unit1:"G » H ⟹ 𝟭 ♢ H = H"
apply (rule equalityI)
apply (rule subsetI, simp add:lcs_def, erule bexE,
       frule_tac h = h in sg_subset_elem[of "H"], assumption+,
       simp add:l_unit)
apply (rule subsetI,
       simp add:lcs_def,
       frule_tac h = x in sg_subset_elem[of "H"], assumption+,
       frule_tac a = x in l_unit)
apply blast
done

lemma (in Group) lcs_Unit2:"⟦G » H; h ∈ H⟧ ⟹ h ♢ H = H"
apply (rule equalityI)
apply (rule subsetI, simp add:lcs_def, erule bexE,
       frule_tac x = h and y = ha in sg_mult_closed, assumption+, simp)
apply (rule subsetI,
       simp add:lcs_def,
       rule_tac  x = "(ρ h) ⋅ x" in bexI[of _ _ "H"])
apply (frule sg_subset_elem[of "H" "h"], assumption+,
       frule i_closed[of "h"],
       frule_tac h = x in sg_subset_elem[of "H"], assumption+,
       simp add:tassoc[THEN sym, of "h" "ρ h"] r_i l_unit)
apply (simp add:sg_i_m_closed[of "H" "h"])
done

lemma (in Group) lcsTr7:"⟦G » H; a ∈ carrier G; b ∈ carrier G; (ρ a) ⋅ b ∈ H⟧
                        ⟹ a ♢ H ⊆  b ♢ H"
apply (rule subsetI)
apply (simp add:lcsTr6 [of "H" "a" "b" _])
done

lemma (in Group) lcsTr8:"⟦G » H; a ∈ carrier G; h ∈ H⟧ ⟹ a ⋅ h ∈ a ♢ H"
apply (simp add:lcs_def)
apply blast
done

lemma (in Group) lcs_tool1:"⟦G » H; a ∈ carrier G; b ∈ carrier G;
      (ρ a) ⋅ b ∈ H⟧ ⟹ (ρ b) ⋅ a ∈ H"
by (frule sg_i_closed [of "H" "(ρ a) ⋅ b"], assumption+,
       frule i_closed[of "a"], simp add:i_ab iop_i_i)

theorem (in Group) lcs_eq:"⟦G » H; a ∈ carrier G; b ∈ carrier G⟧ ⟹ 
           ((ρ a) ⋅ b ∈ H) = (a ♢ H = b ♢ H)" 
apply (rule iffI)
 apply ((rule equalityI),
        (rule lcsTr7 [of "H" "a" "b"], assumption+),
        (frule lcs_tool1 [of "H" "a" "b"], assumption+),
        (rule lcsTr7 [of "H" "b" "a"], assumption+))
apply (subst lcs_mem_ldiv[THEN sym, of "H" "b" "a"], assumption+,
       simp add:a_in_lcs[of "H" "b"])
done

lemma (in Group) rcs_subset:"⟦G » H; a ∈ carrier G⟧ ⟹ H ∙ a ⊆ carrier G"
apply (rule subsetI,
       simp add:rcs_def, erule bexE,
       frule_tac h = h in sg_mult_closedl[of "H" "a"], assumption+)
apply simp
done

lemma (in Group) mem_rcs:"⟦G » H; x ∈ H ∙ a⟧ ⟹ ∃h∈H. h ⋅ a = x" 
by (simp add:rcs_def)

lemma (in Group) rcs_subset_elem:"⟦G » H; a ∈ carrier G; x ∈ H ∙ a⟧  ⟹ 
                                                        x ∈ carrier G"
apply (simp add:rcs_def, erule bexE)
apply (frule_tac h = h in sg_mult_closedl[of "H" "a"], assumption+,
       simp)
done

lemma (in Group) rcs_in_set_rcs:"⟦G » H; a ∈ carrier G⟧ ⟹ 
          H ∙ a ∈ set_rcs G H"
apply (simp add:set_rcs_def)
apply blast
done

lemma (in Group) rcsTr0:"⟦G » H; a ∈ carrier G; b ∈ carrier G⟧ ⟹
                         H ∙ (a ⋅ b) ∈ set_rcs G H"
apply (rule rcs_in_set_rcs [of "H" "a ⋅ b"], assumption)
apply (simp add:mult_closed)
done

lemma (in Group) a_in_rcs:"⟦G » H; a ∈ carrier G⟧ ⟹ a ∈ H ∙ a"
apply (simp add: rcs_def)
apply (frule l_unit[of "a"],
       frule sg_unit_closed[of "H"], blast)
done

lemma (in Group) rcs_nonempty:"⟦G » H; X ∈ set_rcs G H⟧ ⟹ X ≠ {}"
apply (simp add:set_rcs_def, erule bexE)
apply (frule_tac a = a in a_in_rcs[of "H"], assumption+, simp)
apply (simp add:nonempty)
done

lemma (in Group) rcs_tool0:"⟦G » H; a ∈ carrier G; b ∈ carrier G;
      a ⋅ (ρ b) ∈ H⟧ ⟹ b ⋅ (ρ a) ∈ H"
by (frule sg_i_closed [of "H" "a ⋅ ( ρ b)"], assumption+,
       frule i_closed[of "b"], simp add:i_ab iop_i_i)

lemma (in Group) rcsTr1:"⟦G » H; a ∈ carrier G; b ∈ carrier G;
         x ∈ H ∙ a; H ∙ a = H ∙ b⟧ ⟹ x ∈ H ∙ b"
by simp

lemma (in Group) rcs_eqTr:"⟦G » H; a ∈ carrier G; b ∈ carrier G;
                             H ∙ a = H ∙ b⟧ ⟹ a ∈ H ∙ b"
apply (rule rcsTr1, assumption+)
apply (rule a_in_rcs, assumption+)
done 

lemma (in Group) rcs_eqTr1:"⟦G » H; a ∈ carrier G; b ∈ carrier G⟧ ⟹ 
           (a ∈ H ∙ b) =  (a ⋅ (ρ b) ∈ H)"
apply (rule iffI)
apply (simp add:rcs_def, erule bexE,
       frule_tac h = h in sg_subset_elem[of "H"], assumption+)
apply (frule_tac x = h in sol_eq_r[of "b" "a" _], assumption+, simp)
apply (frule inEx[of "a ⋅ (ρ b)" "H"], erule bexE)
apply (frule_tac h = y in sg_subset_elem[of "H"], assumption+,
       frule i_closed[of "b"])
apply (rotate_tac -3, frule sym, thin_tac "y = a ⋅ ρ b",
       frule_tac b = y in sol_eq_r[of "ρ b" _ "a"], assumption+,
       simp add:iop_i_i)
apply (simp add:rcs_def, blast)
done   
       
lemma (in Group) rcsTr2:"⟦G » H; a ∈ carrier G; b ∈ H ∙ (ρ a)⟧ ⟹ 
                          b ⋅ a ∈ H" 
apply (frule i_closed[of "a"],
       frule_tac rcs_subset_elem[of "H" "ρ a" "b"], assumption+,
       frule rcs_eqTr1[of "H" "b" "ρ a"], assumption+)
apply (simp add:iop_i_i)
done

lemma (in Group) rcsTr5:"⟦G » H; a ∈ carrier G; b ∈ carrier G;
       b ⋅ (ρ a) ∈ H; x ∈ H ∙ a⟧ ⟹ x ⋅ (ρ b) ∈ H"
apply (frule rcs_subset_elem[of "H" "a" "x"], assumption+,
       simp add:rcs_def, erule bexE)
apply (frule_tac h = h in sg_subset_elem[of "H"], assumption,
       frule_tac a = h and b = a in mult_closed, assumption+,
       frule i_closed[of "b"])
apply (frule_tac a = "h ⋅ a" in r_mult_eqn[of _ "x" "ρ b"], assumption+,
       thin_tac "h ⋅ a = x",
       simp add:tassoc[of _ "a" "ρ b"],
       frule_tac x = h in sg_mult_closed[of "H" _ "a ⋅ (ρ b)"], assumption+,
       rule rcs_tool0[of "H" "b" "a"], assumption+)
apply simp
done

lemma (in Group) rcsTr6:"⟦G » H; a ∈ carrier G; b ∈ carrier G;
                  b ⋅ (ρ a) ∈ H ; x ∈ H ∙ a⟧ ⟹ x ∈ H ∙ b"
apply (frule  rcsTr5 [of "H" "a" "b" "x"], assumption+)
apply (subst rcs_eqTr1[of "H" "x" "b"], assumption+)
apply (rule rcs_subset_elem[of "H" "a" "x"], assumption+)
done

lemma (in Group) rcs_Unit1:"G » H ⟹  H ∙ 𝟭 = H"
apply (rule equalityI)
apply (rule subsetI,
       simp add:rcs_def, erule bexE,
       frule_tac h = h in sg_subset_elem[of "H"], assumption+,
       simp add:r_unit)
apply (rule subsetI)
apply (simp add:rcs_def,
       frule_tac h = x in sg_subset_elem[of "H"], assumption+,
       frule_tac a = x in r_unit, blast)
done

lemma (in Group) unit_rcs_in_set_rcs:"G » H ⟹ H ∈ set_rcs G H"
apply (cut_tac unit_closed)
apply (frule rcs_in_set_rcs[of "H" "𝟭"], assumption+)
apply (simp add:rcs_Unit1)
done

lemma (in Group) rcs_Unit2:"⟦G » H; h ∈ H⟧ ⟹ H ∙ h = H"
apply (rule equalityI)
 apply (rule subsetI,
        simp add:rcs_def, erule bexE,
        frule_tac x = ha and y = h in sg_mult_closed[of "H"], assumption+,
        simp)

apply (rule subsetI,
       simp add:rcs_def)
apply (frule_tac h = h in sg_subset_elem[of "H"], assumption+,
       frule_tac h = x in sg_subset_elem[of "H"], assumption+,
       frule i_closed[of "h"],
       frule_tac a = x in tassoc[of _ "ρ h" "h"], assumption+,
       simp add:l_i r_unit)
apply (frule_tac a = x in sg_m_i_closed[of "H" _ "h"], assumption+,
       blast)
done
     
lemma (in Group) rcsTr7:"⟦G » H; a ∈ carrier G; b ∈ carrier G; b ⋅ (ρ a) ∈ H⟧
                         ⟹ H ∙ a  ⊆  H ∙ b"
apply (rule subsetI)
apply (rule rcsTr6[of "H" "a" "b"], assumption+)
done 

lemma (in Group) rcs_tool1:"⟦G » H; a ∈ carrier G; b ∈ carrier G; 
      b ⋅ (ρ a) ∈ H⟧ ⟹  a ⋅ (ρ b) ∈ H "
apply (frule sg_i_closed[of "H" "b ⋅ (ρ a)"], assumption+)
 apply (frule i_closed[of "a"], simp add:i_ab iop_i_i)
done

lemma (in Group) rcs_tool2:"⟦G » H; a ∈ carrier G;  x ∈ H ∙ a⟧ ⟹
                               ∃ h ∈ H. h ⋅ a = x"
apply (simp add:rcs_def)
done

theorem (in Group) rcs_eq:"⟦G » H; a ∈ carrier G; b ∈ carrier G⟧ ⟹
                            (b ⋅ (ρ a) ∈ H) = (H ∙ a = H ∙ b)"
apply (rule iffI)
apply (rule equalityI)
apply (frule rcsTr7[of "H" "a" "b"], assumption+)
apply (frule rcs_tool1[of "H" "a" "b"], assumption+)
apply (rule rcsTr7[of "H" "b" "a"], assumption+)
apply (frule a_in_rcs[of "H" "a"], assumption, simp)
apply (simp add:rcs_eqTr1[of "H" "a" "b"])
apply (rule rcs_tool1, assumption+)
done

lemma (in Group) rcs_eq1:"⟦G » H; a ∈ carrier G; x ∈ H ∙ a⟧ ⟹
                                           H ∙ a = H ∙ x"
apply (frule rcs_subset_elem[of "H" "a" "x"], assumption+)
apply (subst rcs_eq[THEN sym, of "H" "a" "x"], assumption+)
apply (subst rcs_eqTr1[THEN sym, of "H" "x" "a"], assumption+)
done

lemma (in Group) rcs_eq2:"⟦G » H; a ∈ carrier G;  b ∈ carrier G; 
                           (H ∙ a) ∩ (H ∙ b) ≠ {}⟧ ⟹ (H ∙ a) = (H ∙ b)"
apply (frule nonempty_int [of "H ∙ a" "H ∙ b"], erule exE)
apply (simp, erule conjE)
apply (frule_tac x = x in rcs_eq1[of "H" "a"], assumption+,
       frule_tac x = x in rcs_eq1[of "H" "b"], assumption+)
apply simp
done

lemma (in Group) rcs_meet:"⟦G » H; X ∈ set_rcs G H; Y ∈ set_rcs G H;
                               X ∩ Y ≠ {}⟧ ⟹ X = Y"
apply (simp add:set_rcs_def, (erule bexE)+, simp)
apply (rule_tac a = a and b = aa in rcs_eq2[of "H"], assumption+)
done
      
lemma (in Group) rcsTr8:"⟦G » H; a ∈ carrier G; h ∈ H; x ∈ H ∙ a⟧ ⟹
                      h ⋅ x ∈ H ∙ a"
apply (frule rcs_subset_elem[of "H" "a" "x"], assumption+,
       frule sg_subset_elem[of "H" "h"], assumption+)
apply (simp add:rcs_def, erule bexE,
       frule_tac h = ha in sg_subset_elem[of "H"], assumption+,
       frule_tac a = ha and b = a in mult_closed, assumption,
       frule_tac a = "ha ⋅ a" and b = x and c = h in l_mult_eqn, assumption+,
       thin_tac "ha ⋅ a = x", simp add:tassoc[THEN sym, of "h" _ "a"])
apply (frule_tac x = h and y = ha in sg_mult_closed[of "H"], assumption+,
       blast)
done

lemma (in Group) rcsTr9:"⟦G » H; a ∈ carrier G; h ∈ H; (ρ x) ∈ H ∙ a⟧ ⟹
                          h ⋅ (ρ x) ∈ H ∙ a"
by (insert rcsTr8 [of "H" "a" "h" "ρ x"], simp)

lemma (in Group) rcsTr10:"⟦G » H; a ∈ carrier G; x ∈ H ∙ a; y ∈ H ∙ a⟧ ⟹
                          x ⋅ (ρ y) ∈ H" 
apply (simp add:rcs_def)
apply (erule bexE)+
apply (rotate_tac -1, frule sym, thin_tac "ha ⋅ a = y",
       frule sym, thin_tac "h ⋅ a = x", simp,
       thin_tac "y = ha ⋅ a", thin_tac "x = h ⋅ a")
apply (frule_tac h = ha in sg_subset_elem[of "H"], assumption+,
       frule_tac h = h in sg_subset_elem[of "H"], assumption+,
       simp add:i_ab)
apply (frule_tac a = a in i_closed, frule_tac a = ha in i_closed,
       simp add:tOp_assocTr41[THEN sym], simp add:tOp_assocTr42,
       simp add:r_i r_unit)
apply (simp add:sg_m_i_closed[of "H"])
done

lemma (in Group) PrSubg4_2:"⟦G » H; a ∈ carrier G; x ∈ H ∙ (ρ a)⟧ ⟹ 
       x ∈ {z. ∃v∈(H ∙ a). ∃h∈H. h ⋅ (ρ v) = z}"
apply (simp add:rcs_def[of _ "H" "ρ a"], erule bexE,
       frule_tac h = h in sg_subset_elem[of "H"], assumption+,
       frule i_closed[of "a"])
apply (frule a_in_rcs[of "H" "a"], assumption, blast)
done

lemma (in Group) rcs_fixed:"⟦G » H; a ∈ carrier G; H ∙ a = H⟧  ⟹ a ∈ H"
by (frule a_in_rcs[of "H" "a"], assumption+, simp)

lemma (in Group) rcs_fixed1:"⟦G » H; a ∈ carrier G; h ∈ H⟧ ⟹
                                               H ∙ a = (H ∙ (h ⋅ a))"
apply (rule rcs_eq1[of "H" "a" "h ⋅ a"], assumption+)
apply (simp add:rcs_def, blast)
done  

lemma (in Group) rcs_fixed2:"G » H ⟹ ∀h∈H. H ∙ h = H"
apply (rule ballI)
apply (simp add:rcs_Unit2)
done

lemma (in Group) Gp_rcs:"⟦G » H; G » K; H ⊆ K; x ∈ K⟧ ⟹
                                   H ∙⇘(Gp G K)⇙ x = (H ∙ x)"
by (simp add:rcs_def, simp add:Gp_def)

lemma (in Group) subg_lcs:"⟦G » H; G » K; H ⊆ K; x ∈ K⟧ ⟹
                                   x ♢⇘(Gp G K)⇙ H = x ♢ H"
by (simp add:lcs_def, simp add:Gp_def)

section "Normal subgroups and Quotient groups"

lemma (in Group) nsg1:"⟦G » H; b ∈ carrier G; h ∈ H;
       ∀a∈ carrier G. ∀h∈H. (a ⋅ h)⋅ (ρ a) ∈ H⟧ ⟹ b ⋅ h ⋅ (ρ b) ∈ H"
by blast

lemma (in Group) nsg2:"⟦G » H; b ∈ carrier G; h ∈ H;  
       ∀a∈carrier G. ∀h∈H. (a ⋅ h) ⋅ (ρ a) ∈ H⟧ ⟹  (ρ b) ⋅ h ⋅ b ∈ H"
apply (frule i_closed[of "b"], 
       frule_tac x = "ρ b" in bspec, assumption,
       thin_tac "∀a∈carrier G. ∀h∈H. a ⋅ h ⋅ ρ a ∈ H",
       frule_tac x = h in bspec, assumption,
       thin_tac "∀h∈H. ρ b ⋅ h ⋅ ρ (ρ b) ∈ H")
apply (simp add:iop_i_i)
done

lemma (in Group) nsg_subset_elem:"⟦G ▹ H; h ∈ H⟧ ⟹ h ∈ carrier G"
by (insert nsg_sg[of "H"], simp add:sg_subset_elem)

lemma (in Group) nsg_l_rcs_eq:"⟦G ▹ N; a ∈ carrier G⟧ ⟹ a ♢ N = N ∙ a"
by (simp add: nsg_def)

lemma (in Group) sg_nsg1:"⟦G » H; ∀a∈ carrier G. ∀h∈H. (a ⋅ h)⋅ (ρ a) ∈ H;
                 b ∈ carrier G ⟧ ⟹ H ∙ b =  b ♢ H"
apply (rule equalityI)
 (* H ∙ b ⊆ b ♢ H  *)
  apply (rule subsetI, simp add:rcs_def, erule bexE, frule i_closed[of "b"])
  apply (frule_tac x = "ρ b" in bspec, assumption,
         thin_tac "∀a∈carrier G. ∀h∈H. a ⋅ h ⋅ ρ a ∈ H",
         frule_tac x = h in bspec, assumption,
         thin_tac "∀h∈H. ρ b ⋅ h ⋅ ρ (ρ b) ∈ H",
         simp add:iop_i_i)
  apply (frule_tac h = h in sg_mult_closedl[of "H" "b"], assumption+, simp,
         frule_tac h = h in sg_subset_elem[of "H"], assumption+,
         simp only:tassoc[of "ρ b" _ "b"], thin_tac "h ⋅ b = x")
  apply (subst lcs_mem_ldiv[of "H" _ "b"], assumption+)

  apply (rule subsetI, simp add:lcs_def, erule bexE)
  apply (frule_tac x = b in bspec, assumption,
         thin_tac "∀a∈carrier G. ∀h∈H. a ⋅ h ⋅ ρ a ∈ H",
         frule_tac x = h in bspec, assumption,
         thin_tac "∀h∈H.  b ⋅ h ⋅ (ρ b) ∈ H",
         simp add:iop_i_i)
  apply (frule_tac h = h in sg_mult_closedr[of "H" "b"], assumption+, simp)
  apply (subst rcs_eqTr1[of "H" _ "b"], assumption+)
done 

lemma (in Group) cond_nsg:"⟦G » H; ∀a∈carrier G. ∀h∈H. a ⋅ h ⋅ (ρ a) ∈ H ⟧
                            ⟹ G ▹ H" 
apply (subst nsg_def, simp)
apply (rule ballI, rule sg_nsg1, assumption+)
done

lemma (in Group) special_nsg_e:"G » H ⟹ Gp G H ▹ {𝟭}"
apply (simp add:nsg_def,
       frule Group_Gp[of "H"])
apply (rule conjI)
apply (frule Group.special_sg_e[of "♮H"],
       simp add:one_Gp_one[THEN sym])

apply (rule ballI,
       simp add:lcs_def rcs_def, simp add:Gp_def,
       frule_tac h = x in sg_subset_elem[of "H"], assumption+,
       simp add:l_unit r_unit)
done

lemma (in Group) special_nsg_G:"G ▹ (carrier G)" 
apply (simp add:nsg_def,
       simp add:special_sg_G)
apply (rule ballI, rule equalityI)
apply (rule subsetI,
       simp add:rcs_def lcs_def, erule bexE)
apply (frule_tac a = h and b = x in mult_closed, assumption+,
       frule_tac a = x in i_closed,
       frule_tac a1 = x and b1 = "ρ x" and c1 = "h ⋅ x" in tassoc[THEN sym],
                 assumption+, simp add:r_i l_unit,
       frule_tac a = "ρ x" and b = xa in mult_closed, assumption+, blast)

apply (rule subsetI, simp add:rcs_def lcs_def, erule bexE,
       frule_tac a = x and b = h in mult_closed, assumption+,
       frule_tac a = x in i_closed,
       frule_tac a = "x ⋅ h"  and b = "ρ x" and c = x in tassoc,
                 assumption+, simp add:l_i r_unit,
       frule_tac a = xa and b = "ρ x" in mult_closed, assumption+,
       blast)
done

lemma (in Group) special_nsg_G1:"G » H ⟹ Gp G H ▹ H" 
apply (frule Group_Gp[of "H"], frule Group.special_nsg_G[of "♮H"])
apply (simp add:Gp_carrier)
done

lemma (in Group) nsgTr0:"⟦G ▹ N; a ∈ carrier G; b ∈ carrier G; b ∈ N ∙ a ⟧
                        ⟹  (a ⋅ (ρ b) ∈ N) ∧ ((ρ a) ⋅ b ∈ N)"
apply (frule nsg_sg[of "N"],
       frule rcs_eqTr1[of "N" "b" "a"], assumption+, simp,
       frule i_closed[of "a"], 
       frule sg_i_closed[of "N" "b ⋅ ρ a"], assumption, simp add:i_ab iop_i_i)
apply (simp add:nsg_l_rcs_eq[THEN sym, of "N" "a"],
       subst lcs_mem_ldiv[THEN sym, of "N" "b" "a"], assumption+)
done

lemma (in Group) nsgTr1:"⟦G ▹ N; a ∈ carrier G; b ∈ carrier G; b ⋅ (ρ a) ∈ N⟧
                         ⟹ (ρ b) ⋅ a ∈ N"
apply (frule nsg_sg[of "N"],
       simp add:rcs_eqTr1[THEN sym, of "N" "b" "a"],
       simp add:nsg_l_rcs_eq[THEN sym])
apply (simp add:lcs_mem_ldiv[of "N" "b" "a"],
       rule lcs_tool1, assumption+)
done      

lemma (in Group) nsgTr2:"⟦a ∈ carrier G; b ∈ carrier G; a1 ∈ carrier G; 
       b1 ∈ carrier G ⟧ ⟹ (a ⋅ b) ⋅ (ρ (a1 ⋅ b1)) = 
                          a ⋅ (((b ⋅ (ρ b1)) ⋅ ((ρ a1) ⋅ a)) ⋅ (ρ a))"
apply (frule i_closed[of "a1"], frule i_closed[of "b1"],
       frule i_closed[of "a"],
       frule mult_closed[of "b" "ρ b1"], assumption+,
       frule mult_closed[of "ρ a1" "a"], assumption+,
       subst tassoc[of "b ⋅ (ρ b1)" "(ρ a1) ⋅ a" "ρ a"], assumption+,
       simp add:tassoc[of "ρ a1" "a" "ρ a"] r_i r_unit) 
apply (simp add:i_ab,
       subst tassoc[of "a" "b" "(ρ b1) ⋅ (ρ a1)"], assumption+,
       rule mult_closed, assumption+,
       simp add:tassoc[THEN sym, of "b" "ρ b1" "ρ a1"])
done

lemma (in Group) nsgPr1:"⟦G ▹ N; a ∈ carrier G; h ∈ N⟧ ⟹
                                                 a ⋅ (h ⋅ (ρ a)) ∈ N"
apply (frule nsg_sg[of "N"], 
       frule sg_subset_elem[of "N" "h"], assumption+,
       frule i_closed[of "a"],
       frule rcs_fixed1[THEN sym, of "N" "ρ a" "h"], assumption+, 
       frule mult_closed[of "h" "ρ a"], assumption+)
apply (frule a_in_rcs[of "N" "h ⋅ (ρ a)"], assumption+, simp,
       thin_tac "N ∙ (h ⋅ ρ a) = N ∙ ρ a")
apply (simp add:nsg_l_rcs_eq[THEN sym, of "N" "ρ a"],
       simp add:lcs_mem_ldiv[of "N" "h ⋅ (ρ a)" "ρ a"] iop_i_i)
done       
    
lemma (in Group) nsgPr1_1:"⟦G ▹ N; a ∈ carrier G ; h ∈ N⟧ ⟹ 
                              (a ⋅ h) ⋅ (ρ a) ∈ N"
apply (frule nsgPr1[of "N" "a" "h"], assumption+)
apply (frule nsg_sg[of "N"],
       frule sg_subset_elem[of "N" "h"], assumption+,
       frule i_closed[of "a"],
       simp add:tassoc[THEN sym, of "a" "h" "ρ a"])
done

lemma (in Group) nsgPr2:"⟦G ▹ N; a ∈ carrier G; h ∈ N⟧ ⟹
                                   (ρ a) ⋅ (h ⋅ a) ∈ N"
apply (frule i_closed[of "a"],
       frule nsgPr1[of "N" "ρ a" "h"], assumption+)
apply (simp add:iop_i_i)
done

lemma (in Group) nsgPr2_1:"⟦G ▹ N; a ∈ carrier G; h ∈ N⟧ ⟹
                                              (ρ a) ⋅ h ⋅ a ∈ N"
apply (frule i_closed[of "a"],
       frule  nsgPr1_1[of "N" "ρ a" "h"], assumption+, simp add:iop_i_i)
done

lemma (in Group) nsgTr3:"⟦G ▹ N; a ∈ carrier G; b ∈ carrier G; 
a1 ∈ carrier G; b1 ∈ carrier G;  a ⋅ (ρ a1) ∈ N; b ⋅ (ρ b1) ∈ N⟧ ⟹ 
                  (a ⋅ b) ⋅ (ρ (a1 ⋅ b1)) ∈ N"
apply (frule nsg_sg[of "N"]) 
apply (frule  nsgTr2 [of "a" "b" "a1" "b1"], assumption+)
apply (frule  nsgTr1 [of "N" "a1" "a"], assumption+)

apply (frule i_closed[of "a"],
       frule sg_i_closed [of "N" "(ρ a) ⋅ a1"], assumption+, 
        simp add:i_ab[of "ρ a" "a1"] iop_i_i,
       frule sg_mult_closed[of "N" "b ⋅ (ρ b1)" "(ρ a1) ⋅ a"], assumption+)
apply (rule nsgPr1[of "N" "a" "b ⋅ (ρ b1) ⋅ ((ρ a1) ⋅ a)"], assumption+)
done

lemma (in Group) nsg_in_Gp:"⟦G ▹ N; G » H; N ⊆ H⟧ ⟹ (Gp G H) ▹ N"
apply (frule Group_Gp [of "H"],
       frule nsg_sg[of "N"]) 
apply (rule Group.cond_nsg [of "♮H" "N"], assumption+,
       simp add:sg_sg[of "H" "N"])
apply (rule ballI, rule ballI,
       (subst Gp_def)+, simp add:Gp_carrier)
apply (frule_tac h = a in sg_subset_elem[of "H"], assumption+,
       rule_tac a = a and h = h in nsgPr1_1[of "N"], assumption+)
done

lemma (in Group) nsgTr4:"⟦G ▹ N; a ∈ carrier G;  x ∈ N ∙ a⟧ ⟹ 
                            (ρ x) ∈ N ∙ (ρ a)"
apply (frule nsgTr0 [of "N"], assumption+)
apply (frule nsg_sg[of "N"], rule a_in_rcs[of "N"], assumption+,
       thin_tac "a ⋅ ρ a ∈ N ∧ ρ a ⋅ a ∈ N",
       frule nsg_sg[of "N"],
       frule rcs_subset_elem[of "N" "a" "x"], assumption+,
       simp add:rcs_eqTr1[of "N" "x" "a"])
apply (frule nsgTr1[of "N" "a" "x"], assumption+,
       frule i_closed[of "x"],
       subst rcs_eqTr1[of "N" "ρ x" "ρ a"], assumption+,
       simp add:i_closed, simp add:iop_i_i)
done

lemma (in Group) c_topTr1:"⟦G ▹ N; a ∈ carrier G; b ∈ carrier G; 
       a1 ∈ carrier G; b1 ∈ carrier G; N ∙ a = N ∙ a1; N ∙ b = N ∙ b1⟧ ⟹ 
                      N ∙ (a ⋅ b) = N ∙ (a1 ⋅ b1)"
apply (frule nsg_sg[of "N"],
       frule mult_closed[of "a" "b"], assumption+,
       frule mult_closed[of "a1" "b1"], assumption+,
       simp add:rcs_eq[THEN sym, of "N" "a" "a1"],
       simp add:rcs_eq[THEN sym, of "N" "b" "b1"])
apply (subst rcs_eq[THEN sym, of "N" "a ⋅ b" "a1 ⋅ b1"], assumption+)
apply (rule nsgTr3[of "N" "a1" "b1" "a" "b"], assumption+)
done

lemma (in Group) c_topTr2:"⟦G ▹ N; a ∈ carrier G; a1 ∈ carrier G;
                 N ∙ a = N ∙ a1 ⟧ ⟹ N ∙ (ρ a) = N ∙ (ρ a1)"
apply (frule nsg_sg[of "N"], 
       simp add:rcs_eq[THEN sym, of "N" "a" "a1"])
apply (subst rcs_eq[THEN sym, of "N" "ρ a" "ρ a1"], assumption+,
       simp add:i_closed, simp add:i_closed, simp add:iop_i_i)
apply (rule nsgTr1[of "N" "a" "a1"], assumption+)
done

lemma (in Group) c_iop_welldefTr1:"⟦G ▹ N; a ∈ carrier G⟧ ⟹
                         c_iop G N (N ∙ a) ⊆  N ∙ (ρ a)"
apply (frule nsg_sg[of "N"],
       frule i_closed[of "a"])  
apply (rule subsetI)
apply (simp add:c_iop_def rcs_in_set_rcs)
apply (erule bexE)+
apply (simp add:rcs_def[of _ "N" "a"], erule bexE,
       rotate_tac -1, frule sym, thin_tac "ha ⋅ a = xa", simp,
       thin_tac "xa = ha ⋅ a")
apply (frule_tac h = ha in sg_subset_elem[of "N"], assumption+,
       frule_tac a = ha and b = a in mult_closed, assumption+,
       frule_tac a = "ha ⋅ a" in i_closed,
       frule_tac h = h in sg_subset_elem[of "N"], assumption+,
       frule_tac a = h and b = "ρ (ha ⋅ a)" in mult_closed, assumption+)
apply (frule_tac a = "h ⋅ ρ (ha ⋅ a)" and b = x in r_mult_eqn[of _ _ 
       "a ⋅ (ρ a)"], simp, simp add:r_i unit_closed, assumption)
apply (frule_tac a = "h ⋅ ρ (ha ⋅ a)" in tassoc[of _ "a" "ρ a"], assumption+,
       frule_tac a = "h ⋅ ρ (ha ⋅ a)" and A = "carrier G" and b = x in 
                 eq_elem_in, assumption+,
       thin_tac "h ⋅ ρ (ha ⋅ a) = x", simp,
       thin_tac "h ⋅ ρ (ha ⋅ a) ⋅ (a ⋅ ρ a) = x ⋅ (a ⋅ ρ a)")
apply (frule_tac a = h and b = "ρ (ha ⋅ a)" and c = a in tassoc, assumption+,
       simp, thin_tac "h ⋅ ρ (ha ⋅ a) ⋅ a = h ⋅ (ρ (ha ⋅ a) ⋅ a)")
apply (simp add:i_ab r_i r_unit)
apply (frule_tac x = ha in sg_i_closed[of "N"], assumption+,
       frule sym, thin_tac "h ⋅ (ρ a ⋅ ρ ha ⋅ a) ⋅ ρ a = x", simp,
       thin_tac "x = h ⋅ (ρ a ⋅ ρ ha ⋅ a) ⋅ ρ a")
apply (frule_tac h = "ρ ha" in nsgPr2_1[of "N" "a"], assumption+,
       frule_tac x = h and y = "ρ a ⋅ ρ ha ⋅ a" in sg_mult_closed, assumption+)
apply (simp add:rcs_def, blast)
done

lemma (in Group) c_iop_welldefTr2:"⟦G ▹ N; a ∈ carrier G⟧ ⟹
                                   N ∙ (ρ a) ⊆  c_iop G N (N ∙ a)"
apply (rule subsetI) 
 apply (frule nsg_sg[of "N"],
        frule i_closed[of "a"],
        frule_tac x = x in rcs_subset_elem[of "N" "ρ a"], assumption+)
apply (simp add:c_iop_def,
       simp add:rcs_in_set_rcs[of "N" "a"],
       simp add:rcs_def[of _ "N" "ρ a"])
 apply (frule a_in_rcs[of "N" "a"], assumption, blast)
done
 
lemma (in Group) c_iop_welldef:"⟦G ▹ N; a ∈ carrier G⟧ ⟹
                 c_iop G N (N ∙ a) =  N ∙ (ρ a)"  
 apply (rule equalityI) 
 apply (simp only:c_iop_welldefTr1[of "N" "a"])
 apply (simp only:c_iop_welldefTr2[of "N" "a"])
done

lemma (in Group) c_top_welldefTr1:"⟦G ▹ N; a ∈ carrier G; 
          b ∈ carrier G; x ∈ N ∙ a; y ∈ N ∙ b⟧ ⟹ x ⋅ y ∈ N ∙ (a ⋅ b)"
apply (frule nsg_sg[of "N"])
apply (frule_tac x = x in rcs_subset_elem[of "N" "a"], assumption+,
       frule_tac x = y in rcs_subset_elem[of "N" "b"], assumption+,
       frule rcs_eqTr1[of "N" "x" "a"], assumption+,
       frule rcs_eqTr1[of "N" "y" "b"], assumption+, simp)      
apply (frule_tac mult_closed[of "a" "b"], assumption+,
       frule_tac mult_closed[of "x" "y"], assumption+)
apply (subst rcs_eqTr1[of "N" "x ⋅ y" "a ⋅ b"], assumption+,
       rule nsgTr3[of "N" "x" "y" "a" "b"], assumption+)
done

lemma (in Group) c_top_welldefTr2:"⟦G ▹ N; a ∈ carrier G; b ∈ carrier G ⟧ 
                       ⟹ c_top G N (N ∙ a) (N ∙ b) ⊆  N ∙ (a ⋅ b)"
apply (frule nsg_sg[of "N"],
       simp add:c_top_def, simp add:rcs_in_set_rcs)
apply (rule subsetI, simp, (erule bexE)+,
       frule_tac x = xa and y = y in c_top_welldefTr1[of "N" "a" "b"], 
       assumption+, simp)
done

lemma (in Group) c_top_welldefTr4:"⟦G ▹ N; a ∈ carrier G; b ∈ carrier G; 
      x ∈ N ∙ (a ⋅ b)⟧ ⟹ x ∈ c_top G N (N ∙ a) (N ∙ b)" 
apply (frule nsg_sg[of "N"]) 
apply (simp add:c_top_def, simp add:rcs_in_set_rcs,
       simp add:rcs_def[of _ "N" "a ⋅ b"], erule bexE,
       frule_tac h = h in sg_subset_elem[of "N"], assumption+,
       simp add:tassoc[THEN sym, of _ "a" "b"])
apply (frule a_in_rcs[of "N" "b"], assumption,
       frule_tac h1 = h in rcs_fixed1[THEN sym, of "N" "a"], assumption+,
       frule_tac a = h and b = a in mult_closed, assumption+,
       frule_tac a = "h ⋅ a" in a_in_rcs[of "N"], assumption+, simp)
apply blast
done

lemma (in Group) c_top_welldefTr5:"⟦G ▹ N; a ∈ carrier G; b ∈ carrier G⟧ ⟹ 
                             N ∙ (a ⋅ b) ⊆ c_top G N (N ∙ a) (N ∙ b)"
by (rule subsetI,
       rule c_top_welldefTr4[of "N" "a" "b" _], assumption+)

lemma (in Group) c_top_welldef:"⟦G ▹ N; a ∈ carrier G; b ∈ carrier G⟧ ⟹ 
                 N ∙ (a ⋅ b) = c_top G N (N ∙ a) (N ∙ b)"
by (rule equalityI, simp only:c_top_welldefTr5, simp only:c_top_welldefTr2)

lemma (in Group) Qg_unitTr:"⟦G ▹ N; a ∈ carrier G⟧ ⟹
                            c_top G N N (N ∙ a) = N ∙ a" 
apply (frule nsg_sg[of "N"])
apply (rule equalityI)
 apply (rule subsetI, simp add:c_top_def) 
 apply (simp add:unit_rcs_in_set_rcs rcs_in_set_rcs)
 apply (erule bexE)+
 apply (simp add:rcs_def, erule bexE)
 apply (frule sym, thin_tac "xa ⋅ y = x", frule sym, thin_tac "h ⋅ a = y",
        simp, thin_tac "x = xa ⋅ (h ⋅ a)", thin_tac "y = h ⋅ a",
       frule_tac h = xa in sg_subset_elem[of "N"], assumption+,
       frule_tac h = h in sg_subset_elem[of "N"], assumption+,
       simp add:tassoc[THEN sym],
       frule_tac x = xa and y = h in  sg_mult_closed[of "N"], assumption+,
       blast)
apply (rule subsetI,
       simp add:c_top_def, simp add:unit_rcs_in_set_rcs rcs_in_set_rcs)
apply (frule_tac x = x in mem_rcs [of "N" _ "a"], assumption, erule bexE,
       frule a_in_rcs[of "N" "a"], assumption, blast)
done                    

lemma (in Group) Qg_unit:"G ▹ N  ⟹ ∀x∈set_rcs G N. c_top G N N x = x" 
by (rule ballI,
       simp add:set_rcs_def, erule bexE, simp,
       simp add:Qg_unitTr)

lemma (in Group) Qg_iTr:"⟦G ▹ N; a ∈ carrier G⟧ ⟹
                         c_top G N (c_iop G N (N ∙ a)) (N ∙ a) = N"
apply (simp add:c_iop_welldef [of "N" "a"])
apply (frule i_closed[of "a"],
       simp add:c_top_welldef[THEN sym, of "N" "ρ a" "a"],
       simp add:l_i)
apply (frule nsg_sg[of "N"],
       simp add:rcs_Unit1[of "N"])
done  

lemma (in Group) Qg_i:"G ▹ N  ⟹
                         ∀x ∈ set_rcs G N. c_top G N (c_iop G N x) x = N"
apply (rule ballI, simp add:set_rcs_def, erule bexE)
apply (simp add:Qg_iTr)
done

lemma (in Group) Qg_tassocTr:
  "⟦G ▹ N; a ∈ carrier G; b ∈ carrier G; c ∈ carrier G ⟧ ⟹ 
   c_top G N (N ∙ a) (c_top G N (N ∙ b) (N ∙ c)) = 
                           c_top G N (c_top G N (N ∙ a) (N ∙ b)) (N ∙ c)"
apply (frule mult_closed[of "b" "c"], assumption+,
       frule mult_closed[of "a" "b"], assumption+,
       simp add:c_top_welldef[THEN sym])
apply (simp add:tassoc)
done

lemma (in Group) Qg_tassoc: "G ▹ N ⟹
∀X∈set_rcs G N. ∀Y∈set_rcs G N. ∀Z∈set_rcs G N. c_top G N X (c_top G N Y Z) 
                                   = c_top G N (c_top G N X Y) Z"
apply (rule ballI)+ apply (simp add:set_rcs_def, (erule bexE)+)
apply (simp add:Qg_tassocTr)
done

lemma (in Group) Qg_top:"G ▹ N ⟹ 
                 c_top G N : set_rcs G N → set_rcs G N → set_rcs G N"
apply (rule Pi_I, rule Pi_I, simp add:set_rcs_def, (erule bexE)+,
       simp add:c_top_welldef[THEN sym])
 apply (metis mult_closed)
done

lemma (in Group) Qg_top_closed:"⟦G ▹ N; A ∈ set_rcs G N; B ∈ set_rcs G N⟧ ⟹
                                   c_top G N A B ∈ set_rcs G N"
apply (frule Qg_top[of "N"])
apply (frule funcset_mem [of "c_top G N" "set_rcs G N" _ "A"], assumption)
apply (rule funcset_mem[of "c_top G N A" "set_rcs G N" "set_rcs G N" "B"],
           assumption, assumption)
done

lemma (in Group) Qg_iop: "G ▹ N ⟹
               c_iop G N :set_rcs G N → set_rcs G N"
apply (rule Pi_I)
 apply (simp add:set_rcs_def, erule bexE)
 apply (simp add:c_iop_welldef)
apply (frule_tac a = a in i_closed, blast)
done

lemma (in Group) Qg_iop_closed:"⟦G ▹ N; A ∈ set_rcs G N⟧ ⟹
                                   c_iop G N A ∈ set_rcs G N"
by (frule Qg_iop[of "N"],
       erule funcset_mem, assumption)

lemma (in Group) Qg_unit_closed: "G ▹ N ⟹  N ∈ set_rcs G N"
by (frule nsg_sg[of "N"],
       simp only:unit_rcs_in_set_rcs)

theorem (in Group) Group_Qg:"G ▹ N ⟹  Group (Qg G N)" 
apply (frule Qg_top [of "N"], frule Qg_iop [of "N"],
       frule Qg_unit[of "N"], frule Qg_i[of "N" ],
       frule Qg_tassoc[of "N"], frule Qg_unit_closed[of "N" ])
apply (simp add:Qg_def Group_def)
done

lemma (in Group) Qg_one:"G ▹ N ⟹ one (G / N) = N"
by (simp add:Qg_def)

lemma (in Group) Qg_carrier:"carrier (G / (N::'a set)) = set_rcs G N" 
by (simp add:Qg_def) (** only a trick *)

lemma (in Group) Qg_unit_group:"G ▹ N ⟹ 
                        (set_rcs G N = {N}) = (carrier G = N)"
apply (rule iffI)
 apply (rule contrapos_pp, simp+,
       frule nsg_sg[of "N"],
       frule sg_subset[of "N"],
       frule sets_not_eq[of "carrier G" "N"], assumption, erule bexE,
       frule_tac a = a in rcs_in_set_rcs[of "N"], assumption+,
       simp)  
 apply (frule_tac a = a in a_in_rcs[of "N"], assumption+,
        simp)
apply (simp add:set_rcs_def, frule nsg_sg[of "N"],
       frule rcs_fixed2[of "N"], frule_tac sg_unit_closed[of "N"], blast)
done

lemma (in Group) Gp_Qg:"G ▹ N ⟹ Gp(G / N) (carrier(G / N)) = G / N"
by (simp add:Gp_def Qg_def)

lemma (in Group) Pj_hom0:"⟦G ▹ N; x ∈ carrier G; y ∈ carrier G⟧
                 ⟹ Pj G N (x ⋅ y) = (Pj G N x) ⋅⇘(G / N)⇙ (Pj G N y)"
apply (simp add:Pj_def mult_closed)
apply (simp add:Qg_def, simp add:c_top_welldef)
done

lemma (in Group) Pj_ghom:"G ▹ N ⟹ (Pj G N) ∈ gHom G (G / N)"
apply (simp add:gHom_def)
apply (rule conjI,
       simp add:restrict_def Pj_def extensional_def)
apply (rule conjI, simp add:Pi_def,
       rule allI, rule impI,
       simp add:Qg_def set_rcs_def, simp add:Pj_def, blast)
apply ((rule ballI)+, simp add:Pj_hom0)
done

lemma (in Group) Pj_mem:"⟦G ▹ N; x ∈ carrier G⟧ ⟹ (Pj G N) x = N ∙ x"
by (simp add:Pj_def)

lemma (in Group) Pj_gsurjec:"G ▹ N ⟹ gsurjec G (G/N) (Pj G N)"
apply (simp add:gsurjec_def)
apply (simp add:Pj_ghom) 
apply (rule surj_to_test[of "Pj G N" "carrier G" "carrier (G / N)"],
       frule Pj_ghom[of "N"], simp add:gHom_def,
       rule ballI,
       simp add:Qg_def set_rcs_def, erule bexE)
 apply (frule_tac x = a in Pj_mem[of "N"], assumption, simp, blast)
done

lemma (in Group) lcs_in_Gp:"⟦G » H; G » K; K ⊆ H; a ∈ H⟧  ⟹ 
                                       a ♢ K = a ♢⇘(Gp G H)⇙ K"
by (simp add:lcs_def, simp add:Gp_def)

lemma (in Group) rcs_in_Gp:"⟦G » H; G » K; K ⊆ H; a ∈ H ⟧  ⟹
                              K ∙ a = K ∙⇘(Gp G H)⇙ a"
apply (simp add:rcs_def)
apply (simp add:Gp_def)
done

end