renamed '(BNF_)Constructions_on_Wellorders' to '(BNF_)Wellorder_Constructions'
authorblanchet
Mon Sep 01 16:34:39 2014 +0200 (2014-09-01)
changeset 58127b7cab82f488e
parent 58126 3831312eb476
child 58128 43a1ba26a8cb
renamed '(BNF_)Constructions_on_Wellorders' to '(BNF_)Wellorder_Constructions'
src/HOL/BNF_Cardinal_Order_Relation.thy
src/HOL/BNF_Constructions_on_Wellorders.thy
src/HOL/BNF_Wellorder_Constructions.thy
src/HOL/Cardinals/Cardinal_Arithmetic.thy
src/HOL/Cardinals/Cardinal_Order_Relation.thy
src/HOL/Cardinals/Constructions_on_Wellorders.thy
src/HOL/Cardinals/Order_Union.thy
src/HOL/Cardinals/Ordinal_Arithmetic.thy
src/HOL/Cardinals/README.txt
src/HOL/Cardinals/Wellorder_Constructions.thy
     1.1 --- a/src/HOL/BNF_Cardinal_Order_Relation.thy	Mon Sep 01 16:34:38 2014 +0200
     1.2 +++ b/src/HOL/BNF_Cardinal_Order_Relation.thy	Mon Sep 01 16:34:39 2014 +0200
     1.3 @@ -8,7 +8,7 @@
     1.4  header {* Cardinal-Order Relations as Needed by Bounded Natural Functors *}
     1.5  
     1.6  theory BNF_Cardinal_Order_Relation
     1.7 -imports Zorn BNF_Constructions_on_Wellorders
     1.8 +imports Zorn BNF_Wellorder_Constructions
     1.9  begin
    1.10  
    1.11  text{* In this section, we define cardinal-order relations to be minim well-orders
     2.1 --- a/src/HOL/BNF_Constructions_on_Wellorders.thy	Mon Sep 01 16:34:38 2014 +0200
     2.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     2.3 @@ -1,1656 +0,0 @@
     2.4 -(*  Title:      HOL/BNF_Constructions_on_Wellorders.thy
     2.5 -    Author:     Andrei Popescu, TU Muenchen
     2.6 -    Copyright   2012
     2.7 -
     2.8 -Constructions on wellorders as needed by bounded natural functors.
     2.9 -*)
    2.10 -
    2.11 -header {* Constructions on Wellorders as Needed by Bounded Natural Functors *}
    2.12 -
    2.13 -theory BNF_Constructions_on_Wellorders
    2.14 -imports BNF_Wellorder_Embedding
    2.15 -begin
    2.16 -
    2.17 -text {* In this section, we study basic constructions on well-orders, such as restriction to
    2.18 -a set/order filter, copy via direct images, ordinal-like sum of disjoint well-orders,
    2.19 -and bounded square.  We also define between well-orders
    2.20 -the relations @{text "ordLeq"}, of being embedded (abbreviated @{text "\<le>o"}),
    2.21 -@{text "ordLess"}, of being strictly embedded (abbreviated @{text "<o"}), and
    2.22 -@{text "ordIso"}, of being isomorphic (abbreviated @{text "=o"}).  We study the
    2.23 -connections between these relations, order filters, and the aforementioned constructions.
    2.24 -A main result of this section is that @{text "<o"} is well-founded. *}
    2.25 -
    2.26 -
    2.27 -subsection {* Restriction to a set *}
    2.28 -
    2.29 -abbreviation Restr :: "'a rel \<Rightarrow> 'a set \<Rightarrow> 'a rel"
    2.30 -where "Restr r A \<equiv> r Int (A \<times> A)"
    2.31 -
    2.32 -lemma Restr_subset:
    2.33 -"A \<le> B \<Longrightarrow> Restr (Restr r B) A = Restr r A"
    2.34 -by blast
    2.35 -
    2.36 -lemma Restr_Field: "Restr r (Field r) = r"
    2.37 -unfolding Field_def by auto
    2.38 -
    2.39 -lemma Refl_Restr: "Refl r \<Longrightarrow> Refl(Restr r A)"
    2.40 -unfolding refl_on_def Field_def by auto
    2.41 -
    2.42 -lemma antisym_Restr:
    2.43 -"antisym r \<Longrightarrow> antisym(Restr r A)"
    2.44 -unfolding antisym_def Field_def by auto
    2.45 -
    2.46 -lemma Total_Restr:
    2.47 -"Total r \<Longrightarrow> Total(Restr r A)"
    2.48 -unfolding total_on_def Field_def by auto
    2.49 -
    2.50 -lemma trans_Restr:
    2.51 -"trans r \<Longrightarrow> trans(Restr r A)"
    2.52 -unfolding trans_def Field_def by blast
    2.53 -
    2.54 -lemma Preorder_Restr:
    2.55 -"Preorder r \<Longrightarrow> Preorder(Restr r A)"
    2.56 -unfolding preorder_on_def by (simp add: Refl_Restr trans_Restr)
    2.57 -
    2.58 -lemma Partial_order_Restr:
    2.59 -"Partial_order r \<Longrightarrow> Partial_order(Restr r A)"
    2.60 -unfolding partial_order_on_def by (simp add: Preorder_Restr antisym_Restr)
    2.61 -
    2.62 -lemma Linear_order_Restr:
    2.63 -"Linear_order r \<Longrightarrow> Linear_order(Restr r A)"
    2.64 -unfolding linear_order_on_def by (simp add: Partial_order_Restr Total_Restr)
    2.65 -
    2.66 -lemma Well_order_Restr:
    2.67 -assumes "Well_order r"
    2.68 -shows "Well_order(Restr r A)"
    2.69 -proof-
    2.70 -  have "Restr r A - Id \<le> r - Id" using Restr_subset by blast
    2.71 -  hence "wf(Restr r A - Id)" using assms
    2.72 -  using well_order_on_def wf_subset by blast
    2.73 -  thus ?thesis using assms unfolding well_order_on_def
    2.74 -  by (simp add: Linear_order_Restr)
    2.75 -qed
    2.76 -
    2.77 -lemma Field_Restr_subset: "Field(Restr r A) \<le> A"
    2.78 -by (auto simp add: Field_def)
    2.79 -
    2.80 -lemma Refl_Field_Restr:
    2.81 -"Refl r \<Longrightarrow> Field(Restr r A) = (Field r) Int A"
    2.82 -unfolding refl_on_def Field_def by blast
    2.83 -
    2.84 -lemma Refl_Field_Restr2:
    2.85 -"\<lbrakk>Refl r; A \<le> Field r\<rbrakk> \<Longrightarrow> Field(Restr r A) = A"
    2.86 -by (auto simp add: Refl_Field_Restr)
    2.87 -
    2.88 -lemma well_order_on_Restr:
    2.89 -assumes WELL: "Well_order r" and SUB: "A \<le> Field r"
    2.90 -shows "well_order_on A (Restr r A)"
    2.91 -using assms
    2.92 -using Well_order_Restr[of r A] Refl_Field_Restr2[of r A]
    2.93 -     order_on_defs[of "Field r" r] by auto
    2.94 -
    2.95 -
    2.96 -subsection {* Order filters versus restrictions and embeddings *}
    2.97 -
    2.98 -lemma Field_Restr_ofilter:
    2.99 -"\<lbrakk>Well_order r; wo_rel.ofilter r A\<rbrakk> \<Longrightarrow> Field(Restr r A) = A"
   2.100 -by (auto simp add: wo_rel_def wo_rel.ofilter_def wo_rel.REFL Refl_Field_Restr2)
   2.101 -
   2.102 -lemma ofilter_Restr_under:
   2.103 -assumes WELL: "Well_order r" and OF: "wo_rel.ofilter r A" and IN: "a \<in> A"
   2.104 -shows "under (Restr r A) a = under r a"
   2.105 -using assms wo_rel_def
   2.106 -proof(auto simp add: wo_rel.ofilter_def under_def)
   2.107 -  fix b assume *: "a \<in> A" and "(b,a) \<in> r"
   2.108 -  hence "b \<in> under r a \<and> a \<in> Field r"
   2.109 -  unfolding under_def using Field_def by fastforce
   2.110 -  thus "b \<in> A" using * assms by (auto simp add: wo_rel_def wo_rel.ofilter_def)
   2.111 -qed
   2.112 -
   2.113 -lemma ofilter_embed:
   2.114 -assumes "Well_order r"
   2.115 -shows "wo_rel.ofilter r A = (A \<le> Field r \<and> embed (Restr r A) r id)"
   2.116 -proof
   2.117 -  assume *: "wo_rel.ofilter r A"
   2.118 -  show "A \<le> Field r \<and> embed (Restr r A) r id"
   2.119 -  proof(unfold embed_def, auto)
   2.120 -    fix a assume "a \<in> A" thus "a \<in> Field r" using assms *
   2.121 -    by (auto simp add: wo_rel_def wo_rel.ofilter_def)
   2.122 -  next
   2.123 -    fix a assume "a \<in> Field (Restr r A)"
   2.124 -    thus "bij_betw id (under (Restr r A) a) (under r a)" using assms *
   2.125 -    by (simp add: ofilter_Restr_under Field_Restr_ofilter)
   2.126 -  qed
   2.127 -next
   2.128 -  assume *: "A \<le> Field r \<and> embed (Restr r A) r id"
   2.129 -  hence "Field(Restr r A) \<le> Field r"
   2.130 -  using assms  embed_Field[of "Restr r A" r id] id_def
   2.131 -        Well_order_Restr[of r] by auto
   2.132 -  {fix a assume "a \<in> A"
   2.133 -   hence "a \<in> Field(Restr r A)" using * assms
   2.134 -   by (simp add: order_on_defs Refl_Field_Restr2)
   2.135 -   hence "bij_betw id (under (Restr r A) a) (under r a)"
   2.136 -   using * unfolding embed_def by auto
   2.137 -   hence "under r a \<le> under (Restr r A) a"
   2.138 -   unfolding bij_betw_def by auto
   2.139 -   also have "\<dots> \<le> Field(Restr r A)" by (simp add: under_Field)
   2.140 -   also have "\<dots> \<le> A" by (simp add: Field_Restr_subset)
   2.141 -   finally have "under r a \<le> A" .
   2.142 -  }
   2.143 -  thus "wo_rel.ofilter r A" using assms * by (simp add: wo_rel_def wo_rel.ofilter_def)
   2.144 -qed
   2.145 -
   2.146 -lemma ofilter_Restr_Int:
   2.147 -assumes WELL: "Well_order r" and OFA: "wo_rel.ofilter r A"
   2.148 -shows "wo_rel.ofilter (Restr r B) (A Int B)"
   2.149 -proof-
   2.150 -  let ?rB = "Restr r B"
   2.151 -  have Well: "wo_rel r" unfolding wo_rel_def using WELL .
   2.152 -  hence Refl: "Refl r" by (simp add: wo_rel.REFL)
   2.153 -  hence Field: "Field ?rB = Field r Int B"
   2.154 -  using Refl_Field_Restr by blast
   2.155 -  have WellB: "wo_rel ?rB \<and> Well_order ?rB" using WELL
   2.156 -  by (simp add: Well_order_Restr wo_rel_def)
   2.157 -  (* Main proof *)
   2.158 -  show ?thesis using WellB assms
   2.159 -  proof(auto simp add: wo_rel.ofilter_def under_def)
   2.160 -    fix a assume "a \<in> A" and *: "a \<in> B"
   2.161 -    hence "a \<in> Field r" using OFA Well by (auto simp add: wo_rel.ofilter_def)
   2.162 -    with * show "a \<in> Field ?rB" using Field by auto
   2.163 -  next
   2.164 -    fix a b assume "a \<in> A" and "(b,a) \<in> r"
   2.165 -    thus "b \<in> A" using Well OFA by (auto simp add: wo_rel.ofilter_def under_def)
   2.166 -  qed
   2.167 -qed
   2.168 -
   2.169 -lemma ofilter_Restr_subset:
   2.170 -assumes WELL: "Well_order r" and OFA: "wo_rel.ofilter r A" and SUB: "A \<le> B"
   2.171 -shows "wo_rel.ofilter (Restr r B) A"
   2.172 -proof-
   2.173 -  have "A Int B = A" using SUB by blast
   2.174 -  thus ?thesis using assms ofilter_Restr_Int[of r A B] by auto
   2.175 -qed
   2.176 -
   2.177 -lemma ofilter_subset_embed:
   2.178 -assumes WELL: "Well_order r" and
   2.179 -        OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
   2.180 -shows "(A \<le> B) = (embed (Restr r A) (Restr r B) id)"
   2.181 -proof-
   2.182 -  let ?rA = "Restr r A"  let ?rB = "Restr r B"
   2.183 -  have Well: "wo_rel r" unfolding wo_rel_def using WELL .
   2.184 -  hence Refl: "Refl r" by (simp add: wo_rel.REFL)
   2.185 -  hence FieldA: "Field ?rA = Field r Int A"
   2.186 -  using Refl_Field_Restr by blast
   2.187 -  have FieldB: "Field ?rB = Field r Int B"
   2.188 -  using Refl Refl_Field_Restr by blast
   2.189 -  have WellA: "wo_rel ?rA \<and> Well_order ?rA" using WELL
   2.190 -  by (simp add: Well_order_Restr wo_rel_def)
   2.191 -  have WellB: "wo_rel ?rB \<and> Well_order ?rB" using WELL
   2.192 -  by (simp add: Well_order_Restr wo_rel_def)
   2.193 -  (* Main proof *)
   2.194 -  show ?thesis
   2.195 -  proof
   2.196 -    assume *: "A \<le> B"
   2.197 -    hence "wo_rel.ofilter (Restr r B) A" using assms
   2.198 -    by (simp add: ofilter_Restr_subset)
   2.199 -    hence "embed (Restr ?rB A) (Restr r B) id"
   2.200 -    using WellB ofilter_embed[of "?rB" A] by auto
   2.201 -    thus "embed (Restr r A) (Restr r B) id"
   2.202 -    using * by (simp add: Restr_subset)
   2.203 -  next
   2.204 -    assume *: "embed (Restr r A) (Restr r B) id"
   2.205 -    {fix a assume **: "a \<in> A"
   2.206 -     hence "a \<in> Field r" using Well OFA by (auto simp add: wo_rel.ofilter_def)
   2.207 -     with ** FieldA have "a \<in> Field ?rA" by auto
   2.208 -     hence "a \<in> Field ?rB" using * WellA embed_Field[of ?rA ?rB id] by auto
   2.209 -     hence "a \<in> B" using FieldB by auto
   2.210 -    }
   2.211 -    thus "A \<le> B" by blast
   2.212 -  qed
   2.213 -qed
   2.214 -
   2.215 -lemma ofilter_subset_embedS_iso:
   2.216 -assumes WELL: "Well_order r" and
   2.217 -        OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
   2.218 -shows "((A < B) = (embedS (Restr r A) (Restr r B) id)) \<and>
   2.219 -       ((A = B) = (iso (Restr r A) (Restr r B) id))"
   2.220 -proof-
   2.221 -  let ?rA = "Restr r A"  let ?rB = "Restr r B"
   2.222 -  have Well: "wo_rel r" unfolding wo_rel_def using WELL .
   2.223 -  hence Refl: "Refl r" by (simp add: wo_rel.REFL)
   2.224 -  hence "Field ?rA = Field r Int A"
   2.225 -  using Refl_Field_Restr by blast
   2.226 -  hence FieldA: "Field ?rA = A" using OFA Well
   2.227 -  by (auto simp add: wo_rel.ofilter_def)
   2.228 -  have "Field ?rB = Field r Int B"
   2.229 -  using Refl Refl_Field_Restr by blast
   2.230 -  hence FieldB: "Field ?rB = B" using OFB Well
   2.231 -  by (auto simp add: wo_rel.ofilter_def)
   2.232 -  (* Main proof *)
   2.233 -  show ?thesis unfolding embedS_def iso_def
   2.234 -  using assms ofilter_subset_embed[of r A B]
   2.235 -        FieldA FieldB bij_betw_id_iff[of A B] by auto
   2.236 -qed
   2.237 -
   2.238 -lemma ofilter_subset_embedS:
   2.239 -assumes WELL: "Well_order r" and
   2.240 -        OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
   2.241 -shows "(A < B) = embedS (Restr r A) (Restr r B) id"
   2.242 -using assms by (simp add: ofilter_subset_embedS_iso)
   2.243 -
   2.244 -lemma embed_implies_iso_Restr:
   2.245 -assumes WELL: "Well_order r" and WELL': "Well_order r'" and
   2.246 -        EMB: "embed r' r f"
   2.247 -shows "iso r' (Restr r (f ` (Field r'))) f"
   2.248 -proof-
   2.249 -  let ?A' = "Field r'"
   2.250 -  let ?r'' = "Restr r (f ` ?A')"
   2.251 -  have 0: "Well_order ?r''" using WELL Well_order_Restr by blast
   2.252 -  have 1: "wo_rel.ofilter r (f ` ?A')" using assms embed_Field_ofilter  by blast
   2.253 -  hence "Field ?r'' = f ` (Field r')" using WELL Field_Restr_ofilter by blast
   2.254 -  hence "bij_betw f ?A' (Field ?r'')"
   2.255 -  using EMB embed_inj_on WELL' unfolding bij_betw_def by blast
   2.256 -  moreover
   2.257 -  {have "\<forall>a b. (a,b) \<in> r' \<longrightarrow> a \<in> Field r' \<and> b \<in> Field r'"
   2.258 -   unfolding Field_def by auto
   2.259 -   hence "compat r' ?r'' f"
   2.260 -   using assms embed_iff_compat_inj_on_ofilter
   2.261 -   unfolding compat_def by blast
   2.262 -  }
   2.263 -  ultimately show ?thesis using WELL' 0 iso_iff3 by blast
   2.264 -qed
   2.265 -
   2.266 -
   2.267 -subsection {* The strict inclusion on proper ofilters is well-founded *}
   2.268 -
   2.269 -definition ofilterIncl :: "'a rel \<Rightarrow> 'a set rel"
   2.270 -where
   2.271 -"ofilterIncl r \<equiv> {(A,B). wo_rel.ofilter r A \<and> A \<noteq> Field r \<and>
   2.272 -                         wo_rel.ofilter r B \<and> B \<noteq> Field r \<and> A < B}"
   2.273 -
   2.274 -lemma wf_ofilterIncl:
   2.275 -assumes WELL: "Well_order r"
   2.276 -shows "wf(ofilterIncl r)"
   2.277 -proof-
   2.278 -  have Well: "wo_rel r" using WELL by (simp add: wo_rel_def)
   2.279 -  hence Lo: "Linear_order r" by (simp add: wo_rel.LIN)
   2.280 -  let ?h = "(\<lambda> A. wo_rel.suc r A)"
   2.281 -  let ?rS = "r - Id"
   2.282 -  have "wf ?rS" using WELL by (simp add: order_on_defs)
   2.283 -  moreover
   2.284 -  have "compat (ofilterIncl r) ?rS ?h"
   2.285 -  proof(unfold compat_def ofilterIncl_def,
   2.286 -        intro allI impI, simp, elim conjE)
   2.287 -    fix A B
   2.288 -    assume *: "wo_rel.ofilter r A" "A \<noteq> Field r" and
   2.289 -           **: "wo_rel.ofilter r B" "B \<noteq> Field r" and ***: "A < B"
   2.290 -    then obtain a and b where 0: "a \<in> Field r \<and> b \<in> Field r" and
   2.291 -                         1: "A = underS r a \<and> B = underS r b"
   2.292 -    using Well by (auto simp add: wo_rel.ofilter_underS_Field)
   2.293 -    hence "a \<noteq> b" using *** by auto
   2.294 -    moreover
   2.295 -    have "(a,b) \<in> r" using 0 1 Lo ***
   2.296 -    by (auto simp add: underS_incl_iff)
   2.297 -    moreover
   2.298 -    have "a = wo_rel.suc r A \<and> b = wo_rel.suc r B"
   2.299 -    using Well 0 1 by (simp add: wo_rel.suc_underS)
   2.300 -    ultimately
   2.301 -    show "(wo_rel.suc r A, wo_rel.suc r B) \<in> r \<and> wo_rel.suc r A \<noteq> wo_rel.suc r B"
   2.302 -    by simp
   2.303 -  qed
   2.304 -  ultimately show "wf (ofilterIncl r)" by (simp add: compat_wf)
   2.305 -qed
   2.306 -
   2.307 -
   2.308 -subsection {* Ordering the well-orders by existence of embeddings *}
   2.309 -
   2.310 -text {* We define three relations between well-orders:
   2.311 -\begin{itemize}
   2.312 -\item @{text "ordLeq"}, of being embedded (abbreviated @{text "\<le>o"});
   2.313 -\item @{text "ordLess"}, of being strictly embedded (abbreviated @{text "<o"});
   2.314 -\item @{text "ordIso"}, of being isomorphic (abbreviated @{text "=o"}).
   2.315 -\end{itemize}
   2.316 -%
   2.317 -The prefix "ord" and the index "o" in these names stand for "ordinal-like".
   2.318 -These relations shall be proved to be inter-connected in a similar fashion as the trio
   2.319 -@{text "\<le>"}, @{text "<"}, @{text "="} associated to a total order on a set.
   2.320 -*}
   2.321 -
   2.322 -definition ordLeq :: "('a rel * 'a' rel) set"
   2.323 -where
   2.324 -"ordLeq = {(r,r'). Well_order r \<and> Well_order r' \<and> (\<exists>f. embed r r' f)}"
   2.325 -
   2.326 -abbreviation ordLeq2 :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> bool" (infix "<=o" 50)
   2.327 -where "r <=o r' \<equiv> (r,r') \<in> ordLeq"
   2.328 -
   2.329 -abbreviation ordLeq3 :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> bool" (infix "\<le>o" 50)
   2.330 -where "r \<le>o r' \<equiv> r <=o r'"
   2.331 -
   2.332 -definition ordLess :: "('a rel * 'a' rel) set"
   2.333 -where
   2.334 -"ordLess = {(r,r'). Well_order r \<and> Well_order r' \<and> (\<exists>f. embedS r r' f)}"
   2.335 -
   2.336 -abbreviation ordLess2 :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> bool" (infix "<o" 50)
   2.337 -where "r <o r' \<equiv> (r,r') \<in> ordLess"
   2.338 -
   2.339 -definition ordIso :: "('a rel * 'a' rel) set"
   2.340 -where
   2.341 -"ordIso = {(r,r'). Well_order r \<and> Well_order r' \<and> (\<exists>f. iso r r' f)}"
   2.342 -
   2.343 -abbreviation ordIso2 :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> bool" (infix "=o" 50)
   2.344 -where "r =o r' \<equiv> (r,r') \<in> ordIso"
   2.345 -
   2.346 -lemmas ordRels_def = ordLeq_def ordLess_def ordIso_def
   2.347 -
   2.348 -lemma ordLeq_Well_order_simp:
   2.349 -assumes "r \<le>o r'"
   2.350 -shows "Well_order r \<and> Well_order r'"
   2.351 -using assms unfolding ordLeq_def by simp
   2.352 -
   2.353 -text{* Notice that the relations @{text "\<le>o"}, @{text "<o"}, @{text "=o"} connect well-orders
   2.354 -on potentially {\em distinct} types. However, some of the lemmas below, including the next one,
   2.355 -restrict implicitly the type of these relations to @{text "(('a rel) * ('a rel)) set"} , i.e.,
   2.356 -to @{text "'a rel rel"}. *}
   2.357 -
   2.358 -lemma ordLeq_reflexive:
   2.359 -"Well_order r \<Longrightarrow> r \<le>o r"
   2.360 -unfolding ordLeq_def using id_embed[of r] by blast
   2.361 -
   2.362 -lemma ordLeq_transitive[trans]:
   2.363 -assumes *: "r \<le>o r'" and **: "r' \<le>o r''"
   2.364 -shows "r \<le>o r''"
   2.365 -proof-
   2.366 -  obtain f and f'
   2.367 -  where 1: "Well_order r \<and> Well_order r' \<and> Well_order r''" and
   2.368 -        "embed r r' f" and "embed r' r'' f'"
   2.369 -  using * ** unfolding ordLeq_def by blast
   2.370 -  hence "embed r r'' (f' o f)"
   2.371 -  using comp_embed[of r r' f r'' f'] by auto
   2.372 -  thus "r \<le>o r''" unfolding ordLeq_def using 1 by auto
   2.373 -qed
   2.374 -
   2.375 -lemma ordLeq_total:
   2.376 -"\<lbrakk>Well_order r; Well_order r'\<rbrakk> \<Longrightarrow> r \<le>o r' \<or> r' \<le>o r"
   2.377 -unfolding ordLeq_def using wellorders_totally_ordered by blast
   2.378 -
   2.379 -lemma ordIso_reflexive:
   2.380 -"Well_order r \<Longrightarrow> r =o r"
   2.381 -unfolding ordIso_def using id_iso[of r] by blast
   2.382 -
   2.383 -lemma ordIso_transitive[trans]:
   2.384 -assumes *: "r =o r'" and **: "r' =o r''"
   2.385 -shows "r =o r''"
   2.386 -proof-
   2.387 -  obtain f and f'
   2.388 -  where 1: "Well_order r \<and> Well_order r' \<and> Well_order r''" and
   2.389 -        "iso r r' f" and 3: "iso r' r'' f'"
   2.390 -  using * ** unfolding ordIso_def by auto
   2.391 -  hence "iso r r'' (f' o f)"
   2.392 -  using comp_iso[of r r' f r'' f'] by auto
   2.393 -  thus "r =o r''" unfolding ordIso_def using 1 by auto
   2.394 -qed
   2.395 -
   2.396 -lemma ordIso_symmetric:
   2.397 -assumes *: "r =o r'"
   2.398 -shows "r' =o r"
   2.399 -proof-
   2.400 -  obtain f where 1: "Well_order r \<and> Well_order r'" and
   2.401 -                 2: "embed r r' f \<and> bij_betw f (Field r) (Field r')"
   2.402 -  using * by (auto simp add: ordIso_def iso_def)
   2.403 -  let ?f' = "inv_into (Field r) f"
   2.404 -  have "embed r' r ?f' \<and> bij_betw ?f' (Field r') (Field r)"
   2.405 -  using 1 2 by (simp add: bij_betw_inv_into inv_into_Field_embed_bij_betw)
   2.406 -  thus "r' =o r" unfolding ordIso_def using 1 by (auto simp add: iso_def)
   2.407 -qed
   2.408 -
   2.409 -lemma ordLeq_ordLess_trans[trans]:
   2.410 -assumes "r \<le>o r'" and " r' <o r''"
   2.411 -shows "r <o r''"
   2.412 -proof-
   2.413 -  have "Well_order r \<and> Well_order r''"
   2.414 -  using assms unfolding ordLeq_def ordLess_def by auto
   2.415 -  thus ?thesis using assms unfolding ordLeq_def ordLess_def
   2.416 -  using embed_comp_embedS by blast
   2.417 -qed
   2.418 -
   2.419 -lemma ordLess_ordLeq_trans[trans]:
   2.420 -assumes "r <o r'" and " r' \<le>o r''"
   2.421 -shows "r <o r''"
   2.422 -proof-
   2.423 -  have "Well_order r \<and> Well_order r''"
   2.424 -  using assms unfolding ordLeq_def ordLess_def by auto
   2.425 -  thus ?thesis using assms unfolding ordLeq_def ordLess_def
   2.426 -  using embedS_comp_embed by blast
   2.427 -qed
   2.428 -
   2.429 -lemma ordLeq_ordIso_trans[trans]:
   2.430 -assumes "r \<le>o r'" and " r' =o r''"
   2.431 -shows "r \<le>o r''"
   2.432 -proof-
   2.433 -  have "Well_order r \<and> Well_order r''"
   2.434 -  using assms unfolding ordLeq_def ordIso_def by auto
   2.435 -  thus ?thesis using assms unfolding ordLeq_def ordIso_def
   2.436 -  using embed_comp_iso by blast
   2.437 -qed
   2.438 -
   2.439 -lemma ordIso_ordLeq_trans[trans]:
   2.440 -assumes "r =o r'" and " r' \<le>o r''"
   2.441 -shows "r \<le>o r''"
   2.442 -proof-
   2.443 -  have "Well_order r \<and> Well_order r''"
   2.444 -  using assms unfolding ordLeq_def ordIso_def by auto
   2.445 -  thus ?thesis using assms unfolding ordLeq_def ordIso_def
   2.446 -  using iso_comp_embed by blast
   2.447 -qed
   2.448 -
   2.449 -lemma ordLess_ordIso_trans[trans]:
   2.450 -assumes "r <o r'" and " r' =o r''"
   2.451 -shows "r <o r''"
   2.452 -proof-
   2.453 -  have "Well_order r \<and> Well_order r''"
   2.454 -  using assms unfolding ordLess_def ordIso_def by auto
   2.455 -  thus ?thesis using assms unfolding ordLess_def ordIso_def
   2.456 -  using embedS_comp_iso by blast
   2.457 -qed
   2.458 -
   2.459 -lemma ordIso_ordLess_trans[trans]:
   2.460 -assumes "r =o r'" and " r' <o r''"
   2.461 -shows "r <o r''"
   2.462 -proof-
   2.463 -  have "Well_order r \<and> Well_order r''"
   2.464 -  using assms unfolding ordLess_def ordIso_def by auto
   2.465 -  thus ?thesis using assms unfolding ordLess_def ordIso_def
   2.466 -  using iso_comp_embedS by blast
   2.467 -qed
   2.468 -
   2.469 -lemma ordLess_not_embed:
   2.470 -assumes "r <o r'"
   2.471 -shows "\<not>(\<exists>f'. embed r' r f')"
   2.472 -proof-
   2.473 -  obtain f where 1: "Well_order r \<and> Well_order r'" and 2: "embed r r' f" and
   2.474 -                 3: " \<not> bij_betw f (Field r) (Field r')"
   2.475 -  using assms unfolding ordLess_def by (auto simp add: embedS_def)
   2.476 -  {fix f' assume *: "embed r' r f'"
   2.477 -   hence "bij_betw f (Field r) (Field r')" using 1 2
   2.478 -   by (simp add: embed_bothWays_Field_bij_betw)
   2.479 -   with 3 have False by contradiction
   2.480 -  }
   2.481 -  thus ?thesis by blast
   2.482 -qed
   2.483 -
   2.484 -lemma ordLess_Field:
   2.485 -assumes OL: "r1 <o r2" and EMB: "embed r1 r2 f"
   2.486 -shows "\<not> (f`(Field r1) = Field r2)"
   2.487 -proof-
   2.488 -  let ?A1 = "Field r1"  let ?A2 = "Field r2"
   2.489 -  obtain g where
   2.490 -  0: "Well_order r1 \<and> Well_order r2" and
   2.491 -  1: "embed r1 r2 g \<and> \<not>(bij_betw g ?A1 ?A2)"
   2.492 -  using OL unfolding ordLess_def by (auto simp add: embedS_def)
   2.493 -  hence "\<forall>a \<in> ?A1. f a = g a"
   2.494 -  using 0 EMB embed_unique[of r1] by auto
   2.495 -  hence "\<not>(bij_betw f ?A1 ?A2)"
   2.496 -  using 1 bij_betw_cong[of ?A1] by blast
   2.497 -  moreover
   2.498 -  have "inj_on f ?A1" using EMB 0 by (simp add: embed_inj_on)
   2.499 -  ultimately show ?thesis by (simp add: bij_betw_def)
   2.500 -qed
   2.501 -
   2.502 -lemma ordLess_iff:
   2.503 -"r <o r' = (Well_order r \<and> Well_order r' \<and> \<not>(\<exists>f'. embed r' r f'))"
   2.504 -proof
   2.505 -  assume *: "r <o r'"
   2.506 -  hence "\<not>(\<exists>f'. embed r' r f')" using ordLess_not_embed[of r r'] by simp
   2.507 -  with * show "Well_order r \<and> Well_order r' \<and> \<not> (\<exists>f'. embed r' r f')"
   2.508 -  unfolding ordLess_def by auto
   2.509 -next
   2.510 -  assume *: "Well_order r \<and> Well_order r' \<and> \<not> (\<exists>f'. embed r' r f')"
   2.511 -  then obtain f where 1: "embed r r' f"
   2.512 -  using wellorders_totally_ordered[of r r'] by blast
   2.513 -  moreover
   2.514 -  {assume "bij_betw f (Field r) (Field r')"
   2.515 -   with * 1 have "embed r' r (inv_into (Field r) f) "
   2.516 -   using inv_into_Field_embed_bij_betw[of r r' f] by auto
   2.517 -   with * have False by blast
   2.518 -  }
   2.519 -  ultimately show "(r,r') \<in> ordLess"
   2.520 -  unfolding ordLess_def using * by (fastforce simp add: embedS_def)
   2.521 -qed
   2.522 -
   2.523 -lemma ordLess_irreflexive: "\<not> r <o r"
   2.524 -proof
   2.525 -  assume "r <o r"
   2.526 -  hence "Well_order r \<and>  \<not>(\<exists>f. embed r r f)"
   2.527 -  unfolding ordLess_iff ..
   2.528 -  moreover have "embed r r id" using id_embed[of r] .
   2.529 -  ultimately show False by blast
   2.530 -qed
   2.531 -
   2.532 -lemma ordLeq_iff_ordLess_or_ordIso:
   2.533 -"r \<le>o r' = (r <o r' \<or> r =o r')"
   2.534 -unfolding ordRels_def embedS_defs iso_defs by blast
   2.535 -
   2.536 -lemma ordIso_iff_ordLeq:
   2.537 -"(r =o r') = (r \<le>o r' \<and> r' \<le>o r)"
   2.538 -proof
   2.539 -  assume "r =o r'"
   2.540 -  then obtain f where 1: "Well_order r \<and> Well_order r' \<and>
   2.541 -                     embed r r' f \<and> bij_betw f (Field r) (Field r')"
   2.542 -  unfolding ordIso_def iso_defs by auto
   2.543 -  hence "embed r r' f \<and> embed r' r (inv_into (Field r) f)"
   2.544 -  by (simp add: inv_into_Field_embed_bij_betw)
   2.545 -  thus  "r \<le>o r' \<and> r' \<le>o r"
   2.546 -  unfolding ordLeq_def using 1 by auto
   2.547 -next
   2.548 -  assume "r \<le>o r' \<and> r' \<le>o r"
   2.549 -  then obtain f and g where 1: "Well_order r \<and> Well_order r' \<and>
   2.550 -                           embed r r' f \<and> embed r' r g"
   2.551 -  unfolding ordLeq_def by auto
   2.552 -  hence "iso r r' f" by (auto simp add: embed_bothWays_iso)
   2.553 -  thus "r =o r'" unfolding ordIso_def using 1 by auto
   2.554 -qed
   2.555 -
   2.556 -lemma not_ordLess_ordLeq:
   2.557 -"r <o r' \<Longrightarrow> \<not> r' \<le>o r"
   2.558 -using ordLess_ordLeq_trans ordLess_irreflexive by blast
   2.559 -
   2.560 -lemma ordLess_or_ordLeq:
   2.561 -assumes WELL: "Well_order r" and WELL': "Well_order r'"
   2.562 -shows "r <o r' \<or> r' \<le>o r"
   2.563 -proof-
   2.564 -  have "r \<le>o r' \<or> r' \<le>o r"
   2.565 -  using assms by (simp add: ordLeq_total)
   2.566 -  moreover
   2.567 -  {assume "\<not> r <o r' \<and> r \<le>o r'"
   2.568 -   hence "r =o r'" using ordLeq_iff_ordLess_or_ordIso by blast
   2.569 -   hence "r' \<le>o r" using ordIso_symmetric ordIso_iff_ordLeq by blast
   2.570 -  }
   2.571 -  ultimately show ?thesis by blast
   2.572 -qed
   2.573 -
   2.574 -lemma not_ordLess_ordIso:
   2.575 -"r <o r' \<Longrightarrow> \<not> r =o r'"
   2.576 -using assms ordLess_ordIso_trans ordIso_symmetric ordLess_irreflexive by blast
   2.577 -
   2.578 -lemma not_ordLeq_iff_ordLess:
   2.579 -assumes WELL: "Well_order r" and WELL': "Well_order r'"
   2.580 -shows "(\<not> r' \<le>o r) = (r <o r')"
   2.581 -using assms not_ordLess_ordLeq ordLess_or_ordLeq by blast
   2.582 -
   2.583 -lemma not_ordLess_iff_ordLeq:
   2.584 -assumes WELL: "Well_order r" and WELL': "Well_order r'"
   2.585 -shows "(\<not> r' <o r) = (r \<le>o r')"
   2.586 -using assms not_ordLess_ordLeq ordLess_or_ordLeq by blast
   2.587 -
   2.588 -lemma ordLess_transitive[trans]:
   2.589 -"\<lbrakk>r <o r'; r' <o r''\<rbrakk> \<Longrightarrow> r <o r''"
   2.590 -using assms ordLess_ordLeq_trans ordLeq_iff_ordLess_or_ordIso by blast
   2.591 -
   2.592 -corollary ordLess_trans: "trans ordLess"
   2.593 -unfolding trans_def using ordLess_transitive by blast
   2.594 -
   2.595 -lemmas ordIso_equivalence = ordIso_transitive ordIso_reflexive ordIso_symmetric
   2.596 -
   2.597 -lemma ordIso_imp_ordLeq:
   2.598 -"r =o r' \<Longrightarrow> r \<le>o r'"
   2.599 -using ordIso_iff_ordLeq by blast
   2.600 -
   2.601 -lemma ordLess_imp_ordLeq:
   2.602 -"r <o r' \<Longrightarrow> r \<le>o r'"
   2.603 -using ordLeq_iff_ordLess_or_ordIso by blast
   2.604 -
   2.605 -lemma ofilter_subset_ordLeq:
   2.606 -assumes WELL: "Well_order r" and
   2.607 -        OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
   2.608 -shows "(A \<le> B) = (Restr r A \<le>o Restr r B)"
   2.609 -proof
   2.610 -  assume "A \<le> B"
   2.611 -  thus "Restr r A \<le>o Restr r B"
   2.612 -  unfolding ordLeq_def using assms
   2.613 -  Well_order_Restr Well_order_Restr ofilter_subset_embed by blast
   2.614 -next
   2.615 -  assume *: "Restr r A \<le>o Restr r B"
   2.616 -  then obtain f where "embed (Restr r A) (Restr r B) f"
   2.617 -  unfolding ordLeq_def by blast
   2.618 -  {assume "B < A"
   2.619 -   hence "Restr r B <o Restr r A"
   2.620 -   unfolding ordLess_def using assms
   2.621 -   Well_order_Restr Well_order_Restr ofilter_subset_embedS by blast
   2.622 -   hence False using * not_ordLess_ordLeq by blast
   2.623 -  }
   2.624 -  thus "A \<le> B" using OFA OFB WELL
   2.625 -  wo_rel_def[of r] wo_rel.ofilter_linord[of r A B] by blast
   2.626 -qed
   2.627 -
   2.628 -lemma ofilter_subset_ordLess:
   2.629 -assumes WELL: "Well_order r" and
   2.630 -        OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
   2.631 -shows "(A < B) = (Restr r A <o Restr r B)"
   2.632 -proof-
   2.633 -  let ?rA = "Restr r A" let ?rB = "Restr r B"
   2.634 -  have 1: "Well_order ?rA \<and> Well_order ?rB"
   2.635 -  using WELL Well_order_Restr by blast
   2.636 -  have "(A < B) = (\<not> B \<le> A)" using assms
   2.637 -  wo_rel_def wo_rel.ofilter_linord[of r A B] by blast
   2.638 -  also have "\<dots> = (\<not> Restr r B \<le>o Restr r A)"
   2.639 -  using assms ofilter_subset_ordLeq by blast
   2.640 -  also have "\<dots> = (Restr r A <o Restr r B)"
   2.641 -  using 1 not_ordLeq_iff_ordLess by blast
   2.642 -  finally show ?thesis .
   2.643 -qed
   2.644 -
   2.645 -lemma ofilter_ordLess:
   2.646 -"\<lbrakk>Well_order r; wo_rel.ofilter r A\<rbrakk> \<Longrightarrow> (A < Field r) = (Restr r A <o r)"
   2.647 -by (simp add: ofilter_subset_ordLess wo_rel.Field_ofilter
   2.648 -    wo_rel_def Restr_Field)
   2.649 -
   2.650 -corollary underS_Restr_ordLess:
   2.651 -assumes "Well_order r" and "Field r \<noteq> {}"
   2.652 -shows "Restr r (underS r a) <o r"
   2.653 -proof-
   2.654 -  have "underS r a < Field r" using assms
   2.655 -  by (simp add: underS_Field3)
   2.656 -  thus ?thesis using assms
   2.657 -  by (simp add: ofilter_ordLess wo_rel.underS_ofilter wo_rel_def)
   2.658 -qed
   2.659 -
   2.660 -lemma embed_ordLess_ofilterIncl:
   2.661 -assumes
   2.662 -  OL12: "r1 <o r2" and OL23: "r2 <o r3" and
   2.663 -  EMB13: "embed r1 r3 f13" and EMB23: "embed r2 r3 f23"
   2.664 -shows "(f13`(Field r1), f23`(Field r2)) \<in> (ofilterIncl r3)"
   2.665 -proof-
   2.666 -  have OL13: "r1 <o r3"
   2.667 -  using OL12 OL23 using ordLess_transitive by auto
   2.668 -  let ?A1 = "Field r1"  let ?A2 ="Field r2" let ?A3 ="Field r3"
   2.669 -  obtain f12 g23 where
   2.670 -  0: "Well_order r1 \<and> Well_order r2 \<and> Well_order r3" and
   2.671 -  1: "embed r1 r2 f12 \<and> \<not>(bij_betw f12 ?A1 ?A2)" and
   2.672 -  2: "embed r2 r3 g23 \<and> \<not>(bij_betw g23 ?A2 ?A3)"
   2.673 -  using OL12 OL23 by (auto simp add: ordLess_def embedS_def)
   2.674 -  hence "\<forall>a \<in> ?A2. f23 a = g23 a"
   2.675 -  using EMB23 embed_unique[of r2 r3] by blast
   2.676 -  hence 3: "\<not>(bij_betw f23 ?A2 ?A3)"
   2.677 -  using 2 bij_betw_cong[of ?A2 f23 g23] by blast
   2.678 -  (*  *)
   2.679 -  have 4: "wo_rel.ofilter r2 (f12 ` ?A1) \<and> f12 ` ?A1 \<noteq> ?A2"
   2.680 -  using 0 1 OL12 by (simp add: embed_Field_ofilter ordLess_Field)
   2.681 -  have 5: "wo_rel.ofilter r3 (f23 ` ?A2) \<and> f23 ` ?A2 \<noteq> ?A3"
   2.682 -  using 0 EMB23 OL23 by (simp add: embed_Field_ofilter ordLess_Field)
   2.683 -  have 6: "wo_rel.ofilter r3 (f13 ` ?A1)  \<and> f13 ` ?A1 \<noteq> ?A3"
   2.684 -  using 0 EMB13 OL13 by (simp add: embed_Field_ofilter ordLess_Field)
   2.685 -  (*  *)
   2.686 -  have "f12 ` ?A1 < ?A2"
   2.687 -  using 0 4 by (auto simp add: wo_rel_def wo_rel.ofilter_def)
   2.688 -  moreover have "inj_on f23 ?A2"
   2.689 -  using EMB23 0 by (simp add: wo_rel_def embed_inj_on)
   2.690 -  ultimately
   2.691 -  have "f23 ` (f12 ` ?A1) < f23 ` ?A2" by (simp add: inj_on_strict_subset)
   2.692 -  moreover
   2.693 -  {have "embed r1 r3 (f23 o f12)"
   2.694 -   using 1 EMB23 0 by (auto simp add: comp_embed)
   2.695 -   hence "\<forall>a \<in> ?A1. f23(f12 a) = f13 a"
   2.696 -   using EMB13 0 embed_unique[of r1 r3 "f23 o f12" f13] by auto
   2.697 -   hence "f23 ` (f12 ` ?A1) = f13 ` ?A1" by force
   2.698 -  }
   2.699 -  ultimately
   2.700 -  have "f13 ` ?A1 < f23 ` ?A2" by simp
   2.701 -  (*  *)
   2.702 -  with 5 6 show ?thesis
   2.703 -  unfolding ofilterIncl_def by auto
   2.704 -qed
   2.705 -
   2.706 -lemma ordLess_iff_ordIso_Restr:
   2.707 -assumes WELL: "Well_order r" and WELL': "Well_order r'"
   2.708 -shows "(r' <o r) = (\<exists>a \<in> Field r. r' =o Restr r (underS r a))"
   2.709 -proof(auto)
   2.710 -  fix a assume *: "a \<in> Field r" and **: "r' =o Restr r (underS r a)"
   2.711 -  hence "Restr r (underS r a) <o r" using WELL underS_Restr_ordLess[of r] by blast
   2.712 -  thus "r' <o r" using ** ordIso_ordLess_trans by blast
   2.713 -next
   2.714 -  assume "r' <o r"
   2.715 -  then obtain f where 1: "Well_order r \<and> Well_order r'" and
   2.716 -                      2: "embed r' r f \<and> f ` (Field r') \<noteq> Field r"
   2.717 -  unfolding ordLess_def embedS_def[abs_def] bij_betw_def using embed_inj_on by blast
   2.718 -  hence "wo_rel.ofilter r (f ` (Field r'))" using embed_Field_ofilter by blast
   2.719 -  then obtain a where 3: "a \<in> Field r" and 4: "underS r a = f ` (Field r')"
   2.720 -  using 1 2 by (auto simp add: wo_rel.ofilter_underS_Field wo_rel_def)
   2.721 -  have "iso r' (Restr r (f ` (Field r'))) f"
   2.722 -  using embed_implies_iso_Restr 2 assms by blast
   2.723 -  moreover have "Well_order (Restr r (f ` (Field r')))"
   2.724 -  using WELL Well_order_Restr by blast
   2.725 -  ultimately have "r' =o Restr r (f ` (Field r'))"
   2.726 -  using WELL' unfolding ordIso_def by auto
   2.727 -  hence "r' =o Restr r (underS r a)" using 4 by auto
   2.728 -  thus "\<exists>a \<in> Field r. r' =o Restr r (underS r a)" using 3 by auto
   2.729 -qed
   2.730 -
   2.731 -lemma internalize_ordLess:
   2.732 -"(r' <o r) = (\<exists>p. Field p < Field r \<and> r' =o p \<and> p <o r)"
   2.733 -proof
   2.734 -  assume *: "r' <o r"
   2.735 -  hence 0: "Well_order r \<and> Well_order r'" unfolding ordLess_def by auto
   2.736 -  with * obtain a where 1: "a \<in> Field r" and 2: "r' =o Restr r (underS r a)"
   2.737 -  using ordLess_iff_ordIso_Restr by blast
   2.738 -  let ?p = "Restr r (underS r a)"
   2.739 -  have "wo_rel.ofilter r (underS r a)" using 0
   2.740 -  by (simp add: wo_rel_def wo_rel.underS_ofilter)
   2.741 -  hence "Field ?p = underS r a" using 0 Field_Restr_ofilter by blast
   2.742 -  hence "Field ?p < Field r" using underS_Field2 1 by fast
   2.743 -  moreover have "?p <o r" using underS_Restr_ordLess[of r a] 0 1 by blast
   2.744 -  ultimately
   2.745 -  show "\<exists>p. Field p < Field r \<and> r' =o p \<and> p <o r" using 2 by blast
   2.746 -next
   2.747 -  assume "\<exists>p. Field p < Field r \<and> r' =o p \<and> p <o r"
   2.748 -  thus "r' <o r" using ordIso_ordLess_trans by blast
   2.749 -qed
   2.750 -
   2.751 -lemma internalize_ordLeq:
   2.752 -"(r' \<le>o r) = (\<exists>p. Field p \<le> Field r \<and> r' =o p \<and> p \<le>o r)"
   2.753 -proof
   2.754 -  assume *: "r' \<le>o r"
   2.755 -  moreover
   2.756 -  {assume "r' <o r"
   2.757 -   then obtain p where "Field p < Field r \<and> r' =o p \<and> p <o r"
   2.758 -   using internalize_ordLess[of r' r] by blast
   2.759 -   hence "\<exists>p. Field p \<le> Field r \<and> r' =o p \<and> p \<le>o r"
   2.760 -   using ordLeq_iff_ordLess_or_ordIso by blast
   2.761 -  }
   2.762 -  moreover
   2.763 -  have "r \<le>o r" using * ordLeq_def ordLeq_reflexive by blast
   2.764 -  ultimately show "\<exists>p. Field p \<le> Field r \<and> r' =o p \<and> p \<le>o r"
   2.765 -  using ordLeq_iff_ordLess_or_ordIso by blast
   2.766 -next
   2.767 -  assume "\<exists>p. Field p \<le> Field r \<and> r' =o p \<and> p \<le>o r"
   2.768 -  thus "r' \<le>o r" using ordIso_ordLeq_trans by blast
   2.769 -qed
   2.770 -
   2.771 -lemma ordLeq_iff_ordLess_Restr:
   2.772 -assumes WELL: "Well_order r" and WELL': "Well_order r'"
   2.773 -shows "(r \<le>o r') = (\<forall>a \<in> Field r. Restr r (underS r a) <o r')"
   2.774 -proof(auto)
   2.775 -  assume *: "r \<le>o r'"
   2.776 -  fix a assume "a \<in> Field r"
   2.777 -  hence "Restr r (underS r a) <o r"
   2.778 -  using WELL underS_Restr_ordLess[of r] by blast
   2.779 -  thus "Restr r (underS r a) <o r'"
   2.780 -  using * ordLess_ordLeq_trans by blast
   2.781 -next
   2.782 -  assume *: "\<forall>a \<in> Field r. Restr r (underS r a) <o r'"
   2.783 -  {assume "r' <o r"
   2.784 -   then obtain a where "a \<in> Field r \<and> r' =o Restr r (underS r a)"
   2.785 -   using assms ordLess_iff_ordIso_Restr by blast
   2.786 -   hence False using * not_ordLess_ordIso ordIso_symmetric by blast
   2.787 -  }
   2.788 -  thus "r \<le>o r'" using ordLess_or_ordLeq assms by blast
   2.789 -qed
   2.790 -
   2.791 -lemma finite_ordLess_infinite:
   2.792 -assumes WELL: "Well_order r" and WELL': "Well_order r'" and
   2.793 -        FIN: "finite(Field r)" and INF: "\<not>finite(Field r')"
   2.794 -shows "r <o r'"
   2.795 -proof-
   2.796 -  {assume "r' \<le>o r"
   2.797 -   then obtain h where "inj_on h (Field r') \<and> h ` (Field r') \<le> Field r"
   2.798 -   unfolding ordLeq_def using assms embed_inj_on embed_Field by blast
   2.799 -   hence False using finite_imageD finite_subset FIN INF by blast
   2.800 -  }
   2.801 -  thus ?thesis using WELL WELL' ordLess_or_ordLeq by blast
   2.802 -qed
   2.803 -
   2.804 -lemma finite_well_order_on_ordIso:
   2.805 -assumes FIN: "finite A" and
   2.806 -        WELL: "well_order_on A r" and WELL': "well_order_on A r'"
   2.807 -shows "r =o r'"
   2.808 -proof-
   2.809 -  have 0: "Well_order r \<and> Well_order r' \<and> Field r = A \<and> Field r' = A"
   2.810 -  using assms well_order_on_Well_order by blast
   2.811 -  moreover
   2.812 -  have "\<forall>r r'. well_order_on A r \<and> well_order_on A r' \<and> r \<le>o r'
   2.813 -                  \<longrightarrow> r =o r'"
   2.814 -  proof(clarify)
   2.815 -    fix r r' assume *: "well_order_on A r" and **: "well_order_on A r'"
   2.816 -    have 2: "Well_order r \<and> Well_order r' \<and> Field r = A \<and> Field r' = A"
   2.817 -    using * ** well_order_on_Well_order by blast
   2.818 -    assume "r \<le>o r'"
   2.819 -    then obtain f where 1: "embed r r' f" and
   2.820 -                        "inj_on f A \<and> f ` A \<le> A"
   2.821 -    unfolding ordLeq_def using 2 embed_inj_on embed_Field by blast
   2.822 -    hence "bij_betw f A A" unfolding bij_betw_def using FIN endo_inj_surj by blast
   2.823 -    thus "r =o r'" unfolding ordIso_def iso_def[abs_def] using 1 2 by auto
   2.824 -  qed
   2.825 -  ultimately show ?thesis using assms ordLeq_total ordIso_symmetric by blast
   2.826 -qed
   2.827 -
   2.828 -subsection{* @{text "<o"} is well-founded *}
   2.829 -
   2.830 -text {* Of course, it only makes sense to state that the @{text "<o"} is well-founded
   2.831 -on the restricted type @{text "'a rel rel"}.  We prove this by first showing that, for any set
   2.832 -of well-orders all embedded in a fixed well-order, the function mapping each well-order
   2.833 -in the set to an order filter of the fixed well-order is compatible w.r.t. to @{text "<o"} versus
   2.834 -{\em strict inclusion}; and we already know that strict inclusion of order filters is well-founded. *}
   2.835 -
   2.836 -definition ord_to_filter :: "'a rel \<Rightarrow> 'a rel \<Rightarrow> 'a set"
   2.837 -where "ord_to_filter r0 r \<equiv> (SOME f. embed r r0 f) ` (Field r)"
   2.838 -
   2.839 -lemma ord_to_filter_compat:
   2.840 -"compat (ordLess Int (ordLess^-1``{r0} \<times> ordLess^-1``{r0}))
   2.841 -        (ofilterIncl r0)
   2.842 -        (ord_to_filter r0)"
   2.843 -proof(unfold compat_def ord_to_filter_def, clarify)
   2.844 -  fix r1::"'a rel" and r2::"'a rel"
   2.845 -  let ?A1 = "Field r1"  let ?A2 ="Field r2" let ?A0 ="Field r0"
   2.846 -  let ?phi10 = "\<lambda> f10. embed r1 r0 f10" let ?f10 = "SOME f. ?phi10 f"
   2.847 -  let ?phi20 = "\<lambda> f20. embed r2 r0 f20" let ?f20 = "SOME f. ?phi20 f"
   2.848 -  assume *: "r1 <o r0" "r2 <o r0" and **: "r1 <o r2"
   2.849 -  hence "(\<exists>f. ?phi10 f) \<and> (\<exists>f. ?phi20 f)"
   2.850 -  by (auto simp add: ordLess_def embedS_def)
   2.851 -  hence "?phi10 ?f10 \<and> ?phi20 ?f20" by (auto simp add: someI_ex)
   2.852 -  thus "(?f10 ` ?A1, ?f20 ` ?A2) \<in> ofilterIncl r0"
   2.853 -  using * ** by (simp add: embed_ordLess_ofilterIncl)
   2.854 -qed
   2.855 -
   2.856 -theorem wf_ordLess: "wf ordLess"
   2.857 -proof-
   2.858 -  {fix r0 :: "('a \<times> 'a) set"
   2.859 -   (* need to annotate here!*)
   2.860 -   let ?ordLess = "ordLess::('d rel * 'd rel) set"
   2.861 -   let ?R = "?ordLess Int (?ordLess^-1``{r0} \<times> ?ordLess^-1``{r0})"
   2.862 -   {assume Case1: "Well_order r0"
   2.863 -    hence "wf ?R"
   2.864 -    using wf_ofilterIncl[of r0]
   2.865 -          compat_wf[of ?R "ofilterIncl r0" "ord_to_filter r0"]
   2.866 -          ord_to_filter_compat[of r0] by auto
   2.867 -   }
   2.868 -   moreover
   2.869 -   {assume Case2: "\<not> Well_order r0"
   2.870 -    hence "?R = {}" unfolding ordLess_def by auto
   2.871 -    hence "wf ?R" using wf_empty by simp
   2.872 -   }
   2.873 -   ultimately have "wf ?R" by blast
   2.874 -  }
   2.875 -  thus ?thesis by (simp add: trans_wf_iff ordLess_trans)
   2.876 -qed
   2.877 -
   2.878 -corollary exists_minim_Well_order:
   2.879 -assumes NE: "R \<noteq> {}" and WELL: "\<forall>r \<in> R. Well_order r"
   2.880 -shows "\<exists>r \<in> R. \<forall>r' \<in> R. r \<le>o r'"
   2.881 -proof-
   2.882 -  obtain r where "r \<in> R \<and> (\<forall>r' \<in> R. \<not> r' <o r)"
   2.883 -  using NE spec[OF spec[OF subst[OF wf_eq_minimal, of "%x. x", OF wf_ordLess]], of _ R]
   2.884 -    equals0I[of R] by blast
   2.885 -  with not_ordLeq_iff_ordLess WELL show ?thesis by blast
   2.886 -qed
   2.887 -
   2.888 -
   2.889 -subsection {* Copy via direct images *}
   2.890 -
   2.891 -text{* The direct image operator is the dual of the inverse image operator @{text "inv_image"}
   2.892 -from @{text "Relation.thy"}.  It is useful for transporting a well-order between
   2.893 -different types. *}
   2.894 -
   2.895 -definition dir_image :: "'a rel \<Rightarrow> ('a \<Rightarrow> 'a') \<Rightarrow> 'a' rel"
   2.896 -where
   2.897 -"dir_image r f = {(f a, f b)| a b. (a,b) \<in> r}"
   2.898 -
   2.899 -lemma dir_image_Field:
   2.900 -"Field(dir_image r f) = f ` (Field r)"
   2.901 -unfolding dir_image_def Field_def Range_def Domain_def by fast
   2.902 -
   2.903 -lemma dir_image_minus_Id:
   2.904 -"inj_on f (Field r) \<Longrightarrow> (dir_image r f) - Id = dir_image (r - Id) f"
   2.905 -unfolding inj_on_def Field_def dir_image_def by auto
   2.906 -
   2.907 -lemma Refl_dir_image:
   2.908 -assumes "Refl r"
   2.909 -shows "Refl(dir_image r f)"
   2.910 -proof-
   2.911 -  {fix a' b'
   2.912 -   assume "(a',b') \<in> dir_image r f"
   2.913 -   then obtain a b where 1: "a' = f a \<and> b' = f b \<and> (a,b) \<in> r"
   2.914 -   unfolding dir_image_def by blast
   2.915 -   hence "a \<in> Field r \<and> b \<in> Field r" using Field_def by fastforce
   2.916 -   hence "(a,a) \<in> r \<and> (b,b) \<in> r" using assms by (simp add: refl_on_def)
   2.917 -   with 1 have "(a',a') \<in> dir_image r f \<and> (b',b') \<in> dir_image r f"
   2.918 -   unfolding dir_image_def by auto
   2.919 -  }
   2.920 -  thus ?thesis
   2.921 -  by(unfold refl_on_def Field_def Domain_def Range_def, auto)
   2.922 -qed
   2.923 -
   2.924 -lemma trans_dir_image:
   2.925 -assumes TRANS: "trans r" and INJ: "inj_on f (Field r)"
   2.926 -shows "trans(dir_image r f)"
   2.927 -proof(unfold trans_def, auto)
   2.928 -  fix a' b' c'
   2.929 -  assume "(a',b') \<in> dir_image r f" "(b',c') \<in> dir_image r f"
   2.930 -  then obtain a b1 b2 c where 1: "a' = f a \<and> b' = f b1 \<and> b' = f b2 \<and> c' = f c" and
   2.931 -                         2: "(a,b1) \<in> r \<and> (b2,c) \<in> r"
   2.932 -  unfolding dir_image_def by blast
   2.933 -  hence "b1 \<in> Field r \<and> b2 \<in> Field r"
   2.934 -  unfolding Field_def by auto
   2.935 -  hence "b1 = b2" using 1 INJ unfolding inj_on_def by auto
   2.936 -  hence "(a,c): r" using 2 TRANS unfolding trans_def by blast
   2.937 -  thus "(a',c') \<in> dir_image r f"
   2.938 -  unfolding dir_image_def using 1 by auto
   2.939 -qed
   2.940 -
   2.941 -lemma Preorder_dir_image:
   2.942 -"\<lbrakk>Preorder r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> Preorder (dir_image r f)"
   2.943 -by (simp add: preorder_on_def Refl_dir_image trans_dir_image)
   2.944 -
   2.945 -lemma antisym_dir_image:
   2.946 -assumes AN: "antisym r" and INJ: "inj_on f (Field r)"
   2.947 -shows "antisym(dir_image r f)"
   2.948 -proof(unfold antisym_def, auto)
   2.949 -  fix a' b'
   2.950 -  assume "(a',b') \<in> dir_image r f" "(b',a') \<in> dir_image r f"
   2.951 -  then obtain a1 b1 a2 b2 where 1: "a' = f a1 \<and> a' = f a2 \<and> b' = f b1 \<and> b' = f b2" and
   2.952 -                           2: "(a1,b1) \<in> r \<and> (b2,a2) \<in> r " and
   2.953 -                           3: "{a1,a2,b1,b2} \<le> Field r"
   2.954 -  unfolding dir_image_def Field_def by blast
   2.955 -  hence "a1 = a2 \<and> b1 = b2" using INJ unfolding inj_on_def by auto
   2.956 -  hence "a1 = b2" using 2 AN unfolding antisym_def by auto
   2.957 -  thus "a' = b'" using 1 by auto
   2.958 -qed
   2.959 -
   2.960 -lemma Partial_order_dir_image:
   2.961 -"\<lbrakk>Partial_order r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> Partial_order (dir_image r f)"
   2.962 -by (simp add: partial_order_on_def Preorder_dir_image antisym_dir_image)
   2.963 -
   2.964 -lemma Total_dir_image:
   2.965 -assumes TOT: "Total r" and INJ: "inj_on f (Field r)"
   2.966 -shows "Total(dir_image r f)"
   2.967 -proof(unfold total_on_def, intro ballI impI)
   2.968 -  fix a' b'
   2.969 -  assume "a' \<in> Field (dir_image r f)" "b' \<in> Field (dir_image r f)"
   2.970 -  then obtain a and b where 1: "a \<in> Field r \<and> b \<in> Field r \<and> f a = a' \<and> f b = b'"
   2.971 -    unfolding dir_image_Field[of r f] by blast
   2.972 -  moreover assume "a' \<noteq> b'"
   2.973 -  ultimately have "a \<noteq> b" using INJ unfolding inj_on_def by auto
   2.974 -  hence "(a,b) \<in> r \<or> (b,a) \<in> r" using 1 TOT unfolding total_on_def by auto
   2.975 -  thus "(a',b') \<in> dir_image r f \<or> (b',a') \<in> dir_image r f"
   2.976 -  using 1 unfolding dir_image_def by auto
   2.977 -qed
   2.978 -
   2.979 -lemma Linear_order_dir_image:
   2.980 -"\<lbrakk>Linear_order r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> Linear_order (dir_image r f)"
   2.981 -by (simp add: linear_order_on_def Partial_order_dir_image Total_dir_image)
   2.982 -
   2.983 -lemma wf_dir_image:
   2.984 -assumes WF: "wf r" and INJ: "inj_on f (Field r)"
   2.985 -shows "wf(dir_image r f)"
   2.986 -proof(unfold wf_eq_minimal2, intro allI impI, elim conjE)
   2.987 -  fix A'::"'b set"
   2.988 -  assume SUB: "A' \<le> Field(dir_image r f)" and NE: "A' \<noteq> {}"
   2.989 -  obtain A where A_def: "A = {a \<in> Field r. f a \<in> A'}" by blast
   2.990 -  have "A \<noteq> {} \<and> A \<le> Field r" using A_def SUB NE by (auto simp: dir_image_Field)
   2.991 -  then obtain a where 1: "a \<in> A \<and> (\<forall>b \<in> A. (b,a) \<notin> r)"
   2.992 -  using spec[OF WF[unfolded wf_eq_minimal2], of A] by blast
   2.993 -  have "\<forall>b' \<in> A'. (b',f a) \<notin> dir_image r f"
   2.994 -  proof(clarify)
   2.995 -    fix b' assume *: "b' \<in> A'" and **: "(b',f a) \<in> dir_image r f"
   2.996 -    obtain b1 a1 where 2: "b' = f b1 \<and> f a = f a1" and
   2.997 -                       3: "(b1,a1) \<in> r \<and> {a1,b1} \<le> Field r"
   2.998 -    using ** unfolding dir_image_def Field_def by blast
   2.999 -    hence "a = a1" using 1 A_def INJ unfolding inj_on_def by auto
  2.1000 -    hence "b1 \<in> A \<and> (b1,a) \<in> r" using 2 3 A_def * by auto
  2.1001 -    with 1 show False by auto
  2.1002 -  qed
  2.1003 -  thus "\<exists>a'\<in>A'. \<forall>b'\<in>A'. (b', a') \<notin> dir_image r f"
  2.1004 -  using A_def 1 by blast
  2.1005 -qed
  2.1006 -
  2.1007 -lemma Well_order_dir_image:
  2.1008 -"\<lbrakk>Well_order r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> Well_order (dir_image r f)"
  2.1009 -using assms unfolding well_order_on_def
  2.1010 -using Linear_order_dir_image[of r f] wf_dir_image[of "r - Id" f]
  2.1011 -  dir_image_minus_Id[of f r]
  2.1012 -  subset_inj_on[of f "Field r" "Field(r - Id)"]
  2.1013 -  mono_Field[of "r - Id" r] by auto
  2.1014 -
  2.1015 -lemma dir_image_bij_betw:
  2.1016 -"\<lbrakk>inj_on f (Field r)\<rbrakk> \<Longrightarrow> bij_betw f (Field r) (Field (dir_image r f))"
  2.1017 -unfolding bij_betw_def by (simp add: dir_image_Field order_on_defs)
  2.1018 -
  2.1019 -lemma dir_image_compat:
  2.1020 -"compat r (dir_image r f) f"
  2.1021 -unfolding compat_def dir_image_def by auto
  2.1022 -
  2.1023 -lemma dir_image_iso:
  2.1024 -"\<lbrakk>Well_order r; inj_on f (Field r)\<rbrakk>  \<Longrightarrow> iso r (dir_image r f) f"
  2.1025 -using iso_iff3 dir_image_compat dir_image_bij_betw Well_order_dir_image by blast
  2.1026 -
  2.1027 -lemma dir_image_ordIso:
  2.1028 -"\<lbrakk>Well_order r; inj_on f (Field r)\<rbrakk>  \<Longrightarrow> r =o dir_image r f"
  2.1029 -unfolding ordIso_def using dir_image_iso Well_order_dir_image by blast
  2.1030 -
  2.1031 -lemma Well_order_iso_copy:
  2.1032 -assumes WELL: "well_order_on A r" and BIJ: "bij_betw f A A'"
  2.1033 -shows "\<exists>r'. well_order_on A' r' \<and> r =o r'"
  2.1034 -proof-
  2.1035 -   let ?r' = "dir_image r f"
  2.1036 -   have 1: "A = Field r \<and> Well_order r"
  2.1037 -   using WELL well_order_on_Well_order by blast
  2.1038 -   hence 2: "iso r ?r' f"
  2.1039 -   using dir_image_iso using BIJ unfolding bij_betw_def by auto
  2.1040 -   hence "f ` (Field r) = Field ?r'" using 1 iso_iff[of r ?r'] by blast
  2.1041 -   hence "Field ?r' = A'"
  2.1042 -   using 1 BIJ unfolding bij_betw_def by auto
  2.1043 -   moreover have "Well_order ?r'"
  2.1044 -   using 1 Well_order_dir_image BIJ unfolding bij_betw_def by blast
  2.1045 -   ultimately show ?thesis unfolding ordIso_def using 1 2 by blast
  2.1046 -qed
  2.1047 -
  2.1048 -
  2.1049 -subsection {* Bounded square *}
  2.1050 -
  2.1051 -text{* This construction essentially defines, for an order relation @{text "r"}, a lexicographic
  2.1052 -order @{text "bsqr r"} on @{text "(Field r) \<times> (Field r)"}, applying the
  2.1053 -following criteria (in this order):
  2.1054 -\begin{itemize}
  2.1055 -\item compare the maximums;
  2.1056 -\item compare the first components;
  2.1057 -\item compare the second components.
  2.1058 -\end{itemize}
  2.1059 -%
  2.1060 -The only application of this construction that we are aware of is
  2.1061 -at proving that the square of an infinite set has the same cardinal
  2.1062 -as that set. The essential property required there (and which is ensured by this
  2.1063 -construction) is that any proper order filter of the product order is included in a rectangle, i.e.,
  2.1064 -in a product of proper filters on the original relation (assumed to be a well-order). *}
  2.1065 -
  2.1066 -definition bsqr :: "'a rel => ('a * 'a)rel"
  2.1067 -where
  2.1068 -"bsqr r = {((a1,a2),(b1,b2)).
  2.1069 -           {a1,a2,b1,b2} \<le> Field r \<and>
  2.1070 -           (a1 = b1 \<and> a2 = b2 \<or>
  2.1071 -            (wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r - Id \<or>
  2.1072 -            wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> (a1,b1) \<in> r - Id \<or>
  2.1073 -            wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> a1 = b1  \<and> (a2,b2) \<in> r - Id
  2.1074 -           )}"
  2.1075 -
  2.1076 -lemma Field_bsqr:
  2.1077 -"Field (bsqr r) = Field r \<times> Field r"
  2.1078 -proof
  2.1079 -  show "Field (bsqr r) \<le> Field r \<times> Field r"
  2.1080 -  proof-
  2.1081 -    {fix a1 a2 assume "(a1,a2) \<in> Field (bsqr r)"
  2.1082 -     moreover
  2.1083 -     have "\<And> b1 b2. ((a1,a2),(b1,b2)) \<in> bsqr r \<or> ((b1,b2),(a1,a2)) \<in> bsqr r \<Longrightarrow>
  2.1084 -                      a1 \<in> Field r \<and> a2 \<in> Field r" unfolding bsqr_def by auto
  2.1085 -     ultimately have "a1 \<in> Field r \<and> a2 \<in> Field r" unfolding Field_def by auto
  2.1086 -    }
  2.1087 -    thus ?thesis unfolding Field_def by force
  2.1088 -  qed
  2.1089 -next
  2.1090 -  show "Field r \<times> Field r \<le> Field (bsqr r)"
  2.1091 -  proof(auto)
  2.1092 -    fix a1 a2 assume "a1 \<in> Field r" and "a2 \<in> Field r"
  2.1093 -    hence "((a1,a2),(a1,a2)) \<in> bsqr r" unfolding bsqr_def by blast
  2.1094 -    thus "(a1,a2) \<in> Field (bsqr r)" unfolding Field_def by auto
  2.1095 -  qed
  2.1096 -qed
  2.1097 -
  2.1098 -lemma bsqr_Refl: "Refl(bsqr r)"
  2.1099 -by(unfold refl_on_def Field_bsqr, auto simp add: bsqr_def)
  2.1100 -
  2.1101 -lemma bsqr_Trans:
  2.1102 -assumes "Well_order r"
  2.1103 -shows "trans (bsqr r)"
  2.1104 -proof(unfold trans_def, auto)
  2.1105 -  (* Preliminary facts *)
  2.1106 -  have Well: "wo_rel r" using assms wo_rel_def by auto
  2.1107 -  hence Trans: "trans r" using wo_rel.TRANS by auto
  2.1108 -  have Anti: "antisym r" using wo_rel.ANTISYM Well by auto
  2.1109 -  hence TransS: "trans(r - Id)" using Trans by (simp add: trans_diff_Id)
  2.1110 -  (* Main proof *)
  2.1111 -  fix a1 a2 b1 b2 c1 c2
  2.1112 -  assume *: "((a1,a2),(b1,b2)) \<in> bsqr r" and **: "((b1,b2),(c1,c2)) \<in> bsqr r"
  2.1113 -  hence 0: "{a1,a2,b1,b2,c1,c2} \<le> Field r" unfolding bsqr_def by auto
  2.1114 -  have 1: "a1 = b1 \<and> a2 = b2 \<or> (wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r - Id \<or>
  2.1115 -           wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> (a1,b1) \<in> r - Id \<or>
  2.1116 -           wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> a1 = b1 \<and> (a2,b2) \<in> r - Id"
  2.1117 -  using * unfolding bsqr_def by auto
  2.1118 -  have 2: "b1 = c1 \<and> b2 = c2 \<or> (wo_rel.max2 r b1 b2, wo_rel.max2 r c1 c2) \<in> r - Id \<or>
  2.1119 -           wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> (b1,c1) \<in> r - Id \<or>
  2.1120 -           wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> b1 = c1 \<and> (b2,c2) \<in> r - Id"
  2.1121 -  using ** unfolding bsqr_def by auto
  2.1122 -  show "((a1,a2),(c1,c2)) \<in> bsqr r"
  2.1123 -  proof-
  2.1124 -    {assume Case1: "a1 = b1 \<and> a2 = b2"
  2.1125 -     hence ?thesis using ** by simp
  2.1126 -    }
  2.1127 -    moreover
  2.1128 -    {assume Case2: "(wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r - Id"
  2.1129 -     {assume Case21: "b1 = c1 \<and> b2 = c2"
  2.1130 -      hence ?thesis using * by simp
  2.1131 -     }
  2.1132 -     moreover
  2.1133 -     {assume Case22: "(wo_rel.max2 r b1 b2, wo_rel.max2 r c1 c2) \<in> r - Id"
  2.1134 -      hence "(wo_rel.max2 r a1 a2, wo_rel.max2 r c1 c2) \<in> r - Id"
  2.1135 -      using Case2 TransS trans_def[of "r - Id"] by blast
  2.1136 -      hence ?thesis using 0 unfolding bsqr_def by auto
  2.1137 -     }
  2.1138 -     moreover
  2.1139 -     {assume Case23_4: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2"
  2.1140 -      hence ?thesis using Case2 0 unfolding bsqr_def by auto
  2.1141 -     }
  2.1142 -     ultimately have ?thesis using 0 2 by auto
  2.1143 -    }
  2.1144 -    moreover
  2.1145 -    {assume Case3: "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> (a1,b1) \<in> r - Id"
  2.1146 -     {assume Case31: "b1 = c1 \<and> b2 = c2"
  2.1147 -      hence ?thesis using * by simp
  2.1148 -     }
  2.1149 -     moreover
  2.1150 -     {assume Case32: "(wo_rel.max2 r b1 b2, wo_rel.max2 r c1 c2) \<in> r - Id"
  2.1151 -      hence ?thesis using Case3 0 unfolding bsqr_def by auto
  2.1152 -     }
  2.1153 -     moreover
  2.1154 -     {assume Case33: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> (b1,c1) \<in> r - Id"
  2.1155 -      hence "(a1,c1) \<in> r - Id"
  2.1156 -      using Case3 TransS trans_def[of "r - Id"] by blast
  2.1157 -      hence ?thesis using Case3 Case33 0 unfolding bsqr_def by auto
  2.1158 -     }
  2.1159 -     moreover
  2.1160 -     {assume Case33: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> b1 = c1"
  2.1161 -      hence ?thesis using Case3 0 unfolding bsqr_def by auto
  2.1162 -     }
  2.1163 -     ultimately have ?thesis using 0 2 by auto
  2.1164 -    }
  2.1165 -    moreover
  2.1166 -    {assume Case4: "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> a1 = b1 \<and> (a2,b2) \<in> r - Id"
  2.1167 -     {assume Case41: "b1 = c1 \<and> b2 = c2"
  2.1168 -      hence ?thesis using * by simp
  2.1169 -     }
  2.1170 -     moreover
  2.1171 -     {assume Case42: "(wo_rel.max2 r b1 b2, wo_rel.max2 r c1 c2) \<in> r - Id"
  2.1172 -      hence ?thesis using Case4 0 unfolding bsqr_def by force
  2.1173 -     }
  2.1174 -     moreover
  2.1175 -     {assume Case43: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> (b1,c1) \<in> r - Id"
  2.1176 -      hence ?thesis using Case4 0 unfolding bsqr_def by auto
  2.1177 -     }
  2.1178 -     moreover
  2.1179 -     {assume Case44: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> b1 = c1 \<and> (b2,c2) \<in> r - Id"
  2.1180 -      hence "(a2,c2) \<in> r - Id"
  2.1181 -      using Case4 TransS trans_def[of "r - Id"] by blast
  2.1182 -      hence ?thesis using Case4 Case44 0 unfolding bsqr_def by auto
  2.1183 -     }
  2.1184 -     ultimately have ?thesis using 0 2 by auto
  2.1185 -    }
  2.1186 -    ultimately show ?thesis using 0 1 by auto
  2.1187 -  qed
  2.1188 -qed
  2.1189 -
  2.1190 -lemma bsqr_antisym:
  2.1191 -assumes "Well_order r"
  2.1192 -shows "antisym (bsqr r)"
  2.1193 -proof(unfold antisym_def, clarify)
  2.1194 -  (* Preliminary facts *)
  2.1195 -  have Well: "wo_rel r" using assms wo_rel_def by auto
  2.1196 -  hence Trans: "trans r" using wo_rel.TRANS by auto
  2.1197 -  have Anti: "antisym r" using wo_rel.ANTISYM Well by auto
  2.1198 -  hence TransS: "trans(r - Id)" using Trans by (simp add: trans_diff_Id)
  2.1199 -  hence IrrS: "\<forall>a b. \<not>((a,b) \<in> r - Id \<and> (b,a) \<in> r - Id)"
  2.1200 -  using Anti trans_def[of "r - Id"] antisym_def[of "r - Id"] by blast
  2.1201 -  (* Main proof *)
  2.1202 -  fix a1 a2 b1 b2
  2.1203 -  assume *: "((a1,a2),(b1,b2)) \<in> bsqr r" and **: "((b1,b2),(a1,a2)) \<in> bsqr r"
  2.1204 -  hence 0: "{a1,a2,b1,b2} \<le> Field r" unfolding bsqr_def by auto
  2.1205 -  have 1: "a1 = b1 \<and> a2 = b2 \<or> (wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r - Id \<or>
  2.1206 -           wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> (a1,b1) \<in> r - Id \<or>
  2.1207 -           wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> a1 = b1 \<and> (a2,b2) \<in> r - Id"
  2.1208 -  using * unfolding bsqr_def by auto
  2.1209 -  have 2: "b1 = a1 \<and> b2 = a2 \<or> (wo_rel.max2 r b1 b2, wo_rel.max2 r a1 a2) \<in> r - Id \<or>
  2.1210 -           wo_rel.max2 r b1 b2 = wo_rel.max2 r a1 a2 \<and> (b1,a1) \<in> r - Id \<or>
  2.1211 -           wo_rel.max2 r b1 b2 = wo_rel.max2 r a1 a2 \<and> b1 = a1 \<and> (b2,a2) \<in> r - Id"
  2.1212 -  using ** unfolding bsqr_def by auto
  2.1213 -  show "a1 = b1 \<and> a2 = b2"
  2.1214 -  proof-
  2.1215 -    {assume Case1: "(wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r - Id"
  2.1216 -     {assume Case11: "(wo_rel.max2 r b1 b2, wo_rel.max2 r a1 a2) \<in> r - Id"
  2.1217 -      hence False using Case1 IrrS by blast
  2.1218 -     }
  2.1219 -     moreover
  2.1220 -     {assume Case12_3: "wo_rel.max2 r b1 b2 = wo_rel.max2 r a1 a2"
  2.1221 -      hence False using Case1 by auto
  2.1222 -     }
  2.1223 -     ultimately have ?thesis using 0 2 by auto
  2.1224 -    }
  2.1225 -    moreover
  2.1226 -    {assume Case2: "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> (a1,b1) \<in> r - Id"
  2.1227 -     {assume Case21: "(wo_rel.max2 r b1 b2, wo_rel.max2 r a1 a2) \<in> r - Id"
  2.1228 -       hence False using Case2 by auto
  2.1229 -     }
  2.1230 -     moreover
  2.1231 -     {assume Case22: "(b1,a1) \<in> r - Id"
  2.1232 -      hence False using Case2 IrrS by blast
  2.1233 -     }
  2.1234 -     moreover
  2.1235 -     {assume Case23: "b1 = a1"
  2.1236 -      hence False using Case2 by auto
  2.1237 -     }
  2.1238 -     ultimately have ?thesis using 0 2 by auto
  2.1239 -    }
  2.1240 -    moreover
  2.1241 -    {assume Case3: "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> a1 = b1 \<and> (a2,b2) \<in> r - Id"
  2.1242 -     moreover
  2.1243 -     {assume Case31: "(wo_rel.max2 r b1 b2, wo_rel.max2 r a1 a2) \<in> r - Id"
  2.1244 -      hence False using Case3 by auto
  2.1245 -     }
  2.1246 -     moreover
  2.1247 -     {assume Case32: "(b1,a1) \<in> r - Id"
  2.1248 -      hence False using Case3 by auto
  2.1249 -     }
  2.1250 -     moreover
  2.1251 -     {assume Case33: "(b2,a2) \<in> r - Id"
  2.1252 -      hence False using Case3 IrrS by blast
  2.1253 -     }
  2.1254 -     ultimately have ?thesis using 0 2 by auto
  2.1255 -    }
  2.1256 -    ultimately show ?thesis using 0 1 by blast
  2.1257 -  qed
  2.1258 -qed
  2.1259 -
  2.1260 -lemma bsqr_Total:
  2.1261 -assumes "Well_order r"
  2.1262 -shows "Total(bsqr r)"
  2.1263 -proof-
  2.1264 -  (* Preliminary facts *)
  2.1265 -  have Well: "wo_rel r" using assms wo_rel_def by auto
  2.1266 -  hence Total: "\<forall>a \<in> Field r. \<forall>b \<in> Field r. (a,b) \<in> r \<or> (b,a) \<in> r"
  2.1267 -  using wo_rel.TOTALS by auto
  2.1268 -  (* Main proof *)
  2.1269 -  {fix a1 a2 b1 b2 assume "{(a1,a2), (b1,b2)} \<le> Field(bsqr r)"
  2.1270 -   hence 0: "a1 \<in> Field r \<and> a2 \<in> Field r \<and> b1 \<in> Field r \<and> b2 \<in> Field r"
  2.1271 -   using Field_bsqr by blast
  2.1272 -   have "((a1,a2) = (b1,b2) \<or> ((a1,a2),(b1,b2)) \<in> bsqr r \<or> ((b1,b2),(a1,a2)) \<in> bsqr r)"
  2.1273 -   proof(rule wo_rel.cases_Total[of r a1 a2], clarsimp simp add: Well, simp add: 0)
  2.1274 -       (* Why didn't clarsimp simp add: Well 0 do the same job? *)
  2.1275 -     assume Case1: "(a1,a2) \<in> r"
  2.1276 -     hence 1: "wo_rel.max2 r a1 a2 = a2"
  2.1277 -     using Well 0 by (simp add: wo_rel.max2_equals2)
  2.1278 -     show ?thesis
  2.1279 -     proof(rule wo_rel.cases_Total[of r b1 b2], clarsimp simp add: Well, simp add: 0)
  2.1280 -       assume Case11: "(b1,b2) \<in> r"
  2.1281 -       hence 2: "wo_rel.max2 r b1 b2 = b2"
  2.1282 -       using Well 0 by (simp add: wo_rel.max2_equals2)
  2.1283 -       show ?thesis
  2.1284 -       proof(rule wo_rel.cases_Total3[of r a2 b2], clarsimp simp add: Well, simp add: 0)
  2.1285 -         assume Case111: "(a2,b2) \<in> r - Id \<or> (b2,a2) \<in> r - Id"
  2.1286 -         thus ?thesis using 0 1 2 unfolding bsqr_def by auto
  2.1287 -       next
  2.1288 -         assume Case112: "a2 = b2"
  2.1289 -         show ?thesis
  2.1290 -         proof(rule wo_rel.cases_Total3[of r a1 b1], clarsimp simp add: Well, simp add: 0)
  2.1291 -           assume Case1121: "(a1,b1) \<in> r - Id \<or> (b1,a1) \<in> r - Id"
  2.1292 -           thus ?thesis using 0 1 2 Case112 unfolding bsqr_def by auto
  2.1293 -         next
  2.1294 -           assume Case1122: "a1 = b1"
  2.1295 -           thus ?thesis using Case112 by auto
  2.1296 -         qed
  2.1297 -       qed
  2.1298 -     next
  2.1299 -       assume Case12: "(b2,b1) \<in> r"
  2.1300 -       hence 3: "wo_rel.max2 r b1 b2 = b1" using Well 0 by (simp add: wo_rel.max2_equals1)
  2.1301 -       show ?thesis
  2.1302 -       proof(rule wo_rel.cases_Total3[of r a2 b1], clarsimp simp add: Well, simp add: 0)
  2.1303 -         assume Case121: "(a2,b1) \<in> r - Id \<or> (b1,a2) \<in> r - Id"
  2.1304 -         thus ?thesis using 0 1 3 unfolding bsqr_def by auto
  2.1305 -       next
  2.1306 -         assume Case122: "a2 = b1"
  2.1307 -         show ?thesis
  2.1308 -         proof(rule wo_rel.cases_Total3[of r a1 b1], clarsimp simp add: Well, simp add: 0)
  2.1309 -           assume Case1221: "(a1,b1) \<in> r - Id \<or> (b1,a1) \<in> r - Id"
  2.1310 -           thus ?thesis using 0 1 3 Case122 unfolding bsqr_def by auto
  2.1311 -         next
  2.1312 -           assume Case1222: "a1 = b1"
  2.1313 -           show ?thesis
  2.1314 -           proof(rule wo_rel.cases_Total3[of r a2 b2], clarsimp simp add: Well, simp add: 0)
  2.1315 -             assume Case12221: "(a2,b2) \<in> r - Id \<or> (b2,a2) \<in> r - Id"
  2.1316 -             thus ?thesis using 0 1 3 Case122 Case1222 unfolding bsqr_def by auto
  2.1317 -           next
  2.1318 -             assume Case12222: "a2 = b2"
  2.1319 -             thus ?thesis using Case122 Case1222 by auto
  2.1320 -           qed
  2.1321 -         qed
  2.1322 -       qed
  2.1323 -     qed
  2.1324 -   next
  2.1325 -     assume Case2: "(a2,a1) \<in> r"
  2.1326 -     hence 1: "wo_rel.max2 r a1 a2 = a1" using Well 0 by (simp add: wo_rel.max2_equals1)
  2.1327 -     show ?thesis
  2.1328 -     proof(rule wo_rel.cases_Total[of r b1 b2], clarsimp simp add: Well, simp add: 0)
  2.1329 -       assume Case21: "(b1,b2) \<in> r"
  2.1330 -       hence 2: "wo_rel.max2 r b1 b2 = b2" using Well 0 by (simp add: wo_rel.max2_equals2)
  2.1331 -       show ?thesis
  2.1332 -       proof(rule wo_rel.cases_Total3[of r a1 b2], clarsimp simp add: Well, simp add: 0)
  2.1333 -         assume Case211: "(a1,b2) \<in> r - Id \<or> (b2,a1) \<in> r - Id"
  2.1334 -         thus ?thesis using 0 1 2 unfolding bsqr_def by auto
  2.1335 -       next
  2.1336 -         assume Case212: "a1 = b2"
  2.1337 -         show ?thesis
  2.1338 -         proof(rule wo_rel.cases_Total3[of r a1 b1], clarsimp simp add: Well, simp add: 0)
  2.1339 -           assume Case2121: "(a1,b1) \<in> r - Id \<or> (b1,a1) \<in> r - Id"
  2.1340 -           thus ?thesis using 0 1 2 Case212 unfolding bsqr_def by auto
  2.1341 -         next
  2.1342 -           assume Case2122: "a1 = b1"
  2.1343 -           show ?thesis
  2.1344 -           proof(rule wo_rel.cases_Total3[of r a2 b2], clarsimp simp add: Well, simp add: 0)
  2.1345 -             assume Case21221: "(a2,b2) \<in> r - Id \<or> (b2,a2) \<in> r - Id"
  2.1346 -             thus ?thesis using 0 1 2 Case212 Case2122 unfolding bsqr_def by auto
  2.1347 -           next
  2.1348 -             assume Case21222: "a2 = b2"
  2.1349 -             thus ?thesis using Case2122 Case212 by auto
  2.1350 -           qed
  2.1351 -         qed
  2.1352 -       qed
  2.1353 -     next
  2.1354 -       assume Case22: "(b2,b1) \<in> r"
  2.1355 -       hence 3: "wo_rel.max2 r b1 b2 = b1"  using Well 0 by (simp add: wo_rel.max2_equals1)
  2.1356 -       show ?thesis
  2.1357 -       proof(rule wo_rel.cases_Total3[of r a1 b1], clarsimp simp add: Well, simp add: 0)
  2.1358 -         assume Case221: "(a1,b1) \<in> r - Id \<or> (b1,a1) \<in> r - Id"
  2.1359 -         thus ?thesis using 0 1 3 unfolding bsqr_def by auto
  2.1360 -       next
  2.1361 -         assume Case222: "a1 = b1"
  2.1362 -         show ?thesis
  2.1363 -         proof(rule wo_rel.cases_Total3[of r a2 b2], clarsimp simp add: Well, simp add: 0)
  2.1364 -           assume Case2221: "(a2,b2) \<in> r - Id \<or> (b2,a2) \<in> r - Id"
  2.1365 -           thus ?thesis using 0 1 3 Case222 unfolding bsqr_def by auto
  2.1366 -         next
  2.1367 -           assume Case2222: "a2 = b2"
  2.1368 -           thus ?thesis using Case222 by auto
  2.1369 -         qed
  2.1370 -       qed
  2.1371 -     qed
  2.1372 -   qed
  2.1373 -  }
  2.1374 -  thus ?thesis unfolding total_on_def by fast
  2.1375 -qed
  2.1376 -
  2.1377 -lemma bsqr_Linear_order:
  2.1378 -assumes "Well_order r"
  2.1379 -shows "Linear_order(bsqr r)"
  2.1380 -unfolding order_on_defs
  2.1381 -using assms bsqr_Refl bsqr_Trans bsqr_antisym bsqr_Total by blast
  2.1382 -
  2.1383 -lemma bsqr_Well_order:
  2.1384 -assumes "Well_order r"
  2.1385 -shows "Well_order(bsqr r)"
  2.1386 -using assms
  2.1387 -proof(simp add: bsqr_Linear_order Linear_order_Well_order_iff, intro allI impI)
  2.1388 -  have 0: "\<forall>A \<le> Field r. A \<noteq> {} \<longrightarrow> (\<exists>a \<in> A. \<forall>a' \<in> A. (a,a') \<in> r)"
  2.1389 -  using assms well_order_on_def Linear_order_Well_order_iff by blast
  2.1390 -  fix D assume *: "D \<le> Field (bsqr r)" and **: "D \<noteq> {}"
  2.1391 -  hence 1: "D \<le> Field r \<times> Field r" unfolding Field_bsqr by simp
  2.1392 -  (*  *)
  2.1393 -  obtain M where M_def: "M = {wo_rel.max2 r a1 a2| a1 a2. (a1,a2) \<in> D}" by blast
  2.1394 -  have "M \<noteq> {}" using 1 M_def ** by auto
  2.1395 -  moreover
  2.1396 -  have "M \<le> Field r" unfolding M_def
  2.1397 -  using 1 assms wo_rel_def[of r] wo_rel.max2_among[of r] by fastforce
  2.1398 -  ultimately obtain m where m_min: "m \<in> M \<and> (\<forall>a \<in> M. (m,a) \<in> r)"
  2.1399 -  using 0 by blast
  2.1400 -  (*  *)
  2.1401 -  obtain A1 where A1_def: "A1 = {a1. \<exists>a2. (a1,a2) \<in> D \<and> wo_rel.max2 r a1 a2 = m}" by blast
  2.1402 -  have "A1 \<le> Field r" unfolding A1_def using 1 by auto
  2.1403 -  moreover have "A1 \<noteq> {}" unfolding A1_def using m_min unfolding M_def by blast
  2.1404 -  ultimately obtain a1 where a1_min: "a1 \<in> A1 \<and> (\<forall>a \<in> A1. (a1,a) \<in> r)"
  2.1405 -  using 0 by blast
  2.1406 -  (*  *)
  2.1407 -  obtain A2 where A2_def: "A2 = {a2. (a1,a2) \<in> D \<and> wo_rel.max2 r a1 a2 = m}" by blast
  2.1408 -  have "A2 \<le> Field r" unfolding A2_def using 1 by auto
  2.1409 -  moreover have "A2 \<noteq> {}" unfolding A2_def
  2.1410 -  using m_min a1_min unfolding A1_def M_def by blast
  2.1411 -  ultimately obtain a2 where a2_min: "a2 \<in> A2 \<and> (\<forall>a \<in> A2. (a2,a) \<in> r)"
  2.1412 -  using 0 by blast
  2.1413 -  (*   *)
  2.1414 -  have 2: "wo_rel.max2 r a1 a2 = m"
  2.1415 -  using a1_min a2_min unfolding A1_def A2_def by auto
  2.1416 -  have 3: "(a1,a2) \<in> D" using a2_min unfolding A2_def by auto
  2.1417 -  (*  *)
  2.1418 -  moreover
  2.1419 -  {fix b1 b2 assume ***: "(b1,b2) \<in> D"
  2.1420 -   hence 4: "{a1,a2,b1,b2} \<le> Field r" using 1 3 by blast
  2.1421 -   have 5: "(wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r"
  2.1422 -   using *** a1_min a2_min m_min unfolding A1_def A2_def M_def by auto
  2.1423 -   have "((a1,a2),(b1,b2)) \<in> bsqr r"
  2.1424 -   proof(cases "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2")
  2.1425 -     assume Case1: "wo_rel.max2 r a1 a2 \<noteq> wo_rel.max2 r b1 b2"
  2.1426 -     thus ?thesis unfolding bsqr_def using 4 5 by auto
  2.1427 -   next
  2.1428 -     assume Case2: "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2"
  2.1429 -     hence "b1 \<in> A1" unfolding A1_def using 2 *** by auto
  2.1430 -     hence 6: "(a1,b1) \<in> r" using a1_min by auto
  2.1431 -     show ?thesis
  2.1432 -     proof(cases "a1 = b1")
  2.1433 -       assume Case21: "a1 \<noteq> b1"
  2.1434 -       thus ?thesis unfolding bsqr_def using 4 Case2 6 by auto
  2.1435 -     next
  2.1436 -       assume Case22: "a1 = b1"
  2.1437 -       hence "b2 \<in> A2" unfolding A2_def using 2 *** Case2 by auto
  2.1438 -       hence 7: "(a2,b2) \<in> r" using a2_min by auto
  2.1439 -       thus ?thesis unfolding bsqr_def using 4 7 Case2 Case22 by auto
  2.1440 -     qed
  2.1441 -   qed
  2.1442 -  }
  2.1443 -  (*  *)
  2.1444 -  ultimately show "\<exists>d \<in> D. \<forall>d' \<in> D. (d,d') \<in> bsqr r" by fastforce
  2.1445 -qed
  2.1446 -
  2.1447 -lemma bsqr_max2:
  2.1448 -assumes WELL: "Well_order r" and LEQ: "((a1,a2),(b1,b2)) \<in> bsqr r"
  2.1449 -shows "(wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r"
  2.1450 -proof-
  2.1451 -  have "{(a1,a2),(b1,b2)} \<le> Field(bsqr r)"
  2.1452 -  using LEQ unfolding Field_def by auto
  2.1453 -  hence "{a1,a2,b1,b2} \<le> Field r" unfolding Field_bsqr by auto
  2.1454 -  hence "{wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2} \<le> Field r"
  2.1455 -  using WELL wo_rel_def[of r] wo_rel.max2_among[of r] by fastforce
  2.1456 -  moreover have "(wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r \<or> wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2"
  2.1457 -  using LEQ unfolding bsqr_def by auto
  2.1458 -  ultimately show ?thesis using WELL unfolding order_on_defs refl_on_def by auto
  2.1459 -qed
  2.1460 -
  2.1461 -lemma bsqr_ofilter:
  2.1462 -assumes WELL: "Well_order r" and
  2.1463 -        OF: "wo_rel.ofilter (bsqr r) D" and SUB: "D < Field r \<times> Field r" and
  2.1464 -        NE: "\<not> (\<exists>a. Field r = under r a)"
  2.1465 -shows "\<exists>A. wo_rel.ofilter r A \<and> A < Field r \<and> D \<le> A \<times> A"
  2.1466 -proof-
  2.1467 -  let ?r' = "bsqr r"
  2.1468 -  have Well: "wo_rel r" using WELL wo_rel_def by blast
  2.1469 -  hence Trans: "trans r" using wo_rel.TRANS by blast
  2.1470 -  have Well': "Well_order ?r' \<and> wo_rel ?r'"
  2.1471 -  using WELL bsqr_Well_order wo_rel_def by blast
  2.1472 -  (*  *)
  2.1473 -  have "D < Field ?r'" unfolding Field_bsqr using SUB .
  2.1474 -  with OF obtain a1 and a2 where
  2.1475 -  "(a1,a2) \<in> Field ?r'" and 1: "D = underS ?r' (a1,a2)"
  2.1476 -  using Well' wo_rel.ofilter_underS_Field[of ?r' D] by auto
  2.1477 -  hence 2: "{a1,a2} \<le> Field r" unfolding Field_bsqr by auto
  2.1478 -  let ?m = "wo_rel.max2 r a1 a2"
  2.1479 -  have "D \<le> (under r ?m) \<times> (under r ?m)"
  2.1480 -  proof(unfold 1)
  2.1481 -    {fix b1 b2
  2.1482 -     let ?n = "wo_rel.max2 r b1 b2"
  2.1483 -     assume "(b1,b2) \<in> underS ?r' (a1,a2)"
  2.1484 -     hence 3: "((b1,b2),(a1,a2)) \<in> ?r'"
  2.1485 -     unfolding underS_def by blast
  2.1486 -     hence "(?n,?m) \<in> r" using WELL by (simp add: bsqr_max2)
  2.1487 -     moreover
  2.1488 -     {have "(b1,b2) \<in> Field ?r'" using 3 unfolding Field_def by auto
  2.1489 -      hence "{b1,b2} \<le> Field r" unfolding Field_bsqr by auto
  2.1490 -      hence "(b1,?n) \<in> r \<and> (b2,?n) \<in> r"
  2.1491 -      using Well by (simp add: wo_rel.max2_greater)
  2.1492 -     }
  2.1493 -     ultimately have "(b1,?m) \<in> r \<and> (b2,?m) \<in> r"
  2.1494 -     using Trans trans_def[of r] by blast
  2.1495 -     hence "(b1,b2) \<in> (under r ?m) \<times> (under r ?m)" unfolding under_def by simp}
  2.1496 -     thus "underS ?r' (a1,a2) \<le> (under r ?m) \<times> (under r ?m)" by auto
  2.1497 -  qed
  2.1498 -  moreover have "wo_rel.ofilter r (under r ?m)"
  2.1499 -  using Well by (simp add: wo_rel.under_ofilter)
  2.1500 -  moreover have "under r ?m < Field r"
  2.1501 -  using NE under_Field[of r ?m] by blast
  2.1502 -  ultimately show ?thesis by blast
  2.1503 -qed
  2.1504 -
  2.1505 -definition Func where
  2.1506 -"Func A B = {f . (\<forall> a \<in> A. f a \<in> B) \<and> (\<forall> a. a \<notin> A \<longrightarrow> f a = undefined)}"
  2.1507 -
  2.1508 -lemma Func_empty:
  2.1509 -"Func {} B = {\<lambda>x. undefined}"
  2.1510 -unfolding Func_def by auto
  2.1511 -
  2.1512 -lemma Func_elim:
  2.1513 -assumes "g \<in> Func A B" and "a \<in> A"
  2.1514 -shows "\<exists> b. b \<in> B \<and> g a = b"
  2.1515 -using assms unfolding Func_def by (cases "g a = undefined") auto
  2.1516 -
  2.1517 -definition curr where
  2.1518 -"curr A f \<equiv> \<lambda> a. if a \<in> A then \<lambda>b. f (a,b) else undefined"
  2.1519 -
  2.1520 -lemma curr_in:
  2.1521 -assumes f: "f \<in> Func (A <*> B) C"
  2.1522 -shows "curr A f \<in> Func A (Func B C)"
  2.1523 -using assms unfolding curr_def Func_def by auto
  2.1524 -
  2.1525 -lemma curr_inj:
  2.1526 -assumes "f1 \<in> Func (A <*> B) C" and "f2 \<in> Func (A <*> B) C"
  2.1527 -shows "curr A f1 = curr A f2 \<longleftrightarrow> f1 = f2"
  2.1528 -proof safe
  2.1529 -  assume c: "curr A f1 = curr A f2"
  2.1530 -  show "f1 = f2"
  2.1531 -  proof (rule ext, clarify)
  2.1532 -    fix a b show "f1 (a, b) = f2 (a, b)"
  2.1533 -    proof (cases "(a,b) \<in> A <*> B")
  2.1534 -      case False
  2.1535 -      thus ?thesis using assms unfolding Func_def by auto
  2.1536 -    next
  2.1537 -      case True hence a: "a \<in> A" and b: "b \<in> B" by auto
  2.1538 -      thus ?thesis
  2.1539 -      using c unfolding curr_def fun_eq_iff by(elim allE[of _ a]) simp
  2.1540 -    qed
  2.1541 -  qed
  2.1542 -qed
  2.1543 -
  2.1544 -lemma curr_surj:
  2.1545 -assumes "g \<in> Func A (Func B C)"
  2.1546 -shows "\<exists> f \<in> Func (A <*> B) C. curr A f = g"
  2.1547 -proof
  2.1548 -  let ?f = "\<lambda> ab. if fst ab \<in> A \<and> snd ab \<in> B then g (fst ab) (snd ab) else undefined"
  2.1549 -  show "curr A ?f = g"
  2.1550 -  proof (rule ext)
  2.1551 -    fix a show "curr A ?f a = g a"
  2.1552 -    proof (cases "a \<in> A")
  2.1553 -      case False
  2.1554 -      hence "g a = undefined" using assms unfolding Func_def by auto
  2.1555 -      thus ?thesis unfolding curr_def using False by simp
  2.1556 -    next
  2.1557 -      case True
  2.1558 -      obtain g1 where "g1 \<in> Func B C" and "g a = g1"
  2.1559 -      using assms using Func_elim[OF assms True] by blast
  2.1560 -      thus ?thesis using True unfolding Func_def curr_def by auto
  2.1561 -    qed
  2.1562 -  qed
  2.1563 -  show "?f \<in> Func (A <*> B) C" using assms unfolding Func_def mem_Collect_eq by auto
  2.1564 -qed
  2.1565 -
  2.1566 -lemma bij_betw_curr:
  2.1567 -"bij_betw (curr A) (Func (A <*> B) C) (Func A (Func B C))"
  2.1568 -unfolding bij_betw_def inj_on_def image_def
  2.1569 -apply (intro impI conjI ballI)
  2.1570 -apply (erule curr_inj[THEN iffD1], assumption+)
  2.1571 -apply auto
  2.1572 -apply (erule curr_in)
  2.1573 -using curr_surj by blast
  2.1574 -
  2.1575 -definition Func_map where
  2.1576 -"Func_map B2 f1 f2 g b2 \<equiv> if b2 \<in> B2 then f1 (g (f2 b2)) else undefined"
  2.1577 -
  2.1578 -lemma Func_map:
  2.1579 -assumes g: "g \<in> Func A2 A1" and f1: "f1 ` A1 \<subseteq> B1" and f2: "f2 ` B2 \<subseteq> A2"
  2.1580 -shows "Func_map B2 f1 f2 g \<in> Func B2 B1"
  2.1581 -using assms unfolding Func_def Func_map_def mem_Collect_eq by auto
  2.1582 -
  2.1583 -lemma Func_non_emp:
  2.1584 -assumes "B \<noteq> {}"
  2.1585 -shows "Func A B \<noteq> {}"
  2.1586 -proof-
  2.1587 -  obtain b where b: "b \<in> B" using assms by auto
  2.1588 -  hence "(\<lambda> a. if a \<in> A then b else undefined) \<in> Func A B" unfolding Func_def by auto
  2.1589 -  thus ?thesis by blast
  2.1590 -qed
  2.1591 -
  2.1592 -lemma Func_is_emp:
  2.1593 -"Func A B = {} \<longleftrightarrow> A \<noteq> {} \<and> B = {}" (is "?L \<longleftrightarrow> ?R")
  2.1594 -proof
  2.1595 -  assume L: ?L
  2.1596 -  moreover {assume "A = {}" hence False using L Func_empty by auto}
  2.1597 -  moreover {assume "B \<noteq> {}" hence False using L Func_non_emp[of B A] by simp }
  2.1598 -  ultimately show ?R by blast
  2.1599 -next
  2.1600 -  assume R: ?R
  2.1601 -  moreover
  2.1602 -  {fix f assume "f \<in> Func A B"
  2.1603 -   moreover obtain a where "a \<in> A" using R by blast
  2.1604 -   ultimately obtain b where "b \<in> B" unfolding Func_def by blast
  2.1605 -   with R have False by blast
  2.1606 -  }
  2.1607 -  thus ?L by blast
  2.1608 -qed
  2.1609 -
  2.1610 -lemma Func_map_surj:
  2.1611 -assumes B1: "f1 ` A1 = B1" and A2: "inj_on f2 B2" "f2 ` B2 \<subseteq> A2"
  2.1612 -and B2A2: "B2 = {} \<Longrightarrow> A2 = {}"
  2.1613 -shows "Func B2 B1 = Func_map B2 f1 f2 ` Func A2 A1"
  2.1614 -proof(cases "B2 = {}")
  2.1615 -  case True
  2.1616 -  thus ?thesis using B2A2 by (auto simp: Func_empty Func_map_def)
  2.1617 -next
  2.1618 -  case False note B2 = False
  2.1619 -  show ?thesis
  2.1620 -  proof safe
  2.1621 -    fix h assume h: "h \<in> Func B2 B1"
  2.1622 -    def j1 \<equiv> "inv_into A1 f1"
  2.1623 -    have "\<forall> a2 \<in> f2 ` B2. \<exists> b2. b2 \<in> B2 \<and> f2 b2 = a2" by blast
  2.1624 -    then obtain k where k: "\<forall> a2 \<in> f2 ` B2. k a2 \<in> B2 \<and> f2 (k a2) = a2"
  2.1625 -      by atomize_elim (rule bchoice)
  2.1626 -    {fix b2 assume b2: "b2 \<in> B2"
  2.1627 -     hence "f2 (k (f2 b2)) = f2 b2" using k A2(2) by auto
  2.1628 -     moreover have "k (f2 b2) \<in> B2" using b2 A2(2) k by auto
  2.1629 -     ultimately have "k (f2 b2) = b2" using b2 A2(1) unfolding inj_on_def by blast
  2.1630 -    } note kk = this
  2.1631 -    obtain b22 where b22: "b22 \<in> B2" using B2 by auto
  2.1632 -    def j2 \<equiv> "\<lambda> a2. if a2 \<in> f2 ` B2 then k a2 else b22"
  2.1633 -    have j2A2: "j2 ` A2 \<subseteq> B2" unfolding j2_def using k b22 by auto
  2.1634 -    have j2: "\<And> b2. b2 \<in> B2 \<Longrightarrow> j2 (f2 b2) = b2"
  2.1635 -    using kk unfolding j2_def by auto
  2.1636 -    def g \<equiv> "Func_map A2 j1 j2 h"
  2.1637 -    have "Func_map B2 f1 f2 g = h"
  2.1638 -    proof (rule ext)
  2.1639 -      fix b2 show "Func_map B2 f1 f2 g b2 = h b2"
  2.1640 -      proof(cases "b2 \<in> B2")
  2.1641 -        case True
  2.1642 -        show ?thesis
  2.1643 -        proof (cases "h b2 = undefined")
  2.1644 -          case True
  2.1645 -          hence b1: "h b2 \<in> f1 ` A1" using h `b2 \<in> B2` unfolding B1 Func_def by auto
  2.1646 -          show ?thesis using A2 f_inv_into_f[OF b1]
  2.1647 -            unfolding True g_def Func_map_def j1_def j2[OF `b2 \<in> B2`] by auto
  2.1648 -        qed(insert A2 True j2[OF True] h B1, unfold j1_def g_def Func_def Func_map_def,
  2.1649 -          auto intro: f_inv_into_f)
  2.1650 -      qed(insert h, unfold Func_def Func_map_def, auto)
  2.1651 -    qed
  2.1652 -    moreover have "g \<in> Func A2 A1" unfolding g_def apply(rule Func_map[OF h])
  2.1653 -    using j2A2 B1 A2 unfolding j1_def by (fast intro: inv_into_into)+
  2.1654 -    ultimately show "h \<in> Func_map B2 f1 f2 ` Func A2 A1"
  2.1655 -    unfolding Func_map_def[abs_def] by auto
  2.1656 -  qed(insert B1 Func_map[OF _ _ A2(2)], auto)
  2.1657 -qed
  2.1658 -
  2.1659 -end
     3.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     3.2 +++ b/src/HOL/BNF_Wellorder_Constructions.thy	Mon Sep 01 16:34:39 2014 +0200
     3.3 @@ -0,0 +1,1656 @@
     3.4 +(*  Title:      HOL/BNF_Wellorder_Constructions.thy
     3.5 +    Author:     Andrei Popescu, TU Muenchen
     3.6 +    Copyright   2012
     3.7 +
     3.8 +Constructions on wellorders as needed by bounded natural functors.
     3.9 +*)
    3.10 +
    3.11 +header {* Constructions on Wellorders as Needed by Bounded Natural Functors *}
    3.12 +
    3.13 +theory BNF_Wellorder_Constructions
    3.14 +imports BNF_Wellorder_Embedding
    3.15 +begin
    3.16 +
    3.17 +text {* In this section, we study basic constructions on well-orders, such as restriction to
    3.18 +a set/order filter, copy via direct images, ordinal-like sum of disjoint well-orders,
    3.19 +and bounded square.  We also define between well-orders
    3.20 +the relations @{text "ordLeq"}, of being embedded (abbreviated @{text "\<le>o"}),
    3.21 +@{text "ordLess"}, of being strictly embedded (abbreviated @{text "<o"}), and
    3.22 +@{text "ordIso"}, of being isomorphic (abbreviated @{text "=o"}).  We study the
    3.23 +connections between these relations, order filters, and the aforementioned constructions.
    3.24 +A main result of this section is that @{text "<o"} is well-founded. *}
    3.25 +
    3.26 +
    3.27 +subsection {* Restriction to a set *}
    3.28 +
    3.29 +abbreviation Restr :: "'a rel \<Rightarrow> 'a set \<Rightarrow> 'a rel"
    3.30 +where "Restr r A \<equiv> r Int (A \<times> A)"
    3.31 +
    3.32 +lemma Restr_subset:
    3.33 +"A \<le> B \<Longrightarrow> Restr (Restr r B) A = Restr r A"
    3.34 +by blast
    3.35 +
    3.36 +lemma Restr_Field: "Restr r (Field r) = r"
    3.37 +unfolding Field_def by auto
    3.38 +
    3.39 +lemma Refl_Restr: "Refl r \<Longrightarrow> Refl(Restr r A)"
    3.40 +unfolding refl_on_def Field_def by auto
    3.41 +
    3.42 +lemma antisym_Restr:
    3.43 +"antisym r \<Longrightarrow> antisym(Restr r A)"
    3.44 +unfolding antisym_def Field_def by auto
    3.45 +
    3.46 +lemma Total_Restr:
    3.47 +"Total r \<Longrightarrow> Total(Restr r A)"
    3.48 +unfolding total_on_def Field_def by auto
    3.49 +
    3.50 +lemma trans_Restr:
    3.51 +"trans r \<Longrightarrow> trans(Restr r A)"
    3.52 +unfolding trans_def Field_def by blast
    3.53 +
    3.54 +lemma Preorder_Restr:
    3.55 +"Preorder r \<Longrightarrow> Preorder(Restr r A)"
    3.56 +unfolding preorder_on_def by (simp add: Refl_Restr trans_Restr)
    3.57 +
    3.58 +lemma Partial_order_Restr:
    3.59 +"Partial_order r \<Longrightarrow> Partial_order(Restr r A)"
    3.60 +unfolding partial_order_on_def by (simp add: Preorder_Restr antisym_Restr)
    3.61 +
    3.62 +lemma Linear_order_Restr:
    3.63 +"Linear_order r \<Longrightarrow> Linear_order(Restr r A)"
    3.64 +unfolding linear_order_on_def by (simp add: Partial_order_Restr Total_Restr)
    3.65 +
    3.66 +lemma Well_order_Restr:
    3.67 +assumes "Well_order r"
    3.68 +shows "Well_order(Restr r A)"
    3.69 +proof-
    3.70 +  have "Restr r A - Id \<le> r - Id" using Restr_subset by blast
    3.71 +  hence "wf(Restr r A - Id)" using assms
    3.72 +  using well_order_on_def wf_subset by blast
    3.73 +  thus ?thesis using assms unfolding well_order_on_def
    3.74 +  by (simp add: Linear_order_Restr)
    3.75 +qed
    3.76 +
    3.77 +lemma Field_Restr_subset: "Field(Restr r A) \<le> A"
    3.78 +by (auto simp add: Field_def)
    3.79 +
    3.80 +lemma Refl_Field_Restr:
    3.81 +"Refl r \<Longrightarrow> Field(Restr r A) = (Field r) Int A"
    3.82 +unfolding refl_on_def Field_def by blast
    3.83 +
    3.84 +lemma Refl_Field_Restr2:
    3.85 +"\<lbrakk>Refl r; A \<le> Field r\<rbrakk> \<Longrightarrow> Field(Restr r A) = A"
    3.86 +by (auto simp add: Refl_Field_Restr)
    3.87 +
    3.88 +lemma well_order_on_Restr:
    3.89 +assumes WELL: "Well_order r" and SUB: "A \<le> Field r"
    3.90 +shows "well_order_on A (Restr r A)"
    3.91 +using assms
    3.92 +using Well_order_Restr[of r A] Refl_Field_Restr2[of r A]
    3.93 +     order_on_defs[of "Field r" r] by auto
    3.94 +
    3.95 +
    3.96 +subsection {* Order filters versus restrictions and embeddings *}
    3.97 +
    3.98 +lemma Field_Restr_ofilter:
    3.99 +"\<lbrakk>Well_order r; wo_rel.ofilter r A\<rbrakk> \<Longrightarrow> Field(Restr r A) = A"
   3.100 +by (auto simp add: wo_rel_def wo_rel.ofilter_def wo_rel.REFL Refl_Field_Restr2)
   3.101 +
   3.102 +lemma ofilter_Restr_under:
   3.103 +assumes WELL: "Well_order r" and OF: "wo_rel.ofilter r A" and IN: "a \<in> A"
   3.104 +shows "under (Restr r A) a = under r a"
   3.105 +using assms wo_rel_def
   3.106 +proof(auto simp add: wo_rel.ofilter_def under_def)
   3.107 +  fix b assume *: "a \<in> A" and "(b,a) \<in> r"
   3.108 +  hence "b \<in> under r a \<and> a \<in> Field r"
   3.109 +  unfolding under_def using Field_def by fastforce
   3.110 +  thus "b \<in> A" using * assms by (auto simp add: wo_rel_def wo_rel.ofilter_def)
   3.111 +qed
   3.112 +
   3.113 +lemma ofilter_embed:
   3.114 +assumes "Well_order r"
   3.115 +shows "wo_rel.ofilter r A = (A \<le> Field r \<and> embed (Restr r A) r id)"
   3.116 +proof
   3.117 +  assume *: "wo_rel.ofilter r A"
   3.118 +  show "A \<le> Field r \<and> embed (Restr r A) r id"
   3.119 +  proof(unfold embed_def, auto)
   3.120 +    fix a assume "a \<in> A" thus "a \<in> Field r" using assms *
   3.121 +    by (auto simp add: wo_rel_def wo_rel.ofilter_def)
   3.122 +  next
   3.123 +    fix a assume "a \<in> Field (Restr r A)"
   3.124 +    thus "bij_betw id (under (Restr r A) a) (under r a)" using assms *
   3.125 +    by (simp add: ofilter_Restr_under Field_Restr_ofilter)
   3.126 +  qed
   3.127 +next
   3.128 +  assume *: "A \<le> Field r \<and> embed (Restr r A) r id"
   3.129 +  hence "Field(Restr r A) \<le> Field r"
   3.130 +  using assms  embed_Field[of "Restr r A" r id] id_def
   3.131 +        Well_order_Restr[of r] by auto
   3.132 +  {fix a assume "a \<in> A"
   3.133 +   hence "a \<in> Field(Restr r A)" using * assms
   3.134 +   by (simp add: order_on_defs Refl_Field_Restr2)
   3.135 +   hence "bij_betw id (under (Restr r A) a) (under r a)"
   3.136 +   using * unfolding embed_def by auto
   3.137 +   hence "under r a \<le> under (Restr r A) a"
   3.138 +   unfolding bij_betw_def by auto
   3.139 +   also have "\<dots> \<le> Field(Restr r A)" by (simp add: under_Field)
   3.140 +   also have "\<dots> \<le> A" by (simp add: Field_Restr_subset)
   3.141 +   finally have "under r a \<le> A" .
   3.142 +  }
   3.143 +  thus "wo_rel.ofilter r A" using assms * by (simp add: wo_rel_def wo_rel.ofilter_def)
   3.144 +qed
   3.145 +
   3.146 +lemma ofilter_Restr_Int:
   3.147 +assumes WELL: "Well_order r" and OFA: "wo_rel.ofilter r A"
   3.148 +shows "wo_rel.ofilter (Restr r B) (A Int B)"
   3.149 +proof-
   3.150 +  let ?rB = "Restr r B"
   3.151 +  have Well: "wo_rel r" unfolding wo_rel_def using WELL .
   3.152 +  hence Refl: "Refl r" by (simp add: wo_rel.REFL)
   3.153 +  hence Field: "Field ?rB = Field r Int B"
   3.154 +  using Refl_Field_Restr by blast
   3.155 +  have WellB: "wo_rel ?rB \<and> Well_order ?rB" using WELL
   3.156 +  by (simp add: Well_order_Restr wo_rel_def)
   3.157 +  (* Main proof *)
   3.158 +  show ?thesis using WellB assms
   3.159 +  proof(auto simp add: wo_rel.ofilter_def under_def)
   3.160 +    fix a assume "a \<in> A" and *: "a \<in> B"
   3.161 +    hence "a \<in> Field r" using OFA Well by (auto simp add: wo_rel.ofilter_def)
   3.162 +    with * show "a \<in> Field ?rB" using Field by auto
   3.163 +  next
   3.164 +    fix a b assume "a \<in> A" and "(b,a) \<in> r"
   3.165 +    thus "b \<in> A" using Well OFA by (auto simp add: wo_rel.ofilter_def under_def)
   3.166 +  qed
   3.167 +qed
   3.168 +
   3.169 +lemma ofilter_Restr_subset:
   3.170 +assumes WELL: "Well_order r" and OFA: "wo_rel.ofilter r A" and SUB: "A \<le> B"
   3.171 +shows "wo_rel.ofilter (Restr r B) A"
   3.172 +proof-
   3.173 +  have "A Int B = A" using SUB by blast
   3.174 +  thus ?thesis using assms ofilter_Restr_Int[of r A B] by auto
   3.175 +qed
   3.176 +
   3.177 +lemma ofilter_subset_embed:
   3.178 +assumes WELL: "Well_order r" and
   3.179 +        OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
   3.180 +shows "(A \<le> B) = (embed (Restr r A) (Restr r B) id)"
   3.181 +proof-
   3.182 +  let ?rA = "Restr r A"  let ?rB = "Restr r B"
   3.183 +  have Well: "wo_rel r" unfolding wo_rel_def using WELL .
   3.184 +  hence Refl: "Refl r" by (simp add: wo_rel.REFL)
   3.185 +  hence FieldA: "Field ?rA = Field r Int A"
   3.186 +  using Refl_Field_Restr by blast
   3.187 +  have FieldB: "Field ?rB = Field r Int B"
   3.188 +  using Refl Refl_Field_Restr by blast
   3.189 +  have WellA: "wo_rel ?rA \<and> Well_order ?rA" using WELL
   3.190 +  by (simp add: Well_order_Restr wo_rel_def)
   3.191 +  have WellB: "wo_rel ?rB \<and> Well_order ?rB" using WELL
   3.192 +  by (simp add: Well_order_Restr wo_rel_def)
   3.193 +  (* Main proof *)
   3.194 +  show ?thesis
   3.195 +  proof
   3.196 +    assume *: "A \<le> B"
   3.197 +    hence "wo_rel.ofilter (Restr r B) A" using assms
   3.198 +    by (simp add: ofilter_Restr_subset)
   3.199 +    hence "embed (Restr ?rB A) (Restr r B) id"
   3.200 +    using WellB ofilter_embed[of "?rB" A] by auto
   3.201 +    thus "embed (Restr r A) (Restr r B) id"
   3.202 +    using * by (simp add: Restr_subset)
   3.203 +  next
   3.204 +    assume *: "embed (Restr r A) (Restr r B) id"
   3.205 +    {fix a assume **: "a \<in> A"
   3.206 +     hence "a \<in> Field r" using Well OFA by (auto simp add: wo_rel.ofilter_def)
   3.207 +     with ** FieldA have "a \<in> Field ?rA" by auto
   3.208 +     hence "a \<in> Field ?rB" using * WellA embed_Field[of ?rA ?rB id] by auto
   3.209 +     hence "a \<in> B" using FieldB by auto
   3.210 +    }
   3.211 +    thus "A \<le> B" by blast
   3.212 +  qed
   3.213 +qed
   3.214 +
   3.215 +lemma ofilter_subset_embedS_iso:
   3.216 +assumes WELL: "Well_order r" and
   3.217 +        OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
   3.218 +shows "((A < B) = (embedS (Restr r A) (Restr r B) id)) \<and>
   3.219 +       ((A = B) = (iso (Restr r A) (Restr r B) id))"
   3.220 +proof-
   3.221 +  let ?rA = "Restr r A"  let ?rB = "Restr r B"
   3.222 +  have Well: "wo_rel r" unfolding wo_rel_def using WELL .
   3.223 +  hence Refl: "Refl r" by (simp add: wo_rel.REFL)
   3.224 +  hence "Field ?rA = Field r Int A"
   3.225 +  using Refl_Field_Restr by blast
   3.226 +  hence FieldA: "Field ?rA = A" using OFA Well
   3.227 +  by (auto simp add: wo_rel.ofilter_def)
   3.228 +  have "Field ?rB = Field r Int B"
   3.229 +  using Refl Refl_Field_Restr by blast
   3.230 +  hence FieldB: "Field ?rB = B" using OFB Well
   3.231 +  by (auto simp add: wo_rel.ofilter_def)
   3.232 +  (* Main proof *)
   3.233 +  show ?thesis unfolding embedS_def iso_def
   3.234 +  using assms ofilter_subset_embed[of r A B]
   3.235 +        FieldA FieldB bij_betw_id_iff[of A B] by auto
   3.236 +qed
   3.237 +
   3.238 +lemma ofilter_subset_embedS:
   3.239 +assumes WELL: "Well_order r" and
   3.240 +        OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
   3.241 +shows "(A < B) = embedS (Restr r A) (Restr r B) id"
   3.242 +using assms by (simp add: ofilter_subset_embedS_iso)
   3.243 +
   3.244 +lemma embed_implies_iso_Restr:
   3.245 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and
   3.246 +        EMB: "embed r' r f"
   3.247 +shows "iso r' (Restr r (f ` (Field r'))) f"
   3.248 +proof-
   3.249 +  let ?A' = "Field r'"
   3.250 +  let ?r'' = "Restr r (f ` ?A')"
   3.251 +  have 0: "Well_order ?r''" using WELL Well_order_Restr by blast
   3.252 +  have 1: "wo_rel.ofilter r (f ` ?A')" using assms embed_Field_ofilter  by blast
   3.253 +  hence "Field ?r'' = f ` (Field r')" using WELL Field_Restr_ofilter by blast
   3.254 +  hence "bij_betw f ?A' (Field ?r'')"
   3.255 +  using EMB embed_inj_on WELL' unfolding bij_betw_def by blast
   3.256 +  moreover
   3.257 +  {have "\<forall>a b. (a,b) \<in> r' \<longrightarrow> a \<in> Field r' \<and> b \<in> Field r'"
   3.258 +   unfolding Field_def by auto
   3.259 +   hence "compat r' ?r'' f"
   3.260 +   using assms embed_iff_compat_inj_on_ofilter
   3.261 +   unfolding compat_def by blast
   3.262 +  }
   3.263 +  ultimately show ?thesis using WELL' 0 iso_iff3 by blast
   3.264 +qed
   3.265 +
   3.266 +
   3.267 +subsection {* The strict inclusion on proper ofilters is well-founded *}
   3.268 +
   3.269 +definition ofilterIncl :: "'a rel \<Rightarrow> 'a set rel"
   3.270 +where
   3.271 +"ofilterIncl r \<equiv> {(A,B). wo_rel.ofilter r A \<and> A \<noteq> Field r \<and>
   3.272 +                         wo_rel.ofilter r B \<and> B \<noteq> Field r \<and> A < B}"
   3.273 +
   3.274 +lemma wf_ofilterIncl:
   3.275 +assumes WELL: "Well_order r"
   3.276 +shows "wf(ofilterIncl r)"
   3.277 +proof-
   3.278 +  have Well: "wo_rel r" using WELL by (simp add: wo_rel_def)
   3.279 +  hence Lo: "Linear_order r" by (simp add: wo_rel.LIN)
   3.280 +  let ?h = "(\<lambda> A. wo_rel.suc r A)"
   3.281 +  let ?rS = "r - Id"
   3.282 +  have "wf ?rS" using WELL by (simp add: order_on_defs)
   3.283 +  moreover
   3.284 +  have "compat (ofilterIncl r) ?rS ?h"
   3.285 +  proof(unfold compat_def ofilterIncl_def,
   3.286 +        intro allI impI, simp, elim conjE)
   3.287 +    fix A B
   3.288 +    assume *: "wo_rel.ofilter r A" "A \<noteq> Field r" and
   3.289 +           **: "wo_rel.ofilter r B" "B \<noteq> Field r" and ***: "A < B"
   3.290 +    then obtain a and b where 0: "a \<in> Field r \<and> b \<in> Field r" and
   3.291 +                         1: "A = underS r a \<and> B = underS r b"
   3.292 +    using Well by (auto simp add: wo_rel.ofilter_underS_Field)
   3.293 +    hence "a \<noteq> b" using *** by auto
   3.294 +    moreover
   3.295 +    have "(a,b) \<in> r" using 0 1 Lo ***
   3.296 +    by (auto simp add: underS_incl_iff)
   3.297 +    moreover
   3.298 +    have "a = wo_rel.suc r A \<and> b = wo_rel.suc r B"
   3.299 +    using Well 0 1 by (simp add: wo_rel.suc_underS)
   3.300 +    ultimately
   3.301 +    show "(wo_rel.suc r A, wo_rel.suc r B) \<in> r \<and> wo_rel.suc r A \<noteq> wo_rel.suc r B"
   3.302 +    by simp
   3.303 +  qed
   3.304 +  ultimately show "wf (ofilterIncl r)" by (simp add: compat_wf)
   3.305 +qed
   3.306 +
   3.307 +
   3.308 +subsection {* Ordering the well-orders by existence of embeddings *}
   3.309 +
   3.310 +text {* We define three relations between well-orders:
   3.311 +\begin{itemize}
   3.312 +\item @{text "ordLeq"}, of being embedded (abbreviated @{text "\<le>o"});
   3.313 +\item @{text "ordLess"}, of being strictly embedded (abbreviated @{text "<o"});
   3.314 +\item @{text "ordIso"}, of being isomorphic (abbreviated @{text "=o"}).
   3.315 +\end{itemize}
   3.316 +%
   3.317 +The prefix "ord" and the index "o" in these names stand for "ordinal-like".
   3.318 +These relations shall be proved to be inter-connected in a similar fashion as the trio
   3.319 +@{text "\<le>"}, @{text "<"}, @{text "="} associated to a total order on a set.
   3.320 +*}
   3.321 +
   3.322 +definition ordLeq :: "('a rel * 'a' rel) set"
   3.323 +where
   3.324 +"ordLeq = {(r,r'). Well_order r \<and> Well_order r' \<and> (\<exists>f. embed r r' f)}"
   3.325 +
   3.326 +abbreviation ordLeq2 :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> bool" (infix "<=o" 50)
   3.327 +where "r <=o r' \<equiv> (r,r') \<in> ordLeq"
   3.328 +
   3.329 +abbreviation ordLeq3 :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> bool" (infix "\<le>o" 50)
   3.330 +where "r \<le>o r' \<equiv> r <=o r'"
   3.331 +
   3.332 +definition ordLess :: "('a rel * 'a' rel) set"
   3.333 +where
   3.334 +"ordLess = {(r,r'). Well_order r \<and> Well_order r' \<and> (\<exists>f. embedS r r' f)}"
   3.335 +
   3.336 +abbreviation ordLess2 :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> bool" (infix "<o" 50)
   3.337 +where "r <o r' \<equiv> (r,r') \<in> ordLess"
   3.338 +
   3.339 +definition ordIso :: "('a rel * 'a' rel) set"
   3.340 +where
   3.341 +"ordIso = {(r,r'). Well_order r \<and> Well_order r' \<and> (\<exists>f. iso r r' f)}"
   3.342 +
   3.343 +abbreviation ordIso2 :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> bool" (infix "=o" 50)
   3.344 +where "r =o r' \<equiv> (r,r') \<in> ordIso"
   3.345 +
   3.346 +lemmas ordRels_def = ordLeq_def ordLess_def ordIso_def
   3.347 +
   3.348 +lemma ordLeq_Well_order_simp:
   3.349 +assumes "r \<le>o r'"
   3.350 +shows "Well_order r \<and> Well_order r'"
   3.351 +using assms unfolding ordLeq_def by simp
   3.352 +
   3.353 +text{* Notice that the relations @{text "\<le>o"}, @{text "<o"}, @{text "=o"} connect well-orders
   3.354 +on potentially {\em distinct} types. However, some of the lemmas below, including the next one,
   3.355 +restrict implicitly the type of these relations to @{text "(('a rel) * ('a rel)) set"} , i.e.,
   3.356 +to @{text "'a rel rel"}. *}
   3.357 +
   3.358 +lemma ordLeq_reflexive:
   3.359 +"Well_order r \<Longrightarrow> r \<le>o r"
   3.360 +unfolding ordLeq_def using id_embed[of r] by blast
   3.361 +
   3.362 +lemma ordLeq_transitive[trans]:
   3.363 +assumes *: "r \<le>o r'" and **: "r' \<le>o r''"
   3.364 +shows "r \<le>o r''"
   3.365 +proof-
   3.366 +  obtain f and f'
   3.367 +  where 1: "Well_order r \<and> Well_order r' \<and> Well_order r''" and
   3.368 +        "embed r r' f" and "embed r' r'' f'"
   3.369 +  using * ** unfolding ordLeq_def by blast
   3.370 +  hence "embed r r'' (f' o f)"
   3.371 +  using comp_embed[of r r' f r'' f'] by auto
   3.372 +  thus "r \<le>o r''" unfolding ordLeq_def using 1 by auto
   3.373 +qed
   3.374 +
   3.375 +lemma ordLeq_total:
   3.376 +"\<lbrakk>Well_order r; Well_order r'\<rbrakk> \<Longrightarrow> r \<le>o r' \<or> r' \<le>o r"
   3.377 +unfolding ordLeq_def using wellorders_totally_ordered by blast
   3.378 +
   3.379 +lemma ordIso_reflexive:
   3.380 +"Well_order r \<Longrightarrow> r =o r"
   3.381 +unfolding ordIso_def using id_iso[of r] by blast
   3.382 +
   3.383 +lemma ordIso_transitive[trans]:
   3.384 +assumes *: "r =o r'" and **: "r' =o r''"
   3.385 +shows "r =o r''"
   3.386 +proof-
   3.387 +  obtain f and f'
   3.388 +  where 1: "Well_order r \<and> Well_order r' \<and> Well_order r''" and
   3.389 +        "iso r r' f" and 3: "iso r' r'' f'"
   3.390 +  using * ** unfolding ordIso_def by auto
   3.391 +  hence "iso r r'' (f' o f)"
   3.392 +  using comp_iso[of r r' f r'' f'] by auto
   3.393 +  thus "r =o r''" unfolding ordIso_def using 1 by auto
   3.394 +qed
   3.395 +
   3.396 +lemma ordIso_symmetric:
   3.397 +assumes *: "r =o r'"
   3.398 +shows "r' =o r"
   3.399 +proof-
   3.400 +  obtain f where 1: "Well_order r \<and> Well_order r'" and
   3.401 +                 2: "embed r r' f \<and> bij_betw f (Field r) (Field r')"
   3.402 +  using * by (auto simp add: ordIso_def iso_def)
   3.403 +  let ?f' = "inv_into (Field r) f"
   3.404 +  have "embed r' r ?f' \<and> bij_betw ?f' (Field r') (Field r)"
   3.405 +  using 1 2 by (simp add: bij_betw_inv_into inv_into_Field_embed_bij_betw)
   3.406 +  thus "r' =o r" unfolding ordIso_def using 1 by (auto simp add: iso_def)
   3.407 +qed
   3.408 +
   3.409 +lemma ordLeq_ordLess_trans[trans]:
   3.410 +assumes "r \<le>o r'" and " r' <o r''"
   3.411 +shows "r <o r''"
   3.412 +proof-
   3.413 +  have "Well_order r \<and> Well_order r''"
   3.414 +  using assms unfolding ordLeq_def ordLess_def by auto
   3.415 +  thus ?thesis using assms unfolding ordLeq_def ordLess_def
   3.416 +  using embed_comp_embedS by blast
   3.417 +qed
   3.418 +
   3.419 +lemma ordLess_ordLeq_trans[trans]:
   3.420 +assumes "r <o r'" and " r' \<le>o r''"
   3.421 +shows "r <o r''"
   3.422 +proof-
   3.423 +  have "Well_order r \<and> Well_order r''"
   3.424 +  using assms unfolding ordLeq_def ordLess_def by auto
   3.425 +  thus ?thesis using assms unfolding ordLeq_def ordLess_def
   3.426 +  using embedS_comp_embed by blast
   3.427 +qed
   3.428 +
   3.429 +lemma ordLeq_ordIso_trans[trans]:
   3.430 +assumes "r \<le>o r'" and " r' =o r''"
   3.431 +shows "r \<le>o r''"
   3.432 +proof-
   3.433 +  have "Well_order r \<and> Well_order r''"
   3.434 +  using assms unfolding ordLeq_def ordIso_def by auto
   3.435 +  thus ?thesis using assms unfolding ordLeq_def ordIso_def
   3.436 +  using embed_comp_iso by blast
   3.437 +qed
   3.438 +
   3.439 +lemma ordIso_ordLeq_trans[trans]:
   3.440 +assumes "r =o r'" and " r' \<le>o r''"
   3.441 +shows "r \<le>o r''"
   3.442 +proof-
   3.443 +  have "Well_order r \<and> Well_order r''"
   3.444 +  using assms unfolding ordLeq_def ordIso_def by auto
   3.445 +  thus ?thesis using assms unfolding ordLeq_def ordIso_def
   3.446 +  using iso_comp_embed by blast
   3.447 +qed
   3.448 +
   3.449 +lemma ordLess_ordIso_trans[trans]:
   3.450 +assumes "r <o r'" and " r' =o r''"
   3.451 +shows "r <o r''"
   3.452 +proof-
   3.453 +  have "Well_order r \<and> Well_order r''"
   3.454 +  using assms unfolding ordLess_def ordIso_def by auto
   3.455 +  thus ?thesis using assms unfolding ordLess_def ordIso_def
   3.456 +  using embedS_comp_iso by blast
   3.457 +qed
   3.458 +
   3.459 +lemma ordIso_ordLess_trans[trans]:
   3.460 +assumes "r =o r'" and " r' <o r''"
   3.461 +shows "r <o r''"
   3.462 +proof-
   3.463 +  have "Well_order r \<and> Well_order r''"
   3.464 +  using assms unfolding ordLess_def ordIso_def by auto
   3.465 +  thus ?thesis using assms unfolding ordLess_def ordIso_def
   3.466 +  using iso_comp_embedS by blast
   3.467 +qed
   3.468 +
   3.469 +lemma ordLess_not_embed:
   3.470 +assumes "r <o r'"
   3.471 +shows "\<not>(\<exists>f'. embed r' r f')"
   3.472 +proof-
   3.473 +  obtain f where 1: "Well_order r \<and> Well_order r'" and 2: "embed r r' f" and
   3.474 +                 3: " \<not> bij_betw f (Field r) (Field r')"
   3.475 +  using assms unfolding ordLess_def by (auto simp add: embedS_def)
   3.476 +  {fix f' assume *: "embed r' r f'"
   3.477 +   hence "bij_betw f (Field r) (Field r')" using 1 2
   3.478 +   by (simp add: embed_bothWays_Field_bij_betw)
   3.479 +   with 3 have False by contradiction
   3.480 +  }
   3.481 +  thus ?thesis by blast
   3.482 +qed
   3.483 +
   3.484 +lemma ordLess_Field:
   3.485 +assumes OL: "r1 <o r2" and EMB: "embed r1 r2 f"
   3.486 +shows "\<not> (f`(Field r1) = Field r2)"
   3.487 +proof-
   3.488 +  let ?A1 = "Field r1"  let ?A2 = "Field r2"
   3.489 +  obtain g where
   3.490 +  0: "Well_order r1 \<and> Well_order r2" and
   3.491 +  1: "embed r1 r2 g \<and> \<not>(bij_betw g ?A1 ?A2)"
   3.492 +  using OL unfolding ordLess_def by (auto simp add: embedS_def)
   3.493 +  hence "\<forall>a \<in> ?A1. f a = g a"
   3.494 +  using 0 EMB embed_unique[of r1] by auto
   3.495 +  hence "\<not>(bij_betw f ?A1 ?A2)"
   3.496 +  using 1 bij_betw_cong[of ?A1] by blast
   3.497 +  moreover
   3.498 +  have "inj_on f ?A1" using EMB 0 by (simp add: embed_inj_on)
   3.499 +  ultimately show ?thesis by (simp add: bij_betw_def)
   3.500 +qed
   3.501 +
   3.502 +lemma ordLess_iff:
   3.503 +"r <o r' = (Well_order r \<and> Well_order r' \<and> \<not>(\<exists>f'. embed r' r f'))"
   3.504 +proof
   3.505 +  assume *: "r <o r'"
   3.506 +  hence "\<not>(\<exists>f'. embed r' r f')" using ordLess_not_embed[of r r'] by simp
   3.507 +  with * show "Well_order r \<and> Well_order r' \<and> \<not> (\<exists>f'. embed r' r f')"
   3.508 +  unfolding ordLess_def by auto
   3.509 +next
   3.510 +  assume *: "Well_order r \<and> Well_order r' \<and> \<not> (\<exists>f'. embed r' r f')"
   3.511 +  then obtain f where 1: "embed r r' f"
   3.512 +  using wellorders_totally_ordered[of r r'] by blast
   3.513 +  moreover
   3.514 +  {assume "bij_betw f (Field r) (Field r')"
   3.515 +   with * 1 have "embed r' r (inv_into (Field r) f) "
   3.516 +   using inv_into_Field_embed_bij_betw[of r r' f] by auto
   3.517 +   with * have False by blast
   3.518 +  }
   3.519 +  ultimately show "(r,r') \<in> ordLess"
   3.520 +  unfolding ordLess_def using * by (fastforce simp add: embedS_def)
   3.521 +qed
   3.522 +
   3.523 +lemma ordLess_irreflexive: "\<not> r <o r"
   3.524 +proof
   3.525 +  assume "r <o r"
   3.526 +  hence "Well_order r \<and>  \<not>(\<exists>f. embed r r f)"
   3.527 +  unfolding ordLess_iff ..
   3.528 +  moreover have "embed r r id" using id_embed[of r] .
   3.529 +  ultimately show False by blast
   3.530 +qed
   3.531 +
   3.532 +lemma ordLeq_iff_ordLess_or_ordIso:
   3.533 +"r \<le>o r' = (r <o r' \<or> r =o r')"
   3.534 +unfolding ordRels_def embedS_defs iso_defs by blast
   3.535 +
   3.536 +lemma ordIso_iff_ordLeq:
   3.537 +"(r =o r') = (r \<le>o r' \<and> r' \<le>o r)"
   3.538 +proof
   3.539 +  assume "r =o r'"
   3.540 +  then obtain f where 1: "Well_order r \<and> Well_order r' \<and>
   3.541 +                     embed r r' f \<and> bij_betw f (Field r) (Field r')"
   3.542 +  unfolding ordIso_def iso_defs by auto
   3.543 +  hence "embed r r' f \<and> embed r' r (inv_into (Field r) f)"
   3.544 +  by (simp add: inv_into_Field_embed_bij_betw)
   3.545 +  thus  "r \<le>o r' \<and> r' \<le>o r"
   3.546 +  unfolding ordLeq_def using 1 by auto
   3.547 +next
   3.548 +  assume "r \<le>o r' \<and> r' \<le>o r"
   3.549 +  then obtain f and g where 1: "Well_order r \<and> Well_order r' \<and>
   3.550 +                           embed r r' f \<and> embed r' r g"
   3.551 +  unfolding ordLeq_def by auto
   3.552 +  hence "iso r r' f" by (auto simp add: embed_bothWays_iso)
   3.553 +  thus "r =o r'" unfolding ordIso_def using 1 by auto
   3.554 +qed
   3.555 +
   3.556 +lemma not_ordLess_ordLeq:
   3.557 +"r <o r' \<Longrightarrow> \<not> r' \<le>o r"
   3.558 +using ordLess_ordLeq_trans ordLess_irreflexive by blast
   3.559 +
   3.560 +lemma ordLess_or_ordLeq:
   3.561 +assumes WELL: "Well_order r" and WELL': "Well_order r'"
   3.562 +shows "r <o r' \<or> r' \<le>o r"
   3.563 +proof-
   3.564 +  have "r \<le>o r' \<or> r' \<le>o r"
   3.565 +  using assms by (simp add: ordLeq_total)
   3.566 +  moreover
   3.567 +  {assume "\<not> r <o r' \<and> r \<le>o r'"
   3.568 +   hence "r =o r'" using ordLeq_iff_ordLess_or_ordIso by blast
   3.569 +   hence "r' \<le>o r" using ordIso_symmetric ordIso_iff_ordLeq by blast
   3.570 +  }
   3.571 +  ultimately show ?thesis by blast
   3.572 +qed
   3.573 +
   3.574 +lemma not_ordLess_ordIso:
   3.575 +"r <o r' \<Longrightarrow> \<not> r =o r'"
   3.576 +using assms ordLess_ordIso_trans ordIso_symmetric ordLess_irreflexive by blast
   3.577 +
   3.578 +lemma not_ordLeq_iff_ordLess:
   3.579 +assumes WELL: "Well_order r" and WELL': "Well_order r'"
   3.580 +shows "(\<not> r' \<le>o r) = (r <o r')"
   3.581 +using assms not_ordLess_ordLeq ordLess_or_ordLeq by blast
   3.582 +
   3.583 +lemma not_ordLess_iff_ordLeq:
   3.584 +assumes WELL: "Well_order r" and WELL': "Well_order r'"
   3.585 +shows "(\<not> r' <o r) = (r \<le>o r')"
   3.586 +using assms not_ordLess_ordLeq ordLess_or_ordLeq by blast
   3.587 +
   3.588 +lemma ordLess_transitive[trans]:
   3.589 +"\<lbrakk>r <o r'; r' <o r''\<rbrakk> \<Longrightarrow> r <o r''"
   3.590 +using assms ordLess_ordLeq_trans ordLeq_iff_ordLess_or_ordIso by blast
   3.591 +
   3.592 +corollary ordLess_trans: "trans ordLess"
   3.593 +unfolding trans_def using ordLess_transitive by blast
   3.594 +
   3.595 +lemmas ordIso_equivalence = ordIso_transitive ordIso_reflexive ordIso_symmetric
   3.596 +
   3.597 +lemma ordIso_imp_ordLeq:
   3.598 +"r =o r' \<Longrightarrow> r \<le>o r'"
   3.599 +using ordIso_iff_ordLeq by blast
   3.600 +
   3.601 +lemma ordLess_imp_ordLeq:
   3.602 +"r <o r' \<Longrightarrow> r \<le>o r'"
   3.603 +using ordLeq_iff_ordLess_or_ordIso by blast
   3.604 +
   3.605 +lemma ofilter_subset_ordLeq:
   3.606 +assumes WELL: "Well_order r" and
   3.607 +        OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
   3.608 +shows "(A \<le> B) = (Restr r A \<le>o Restr r B)"
   3.609 +proof
   3.610 +  assume "A \<le> B"
   3.611 +  thus "Restr r A \<le>o Restr r B"
   3.612 +  unfolding ordLeq_def using assms
   3.613 +  Well_order_Restr Well_order_Restr ofilter_subset_embed by blast
   3.614 +next
   3.615 +  assume *: "Restr r A \<le>o Restr r B"
   3.616 +  then obtain f where "embed (Restr r A) (Restr r B) f"
   3.617 +  unfolding ordLeq_def by blast
   3.618 +  {assume "B < A"
   3.619 +   hence "Restr r B <o Restr r A"
   3.620 +   unfolding ordLess_def using assms
   3.621 +   Well_order_Restr Well_order_Restr ofilter_subset_embedS by blast
   3.622 +   hence False using * not_ordLess_ordLeq by blast
   3.623 +  }
   3.624 +  thus "A \<le> B" using OFA OFB WELL
   3.625 +  wo_rel_def[of r] wo_rel.ofilter_linord[of r A B] by blast
   3.626 +qed
   3.627 +
   3.628 +lemma ofilter_subset_ordLess:
   3.629 +assumes WELL: "Well_order r" and
   3.630 +        OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
   3.631 +shows "(A < B) = (Restr r A <o Restr r B)"
   3.632 +proof-
   3.633 +  let ?rA = "Restr r A" let ?rB = "Restr r B"
   3.634 +  have 1: "Well_order ?rA \<and> Well_order ?rB"
   3.635 +  using WELL Well_order_Restr by blast
   3.636 +  have "(A < B) = (\<not> B \<le> A)" using assms
   3.637 +  wo_rel_def wo_rel.ofilter_linord[of r A B] by blast
   3.638 +  also have "\<dots> = (\<not> Restr r B \<le>o Restr r A)"
   3.639 +  using assms ofilter_subset_ordLeq by blast
   3.640 +  also have "\<dots> = (Restr r A <o Restr r B)"
   3.641 +  using 1 not_ordLeq_iff_ordLess by blast
   3.642 +  finally show ?thesis .
   3.643 +qed
   3.644 +
   3.645 +lemma ofilter_ordLess:
   3.646 +"\<lbrakk>Well_order r; wo_rel.ofilter r A\<rbrakk> \<Longrightarrow> (A < Field r) = (Restr r A <o r)"
   3.647 +by (simp add: ofilter_subset_ordLess wo_rel.Field_ofilter
   3.648 +    wo_rel_def Restr_Field)
   3.649 +
   3.650 +corollary underS_Restr_ordLess:
   3.651 +assumes "Well_order r" and "Field r \<noteq> {}"
   3.652 +shows "Restr r (underS r a) <o r"
   3.653 +proof-
   3.654 +  have "underS r a < Field r" using assms
   3.655 +  by (simp add: underS_Field3)
   3.656 +  thus ?thesis using assms
   3.657 +  by (simp add: ofilter_ordLess wo_rel.underS_ofilter wo_rel_def)
   3.658 +qed
   3.659 +
   3.660 +lemma embed_ordLess_ofilterIncl:
   3.661 +assumes
   3.662 +  OL12: "r1 <o r2" and OL23: "r2 <o r3" and
   3.663 +  EMB13: "embed r1 r3 f13" and EMB23: "embed r2 r3 f23"
   3.664 +shows "(f13`(Field r1), f23`(Field r2)) \<in> (ofilterIncl r3)"
   3.665 +proof-
   3.666 +  have OL13: "r1 <o r3"
   3.667 +  using OL12 OL23 using ordLess_transitive by auto
   3.668 +  let ?A1 = "Field r1"  let ?A2 ="Field r2" let ?A3 ="Field r3"
   3.669 +  obtain f12 g23 where
   3.670 +  0: "Well_order r1 \<and> Well_order r2 \<and> Well_order r3" and
   3.671 +  1: "embed r1 r2 f12 \<and> \<not>(bij_betw f12 ?A1 ?A2)" and
   3.672 +  2: "embed r2 r3 g23 \<and> \<not>(bij_betw g23 ?A2 ?A3)"
   3.673 +  using OL12 OL23 by (auto simp add: ordLess_def embedS_def)
   3.674 +  hence "\<forall>a \<in> ?A2. f23 a = g23 a"
   3.675 +  using EMB23 embed_unique[of r2 r3] by blast
   3.676 +  hence 3: "\<not>(bij_betw f23 ?A2 ?A3)"
   3.677 +  using 2 bij_betw_cong[of ?A2 f23 g23] by blast
   3.678 +  (*  *)
   3.679 +  have 4: "wo_rel.ofilter r2 (f12 ` ?A1) \<and> f12 ` ?A1 \<noteq> ?A2"
   3.680 +  using 0 1 OL12 by (simp add: embed_Field_ofilter ordLess_Field)
   3.681 +  have 5: "wo_rel.ofilter r3 (f23 ` ?A2) \<and> f23 ` ?A2 \<noteq> ?A3"
   3.682 +  using 0 EMB23 OL23 by (simp add: embed_Field_ofilter ordLess_Field)
   3.683 +  have 6: "wo_rel.ofilter r3 (f13 ` ?A1)  \<and> f13 ` ?A1 \<noteq> ?A3"
   3.684 +  using 0 EMB13 OL13 by (simp add: embed_Field_ofilter ordLess_Field)
   3.685 +  (*  *)
   3.686 +  have "f12 ` ?A1 < ?A2"
   3.687 +  using 0 4 by (auto simp add: wo_rel_def wo_rel.ofilter_def)
   3.688 +  moreover have "inj_on f23 ?A2"
   3.689 +  using EMB23 0 by (simp add: wo_rel_def embed_inj_on)
   3.690 +  ultimately
   3.691 +  have "f23 ` (f12 ` ?A1) < f23 ` ?A2" by (simp add: inj_on_strict_subset)
   3.692 +  moreover
   3.693 +  {have "embed r1 r3 (f23 o f12)"
   3.694 +   using 1 EMB23 0 by (auto simp add: comp_embed)
   3.695 +   hence "\<forall>a \<in> ?A1. f23(f12 a) = f13 a"
   3.696 +   using EMB13 0 embed_unique[of r1 r3 "f23 o f12" f13] by auto
   3.697 +   hence "f23 ` (f12 ` ?A1) = f13 ` ?A1" by force
   3.698 +  }
   3.699 +  ultimately
   3.700 +  have "f13 ` ?A1 < f23 ` ?A2" by simp
   3.701 +  (*  *)
   3.702 +  with 5 6 show ?thesis
   3.703 +  unfolding ofilterIncl_def by auto
   3.704 +qed
   3.705 +
   3.706 +lemma ordLess_iff_ordIso_Restr:
   3.707 +assumes WELL: "Well_order r" and WELL': "Well_order r'"
   3.708 +shows "(r' <o r) = (\<exists>a \<in> Field r. r' =o Restr r (underS r a))"
   3.709 +proof(auto)
   3.710 +  fix a assume *: "a \<in> Field r" and **: "r' =o Restr r (underS r a)"
   3.711 +  hence "Restr r (underS r a) <o r" using WELL underS_Restr_ordLess[of r] by blast
   3.712 +  thus "r' <o r" using ** ordIso_ordLess_trans by blast
   3.713 +next
   3.714 +  assume "r' <o r"
   3.715 +  then obtain f where 1: "Well_order r \<and> Well_order r'" and
   3.716 +                      2: "embed r' r f \<and> f ` (Field r') \<noteq> Field r"
   3.717 +  unfolding ordLess_def embedS_def[abs_def] bij_betw_def using embed_inj_on by blast
   3.718 +  hence "wo_rel.ofilter r (f ` (Field r'))" using embed_Field_ofilter by blast
   3.719 +  then obtain a where 3: "a \<in> Field r" and 4: "underS r a = f ` (Field r')"
   3.720 +  using 1 2 by (auto simp add: wo_rel.ofilter_underS_Field wo_rel_def)
   3.721 +  have "iso r' (Restr r (f ` (Field r'))) f"
   3.722 +  using embed_implies_iso_Restr 2 assms by blast
   3.723 +  moreover have "Well_order (Restr r (f ` (Field r')))"
   3.724 +  using WELL Well_order_Restr by blast
   3.725 +  ultimately have "r' =o Restr r (f ` (Field r'))"
   3.726 +  using WELL' unfolding ordIso_def by auto
   3.727 +  hence "r' =o Restr r (underS r a)" using 4 by auto
   3.728 +  thus "\<exists>a \<in> Field r. r' =o Restr r (underS r a)" using 3 by auto
   3.729 +qed
   3.730 +
   3.731 +lemma internalize_ordLess:
   3.732 +"(r' <o r) = (\<exists>p. Field p < Field r \<and> r' =o p \<and> p <o r)"
   3.733 +proof
   3.734 +  assume *: "r' <o r"
   3.735 +  hence 0: "Well_order r \<and> Well_order r'" unfolding ordLess_def by auto
   3.736 +  with * obtain a where 1: "a \<in> Field r" and 2: "r' =o Restr r (underS r a)"
   3.737 +  using ordLess_iff_ordIso_Restr by blast
   3.738 +  let ?p = "Restr r (underS r a)"
   3.739 +  have "wo_rel.ofilter r (underS r a)" using 0
   3.740 +  by (simp add: wo_rel_def wo_rel.underS_ofilter)
   3.741 +  hence "Field ?p = underS r a" using 0 Field_Restr_ofilter by blast
   3.742 +  hence "Field ?p < Field r" using underS_Field2 1 by fast
   3.743 +  moreover have "?p <o r" using underS_Restr_ordLess[of r a] 0 1 by blast
   3.744 +  ultimately
   3.745 +  show "\<exists>p. Field p < Field r \<and> r' =o p \<and> p <o r" using 2 by blast
   3.746 +next
   3.747 +  assume "\<exists>p. Field p < Field r \<and> r' =o p \<and> p <o r"
   3.748 +  thus "r' <o r" using ordIso_ordLess_trans by blast
   3.749 +qed
   3.750 +
   3.751 +lemma internalize_ordLeq:
   3.752 +"(r' \<le>o r) = (\<exists>p. Field p \<le> Field r \<and> r' =o p \<and> p \<le>o r)"
   3.753 +proof
   3.754 +  assume *: "r' \<le>o r"
   3.755 +  moreover
   3.756 +  {assume "r' <o r"
   3.757 +   then obtain p where "Field p < Field r \<and> r' =o p \<and> p <o r"
   3.758 +   using internalize_ordLess[of r' r] by blast
   3.759 +   hence "\<exists>p. Field p \<le> Field r \<and> r' =o p \<and> p \<le>o r"
   3.760 +   using ordLeq_iff_ordLess_or_ordIso by blast
   3.761 +  }
   3.762 +  moreover
   3.763 +  have "r \<le>o r" using * ordLeq_def ordLeq_reflexive by blast
   3.764 +  ultimately show "\<exists>p. Field p \<le> Field r \<and> r' =o p \<and> p \<le>o r"
   3.765 +  using ordLeq_iff_ordLess_or_ordIso by blast
   3.766 +next
   3.767 +  assume "\<exists>p. Field p \<le> Field r \<and> r' =o p \<and> p \<le>o r"
   3.768 +  thus "r' \<le>o r" using ordIso_ordLeq_trans by blast
   3.769 +qed
   3.770 +
   3.771 +lemma ordLeq_iff_ordLess_Restr:
   3.772 +assumes WELL: "Well_order r" and WELL': "Well_order r'"
   3.773 +shows "(r \<le>o r') = (\<forall>a \<in> Field r. Restr r (underS r a) <o r')"
   3.774 +proof(auto)
   3.775 +  assume *: "r \<le>o r'"
   3.776 +  fix a assume "a \<in> Field r"
   3.777 +  hence "Restr r (underS r a) <o r"
   3.778 +  using WELL underS_Restr_ordLess[of r] by blast
   3.779 +  thus "Restr r (underS r a) <o r'"
   3.780 +  using * ordLess_ordLeq_trans by blast
   3.781 +next
   3.782 +  assume *: "\<forall>a \<in> Field r. Restr r (underS r a) <o r'"
   3.783 +  {assume "r' <o r"
   3.784 +   then obtain a where "a \<in> Field r \<and> r' =o Restr r (underS r a)"
   3.785 +   using assms ordLess_iff_ordIso_Restr by blast
   3.786 +   hence False using * not_ordLess_ordIso ordIso_symmetric by blast
   3.787 +  }
   3.788 +  thus "r \<le>o r'" using ordLess_or_ordLeq assms by blast
   3.789 +qed
   3.790 +
   3.791 +lemma finite_ordLess_infinite:
   3.792 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and
   3.793 +        FIN: "finite(Field r)" and INF: "\<not>finite(Field r')"
   3.794 +shows "r <o r'"
   3.795 +proof-
   3.796 +  {assume "r' \<le>o r"
   3.797 +   then obtain h where "inj_on h (Field r') \<and> h ` (Field r') \<le> Field r"
   3.798 +   unfolding ordLeq_def using assms embed_inj_on embed_Field by blast
   3.799 +   hence False using finite_imageD finite_subset FIN INF by blast
   3.800 +  }
   3.801 +  thus ?thesis using WELL WELL' ordLess_or_ordLeq by blast
   3.802 +qed
   3.803 +
   3.804 +lemma finite_well_order_on_ordIso:
   3.805 +assumes FIN: "finite A" and
   3.806 +        WELL: "well_order_on A r" and WELL': "well_order_on A r'"
   3.807 +shows "r =o r'"
   3.808 +proof-
   3.809 +  have 0: "Well_order r \<and> Well_order r' \<and> Field r = A \<and> Field r' = A"
   3.810 +  using assms well_order_on_Well_order by blast
   3.811 +  moreover
   3.812 +  have "\<forall>r r'. well_order_on A r \<and> well_order_on A r' \<and> r \<le>o r'
   3.813 +                  \<longrightarrow> r =o r'"
   3.814 +  proof(clarify)
   3.815 +    fix r r' assume *: "well_order_on A r" and **: "well_order_on A r'"
   3.816 +    have 2: "Well_order r \<and> Well_order r' \<and> Field r = A \<and> Field r' = A"
   3.817 +    using * ** well_order_on_Well_order by blast
   3.818 +    assume "r \<le>o r'"
   3.819 +    then obtain f where 1: "embed r r' f" and
   3.820 +                        "inj_on f A \<and> f ` A \<le> A"
   3.821 +    unfolding ordLeq_def using 2 embed_inj_on embed_Field by blast
   3.822 +    hence "bij_betw f A A" unfolding bij_betw_def using FIN endo_inj_surj by blast
   3.823 +    thus "r =o r'" unfolding ordIso_def iso_def[abs_def] using 1 2 by auto
   3.824 +  qed
   3.825 +  ultimately show ?thesis using assms ordLeq_total ordIso_symmetric by blast
   3.826 +qed
   3.827 +
   3.828 +subsection{* @{text "<o"} is well-founded *}
   3.829 +
   3.830 +text {* Of course, it only makes sense to state that the @{text "<o"} is well-founded
   3.831 +on the restricted type @{text "'a rel rel"}.  We prove this by first showing that, for any set
   3.832 +of well-orders all embedded in a fixed well-order, the function mapping each well-order
   3.833 +in the set to an order filter of the fixed well-order is compatible w.r.t. to @{text "<o"} versus
   3.834 +{\em strict inclusion}; and we already know that strict inclusion of order filters is well-founded. *}
   3.835 +
   3.836 +definition ord_to_filter :: "'a rel \<Rightarrow> 'a rel \<Rightarrow> 'a set"
   3.837 +where "ord_to_filter r0 r \<equiv> (SOME f. embed r r0 f) ` (Field r)"
   3.838 +
   3.839 +lemma ord_to_filter_compat:
   3.840 +"compat (ordLess Int (ordLess^-1``{r0} \<times> ordLess^-1``{r0}))
   3.841 +        (ofilterIncl r0)
   3.842 +        (ord_to_filter r0)"
   3.843 +proof(unfold compat_def ord_to_filter_def, clarify)
   3.844 +  fix r1::"'a rel" and r2::"'a rel"
   3.845 +  let ?A1 = "Field r1"  let ?A2 ="Field r2" let ?A0 ="Field r0"
   3.846 +  let ?phi10 = "\<lambda> f10. embed r1 r0 f10" let ?f10 = "SOME f. ?phi10 f"
   3.847 +  let ?phi20 = "\<lambda> f20. embed r2 r0 f20" let ?f20 = "SOME f. ?phi20 f"
   3.848 +  assume *: "r1 <o r0" "r2 <o r0" and **: "r1 <o r2"
   3.849 +  hence "(\<exists>f. ?phi10 f) \<and> (\<exists>f. ?phi20 f)"
   3.850 +  by (auto simp add: ordLess_def embedS_def)
   3.851 +  hence "?phi10 ?f10 \<and> ?phi20 ?f20" by (auto simp add: someI_ex)
   3.852 +  thus "(?f10 ` ?A1, ?f20 ` ?A2) \<in> ofilterIncl r0"
   3.853 +  using * ** by (simp add: embed_ordLess_ofilterIncl)
   3.854 +qed
   3.855 +
   3.856 +theorem wf_ordLess: "wf ordLess"
   3.857 +proof-
   3.858 +  {fix r0 :: "('a \<times> 'a) set"
   3.859 +   (* need to annotate here!*)
   3.860 +   let ?ordLess = "ordLess::('d rel * 'd rel) set"
   3.861 +   let ?R = "?ordLess Int (?ordLess^-1``{r0} \<times> ?ordLess^-1``{r0})"
   3.862 +   {assume Case1: "Well_order r0"
   3.863 +    hence "wf ?R"
   3.864 +    using wf_ofilterIncl[of r0]
   3.865 +          compat_wf[of ?R "ofilterIncl r0" "ord_to_filter r0"]
   3.866 +          ord_to_filter_compat[of r0] by auto
   3.867 +   }
   3.868 +   moreover
   3.869 +   {assume Case2: "\<not> Well_order r0"
   3.870 +    hence "?R = {}" unfolding ordLess_def by auto
   3.871 +    hence "wf ?R" using wf_empty by simp
   3.872 +   }
   3.873 +   ultimately have "wf ?R" by blast
   3.874 +  }
   3.875 +  thus ?thesis by (simp add: trans_wf_iff ordLess_trans)
   3.876 +qed
   3.877 +
   3.878 +corollary exists_minim_Well_order:
   3.879 +assumes NE: "R \<noteq> {}" and WELL: "\<forall>r \<in> R. Well_order r"
   3.880 +shows "\<exists>r \<in> R. \<forall>r' \<in> R. r \<le>o r'"
   3.881 +proof-
   3.882 +  obtain r where "r \<in> R \<and> (\<forall>r' \<in> R. \<not> r' <o r)"
   3.883 +  using NE spec[OF spec[OF subst[OF wf_eq_minimal, of "%x. x", OF wf_ordLess]], of _ R]
   3.884 +    equals0I[of R] by blast
   3.885 +  with not_ordLeq_iff_ordLess WELL show ?thesis by blast
   3.886 +qed
   3.887 +
   3.888 +
   3.889 +subsection {* Copy via direct images *}
   3.890 +
   3.891 +text{* The direct image operator is the dual of the inverse image operator @{text "inv_image"}
   3.892 +from @{text "Relation.thy"}.  It is useful for transporting a well-order between
   3.893 +different types. *}
   3.894 +
   3.895 +definition dir_image :: "'a rel \<Rightarrow> ('a \<Rightarrow> 'a') \<Rightarrow> 'a' rel"
   3.896 +where
   3.897 +"dir_image r f = {(f a, f b)| a b. (a,b) \<in> r}"
   3.898 +
   3.899 +lemma dir_image_Field:
   3.900 +"Field(dir_image r f) = f ` (Field r)"
   3.901 +unfolding dir_image_def Field_def Range_def Domain_def by fast
   3.902 +
   3.903 +lemma dir_image_minus_Id:
   3.904 +"inj_on f (Field r) \<Longrightarrow> (dir_image r f) - Id = dir_image (r - Id) f"
   3.905 +unfolding inj_on_def Field_def dir_image_def by auto
   3.906 +
   3.907 +lemma Refl_dir_image:
   3.908 +assumes "Refl r"
   3.909 +shows "Refl(dir_image r f)"
   3.910 +proof-
   3.911 +  {fix a' b'
   3.912 +   assume "(a',b') \<in> dir_image r f"
   3.913 +   then obtain a b where 1: "a' = f a \<and> b' = f b \<and> (a,b) \<in> r"
   3.914 +   unfolding dir_image_def by blast
   3.915 +   hence "a \<in> Field r \<and> b \<in> Field r" using Field_def by fastforce
   3.916 +   hence "(a,a) \<in> r \<and> (b,b) \<in> r" using assms by (simp add: refl_on_def)
   3.917 +   with 1 have "(a',a') \<in> dir_image r f \<and> (b',b') \<in> dir_image r f"
   3.918 +   unfolding dir_image_def by auto
   3.919 +  }
   3.920 +  thus ?thesis
   3.921 +  by(unfold refl_on_def Field_def Domain_def Range_def, auto)
   3.922 +qed
   3.923 +
   3.924 +lemma trans_dir_image:
   3.925 +assumes TRANS: "trans r" and INJ: "inj_on f (Field r)"
   3.926 +shows "trans(dir_image r f)"
   3.927 +proof(unfold trans_def, auto)
   3.928 +  fix a' b' c'
   3.929 +  assume "(a',b') \<in> dir_image r f" "(b',c') \<in> dir_image r f"
   3.930 +  then obtain a b1 b2 c where 1: "a' = f a \<and> b' = f b1 \<and> b' = f b2 \<and> c' = f c" and
   3.931 +                         2: "(a,b1) \<in> r \<and> (b2,c) \<in> r"
   3.932 +  unfolding dir_image_def by blast
   3.933 +  hence "b1 \<in> Field r \<and> b2 \<in> Field r"
   3.934 +  unfolding Field_def by auto
   3.935 +  hence "b1 = b2" using 1 INJ unfolding inj_on_def by auto
   3.936 +  hence "(a,c): r" using 2 TRANS unfolding trans_def by blast
   3.937 +  thus "(a',c') \<in> dir_image r f"
   3.938 +  unfolding dir_image_def using 1 by auto
   3.939 +qed
   3.940 +
   3.941 +lemma Preorder_dir_image:
   3.942 +"\<lbrakk>Preorder r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> Preorder (dir_image r f)"
   3.943 +by (simp add: preorder_on_def Refl_dir_image trans_dir_image)
   3.944 +
   3.945 +lemma antisym_dir_image:
   3.946 +assumes AN: "antisym r" and INJ: "inj_on f (Field r)"
   3.947 +shows "antisym(dir_image r f)"
   3.948 +proof(unfold antisym_def, auto)
   3.949 +  fix a' b'
   3.950 +  assume "(a',b') \<in> dir_image r f" "(b',a') \<in> dir_image r f"
   3.951 +  then obtain a1 b1 a2 b2 where 1: "a' = f a1 \<and> a' = f a2 \<and> b' = f b1 \<and> b' = f b2" and
   3.952 +                           2: "(a1,b1) \<in> r \<and> (b2,a2) \<in> r " and
   3.953 +                           3: "{a1,a2,b1,b2} \<le> Field r"
   3.954 +  unfolding dir_image_def Field_def by blast
   3.955 +  hence "a1 = a2 \<and> b1 = b2" using INJ unfolding inj_on_def by auto
   3.956 +  hence "a1 = b2" using 2 AN unfolding antisym_def by auto
   3.957 +  thus "a' = b'" using 1 by auto
   3.958 +qed
   3.959 +
   3.960 +lemma Partial_order_dir_image:
   3.961 +"\<lbrakk>Partial_order r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> Partial_order (dir_image r f)"
   3.962 +by (simp add: partial_order_on_def Preorder_dir_image antisym_dir_image)
   3.963 +
   3.964 +lemma Total_dir_image:
   3.965 +assumes TOT: "Total r" and INJ: "inj_on f (Field r)"
   3.966 +shows "Total(dir_image r f)"
   3.967 +proof(unfold total_on_def, intro ballI impI)
   3.968 +  fix a' b'
   3.969 +  assume "a' \<in> Field (dir_image r f)" "b' \<in> Field (dir_image r f)"
   3.970 +  then obtain a and b where 1: "a \<in> Field r \<and> b \<in> Field r \<and> f a = a' \<and> f b = b'"
   3.971 +    unfolding dir_image_Field[of r f] by blast
   3.972 +  moreover assume "a' \<noteq> b'"
   3.973 +  ultimately have "a \<noteq> b" using INJ unfolding inj_on_def by auto
   3.974 +  hence "(a,b) \<in> r \<or> (b,a) \<in> r" using 1 TOT unfolding total_on_def by auto
   3.975 +  thus "(a',b') \<in> dir_image r f \<or> (b',a') \<in> dir_image r f"
   3.976 +  using 1 unfolding dir_image_def by auto
   3.977 +qed
   3.978 +
   3.979 +lemma Linear_order_dir_image:
   3.980 +"\<lbrakk>Linear_order r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> Linear_order (dir_image r f)"
   3.981 +by (simp add: linear_order_on_def Partial_order_dir_image Total_dir_image)
   3.982 +
   3.983 +lemma wf_dir_image:
   3.984 +assumes WF: "wf r" and INJ: "inj_on f (Field r)"
   3.985 +shows "wf(dir_image r f)"
   3.986 +proof(unfold wf_eq_minimal2, intro allI impI, elim conjE)
   3.987 +  fix A'::"'b set"
   3.988 +  assume SUB: "A' \<le> Field(dir_image r f)" and NE: "A' \<noteq> {}"
   3.989 +  obtain A where A_def: "A = {a \<in> Field r. f a \<in> A'}" by blast
   3.990 +  have "A \<noteq> {} \<and> A \<le> Field r" using A_def SUB NE by (auto simp: dir_image_Field)
   3.991 +  then obtain a where 1: "a \<in> A \<and> (\<forall>b \<in> A. (b,a) \<notin> r)"
   3.992 +  using spec[OF WF[unfolded wf_eq_minimal2], of A] by blast
   3.993 +  have "\<forall>b' \<in> A'. (b',f a) \<notin> dir_image r f"
   3.994 +  proof(clarify)
   3.995 +    fix b' assume *: "b' \<in> A'" and **: "(b',f a) \<in> dir_image r f"
   3.996 +    obtain b1 a1 where 2: "b' = f b1 \<and> f a = f a1" and
   3.997 +                       3: "(b1,a1) \<in> r \<and> {a1,b1} \<le> Field r"
   3.998 +    using ** unfolding dir_image_def Field_def by blast
   3.999 +    hence "a = a1" using 1 A_def INJ unfolding inj_on_def by auto
  3.1000 +    hence "b1 \<in> A \<and> (b1,a) \<in> r" using 2 3 A_def * by auto
  3.1001 +    with 1 show False by auto
  3.1002 +  qed
  3.1003 +  thus "\<exists>a'\<in>A'. \<forall>b'\<in>A'. (b', a') \<notin> dir_image r f"
  3.1004 +  using A_def 1 by blast
  3.1005 +qed
  3.1006 +
  3.1007 +lemma Well_order_dir_image:
  3.1008 +"\<lbrakk>Well_order r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> Well_order (dir_image r f)"
  3.1009 +using assms unfolding well_order_on_def
  3.1010 +using Linear_order_dir_image[of r f] wf_dir_image[of "r - Id" f]
  3.1011 +  dir_image_minus_Id[of f r]
  3.1012 +  subset_inj_on[of f "Field r" "Field(r - Id)"]
  3.1013 +  mono_Field[of "r - Id" r] by auto
  3.1014 +
  3.1015 +lemma dir_image_bij_betw:
  3.1016 +"\<lbrakk>inj_on f (Field r)\<rbrakk> \<Longrightarrow> bij_betw f (Field r) (Field (dir_image r f))"
  3.1017 +unfolding bij_betw_def by (simp add: dir_image_Field order_on_defs)
  3.1018 +
  3.1019 +lemma dir_image_compat:
  3.1020 +"compat r (dir_image r f) f"
  3.1021 +unfolding compat_def dir_image_def by auto
  3.1022 +
  3.1023 +lemma dir_image_iso:
  3.1024 +"\<lbrakk>Well_order r; inj_on f (Field r)\<rbrakk>  \<Longrightarrow> iso r (dir_image r f) f"
  3.1025 +using iso_iff3 dir_image_compat dir_image_bij_betw Well_order_dir_image by blast
  3.1026 +
  3.1027 +lemma dir_image_ordIso:
  3.1028 +"\<lbrakk>Well_order r; inj_on f (Field r)\<rbrakk>  \<Longrightarrow> r =o dir_image r f"
  3.1029 +unfolding ordIso_def using dir_image_iso Well_order_dir_image by blast
  3.1030 +
  3.1031 +lemma Well_order_iso_copy:
  3.1032 +assumes WELL: "well_order_on A r" and BIJ: "bij_betw f A A'"
  3.1033 +shows "\<exists>r'. well_order_on A' r' \<and> r =o r'"
  3.1034 +proof-
  3.1035 +   let ?r' = "dir_image r f"
  3.1036 +   have 1: "A = Field r \<and> Well_order r"
  3.1037 +   using WELL well_order_on_Well_order by blast
  3.1038 +   hence 2: "iso r ?r' f"
  3.1039 +   using dir_image_iso using BIJ unfolding bij_betw_def by auto
  3.1040 +   hence "f ` (Field r) = Field ?r'" using 1 iso_iff[of r ?r'] by blast
  3.1041 +   hence "Field ?r' = A'"
  3.1042 +   using 1 BIJ unfolding bij_betw_def by auto
  3.1043 +   moreover have "Well_order ?r'"
  3.1044 +   using 1 Well_order_dir_image BIJ unfolding bij_betw_def by blast
  3.1045 +   ultimately show ?thesis unfolding ordIso_def using 1 2 by blast
  3.1046 +qed
  3.1047 +
  3.1048 +
  3.1049 +subsection {* Bounded square *}
  3.1050 +
  3.1051 +text{* This construction essentially defines, for an order relation @{text "r"}, a lexicographic
  3.1052 +order @{text "bsqr r"} on @{text "(Field r) \<times> (Field r)"}, applying the
  3.1053 +following criteria (in this order):
  3.1054 +\begin{itemize}
  3.1055 +\item compare the maximums;
  3.1056 +\item compare the first components;
  3.1057 +\item compare the second components.
  3.1058 +\end{itemize}
  3.1059 +%
  3.1060 +The only application of this construction that we are aware of is
  3.1061 +at proving that the square of an infinite set has the same cardinal
  3.1062 +as that set. The essential property required there (and which is ensured by this
  3.1063 +construction) is that any proper order filter of the product order is included in a rectangle, i.e.,
  3.1064 +in a product of proper filters on the original relation (assumed to be a well-order). *}
  3.1065 +
  3.1066 +definition bsqr :: "'a rel => ('a * 'a)rel"
  3.1067 +where
  3.1068 +"bsqr r = {((a1,a2),(b1,b2)).
  3.1069 +           {a1,a2,b1,b2} \<le> Field r \<and>
  3.1070 +           (a1 = b1 \<and> a2 = b2 \<or>
  3.1071 +            (wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r - Id \<or>
  3.1072 +            wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> (a1,b1) \<in> r - Id \<or>
  3.1073 +            wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> a1 = b1  \<and> (a2,b2) \<in> r - Id
  3.1074 +           )}"
  3.1075 +
  3.1076 +lemma Field_bsqr:
  3.1077 +"Field (bsqr r) = Field r \<times> Field r"
  3.1078 +proof
  3.1079 +  show "Field (bsqr r) \<le> Field r \<times> Field r"
  3.1080 +  proof-
  3.1081 +    {fix a1 a2 assume "(a1,a2) \<in> Field (bsqr r)"
  3.1082 +     moreover
  3.1083 +     have "\<And> b1 b2. ((a1,a2),(b1,b2)) \<in> bsqr r \<or> ((b1,b2),(a1,a2)) \<in> bsqr r \<Longrightarrow>
  3.1084 +                      a1 \<in> Field r \<and> a2 \<in> Field r" unfolding bsqr_def by auto
  3.1085 +     ultimately have "a1 \<in> Field r \<and> a2 \<in> Field r" unfolding Field_def by auto
  3.1086 +    }
  3.1087 +    thus ?thesis unfolding Field_def by force
  3.1088 +  qed
  3.1089 +next
  3.1090 +  show "Field r \<times> Field r \<le> Field (bsqr r)"
  3.1091 +  proof(auto)
  3.1092 +    fix a1 a2 assume "a1 \<in> Field r" and "a2 \<in> Field r"
  3.1093 +    hence "((a1,a2),(a1,a2)) \<in> bsqr r" unfolding bsqr_def by blast
  3.1094 +    thus "(a1,a2) \<in> Field (bsqr r)" unfolding Field_def by auto
  3.1095 +  qed
  3.1096 +qed
  3.1097 +
  3.1098 +lemma bsqr_Refl: "Refl(bsqr r)"
  3.1099 +by(unfold refl_on_def Field_bsqr, auto simp add: bsqr_def)
  3.1100 +
  3.1101 +lemma bsqr_Trans:
  3.1102 +assumes "Well_order r"
  3.1103 +shows "trans (bsqr r)"
  3.1104 +proof(unfold trans_def, auto)
  3.1105 +  (* Preliminary facts *)
  3.1106 +  have Well: "wo_rel r" using assms wo_rel_def by auto
  3.1107 +  hence Trans: "trans r" using wo_rel.TRANS by auto
  3.1108 +  have Anti: "antisym r" using wo_rel.ANTISYM Well by auto
  3.1109 +  hence TransS: "trans(r - Id)" using Trans by (simp add: trans_diff_Id)
  3.1110 +  (* Main proof *)
  3.1111 +  fix a1 a2 b1 b2 c1 c2
  3.1112 +  assume *: "((a1,a2),(b1,b2)) \<in> bsqr r" and **: "((b1,b2),(c1,c2)) \<in> bsqr r"
  3.1113 +  hence 0: "{a1,a2,b1,b2,c1,c2} \<le> Field r" unfolding bsqr_def by auto
  3.1114 +  have 1: "a1 = b1 \<and> a2 = b2 \<or> (wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r - Id \<or>
  3.1115 +           wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> (a1,b1) \<in> r - Id \<or>
  3.1116 +           wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> a1 = b1 \<and> (a2,b2) \<in> r - Id"
  3.1117 +  using * unfolding bsqr_def by auto
  3.1118 +  have 2: "b1 = c1 \<and> b2 = c2 \<or> (wo_rel.max2 r b1 b2, wo_rel.max2 r c1 c2) \<in> r - Id \<or>
  3.1119 +           wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> (b1,c1) \<in> r - Id \<or>
  3.1120 +           wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> b1 = c1 \<and> (b2,c2) \<in> r - Id"
  3.1121 +  using ** unfolding bsqr_def by auto
  3.1122 +  show "((a1,a2),(c1,c2)) \<in> bsqr r"
  3.1123 +  proof-
  3.1124 +    {assume Case1: "a1 = b1 \<and> a2 = b2"
  3.1125 +     hence ?thesis using ** by simp
  3.1126 +    }
  3.1127 +    moreover
  3.1128 +    {assume Case2: "(wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r - Id"
  3.1129 +     {assume Case21: "b1 = c1 \<and> b2 = c2"
  3.1130 +      hence ?thesis using * by simp
  3.1131 +     }
  3.1132 +     moreover
  3.1133 +     {assume Case22: "(wo_rel.max2 r b1 b2, wo_rel.max2 r c1 c2) \<in> r - Id"
  3.1134 +      hence "(wo_rel.max2 r a1 a2, wo_rel.max2 r c1 c2) \<in> r - Id"
  3.1135 +      using Case2 TransS trans_def[of "r - Id"] by blast
  3.1136 +      hence ?thesis using 0 unfolding bsqr_def by auto
  3.1137 +     }
  3.1138 +     moreover
  3.1139 +     {assume Case23_4: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2"
  3.1140 +      hence ?thesis using Case2 0 unfolding bsqr_def by auto
  3.1141 +     }
  3.1142 +     ultimately have ?thesis using 0 2 by auto
  3.1143 +    }
  3.1144 +    moreover
  3.1145 +    {assume Case3: "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> (a1,b1) \<in> r - Id"
  3.1146 +     {assume Case31: "b1 = c1 \<and> b2 = c2"
  3.1147 +      hence ?thesis using * by simp
  3.1148 +     }
  3.1149 +     moreover
  3.1150 +     {assume Case32: "(wo_rel.max2 r b1 b2, wo_rel.max2 r c1 c2) \<in> r - Id"
  3.1151 +      hence ?thesis using Case3 0 unfolding bsqr_def by auto
  3.1152 +     }
  3.1153 +     moreover
  3.1154 +     {assume Case33: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> (b1,c1) \<in> r - Id"
  3.1155 +      hence "(a1,c1) \<in> r - Id"
  3.1156 +      using Case3 TransS trans_def[of "r - Id"] by blast
  3.1157 +      hence ?thesis using Case3 Case33 0 unfolding bsqr_def by auto
  3.1158 +     }
  3.1159 +     moreover
  3.1160 +     {assume Case33: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> b1 = c1"
  3.1161 +      hence ?thesis using Case3 0 unfolding bsqr_def by auto
  3.1162 +     }
  3.1163 +     ultimately have ?thesis using 0 2 by auto
  3.1164 +    }
  3.1165 +    moreover
  3.1166 +    {assume Case4: "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> a1 = b1 \<and> (a2,b2) \<in> r - Id"
  3.1167 +     {assume Case41: "b1 = c1 \<and> b2 = c2"
  3.1168 +      hence ?thesis using * by simp
  3.1169 +     }
  3.1170 +     moreover
  3.1171 +     {assume Case42: "(wo_rel.max2 r b1 b2, wo_rel.max2 r c1 c2) \<in> r - Id"
  3.1172 +      hence ?thesis using Case4 0 unfolding bsqr_def by force
  3.1173 +     }
  3.1174 +     moreover
  3.1175 +     {assume Case43: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> (b1,c1) \<in> r - Id"
  3.1176 +      hence ?thesis using Case4 0 unfolding bsqr_def by auto
  3.1177 +     }
  3.1178 +     moreover
  3.1179 +     {assume Case44: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> b1 = c1 \<and> (b2,c2) \<in> r - Id"
  3.1180 +      hence "(a2,c2) \<in> r - Id"
  3.1181 +      using Case4 TransS trans_def[of "r - Id"] by blast
  3.1182 +      hence ?thesis using Case4 Case44 0 unfolding bsqr_def by auto
  3.1183 +     }
  3.1184 +     ultimately have ?thesis using 0 2 by auto
  3.1185 +    }
  3.1186 +    ultimately show ?thesis using 0 1 by auto
  3.1187 +  qed
  3.1188 +qed
  3.1189 +
  3.1190 +lemma bsqr_antisym:
  3.1191 +assumes "Well_order r"
  3.1192 +shows "antisym (bsqr r)"
  3.1193 +proof(unfold antisym_def, clarify)
  3.1194 +  (* Preliminary facts *)
  3.1195 +  have Well: "wo_rel r" using assms wo_rel_def by auto
  3.1196 +  hence Trans: "trans r" using wo_rel.TRANS by auto
  3.1197 +  have Anti: "antisym r" using wo_rel.ANTISYM Well by auto
  3.1198 +  hence TransS: "trans(r - Id)" using Trans by (simp add: trans_diff_Id)
  3.1199 +  hence IrrS: "\<forall>a b. \<not>((a,b) \<in> r - Id \<and> (b,a) \<in> r - Id)"
  3.1200 +  using Anti trans_def[of "r - Id"] antisym_def[of "r - Id"] by blast
  3.1201 +  (* Main proof *)
  3.1202 +  fix a1 a2 b1 b2
  3.1203 +  assume *: "((a1,a2),(b1,b2)) \<in> bsqr r" and **: "((b1,b2),(a1,a2)) \<in> bsqr r"
  3.1204 +  hence 0: "{a1,a2,b1,b2} \<le> Field r" unfolding bsqr_def by auto
  3.1205 +  have 1: "a1 = b1 \<and> a2 = b2 \<or> (wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r - Id \<or>
  3.1206 +           wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> (a1,b1) \<in> r - Id \<or>
  3.1207 +           wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> a1 = b1 \<and> (a2,b2) \<in> r - Id"
  3.1208 +  using * unfolding bsqr_def by auto
  3.1209 +  have 2: "b1 = a1 \<and> b2 = a2 \<or> (wo_rel.max2 r b1 b2, wo_rel.max2 r a1 a2) \<in> r - Id \<or>
  3.1210 +           wo_rel.max2 r b1 b2 = wo_rel.max2 r a1 a2 \<and> (b1,a1) \<in> r - Id \<or>
  3.1211 +           wo_rel.max2 r b1 b2 = wo_rel.max2 r a1 a2 \<and> b1 = a1 \<and> (b2,a2) \<in> r - Id"
  3.1212 +  using ** unfolding bsqr_def by auto
  3.1213 +  show "a1 = b1 \<and> a2 = b2"
  3.1214 +  proof-
  3.1215 +    {assume Case1: "(wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r - Id"
  3.1216 +     {assume Case11: "(wo_rel.max2 r b1 b2, wo_rel.max2 r a1 a2) \<in> r - Id"
  3.1217 +      hence False using Case1 IrrS by blast
  3.1218 +     }
  3.1219 +     moreover
  3.1220 +     {assume Case12_3: "wo_rel.max2 r b1 b2 = wo_rel.max2 r a1 a2"
  3.1221 +      hence False using Case1 by auto
  3.1222 +     }
  3.1223 +     ultimately have ?thesis using 0 2 by auto
  3.1224 +    }
  3.1225 +    moreover
  3.1226 +    {assume Case2: "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> (a1,b1) \<in> r - Id"
  3.1227 +     {assume Case21: "(wo_rel.max2 r b1 b2, wo_rel.max2 r a1 a2) \<in> r - Id"
  3.1228 +       hence False using Case2 by auto
  3.1229 +     }
  3.1230 +     moreover
  3.1231 +     {assume Case22: "(b1,a1) \<in> r - Id"
  3.1232 +      hence False using Case2 IrrS by blast
  3.1233 +     }
  3.1234 +     moreover
  3.1235 +     {assume Case23: "b1 = a1"
  3.1236 +      hence False using Case2 by auto
  3.1237 +     }
  3.1238 +     ultimately have ?thesis using 0 2 by auto
  3.1239 +    }
  3.1240 +    moreover
  3.1241 +    {assume Case3: "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> a1 = b1 \<and> (a2,b2) \<in> r - Id"
  3.1242 +     moreover
  3.1243 +     {assume Case31: "(wo_rel.max2 r b1 b2, wo_rel.max2 r a1 a2) \<in> r - Id"
  3.1244 +      hence False using Case3 by auto
  3.1245 +     }
  3.1246 +     moreover
  3.1247 +     {assume Case32: "(b1,a1) \<in> r - Id"
  3.1248 +      hence False using Case3 by auto
  3.1249 +     }
  3.1250 +     moreover
  3.1251 +     {assume Case33: "(b2,a2) \<in> r - Id"
  3.1252 +      hence False using Case3 IrrS by blast
  3.1253 +     }
  3.1254 +     ultimately have ?thesis using 0 2 by auto
  3.1255 +    }
  3.1256 +    ultimately show ?thesis using 0 1 by blast
  3.1257 +  qed
  3.1258 +qed
  3.1259 +
  3.1260 +lemma bsqr_Total:
  3.1261 +assumes "Well_order r"
  3.1262 +shows "Total(bsqr r)"
  3.1263 +proof-
  3.1264 +  (* Preliminary facts *)
  3.1265 +  have Well: "wo_rel r" using assms wo_rel_def by auto
  3.1266 +  hence Total: "\<forall>a \<in> Field r. \<forall>b \<in> Field r. (a,b) \<in> r \<or> (b,a) \<in> r"
  3.1267 +  using wo_rel.TOTALS by auto
  3.1268 +  (* Main proof *)
  3.1269 +  {fix a1 a2 b1 b2 assume "{(a1,a2), (b1,b2)} \<le> Field(bsqr r)"
  3.1270 +   hence 0: "a1 \<in> Field r \<and> a2 \<in> Field r \<and> b1 \<in> Field r \<and> b2 \<in> Field r"
  3.1271 +   using Field_bsqr by blast
  3.1272 +   have "((a1,a2) = (b1,b2) \<or> ((a1,a2),(b1,b2)) \<in> bsqr r \<or> ((b1,b2),(a1,a2)) \<in> bsqr r)"
  3.1273 +   proof(rule wo_rel.cases_Total[of r a1 a2], clarsimp simp add: Well, simp add: 0)
  3.1274 +       (* Why didn't clarsimp simp add: Well 0 do the same job? *)
  3.1275 +     assume Case1: "(a1,a2) \<in> r"
  3.1276 +     hence 1: "wo_rel.max2 r a1 a2 = a2"
  3.1277 +     using Well 0 by (simp add: wo_rel.max2_equals2)
  3.1278 +     show ?thesis
  3.1279 +     proof(rule wo_rel.cases_Total[of r b1 b2], clarsimp simp add: Well, simp add: 0)
  3.1280 +       assume Case11: "(b1,b2) \<in> r"
  3.1281 +       hence 2: "wo_rel.max2 r b1 b2 = b2"
  3.1282 +       using Well 0 by (simp add: wo_rel.max2_equals2)
  3.1283 +       show ?thesis
  3.1284 +       proof(rule wo_rel.cases_Total3[of r a2 b2], clarsimp simp add: Well, simp add: 0)
  3.1285 +         assume Case111: "(a2,b2) \<in> r - Id \<or> (b2,a2) \<in> r - Id"
  3.1286 +         thus ?thesis using 0 1 2 unfolding bsqr_def by auto
  3.1287 +       next
  3.1288 +         assume Case112: "a2 = b2"
  3.1289 +         show ?thesis
  3.1290 +         proof(rule wo_rel.cases_Total3[of r a1 b1], clarsimp simp add: Well, simp add: 0)
  3.1291 +           assume Case1121: "(a1,b1) \<in> r - Id \<or> (b1,a1) \<in> r - Id"
  3.1292 +           thus ?thesis using 0 1 2 Case112 unfolding bsqr_def by auto
  3.1293 +         next
  3.1294 +           assume Case1122: "a1 = b1"
  3.1295 +           thus ?thesis using Case112 by auto
  3.1296 +         qed
  3.1297 +       qed
  3.1298 +     next
  3.1299 +       assume Case12: "(b2,b1) \<in> r"
  3.1300 +       hence 3: "wo_rel.max2 r b1 b2 = b1" using Well 0 by (simp add: wo_rel.max2_equals1)
  3.1301 +       show ?thesis
  3.1302 +       proof(rule wo_rel.cases_Total3[of r a2 b1], clarsimp simp add: Well, simp add: 0)
  3.1303 +         assume Case121: "(a2,b1) \<in> r - Id \<or> (b1,a2) \<in> r - Id"
  3.1304 +         thus ?thesis using 0 1 3 unfolding bsqr_def by auto
  3.1305 +       next
  3.1306 +         assume Case122: "a2 = b1"
  3.1307 +         show ?thesis
  3.1308 +         proof(rule wo_rel.cases_Total3[of r a1 b1], clarsimp simp add: Well, simp add: 0)
  3.1309 +           assume Case1221: "(a1,b1) \<in> r - Id \<or> (b1,a1) \<in> r - Id"
  3.1310 +           thus ?thesis using 0 1 3 Case122 unfolding bsqr_def by auto
  3.1311 +         next
  3.1312 +           assume Case1222: "a1 = b1"
  3.1313 +           show ?thesis
  3.1314 +           proof(rule wo_rel.cases_Total3[of r a2 b2], clarsimp simp add: Well, simp add: 0)
  3.1315 +             assume Case12221: "(a2,b2) \<in> r - Id \<or> (b2,a2) \<in> r - Id"
  3.1316 +             thus ?thesis using 0 1 3 Case122 Case1222 unfolding bsqr_def by auto
  3.1317 +           next
  3.1318 +             assume Case12222: "a2 = b2"
  3.1319 +             thus ?thesis using Case122 Case1222 by auto
  3.1320 +           qed
  3.1321 +         qed
  3.1322 +       qed
  3.1323 +     qed
  3.1324 +   next
  3.1325 +     assume Case2: "(a2,a1) \<in> r"
  3.1326 +     hence 1: "wo_rel.max2 r a1 a2 = a1" using Well 0 by (simp add: wo_rel.max2_equals1)
  3.1327 +     show ?thesis
  3.1328 +     proof(rule wo_rel.cases_Total[of r b1 b2], clarsimp simp add: Well, simp add: 0)
  3.1329 +       assume Case21: "(b1,b2) \<in> r"
  3.1330 +       hence 2: "wo_rel.max2 r b1 b2 = b2" using Well 0 by (simp add: wo_rel.max2_equals2)
  3.1331 +       show ?thesis
  3.1332 +       proof(rule wo_rel.cases_Total3[of r a1 b2], clarsimp simp add: Well, simp add: 0)
  3.1333 +         assume Case211: "(a1,b2) \<in> r - Id \<or> (b2,a1) \<in> r - Id"
  3.1334 +         thus ?thesis using 0 1 2 unfolding bsqr_def by auto
  3.1335 +       next
  3.1336 +         assume Case212: "a1 = b2"
  3.1337 +         show ?thesis
  3.1338 +         proof(rule wo_rel.cases_Total3[of r a1 b1], clarsimp simp add: Well, simp add: 0)
  3.1339 +           assume Case2121: "(a1,b1) \<in> r - Id \<or> (b1,a1) \<in> r - Id"
  3.1340 +           thus ?thesis using 0 1 2 Case212 unfolding bsqr_def by auto
  3.1341 +         next
  3.1342 +           assume Case2122: "a1 = b1"
  3.1343 +           show ?thesis
  3.1344 +           proof(rule wo_rel.cases_Total3[of r a2 b2], clarsimp simp add: Well, simp add: 0)
  3.1345 +             assume Case21221: "(a2,b2) \<in> r - Id \<or> (b2,a2) \<in> r - Id"
  3.1346 +             thus ?thesis using 0 1 2 Case212 Case2122 unfolding bsqr_def by auto
  3.1347 +           next
  3.1348 +             assume Case21222: "a2 = b2"
  3.1349 +             thus ?thesis using Case2122 Case212 by auto
  3.1350 +           qed
  3.1351 +         qed
  3.1352 +       qed
  3.1353 +     next
  3.1354 +       assume Case22: "(b2,b1) \<in> r"
  3.1355 +       hence 3: "wo_rel.max2 r b1 b2 = b1"  using Well 0 by (simp add: wo_rel.max2_equals1)
  3.1356 +       show ?thesis
  3.1357 +       proof(rule wo_rel.cases_Total3[of r a1 b1], clarsimp simp add: Well, simp add: 0)
  3.1358 +         assume Case221: "(a1,b1) \<in> r - Id \<or> (b1,a1) \<in> r - Id"
  3.1359 +         thus ?thesis using 0 1 3 unfolding bsqr_def by auto
  3.1360 +       next
  3.1361 +         assume Case222: "a1 = b1"
  3.1362 +         show ?thesis
  3.1363 +         proof(rule wo_rel.cases_Total3[of r a2 b2], clarsimp simp add: Well, simp add: 0)
  3.1364 +           assume Case2221: "(a2,b2) \<in> r - Id \<or> (b2,a2) \<in> r - Id"
  3.1365 +           thus ?thesis using 0 1 3 Case222 unfolding bsqr_def by auto
  3.1366 +         next
  3.1367 +           assume Case2222: "a2 = b2"
  3.1368 +           thus ?thesis using Case222 by auto
  3.1369 +         qed
  3.1370 +       qed
  3.1371 +     qed
  3.1372 +   qed
  3.1373 +  }
  3.1374 +  thus ?thesis unfolding total_on_def by fast
  3.1375 +qed
  3.1376 +
  3.1377 +lemma bsqr_Linear_order:
  3.1378 +assumes "Well_order r"
  3.1379 +shows "Linear_order(bsqr r)"
  3.1380 +unfolding order_on_defs
  3.1381 +using assms bsqr_Refl bsqr_Trans bsqr_antisym bsqr_Total by blast
  3.1382 +
  3.1383 +lemma bsqr_Well_order:
  3.1384 +assumes "Well_order r"
  3.1385 +shows "Well_order(bsqr r)"
  3.1386 +using assms
  3.1387 +proof(simp add: bsqr_Linear_order Linear_order_Well_order_iff, intro allI impI)
  3.1388 +  have 0: "\<forall>A \<le> Field r. A \<noteq> {} \<longrightarrow> (\<exists>a \<in> A. \<forall>a' \<in> A. (a,a') \<in> r)"
  3.1389 +  using assms well_order_on_def Linear_order_Well_order_iff by blast
  3.1390 +  fix D assume *: "D \<le> Field (bsqr r)" and **: "D \<noteq> {}"
  3.1391 +  hence 1: "D \<le> Field r \<times> Field r" unfolding Field_bsqr by simp
  3.1392 +  (*  *)
  3.1393 +  obtain M where M_def: "M = {wo_rel.max2 r a1 a2| a1 a2. (a1,a2) \<in> D}" by blast
  3.1394 +  have "M \<noteq> {}" using 1 M_def ** by auto
  3.1395 +  moreover
  3.1396 +  have "M \<le> Field r" unfolding M_def
  3.1397 +  using 1 assms wo_rel_def[of r] wo_rel.max2_among[of r] by fastforce
  3.1398 +  ultimately obtain m where m_min: "m \<in> M \<and> (\<forall>a \<in> M. (m,a) \<in> r)"
  3.1399 +  using 0 by blast
  3.1400 +  (*  *)
  3.1401 +  obtain A1 where A1_def: "A1 = {a1. \<exists>a2. (a1,a2) \<in> D \<and> wo_rel.max2 r a1 a2 = m}" by blast
  3.1402 +  have "A1 \<le> Field r" unfolding A1_def using 1 by auto
  3.1403 +  moreover have "A1 \<noteq> {}" unfolding A1_def using m_min unfolding M_def by blast
  3.1404 +  ultimately obtain a1 where a1_min: "a1 \<in> A1 \<and> (\<forall>a \<in> A1. (a1,a) \<in> r)"
  3.1405 +  using 0 by blast
  3.1406 +  (*  *)
  3.1407 +  obtain A2 where A2_def: "A2 = {a2. (a1,a2) \<in> D \<and> wo_rel.max2 r a1 a2 = m}" by blast
  3.1408 +  have "A2 \<le> Field r" unfolding A2_def using 1 by auto
  3.1409 +  moreover have "A2 \<noteq> {}" unfolding A2_def
  3.1410 +  using m_min a1_min unfolding A1_def M_def by blast
  3.1411 +  ultimately obtain a2 where a2_min: "a2 \<in> A2 \<and> (\<forall>a \<in> A2. (a2,a) \<in> r)"
  3.1412 +  using 0 by blast
  3.1413 +  (*   *)
  3.1414 +  have 2: "wo_rel.max2 r a1 a2 = m"
  3.1415 +  using a1_min a2_min unfolding A1_def A2_def by auto
  3.1416 +  have 3: "(a1,a2) \<in> D" using a2_min unfolding A2_def by auto
  3.1417 +  (*  *)
  3.1418 +  moreover
  3.1419 +  {fix b1 b2 assume ***: "(b1,b2) \<in> D"
  3.1420 +   hence 4: "{a1,a2,b1,b2} \<le> Field r" using 1 3 by blast
  3.1421 +   have 5: "(wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r"
  3.1422 +   using *** a1_min a2_min m_min unfolding A1_def A2_def M_def by auto
  3.1423 +   have "((a1,a2),(b1,b2)) \<in> bsqr r"
  3.1424 +   proof(cases "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2")
  3.1425 +     assume Case1: "wo_rel.max2 r a1 a2 \<noteq> wo_rel.max2 r b1 b2"
  3.1426 +     thus ?thesis unfolding bsqr_def using 4 5 by auto
  3.1427 +   next
  3.1428 +     assume Case2: "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2"
  3.1429 +     hence "b1 \<in> A1" unfolding A1_def using 2 *** by auto
  3.1430 +     hence 6: "(a1,b1) \<in> r" using a1_min by auto
  3.1431 +     show ?thesis
  3.1432 +     proof(cases "a1 = b1")
  3.1433 +       assume Case21: "a1 \<noteq> b1"
  3.1434 +       thus ?thesis unfolding bsqr_def using 4 Case2 6 by auto
  3.1435 +     next
  3.1436 +       assume Case22: "a1 = b1"
  3.1437 +       hence "b2 \<in> A2" unfolding A2_def using 2 *** Case2 by auto
  3.1438 +       hence 7: "(a2,b2) \<in> r" using a2_min by auto
  3.1439 +       thus ?thesis unfolding bsqr_def using 4 7 Case2 Case22 by auto
  3.1440 +     qed
  3.1441 +   qed
  3.1442 +  }
  3.1443 +  (*  *)
  3.1444 +  ultimately show "\<exists>d \<in> D. \<forall>d' \<in> D. (d,d') \<in> bsqr r" by fastforce
  3.1445 +qed
  3.1446 +
  3.1447 +lemma bsqr_max2:
  3.1448 +assumes WELL: "Well_order r" and LEQ: "((a1,a2),(b1,b2)) \<in> bsqr r"
  3.1449 +shows "(wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r"
  3.1450 +proof-
  3.1451 +  have "{(a1,a2),(b1,b2)} \<le> Field(bsqr r)"
  3.1452 +  using LEQ unfolding Field_def by auto
  3.1453 +  hence "{a1,a2,b1,b2} \<le> Field r" unfolding Field_bsqr by auto
  3.1454 +  hence "{wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2} \<le> Field r"
  3.1455 +  using WELL wo_rel_def[of r] wo_rel.max2_among[of r] by fastforce
  3.1456 +  moreover have "(wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r \<or> wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2"
  3.1457 +  using LEQ unfolding bsqr_def by auto
  3.1458 +  ultimately show ?thesis using WELL unfolding order_on_defs refl_on_def by auto
  3.1459 +qed
  3.1460 +
  3.1461 +lemma bsqr_ofilter:
  3.1462 +assumes WELL: "Well_order r" and
  3.1463 +        OF: "wo_rel.ofilter (bsqr r) D" and SUB: "D < Field r \<times> Field r" and
  3.1464 +        NE: "\<not> (\<exists>a. Field r = under r a)"
  3.1465 +shows "\<exists>A. wo_rel.ofilter r A \<and> A < Field r \<and> D \<le> A \<times> A"
  3.1466 +proof-
  3.1467 +  let ?r' = "bsqr r"
  3.1468 +  have Well: "wo_rel r" using WELL wo_rel_def by blast
  3.1469 +  hence Trans: "trans r" using wo_rel.TRANS by blast
  3.1470 +  have Well': "Well_order ?r' \<and> wo_rel ?r'"
  3.1471 +  using WELL bsqr_Well_order wo_rel_def by blast
  3.1472 +  (*  *)
  3.1473 +  have "D < Field ?r'" unfolding Field_bsqr using SUB .
  3.1474 +  with OF obtain a1 and a2 where
  3.1475 +  "(a1,a2) \<in> Field ?r'" and 1: "D = underS ?r' (a1,a2)"
  3.1476 +  using Well' wo_rel.ofilter_underS_Field[of ?r' D] by auto
  3.1477 +  hence 2: "{a1,a2} \<le> Field r" unfolding Field_bsqr by auto
  3.1478 +  let ?m = "wo_rel.max2 r a1 a2"
  3.1479 +  have "D \<le> (under r ?m) \<times> (under r ?m)"
  3.1480 +  proof(unfold 1)
  3.1481 +    {fix b1 b2
  3.1482 +     let ?n = "wo_rel.max2 r b1 b2"
  3.1483 +     assume "(b1,b2) \<in> underS ?r' (a1,a2)"
  3.1484 +     hence 3: "((b1,b2),(a1,a2)) \<in> ?r'"
  3.1485 +     unfolding underS_def by blast
  3.1486 +     hence "(?n,?m) \<in> r" using WELL by (simp add: bsqr_max2)
  3.1487 +     moreover
  3.1488 +     {have "(b1,b2) \<in> Field ?r'" using 3 unfolding Field_def by auto
  3.1489 +      hence "{b1,b2} \<le> Field r" unfolding Field_bsqr by auto
  3.1490 +      hence "(b1,?n) \<in> r \<and> (b2,?n) \<in> r"
  3.1491 +      using Well by (simp add: wo_rel.max2_greater)
  3.1492 +     }
  3.1493 +     ultimately have "(b1,?m) \<in> r \<and> (b2,?m) \<in> r"
  3.1494 +     using Trans trans_def[of r] by blast
  3.1495 +     hence "(b1,b2) \<in> (under r ?m) \<times> (under r ?m)" unfolding under_def by simp}
  3.1496 +     thus "underS ?r' (a1,a2) \<le> (under r ?m) \<times> (under r ?m)" by auto
  3.1497 +  qed
  3.1498 +  moreover have "wo_rel.ofilter r (under r ?m)"
  3.1499 +  using Well by (simp add: wo_rel.under_ofilter)
  3.1500 +  moreover have "under r ?m < Field r"
  3.1501 +  using NE under_Field[of r ?m] by blast
  3.1502 +  ultimately show ?thesis by blast
  3.1503 +qed
  3.1504 +
  3.1505 +definition Func where
  3.1506 +"Func A B = {f . (\<forall> a \<in> A. f a \<in> B) \<and> (\<forall> a. a \<notin> A \<longrightarrow> f a = undefined)}"
  3.1507 +
  3.1508 +lemma Func_empty:
  3.1509 +"Func {} B = {\<lambda>x. undefined}"
  3.1510 +unfolding Func_def by auto
  3.1511 +
  3.1512 +lemma Func_elim:
  3.1513 +assumes "g \<in> Func A B" and "a \<in> A"
  3.1514 +shows "\<exists> b. b \<in> B \<and> g a = b"
  3.1515 +using assms unfolding Func_def by (cases "g a = undefined") auto
  3.1516 +
  3.1517 +definition curr where
  3.1518 +"curr A f \<equiv> \<lambda> a. if a \<in> A then \<lambda>b. f (a,b) else undefined"
  3.1519 +
  3.1520 +lemma curr_in:
  3.1521 +assumes f: "f \<in> Func (A <*> B) C"
  3.1522 +shows "curr A f \<in> Func A (Func B C)"
  3.1523 +using assms unfolding curr_def Func_def by auto
  3.1524 +
  3.1525 +lemma curr_inj:
  3.1526 +assumes "f1 \<in> Func (A <*> B) C" and "f2 \<in> Func (A <*> B) C"
  3.1527 +shows "curr A f1 = curr A f2 \<longleftrightarrow> f1 = f2"
  3.1528 +proof safe
  3.1529 +  assume c: "curr A f1 = curr A f2"
  3.1530 +  show "f1 = f2"
  3.1531 +  proof (rule ext, clarify)
  3.1532 +    fix a b show "f1 (a, b) = f2 (a, b)"
  3.1533 +    proof (cases "(a,b) \<in> A <*> B")
  3.1534 +      case False
  3.1535 +      thus ?thesis using assms unfolding Func_def by auto
  3.1536 +    next
  3.1537 +      case True hence a: "a \<in> A" and b: "b \<in> B" by auto
  3.1538 +      thus ?thesis
  3.1539 +      using c unfolding curr_def fun_eq_iff by(elim allE[of _ a]) simp
  3.1540 +    qed
  3.1541 +  qed
  3.1542 +qed
  3.1543 +
  3.1544 +lemma curr_surj:
  3.1545 +assumes "g \<in> Func A (Func B C)"
  3.1546 +shows "\<exists> f \<in> Func (A <*> B) C. curr A f = g"
  3.1547 +proof
  3.1548 +  let ?f = "\<lambda> ab. if fst ab \<in> A \<and> snd ab \<in> B then g (fst ab) (snd ab) else undefined"
  3.1549 +  show "curr A ?f = g"
  3.1550 +  proof (rule ext)
  3.1551 +    fix a show "curr A ?f a = g a"
  3.1552 +    proof (cases "a \<in> A")
  3.1553 +      case False
  3.1554 +      hence "g a = undefined" using assms unfolding Func_def by auto
  3.1555 +      thus ?thesis unfolding curr_def using False by simp
  3.1556 +    next
  3.1557 +      case True
  3.1558 +      obtain g1 where "g1 \<in> Func B C" and "g a = g1"
  3.1559 +      using assms using Func_elim[OF assms True] by blast
  3.1560 +      thus ?thesis using True unfolding Func_def curr_def by auto
  3.1561 +    qed
  3.1562 +  qed
  3.1563 +  show "?f \<in> Func (A <*> B) C" using assms unfolding Func_def mem_Collect_eq by auto
  3.1564 +qed
  3.1565 +
  3.1566 +lemma bij_betw_curr:
  3.1567 +"bij_betw (curr A) (Func (A <*> B) C) (Func A (Func B C))"
  3.1568 +unfolding bij_betw_def inj_on_def image_def
  3.1569 +apply (intro impI conjI ballI)
  3.1570 +apply (erule curr_inj[THEN iffD1], assumption+)
  3.1571 +apply auto
  3.1572 +apply (erule curr_in)
  3.1573 +using curr_surj by blast
  3.1574 +
  3.1575 +definition Func_map where
  3.1576 +"Func_map B2 f1 f2 g b2 \<equiv> if b2 \<in> B2 then f1 (g (f2 b2)) else undefined"
  3.1577 +
  3.1578 +lemma Func_map:
  3.1579 +assumes g: "g \<in> Func A2 A1" and f1: "f1 ` A1 \<subseteq> B1" and f2: "f2 ` B2 \<subseteq> A2"
  3.1580 +shows "Func_map B2 f1 f2 g \<in> Func B2 B1"
  3.1581 +using assms unfolding Func_def Func_map_def mem_Collect_eq by auto
  3.1582 +
  3.1583 +lemma Func_non_emp:
  3.1584 +assumes "B \<noteq> {}"
  3.1585 +shows "Func A B \<noteq> {}"
  3.1586 +proof-
  3.1587 +  obtain b where b: "b \<in> B" using assms by auto
  3.1588 +  hence "(\<lambda> a. if a \<in> A then b else undefined) \<in> Func A B" unfolding Func_def by auto
  3.1589 +  thus ?thesis by blast
  3.1590 +qed
  3.1591 +
  3.1592 +lemma Func_is_emp:
  3.1593 +"Func A B = {} \<longleftrightarrow> A \<noteq> {} \<and> B = {}" (is "?L \<longleftrightarrow> ?R")
  3.1594 +proof
  3.1595 +  assume L: ?L
  3.1596 +  moreover {assume "A = {}" hence False using L Func_empty by auto}
  3.1597 +  moreover {assume "B \<noteq> {}" hence False using L Func_non_emp[of B A] by simp }
  3.1598 +  ultimately show ?R by blast
  3.1599 +next
  3.1600 +  assume R: ?R
  3.1601 +  moreover
  3.1602 +  {fix f assume "f \<in> Func A B"
  3.1603 +   moreover obtain a where "a \<in> A" using R by blast
  3.1604 +   ultimately obtain b where "b \<in> B" unfolding Func_def by blast
  3.1605 +   with R have False by blast
  3.1606 +  }
  3.1607 +  thus ?L by blast
  3.1608 +qed
  3.1609 +
  3.1610 +lemma Func_map_surj:
  3.1611 +assumes B1: "f1 ` A1 = B1" and A2: "inj_on f2 B2" "f2 ` B2 \<subseteq> A2"
  3.1612 +and B2A2: "B2 = {} \<Longrightarrow> A2 = {}"
  3.1613 +shows "Func B2 B1 = Func_map B2 f1 f2 ` Func A2 A1"
  3.1614 +proof(cases "B2 = {}")
  3.1615 +  case True
  3.1616 +  thus ?thesis using B2A2 by (auto simp: Func_empty Func_map_def)
  3.1617 +next
  3.1618 +  case False note B2 = False
  3.1619 +  show ?thesis
  3.1620 +  proof safe
  3.1621 +    fix h assume h: "h \<in> Func B2 B1"
  3.1622 +    def j1 \<equiv> "inv_into A1 f1"
  3.1623 +    have "\<forall> a2 \<in> f2 ` B2. \<exists> b2. b2 \<in> B2 \<and> f2 b2 = a2" by blast
  3.1624 +    then obtain k where k: "\<forall> a2 \<in> f2 ` B2. k a2 \<in> B2 \<and> f2 (k a2) = a2"
  3.1625 +      by atomize_elim (rule bchoice)
  3.1626 +    {fix b2 assume b2: "b2 \<in> B2"
  3.1627 +     hence "f2 (k (f2 b2)) = f2 b2" using k A2(2) by auto
  3.1628 +     moreover have "k (f2 b2) \<in> B2" using b2 A2(2) k by auto
  3.1629 +     ultimately have "k (f2 b2) = b2" using b2 A2(1) unfolding inj_on_def by blast
  3.1630 +    } note kk = this
  3.1631 +    obtain b22 where b22: "b22 \<in> B2" using B2 by auto
  3.1632 +    def j2 \<equiv> "\<lambda> a2. if a2 \<in> f2 ` B2 then k a2 else b22"
  3.1633 +    have j2A2: "j2 ` A2 \<subseteq> B2" unfolding j2_def using k b22 by auto
  3.1634 +    have j2: "\<And> b2. b2 \<in> B2 \<Longrightarrow> j2 (f2 b2) = b2"
  3.1635 +    using kk unfolding j2_def by auto
  3.1636 +    def g \<equiv> "Func_map A2 j1 j2 h"
  3.1637 +    have "Func_map B2 f1 f2 g = h"
  3.1638 +    proof (rule ext)
  3.1639 +      fix b2 show "Func_map B2 f1 f2 g b2 = h b2"
  3.1640 +      proof(cases "b2 \<in> B2")
  3.1641 +        case True
  3.1642 +        show ?thesis
  3.1643 +        proof (cases "h b2 = undefined")
  3.1644 +          case True
  3.1645 +          hence b1: "h b2 \<in> f1 ` A1" using h `b2 \<in> B2` unfolding B1 Func_def by auto
  3.1646 +          show ?thesis using A2 f_inv_into_f[OF b1]
  3.1647 +            unfolding True g_def Func_map_def j1_def j2[OF `b2 \<in> B2`] by auto
  3.1648 +        qed(insert A2 True j2[OF True] h B1, unfold j1_def g_def Func_def Func_map_def,
  3.1649 +          auto intro: f_inv_into_f)
  3.1650 +      qed(insert h, unfold Func_def Func_map_def, auto)
  3.1651 +    qed
  3.1652 +    moreover have "g \<in> Func A2 A1" unfolding g_def apply(rule Func_map[OF h])
  3.1653 +    using j2A2 B1 A2 unfolding j1_def by (fast intro: inv_into_into)+
  3.1654 +    ultimately show "h \<in> Func_map B2 f1 f2 ` Func A2 A1"
  3.1655 +    unfolding Func_map_def[abs_def] by auto
  3.1656 +  qed(insert B1 Func_map[OF _ _ A2(2)], auto)
  3.1657 +qed
  3.1658 +
  3.1659 +end
     4.1 --- a/src/HOL/Cardinals/Cardinal_Arithmetic.thy	Mon Sep 01 16:34:38 2014 +0200
     4.2 +++ b/src/HOL/Cardinals/Cardinal_Arithmetic.thy	Mon Sep 01 16:34:39 2014 +0200
     4.3 @@ -219,7 +219,7 @@
     4.4  lemma czero_cexp: "Cnotzero r \<Longrightarrow> czero ^c r =o czero"
     4.5    by (drule Cnotzero_imp_not_empty) (simp add: cexp_def czero_def card_of_empty_ordIso)
     4.6  
     4.7 -lemma Func_singleton: 
     4.8 +lemma Func_singleton:
     4.9  fixes x :: 'b and A :: "'a set"
    4.10  shows "|Func A {x}| =o |{x}|"
    4.11  proof (rule ordIso_symmetric)
     5.1 --- a/src/HOL/Cardinals/Cardinal_Order_Relation.thy	Mon Sep 01 16:34:38 2014 +0200
     5.2 +++ b/src/HOL/Cardinals/Cardinal_Order_Relation.thy	Mon Sep 01 16:34:39 2014 +0200
     5.3 @@ -8,7 +8,7 @@
     5.4  header {* Cardinal-Order Relations *}
     5.5  
     5.6  theory Cardinal_Order_Relation
     5.7 -imports BNF_Cardinal_Order_Relation Constructions_on_Wellorders
     5.8 +imports BNF_Cardinal_Order_Relation Wellorder_Constructions
     5.9  begin
    5.10  
    5.11  declare
     6.1 --- a/src/HOL/Cardinals/Constructions_on_Wellorders.thy	Mon Sep 01 16:34:38 2014 +0200
     6.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     6.3 @@ -1,1077 +0,0 @@
     6.4 -(*  Title:      HOL/Cardinals/Constructions_on_Wellorders.thy
     6.5 -    Author:     Andrei Popescu, TU Muenchen
     6.6 -    Copyright   2012
     6.7 -
     6.8 -Constructions on wellorders.
     6.9 -*)
    6.10 -
    6.11 -header {* Constructions on Wellorders *}
    6.12 -
    6.13 -theory Constructions_on_Wellorders
    6.14 -imports
    6.15 -  BNF_Constructions_on_Wellorders Wellorder_Embedding Order_Union
    6.16 -  "../Library/Cardinal_Notations"
    6.17 -begin
    6.18 -
    6.19 -declare
    6.20 -  ordLeq_Well_order_simp[simp]
    6.21 -  not_ordLeq_iff_ordLess[simp]
    6.22 -  not_ordLess_iff_ordLeq[simp]
    6.23 -  Func_empty[simp]
    6.24 -  Func_is_emp[simp]
    6.25 -
    6.26 -lemma Func_emp2[simp]: "A \<noteq> {} \<Longrightarrow> Func A {} = {}" by auto
    6.27 -
    6.28 -
    6.29 -subsection {* Restriction to a set *}
    6.30 -
    6.31 -lemma Restr_incr2:
    6.32 -"r <= r' \<Longrightarrow> Restr r A <= Restr r' A"
    6.33 -by blast
    6.34 -
    6.35 -lemma Restr_incr:
    6.36 -"\<lbrakk>r \<le> r'; A \<le> A'\<rbrakk> \<Longrightarrow> Restr r A \<le> Restr r' A'"
    6.37 -by blast
    6.38 -
    6.39 -lemma Restr_Int:
    6.40 -"Restr (Restr r A) B = Restr r (A Int B)"
    6.41 -by blast
    6.42 -
    6.43 -lemma Restr_iff: "(a,b) : Restr r A = (a : A \<and> b : A \<and> (a,b) : r)"
    6.44 -by (auto simp add: Field_def)
    6.45 -
    6.46 -lemma Restr_subset1: "Restr r A \<le> r"
    6.47 -by auto
    6.48 -
    6.49 -lemma Restr_subset2: "Restr r A \<le> A \<times> A"
    6.50 -by auto
    6.51 -
    6.52 -lemma wf_Restr:
    6.53 -"wf r \<Longrightarrow> wf(Restr r A)"
    6.54 -using Restr_subset by (elim wf_subset) simp
    6.55 -
    6.56 -lemma Restr_incr1:
    6.57 -"A \<le> B \<Longrightarrow> Restr r A \<le> Restr r B"
    6.58 -by blast
    6.59 -
    6.60 -
    6.61 -subsection {* Order filters versus restrictions and embeddings *}
    6.62 -
    6.63 -lemma ofilter_Restr:
    6.64 -assumes WELL: "Well_order r" and
    6.65 -        OFA: "ofilter r A" and OFB: "ofilter r B" and SUB: "A \<le> B"
    6.66 -shows "ofilter (Restr r B) A"
    6.67 -proof-
    6.68 -  let ?rB = "Restr r B"
    6.69 -  have Well: "wo_rel r" unfolding wo_rel_def using WELL .
    6.70 -  hence Refl: "Refl r" by (auto simp add: wo_rel.REFL)
    6.71 -  hence Field: "Field ?rB = Field r Int B"
    6.72 -  using Refl_Field_Restr by blast
    6.73 -  have WellB: "wo_rel ?rB \<and> Well_order ?rB" using WELL
    6.74 -  by (auto simp add: Well_order_Restr wo_rel_def)
    6.75 -  (* Main proof *)
    6.76 -  show ?thesis
    6.77 -  proof(auto simp add: WellB wo_rel.ofilter_def)
    6.78 -    fix a assume "a \<in> A"
    6.79 -    hence "a \<in> Field r \<and> a \<in> B" using assms Well
    6.80 -    by (auto simp add: wo_rel.ofilter_def)
    6.81 -    with Field show "a \<in> Field(Restr r B)" by auto
    6.82 -  next
    6.83 -    fix a b assume *: "a \<in> A"  and "b \<in> under (Restr r B) a"
    6.84 -    hence "b \<in> under r a"
    6.85 -    using WELL OFB SUB ofilter_Restr_under[of r B a] by auto
    6.86 -    thus "b \<in> A" using * Well OFA by(auto simp add: wo_rel.ofilter_def)
    6.87 -  qed
    6.88 -qed
    6.89 -
    6.90 -lemma ofilter_subset_iso:
    6.91 -assumes WELL: "Well_order r" and
    6.92 -        OFA: "ofilter r A" and OFB: "ofilter r B"
    6.93 -shows "(A = B) = iso (Restr r A) (Restr r B) id"
    6.94 -using assms
    6.95 -by (auto simp add: ofilter_subset_embedS_iso)
    6.96 -
    6.97 -
    6.98 -subsection {* Ordering the well-orders by existence of embeddings *}
    6.99 -
   6.100 -corollary ordLeq_refl_on: "refl_on {r. Well_order r} ordLeq"
   6.101 -using ordLeq_reflexive unfolding ordLeq_def refl_on_def
   6.102 -by blast
   6.103 -
   6.104 -corollary ordLeq_trans: "trans ordLeq"
   6.105 -using trans_def[of ordLeq] ordLeq_transitive by blast
   6.106 -
   6.107 -corollary ordLeq_preorder_on: "preorder_on {r. Well_order r} ordLeq"
   6.108 -by(auto simp add: preorder_on_def ordLeq_refl_on ordLeq_trans)
   6.109 -
   6.110 -corollary ordIso_refl_on: "refl_on {r. Well_order r} ordIso"
   6.111 -using ordIso_reflexive unfolding refl_on_def ordIso_def
   6.112 -by blast
   6.113 -
   6.114 -corollary ordIso_trans: "trans ordIso"
   6.115 -using trans_def[of ordIso] ordIso_transitive by blast
   6.116 -
   6.117 -corollary ordIso_sym: "sym ordIso"
   6.118 -by (auto simp add: sym_def ordIso_symmetric)
   6.119 -
   6.120 -corollary ordIso_equiv: "equiv {r. Well_order r} ordIso"
   6.121 -by (auto simp add:  equiv_def ordIso_sym ordIso_refl_on ordIso_trans)
   6.122 -
   6.123 -lemma ordLess_Well_order_simp[simp]:
   6.124 -assumes "r <o r'"
   6.125 -shows "Well_order r \<and> Well_order r'"
   6.126 -using assms unfolding ordLess_def by simp
   6.127 -
   6.128 -lemma ordIso_Well_order_simp[simp]:
   6.129 -assumes "r =o r'"
   6.130 -shows "Well_order r \<and> Well_order r'"
   6.131 -using assms unfolding ordIso_def by simp
   6.132 -
   6.133 -lemma ordLess_irrefl: "irrefl ordLess"
   6.134 -by(unfold irrefl_def, auto simp add: ordLess_irreflexive)
   6.135 -
   6.136 -lemma ordLess_or_ordIso:
   6.137 -assumes WELL: "Well_order r" and WELL': "Well_order r'"
   6.138 -shows "r <o r' \<or> r' <o r \<or> r =o r'"
   6.139 -unfolding ordLess_def ordIso_def
   6.140 -using assms embedS_or_iso[of r r'] by auto
   6.141 -
   6.142 -corollary ordLeq_ordLess_Un_ordIso:
   6.143 -"ordLeq = ordLess \<union> ordIso"
   6.144 -by (auto simp add: ordLeq_iff_ordLess_or_ordIso)
   6.145 -
   6.146 -lemma not_ordLeq_ordLess:
   6.147 -"r \<le>o r' \<Longrightarrow> \<not> r' <o r"
   6.148 -using not_ordLess_ordLeq by blast
   6.149 -
   6.150 -lemma ordIso_or_ordLess:
   6.151 -assumes WELL: "Well_order r" and WELL': "Well_order r'"
   6.152 -shows "r =o r' \<or> r <o r' \<or> r' <o r"
   6.153 -using assms ordLess_or_ordLeq ordLeq_iff_ordLess_or_ordIso by blast
   6.154 -
   6.155 -lemmas ord_trans = ordIso_transitive ordLeq_transitive ordLess_transitive
   6.156 -                   ordIso_ordLeq_trans ordLeq_ordIso_trans
   6.157 -                   ordIso_ordLess_trans ordLess_ordIso_trans
   6.158 -                   ordLess_ordLeq_trans ordLeq_ordLess_trans
   6.159 -
   6.160 -lemma ofilter_ordLeq:
   6.161 -assumes "Well_order r" and "ofilter r A"
   6.162 -shows "Restr r A \<le>o r"
   6.163 -proof-
   6.164 -  have "A \<le> Field r" using assms by (auto simp add: wo_rel_def wo_rel.ofilter_def)
   6.165 -  thus ?thesis using assms
   6.166 -  by (simp add: ofilter_subset_ordLeq wo_rel.Field_ofilter
   6.167 -      wo_rel_def Restr_Field)
   6.168 -qed
   6.169 -
   6.170 -corollary under_Restr_ordLeq:
   6.171 -"Well_order r \<Longrightarrow> Restr r (under r a) \<le>o r"
   6.172 -by (auto simp add: ofilter_ordLeq wo_rel.under_ofilter wo_rel_def)
   6.173 -
   6.174 -
   6.175 -subsection {* Copy via direct images *}
   6.176 -
   6.177 -lemma Id_dir_image: "dir_image Id f \<le> Id"
   6.178 -unfolding dir_image_def by auto
   6.179 -
   6.180 -lemma Un_dir_image:
   6.181 -"dir_image (r1 \<union> r2) f = (dir_image r1 f) \<union> (dir_image r2 f)"
   6.182 -unfolding dir_image_def by auto
   6.183 -
   6.184 -lemma Int_dir_image:
   6.185 -assumes "inj_on f (Field r1 \<union> Field r2)"
   6.186 -shows "dir_image (r1 Int r2) f = (dir_image r1 f) Int (dir_image r2 f)"
   6.187 -proof
   6.188 -  show "dir_image (r1 Int r2) f \<le> (dir_image r1 f) Int (dir_image r2 f)"
   6.189 -  using assms unfolding dir_image_def inj_on_def by auto
   6.190 -next
   6.191 -  show "(dir_image r1 f) Int (dir_image r2 f) \<le> dir_image (r1 Int r2) f"
   6.192 -  proof(clarify)
   6.193 -    fix a' b'
   6.194 -    assume "(a',b') \<in> dir_image r1 f" "(a',b') \<in> dir_image r2 f"
   6.195 -    then obtain a1 b1 a2 b2
   6.196 -    where 1: "a' = f a1 \<and> b' = f b1 \<and> a' = f a2 \<and> b' = f b2" and
   6.197 -          2: "(a1,b1) \<in> r1 \<and> (a2,b2) \<in> r2" and
   6.198 -          3: "{a1,b1} \<le> Field r1 \<and> {a2,b2} \<le> Field r2"
   6.199 -    unfolding dir_image_def Field_def by blast
   6.200 -    hence "a1 = a2 \<and> b1 = b2" using assms unfolding inj_on_def by auto
   6.201 -    hence "a' = f a1 \<and> b' = f b1 \<and> (a1,b1) \<in> r1 Int r2 \<and> (a2,b2) \<in> r1 Int r2"
   6.202 -    using 1 2 by auto
   6.203 -    thus "(a',b') \<in> dir_image (r1 \<inter> r2) f"
   6.204 -    unfolding dir_image_def by blast
   6.205 -  qed
   6.206 -qed
   6.207 -
   6.208 -(* More facts on ordinal sum: *)
   6.209 -
   6.210 -lemma Osum_embed:
   6.211 -assumes FLD: "Field r Int Field r' = {}" and
   6.212 -        WELL: "Well_order r" and WELL': "Well_order r'"
   6.213 -shows "embed r (r Osum r') id"
   6.214 -proof-
   6.215 -  have 1: "Well_order (r Osum r')"
   6.216 -  using assms by (auto simp add: Osum_Well_order)
   6.217 -  moreover
   6.218 -  have "compat r (r Osum r') id"
   6.219 -  unfolding compat_def Osum_def by auto
   6.220 -  moreover
   6.221 -  have "inj_on id (Field r)" by simp
   6.222 -  moreover
   6.223 -  have "ofilter (r Osum r') (Field r)"
   6.224 -  using 1 proof(auto simp add: wo_rel_def wo_rel.ofilter_def
   6.225 -                               Field_Osum under_def)
   6.226 -    fix a b assume 2: "a \<in> Field r" and 3: "(b,a) \<in> r Osum r'"
   6.227 -    moreover
   6.228 -    {assume "(b,a) \<in> r'"
   6.229 -     hence "a \<in> Field r'" using Field_def[of r'] by blast
   6.230 -     hence False using 2 FLD by blast
   6.231 -    }
   6.232 -    moreover
   6.233 -    {assume "a \<in> Field r'"
   6.234 -     hence False using 2 FLD by blast
   6.235 -    }
   6.236 -    ultimately
   6.237 -    show "b \<in> Field r" by (auto simp add: Osum_def Field_def)
   6.238 -  qed
   6.239 -  ultimately show ?thesis
   6.240 -  using assms by (auto simp add: embed_iff_compat_inj_on_ofilter)
   6.241 -qed
   6.242 -
   6.243 -corollary Osum_ordLeq:
   6.244 -assumes FLD: "Field r Int Field r' = {}" and
   6.245 -        WELL: "Well_order r" and WELL': "Well_order r'"
   6.246 -shows "r \<le>o r Osum r'"
   6.247 -using assms Osum_embed Osum_Well_order
   6.248 -unfolding ordLeq_def by blast
   6.249 -
   6.250 -lemma Well_order_embed_copy:
   6.251 -assumes WELL: "well_order_on A r" and
   6.252 -        INJ: "inj_on f A" and SUB: "f ` A \<le> B"
   6.253 -shows "\<exists>r'. well_order_on B r' \<and> r \<le>o r'"
   6.254 -proof-
   6.255 -  have "bij_betw f A (f ` A)"
   6.256 -  using INJ inj_on_imp_bij_betw by blast
   6.257 -  then obtain r'' where "well_order_on (f ` A) r''" and 1: "r =o r''"
   6.258 -  using WELL  Well_order_iso_copy by blast
   6.259 -  hence 2: "Well_order r'' \<and> Field r'' = (f ` A)"
   6.260 -  using well_order_on_Well_order by blast
   6.261 -  (*  *)
   6.262 -  let ?C = "B - (f ` A)"
   6.263 -  obtain r''' where "well_order_on ?C r'''"
   6.264 -  using well_order_on by blast
   6.265 -  hence 3: "Well_order r''' \<and> Field r''' = ?C"
   6.266 -  using well_order_on_Well_order by blast
   6.267 -  (*  *)
   6.268 -  let ?r' = "r'' Osum r'''"
   6.269 -  have "Field r'' Int Field r''' = {}"
   6.270 -  using 2 3 by auto
   6.271 -  hence "r'' \<le>o ?r'" using Osum_ordLeq[of r'' r'''] 2 3 by blast
   6.272 -  hence 4: "r \<le>o ?r'" using 1 ordIso_ordLeq_trans by blast
   6.273 -  (*  *)
   6.274 -  hence "Well_order ?r'" unfolding ordLeq_def by auto
   6.275 -  moreover
   6.276 -  have "Field ?r' = B" using 2 3 SUB by (auto simp add: Field_Osum)
   6.277 -  ultimately show ?thesis using 4 by blast
   6.278 -qed
   6.279 -
   6.280 -
   6.281 -subsection {* The maxim among a finite set of ordinals *}
   6.282 -
   6.283 -text {* The correct phrasing would be ``a maxim of ...", as @{text "\<le>o"} is only a preorder. *}
   6.284 -
   6.285 -definition isOmax :: "'a rel set \<Rightarrow> 'a rel \<Rightarrow> bool"
   6.286 -where
   6.287 -"isOmax  R r == r \<in> R \<and> (ALL r' : R. r' \<le>o r)"
   6.288 -
   6.289 -definition omax :: "'a rel set \<Rightarrow> 'a rel"
   6.290 -where
   6.291 -"omax R == SOME r. isOmax R r"
   6.292 -
   6.293 -lemma exists_isOmax:
   6.294 -assumes "finite R" and "R \<noteq> {}" and "\<forall> r \<in> R. Well_order r"
   6.295 -shows "\<exists> r. isOmax R r"
   6.296 -proof-
   6.297 -  have "finite R \<Longrightarrow> R \<noteq> {} \<longrightarrow> (\<forall> r \<in> R. Well_order r) \<longrightarrow> (\<exists> r. isOmax R r)"
   6.298 -  apply(erule finite_induct) apply(simp add: isOmax_def)
   6.299 -  proof(clarsimp)
   6.300 -    fix r :: "('a \<times> 'a) set" and R assume *: "finite R" and **: "r \<notin> R"
   6.301 -    and ***: "Well_order r" and ****: "\<forall>r\<in>R. Well_order r"
   6.302 -    and IH: "R \<noteq> {} \<longrightarrow> (\<exists>p. isOmax R p)"
   6.303 -    let ?R' = "insert r R"
   6.304 -    show "\<exists>p'. (isOmax ?R' p')"
   6.305 -    proof(cases "R = {}")
   6.306 -      assume Case1: "R = {}"
   6.307 -      thus ?thesis unfolding isOmax_def using ***
   6.308 -      by (simp add: ordLeq_reflexive)
   6.309 -    next
   6.310 -      assume Case2: "R \<noteq> {}"
   6.311 -      then obtain p where p: "isOmax R p" using IH by auto
   6.312 -      hence 1: "Well_order p" using **** unfolding isOmax_def by simp
   6.313 -      {assume Case21: "r \<le>o p"
   6.314 -       hence "isOmax ?R' p" using p unfolding isOmax_def by simp
   6.315 -       hence ?thesis by auto
   6.316 -      }
   6.317 -      moreover
   6.318 -      {assume Case22: "p \<le>o r"
   6.319 -       {fix r' assume "r' \<in> ?R'"
   6.320 -        moreover
   6.321 -        {assume "r' \<in> R"
   6.322 -         hence "r' \<le>o p" using p unfolding isOmax_def by simp
   6.323 -         hence "r' \<le>o r" using Case22 by(rule ordLeq_transitive)
   6.324 -        }
   6.325 -        moreover have "r \<le>o r" using *** by(rule ordLeq_reflexive)
   6.326 -        ultimately have "r' \<le>o r" by auto
   6.327 -       }
   6.328 -       hence "isOmax ?R' r" unfolding isOmax_def by simp
   6.329 -       hence ?thesis by auto
   6.330 -      }
   6.331 -      moreover have "r \<le>o p \<or> p \<le>o r"
   6.332 -      using 1 *** ordLeq_total by auto
   6.333 -      ultimately show ?thesis by blast
   6.334 -    qed
   6.335 -  qed
   6.336 -  thus ?thesis using assms by auto
   6.337 -qed
   6.338 -
   6.339 -lemma omax_isOmax:
   6.340 -assumes "finite R" and "R \<noteq> {}" and "\<forall> r \<in> R. Well_order r"
   6.341 -shows "isOmax R (omax R)"
   6.342 -unfolding omax_def using assms
   6.343 -by(simp add: exists_isOmax someI_ex)
   6.344 -
   6.345 -lemma omax_in:
   6.346 -assumes "finite R" and "R \<noteq> {}" and "\<forall> r \<in> R. Well_order r"
   6.347 -shows "omax R \<in> R"
   6.348 -using assms omax_isOmax unfolding isOmax_def by blast
   6.349 -
   6.350 -lemma Well_order_omax:
   6.351 -assumes "finite R" and "R \<noteq> {}" and "\<forall>r\<in>R. Well_order r"
   6.352 -shows "Well_order (omax R)"
   6.353 -using assms apply - apply(drule omax_in) by auto
   6.354 -
   6.355 -lemma omax_maxim:
   6.356 -assumes "finite R" and "\<forall> r \<in> R. Well_order r" and "r \<in> R"
   6.357 -shows "r \<le>o omax R"
   6.358 -using assms omax_isOmax unfolding isOmax_def by blast
   6.359 -
   6.360 -lemma omax_ordLeq:
   6.361 -assumes "finite R" and "R \<noteq> {}" and *: "\<forall> r \<in> R. r \<le>o p"
   6.362 -shows "omax R \<le>o p"
   6.363 -proof-
   6.364 -  have "\<forall> r \<in> R. Well_order r" using * unfolding ordLeq_def by simp
   6.365 -  thus ?thesis using assms omax_in by auto
   6.366 -qed
   6.367 -
   6.368 -lemma omax_ordLess:
   6.369 -assumes "finite R" and "R \<noteq> {}" and *: "\<forall> r \<in> R. r <o p"
   6.370 -shows "omax R <o p"
   6.371 -proof-
   6.372 -  have "\<forall> r \<in> R. Well_order r" using * unfolding ordLess_def by simp
   6.373 -  thus ?thesis using assms omax_in by auto
   6.374 -qed
   6.375 -
   6.376 -lemma omax_ordLeq_elim:
   6.377 -assumes "finite R" and "\<forall> r \<in> R. Well_order r"
   6.378 -and "omax R \<le>o p" and "r \<in> R"
   6.379 -shows "r \<le>o p"
   6.380 -using assms omax_maxim[of R r] apply simp
   6.381 -using ordLeq_transitive by blast
   6.382 -
   6.383 -lemma omax_ordLess_elim:
   6.384 -assumes "finite R" and "\<forall> r \<in> R. Well_order r"
   6.385 -and "omax R <o p" and "r \<in> R"
   6.386 -shows "r <o p"
   6.387 -using assms omax_maxim[of R r] apply simp
   6.388 -using ordLeq_ordLess_trans by blast
   6.389 -
   6.390 -lemma ordLeq_omax:
   6.391 -assumes "finite R" and "\<forall> r \<in> R. Well_order r"
   6.392 -and "r \<in> R" and "p \<le>o r"
   6.393 -shows "p \<le>o omax R"
   6.394 -using assms omax_maxim[of R r] apply simp
   6.395 -using ordLeq_transitive by blast
   6.396 -
   6.397 -lemma ordLess_omax:
   6.398 -assumes "finite R" and "\<forall> r \<in> R. Well_order r"
   6.399 -and "r \<in> R" and "p <o r"
   6.400 -shows "p <o omax R"
   6.401 -using assms omax_maxim[of R r] apply simp
   6.402 -using ordLess_ordLeq_trans by blast
   6.403 -
   6.404 -lemma omax_ordLeq_mono:
   6.405 -assumes P: "finite P" and R: "finite R"
   6.406 -and NE_P: "P \<noteq> {}" and Well_R: "\<forall> r \<in> R. Well_order r"
   6.407 -and LEQ: "\<forall> p \<in> P. \<exists> r \<in> R. p \<le>o r"
   6.408 -shows "omax P \<le>o omax R"
   6.409 -proof-
   6.410 -  let ?mp = "omax P"  let ?mr = "omax R"
   6.411 -  {fix p assume "p : P"
   6.412 -   then obtain r where r: "r : R" and "p \<le>o r"
   6.413 -   using LEQ by blast
   6.414 -   moreover have "r <=o ?mr"
   6.415 -   using r R Well_R omax_maxim by blast
   6.416 -   ultimately have "p <=o ?mr"
   6.417 -   using ordLeq_transitive by blast
   6.418 -  }
   6.419 -  thus "?mp <=o ?mr"
   6.420 -  using NE_P P using omax_ordLeq by blast
   6.421 -qed
   6.422 -
   6.423 -lemma omax_ordLess_mono:
   6.424 -assumes P: "finite P" and R: "finite R"
   6.425 -and NE_P: "P \<noteq> {}" and Well_R: "\<forall> r \<in> R. Well_order r"
   6.426 -and LEQ: "\<forall> p \<in> P. \<exists> r \<in> R. p <o r"
   6.427 -shows "omax P <o omax R"
   6.428 -proof-
   6.429 -  let ?mp = "omax P"  let ?mr = "omax R"
   6.430 -  {fix p assume "p : P"
   6.431 -   then obtain r where r: "r : R" and "p <o r"
   6.432 -   using LEQ by blast
   6.433 -   moreover have "r <=o ?mr"
   6.434 -   using r R Well_R omax_maxim by blast
   6.435 -   ultimately have "p <o ?mr"
   6.436 -   using ordLess_ordLeq_trans by blast
   6.437 -  }
   6.438 -  thus "?mp <o ?mr"
   6.439 -  using NE_P P omax_ordLess by blast
   6.440 -qed
   6.441 -
   6.442 -
   6.443 -subsection {* Limit and succesor ordinals *}
   6.444 -
   6.445 -lemma embed_underS2:
   6.446 -assumes r: "Well_order r" and s: "Well_order s"  and g: "embed r s g" and a: "a \<in> Field r"
   6.447 -shows "g ` underS r a = underS s (g a)"
   6.448 -using embed_underS[OF assms] unfolding bij_betw_def by auto
   6.449 -
   6.450 -lemma bij_betw_insert:
   6.451 -assumes "b \<notin> A" and "f b \<notin> A'" and "bij_betw f A A'"
   6.452 -shows "bij_betw f (insert b A) (insert (f b) A')"
   6.453 -using notIn_Un_bij_betw[OF assms] by auto
   6.454 -
   6.455 -context wo_rel
   6.456 -begin
   6.457 -
   6.458 -lemma underS_induct:
   6.459 -  assumes "\<And>a. (\<And> a1. a1 \<in> underS a \<Longrightarrow> P a1) \<Longrightarrow> P a"
   6.460 -  shows "P a"
   6.461 -  by (induct rule: well_order_induct) (rule assms, simp add: underS_def)
   6.462 -
   6.463 -lemma suc_underS:
   6.464 -assumes B: "B \<subseteq> Field r" and A: "AboveS B \<noteq> {}" and b: "b \<in> B"
   6.465 -shows "b \<in> underS (suc B)"
   6.466 -using suc_AboveS[OF B A] b unfolding underS_def AboveS_def by auto
   6.467 -
   6.468 -lemma underS_supr:
   6.469 -assumes bA: "b \<in> underS (supr A)" and A: "A \<subseteq> Field r"
   6.470 -shows "\<exists> a \<in> A. b \<in> underS a"
   6.471 -proof(rule ccontr, auto)
   6.472 -  have bb: "b \<in> Field r" using bA unfolding underS_def Field_def by auto
   6.473 -  assume "\<forall>a\<in>A.  b \<notin> underS a"
   6.474 -  hence 0: "\<forall>a \<in> A. (a,b) \<in> r" using A bA unfolding underS_def
   6.475 -  by simp (metis REFL in_mono max2_def max2_greater refl_on_domain)
   6.476 -  have "(supr A, b) \<in> r" apply(rule supr_least[OF A bb]) using 0 by auto
   6.477 -  thus False using bA unfolding underS_def by simp (metis ANTISYM antisymD)
   6.478 -qed
   6.479 -
   6.480 -lemma underS_suc:
   6.481 -assumes bA: "b \<in> underS (suc A)" and A: "A \<subseteq> Field r"
   6.482 -shows "\<exists> a \<in> A. b \<in> under a"
   6.483 -proof(rule ccontr, auto)
   6.484 -  have bb: "b \<in> Field r" using bA unfolding underS_def Field_def by auto
   6.485 -  assume "\<forall>a\<in>A.  b \<notin> under a"
   6.486 -  hence 0: "\<forall>a \<in> A. a \<in> underS b" using A bA unfolding underS_def
   6.487 -  by simp (metis (lifting) bb max2_def max2_greater mem_Collect_eq under_def set_rev_mp)
   6.488 -  have "(suc A, b) \<in> r" apply(rule suc_least[OF A bb]) using 0 unfolding underS_def by auto
   6.489 -  thus False using bA unfolding underS_def by simp (metis ANTISYM antisymD)
   6.490 -qed
   6.491 -
   6.492 -lemma (in wo_rel) in_underS_supr:
   6.493 -assumes j: "j \<in> underS i" and i: "i \<in> A" and A: "A \<subseteq> Field r" and AA: "Above A \<noteq> {}"
   6.494 -shows "j \<in> underS (supr A)"
   6.495 -proof-
   6.496 -  have "(i,supr A) \<in> r" using supr_greater[OF A AA i] .
   6.497 -  thus ?thesis using j unfolding underS_def
   6.498 -  by simp (metis REFL TRANS max2_def max2_equals1 refl_on_domain transD)
   6.499 -qed
   6.500 -
   6.501 -lemma inj_on_Field:
   6.502 -assumes A: "A \<subseteq> Field r" and f: "\<And> a b. \<lbrakk>a \<in> A; b \<in> A; a \<in> underS b\<rbrakk> \<Longrightarrow> f a \<noteq> f b"
   6.503 -shows "inj_on f A"
   6.504 -unfolding inj_on_def proof safe
   6.505 -  fix a b assume a: "a \<in> A" and b: "b \<in> A" and fab: "f a = f b"
   6.506 -  {assume "a \<in> underS b"
   6.507 -   hence False using f[OF a b] fab by auto
   6.508 -  }
   6.509 -  moreover
   6.510 -  {assume "b \<in> underS a"
   6.511 -   hence False using f[OF b a] fab by auto
   6.512 -  }
   6.513 -  ultimately show "a = b" using TOTALS A a b unfolding underS_def by auto
   6.514 -qed
   6.515 -
   6.516 -lemma in_notinI:
   6.517 -assumes "(j,i) \<notin> r \<or> j = i" and "i \<in> Field r" and "j \<in> Field r"
   6.518 -shows "(i,j) \<in> r" by (metis assms max2_def max2_greater_among)
   6.519 -
   6.520 -lemma ofilter_init_seg_of:
   6.521 -assumes "ofilter F"
   6.522 -shows "Restr r F initial_segment_of r"
   6.523 -using assms unfolding ofilter_def init_seg_of_def under_def by auto
   6.524 -
   6.525 -lemma underS_init_seg_of_Collect:
   6.526 -assumes "\<And>j1 j2. \<lbrakk>j2 \<in> underS i; (j1, j2) \<in> r\<rbrakk> \<Longrightarrow> R j1 initial_segment_of R j2"
   6.527 -shows "{R j |j. j \<in> underS i} \<in> Chains init_seg_of"
   6.528 -unfolding Chains_def proof safe
   6.529 -  fix j ja assume jS: "j \<in> underS i" and jaS: "ja \<in> underS i"
   6.530 -  and init: "(R ja, R j) \<notin> init_seg_of"
   6.531 -  hence jja: "{j,ja} \<subseteq> Field r" and j: "j \<in> Field r" and ja: "ja \<in> Field r"
   6.532 -  and jjai: "(j,i) \<in> r" "(ja,i) \<in> r"
   6.533 -  and i: "i \<notin> {j,ja}" unfolding Field_def underS_def by auto
   6.534 -  have jj: "(j,j) \<in> r" and jaja: "(ja,ja) \<in> r" using j ja by (metis in_notinI)+
   6.535 -  show "R j initial_segment_of R ja"
   6.536 -  using jja init jjai i
   6.537 -  by (elim cases_Total3 disjE) (auto elim: cases_Total3 intro!: assms simp: underS_def)
   6.538 -qed
   6.539 -
   6.540 -lemma (in wo_rel) Field_init_seg_of_Collect:
   6.541 -assumes "\<And>j1 j2. \<lbrakk>j2 \<in> Field r; (j1, j2) \<in> r\<rbrakk> \<Longrightarrow> R j1 initial_segment_of R j2"
   6.542 -shows "{R j |j. j \<in> Field r} \<in> Chains init_seg_of"
   6.543 -unfolding Chains_def proof safe
   6.544 -  fix j ja assume jS: "j \<in> Field r" and jaS: "ja \<in> Field r"
   6.545 -  and init: "(R ja, R j) \<notin> init_seg_of"
   6.546 -  hence jja: "{j,ja} \<subseteq> Field r" and j: "j \<in> Field r" and ja: "ja \<in> Field r"
   6.547 -  unfolding Field_def underS_def by auto
   6.548 -  have jj: "(j,j) \<in> r" and jaja: "(ja,ja) \<in> r" using j ja by (metis in_notinI)+
   6.549 -  show "R j initial_segment_of R ja"
   6.550 -  using jja init
   6.551 -  by (elim cases_Total3 disjE) (auto elim: cases_Total3 intro!: assms simp: Field_def)
   6.552 -qed
   6.553 -
   6.554 -subsubsection {* Successor and limit elements of an ordinal *}
   6.555 -
   6.556 -definition "succ i \<equiv> suc {i}"
   6.557 -
   6.558 -definition "isSucc i \<equiv> \<exists> j. aboveS j \<noteq> {} \<and> i = succ j"
   6.559 -
   6.560 -definition "zero = minim (Field r)"
   6.561 -
   6.562 -definition "isLim i \<equiv> \<not> isSucc i"
   6.563 -
   6.564 -lemma zero_smallest[simp]:
   6.565 -assumes "j \<in> Field r" shows "(zero, j) \<in> r"
   6.566 -unfolding zero_def
   6.567 -by (metis AboveS_Field assms subset_AboveS_UnderS subset_antisym subset_refl suc_def suc_least_AboveS)
   6.568 -
   6.569 -lemma zero_in_Field: assumes "Field r \<noteq> {}"  shows "zero \<in> Field r"
   6.570 -using assms unfolding zero_def by (metis Field_ofilter minim_in ofilter_def)
   6.571 -
   6.572 -lemma leq_zero_imp[simp]:
   6.573 -"(x, zero) \<in> r \<Longrightarrow> x = zero"
   6.574 -by (metis ANTISYM WELL antisymD well_order_on_domain zero_smallest)
   6.575 -
   6.576 -lemma leq_zero[simp]:
   6.577 -assumes "Field r \<noteq> {}"  shows "(x, zero) \<in> r \<longleftrightarrow> x = zero"
   6.578 -using zero_in_Field[OF assms] in_notinI[of x zero] by auto
   6.579 -
   6.580 -lemma under_zero[simp]:
   6.581 -assumes "Field r \<noteq> {}" shows "under zero = {zero}"
   6.582 -using assms unfolding under_def by auto
   6.583 -
   6.584 -lemma underS_zero[simp,intro]: "underS zero = {}"
   6.585 -unfolding underS_def by auto
   6.586 -
   6.587 -lemma isSucc_succ: "aboveS i \<noteq> {} \<Longrightarrow> isSucc (succ i)"
   6.588 -unfolding isSucc_def succ_def by auto
   6.589 -
   6.590 -lemma succ_in_diff:
   6.591 -assumes "aboveS i \<noteq> {}"  shows "(i,succ i) \<in> r \<and> succ i \<noteq> i"
   6.592 -using assms suc_greater[of "{i}"] unfolding succ_def AboveS_def aboveS_def Field_def by auto
   6.593 -
   6.594 -lemmas succ_in[simp] = succ_in_diff[THEN conjunct1]
   6.595 -lemmas succ_diff[simp] = succ_in_diff[THEN conjunct2]
   6.596 -
   6.597 -lemma succ_in_Field[simp]:
   6.598 -assumes "aboveS i \<noteq> {}"  shows "succ i \<in> Field r"
   6.599 -using succ_in[OF assms] unfolding Field_def by auto
   6.600 -
   6.601 -lemma succ_not_in:
   6.602 -assumes "aboveS i \<noteq> {}" shows "(succ i, i) \<notin> r"
   6.603 -proof
   6.604 -  assume 1: "(succ i, i) \<in> r"
   6.605 -  hence "succ i \<in> Field r \<and> i \<in> Field r" unfolding Field_def by auto
   6.606 -  hence "(i, succ i) \<in> r \<and> succ i \<noteq> i" using assms by auto
   6.607 -  thus False using 1 by (metis ANTISYM antisymD)
   6.608 -qed
   6.609 -
   6.610 -lemma not_isSucc_zero: "\<not> isSucc zero"
   6.611 -proof
   6.612 -  assume "isSucc zero"
   6.613 -  moreover
   6.614 -  then obtain i where "aboveS i \<noteq> {}" and 1: "minim (Field r) = succ i"
   6.615 -  unfolding isSucc_def zero_def by auto
   6.616 -  hence "succ i \<in> Field r" by auto
   6.617 -  ultimately show False by (metis REFL isSucc_def minim_least refl_on_domain
   6.618 -    subset_refl succ_in succ_not_in zero_def)
   6.619 -qed
   6.620 -
   6.621 -lemma isLim_zero[simp]: "isLim zero"
   6.622 -  by (metis isLim_def not_isSucc_zero)
   6.623 -
   6.624 -lemma succ_smallest:
   6.625 -assumes "(i,j) \<in> r" and "i \<noteq> j"
   6.626 -shows "(succ i, j) \<in> r"
   6.627 -unfolding succ_def apply(rule suc_least)
   6.628 -using assms unfolding Field_def by auto
   6.629 -
   6.630 -lemma isLim_supr:
   6.631 -assumes f: "i \<in> Field r" and l: "isLim i"
   6.632 -shows "i = supr (underS i)"
   6.633 -proof(rule equals_supr)
   6.634 -  fix j assume j: "j \<in> Field r" and 1: "\<And> j'. j' \<in> underS i \<Longrightarrow> (j',j) \<in> r"
   6.635 -  show "(i,j) \<in> r" proof(intro in_notinI[OF _ f j], safe)
   6.636 -    assume ji: "(j,i) \<in> r" "j \<noteq> i"
   6.637 -    hence a: "aboveS j \<noteq> {}" unfolding aboveS_def by auto
   6.638 -    hence "i \<noteq> succ j" using l unfolding isLim_def isSucc_def by auto
   6.639 -    moreover have "(succ j, i) \<in> r" using succ_smallest[OF ji] by auto
   6.640 -    ultimately have "succ j \<in> underS i" unfolding underS_def by auto
   6.641 -    hence "(succ j, j) \<in> r" using 1 by auto
   6.642 -    thus False using succ_not_in[OF a] by simp
   6.643 -  qed
   6.644 -qed(insert f, unfold underS_def Field_def, auto)
   6.645 -
   6.646 -definition "pred i \<equiv> SOME j. j \<in> Field r \<and> aboveS j \<noteq> {} \<and> succ j = i"
   6.647 -
   6.648 -lemma pred_Field_succ:
   6.649 -assumes "isSucc i" shows "pred i \<in> Field r \<and> aboveS (pred i) \<noteq> {} \<and> succ (pred i) = i"
   6.650 -proof-
   6.651 -  obtain j where a: "aboveS j \<noteq> {}" and i: "i = succ j" using assms unfolding isSucc_def by auto
   6.652 -  have 1: "j \<in> Field r" "j \<noteq> i" unfolding Field_def i
   6.653 -  using succ_diff[OF a] a unfolding aboveS_def by auto
   6.654 -  show ?thesis unfolding pred_def apply(rule someI_ex) using 1 i a by auto
   6.655 -qed
   6.656 -
   6.657 -lemmas pred_Field[simp] = pred_Field_succ[THEN conjunct1]
   6.658 -lemmas aboveS_pred[simp] = pred_Field_succ[THEN conjunct2, THEN conjunct1]
   6.659 -lemmas succ_pred[simp] = pred_Field_succ[THEN conjunct2, THEN conjunct2]
   6.660 -
   6.661 -lemma isSucc_pred_in:
   6.662 -assumes "isSucc i"  shows "(pred i, i) \<in> r"
   6.663 -proof-
   6.664 -  def j \<equiv> "pred i"
   6.665 -  have i: "i = succ j" using assms unfolding j_def by simp
   6.666 -  have a: "aboveS j \<noteq> {}" unfolding j_def using assms by auto
   6.667 -  show ?thesis unfolding j_def[symmetric] unfolding i using succ_in[OF a] .
   6.668 -qed
   6.669 -
   6.670 -lemma isSucc_pred_diff:
   6.671 -assumes "isSucc i"  shows "pred i \<noteq> i"
   6.672 -by (metis aboveS_pred assms succ_diff succ_pred)
   6.673 -
   6.674 -(* todo: pred maximal, pred injective? *)
   6.675 -
   6.676 -lemma succ_inj[simp]:
   6.677 -assumes "aboveS i \<noteq> {}" and "aboveS j \<noteq> {}"
   6.678 -shows "succ i = succ j \<longleftrightarrow> i = j"
   6.679 -proof safe
   6.680 -  assume s: "succ i = succ j"
   6.681 -  {assume "i \<noteq> j" and "(i,j) \<in> r"
   6.682 -   hence "(succ i, j) \<in> r" using assms by (metis succ_smallest)
   6.683 -   hence False using s assms by (metis succ_not_in)
   6.684 -  }
   6.685 -  moreover
   6.686 -  {assume "i \<noteq> j" and "(j,i) \<in> r"
   6.687 -   hence "(succ j, i) \<in> r" using assms by (metis succ_smallest)
   6.688 -   hence False using s assms by (metis succ_not_in)
   6.689 -  }
   6.690 -  ultimately show "i = j" by (metis TOTALS WELL assms(1) assms(2) succ_in_diff well_order_on_domain)
   6.691 -qed
   6.692 -
   6.693 -lemma pred_succ[simp]:
   6.694 -assumes "aboveS j \<noteq> {}"  shows "pred (succ j) = j"
   6.695 -unfolding pred_def apply(rule some_equality)
   6.696 -using assms apply(force simp: Field_def aboveS_def)
   6.697 -by (metis assms succ_inj)
   6.698 -
   6.699 -lemma less_succ[simp]:
   6.700 -assumes "aboveS i \<noteq> {}"
   6.701 -shows "(j, succ i) \<in> r \<longleftrightarrow> (j,i) \<in> r \<or> j = succ i"
   6.702 -apply safe
   6.703 -  apply (metis WELL assms in_notinI well_order_on_domain suc_singl_pred succ_def succ_in_diff)
   6.704 -  apply (metis (hide_lams, full_types) REFL TRANS assms max2_def max2_equals1 refl_on_domain succ_in_Field succ_not_in transD)
   6.705 -  apply (metis assms in_notinI succ_in_Field)
   6.706 -done
   6.707 -
   6.708 -lemma underS_succ[simp]:
   6.709 -assumes "aboveS i \<noteq> {}"
   6.710 -shows "underS (succ i) = under i"
   6.711 -unfolding underS_def under_def by (auto simp: assms succ_not_in)
   6.712 -
   6.713 -lemma succ_mono:
   6.714 -assumes "aboveS j \<noteq> {}" and "(i,j) \<in> r"
   6.715 -shows "(succ i, succ j) \<in> r"
   6.716 -by (metis (full_types) assms less_succ succ_smallest)
   6.717 -
   6.718 -lemma under_succ[simp]:
   6.719 -assumes "aboveS i \<noteq> {}"
   6.720 -shows "under (succ i) = insert (succ i) (under i)"
   6.721 -using less_succ[OF assms] unfolding under_def by auto
   6.722 -
   6.723 -definition mergeSL :: "('a \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> (('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b"
   6.724 -where
   6.725 -"mergeSL S L f i \<equiv>
   6.726 - if isSucc i then S (pred i) (f (pred i))
   6.727 - else L f i"
   6.728 -
   6.729 -
   6.730 -subsubsection {* Well-order recursion with (zero), succesor, and limit *}
   6.731 -
   6.732 -definition worecSL :: "('a \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> (('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b"
   6.733 -where "worecSL S L \<equiv> worec (mergeSL S L)"
   6.734 -
   6.735 -definition "adm_woL L \<equiv> \<forall>f g i. isLim i \<and> (\<forall>j\<in>underS i. f j = g j) \<longrightarrow> L f i = L g i"
   6.736 -
   6.737 -lemma mergeSL:
   6.738 -assumes "adm_woL L"  shows "adm_wo (mergeSL S L)"
   6.739 -unfolding adm_wo_def proof safe
   6.740 -  fix f g :: "'a => 'b" and i :: 'a
   6.741 -  assume 1: "\<forall>j\<in>underS i. f j = g j"
   6.742 -  show "mergeSL S L f i = mergeSL S L g i"
   6.743 -  proof(cases "isSucc i")
   6.744 -    case True
   6.745 -    hence "pred i \<in> underS i" unfolding underS_def using isSucc_pred_in isSucc_pred_diff by auto
   6.746 -    thus ?thesis using True 1 unfolding mergeSL_def by auto
   6.747 -  next
   6.748 -    case False hence "isLim i" unfolding isLim_def by auto
   6.749 -    thus ?thesis using assms False 1 unfolding mergeSL_def adm_woL_def by auto
   6.750 -  qed
   6.751 -qed
   6.752 -
   6.753 -lemma worec_fixpoint1: "adm_wo H \<Longrightarrow> worec H i = H (worec H) i"
   6.754 -by (metis worec_fixpoint)
   6.755 -
   6.756 -lemma worecSL_isSucc:
   6.757 -assumes a: "adm_woL L" and i: "isSucc i"
   6.758 -shows "worecSL S L i = S (pred i) (worecSL S L (pred i))"
   6.759 -proof-
   6.760 -  let ?H = "mergeSL S L"
   6.761 -  have "worecSL S L i = ?H (worec ?H) i"
   6.762 -  unfolding worecSL_def using worec_fixpoint1[OF mergeSL[OF a]] .
   6.763 -  also have "... = S (pred i) (worecSL S L (pred i))"
   6.764 -  unfolding worecSL_def mergeSL_def using i by simp
   6.765 -  finally show ?thesis .
   6.766 -qed
   6.767 -
   6.768 -lemma worecSL_succ:
   6.769 -assumes a: "adm_woL L" and i: "aboveS j \<noteq> {}"
   6.770 -shows "worecSL S L (succ j) = S j (worecSL S L j)"
   6.771 -proof-
   6.772 -  def i \<equiv> "succ j"
   6.773 -  have i: "isSucc i" by (metis i i_def isSucc_succ)
   6.774 -  have ij: "j = pred i" unfolding i_def using assms by simp
   6.775 -  have 0: "succ (pred i) = i" using i by simp
   6.776 -  show ?thesis unfolding ij using worecSL_isSucc[OF a i] unfolding 0 .
   6.777 -qed
   6.778 -
   6.779 -lemma worecSL_isLim:
   6.780 -assumes a: "adm_woL L" and i: "isLim i"
   6.781 -shows "worecSL S L i = L (worecSL S L) i"
   6.782 -proof-
   6.783 -  let ?H = "mergeSL S L"
   6.784 -  have "worecSL S L i = ?H (worec ?H) i"
   6.785 -  unfolding worecSL_def using worec_fixpoint1[OF mergeSL[OF a]] .
   6.786 -  also have "... = L (worecSL S L) i"
   6.787 -  using i unfolding worecSL_def mergeSL_def isLim_def by simp
   6.788 -  finally show ?thesis .
   6.789 -qed
   6.790 -
   6.791 -definition worecZSL :: "'b \<Rightarrow> ('a \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> (('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b"
   6.792 -where "worecZSL Z S L \<equiv> worecSL S (\<lambda> f a. if a = zero then Z else L f a)"
   6.793 -
   6.794 -lemma worecZSL_zero:
   6.795 -assumes a: "adm_woL L"
   6.796 -shows "worecZSL Z S L zero = Z"
   6.797 -proof-
   6.798 -  let ?L = "\<lambda> f a. if a = zero then Z else L f a"
   6.799 -  have "worecZSL Z S L zero = ?L (worecZSL Z S L) zero"
   6.800 -  unfolding worecZSL_def apply(rule worecSL_isLim)
   6.801 -  using assms unfolding adm_woL_def by auto
   6.802 -  also have "... = Z" by simp
   6.803 -  finally show ?thesis .
   6.804 -qed
   6.805 -
   6.806 -lemma worecZSL_succ:
   6.807 -assumes a: "adm_woL L" and i: "aboveS j \<noteq> {}"
   6.808 -shows "worecZSL Z S L (succ j) = S j (worecZSL Z S L j)"
   6.809 -unfolding worecZSL_def apply(rule  worecSL_succ)
   6.810 -using assms unfolding adm_woL_def by auto
   6.811 -
   6.812 -lemma worecZSL_isLim:
   6.813 -assumes a: "adm_woL L" and "isLim i" and "i \<noteq> zero"
   6.814 -shows "worecZSL Z S L i = L (worecZSL Z S L) i"
   6.815 -proof-
   6.816 -  let ?L = "\<lambda> f a. if a = zero then Z else L f a"
   6.817 -  have "worecZSL Z S L i = ?L (worecZSL Z S L) i"
   6.818 -  unfolding worecZSL_def apply(rule worecSL_isLim)
   6.819 -  using assms unfolding adm_woL_def by auto
   6.820 -  also have "... = L (worecZSL Z S L) i" using assms by simp
   6.821 -  finally show ?thesis .
   6.822 -qed
   6.823 -
   6.824 -
   6.825 -subsubsection {* Well-order succ-lim induction *}
   6.826 -
   6.827 -lemma ord_cases:
   6.828 -obtains j where "i = succ j" and "aboveS j \<noteq> {}"  | "isLim i"
   6.829 -by (metis isLim_def isSucc_def)
   6.830 -
   6.831 -lemma well_order_inductSL[case_names Suc Lim]:
   6.832 -assumes SUCC: "\<And>i. \<lbrakk>aboveS i \<noteq> {}; P i\<rbrakk> \<Longrightarrow> P (succ i)" and
   6.833 -LIM: "\<And>i. \<lbrakk>isLim i; \<And>j. j \<in> underS i \<Longrightarrow> P j\<rbrakk> \<Longrightarrow> P i"
   6.834 -shows "P i"
   6.835 -proof(induction rule: well_order_induct)
   6.836 -  fix i assume 0:  "\<forall>j. j \<noteq> i \<and> (j, i) \<in> r \<longrightarrow> P j"
   6.837 -  show "P i" proof(cases i rule: ord_cases)
   6.838 -    fix j assume i: "i = succ j" and j: "aboveS j \<noteq> {}"
   6.839 -    hence "j \<noteq> i \<and> (j, i) \<in> r" by (metis  succ_diff succ_in)
   6.840 -    hence 1: "P j" using 0 by simp
   6.841 -    show "P i" unfolding i apply(rule SUCC) using 1 j by auto
   6.842 -  qed(insert 0 LIM, unfold underS_def, auto)
   6.843 -qed
   6.844 -
   6.845 -lemma well_order_inductZSL[case_names Zero Suc Lim]:
   6.846 -assumes ZERO: "P zero"
   6.847 -and SUCC: "\<And>i. \<lbrakk>aboveS i \<noteq> {}; P i\<rbrakk> \<Longrightarrow> P (succ i)" and
   6.848 -LIM: "\<And>i. \<lbrakk>isLim i; i \<noteq> zero; \<And>j. j \<in> underS i \<Longrightarrow> P j\<rbrakk> \<Longrightarrow> P i"
   6.849 -shows "P i"
   6.850 -apply(induction rule: well_order_inductSL) using assms by auto
   6.851 -
   6.852 -(* Succesor and limit ordinals *)
   6.853 -definition "isSuccOrd \<equiv> \<exists> j \<in> Field r. \<forall> i \<in> Field r. (i,j) \<in> r"
   6.854 -definition "isLimOrd \<equiv> \<not> isSuccOrd"
   6.855 -
   6.856 -lemma isLimOrd_succ:
   6.857 -assumes isLimOrd and "i \<in> Field r"
   6.858 -shows "succ i \<in> Field r"
   6.859 -using assms unfolding isLimOrd_def isSuccOrd_def
   6.860 -by (metis REFL in_notinI refl_on_domain succ_smallest)
   6.861 -
   6.862 -lemma isLimOrd_aboveS:
   6.863 -assumes l: isLimOrd and i: "i \<in> Field r"
   6.864 -shows "aboveS i \<noteq> {}"
   6.865 -proof-
   6.866 -  obtain j where "j \<in> Field r" and "(j,i) \<notin> r"
   6.867 -  using assms unfolding isLimOrd_def isSuccOrd_def by auto
   6.868 -  hence "(i,j) \<in> r \<and> j \<noteq> i" by (metis i max2_def max2_greater)
   6.869 -  thus ?thesis unfolding aboveS_def by auto
   6.870 -qed
   6.871 -
   6.872 -lemma succ_aboveS_isLimOrd:
   6.873 -assumes "\<forall> i \<in> Field r. aboveS i \<noteq> {} \<and> succ i \<in> Field r"
   6.874 -shows isLimOrd
   6.875 -unfolding isLimOrd_def isSuccOrd_def proof safe
   6.876 -  fix j assume j: "j \<in> Field r" "\<forall>i\<in>Field r. (i, j) \<in> r"
   6.877 -  hence "(succ j, j) \<in> r" using assms by auto
   6.878 -  moreover have "aboveS j \<noteq> {}" using assms j unfolding aboveS_def by auto
   6.879 -  ultimately show False by (metis succ_not_in)
   6.880 -qed
   6.881 -
   6.882 -lemma isLim_iff:
   6.883 -assumes l: "isLim i" and j: "j \<in> underS i"
   6.884 -shows "\<exists> k. k \<in> underS i \<and> j \<in> underS k"
   6.885 -proof-
   6.886 -  have a: "aboveS j \<noteq> {}" using j unfolding underS_def aboveS_def by auto
   6.887 -  show ?thesis apply(rule exI[of _ "succ j"]) apply safe
   6.888 -  using assms a unfolding underS_def isLim_def
   6.889 -  apply (metis (lifting, full_types) isSucc_def mem_Collect_eq succ_smallest)
   6.890 -  by (metis (lifting, full_types) a mem_Collect_eq succ_diff succ_in)
   6.891 -qed
   6.892 -
   6.893 -end (* context wo_rel *)
   6.894 -
   6.895 -abbreviation "zero \<equiv> wo_rel.zero"
   6.896 -abbreviation "succ \<equiv> wo_rel.succ"
   6.897 -abbreviation "pred \<equiv> wo_rel.pred"
   6.898 -abbreviation "isSucc \<equiv> wo_rel.isSucc"
   6.899 -abbreviation "isLim \<equiv> wo_rel.isLim"
   6.900 -abbreviation "isLimOrd \<equiv> wo_rel.isLimOrd"
   6.901 -abbreviation "isSuccOrd \<equiv> wo_rel.isSuccOrd"
   6.902 -abbreviation "adm_woL \<equiv> wo_rel.adm_woL"
   6.903 -abbreviation "worecSL \<equiv> wo_rel.worecSL"
   6.904 -abbreviation "worecZSL \<equiv> wo_rel.worecZSL"
   6.905 -
   6.906 -
   6.907 -subsection {* Projections of wellorders *}
   6.908 - 
   6.909 -definition "oproj r s f \<equiv> Field s \<subseteq> f ` (Field r) \<and> compat r s f"
   6.910 -
   6.911 -lemma oproj_in: 
   6.912 -assumes "oproj r s f" and "(a,a') \<in> r"
   6.913 -shows "(f a, f a') \<in> s"
   6.914 -using assms unfolding oproj_def compat_def by auto
   6.915 -
   6.916 -lemma oproj_Field:
   6.917 -assumes f: "oproj r s f" and a: "a \<in> Field r"
   6.918 -shows "f a \<in> Field s"
   6.919 -using oproj_in[OF f] a unfolding Field_def by auto
   6.920 -
   6.921 -lemma oproj_Field2:
   6.922 -assumes f: "oproj r s f" and a: "b \<in> Field s"
   6.923 -shows "\<exists> a \<in> Field r. f a = b"
   6.924 -using assms unfolding oproj_def by auto
   6.925 -
   6.926 -lemma oproj_under: 
   6.927 -assumes f:  "oproj r s f" and a: "a \<in> under r a'"
   6.928 -shows "f a \<in> under s (f a')"
   6.929 -using oproj_in[OF f] a unfolding under_def by auto
   6.930 -
   6.931 -(* An ordinal is embedded in another whenever it is embedded as an order 
   6.932 -(not necessarily as initial segment):*)
   6.933 -theorem embedI:
   6.934 -assumes r: "Well_order r" and s: "Well_order s" 
   6.935 -and f: "\<And> a. a \<in> Field r \<Longrightarrow> f a \<in> Field s \<and> f ` underS r a \<subseteq> underS s (f a)"
   6.936 -shows "\<exists> g. embed r s g"
   6.937 -proof-  
   6.938 -  interpret r!: wo_rel r by unfold_locales (rule r)
   6.939 -  interpret s!: wo_rel s by unfold_locales (rule s)
   6.940 -  let ?G = "\<lambda> g a. suc s (g ` underS r a)"
   6.941 -  def g \<equiv> "worec r ?G"
   6.942 -  have adm: "adm_wo r ?G" unfolding r.adm_wo_def image_def by auto
   6.943 -  (*  *)
   6.944 -  {fix a assume "a \<in> Field r"
   6.945 -   hence "bij_betw g (under r a) (under s (g a)) \<and> 
   6.946 -          g a \<in> under s (f a)"
   6.947 -   proof(induction a rule: r.underS_induct)
   6.948 -     case (1 a)
   6.949 -     hence a: "a \<in> Field r"
   6.950 -     and IH1a: "\<And> a1. a1 \<in> underS r a \<Longrightarrow> inj_on g (under r a1)"
   6.951 -     and IH1b: "\<And> a1. a1 \<in> underS r a \<Longrightarrow> g ` under r a1 = under s (g a1)"
   6.952 -     and IH2: "\<And> a1. a1 \<in> underS r a \<Longrightarrow> g a1 \<in> under s (f a1)"
   6.953 -     unfolding underS_def Field_def bij_betw_def by auto
   6.954 -     have fa: "f a \<in> Field s" using f[OF a] by auto
   6.955 -     have g: "g a = suc s (g ` underS r a)" 
   6.956 -     using r.worec_fixpoint[OF adm] unfolding g_def fun_eq_iff by simp
   6.957 -     have A0: "g ` underS r a \<subseteq> Field s" 
   6.958 -     using IH1b by (metis IH2 image_subsetI in_mono under_Field)
   6.959 -     {fix a1 assume a1: "a1 \<in> underS r a"
   6.960 -      from IH2[OF this] have "g a1 \<in> under s (f a1)" .
   6.961 -      moreover have "f a1 \<in> underS s (f a)" using f[OF a] a1 by auto
   6.962 -      ultimately have "g a1 \<in> underS s (f a)" by (metis s.ANTISYM s.TRANS under_underS_trans)
   6.963 -     }
   6.964 -     hence "f a \<in> AboveS s (g ` underS r a)" unfolding AboveS_def 
   6.965 -     using fa by simp (metis (lifting, full_types) mem_Collect_eq underS_def)
   6.966 -     hence A: "AboveS s (g ` underS r a) \<noteq> {}" by auto
   6.967 -     have B: "\<And> a1. a1 \<in> underS r a \<Longrightarrow> g a1 \<in> underS s (g a)"
   6.968 -     unfolding g apply(rule s.suc_underS[OF A0 A]) by auto
   6.969 -     {fix a1 a2 assume a2: "a2 \<in> underS r a" and 1: "a1 \<in> underS r a2"
   6.970 -      hence a12: "{a1,a2} \<subseteq> under r a2" and "a1 \<noteq> a2" using r.REFL a
   6.971 -      unfolding underS_def under_def refl_on_def Field_def by auto 
   6.972 -      hence "g a1 \<noteq> g a2" using IH1a[OF a2] unfolding inj_on_def by auto
   6.973 -      hence "g a1 \<in> underS s (g a2)" using IH1b[OF a2] a12 
   6.974 -      unfolding underS_def under_def by auto
   6.975 -     } note C = this
   6.976 -     have ga: "g a \<in> Field s" unfolding g using s.suc_inField[OF A0 A] .
   6.977 -     have aa: "a \<in> under r a" 
   6.978 -     using a r.REFL unfolding under_def underS_def refl_on_def by auto
   6.979 -     show ?case proof safe
   6.980 -       show "bij_betw g (under r a) (under s (g a))" unfolding bij_betw_def proof safe
   6.981 -         show "inj_on g (under r a)" proof(rule r.inj_on_Field)
   6.982 -           fix a1 a2 assume "a1 \<in> under r a" and a2: "a2 \<in> under r a" and a1: "a1 \<in> underS r a2"
   6.983 -           hence a22: "a2 \<in> under r a2" and a12: "a1 \<in> under r a2" "a1 \<noteq> a2"
   6.984 -           using a r.REFL unfolding under_def underS_def refl_on_def by auto
   6.985 -           show "g a1 \<noteq> g a2"
   6.986 -           proof(cases "a2 = a")
   6.987 -             case False hence "a2 \<in> underS r a" 
   6.988 -             using a2 unfolding underS_def under_def by auto 
   6.989 -             from IH1a[OF this] show ?thesis using a12 a22 unfolding inj_on_def by auto
   6.990 -           qed(insert B a1, unfold underS_def, auto)
   6.991 -         qed(unfold under_def Field_def, auto)
   6.992 -       next
   6.993 -         fix a1 assume a1: "a1 \<in> under r a" 
   6.994 -         show "g a1 \<in> under s (g a)"
   6.995 -         proof(cases "a1 = a")
   6.996 -           case True thus ?thesis 
   6.997 -           using ga s.REFL unfolding refl_on_def under_def by auto
   6.998 -         next
   6.999 -           case False
  6.1000 -           hence a1: "a1 \<in> underS r a" using a1 unfolding underS_def under_def by auto 
  6.1001 -           thus ?thesis using B unfolding underS_def under_def by auto
  6.1002 -         qed
  6.1003 -       next
  6.1004 -         fix b1 assume b1: "b1 \<in> under s (g a)"
  6.1005 -         show "b1 \<in> g ` under r a"
  6.1006 -         proof(cases "b1 = g a")
  6.1007 -           case True thus ?thesis using aa by auto
  6.1008 -         next
  6.1009 -           case False 
  6.1010 -           hence "b1 \<in> underS s (g a)" using b1 unfolding underS_def under_def by auto
  6.1011 -           from s.underS_suc[OF this[unfolded g] A0]
  6.1012 -           obtain a1 where a1: "a1 \<in> underS r a" and b1: "b1 \<in> under s (g a1)" by auto
  6.1013 -           obtain a2 where "a2 \<in> under r a1" and b1: "b1 = g a2" using IH1b[OF a1] b1 by auto
  6.1014 -           hence "a2 \<in> under r a" using a1 
  6.1015 -           by (metis r.ANTISYM r.TRANS in_mono underS_subset_under under_underS_trans)
  6.1016 -           thus ?thesis using b1 by auto
  6.1017 -         qed
  6.1018 -       qed
  6.1019 -     next
  6.1020 -       have "(g a, f a) \<in> s" unfolding g proof(rule s.suc_least[OF A0])
  6.1021 -         fix b1 assume "b1 \<in> g ` underS r a" 
  6.1022 -         then obtain a1 where a1: "b1 = g a1" and a1: "a1 \<in> underS r a" by auto
  6.1023 -         hence "b1 \<in> underS s (f a)" 
  6.1024 -         using a by (metis `\<And>a1. a1 \<in> underS r a \<Longrightarrow> g a1 \<in> underS s (f a)`)
  6.1025 -         thus "f a \<noteq> b1 \<and> (b1, f a) \<in> s" unfolding underS_def by auto
  6.1026 -       qed(insert fa, auto)
  6.1027 -       thus "g a \<in> under s (f a)" unfolding under_def by auto
  6.1028 -     qed
  6.1029 -   qed
  6.1030 -  }
  6.1031 -  thus ?thesis unfolding embed_def by auto
  6.1032 -qed
  6.1033 -
  6.1034 -corollary ordLeq_def2:
  6.1035 -  "r \<le>o s \<longleftrightarrow> Well_order r \<and> Well_order s \<and>
  6.1036 -               (\<exists> f. \<forall> a \<in> Field r. f a \<in> Field s \<and> f ` underS r a \<subseteq> underS s (f a))"
  6.1037 -using embed_in_Field[of r s] embed_underS2[of r s] embedI[of r s]
  6.1038 -unfolding ordLeq_def by fast
  6.1039 -
  6.1040 -lemma iso_oproj:
  6.1041 -  assumes r: "Well_order r" and s: "Well_order s" and f: "iso r s f"
  6.1042 -  shows "oproj r s f"
  6.1043 -using assms unfolding oproj_def
  6.1044 -by (subst (asm) iso_iff3) (auto simp: bij_betw_def)
  6.1045 -
  6.1046 -theorem oproj_embed:
  6.1047 -assumes r: "Well_order r" and s: "Well_order s" and f: "oproj r s f"
  6.1048 -shows "\<exists> g. embed s r g"
  6.1049 -proof (rule embedI[OF s r, of "inv_into (Field r) f"], unfold underS_def, safe)
  6.1050 -  fix b assume "b \<in> Field s"
  6.1051 -  thus "inv_into (Field r) f b \<in> Field r" using oproj_Field2[OF f] by (metis imageI inv_into_into)
  6.1052 -next
  6.1053 -  fix a b assume "b \<in> Field s" "a \<noteq> b" "(a, b) \<in> s"
  6.1054 -    "inv_into (Field r) f a = inv_into (Field r) f b"
  6.1055 -  with f show False by (auto dest!: inv_into_injective simp: Field_def oproj_def)
  6.1056 -next
  6.1057 -  fix a b assume *: "b \<in> Field s" "a \<noteq> b" "(a, b) \<in> s"
  6.1058 -  { assume "(inv_into (Field r) f a, inv_into (Field r) f b) \<notin> r"
  6.1059 -    moreover
  6.1060 -    from *(3) have "a \<in> Field s" unfolding Field_def by auto
  6.1061 -    with *(1,2) have
  6.1062 -      "inv_into (Field r) f a \<in> Field r" "inv_into (Field r) f b \<in> Field r"
  6.1063 -      "inv_into (Field r) f a \<noteq> inv_into (Field r) f b"
  6.1064 -      by (auto dest!: oproj_Field2[OF f] inv_into_injective intro!: inv_into_into)
  6.1065 -    ultimately have "(inv_into (Field r) f b, inv_into (Field r) f a) \<in> r"
  6.1066 -      using r by (auto simp: well_order_on_def linear_order_on_def total_on_def)
  6.1067 -    with f[unfolded oproj_def compat_def] *(1) `a \<in> Field s`
  6.1068 -      f_inv_into_f[of b f "Field r"] f_inv_into_f[of a f "Field r"]
  6.1069 -      have "(b, a) \<in> s" by (metis in_mono)
  6.1070 -    with *(2,3) s have False
  6.1071 -      by (auto simp: well_order_on_def linear_order_on_def partial_order_on_def antisym_def)
  6.1072 -  } thus "(inv_into (Field r) f a, inv_into (Field r) f b) \<in> r" by blast
  6.1073 -qed
  6.1074 -
  6.1075 -corollary oproj_ordLeq:
  6.1076 -assumes r: "Well_order r" and s: "Well_order s" and f: "oproj r s f"
  6.1077 -shows "s \<le>o r"
  6.1078 -using oproj_embed[OF assms] r s unfolding ordLeq_def by auto
  6.1079 -
  6.1080 -end
     7.1 --- a/src/HOL/Cardinals/Order_Union.thy	Mon Sep 01 16:34:38 2014 +0200
     7.2 +++ b/src/HOL/Cardinals/Order_Union.thy	Mon Sep 01 16:34:39 2014 +0200
     7.3 @@ -78,7 +78,7 @@
     7.4  assumes FLD: "Field r Int Field r' = {}" and
     7.5          REFL: "Refl r" and REFL': "Refl r'"
     7.6  shows "Refl (r Osum r')"
     7.7 -using assms 
     7.8 +using assms
     7.9  unfolding refl_on_def Field_Osum unfolding Osum_def by blast
    7.10  
    7.11  lemma Osum_trans:
     8.1 --- a/src/HOL/Cardinals/Ordinal_Arithmetic.thy	Mon Sep 01 16:34:38 2014 +0200
     8.2 +++ b/src/HOL/Cardinals/Ordinal_Arithmetic.thy	Mon Sep 01 16:34:39 2014 +0200
     8.3 @@ -8,12 +8,12 @@
     8.4  header {* Ordinal Arithmetic *}
     8.5  
     8.6  theory Ordinal_Arithmetic
     8.7 -imports Constructions_on_Wellorders
     8.8 +imports Wellorder_Constructions
     8.9  begin
    8.10  
    8.11  definition osum :: "'a rel \<Rightarrow> 'b rel \<Rightarrow> ('a + 'b) rel"  (infixr "+o" 70)
    8.12  where
    8.13 -  "r +o r' = map_prod Inl Inl ` r \<union> map_prod Inr Inr ` r' \<union> 
    8.14 +  "r +o r' = map_prod Inl Inl ` r \<union> map_prod Inr Inr ` r' \<union>
    8.15       {(Inl a, Inr a') | a a' . a \<in> Field r \<and> a' \<in> Field r'}"
    8.16  
    8.17  lemma Field_osum: "Field(r +o r') = Inl ` Field r \<union> Inr ` Field r'"
    8.18 @@ -175,7 +175,7 @@
    8.19  lemma oprod_Refl:"\<lbrakk>Refl r; Refl r'\<rbrakk> \<Longrightarrow> Refl (r *o r')"
    8.20    unfolding refl_on_def Field_oprod unfolding oprod_def by auto
    8.21  
    8.22 -lemma oprod_trans: 
    8.23 +lemma oprod_trans:
    8.24    assumes "trans r" "trans r'" "antisym r" "antisym r'"
    8.25    shows "trans (r *o r')"
    8.26  proof(unfold trans_def, safe)
    8.27 @@ -309,7 +309,7 @@
    8.28    from assms(3) have r': "Field r' \<noteq> {}" unfolding Field_def by auto
    8.29    have minim[simp]: "minim r' (Field r') \<in> Field r'"
    8.30      using wo_rel.minim_inField[unfolded wo_rel_def, OF WELL' _ r'] by auto
    8.31 -  { fix b 
    8.32 +  { fix b
    8.33      assume "(b, minim r' (Field r')) \<in> r'"
    8.34      moreover hence "b \<in> Field r'" unfolding Field_def by auto
    8.35      hence "(minim r' (Field r'), b) \<in> r'"
    8.36 @@ -390,7 +390,7 @@
    8.37    unfolding isMaxim_def using antisymD[OF ANTISYM, of x y] by auto
    8.38  
    8.39  lemma maxim_isMaxim: "\<lbrakk>finite A; A \<noteq> {}; A \<subseteq> Field r\<rbrakk> \<Longrightarrow> isMaxim A (maxim A)"
    8.40 -unfolding maxim_def 
    8.41 +unfolding maxim_def
    8.42  proof (rule theI', rule ex_ex1I[OF _ isMaxim_unique, rotated], assumption+,
    8.43    induct A rule: finite_induct)
    8.44    case (insert x A)
    8.45 @@ -494,7 +494,7 @@
    8.46  
    8.47  locale wo_rel2 =
    8.48    fixes r s
    8.49 -  assumes rWELL: "Well_order r" 
    8.50 +  assumes rWELL: "Well_order r"
    8.51    and     sWELL: "Well_order s"
    8.52  begin
    8.53  
    8.54 @@ -539,7 +539,7 @@
    8.55  
    8.56  lemma max_fun_diff_max2:
    8.57    assumes ineq: "s.max_fun_diff f g = s.max_fun_diff g h \<longrightarrow>
    8.58 -    f (s.max_fun_diff f g) \<noteq> h (s.max_fun_diff g h)" and 
    8.59 +    f (s.max_fun_diff f g) \<noteq> h (s.max_fun_diff g h)" and
    8.60      fg: "f \<noteq> g" and gh: "g \<noteq> h" and fh: "f \<noteq> h" and
    8.61      f: "f \<in> FINFUNC" and g: "g \<in> FINFUNC" and h: "h \<in> FINFUNC"
    8.62    shows "s.max_fun_diff f h = s.max2 (s.max_fun_diff f g) (s.max_fun_diff g h)"
    8.63 @@ -708,7 +708,7 @@
    8.64    by (auto intro: finite_subset[OF support_upd_subset])
    8.65  
    8.66  lemma fun_upd_same_oexp:
    8.67 -  assumes "(f, g) \<in> oexp" "f x = g x" "x \<in> Field s" "y \<in> Field r" 
    8.68 +  assumes "(f, g) \<in> oexp" "f x = g x" "x \<in> Field s" "y \<in> Field r"
    8.69    shows   "(f(x := y), g(x := y)) \<in> oexp"
    8.70  proof -
    8.71    from assms(1) fun_upd_FINFUNC[OF _ assms(3,4)] have fg: "f(x := y) \<in> FINFUNC" "g(x := y) \<in> FINFUNC"
    8.72 @@ -829,7 +829,7 @@
    8.73                  thus ?thesis
    8.74                  proof (cases "s.maxim (SUPP f) = z \<and> f z = x0")
    8.75                    case True
    8.76 -                  with f have "f(z := r.zero) \<in> G" unfolding G_def by blast 
    8.77 +                  with f have "f(z := r.zero) \<in> G" unfolding G_def by blast
    8.78                    with g0(2) f0z have "(f0(z := r.zero), f(z := r.zero)) \<in> oexp" by auto
    8.79                    hence "(f0(z := r.zero, z := x0), f(z := r.zero, z := x0)) \<in> oexp"
    8.80                      by (elim fun_upd_same_oexp[OF _ _ zField x0Field]) simp
    8.81 @@ -922,10 +922,10 @@
    8.82    unfolding ozero_def by simp
    8.83  
    8.84  lemma iso_ozero_empty[simp]: "r =o ozero = (r = {})"
    8.85 -  unfolding ozero_def ordIso_def iso_def[abs_def] embed_def bij_betw_def 
    8.86 +  unfolding ozero_def ordIso_def iso_def[abs_def] embed_def bij_betw_def
    8.87    by (auto dest: well_order_on_domain)
    8.88  
    8.89 -lemma ozero_ordLeq: 
    8.90 +lemma ozero_ordLeq:
    8.91  assumes "Well_order r"  shows "ozero \<le>o r"
    8.92  using assms unfolding ozero_def ordLeq_def embed_def[abs_def] under_def by auto
    8.93  
    8.94 @@ -959,7 +959,7 @@
    8.95    with f have "bij_betw ?f (Field ?L) (Field ?R)"
    8.96      unfolding Field_osum iso_def bij_betw_def image_image image_Un by auto
    8.97    moreover from f have "compat ?L ?R ?f"
    8.98 -    unfolding osum_def iso_iff3[OF r s] compat_def bij_betw_def 
    8.99 +    unfolding osum_def iso_iff3[OF r s] compat_def bij_betw_def
   8.100      by (auto simp: map_prod_imageI)
   8.101    ultimately have "iso ?L ?R ?f" by (subst iso_iff3) (auto intro: osum_Well_order r s t)
   8.102    thus ?thesis unfolding ordIso_def by (auto intro: osum_Well_order r s t)
   8.103 @@ -977,7 +977,7 @@
   8.104    with f have "bij_betw ?f (Field ?L) (Field ?R)"
   8.105      unfolding Field_osum iso_def bij_betw_def image_image image_Un by auto
   8.106    moreover from f have "compat ?L ?R ?f"
   8.107 -    unfolding osum_def iso_iff3[OF r s] compat_def bij_betw_def 
   8.108 +    unfolding osum_def iso_iff3[OF r s] compat_def bij_betw_def
   8.109      by (auto simp: map_prod_imageI)
   8.110    ultimately have "iso ?L ?R ?f" by (subst iso_iff3) (auto intro: osum_Well_order r s t)
   8.111    thus ?thesis unfolding ordIso_def by (auto intro: osum_Well_order r s t)
   8.112 @@ -1269,7 +1269,7 @@
   8.113  lemma ozero_oexp: "\<not> (s =o ozero) \<Longrightarrow> ozero ^o s =o ozero"
   8.114    unfolding oexp_def[OF ozero_Well_order s] FinFunc_def
   8.115    by simp (metis Func_emp2 bot.extremum_uniqueI emptyE well_order_on_domain s subrelI)
   8.116 -      
   8.117 +
   8.118  lemma oone_oexp: "oone ^o s =o oone" (is "?L =o ?R")
   8.119    by (rule oone_ordIso_oexp[OF ordIso_reflexive[OF oone_Well_order] s])
   8.120  
   8.121 @@ -1490,7 +1490,7 @@
   8.122    thus ?thesis unfolding ordLeq_def2 by (fast intro: oexp_Well_order r s)
   8.123  qed
   8.124  
   8.125 -lemma FinFunc_osum: 
   8.126 +lemma FinFunc_osum:
   8.127    "fg \<in> FinFunc r (s +o t) = (fg o Inl \<in> FinFunc r s \<and> fg o Inr \<in> FinFunc r t)"
   8.128    (is "?L = (?R1 \<and> ?R2)")
   8.129  proof safe
   8.130 @@ -1696,7 +1696,7 @@
   8.131          unfolding inj_on_def FinFunc_def Func_def Field_oprod rs.Field_oexp rev_curr_def[abs_def]
   8.132          by (auto simp: fun_eq_iff) metis
   8.133        show "rev_curr ` (FinFunc r (s *o t)) = FinFunc (r ^o s) t" by (rule rev_curr_FinFunc[OF Field])
   8.134 -    qed               
   8.135 +    qed
   8.136      moreover
   8.137      have "compat ?L ?R rev_curr"
   8.138      unfolding compat_def proof safe
     9.1 --- a/src/HOL/Cardinals/README.txt	Mon Sep 01 16:34:38 2014 +0200
     9.2 +++ b/src/HOL/Cardinals/README.txt	Mon Sep 01 16:34:39 2014 +0200
     9.3 @@ -35,7 +35,7 @@
     9.4        and *strict embeddings* are defined to be embeddings that are, and respectively
     9.5        are not, bijections.
     9.6  
     9.7 --- Constructions_on_Wellorders:
     9.8 +-- Wellorder_Constructions:
     9.9  ----- 1) Defines direct images, restrictions, disjoint unions and 
    9.10        bounded squares of well-orders.
    9.11  ----- 2) Defines the relations "ordLeq", "ordLess" and "ordIso" 
    9.12 @@ -203,7 +203,7 @@
    9.13    making impossible to debug theorem instantiations.  
    9.14  - At lemma "embed_unique": If we add the attribute "rule format" at lemma, we get an error at qed.
    9.15  
    9.16 -Theory Constructions_on_Wellorders (and BNF_Constructions_on_Wellorders):
    9.17 +Theory Wellorder_Constructions (and BNF_Wellorder_Constructions):
    9.18  - Some of the lemmas in this section are about more general kinds of relations than 
    9.19    well-orders, but it is not clear whether they are useful in such more general contexts.
    9.20  - Recall that "equiv" does not have the "equiv_on" and "Equiv" versions, 
    10.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    10.2 +++ b/src/HOL/Cardinals/Wellorder_Constructions.thy	Mon Sep 01 16:34:39 2014 +0200
    10.3 @@ -0,0 +1,1077 @@
    10.4 +(*  Title:      HOL/Cardinals/Wellorder_Constructions.thy
    10.5 +    Author:     Andrei Popescu, TU Muenchen
    10.6 +    Copyright   2012
    10.7 +
    10.8 +Constructions on wellorders.
    10.9 +*)
   10.10 +
   10.11 +header {* Constructions on Wellorders *}
   10.12 +
   10.13 +theory Wellorder_Constructions
   10.14 +imports
   10.15 +  BNF_Wellorder_Constructions Wellorder_Embedding Order_Union
   10.16 +  "../Library/Cardinal_Notations"
   10.17 +begin
   10.18 +
   10.19 +declare
   10.20 +  ordLeq_Well_order_simp[simp]
   10.21 +  not_ordLeq_iff_ordLess[simp]
   10.22 +  not_ordLess_iff_ordLeq[simp]
   10.23 +  Func_empty[simp]
   10.24 +  Func_is_emp[simp]
   10.25 +
   10.26 +lemma Func_emp2[simp]: "A \<noteq> {} \<Longrightarrow> Func A {} = {}" by auto
   10.27 +
   10.28 +
   10.29 +subsection {* Restriction to a set *}
   10.30 +
   10.31 +lemma Restr_incr2:
   10.32 +"r <= r' \<Longrightarrow> Restr r A <= Restr r' A"
   10.33 +by blast
   10.34 +
   10.35 +lemma Restr_incr:
   10.36 +"\<lbrakk>r \<le> r'; A \<le> A'\<rbrakk> \<Longrightarrow> Restr r A \<le> Restr r' A'"
   10.37 +by blast
   10.38 +
   10.39 +lemma Restr_Int:
   10.40 +"Restr (Restr r A) B = Restr r (A Int B)"
   10.41 +by blast
   10.42 +
   10.43 +lemma Restr_iff: "(a,b) : Restr r A = (a : A \<and> b : A \<and> (a,b) : r)"
   10.44 +by (auto simp add: Field_def)
   10.45 +
   10.46 +lemma Restr_subset1: "Restr r A \<le> r"
   10.47 +by auto
   10.48 +
   10.49 +lemma Restr_subset2: "Restr r A \<le> A \<times> A"
   10.50 +by auto
   10.51 +
   10.52 +lemma wf_Restr:
   10.53 +"wf r \<Longrightarrow> wf(Restr r A)"
   10.54 +using Restr_subset by (elim wf_subset) simp
   10.55 +
   10.56 +lemma Restr_incr1:
   10.57 +"A \<le> B \<Longrightarrow> Restr r A \<le> Restr r B"
   10.58 +by blast
   10.59 +
   10.60 +
   10.61 +subsection {* Order filters versus restrictions and embeddings *}
   10.62 +
   10.63 +lemma ofilter_Restr:
   10.64 +assumes WELL: "Well_order r" and
   10.65 +        OFA: "ofilter r A" and OFB: "ofilter r B" and SUB: "A \<le> B"
   10.66 +shows "ofilter (Restr r B) A"
   10.67 +proof-
   10.68 +  let ?rB = "Restr r B"
   10.69 +  have Well: "wo_rel r" unfolding wo_rel_def using WELL .
   10.70 +  hence Refl: "Refl r" by (auto simp add: wo_rel.REFL)
   10.71 +  hence Field: "Field ?rB = Field r Int B"
   10.72 +  using Refl_Field_Restr by blast
   10.73 +  have WellB: "wo_rel ?rB \<and> Well_order ?rB" using WELL
   10.74 +  by (auto simp add: Well_order_Restr wo_rel_def)
   10.75 +  (* Main proof *)
   10.76 +  show ?thesis
   10.77 +  proof(auto simp add: WellB wo_rel.ofilter_def)
   10.78 +    fix a assume "a \<in> A"
   10.79 +    hence "a \<in> Field r \<and> a \<in> B" using assms Well
   10.80 +    by (auto simp add: wo_rel.ofilter_def)
   10.81 +    with Field show "a \<in> Field(Restr r B)" by auto
   10.82 +  next
   10.83 +    fix a b assume *: "a \<in> A"  and "b \<in> under (Restr r B) a"
   10.84 +    hence "b \<in> under r a"
   10.85 +    using WELL OFB SUB ofilter_Restr_under[of r B a] by auto
   10.86 +    thus "b \<in> A" using * Well OFA by(auto simp add: wo_rel.ofilter_def)
   10.87 +  qed
   10.88 +qed
   10.89 +
   10.90 +lemma ofilter_subset_iso:
   10.91 +assumes WELL: "Well_order r" and
   10.92 +        OFA: "ofilter r A" and OFB: "ofilter r B"
   10.93 +shows "(A = B) = iso (Restr r A) (Restr r B) id"
   10.94 +using assms
   10.95 +by (auto simp add: ofilter_subset_embedS_iso)
   10.96 +
   10.97 +
   10.98 +subsection {* Ordering the well-orders by existence of embeddings *}
   10.99 +
  10.100 +corollary ordLeq_refl_on: "refl_on {r. Well_order r} ordLeq"
  10.101 +using ordLeq_reflexive unfolding ordLeq_def refl_on_def
  10.102 +by blast
  10.103 +
  10.104 +corollary ordLeq_trans: "trans ordLeq"
  10.105 +using trans_def[of ordLeq] ordLeq_transitive by blast
  10.106 +
  10.107 +corollary ordLeq_preorder_on: "preorder_on {r. Well_order r} ordLeq"
  10.108 +by(auto simp add: preorder_on_def ordLeq_refl_on ordLeq_trans)
  10.109 +
  10.110 +corollary ordIso_refl_on: "refl_on {r. Well_order r} ordIso"
  10.111 +using ordIso_reflexive unfolding refl_on_def ordIso_def
  10.112 +by blast
  10.113 +
  10.114 +corollary ordIso_trans: "trans ordIso"
  10.115 +using trans_def[of ordIso] ordIso_transitive by blast
  10.116 +
  10.117 +corollary ordIso_sym: "sym ordIso"
  10.118 +by (auto simp add: sym_def ordIso_symmetric)
  10.119 +
  10.120 +corollary ordIso_equiv: "equiv {r. Well_order r} ordIso"
  10.121 +by (auto simp add:  equiv_def ordIso_sym ordIso_refl_on ordIso_trans)
  10.122 +
  10.123 +lemma ordLess_Well_order_simp[simp]:
  10.124 +assumes "r <o r'"
  10.125 +shows "Well_order r \<and> Well_order r'"
  10.126 +using assms unfolding ordLess_def by simp
  10.127 +
  10.128 +lemma ordIso_Well_order_simp[simp]:
  10.129 +assumes "r =o r'"
  10.130 +shows "Well_order r \<and> Well_order r'"
  10.131 +using assms unfolding ordIso_def by simp
  10.132 +
  10.133 +lemma ordLess_irrefl: "irrefl ordLess"
  10.134 +by(unfold irrefl_def, auto simp add: ordLess_irreflexive)
  10.135 +
  10.136 +lemma ordLess_or_ordIso:
  10.137 +assumes WELL: "Well_order r" and WELL': "Well_order r'"
  10.138 +shows "r <o r' \<or> r' <o r \<or> r =o r'"
  10.139 +unfolding ordLess_def ordIso_def
  10.140 +using assms embedS_or_iso[of r r'] by auto
  10.141 +
  10.142 +corollary ordLeq_ordLess_Un_ordIso:
  10.143 +"ordLeq = ordLess \<union> ordIso"
  10.144 +by (auto simp add: ordLeq_iff_ordLess_or_ordIso)
  10.145 +
  10.146 +lemma not_ordLeq_ordLess:
  10.147 +"r \<le>o r' \<Longrightarrow> \<not> r' <o r"
  10.148 +using not_ordLess_ordLeq by blast
  10.149 +
  10.150 +lemma ordIso_or_ordLess:
  10.151 +assumes WELL: "Well_order r" and WELL': "Well_order r'"
  10.152 +shows "r =o r' \<or> r <o r' \<or> r' <o r"
  10.153 +using assms ordLess_or_ordLeq ordLeq_iff_ordLess_or_ordIso by blast
  10.154 +
  10.155 +lemmas ord_trans = ordIso_transitive ordLeq_transitive ordLess_transitive
  10.156 +                   ordIso_ordLeq_trans ordLeq_ordIso_trans
  10.157 +                   ordIso_ordLess_trans ordLess_ordIso_trans
  10.158 +                   ordLess_ordLeq_trans ordLeq_ordLess_trans
  10.159 +
  10.160 +lemma ofilter_ordLeq:
  10.161 +assumes "Well_order r" and "ofilter r A"
  10.162 +shows "Restr r A \<le>o r"
  10.163 +proof-
  10.164 +  have "A \<le> Field r" using assms by (auto simp add: wo_rel_def wo_rel.ofilter_def)
  10.165 +  thus ?thesis using assms
  10.166 +  by (simp add: ofilter_subset_ordLeq wo_rel.Field_ofilter
  10.167 +      wo_rel_def Restr_Field)
  10.168 +qed
  10.169 +
  10.170 +corollary under_Restr_ordLeq:
  10.171 +"Well_order r \<Longrightarrow> Restr r (under r a) \<le>o r"
  10.172 +by (auto simp add: ofilter_ordLeq wo_rel.under_ofilter wo_rel_def)
  10.173 +
  10.174 +
  10.175 +subsection {* Copy via direct images *}
  10.176 +
  10.177 +lemma Id_dir_image: "dir_image Id f \<le> Id"
  10.178 +unfolding dir_image_def by auto
  10.179 +
  10.180 +lemma Un_dir_image:
  10.181 +"dir_image (r1 \<union> r2) f = (dir_image r1 f) \<union> (dir_image r2 f)"
  10.182 +unfolding dir_image_def by auto
  10.183 +
  10.184 +lemma Int_dir_image:
  10.185 +assumes "inj_on f (Field r1 \<union> Field r2)"
  10.186 +shows "dir_image (r1 Int r2) f = (dir_image r1 f) Int (dir_image r2 f)"
  10.187 +proof
  10.188 +  show "dir_image (r1 Int r2) f \<le> (dir_image r1 f) Int (dir_image r2 f)"
  10.189 +  using assms unfolding dir_image_def inj_on_def by auto
  10.190 +next
  10.191 +  show "(dir_image r1 f) Int (dir_image r2 f) \<le> dir_image (r1 Int r2) f"
  10.192 +  proof(clarify)
  10.193 +    fix a' b'
  10.194 +    assume "(a',b') \<in> dir_image r1 f" "(a',b') \<in> dir_image r2 f"
  10.195 +    then obtain a1 b1 a2 b2
  10.196 +    where 1: "a' = f a1 \<and> b' = f b1 \<and> a' = f a2 \<and> b' = f b2" and
  10.197 +          2: "(a1,b1) \<in> r1 \<and> (a2,b2) \<in> r2" and
  10.198 +          3: "{a1,b1} \<le> Field r1 \<and> {a2,b2} \<le> Field r2"
  10.199 +    unfolding dir_image_def Field_def by blast
  10.200 +    hence "a1 = a2 \<and> b1 = b2" using assms unfolding inj_on_def by auto
  10.201 +    hence "a' = f a1 \<and> b' = f b1 \<and> (a1,b1) \<in> r1 Int r2 \<and> (a2,b2) \<in> r1 Int r2"
  10.202 +    using 1 2 by auto
  10.203 +    thus "(a',b') \<in> dir_image (r1 \<inter> r2) f"
  10.204 +    unfolding dir_image_def by blast
  10.205 +  qed
  10.206 +qed
  10.207 +
  10.208 +(* More facts on ordinal sum: *)
  10.209 +
  10.210 +lemma Osum_embed:
  10.211 +assumes FLD: "Field r Int Field r' = {}" and
  10.212 +        WELL: "Well_order r" and WELL': "Well_order r'"
  10.213 +shows "embed r (r Osum r') id"
  10.214 +proof-
  10.215 +  have 1: "Well_order (r Osum r')"
  10.216 +  using assms by (auto simp add: Osum_Well_order)
  10.217 +  moreover
  10.218 +  have "compat r (r Osum r') id"
  10.219 +  unfolding compat_def Osum_def by auto
  10.220 +  moreover
  10.221 +  have "inj_on id (Field r)" by simp
  10.222 +  moreover
  10.223 +  have "ofilter (r Osum r') (Field r)"
  10.224 +  using 1 proof(auto simp add: wo_rel_def wo_rel.ofilter_def
  10.225 +                               Field_Osum under_def)
  10.226 +    fix a b assume 2: "a \<in> Field r" and 3: "(b,a) \<in> r Osum r'"
  10.227 +    moreover
  10.228 +    {assume "(b,a) \<in> r'"
  10.229 +     hence "a \<in> Field r'" using Field_def[of r'] by blast
  10.230 +     hence False using 2 FLD by blast
  10.231 +    }
  10.232 +    moreover
  10.233 +    {assume "a \<in> Field r'"
  10.234 +     hence False using 2 FLD by blast
  10.235 +    }
  10.236 +    ultimately
  10.237 +    show "b \<in> Field r" by (auto simp add: Osum_def Field_def)
  10.238 +  qed
  10.239 +  ultimately show ?thesis
  10.240 +  using assms by (auto simp add: embed_iff_compat_inj_on_ofilter)
  10.241 +qed
  10.242 +
  10.243 +corollary Osum_ordLeq:
  10.244 +assumes FLD: "Field r Int Field r' = {}" and
  10.245 +        WELL: "Well_order r" and WELL': "Well_order r'"
  10.246 +shows "r \<le>o r Osum r'"
  10.247 +using assms Osum_embed Osum_Well_order
  10.248 +unfolding ordLeq_def by blast
  10.249 +
  10.250 +lemma Well_order_embed_copy:
  10.251 +assumes WELL: "well_order_on A r" and
  10.252 +        INJ: "inj_on f A" and SUB: "f ` A \<le> B"
  10.253 +shows "\<exists>r'. well_order_on B r' \<and> r \<le>o r'"
  10.254 +proof-
  10.255 +  have "bij_betw f A (f ` A)"
  10.256 +  using INJ inj_on_imp_bij_betw by blast
  10.257 +  then obtain r'' where "well_order_on (f ` A) r''" and 1: "r =o r''"
  10.258 +  using WELL  Well_order_iso_copy by blast
  10.259 +  hence 2: "Well_order r'' \<and> Field r'' = (f ` A)"
  10.260 +  using well_order_on_Well_order by blast
  10.261 +  (*  *)
  10.262 +  let ?C = "B - (f ` A)"
  10.263 +  obtain r''' where "well_order_on ?C r'''"
  10.264 +  using well_order_on by blast
  10.265 +  hence 3: "Well_order r''' \<and> Field r''' = ?C"
  10.266 +  using well_order_on_Well_order by blast
  10.267 +  (*  *)
  10.268 +  let ?r' = "r'' Osum r'''"
  10.269 +  have "Field r'' Int Field r''' = {}"
  10.270 +  using 2 3 by auto
  10.271 +  hence "r'' \<le>o ?r'" using Osum_ordLeq[of r'' r'''] 2 3 by blast
  10.272 +  hence 4: "r \<le>o ?r'" using 1 ordIso_ordLeq_trans by blast
  10.273 +  (*  *)
  10.274 +  hence "Well_order ?r'" unfolding ordLeq_def by auto
  10.275 +  moreover
  10.276 +  have "Field ?r' = B" using 2 3 SUB by (auto simp add: Field_Osum)
  10.277 +  ultimately show ?thesis using 4 by blast
  10.278 +qed
  10.279 +
  10.280 +
  10.281 +subsection {* The maxim among a finite set of ordinals *}
  10.282 +
  10.283 +text {* The correct phrasing would be ``a maxim of ...", as @{text "\<le>o"} is only a preorder. *}
  10.284 +
  10.285 +definition isOmax :: "'a rel set \<Rightarrow> 'a rel \<Rightarrow> bool"
  10.286 +where
  10.287 +"isOmax  R r == r \<in> R \<and> (ALL r' : R. r' \<le>o r)"
  10.288 +
  10.289 +definition omax :: "'a rel set \<Rightarrow> 'a rel"
  10.290 +where
  10.291 +"omax R == SOME r. isOmax R r"
  10.292 +
  10.293 +lemma exists_isOmax:
  10.294 +assumes "finite R" and "R \<noteq> {}" and "\<forall> r \<in> R. Well_order r"
  10.295 +shows "\<exists> r. isOmax R r"
  10.296 +proof-
  10.297 +  have "finite R \<Longrightarrow> R \<noteq> {} \<longrightarrow> (\<forall> r \<in> R. Well_order r) \<longrightarrow> (\<exists> r. isOmax R r)"
  10.298 +  apply(erule finite_induct) apply(simp add: isOmax_def)
  10.299 +  proof(clarsimp)
  10.300 +    fix r :: "('a \<times> 'a) set" and R assume *: "finite R" and **: "r \<notin> R"
  10.301 +    and ***: "Well_order r" and ****: "\<forall>r\<in>R. Well_order r"
  10.302 +    and IH: "R \<noteq> {} \<longrightarrow> (\<exists>p. isOmax R p)"
  10.303 +    let ?R' = "insert r R"
  10.304 +    show "\<exists>p'. (isOmax ?R' p')"
  10.305 +    proof(cases "R = {}")
  10.306 +      assume Case1: "R = {}"
  10.307 +      thus ?thesis unfolding isOmax_def using ***
  10.308 +      by (simp add: ordLeq_reflexive)
  10.309 +    next
  10.310 +      assume Case2: "R \<noteq> {}"
  10.311 +      then obtain p where p: "isOmax R p" using IH by auto
  10.312 +      hence 1: "Well_order p" using **** unfolding isOmax_def by simp
  10.313 +      {assume Case21: "r \<le>o p"
  10.314 +       hence "isOmax ?R' p" using p unfolding isOmax_def by simp
  10.315 +       hence ?thesis by auto
  10.316 +      }
  10.317 +      moreover
  10.318 +      {assume Case22: "p \<le>o r"
  10.319 +       {fix r' assume "r' \<in> ?R'"
  10.320 +        moreover
  10.321 +        {assume "r' \<in> R"
  10.322 +         hence "r' \<le>o p" using p unfolding isOmax_def by simp
  10.323 +         hence "r' \<le>o r" using Case22 by(rule ordLeq_transitive)
  10.324 +        }
  10.325 +        moreover have "r \<le>o r" using *** by(rule ordLeq_reflexive)
  10.326 +        ultimately have "r' \<le>o r" by auto
  10.327 +       }
  10.328 +       hence "isOmax ?R' r" unfolding isOmax_def by simp
  10.329 +       hence ?thesis by auto
  10.330 +      }
  10.331 +      moreover have "r \<le>o p \<or> p \<le>o r"
  10.332 +      using 1 *** ordLeq_total by auto
  10.333 +      ultimately show ?thesis by blast
  10.334 +    qed
  10.335 +  qed
  10.336 +  thus ?thesis using assms by auto
  10.337 +qed
  10.338 +
  10.339 +lemma omax_isOmax:
  10.340 +assumes "finite R" and "R \<noteq> {}" and "\<forall> r \<in> R. Well_order r"
  10.341 +shows "isOmax R (omax R)"
  10.342 +unfolding omax_def using assms
  10.343 +by(simp add: exists_isOmax someI_ex)
  10.344 +
  10.345 +lemma omax_in:
  10.346 +assumes "finite R" and "R \<noteq> {}" and "\<forall> r \<in> R. Well_order r"
  10.347 +shows "omax R \<in> R"
  10.348 +using assms omax_isOmax unfolding isOmax_def by blast
  10.349 +
  10.350 +lemma Well_order_omax:
  10.351 +assumes "finite R" and "R \<noteq> {}" and "\<forall>r\<in>R. Well_order r"
  10.352 +shows "Well_order (omax R)"
  10.353 +using assms apply - apply(drule omax_in) by auto
  10.354 +
  10.355 +lemma omax_maxim:
  10.356 +assumes "finite R" and "\<forall> r \<in> R. Well_order r" and "r \<in> R"
  10.357 +shows "r \<le>o omax R"
  10.358 +using assms omax_isOmax unfolding isOmax_def by blast
  10.359 +
  10.360 +lemma omax_ordLeq:
  10.361 +assumes "finite R" and "R \<noteq> {}" and *: "\<forall> r \<in> R. r \<le>o p"
  10.362 +shows "omax R \<le>o p"
  10.363 +proof-
  10.364 +  have "\<forall> r \<in> R. Well_order r" using * unfolding ordLeq_def by simp
  10.365 +  thus ?thesis using assms omax_in by auto
  10.366 +qed
  10.367 +
  10.368 +lemma omax_ordLess:
  10.369 +assumes "finite R" and "R \<noteq> {}" and *: "\<forall> r \<in> R. r <o p"
  10.370 +shows "omax R <o p"
  10.371 +proof-
  10.372 +  have "\<forall> r \<in> R. Well_order r" using * unfolding ordLess_def by simp
  10.373 +  thus ?thesis using assms omax_in by auto
  10.374 +qed
  10.375 +
  10.376 +lemma omax_ordLeq_elim:
  10.377 +assumes "finite R" and "\<forall> r \<in> R. Well_order r"
  10.378 +and "omax R \<le>o p" and "r \<in> R"
  10.379 +shows "r \<le>o p"
  10.380 +using assms omax_maxim[of R r] apply simp
  10.381 +using ordLeq_transitive by blast
  10.382 +
  10.383 +lemma omax_ordLess_elim:
  10.384 +assumes "finite R" and "\<forall> r \<in> R. Well_order r"
  10.385 +and "omax R <o p" and "r \<in> R"
  10.386 +shows "r <o p"
  10.387 +using assms omax_maxim[of R r] apply simp
  10.388 +using ordLeq_ordLess_trans by blast
  10.389 +
  10.390 +lemma ordLeq_omax:
  10.391 +assumes "finite R" and "\<forall> r \<in> R. Well_order r"
  10.392 +and "r \<in> R" and "p \<le>o r"
  10.393 +shows "p \<le>o omax R"
  10.394 +using assms omax_maxim[of R r] apply simp
  10.395 +using ordLeq_transitive by blast
  10.396 +
  10.397 +lemma ordLess_omax:
  10.398 +assumes "finite R" and "\<forall> r \<in> R. Well_order r"
  10.399 +and "r \<in> R" and "p <o r"
  10.400 +shows "p <o omax R"
  10.401 +using assms omax_maxim[of R r] apply simp
  10.402 +using ordLess_ordLeq_trans by blast
  10.403 +
  10.404 +lemma omax_ordLeq_mono:
  10.405 +assumes P: "finite P" and R: "finite R"
  10.406 +and NE_P: "P \<noteq> {}" and Well_R: "\<forall> r \<in> R. Well_order r"
  10.407 +and LEQ: "\<forall> p \<in> P. \<exists> r \<in> R. p \<le>o r"
  10.408 +shows "omax P \<le>o omax R"
  10.409 +proof-
  10.410 +  let ?mp = "omax P"  let ?mr = "omax R"
  10.411 +  {fix p assume "p : P"
  10.412 +   then obtain r where r: "r : R" and "p \<le>o r"
  10.413 +   using LEQ by blast
  10.414 +   moreover have "r <=o ?mr"
  10.415 +   using r R Well_R omax_maxim by blast
  10.416 +   ultimately have "p <=o ?mr"
  10.417 +   using ordLeq_transitive by blast
  10.418 +  }
  10.419 +  thus "?mp <=o ?mr"
  10.420 +  using NE_P P using omax_ordLeq by blast
  10.421 +qed
  10.422 +
  10.423 +lemma omax_ordLess_mono:
  10.424 +assumes P: "finite P" and R: "finite R"
  10.425 +and NE_P: "P \<noteq> {}" and Well_R: "\<forall> r \<in> R. Well_order r"
  10.426 +and LEQ: "\<forall> p \<in> P. \<exists> r \<in> R. p <o r"
  10.427 +shows "omax P <o omax R"
  10.428 +proof-
  10.429 +  let ?mp = "omax P"  let ?mr = "omax R"
  10.430 +  {fix p assume "p : P"
  10.431 +   then obtain r where r: "r : R" and "p <o r"
  10.432 +   using LEQ by blast
  10.433 +   moreover have "r <=o ?mr"
  10.434 +   using r R Well_R omax_maxim by blast
  10.435 +   ultimately have "p <o ?mr"
  10.436 +   using ordLess_ordLeq_trans by blast
  10.437 +  }
  10.438 +  thus "?mp <o ?mr"
  10.439 +  using NE_P P omax_ordLess by blast
  10.440 +qed
  10.441 +
  10.442 +
  10.443 +subsection {* Limit and succesor ordinals *}
  10.444 +
  10.445 +lemma embed_underS2:
  10.446 +assumes r: "Well_order r" and s: "Well_order s"  and g: "embed r s g" and a: "a \<in> Field r"
  10.447 +shows "g ` underS r a = underS s (g a)"
  10.448 +using embed_underS[OF assms] unfolding bij_betw_def by auto
  10.449 +
  10.450 +lemma bij_betw_insert:
  10.451 +assumes "b \<notin> A" and "f b \<notin> A'" and "bij_betw f A A'"
  10.452 +shows "bij_betw f (insert b A) (insert (f b) A')"
  10.453 +using notIn_Un_bij_betw[OF assms] by auto
  10.454 +
  10.455 +context wo_rel
  10.456 +begin
  10.457 +
  10.458 +lemma underS_induct:
  10.459 +  assumes "\<And>a. (\<And> a1. a1 \<in> underS a \<Longrightarrow> P a1) \<Longrightarrow> P a"
  10.460 +  shows "P a"
  10.461 +  by (induct rule: well_order_induct) (rule assms, simp add: underS_def)
  10.462 +
  10.463 +lemma suc_underS:
  10.464 +assumes B: "B \<subseteq> Field r" and A: "AboveS B \<noteq> {}" and b: "b \<in> B"
  10.465 +shows "b \<in> underS (suc B)"
  10.466 +using suc_AboveS[OF B A] b unfolding underS_def AboveS_def by auto
  10.467 +
  10.468 +lemma underS_supr:
  10.469 +assumes bA: "b \<in> underS (supr A)" and A: "A \<subseteq> Field r"
  10.470 +shows "\<exists> a \<in> A. b \<in> underS a"
  10.471 +proof(rule ccontr, auto)
  10.472 +  have bb: "b \<in> Field r" using bA unfolding underS_def Field_def by auto
  10.473 +  assume "\<forall>a\<in>A.  b \<notin> underS a"
  10.474 +  hence 0: "\<forall>a \<in> A. (a,b) \<in> r" using A bA unfolding underS_def
  10.475 +  by simp (metis REFL in_mono max2_def max2_greater refl_on_domain)
  10.476 +  have "(supr A, b) \<in> r" apply(rule supr_least[OF A bb]) using 0 by auto
  10.477 +  thus False using bA unfolding underS_def by simp (metis ANTISYM antisymD)
  10.478 +qed
  10.479 +
  10.480 +lemma underS_suc:
  10.481 +assumes bA: "b \<in> underS (suc A)" and A: "A \<subseteq> Field r"
  10.482 +shows "\<exists> a \<in> A. b \<in> under a"
  10.483 +proof(rule ccontr, auto)
  10.484 +  have bb: "b \<in> Field r" using bA unfolding underS_def Field_def by auto
  10.485 +  assume "\<forall>a\<in>A.  b \<notin> under a"
  10.486 +  hence 0: "\<forall>a \<in> A. a \<in> underS b" using A bA unfolding underS_def
  10.487 +  by simp (metis (lifting) bb max2_def max2_greater mem_Collect_eq under_def set_rev_mp)
  10.488 +  have "(suc A, b) \<in> r" apply(rule suc_least[OF A bb]) using 0 unfolding underS_def by auto
  10.489 +  thus False using bA unfolding underS_def by simp (metis ANTISYM antisymD)
  10.490 +qed
  10.491 +
  10.492 +lemma (in wo_rel) in_underS_supr:
  10.493 +assumes j: "j \<in> underS i" and i: "i \<in> A" and A: "A \<subseteq> Field r" and AA: "Above A \<noteq> {}"
  10.494 +shows "j \<in> underS (supr A)"
  10.495 +proof-
  10.496 +  have "(i,supr A) \<in> r" using supr_greater[OF A AA i] .
  10.497 +  thus ?thesis using j unfolding underS_def
  10.498 +  by simp (metis REFL TRANS max2_def max2_equals1 refl_on_domain transD)
  10.499 +qed
  10.500 +
  10.501 +lemma inj_on_Field:
  10.502 +assumes A: "A \<subseteq> Field r" and f: "\<And> a b. \<lbrakk>a \<in> A; b \<in> A; a \<in> underS b\<rbrakk> \<Longrightarrow> f a \<noteq> f b"
  10.503 +shows "inj_on f A"
  10.504 +unfolding inj_on_def proof safe
  10.505 +  fix a b assume a: "a \<in> A" and b: "b \<in> A" and fab: "f a = f b"
  10.506 +  {assume "a \<in> underS b"
  10.507 +   hence False using f[OF a b] fab by auto
  10.508 +  }
  10.509 +  moreover
  10.510 +  {assume "b \<in> underS a"
  10.511 +   hence False using f[OF b a] fab by auto
  10.512 +  }
  10.513 +  ultimately show "a = b" using TOTALS A a b unfolding underS_def by auto
  10.514 +qed
  10.515 +
  10.516 +lemma in_notinI:
  10.517 +assumes "(j,i) \<notin> r \<or> j = i" and "i \<in> Field r" and "j \<in> Field r"
  10.518 +shows "(i,j) \<in> r" by (metis assms max2_def max2_greater_among)
  10.519 +
  10.520 +lemma ofilter_init_seg_of:
  10.521 +assumes "ofilter F"
  10.522 +shows "Restr r F initial_segment_of r"
  10.523 +using assms unfolding ofilter_def init_seg_of_def under_def by auto
  10.524 +
  10.525 +lemma underS_init_seg_of_Collect:
  10.526 +assumes "\<And>j1 j2. \<lbrakk>j2 \<in> underS i; (j1, j2) \<in> r\<rbrakk> \<Longrightarrow> R j1 initial_segment_of R j2"
  10.527 +shows "{R j |j. j \<in> underS i} \<in> Chains init_seg_of"
  10.528 +unfolding Chains_def proof safe
  10.529 +  fix j ja assume jS: "j \<in> underS i" and jaS: "ja \<in> underS i"
  10.530 +  and init: "(R ja, R j) \<notin> init_seg_of"
  10.531 +  hence jja: "{j,ja} \<subseteq> Field r" and j: "j \<in> Field r" and ja: "ja \<in> Field r"
  10.532 +  and jjai: "(j,i) \<in> r" "(ja,i) \<in> r"
  10.533 +  and i: "i \<notin> {j,ja}" unfolding Field_def underS_def by auto
  10.534 +  have jj: "(j,j) \<in> r" and jaja: "(ja,ja) \<in> r" using j ja by (metis in_notinI)+
  10.535 +  show "R j initial_segment_of R ja"
  10.536 +  using jja init jjai i
  10.537 +  by (elim cases_Total3 disjE) (auto elim: cases_Total3 intro!: assms simp: underS_def)
  10.538 +qed
  10.539 +
  10.540 +lemma (in wo_rel) Field_init_seg_of_Collect:
  10.541 +assumes "\<And>j1 j2. \<lbrakk>j2 \<in> Field r; (j1, j2) \<in> r\<rbrakk> \<Longrightarrow> R j1 initial_segment_of R j2"
  10.542 +shows "{R j |j. j \<in> Field r} \<in> Chains init_seg_of"
  10.543 +unfolding Chains_def proof safe
  10.544 +  fix j ja assume jS: "j \<in> Field r" and jaS: "ja \<in> Field r"
  10.545 +  and init: "(R ja, R j) \<notin> init_seg_of"
  10.546 +  hence jja: "{j,ja} \<subseteq> Field r" and j: "j \<in> Field r" and ja: "ja \<in> Field r"
  10.547 +  unfolding Field_def underS_def by auto
  10.548 +  have jj: "(j,j) \<in> r" and jaja: "(ja,ja) \<in> r" using j ja by (metis in_notinI)+
  10.549 +  show "R j initial_segment_of R ja"
  10.550 +  using jja init
  10.551 +  by (elim cases_Total3 disjE) (auto elim: cases_Total3 intro!: assms simp: Field_def)
  10.552 +qed
  10.553 +
  10.554 +subsubsection {* Successor and limit elements of an ordinal *}
  10.555 +
  10.556 +definition "succ i \<equiv> suc {i}"
  10.557 +
  10.558 +definition "isSucc i \<equiv> \<exists> j. aboveS j \<noteq> {} \<and> i = succ j"
  10.559 +
  10.560 +definition "zero = minim (Field r)"
  10.561 +
  10.562 +definition "isLim i \<equiv> \<not> isSucc i"
  10.563 +
  10.564 +lemma zero_smallest[simp]:
  10.565 +assumes "j \<in> Field r" shows "(zero, j) \<in> r"
  10.566 +unfolding zero_def
  10.567 +by (metis AboveS_Field assms subset_AboveS_UnderS subset_antisym subset_refl suc_def suc_least_AboveS)
  10.568 +
  10.569 +lemma zero_in_Field: assumes "Field r \<noteq> {}"  shows "zero \<in> Field r"
  10.570 +using assms unfolding zero_def by (metis Field_ofilter minim_in ofilter_def)
  10.571 +
  10.572 +lemma leq_zero_imp[simp]:
  10.573 +"(x, zero) \<in> r \<Longrightarrow> x = zero"
  10.574 +by (metis ANTISYM WELL antisymD well_order_on_domain zero_smallest)
  10.575 +
  10.576 +lemma leq_zero[simp]:
  10.577 +assumes "Field r \<noteq> {}"  shows "(x, zero) \<in> r \<longleftrightarrow> x = zero"
  10.578 +using zero_in_Field[OF assms] in_notinI[of x zero] by auto
  10.579 +
  10.580 +lemma under_zero[simp]:
  10.581 +assumes "Field r \<noteq> {}" shows "under zero = {zero}"
  10.582 +using assms unfolding under_def by auto
  10.583 +
  10.584 +lemma underS_zero[simp,intro]: "underS zero = {}"
  10.585 +unfolding underS_def by auto
  10.586 +
  10.587 +lemma isSucc_succ: "aboveS i \<noteq> {} \<Longrightarrow> isSucc (succ i)"
  10.588 +unfolding isSucc_def succ_def by auto
  10.589 +
  10.590 +lemma succ_in_diff:
  10.591 +assumes "aboveS i \<noteq> {}"  shows "(i,succ i) \<in> r \<and> succ i \<noteq> i"
  10.592 +using assms suc_greater[of "{i}"] unfolding succ_def AboveS_def aboveS_def Field_def by auto
  10.593 +
  10.594 +lemmas succ_in[simp] = succ_in_diff[THEN conjunct1]
  10.595 +lemmas succ_diff[simp] = succ_in_diff[THEN conjunct2]
  10.596 +
  10.597 +lemma succ_in_Field[simp]:
  10.598 +assumes "aboveS i \<noteq> {}"  shows "succ i \<in> Field r"
  10.599 +using succ_in[OF assms] unfolding Field_def by auto
  10.600 +
  10.601 +lemma succ_not_in:
  10.602 +assumes "aboveS i \<noteq> {}" shows "(succ i, i) \<notin> r"
  10.603 +proof
  10.604 +  assume 1: "(succ i, i) \<in> r"
  10.605 +  hence "succ i \<in> Field r \<and> i \<in> Field r" unfolding Field_def by auto
  10.606 +  hence "(i, succ i) \<in> r \<and> succ i \<noteq> i" using assms by auto
  10.607 +  thus False using 1 by (metis ANTISYM antisymD)
  10.608 +qed
  10.609 +
  10.610 +lemma not_isSucc_zero: "\<not> isSucc zero"
  10.611 +proof
  10.612 +  assume "isSucc zero"
  10.613 +  moreover
  10.614 +  then obtain i where "aboveS i \<noteq> {}" and 1: "minim (Field r) = succ i"
  10.615 +  unfolding isSucc_def zero_def by auto
  10.616 +  hence "succ i \<in> Field r" by auto
  10.617 +  ultimately show False by (metis REFL isSucc_def minim_least refl_on_domain
  10.618 +    subset_refl succ_in succ_not_in zero_def)
  10.619 +qed
  10.620 +
  10.621 +lemma isLim_zero[simp]: "isLim zero"
  10.622 +  by (metis isLim_def not_isSucc_zero)
  10.623 +
  10.624 +lemma succ_smallest:
  10.625 +assumes "(i,j) \<in> r" and "i \<noteq> j"
  10.626 +shows "(succ i, j) \<in> r"
  10.627 +unfolding succ_def apply(rule suc_least)
  10.628 +using assms unfolding Field_def by auto
  10.629 +
  10.630 +lemma isLim_supr:
  10.631 +assumes f: "i \<in> Field r" and l: "isLim i"
  10.632 +shows "i = supr (underS i)"
  10.633 +proof(rule equals_supr)
  10.634 +  fix j assume j: "j \<in> Field r" and 1: "\<And> j'. j' \<in> underS i \<Longrightarrow> (j',j) \<in> r"
  10.635 +  show "(i,j) \<in> r" proof(intro in_notinI[OF _ f j], safe)
  10.636 +    assume ji: "(j,i) \<in> r" "j \<noteq> i"
  10.637 +    hence a: "aboveS j \<noteq> {}" unfolding aboveS_def by auto
  10.638 +    hence "i \<noteq> succ j" using l unfolding isLim_def isSucc_def by auto
  10.639 +    moreover have "(succ j, i) \<in> r" using succ_smallest[OF ji] by auto
  10.640 +    ultimately have "succ j \<in> underS i" unfolding underS_def by auto
  10.641 +    hence "(succ j, j) \<in> r" using 1 by auto
  10.642 +    thus False using succ_not_in[OF a] by simp
  10.643 +  qed
  10.644 +qed(insert f, unfold underS_def Field_def, auto)
  10.645 +
  10.646 +definition "pred i \<equiv> SOME j. j \<in> Field r \<and> aboveS j \<noteq> {} \<and> succ j = i"
  10.647 +
  10.648 +lemma pred_Field_succ:
  10.649 +assumes "isSucc i" shows "pred i \<in> Field r \<and> aboveS (pred i) \<noteq> {} \<and> succ (pred i) = i"
  10.650 +proof-
  10.651 +  obtain j where a: "aboveS j \<noteq> {}" and i: "i = succ j" using assms unfolding isSucc_def by auto
  10.652 +  have 1: "j \<in> Field r" "j \<noteq> i" unfolding Field_def i
  10.653 +  using succ_diff[OF a] a unfolding aboveS_def by auto
  10.654 +  show ?thesis unfolding pred_def apply(rule someI_ex) using 1 i a by auto
  10.655 +qed
  10.656 +
  10.657 +lemmas pred_Field[simp] = pred_Field_succ[THEN conjunct1]
  10.658 +lemmas aboveS_pred[simp] = pred_Field_succ[THEN conjunct2, THEN conjunct1]
  10.659 +lemmas succ_pred[simp] = pred_Field_succ[THEN conjunct2, THEN conjunct2]
  10.660 +
  10.661 +lemma isSucc_pred_in:
  10.662 +assumes "isSucc i"  shows "(pred i, i) \<in> r"
  10.663 +proof-
  10.664 +  def j \<equiv> "pred i"
  10.665 +  have i: "i = succ j" using assms unfolding j_def by simp
  10.666 +  have a: "aboveS j \<noteq> {}" unfolding j_def using assms by auto
  10.667 +  show ?thesis unfolding j_def[symmetric] unfolding i using succ_in[OF a] .
  10.668 +qed
  10.669 +
  10.670 +lemma isSucc_pred_diff:
  10.671 +assumes "isSucc i"  shows "pred i \<noteq> i"
  10.672 +by (metis aboveS_pred assms succ_diff succ_pred)
  10.673 +
  10.674 +(* todo: pred maximal, pred injective? *)
  10.675 +
  10.676 +lemma succ_inj[simp]:
  10.677 +assumes "aboveS i \<noteq> {}" and "aboveS j \<noteq> {}"
  10.678 +shows "succ i = succ j \<longleftrightarrow> i = j"
  10.679 +proof safe
  10.680 +  assume s: "succ i = succ j"
  10.681 +  {assume "i \<noteq> j" and "(i,j) \<in> r"
  10.682 +   hence "(succ i, j) \<in> r" using assms by (metis succ_smallest)
  10.683 +   hence False using s assms by (metis succ_not_in)
  10.684 +  }
  10.685 +  moreover
  10.686 +  {assume "i \<noteq> j" and "(j,i) \<in> r"
  10.687 +   hence "(succ j, i) \<in> r" using assms by (metis succ_smallest)
  10.688 +   hence False using s assms by (metis succ_not_in)
  10.689 +  }
  10.690 +  ultimately show "i = j" by (metis TOTALS WELL assms(1) assms(2) succ_in_diff well_order_on_domain)
  10.691 +qed
  10.692 +
  10.693 +lemma pred_succ[simp]:
  10.694 +assumes "aboveS j \<noteq> {}"  shows "pred (succ j) = j"
  10.695 +unfolding pred_def apply(rule some_equality)
  10.696 +using assms apply(force simp: Field_def aboveS_def)
  10.697 +by (metis assms succ_inj)
  10.698 +
  10.699 +lemma less_succ[simp]:
  10.700 +assumes "aboveS i \<noteq> {}"
  10.701 +shows "(j, succ i) \<in> r \<longleftrightarrow> (j,i) \<in> r \<or> j = succ i"
  10.702 +apply safe
  10.703 +  apply (metis WELL assms in_notinI well_order_on_domain suc_singl_pred succ_def succ_in_diff)
  10.704 +  apply (metis (hide_lams, full_types) REFL TRANS assms max2_def max2_equals1 refl_on_domain succ_in_Field succ_not_in transD)
  10.705 +  apply (metis assms in_notinI succ_in_Field)
  10.706 +done
  10.707 +
  10.708 +lemma underS_succ[simp]:
  10.709 +assumes "aboveS i \<noteq> {}"
  10.710 +shows "underS (succ i) = under i"
  10.711 +unfolding underS_def under_def by (auto simp: assms succ_not_in)
  10.712 +
  10.713 +lemma succ_mono:
  10.714 +assumes "aboveS j \<noteq> {}" and "(i,j) \<in> r"
  10.715 +shows "(succ i, succ j) \<in> r"
  10.716 +by (metis (full_types) assms less_succ succ_smallest)
  10.717 +
  10.718 +lemma under_succ[simp]:
  10.719 +assumes "aboveS i \<noteq> {}"
  10.720 +shows "under (succ i) = insert (succ i) (under i)"
  10.721 +using less_succ[OF assms] unfolding under_def by auto
  10.722 +
  10.723 +definition mergeSL :: "('a \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> (('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b"
  10.724 +where
  10.725 +"mergeSL S L f i \<equiv>
  10.726 + if isSucc i then S (pred i) (f (pred i))
  10.727 + else L f i"
  10.728 +
  10.729 +
  10.730 +subsubsection {* Well-order recursion with (zero), succesor, and limit *}
  10.731 +
  10.732 +definition worecSL :: "('a \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> (('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b"
  10.733 +where "worecSL S L \<equiv> worec (mergeSL S L)"
  10.734 +
  10.735 +definition "adm_woL L \<equiv> \<forall>f g i. isLim i \<and> (\<forall>j\<in>underS i. f j = g j) \<longrightarrow> L f i = L g i"
  10.736 +
  10.737 +lemma mergeSL:
  10.738 +assumes "adm_woL L"  shows "adm_wo (mergeSL S L)"
  10.739 +unfolding adm_wo_def proof safe
  10.740 +  fix f g :: "'a => 'b" and i :: 'a
  10.741 +  assume 1: "\<forall>j\<in>underS i. f j = g j"
  10.742 +  show "mergeSL S L f i = mergeSL S L g i"
  10.743 +  proof(cases "isSucc i")
  10.744 +    case True
  10.745 +    hence "pred i \<in> underS i" unfolding underS_def using isSucc_pred_in isSucc_pred_diff by auto
  10.746 +    thus ?thesis using True 1 unfolding mergeSL_def by auto
  10.747 +  next
  10.748 +    case False hence "isLim i" unfolding isLim_def by auto
  10.749 +    thus ?thesis using assms False 1 unfolding mergeSL_def adm_woL_def by auto
  10.750 +  qed
  10.751 +qed
  10.752 +
  10.753 +lemma worec_fixpoint1: "adm_wo H \<Longrightarrow> worec H i = H (worec H) i"
  10.754 +by (metis worec_fixpoint)
  10.755 +
  10.756 +lemma worecSL_isSucc:
  10.757 +assumes a: "adm_woL L" and i: "isSucc i"
  10.758 +shows "worecSL S L i = S (pred i) (worecSL S L (pred i))"
  10.759 +proof-
  10.760 +  let ?H = "mergeSL S L"
  10.761 +  have "worecSL S L i = ?H (worec ?H) i"
  10.762 +  unfolding worecSL_def using worec_fixpoint1[OF mergeSL[OF a]] .
  10.763 +  also have "... = S (pred i) (worecSL S L (pred i))"
  10.764 +  unfolding worecSL_def mergeSL_def using i by simp
  10.765 +  finally show ?thesis .
  10.766 +qed
  10.767 +
  10.768 +lemma worecSL_succ:
  10.769 +assumes a: "adm_woL L" and i: "aboveS j \<noteq> {}"
  10.770 +shows "worecSL S L (succ j) = S j (worecSL S L j)"
  10.771 +proof-
  10.772 +  def i \<equiv> "succ j"
  10.773 +  have i: "isSucc i" by (metis i i_def isSucc_succ)
  10.774 +  have ij: "j = pred i" unfolding i_def using assms by simp
  10.775 +  have 0: "succ (pred i) = i" using i by simp
  10.776 +  show ?thesis unfolding ij using worecSL_isSucc[OF a i] unfolding 0 .
  10.777 +qed
  10.778 +
  10.779 +lemma worecSL_isLim:
  10.780 +assumes a: "adm_woL L" and i: "isLim i"
  10.781 +shows "worecSL S L i = L (worecSL S L) i"
  10.782 +proof-
  10.783 +  let ?H = "mergeSL S L"
  10.784 +  have "worecSL S L i = ?H (worec ?H) i"
  10.785 +  unfolding worecSL_def using worec_fixpoint1[OF mergeSL[OF a]] .
  10.786 +  also have "... = L (worecSL S L) i"
  10.787 +  using i unfolding worecSL_def mergeSL_def isLim_def by simp
  10.788 +  finally show ?thesis .
  10.789 +qed
  10.790 +
  10.791 +definition worecZSL :: "'b \<Rightarrow> ('a \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> (('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b"
  10.792 +where "worecZSL Z S L \<equiv> worecSL S (\<lambda> f a. if a = zero then Z else L f a)"
  10.793 +
  10.794 +lemma worecZSL_zero:
  10.795 +assumes a: "adm_woL L"
  10.796 +shows "worecZSL Z S L zero = Z"
  10.797 +proof-
  10.798 +  let ?L = "\<lambda> f a. if a = zero then Z else L f a"
  10.799 +  have "worecZSL Z S L zero = ?L (worecZSL Z S L) zero"
  10.800 +  unfolding worecZSL_def apply(rule worecSL_isLim)
  10.801 +  using assms unfolding adm_woL_def by auto
  10.802 +  also have "... = Z" by simp
  10.803 +  finally show ?thesis .
  10.804 +qed
  10.805 +
  10.806 +lemma worecZSL_succ:
  10.807 +assumes a: "adm_woL L" and i: "aboveS j \<noteq> {}"
  10.808 +shows "worecZSL Z S L (succ j) = S j (worecZSL Z S L j)"
  10.809 +unfolding worecZSL_def apply(rule  worecSL_succ)
  10.810 +using assms unfolding adm_woL_def by auto
  10.811 +
  10.812 +lemma worecZSL_isLim:
  10.813 +assumes a: "adm_woL L" and "isLim i" and "i \<noteq> zero"
  10.814 +shows "worecZSL Z S L i = L (worecZSL Z S L) i"
  10.815 +proof-
  10.816 +  let ?L = "\<lambda> f a. if a = zero then Z else L f a"
  10.817 +  have "worecZSL Z S L i = ?L (worecZSL Z S L) i"
  10.818 +  unfolding worecZSL_def apply(rule worecSL_isLim)
  10.819 +  using assms unfolding adm_woL_def by auto
  10.820 +  also have "... = L (worecZSL Z S L) i" using assms by simp
  10.821 +  finally show ?thesis .
  10.822 +qed
  10.823 +
  10.824 +
  10.825 +subsubsection {* Well-order succ-lim induction *}
  10.826 +
  10.827 +lemma ord_cases:
  10.828 +obtains j where "i = succ j" and "aboveS j \<noteq> {}"  | "isLim i"
  10.829 +by (metis isLim_def isSucc_def)
  10.830 +
  10.831 +lemma well_order_inductSL[case_names Suc Lim]:
  10.832 +assumes SUCC: "\<And>i. \<lbrakk>aboveS i \<noteq> {}; P i\<rbrakk> \<Longrightarrow> P (succ i)" and
  10.833 +LIM: "\<And>i. \<lbrakk>isLim i; \<And>j. j \<in> underS i \<Longrightarrow> P j\<rbrakk> \<Longrightarrow> P i"
  10.834 +shows "P i"
  10.835 +proof(induction rule: well_order_induct)
  10.836 +  fix i assume 0:  "\<forall>j. j \<noteq> i \<and> (j, i) \<in> r \<longrightarrow> P j"
  10.837 +  show "P i" proof(cases i rule: ord_cases)
  10.838 +    fix j assume i: "i = succ j" and j: "aboveS j \<noteq> {}"
  10.839 +    hence "j \<noteq> i \<and> (j, i) \<in> r" by (metis  succ_diff succ_in)
  10.840 +    hence 1: "P j" using 0 by simp
  10.841 +    show "P i" unfolding i apply(rule SUCC) using 1 j by auto
  10.842 +  qed(insert 0 LIM, unfold underS_def, auto)
  10.843 +qed
  10.844 +
  10.845 +lemma well_order_inductZSL[case_names Zero Suc Lim]:
  10.846 +assumes ZERO: "P zero"
  10.847 +and SUCC: "\<And>i. \<lbrakk>aboveS i \<noteq> {}; P i\<rbrakk> \<Longrightarrow> P (succ i)" and
  10.848 +LIM: "\<And>i. \<lbrakk>isLim i; i \<noteq> zero; \<And>j. j \<in> underS i \<Longrightarrow> P j\<rbrakk> \<Longrightarrow> P i"
  10.849 +shows "P i"
  10.850 +apply(induction rule: well_order_inductSL) using assms by auto
  10.851 +
  10.852 +(* Succesor and limit ordinals *)
  10.853 +definition "isSuccOrd \<equiv> \<exists> j \<in> Field r. \<forall> i \<in> Field r. (i,j) \<in> r"
  10.854 +definition "isLimOrd \<equiv> \<not> isSuccOrd"
  10.855 +
  10.856 +lemma isLimOrd_succ:
  10.857 +assumes isLimOrd and "i \<in> Field r"
  10.858 +shows "succ i \<in> Field r"
  10.859 +using assms unfolding isLimOrd_def isSuccOrd_def
  10.860 +by (metis REFL in_notinI refl_on_domain succ_smallest)
  10.861 +
  10.862 +lemma isLimOrd_aboveS:
  10.863 +assumes l: isLimOrd and i: "i \<in> Field r"
  10.864 +shows "aboveS i \<noteq> {}"
  10.865 +proof-
  10.866 +  obtain j where "j \<in> Field r" and "(j,i) \<notin> r"
  10.867 +  using assms unfolding isLimOrd_def isSuccOrd_def by auto
  10.868 +  hence "(i,j) \<in> r \<and> j \<noteq> i" by (metis i max2_def max2_greater)
  10.869 +  thus ?thesis unfolding aboveS_def by auto
  10.870 +qed
  10.871 +
  10.872 +lemma succ_aboveS_isLimOrd:
  10.873 +assumes "\<forall> i \<in> Field r. aboveS i \<noteq> {} \<and> succ i \<in> Field r"
  10.874 +shows isLimOrd
  10.875 +unfolding isLimOrd_def isSuccOrd_def proof safe
  10.876 +  fix j assume j: "j \<in> Field r" "\<forall>i\<in>Field r. (i, j) \<in> r"
  10.877 +  hence "(succ j, j) \<in> r" using assms by auto
  10.878 +  moreover have "aboveS j \<noteq> {}" using assms j unfolding aboveS_def by auto
  10.879 +  ultimately show False by (metis succ_not_in)
  10.880 +qed
  10.881 +
  10.882 +lemma isLim_iff:
  10.883 +assumes l: "isLim i" and j: "j \<in> underS i"
  10.884 +shows "\<exists> k. k \<in> underS i \<and> j \<in> underS k"
  10.885 +proof-
  10.886 +  have a: "aboveS j \<noteq> {}" using j unfolding underS_def aboveS_def by auto
  10.887 +  show ?thesis apply(rule exI[of _ "succ j"]) apply safe
  10.888 +  using assms a unfolding underS_def isLim_def
  10.889 +  apply (metis (lifting, full_types) isSucc_def mem_Collect_eq succ_smallest)
  10.890 +  by (metis (lifting, full_types) a mem_Collect_eq succ_diff succ_in)
  10.891 +qed
  10.892 +
  10.893 +end (* context wo_rel *)
  10.894 +
  10.895 +abbreviation "zero \<equiv> wo_rel.zero"
  10.896 +abbreviation "succ \<equiv> wo_rel.succ"
  10.897 +abbreviation "pred \<equiv> wo_rel.pred"
  10.898 +abbreviation "isSucc \<equiv> wo_rel.isSucc"
  10.899 +abbreviation "isLim \<equiv> wo_rel.isLim"
  10.900 +abbreviation "isLimOrd \<equiv> wo_rel.isLimOrd"
  10.901 +abbreviation "isSuccOrd \<equiv> wo_rel.isSuccOrd"
  10.902 +abbreviation "adm_woL \<equiv> wo_rel.adm_woL"
  10.903 +abbreviation "worecSL \<equiv> wo_rel.worecSL"
  10.904 +abbreviation "worecZSL \<equiv> wo_rel.worecZSL"
  10.905 +
  10.906 +
  10.907 +subsection {* Projections of wellorders *}
  10.908 +
  10.909 +definition "oproj r s f \<equiv> Field s \<subseteq> f ` (Field r) \<and> compat r s f"
  10.910 +
  10.911 +lemma oproj_in:
  10.912 +assumes "oproj r s f" and "(a,a') \<in> r"
  10.913 +shows "(f a, f a') \<in> s"
  10.914 +using assms unfolding oproj_def compat_def by auto
  10.915 +
  10.916 +lemma oproj_Field:
  10.917 +assumes f: "oproj r s f" and a: "a \<in> Field r"
  10.918 +shows "f a \<in> Field s"
  10.919 +using oproj_in[OF f] a unfolding Field_def by auto
  10.920 +
  10.921 +lemma oproj_Field2:
  10.922 +assumes f: "oproj r s f" and a: "b \<in> Field s"
  10.923 +shows "\<exists> a \<in> Field r. f a = b"
  10.924 +using assms unfolding oproj_def by auto
  10.925 +
  10.926 +lemma oproj_under:
  10.927 +assumes f:  "oproj r s f" and a: "a \<in> under r a'"
  10.928 +shows "f a \<in> under s (f a')"
  10.929 +using oproj_in[OF f] a unfolding under_def by auto
  10.930 +
  10.931 +(* An ordinal is embedded in another whenever it is embedded as an order
  10.932 +(not necessarily as initial segment):*)
  10.933 +theorem embedI:
  10.934 +assumes r: "Well_order r" and s: "Well_order s"
  10.935 +and f: "\<And> a. a \<in> Field r \<Longrightarrow> f a \<in> Field s \<and> f ` underS r a \<subseteq> underS s (f a)"
  10.936 +shows "\<exists> g. embed r s g"
  10.937 +proof-
  10.938 +  interpret r!: wo_rel r by unfold_locales (rule r)
  10.939 +  interpret s!: wo_rel s by unfold_locales (rule s)
  10.940 +  let ?G = "\<lambda> g a. suc s (g ` underS r a)"
  10.941 +  def g \<equiv> "worec r ?G"
  10.942 +  have adm: "adm_wo r ?G" unfolding r.adm_wo_def image_def by auto
  10.943 +  (*  *)
  10.944 +  {fix a assume "a \<in> Field r"
  10.945 +   hence "bij_betw g (under r a) (under s (g a)) \<and>
  10.946 +          g a \<in> under s (f a)"
  10.947 +   proof(induction a rule: r.underS_induct)
  10.948 +     case (1 a)
  10.949 +     hence a: "a \<in> Field r"
  10.950 +     and IH1a: "\<And> a1. a1 \<in> underS r a \<Longrightarrow> inj_on g (under r a1)"
  10.951 +     and IH1b: "\<And> a1. a1 \<in> underS r a \<Longrightarrow> g ` under r a1 = under s (g a1)"
  10.952 +     and IH2: "\<And> a1. a1 \<in> underS r a \<Longrightarrow> g a1 \<in> under s (f a1)"
  10.953 +     unfolding underS_def Field_def bij_betw_def by auto
  10.954 +     have fa: "f a \<in> Field s" using f[OF a] by auto
  10.955 +     have g: "g a = suc s (g ` underS r a)"
  10.956 +     using r.worec_fixpoint[OF adm] unfolding g_def fun_eq_iff by simp
  10.957 +     have A0: "g ` underS r a \<subseteq> Field s"
  10.958 +     using IH1b by (metis IH2 image_subsetI in_mono under_Field)
  10.959 +     {fix a1 assume a1: "a1 \<in> underS r a"
  10.960 +      from IH2[OF this] have "g a1 \<in> under s (f a1)" .
  10.961 +      moreover have "f a1 \<in> underS s (f a)" using f[OF a] a1 by auto
  10.962 +      ultimately have "g a1 \<in> underS s (f a)" by (metis s.ANTISYM s.TRANS under_underS_trans)
  10.963 +     }
  10.964 +     hence "f a \<in> AboveS s (g ` underS r a)" unfolding AboveS_def
  10.965 +     using fa by simp (metis (lifting, full_types) mem_Collect_eq underS_def)
  10.966 +     hence A: "AboveS s (g ` underS r a) \<noteq> {}" by auto
  10.967 +     have B: "\<And> a1. a1 \<in> underS r a \<Longrightarrow> g a1 \<in> underS s (g a)"
  10.968 +     unfolding g apply(rule s.suc_underS[OF A0 A]) by auto
  10.969 +     {fix a1 a2 assume a2: "a2 \<in> underS r a" and 1: "a1 \<in> underS r a2"
  10.970 +      hence a12: "{a1,a2} \<subseteq> under r a2" and "a1 \<noteq> a2" using r.REFL a
  10.971 +      unfolding underS_def under_def refl_on_def Field_def by auto
  10.972 +      hence "g a1 \<noteq> g a2" using IH1a[OF a2] unfolding inj_on_def by auto
  10.973 +      hence "g a1 \<in> underS s (g a2)" using IH1b[OF a2] a12
  10.974 +      unfolding underS_def under_def by auto
  10.975 +     } note C = this
  10.976 +     have ga: "g a \<in> Field s" unfolding g using s.suc_inField[OF A0 A] .
  10.977 +     have aa: "a \<in> under r a"
  10.978 +     using a r.REFL unfolding under_def underS_def refl_on_def by auto
  10.979 +     show ?case proof safe
  10.980 +       show "bij_betw g (under r a) (under s (g a))" unfolding bij_betw_def proof safe
  10.981 +         show "inj_on g (under r a)" proof(rule r.inj_on_Field)
  10.982 +           fix a1 a2 assume "a1 \<in> under r a" and a2: "a2 \<in> under r a" and a1: "a1 \<in> underS r a2"
  10.983 +           hence a22: "a2 \<in> under r a2" and a12: "a1 \<in> under r a2" "a1 \<noteq> a2"
  10.984 +           using a r.REFL unfolding under_def underS_def refl_on_def by auto
  10.985 +           show "g a1 \<noteq> g a2"
  10.986 +           proof(cases "a2 = a")
  10.987 +             case False hence "a2 \<in> underS r a"
  10.988 +             using a2 unfolding underS_def under_def by auto
  10.989 +             from IH1a[OF this] show ?thesis using a12 a22 unfolding inj_on_def by auto
  10.990 +           qed(insert B a1, unfold underS_def, auto)
  10.991 +         qed(unfold under_def Field_def, auto)
  10.992 +       next
  10.993 +         fix a1 assume a1: "a1 \<in> under r a"
  10.994 +         show "g a1 \<in> under s (g a)"
  10.995 +         proof(cases "a1 = a")
  10.996 +           case True thus ?thesis
  10.997 +           using ga s.REFL unfolding refl_on_def under_def by auto
  10.998 +         next
  10.999 +           case False
 10.1000 +           hence a1: "a1 \<in> underS r a" using a1 unfolding underS_def under_def by auto
 10.1001 +           thus ?thesis using B unfolding underS_def under_def by auto
 10.1002 +         qed
 10.1003 +       next
 10.1004 +         fix b1 assume b1: "b1 \<in> under s (g a)"
 10.1005 +         show "b1 \<in> g ` under r a"
 10.1006 +         proof(cases "b1 = g a")
 10.1007 +           case True thus ?thesis using aa by auto
 10.1008 +         next
 10.1009 +           case False
 10.1010 +           hence "b1 \<in> underS s (g a)" using b1 unfolding underS_def under_def by auto
 10.1011 +           from s.underS_suc[OF this[unfolded g] A0]
 10.1012 +           obtain a1 where a1: "a1 \<in> underS r a" and b1: "b1 \<in> under s (g a1)" by auto
 10.1013 +           obtain a2 where "a2 \<in> under r a1" and b1: "b1 = g a2" using IH1b[OF a1] b1 by auto
 10.1014 +           hence "a2 \<in> under r a" using a1
 10.1015 +           by (metis r.ANTISYM r.TRANS in_mono underS_subset_under under_underS_trans)
 10.1016 +           thus ?thesis using b1 by auto
 10.1017 +         qed
 10.1018 +       qed
 10.1019 +     next
 10.1020 +       have "(g a, f a) \<in> s" unfolding g proof(rule s.suc_least[OF A0])
 10.1021 +         fix b1 assume "b1 \<in> g ` underS r a"
 10.1022 +         then obtain a1 where a1: "b1 = g a1" and a1: "a1 \<in> underS r a" by auto
 10.1023 +         hence "b1 \<in> underS s (f a)"
 10.1024 +         using a by (metis `\<And>a1. a1 \<in> underS r a \<Longrightarrow> g a1 \<in> underS s (f a)`)
 10.1025 +         thus "f a \<noteq> b1 \<and> (b1, f a) \<in> s" unfolding underS_def by auto
 10.1026 +       qed(insert fa, auto)
 10.1027 +       thus "g a \<in> under s (f a)" unfolding under_def by auto
 10.1028 +     qed
 10.1029 +   qed
 10.1030 +  }
 10.1031 +  thus ?thesis unfolding embed_def by auto
 10.1032 +qed
 10.1033 +
 10.1034 +corollary ordLeq_def2:
 10.1035 +  "r \<le>o s \<longleftrightarrow> Well_order r \<and> Well_order s \<and>
 10.1036 +               (\<exists> f. \<forall> a \<in> Field r. f a \<in> Field s \<and> f ` underS r a \<subseteq> underS s (f a))"
 10.1037 +using embed_in_Field[of r s] embed_underS2[of r s] embedI[of r s]
 10.1038 +unfolding ordLeq_def by fast
 10.1039 +
 10.1040 +lemma iso_oproj:
 10.1041 +  assumes r: "Well_order r" and s: "Well_order s" and f: "iso r s f"
 10.1042 +  shows "oproj r s f"
 10.1043 +using assms unfolding oproj_def
 10.1044 +by (subst (asm) iso_iff3) (auto simp: bij_betw_def)
 10.1045 +
 10.1046 +theorem oproj_embed:
 10.1047 +assumes r: "Well_order r" and s: "Well_order s" and f: "oproj r s f"
 10.1048 +shows "\<exists> g. embed s r g"
 10.1049 +proof (rule embedI[OF s r, of "inv_into (Field r) f"], unfold underS_def, safe)
 10.1050 +  fix b assume "b \<in> Field s"
 10.1051 +  thus "inv_into (Field r) f b \<in> Field r" using oproj_Field2[OF f] by (metis imageI inv_into_into)
 10.1052 +next
 10.1053 +  fix a b assume "b \<in> Field s" "a \<noteq> b" "(a, b) \<in> s"
 10.1054 +    "inv_into (Field r) f a = inv_into (Field r) f b"
 10.1055 +  with f show False by (auto dest!: inv_into_injective simp: Field_def oproj_def)
 10.1056 +next
 10.1057 +  fix a b assume *: "b \<in> Field s" "a \<noteq> b" "(a, b) \<in> s"
 10.1058 +  { assume "(inv_into (Field r) f a, inv_into (Field r) f b) \<notin> r"
 10.1059 +    moreover
 10.1060 +    from *(3) have "a \<in> Field s" unfolding Field_def by auto
 10.1061 +    with *(1,2) have
 10.1062 +      "inv_into (Field r) f a \<in> Field r" "inv_into (Field r) f b \<in> Field r"
 10.1063 +      "inv_into (Field r) f a \<noteq> inv_into (Field r) f b"
 10.1064 +      by (auto dest!: oproj_Field2[OF f] inv_into_injective intro!: inv_into_into)
 10.1065 +    ultimately have "(inv_into (Field r) f b, inv_into (Field r) f a) \<in> r"
 10.1066 +      using r by (auto simp: well_order_on_def linear_order_on_def total_on_def)
 10.1067 +    with f[unfolded oproj_def compat_def] *(1) `a \<in> Field s`
 10.1068 +      f_inv_into_f[of b f "Field r"] f_inv_into_f[of a f "Field r"]
 10.1069 +      have "(b, a) \<in> s" by (metis in_mono)
 10.1070 +    with *(2,3) s have False
 10.1071 +      by (auto simp: well_order_on_def linear_order_on_def partial_order_on_def antisym_def)
 10.1072 +  } thus "(inv_into (Field r) f a, inv_into (Field r) f b) \<in> r" by blast
 10.1073 +qed
 10.1074 +
 10.1075 +corollary oproj_ordLeq:
 10.1076 +assumes r: "Well_order r" and s: "Well_order s" and f: "oproj r s f"
 10.1077 +shows "s \<le>o r"
 10.1078 +using oproj_embed[OF assms] r s unfolding ordLeq_def by auto
 10.1079 +
 10.1080 +end