renamed '_FP' files to 'BNF_' files
authorblanchet
Mon Jan 20 18:24:55 2014 +0100 (2014-01-20)
changeset 55056b5c94200d081
parent 55055 3f0dfce0e27a
child 55057 6b0fcbeebaba
renamed '_FP' files to 'BNF_' files
src/HOL/BNF/BNF_Util.thy
src/HOL/BNF_Cardinal_Arithmetic.thy
src/HOL/BNF_Cardinal_Order_Relation.thy
src/HOL/BNF_Constructions_on_Wellorders.thy
src/HOL/BNF_Wellorder_Embedding.thy
src/HOL/BNF_Wellorder_Relation.thy
src/HOL/Cardinal_Arithmetic_FP.thy
src/HOL/Cardinal_Order_Relation_FP.thy
src/HOL/Cardinals/Cardinal_Arithmetic.thy
src/HOL/Cardinals/Cardinal_Order_Relation.thy
src/HOL/Cardinals/Constructions_on_Wellorders.thy
src/HOL/Cardinals/README.txt
src/HOL/Cardinals/Wellorder_Embedding.thy
src/HOL/Cardinals/Wellorder_Relation.thy
src/HOL/Constructions_on_Wellorders_FP.thy
src/HOL/Main.thy
src/HOL/Wellorder_Embedding_FP.thy
src/HOL/Wellorder_Relation_FP.thy
     1.1 --- a/src/HOL/BNF/BNF_Util.thy	Mon Jan 20 18:24:55 2014 +0100
     1.2 +++ b/src/HOL/BNF/BNF_Util.thy	Mon Jan 20 18:24:55 2014 +0100
     1.3 @@ -9,7 +9,7 @@
     1.4  header {* Library for Bounded Natural Functors *}
     1.5  
     1.6  theory BNF_Util
     1.7 -imports Cardinal_Arithmetic_FP
     1.8 +imports BNF_Cardinal_Arithmetic
     1.9    Transfer (*FIXME: define fun_rel here, reuse in Transfer once this theory is in HOL*)
    1.10  begin
    1.11  
     2.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     2.2 +++ b/src/HOL/BNF_Cardinal_Arithmetic.thy	Mon Jan 20 18:24:55 2014 +0100
     2.3 @@ -0,0 +1,706 @@
     2.4 +(*  Title:      HOL/BNF_Cardinal_Arithmetic.thy
     2.5 +    Author:     Dmitriy Traytel, TU Muenchen
     2.6 +    Copyright   2012
     2.7 +
     2.8 +Cardinal arithmetic (BNF).
     2.9 +*)
    2.10 +
    2.11 +header {* Cardinal Arithmetic (BNF) *}
    2.12 +
    2.13 +theory BNF_Cardinal_Arithmetic
    2.14 +imports BNF_Cardinal_Order_Relation
    2.15 +begin
    2.16 +
    2.17 +lemma dir_image: "\<lbrakk>\<And>x y. (f x = f y) = (x = y); Card_order r\<rbrakk> \<Longrightarrow> r =o dir_image r f"
    2.18 +by (rule dir_image_ordIso) (auto simp add: inj_on_def card_order_on_def)
    2.19 +
    2.20 +(*should supersede a weaker lemma from the library*)
    2.21 +lemma dir_image_Field: "Field (dir_image r f) = f ` Field r"
    2.22 +unfolding dir_image_def Field_def Range_def Domain_def by fast
    2.23 +
    2.24 +lemma card_order_dir_image:
    2.25 +  assumes bij: "bij f" and co: "card_order r"
    2.26 +  shows "card_order (dir_image r f)"
    2.27 +proof -
    2.28 +  from assms have "Field (dir_image r f) = UNIV"
    2.29 +    using card_order_on_Card_order[of UNIV r] unfolding bij_def dir_image_Field by auto
    2.30 +  moreover from bij have "\<And>x y. (f x = f y) = (x = y)" unfolding bij_def inj_on_def by auto
    2.31 +  with co have "Card_order (dir_image r f)"
    2.32 +    using card_order_on_Card_order[of UNIV r] Card_order_ordIso2[OF _ dir_image] by blast
    2.33 +  ultimately show ?thesis by auto
    2.34 +qed
    2.35 +
    2.36 +lemma ordIso_refl: "Card_order r \<Longrightarrow> r =o r"
    2.37 +by (rule card_order_on_ordIso)
    2.38 +
    2.39 +lemma ordLeq_refl: "Card_order r \<Longrightarrow> r \<le>o r"
    2.40 +by (rule ordIso_imp_ordLeq, rule card_order_on_ordIso)
    2.41 +
    2.42 +lemma card_of_ordIso_subst: "A = B \<Longrightarrow> |A| =o |B|"
    2.43 +by (simp only: ordIso_refl card_of_Card_order)
    2.44 +
    2.45 +lemma Field_card_order: "card_order r \<Longrightarrow> Field r = UNIV"
    2.46 +using card_order_on_Card_order[of UNIV r] by simp
    2.47 +
    2.48 +lemma card_of_Times_Plus_distrib:
    2.49 +  "|A <*> (B <+> C)| =o |A <*> B <+> A <*> C|" (is "|?RHS| =o |?LHS|")
    2.50 +proof -
    2.51 +  let ?f = "\<lambda>(a, bc). case bc of Inl b \<Rightarrow> Inl (a, b) | Inr c \<Rightarrow> Inr (a, c)"
    2.52 +  have "bij_betw ?f ?RHS ?LHS" unfolding bij_betw_def inj_on_def by force
    2.53 +  thus ?thesis using card_of_ordIso by blast
    2.54 +qed
    2.55 +
    2.56 +lemma Func_Times_Range:
    2.57 +  "|Func A (B <*> C)| =o |Func A B <*> Func A C|" (is "|?LHS| =o |?RHS|")
    2.58 +proof -
    2.59 +  let ?F = "\<lambda>fg. (\<lambda>x. if x \<in> A then fst (fg x) else undefined,
    2.60 +                  \<lambda>x. if x \<in> A then snd (fg x) else undefined)"
    2.61 +  let ?G = "\<lambda>(f, g) x. if x \<in> A then (f x, g x) else undefined"
    2.62 +  have "bij_betw ?F ?LHS ?RHS" unfolding bij_betw_def inj_on_def
    2.63 +  apply safe
    2.64 +     apply (simp add: Func_def fun_eq_iff)
    2.65 +     apply (metis (no_types) pair_collapse)
    2.66 +    apply (auto simp: Func_def fun_eq_iff)[2]
    2.67 +  proof -
    2.68 +    fix f g assume "f \<in> Func A B" "g \<in> Func A C"
    2.69 +    thus "(f, g) \<in> ?F ` Func A (B \<times> C)"
    2.70 +      by (intro image_eqI[of _ _ "?G (f, g)"]) (auto simp: Func_def)
    2.71 +  qed
    2.72 +  thus ?thesis using card_of_ordIso by blast
    2.73 +qed
    2.74 +
    2.75 +
    2.76 +subsection {* Zero *}
    2.77 +
    2.78 +definition czero where
    2.79 +  "czero = card_of {}"
    2.80 +
    2.81 +lemma czero_ordIso:
    2.82 +  "czero =o czero"
    2.83 +using card_of_empty_ordIso by (simp add: czero_def)
    2.84 +
    2.85 +lemma card_of_ordIso_czero_iff_empty:
    2.86 +  "|A| =o (czero :: 'b rel) \<longleftrightarrow> A = ({} :: 'a set)"
    2.87 +unfolding czero_def by (rule iffI[OF card_of_empty2]) (auto simp: card_of_refl card_of_empty_ordIso)
    2.88 +
    2.89 +(* A "not czero" Cardinal predicate *)
    2.90 +abbreviation Cnotzero where
    2.91 +  "Cnotzero (r :: 'a rel) \<equiv> \<not>(r =o (czero :: 'a rel)) \<and> Card_order r"
    2.92 +
    2.93 +(*helper*)
    2.94 +lemma Cnotzero_imp_not_empty: "Cnotzero r \<Longrightarrow> Field r \<noteq> {}"
    2.95 +by (metis Card_order_iff_ordIso_card_of czero_def)
    2.96 +
    2.97 +lemma czeroI:
    2.98 +  "\<lbrakk>Card_order r; Field r = {}\<rbrakk> \<Longrightarrow> r =o czero"
    2.99 +using Cnotzero_imp_not_empty ordIso_transitive[OF _ czero_ordIso] by blast
   2.100 +
   2.101 +lemma czeroE:
   2.102 +  "r =o czero \<Longrightarrow> Field r = {}"
   2.103 +unfolding czero_def
   2.104 +by (drule card_of_cong) (simp only: Field_card_of card_of_empty2)
   2.105 +
   2.106 +lemma Cnotzero_mono:
   2.107 +  "\<lbrakk>Cnotzero r; Card_order q; r \<le>o q\<rbrakk> \<Longrightarrow> Cnotzero q"
   2.108 +apply (rule ccontr)
   2.109 +apply auto
   2.110 +apply (drule czeroE)
   2.111 +apply (erule notE)
   2.112 +apply (erule czeroI)
   2.113 +apply (drule card_of_mono2)
   2.114 +apply (simp only: card_of_empty3)
   2.115 +done
   2.116 +
   2.117 +subsection {* (In)finite cardinals *}
   2.118 +
   2.119 +definition cinfinite where
   2.120 +  "cinfinite r = (\<not> finite (Field r))"
   2.121 +
   2.122 +abbreviation Cinfinite where
   2.123 +  "Cinfinite r \<equiv> cinfinite r \<and> Card_order r"
   2.124 +
   2.125 +definition cfinite where
   2.126 +  "cfinite r = finite (Field r)"
   2.127 +
   2.128 +abbreviation Cfinite where
   2.129 +  "Cfinite r \<equiv> cfinite r \<and> Card_order r"
   2.130 +
   2.131 +lemma Cfinite_ordLess_Cinfinite: "\<lbrakk>Cfinite r; Cinfinite s\<rbrakk> \<Longrightarrow> r <o s"
   2.132 +  unfolding cfinite_def cinfinite_def
   2.133 +  by (metis card_order_on_well_order_on finite_ordLess_infinite)
   2.134 +
   2.135 +lemmas natLeq_card_order = natLeq_Card_order[unfolded Field_natLeq]
   2.136 +
   2.137 +lemma natLeq_cinfinite: "cinfinite natLeq"
   2.138 +unfolding cinfinite_def Field_natLeq by (metis infinite_UNIV_nat)
   2.139 +
   2.140 +lemma natLeq_ordLeq_cinfinite:
   2.141 +  assumes inf: "Cinfinite r"
   2.142 +  shows "natLeq \<le>o r"
   2.143 +proof -
   2.144 +  from inf have "natLeq \<le>o |Field r|" by (metis cinfinite_def infinite_iff_natLeq_ordLeq)
   2.145 +  also from inf have "|Field r| =o r" by (simp add: card_of_unique ordIso_symmetric)
   2.146 +  finally show ?thesis .
   2.147 +qed
   2.148 +
   2.149 +lemma cinfinite_not_czero: "cinfinite r \<Longrightarrow> \<not> (r =o (czero :: 'a rel))"
   2.150 +unfolding cinfinite_def by (metis czeroE finite.emptyI)
   2.151 +
   2.152 +lemma Cinfinite_Cnotzero: "Cinfinite r \<Longrightarrow> Cnotzero r"
   2.153 +by (metis cinfinite_not_czero)
   2.154 +
   2.155 +lemma Cinfinite_cong: "\<lbrakk>r1 =o r2; Cinfinite r1\<rbrakk> \<Longrightarrow> Cinfinite r2"
   2.156 +by (metis Card_order_ordIso2 card_of_mono2 card_of_ordLeq_infinite cinfinite_def ordIso_iff_ordLeq)
   2.157 +
   2.158 +lemma cinfinite_mono: "\<lbrakk>r1 \<le>o r2; cinfinite r1\<rbrakk> \<Longrightarrow> cinfinite r2"
   2.159 +by (metis card_of_mono2 card_of_ordLeq_infinite cinfinite_def)
   2.160 +
   2.161 +
   2.162 +subsection {* Binary sum *}
   2.163 +
   2.164 +definition csum (infixr "+c" 65) where
   2.165 +  "r1 +c r2 \<equiv> |Field r1 <+> Field r2|"
   2.166 +
   2.167 +lemma Field_csum: "Field (r +c s) = Inl ` Field r \<union> Inr ` Field s"
   2.168 +  unfolding csum_def Field_card_of by auto
   2.169 +
   2.170 +lemma Card_order_csum:
   2.171 +  "Card_order (r1 +c r2)"
   2.172 +unfolding csum_def by (simp add: card_of_Card_order)
   2.173 +
   2.174 +lemma csum_Cnotzero1:
   2.175 +  "Cnotzero r1 \<Longrightarrow> Cnotzero (r1 +c r2)"
   2.176 +unfolding csum_def
   2.177 +by (metis Cnotzero_imp_not_empty Plus_eq_empty_conv card_of_Card_order card_of_ordIso_czero_iff_empty)
   2.178 +
   2.179 +lemma card_order_csum:
   2.180 +  assumes "card_order r1" "card_order r2"
   2.181 +  shows "card_order (r1 +c r2)"
   2.182 +proof -
   2.183 +  have "Field r1 = UNIV" "Field r2 = UNIV" using assms card_order_on_Card_order by auto
   2.184 +  thus ?thesis unfolding csum_def by (auto simp: card_of_card_order_on)
   2.185 +qed
   2.186 +
   2.187 +lemma cinfinite_csum:
   2.188 +  "cinfinite r1 \<or> cinfinite r2 \<Longrightarrow> cinfinite (r1 +c r2)"
   2.189 +unfolding cinfinite_def csum_def by (auto simp: Field_card_of)
   2.190 +
   2.191 +lemma Cinfinite_csum1:
   2.192 +  "Cinfinite r1 \<Longrightarrow> Cinfinite (r1 +c r2)"
   2.193 +unfolding cinfinite_def csum_def by (metis Field_card_of card_of_Card_order finite_Plus_iff)
   2.194 +
   2.195 +lemma Cinfinite_csum:
   2.196 +  "Cinfinite r1 \<or> Cinfinite r2 \<Longrightarrow> Cinfinite (r1 +c r2)"
   2.197 +unfolding cinfinite_def csum_def by (metis Field_card_of card_of_Card_order finite_Plus_iff)
   2.198 +
   2.199 +lemma Cinfinite_csum_strong:
   2.200 +  "\<lbrakk>Cinfinite r1; Cinfinite r2\<rbrakk> \<Longrightarrow> Cinfinite (r1 +c r2)"
   2.201 +by (metis Cinfinite_csum)
   2.202 +
   2.203 +lemma csum_cong: "\<lbrakk>p1 =o r1; p2 =o r2\<rbrakk> \<Longrightarrow> p1 +c p2 =o r1 +c r2"
   2.204 +by (simp only: csum_def ordIso_Plus_cong)
   2.205 +
   2.206 +lemma csum_cong1: "p1 =o r1 \<Longrightarrow> p1 +c q =o r1 +c q"
   2.207 +by (simp only: csum_def ordIso_Plus_cong1)
   2.208 +
   2.209 +lemma csum_cong2: "p2 =o r2 \<Longrightarrow> q +c p2 =o q +c r2"
   2.210 +by (simp only: csum_def ordIso_Plus_cong2)
   2.211 +
   2.212 +lemma csum_mono: "\<lbrakk>p1 \<le>o r1; p2 \<le>o r2\<rbrakk> \<Longrightarrow> p1 +c p2 \<le>o r1 +c r2"
   2.213 +by (simp only: csum_def ordLeq_Plus_mono)
   2.214 +
   2.215 +lemma csum_mono1: "p1 \<le>o r1 \<Longrightarrow> p1 +c q \<le>o r1 +c q"
   2.216 +by (simp only: csum_def ordLeq_Plus_mono1)
   2.217 +
   2.218 +lemma csum_mono2: "p2 \<le>o r2 \<Longrightarrow> q +c p2 \<le>o q +c r2"
   2.219 +by (simp only: csum_def ordLeq_Plus_mono2)
   2.220 +
   2.221 +lemma ordLeq_csum1: "Card_order p1 \<Longrightarrow> p1 \<le>o p1 +c p2"
   2.222 +by (simp only: csum_def Card_order_Plus1)
   2.223 +
   2.224 +lemma ordLeq_csum2: "Card_order p2 \<Longrightarrow> p2 \<le>o p1 +c p2"
   2.225 +by (simp only: csum_def Card_order_Plus2)
   2.226 +
   2.227 +lemma csum_com: "p1 +c p2 =o p2 +c p1"
   2.228 +by (simp only: csum_def card_of_Plus_commute)
   2.229 +
   2.230 +lemma csum_assoc: "(p1 +c p2) +c p3 =o p1 +c p2 +c p3"
   2.231 +by (simp only: csum_def Field_card_of card_of_Plus_assoc)
   2.232 +
   2.233 +lemma Cfinite_csum: "\<lbrakk>Cfinite r; Cfinite s\<rbrakk> \<Longrightarrow> Cfinite (r +c s)"
   2.234 +  unfolding cfinite_def csum_def Field_card_of using card_of_card_order_on by simp
   2.235 +
   2.236 +lemma csum_csum: "(r1 +c r2) +c (r3 +c r4) =o (r1 +c r3) +c (r2 +c r4)"
   2.237 +proof -
   2.238 +  have "(r1 +c r2) +c (r3 +c r4) =o r1 +c r2 +c (r3 +c r4)"
   2.239 +    by (metis csum_assoc)
   2.240 +  also have "r1 +c r2 +c (r3 +c r4) =o r1 +c (r2 +c r3) +c r4"
   2.241 +    by (metis csum_assoc csum_cong2 ordIso_symmetric)
   2.242 +  also have "r1 +c (r2 +c r3) +c r4 =o r1 +c (r3 +c r2) +c r4"
   2.243 +    by (metis csum_com csum_cong1 csum_cong2)
   2.244 +  also have "r1 +c (r3 +c r2) +c r4 =o r1 +c r3 +c r2 +c r4"
   2.245 +    by (metis csum_assoc csum_cong2 ordIso_symmetric)
   2.246 +  also have "r1 +c r3 +c r2 +c r4 =o (r1 +c r3) +c (r2 +c r4)"
   2.247 +    by (metis csum_assoc ordIso_symmetric)
   2.248 +  finally show ?thesis .
   2.249 +qed
   2.250 +
   2.251 +lemma Plus_csum: "|A <+> B| =o |A| +c |B|"
   2.252 +by (simp only: csum_def Field_card_of card_of_refl)
   2.253 +
   2.254 +lemma Un_csum: "|A \<union> B| \<le>o |A| +c |B|"
   2.255 +using ordLeq_ordIso_trans[OF card_of_Un_Plus_ordLeq Plus_csum] by blast
   2.256 +
   2.257 +
   2.258 +subsection {* One *}
   2.259 +
   2.260 +definition cone where
   2.261 +  "cone = card_of {()}"
   2.262 +
   2.263 +lemma Card_order_cone: "Card_order cone"
   2.264 +unfolding cone_def by (rule card_of_Card_order)
   2.265 +
   2.266 +lemma Cfinite_cone: "Cfinite cone"
   2.267 +  unfolding cfinite_def by (simp add: Card_order_cone)
   2.268 +
   2.269 +lemma cone_not_czero: "\<not> (cone =o czero)"
   2.270 +unfolding czero_def cone_def by (metis empty_not_insert card_of_empty3[of "{()}"] ordIso_iff_ordLeq)
   2.271 +
   2.272 +lemma cone_ordLeq_Cnotzero: "Cnotzero r \<Longrightarrow> cone \<le>o r"
   2.273 +unfolding cone_def by (metis Card_order_singl_ordLeq czeroI)
   2.274 +
   2.275 +
   2.276 +subsection {* Two *}
   2.277 +
   2.278 +definition ctwo where
   2.279 +  "ctwo = |UNIV :: bool set|"
   2.280 +
   2.281 +lemma Card_order_ctwo: "Card_order ctwo"
   2.282 +unfolding ctwo_def by (rule card_of_Card_order)
   2.283 +
   2.284 +lemma ctwo_not_czero: "\<not> (ctwo =o czero)"
   2.285 +using card_of_empty3[of "UNIV :: bool set"] ordIso_iff_ordLeq
   2.286 +unfolding czero_def ctwo_def by (metis UNIV_not_empty)
   2.287 +
   2.288 +lemma ctwo_Cnotzero: "Cnotzero ctwo"
   2.289 +by (simp add: ctwo_not_czero Card_order_ctwo)
   2.290 +
   2.291 +
   2.292 +subsection {* Family sum *}
   2.293 +
   2.294 +definition Csum where
   2.295 +  "Csum r rs \<equiv> |SIGMA i : Field r. Field (rs i)|"
   2.296 +
   2.297 +(* Similar setup to the one for SIGMA from theory Big_Operators: *)
   2.298 +syntax "_Csum" ::
   2.299 +  "pttrn => ('a * 'a) set => 'b * 'b set => (('a * 'b) * ('a * 'b)) set"
   2.300 +  ("(3CSUM _:_. _)" [0, 51, 10] 10)
   2.301 +
   2.302 +translations
   2.303 +  "CSUM i:r. rs" == "CONST Csum r (%i. rs)"
   2.304 +
   2.305 +lemma SIGMA_CSUM: "|SIGMA i : I. As i| = (CSUM i : |I|. |As i| )"
   2.306 +by (auto simp: Csum_def Field_card_of)
   2.307 +
   2.308 +(* NB: Always, under the cardinal operator,
   2.309 +operations on sets are reduced automatically to operations on cardinals.
   2.310 +This should make cardinal reasoning more direct and natural.  *)
   2.311 +
   2.312 +
   2.313 +subsection {* Product *}
   2.314 +
   2.315 +definition cprod (infixr "*c" 80) where
   2.316 +  "r1 *c r2 = |Field r1 <*> Field r2|"
   2.317 +
   2.318 +lemma card_order_cprod:
   2.319 +  assumes "card_order r1" "card_order r2"
   2.320 +  shows "card_order (r1 *c r2)"
   2.321 +proof -
   2.322 +  have "Field r1 = UNIV" "Field r2 = UNIV" using assms card_order_on_Card_order by auto
   2.323 +  thus ?thesis by (auto simp: cprod_def card_of_card_order_on)
   2.324 +qed
   2.325 +
   2.326 +lemma Card_order_cprod: "Card_order (r1 *c r2)"
   2.327 +by (simp only: cprod_def Field_card_of card_of_card_order_on)
   2.328 +
   2.329 +lemma cprod_mono1: "p1 \<le>o r1 \<Longrightarrow> p1 *c q \<le>o r1 *c q"
   2.330 +by (simp only: cprod_def ordLeq_Times_mono1)
   2.331 +
   2.332 +lemma cprod_mono2: "p2 \<le>o r2 \<Longrightarrow> q *c p2 \<le>o q *c r2"
   2.333 +by (simp only: cprod_def ordLeq_Times_mono2)
   2.334 +
   2.335 +lemma ordLeq_cprod2: "\<lbrakk>Cnotzero p1; Card_order p2\<rbrakk> \<Longrightarrow> p2 \<le>o p1 *c p2"
   2.336 +unfolding cprod_def by (metis Card_order_Times2 czeroI)
   2.337 +
   2.338 +lemma cinfinite_cprod: "\<lbrakk>cinfinite r1; cinfinite r2\<rbrakk> \<Longrightarrow> cinfinite (r1 *c r2)"
   2.339 +by (simp add: cinfinite_def cprod_def Field_card_of infinite_cartesian_product)
   2.340 +
   2.341 +lemma cinfinite_cprod2: "\<lbrakk>Cnotzero r1; Cinfinite r2\<rbrakk> \<Longrightarrow> cinfinite (r1 *c r2)"
   2.342 +by (metis cinfinite_mono ordLeq_cprod2)
   2.343 +
   2.344 +lemma Cinfinite_cprod2: "\<lbrakk>Cnotzero r1; Cinfinite r2\<rbrakk> \<Longrightarrow> Cinfinite (r1 *c r2)"
   2.345 +by (blast intro: cinfinite_cprod2 Card_order_cprod)
   2.346 +
   2.347 +lemma cprod_com: "p1 *c p2 =o p2 *c p1"
   2.348 +by (simp only: cprod_def card_of_Times_commute)
   2.349 +
   2.350 +lemma card_of_Csum_Times:
   2.351 +  "\<forall>i \<in> I. |A i| \<le>o |B| \<Longrightarrow> (CSUM i : |I|. |A i| ) \<le>o |I| *c |B|"
   2.352 +by (simp only: Csum_def cprod_def Field_card_of card_of_Sigma_Times)
   2.353 +
   2.354 +lemma card_of_Csum_Times':
   2.355 +  assumes "Card_order r" "\<forall>i \<in> I. |A i| \<le>o r"
   2.356 +  shows "(CSUM i : |I|. |A i| ) \<le>o |I| *c r"
   2.357 +proof -
   2.358 +  from assms(1) have *: "r =o |Field r|" by (simp add: card_of_unique)
   2.359 +  with assms(2) have "\<forall>i \<in> I. |A i| \<le>o |Field r|" by (blast intro: ordLeq_ordIso_trans)
   2.360 +  hence "(CSUM i : |I|. |A i| ) \<le>o |I| *c |Field r|" by (simp only: card_of_Csum_Times)
   2.361 +  also from * have "|I| *c |Field r| \<le>o |I| *c r"
   2.362 +    by (simp only: Field_card_of card_of_refl cprod_def ordIso_imp_ordLeq)
   2.363 +  finally show ?thesis .
   2.364 +qed
   2.365 +
   2.366 +lemma cprod_csum_distrib1: "r1 *c r2 +c r1 *c r3 =o r1 *c (r2 +c r3)"
   2.367 +unfolding csum_def cprod_def by (simp add: Field_card_of card_of_Times_Plus_distrib ordIso_symmetric)
   2.368 +
   2.369 +lemma csum_absorb2': "\<lbrakk>Card_order r2; r1 \<le>o r2; cinfinite r1 \<or> cinfinite r2\<rbrakk> \<Longrightarrow> r1 +c r2 =o r2"
   2.370 +unfolding csum_def by (metis Card_order_Plus_infinite cinfinite_def cinfinite_mono)
   2.371 +
   2.372 +lemma csum_absorb1':
   2.373 +  assumes card: "Card_order r2"
   2.374 +  and r12: "r1 \<le>o r2" and cr12: "cinfinite r1 \<or> cinfinite r2"
   2.375 +  shows "r2 +c r1 =o r2"
   2.376 +by (rule ordIso_transitive, rule csum_com, rule csum_absorb2', (simp only: assms)+)
   2.377 +
   2.378 +lemma csum_absorb1: "\<lbrakk>Cinfinite r2; r1 \<le>o r2\<rbrakk> \<Longrightarrow> r2 +c r1 =o r2"
   2.379 +by (rule csum_absorb1') auto
   2.380 +
   2.381 +
   2.382 +subsection {* Exponentiation *}
   2.383 +
   2.384 +definition cexp (infixr "^c" 90) where
   2.385 +  "r1 ^c r2 \<equiv> |Func (Field r2) (Field r1)|"
   2.386 +
   2.387 +lemma Card_order_cexp: "Card_order (r1 ^c r2)"
   2.388 +unfolding cexp_def by (rule card_of_Card_order)
   2.389 +
   2.390 +lemma cexp_mono':
   2.391 +  assumes 1: "p1 \<le>o r1" and 2: "p2 \<le>o r2"
   2.392 +  and n: "Field p2 = {} \<Longrightarrow> Field r2 = {}"
   2.393 +  shows "p1 ^c p2 \<le>o r1 ^c r2"
   2.394 +proof(cases "Field p1 = {}")
   2.395 +  case True
   2.396 +  hence "|Field |Func (Field p2) (Field p1)|| \<le>o cone"
   2.397 +    unfolding cone_def Field_card_of
   2.398 +    by (cases "Field p2 = {}", auto intro: card_of_ordLeqI2 simp: Func_empty)
   2.399 +       (metis Func_is_emp card_of_empty ex_in_conv)
   2.400 +  hence "|Func (Field p2) (Field p1)| \<le>o cone" by (simp add: Field_card_of cexp_def)
   2.401 +  hence "p1 ^c p2 \<le>o cone" unfolding cexp_def .
   2.402 +  thus ?thesis
   2.403 +  proof (cases "Field p2 = {}")
   2.404 +    case True
   2.405 +    with n have "Field r2 = {}" .
   2.406 +    hence "cone \<le>o r1 ^c r2" unfolding cone_def cexp_def Func_def by (auto intro: card_of_ordLeqI)
   2.407 +    thus ?thesis using `p1 ^c p2 \<le>o cone` ordLeq_transitive by auto
   2.408 +  next
   2.409 +    case False with True have "|Field (p1 ^c p2)| =o czero"
   2.410 +      unfolding card_of_ordIso_czero_iff_empty cexp_def Field_card_of Func_def by auto
   2.411 +    thus ?thesis unfolding cexp_def card_of_ordIso_czero_iff_empty Field_card_of
   2.412 +      by (simp add: card_of_empty)
   2.413 +  qed
   2.414 +next
   2.415 +  case False
   2.416 +  have 1: "|Field p1| \<le>o |Field r1|" and 2: "|Field p2| \<le>o |Field r2|"
   2.417 +    using 1 2 by (auto simp: card_of_mono2)
   2.418 +  obtain f1 where f1: "f1 ` Field r1 = Field p1"
   2.419 +    using 1 unfolding card_of_ordLeq2[OF False, symmetric] by auto
   2.420 +  obtain f2 where f2: "inj_on f2 (Field p2)" "f2 ` Field p2 \<subseteq> Field r2"
   2.421 +    using 2 unfolding card_of_ordLeq[symmetric] by blast
   2.422 +  have 0: "Func_map (Field p2) f1 f2 ` (Field (r1 ^c r2)) = Field (p1 ^c p2)"
   2.423 +    unfolding cexp_def Field_card_of using Func_map_surj[OF f1 f2 n, symmetric] .
   2.424 +  have 00: "Field (p1 ^c p2) \<noteq> {}" unfolding cexp_def Field_card_of Func_is_emp
   2.425 +    using False by simp
   2.426 +  show ?thesis
   2.427 +    using 0 card_of_ordLeq2[OF 00] unfolding cexp_def Field_card_of by blast
   2.428 +qed
   2.429 +
   2.430 +lemma cexp_mono:
   2.431 +  assumes 1: "p1 \<le>o r1" and 2: "p2 \<le>o r2"
   2.432 +  and n: "p2 =o czero \<Longrightarrow> r2 =o czero" and card: "Card_order p2"
   2.433 +  shows "p1 ^c p2 \<le>o r1 ^c r2"
   2.434 +  by (metis (full_types) "1" "2" card cexp_mono' czeroE czeroI n)
   2.435 +
   2.436 +lemma cexp_mono1:
   2.437 +  assumes 1: "p1 \<le>o r1" and q: "Card_order q"
   2.438 +  shows "p1 ^c q \<le>o r1 ^c q"
   2.439 +using ordLeq_refl[OF q] by (rule cexp_mono[OF 1]) (auto simp: q)
   2.440 +
   2.441 +lemma cexp_mono2':
   2.442 +  assumes 2: "p2 \<le>o r2" and q: "Card_order q"
   2.443 +  and n: "Field p2 = {} \<Longrightarrow> Field r2 = {}"
   2.444 +  shows "q ^c p2 \<le>o q ^c r2"
   2.445 +using ordLeq_refl[OF q] by (rule cexp_mono'[OF _ 2 n]) auto
   2.446 +
   2.447 +lemma cexp_mono2:
   2.448 +  assumes 2: "p2 \<le>o r2" and q: "Card_order q"
   2.449 +  and n: "p2 =o czero \<Longrightarrow> r2 =o czero" and card: "Card_order p2"
   2.450 +  shows "q ^c p2 \<le>o q ^c r2"
   2.451 +using ordLeq_refl[OF q] by (rule cexp_mono[OF _ 2 n card]) auto
   2.452 +
   2.453 +lemma cexp_mono2_Cnotzero:
   2.454 +  assumes "p2 \<le>o r2" "Card_order q" "Cnotzero p2"
   2.455 +  shows "q ^c p2 \<le>o q ^c r2"
   2.456 +by (metis assms cexp_mono2' czeroI)
   2.457 +
   2.458 +lemma cexp_cong:
   2.459 +  assumes 1: "p1 =o r1" and 2: "p2 =o r2"
   2.460 +  and Cr: "Card_order r2"
   2.461 +  and Cp: "Card_order p2"
   2.462 +  shows "p1 ^c p2 =o r1 ^c r2"
   2.463 +proof -
   2.464 +  obtain f where "bij_betw f (Field p2) (Field r2)"
   2.465 +    using 2 card_of_ordIso[of "Field p2" "Field r2"] card_of_cong by auto
   2.466 +  hence 0: "Field p2 = {} \<longleftrightarrow> Field r2 = {}" unfolding bij_betw_def by auto
   2.467 +  have r: "p2 =o czero \<Longrightarrow> r2 =o czero"
   2.468 +    and p: "r2 =o czero \<Longrightarrow> p2 =o czero"
   2.469 +     using 0 Cr Cp czeroE czeroI by auto
   2.470 +  show ?thesis using 0 1 2 unfolding ordIso_iff_ordLeq
   2.471 +    using r p cexp_mono[OF _ _ _ Cp] cexp_mono[OF _ _ _ Cr] by metis
   2.472 +qed
   2.473 +
   2.474 +lemma cexp_cong1:
   2.475 +  assumes 1: "p1 =o r1" and q: "Card_order q"
   2.476 +  shows "p1 ^c q =o r1 ^c q"
   2.477 +by (rule cexp_cong[OF 1 _ q q]) (rule ordIso_refl[OF q])
   2.478 +
   2.479 +lemma cexp_cong2:
   2.480 +  assumes 2: "p2 =o r2" and q: "Card_order q" and p: "Card_order p2"
   2.481 +  shows "q ^c p2 =o q ^c r2"
   2.482 +by (rule cexp_cong[OF _ 2]) (auto simp only: ordIso_refl Card_order_ordIso2[OF p 2] q p)
   2.483 +
   2.484 +lemma cexp_cone:
   2.485 +  assumes "Card_order r"
   2.486 +  shows "r ^c cone =o r"
   2.487 +proof -
   2.488 +  have "r ^c cone =o |Field r|"
   2.489 +    unfolding cexp_def cone_def Field_card_of Func_empty
   2.490 +      card_of_ordIso[symmetric] bij_betw_def Func_def inj_on_def image_def
   2.491 +    by (rule exI[of _ "\<lambda>f. f ()"]) auto
   2.492 +  also have "|Field r| =o r" by (rule card_of_Field_ordIso[OF assms])
   2.493 +  finally show ?thesis .
   2.494 +qed
   2.495 +
   2.496 +lemma cexp_cprod:
   2.497 +  assumes r1: "Card_order r1"
   2.498 +  shows "(r1 ^c r2) ^c r3 =o r1 ^c (r2 *c r3)" (is "?L =o ?R")
   2.499 +proof -
   2.500 +  have "?L =o r1 ^c (r3 *c r2)"
   2.501 +    unfolding cprod_def cexp_def Field_card_of
   2.502 +    using card_of_Func_Times by(rule ordIso_symmetric)
   2.503 +  also have "r1 ^c (r3 *c r2) =o ?R"
   2.504 +    apply(rule cexp_cong2) using cprod_com r1 by (auto simp: Card_order_cprod)
   2.505 +  finally show ?thesis .
   2.506 +qed
   2.507 +
   2.508 +lemma cprod_infinite1': "\<lbrakk>Cinfinite r; Cnotzero p; p \<le>o r\<rbrakk> \<Longrightarrow> r *c p =o r"
   2.509 +unfolding cinfinite_def cprod_def
   2.510 +by (rule Card_order_Times_infinite[THEN conjunct1]) (blast intro: czeroI)+
   2.511 +
   2.512 +lemma cexp_cprod_ordLeq:
   2.513 +  assumes r1: "Card_order r1" and r2: "Cinfinite r2"
   2.514 +  and r3: "Cnotzero r3" "r3 \<le>o r2"
   2.515 +  shows "(r1 ^c r2) ^c r3 =o r1 ^c r2" (is "?L =o ?R")
   2.516 +proof-
   2.517 +  have "?L =o r1 ^c (r2 *c r3)" using cexp_cprod[OF r1] .
   2.518 +  also have "r1 ^c (r2 *c r3) =o ?R"
   2.519 +  apply(rule cexp_cong2)
   2.520 +  apply(rule cprod_infinite1'[OF r2 r3]) using r1 r2 by (fastforce simp: Card_order_cprod)+
   2.521 +  finally show ?thesis .
   2.522 +qed
   2.523 +
   2.524 +lemma Cnotzero_UNIV: "Cnotzero |UNIV|"
   2.525 +by (auto simp: card_of_Card_order card_of_ordIso_czero_iff_empty)
   2.526 +
   2.527 +lemma ordLess_ctwo_cexp:
   2.528 +  assumes "Card_order r"
   2.529 +  shows "r <o ctwo ^c r"
   2.530 +proof -
   2.531 +  have "r <o |Pow (Field r)|" using assms by (rule Card_order_Pow)
   2.532 +  also have "|Pow (Field r)| =o ctwo ^c r"
   2.533 +    unfolding ctwo_def cexp_def Field_card_of by (rule card_of_Pow_Func)
   2.534 +  finally show ?thesis .
   2.535 +qed
   2.536 +
   2.537 +lemma ordLeq_cexp1:
   2.538 +  assumes "Cnotzero r" "Card_order q"
   2.539 +  shows "q \<le>o q ^c r"
   2.540 +proof (cases "q =o (czero :: 'a rel)")
   2.541 +  case True thus ?thesis by (simp only: card_of_empty cexp_def czero_def ordIso_ordLeq_trans)
   2.542 +next
   2.543 +  case False
   2.544 +  thus ?thesis
   2.545 +    apply -
   2.546 +    apply (rule ordIso_ordLeq_trans)
   2.547 +    apply (rule ordIso_symmetric)
   2.548 +    apply (rule cexp_cone)
   2.549 +    apply (rule assms(2))
   2.550 +    apply (rule cexp_mono2)
   2.551 +    apply (rule cone_ordLeq_Cnotzero)
   2.552 +    apply (rule assms(1))
   2.553 +    apply (rule assms(2))
   2.554 +    apply (rule notE)
   2.555 +    apply (rule cone_not_czero)
   2.556 +    apply assumption
   2.557 +    apply (rule Card_order_cone)
   2.558 +  done
   2.559 +qed
   2.560 +
   2.561 +lemma ordLeq_cexp2:
   2.562 +  assumes "ctwo \<le>o q" "Card_order r"
   2.563 +  shows "r \<le>o q ^c r"
   2.564 +proof (cases "r =o (czero :: 'a rel)")
   2.565 +  case True thus ?thesis by (simp only: card_of_empty cexp_def czero_def ordIso_ordLeq_trans)
   2.566 +next
   2.567 +  case False thus ?thesis
   2.568 +    apply -
   2.569 +    apply (rule ordLess_imp_ordLeq)
   2.570 +    apply (rule ordLess_ordLeq_trans)
   2.571 +    apply (rule ordLess_ctwo_cexp)
   2.572 +    apply (rule assms(2))
   2.573 +    apply (rule cexp_mono1)
   2.574 +    apply (rule assms(1))
   2.575 +    apply (rule assms(2))
   2.576 +  done
   2.577 +qed
   2.578 +
   2.579 +lemma cinfinite_cexp: "\<lbrakk>ctwo \<le>o q; Cinfinite r\<rbrakk> \<Longrightarrow> cinfinite (q ^c r)"
   2.580 +by (metis assms cinfinite_mono ordLeq_cexp2)
   2.581 +
   2.582 +lemma Cinfinite_cexp:
   2.583 +  "\<lbrakk>ctwo \<le>o q; Cinfinite r\<rbrakk> \<Longrightarrow> Cinfinite (q ^c r)"
   2.584 +by (simp add: cinfinite_cexp Card_order_cexp)
   2.585 +
   2.586 +lemma ctwo_ordLess_natLeq: "ctwo <o natLeq"
   2.587 +unfolding ctwo_def using finite_UNIV natLeq_cinfinite natLeq_Card_order
   2.588 +by (intro Cfinite_ordLess_Cinfinite) (auto simp: cfinite_def card_of_Card_order)
   2.589 +
   2.590 +lemma ctwo_ordLess_Cinfinite: "Cinfinite r \<Longrightarrow> ctwo <o r"
   2.591 +by (metis ctwo_ordLess_natLeq natLeq_ordLeq_cinfinite ordLess_ordLeq_trans)
   2.592 +
   2.593 +lemma ctwo_ordLeq_Cinfinite:
   2.594 +  assumes "Cinfinite r"
   2.595 +  shows "ctwo \<le>o r"
   2.596 +by (rule ordLess_imp_ordLeq[OF ctwo_ordLess_Cinfinite[OF assms]])
   2.597 +
   2.598 +lemma Un_Cinfinite_bound: "\<lbrakk>|A| \<le>o r; |B| \<le>o r; Cinfinite r\<rbrakk> \<Longrightarrow> |A \<union> B| \<le>o r"
   2.599 +by (auto simp add: cinfinite_def card_of_Un_ordLeq_infinite_Field)
   2.600 +
   2.601 +lemma UNION_Cinfinite_bound: "\<lbrakk>|I| \<le>o r; \<forall>i \<in> I. |A i| \<le>o r; Cinfinite r\<rbrakk> \<Longrightarrow> |\<Union>i \<in> I. A i| \<le>o r"
   2.602 +by (auto simp add: card_of_UNION_ordLeq_infinite_Field cinfinite_def)
   2.603 +
   2.604 +lemma csum_cinfinite_bound:
   2.605 +  assumes "p \<le>o r" "q \<le>o r" "Card_order p" "Card_order q" "Cinfinite r"
   2.606 +  shows "p +c q \<le>o r"
   2.607 +proof -
   2.608 +  from assms(1-4) have "|Field p| \<le>o r" "|Field q| \<le>o r"
   2.609 +    unfolding card_order_on_def using card_of_least ordLeq_transitive by blast+
   2.610 +  with assms show ?thesis unfolding cinfinite_def csum_def
   2.611 +    by (blast intro: card_of_Plus_ordLeq_infinite_Field)
   2.612 +qed
   2.613 +
   2.614 +lemma cprod_cinfinite_bound:
   2.615 +  assumes "p \<le>o r" "q \<le>o r" "Card_order p" "Card_order q" "Cinfinite r"
   2.616 +  shows "p *c q \<le>o r"
   2.617 +proof -
   2.618 +  from assms(1-4) have "|Field p| \<le>o r" "|Field q| \<le>o r"
   2.619 +    unfolding card_order_on_def using card_of_least ordLeq_transitive by blast+
   2.620 +  with assms show ?thesis unfolding cinfinite_def cprod_def
   2.621 +    by (blast intro: card_of_Times_ordLeq_infinite_Field)
   2.622 +qed
   2.623 +
   2.624 +lemma cprod_csum_cexp:
   2.625 +  "r1 *c r2 \<le>o (r1 +c r2) ^c ctwo"
   2.626 +unfolding cprod_def csum_def cexp_def ctwo_def Field_card_of
   2.627 +proof -
   2.628 +  let ?f = "\<lambda>(a, b). %x. if x then Inl a else Inr b"
   2.629 +  have "inj_on ?f (Field r1 \<times> Field r2)" (is "inj_on _ ?LHS")
   2.630 +    by (auto simp: inj_on_def fun_eq_iff split: bool.split)
   2.631 +  moreover
   2.632 +  have "?f ` ?LHS \<subseteq> Func (UNIV :: bool set) (Field r1 <+> Field r2)" (is "_ \<subseteq> ?RHS")
   2.633 +    by (auto simp: Func_def)
   2.634 +  ultimately show "|?LHS| \<le>o |?RHS|" using card_of_ordLeq by blast
   2.635 +qed
   2.636 +
   2.637 +lemma Cfinite_cprod_Cinfinite: "\<lbrakk>Cfinite r; Cinfinite s\<rbrakk> \<Longrightarrow> r *c s \<le>o s"
   2.638 +by (intro cprod_cinfinite_bound)
   2.639 +  (auto intro: ordLeq_refl ordLess_imp_ordLeq[OF Cfinite_ordLess_Cinfinite])
   2.640 +
   2.641 +lemma cprod_cexp: "(r *c s) ^c t =o r ^c t *c s ^c t"
   2.642 +  unfolding cprod_def cexp_def Field_card_of by (rule Func_Times_Range)
   2.643 +
   2.644 +lemma cprod_cexp_csum_cexp_Cinfinite:
   2.645 +  assumes t: "Cinfinite t"
   2.646 +  shows "(r *c s) ^c t \<le>o (r +c s) ^c t"
   2.647 +proof -
   2.648 +  have "(r *c s) ^c t \<le>o ((r +c s) ^c ctwo) ^c t"
   2.649 +    by (rule cexp_mono1[OF cprod_csum_cexp conjunct2[OF t]])
   2.650 +  also have "((r +c s) ^c ctwo) ^c t =o (r +c s) ^c (ctwo *c t)"
   2.651 +    by (rule cexp_cprod[OF Card_order_csum])
   2.652 +  also have "(r +c s) ^c (ctwo *c t) =o (r +c s) ^c (t *c ctwo)"
   2.653 +    by (rule cexp_cong2[OF cprod_com Card_order_csum Card_order_cprod])
   2.654 +  also have "(r +c s) ^c (t *c ctwo) =o ((r +c s) ^c t) ^c ctwo"
   2.655 +    by (rule ordIso_symmetric[OF cexp_cprod[OF Card_order_csum]])
   2.656 +  also have "((r +c s) ^c t) ^c ctwo =o (r +c s) ^c t"
   2.657 +    by (rule cexp_cprod_ordLeq[OF Card_order_csum t ctwo_Cnotzero ctwo_ordLeq_Cinfinite[OF t]])
   2.658 +  finally show ?thesis .
   2.659 +qed
   2.660 +
   2.661 +lemma Cfinite_cexp_Cinfinite:
   2.662 +  assumes s: "Cfinite s" and t: "Cinfinite t"
   2.663 +  shows "s ^c t \<le>o ctwo ^c t"
   2.664 +proof (cases "s \<le>o ctwo")
   2.665 +  case True thus ?thesis using t by (blast intro: cexp_mono1)
   2.666 +next
   2.667 +  case False
   2.668 +  hence "ctwo \<le>o s" by (metis card_order_on_well_order_on ctwo_Cnotzero ordLeq_total s)
   2.669 +  hence "Cnotzero s" by (metis Cnotzero_mono ctwo_Cnotzero s)
   2.670 +  hence st: "Cnotzero (s *c t)" by (metis Cinfinite_cprod2 cinfinite_not_czero t)
   2.671 +  have "s ^c t \<le>o (ctwo ^c s) ^c t"
   2.672 +    using assms by (blast intro: cexp_mono1 ordLess_imp_ordLeq[OF ordLess_ctwo_cexp])
   2.673 +  also have "(ctwo ^c s) ^c t =o ctwo ^c (s *c t)"
   2.674 +    by (blast intro: Card_order_ctwo cexp_cprod)
   2.675 +  also have "ctwo ^c (s *c t) \<le>o ctwo ^c t"
   2.676 +    using assms st by (intro cexp_mono2_Cnotzero Cfinite_cprod_Cinfinite Card_order_ctwo)
   2.677 +  finally show ?thesis .
   2.678 +qed
   2.679 +
   2.680 +lemma csum_Cfinite_cexp_Cinfinite:
   2.681 +  assumes r: "Card_order r" and s: "Cfinite s" and t: "Cinfinite t"
   2.682 +  shows "(r +c s) ^c t \<le>o (r +c ctwo) ^c t"
   2.683 +proof (cases "Cinfinite r")
   2.684 +  case True
   2.685 +  hence "r +c s =o r" by (intro csum_absorb1 ordLess_imp_ordLeq[OF Cfinite_ordLess_Cinfinite] s)
   2.686 +  hence "(r +c s) ^c t =o r ^c t" using t by (blast intro: cexp_cong1)
   2.687 +  also have "r ^c t \<le>o (r +c ctwo) ^c t" using t by (blast intro: cexp_mono1 ordLeq_csum1 r)
   2.688 +  finally show ?thesis .
   2.689 +next
   2.690 +  case False
   2.691 +  with r have "Cfinite r" unfolding cinfinite_def cfinite_def by auto
   2.692 +  hence "Cfinite (r +c s)" by (intro Cfinite_csum s)
   2.693 +  hence "(r +c s) ^c t \<le>o ctwo ^c t" by (intro Cfinite_cexp_Cinfinite t)
   2.694 +  also have "ctwo ^c t \<le>o (r +c ctwo) ^c t" using t
   2.695 +    by (blast intro: cexp_mono1 ordLeq_csum2 Card_order_ctwo)
   2.696 +  finally show ?thesis .
   2.697 +qed
   2.698 +
   2.699 +(* cardSuc *)
   2.700 +
   2.701 +lemma Cinfinite_cardSuc: "Cinfinite r \<Longrightarrow> Cinfinite (cardSuc r)"
   2.702 +by (simp add: cinfinite_def cardSuc_Card_order cardSuc_finite)
   2.703 +
   2.704 +lemma cardSuc_UNION_Cinfinite:
   2.705 +  assumes "Cinfinite r" "relChain (cardSuc r) As" "B \<le> (UN i : Field (cardSuc r). As i)" "|B| <=o r"
   2.706 +  shows "EX i : Field (cardSuc r). B \<le> As i"
   2.707 +using cardSuc_UNION assms unfolding cinfinite_def by blast
   2.708 +
   2.709 +end
     3.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     3.2 +++ b/src/HOL/BNF_Cardinal_Order_Relation.thy	Mon Jan 20 18:24:55 2014 +0100
     3.3 @@ -0,0 +1,1664 @@
     3.4 +(*  Title:      HOL/BNF_Cardinal_Order_Relation.thy
     3.5 +    Author:     Andrei Popescu, TU Muenchen
     3.6 +    Copyright   2012
     3.7 +
     3.8 +Cardinal-order relations (BNF).
     3.9 +*)
    3.10 +
    3.11 +header {* Cardinal-Order Relations (BNF) *}
    3.12 +
    3.13 +theory BNF_Cardinal_Order_Relation
    3.14 +imports BNF_Constructions_on_Wellorders
    3.15 +begin
    3.16 +
    3.17 +text{* In this section, we define cardinal-order relations to be minim well-orders
    3.18 +on their field.  Then we define the cardinal of a set to be {\em some} cardinal-order
    3.19 +relation on that set, which will be unique up to order isomorphism.  Then we study
    3.20 +the connection between cardinals and:
    3.21 +\begin{itemize}
    3.22 +\item standard set-theoretic constructions: products,
    3.23 +sums, unions, lists, powersets, set-of finite sets operator;
    3.24 +\item finiteness and infiniteness (in particular, with the numeric cardinal operator
    3.25 +for finite sets, @{text "card"}, from the theory @{text "Finite_Sets.thy"}).
    3.26 +\end{itemize}
    3.27 +%
    3.28 +On the way, we define the canonical $\omega$ cardinal and finite cardinals.  We also
    3.29 +define (again, up to order isomorphism) the successor of a cardinal, and show that
    3.30 +any cardinal admits a successor.
    3.31 +
    3.32 +Main results of this section are the existence of cardinal relations and the
    3.33 +facts that, in the presence of infiniteness,
    3.34 +most of the standard set-theoretic constructions (except for the powerset)
    3.35 +{\em do not increase cardinality}.  In particular, e.g., the set of words/lists over
    3.36 +any infinite set has the same cardinality (hence, is in bijection) with that set.
    3.37 +*}
    3.38 +
    3.39 +
    3.40 +subsection {* Cardinal orders *}
    3.41 +
    3.42 +text{* A cardinal order in our setting shall be a well-order {\em minim} w.r.t. the
    3.43 +order-embedding relation, @{text "\<le>o"} (which is the same as being {\em minimal} w.r.t. the
    3.44 +strict order-embedding relation, @{text "<o"}), among all the well-orders on its field.  *}
    3.45 +
    3.46 +definition card_order_on :: "'a set \<Rightarrow> 'a rel \<Rightarrow> bool"
    3.47 +where
    3.48 +"card_order_on A r \<equiv> well_order_on A r \<and> (\<forall>r'. well_order_on A r' \<longrightarrow> r \<le>o r')"
    3.49 +
    3.50 +abbreviation "Card_order r \<equiv> card_order_on (Field r) r"
    3.51 +abbreviation "card_order r \<equiv> card_order_on UNIV r"
    3.52 +
    3.53 +lemma card_order_on_well_order_on:
    3.54 +assumes "card_order_on A r"
    3.55 +shows "well_order_on A r"
    3.56 +using assms unfolding card_order_on_def by simp
    3.57 +
    3.58 +lemma card_order_on_Card_order:
    3.59 +"card_order_on A r \<Longrightarrow> A = Field r \<and> Card_order r"
    3.60 +unfolding card_order_on_def using well_order_on_Field by blast
    3.61 +
    3.62 +text{* The existence of a cardinal relation on any given set (which will mean
    3.63 +that any set has a cardinal) follows from two facts:
    3.64 +\begin{itemize}
    3.65 +\item Zermelo's theorem (proved in @{text "Zorn.thy"} as theorem @{text "well_order_on"}),
    3.66 +which states that on any given set there exists a well-order;
    3.67 +\item The well-founded-ness of @{text "<o"}, ensuring that then there exists a minimal
    3.68 +such well-order, i.e., a cardinal order.
    3.69 +\end{itemize}
    3.70 +*}
    3.71 +
    3.72 +theorem card_order_on: "\<exists>r. card_order_on A r"
    3.73 +proof-
    3.74 +  obtain R where R_def: "R = {r. well_order_on A r}" by blast
    3.75 +  have 1: "R \<noteq> {} \<and> (\<forall>r \<in> R. Well_order r)"
    3.76 +  using well_order_on[of A] R_def well_order_on_Well_order by blast
    3.77 +  hence "\<exists>r \<in> R. \<forall>r' \<in> R. r \<le>o r'"
    3.78 +  using  exists_minim_Well_order[of R] by auto
    3.79 +  thus ?thesis using R_def unfolding card_order_on_def by auto
    3.80 +qed
    3.81 +
    3.82 +lemma card_order_on_ordIso:
    3.83 +assumes CO: "card_order_on A r" and CO': "card_order_on A r'"
    3.84 +shows "r =o r'"
    3.85 +using assms unfolding card_order_on_def
    3.86 +using ordIso_iff_ordLeq by blast
    3.87 +
    3.88 +lemma Card_order_ordIso:
    3.89 +assumes CO: "Card_order r" and ISO: "r' =o r"
    3.90 +shows "Card_order r'"
    3.91 +using ISO unfolding ordIso_def
    3.92 +proof(unfold card_order_on_def, auto)
    3.93 +  fix p' assume "well_order_on (Field r') p'"
    3.94 +  hence 0: "Well_order p' \<and> Field p' = Field r'"
    3.95 +  using well_order_on_Well_order by blast
    3.96 +  obtain f where 1: "iso r' r f" and 2: "Well_order r \<and> Well_order r'"
    3.97 +  using ISO unfolding ordIso_def by auto
    3.98 +  hence 3: "inj_on f (Field r') \<and> f ` (Field r') = Field r"
    3.99 +  by (auto simp add: iso_iff embed_inj_on)
   3.100 +  let ?p = "dir_image p' f"
   3.101 +  have 4: "p' =o ?p \<and> Well_order ?p"
   3.102 +  using 0 2 3 by (auto simp add: dir_image_ordIso Well_order_dir_image)
   3.103 +  moreover have "Field ?p =  Field r"
   3.104 +  using 0 3 by (auto simp add: dir_image_Field2 order_on_defs)
   3.105 +  ultimately have "well_order_on (Field r) ?p" by auto
   3.106 +  hence "r \<le>o ?p" using CO unfolding card_order_on_def by auto
   3.107 +  thus "r' \<le>o p'"
   3.108 +  using ISO 4 ordLeq_ordIso_trans ordIso_ordLeq_trans ordIso_symmetric by blast
   3.109 +qed
   3.110 +
   3.111 +lemma Card_order_ordIso2:
   3.112 +assumes CO: "Card_order r" and ISO: "r =o r'"
   3.113 +shows "Card_order r'"
   3.114 +using assms Card_order_ordIso ordIso_symmetric by blast
   3.115 +
   3.116 +
   3.117 +subsection {* Cardinal of a set *}
   3.118 +
   3.119 +text{* We define the cardinal of set to be {\em some} cardinal order on that set.
   3.120 +We shall prove that this notion is unique up to order isomorphism, meaning
   3.121 +that order isomorphism shall be the true identity of cardinals.  *}
   3.122 +
   3.123 +definition card_of :: "'a set \<Rightarrow> 'a rel" ("|_|" )
   3.124 +where "card_of A = (SOME r. card_order_on A r)"
   3.125 +
   3.126 +lemma card_of_card_order_on: "card_order_on A |A|"
   3.127 +unfolding card_of_def by (auto simp add: card_order_on someI_ex)
   3.128 +
   3.129 +lemma card_of_well_order_on: "well_order_on A |A|"
   3.130 +using card_of_card_order_on card_order_on_def by blast
   3.131 +
   3.132 +lemma Field_card_of: "Field |A| = A"
   3.133 +using card_of_card_order_on[of A] unfolding card_order_on_def
   3.134 +using well_order_on_Field by blast
   3.135 +
   3.136 +lemma card_of_Card_order: "Card_order |A|"
   3.137 +by (simp only: card_of_card_order_on Field_card_of)
   3.138 +
   3.139 +corollary ordIso_card_of_imp_Card_order:
   3.140 +"r =o |A| \<Longrightarrow> Card_order r"
   3.141 +using card_of_Card_order Card_order_ordIso by blast
   3.142 +
   3.143 +lemma card_of_Well_order: "Well_order |A|"
   3.144 +using card_of_Card_order unfolding card_order_on_def by auto
   3.145 +
   3.146 +lemma card_of_refl: "|A| =o |A|"
   3.147 +using card_of_Well_order ordIso_reflexive by blast
   3.148 +
   3.149 +lemma card_of_least: "well_order_on A r \<Longrightarrow> |A| \<le>o r"
   3.150 +using card_of_card_order_on unfolding card_order_on_def by blast
   3.151 +
   3.152 +lemma card_of_ordIso:
   3.153 +"(\<exists>f. bij_betw f A B) = ( |A| =o |B| )"
   3.154 +proof(auto)
   3.155 +  fix f assume *: "bij_betw f A B"
   3.156 +  then obtain r where "well_order_on B r \<and> |A| =o r"
   3.157 +  using Well_order_iso_copy card_of_well_order_on by blast
   3.158 +  hence "|B| \<le>o |A|" using card_of_least
   3.159 +  ordLeq_ordIso_trans ordIso_symmetric by blast
   3.160 +  moreover
   3.161 +  {let ?g = "inv_into A f"
   3.162 +   have "bij_betw ?g B A" using * bij_betw_inv_into by blast
   3.163 +   then obtain r where "well_order_on A r \<and> |B| =o r"
   3.164 +   using Well_order_iso_copy card_of_well_order_on by blast
   3.165 +   hence "|A| \<le>o |B|" using card_of_least
   3.166 +   ordLeq_ordIso_trans ordIso_symmetric by blast
   3.167 +  }
   3.168 +  ultimately show "|A| =o |B|" using ordIso_iff_ordLeq by blast
   3.169 +next
   3.170 +  assume "|A| =o |B|"
   3.171 +  then obtain f where "iso ( |A| ) ( |B| ) f"
   3.172 +  unfolding ordIso_def by auto
   3.173 +  hence "bij_betw f A B" unfolding iso_def Field_card_of by simp
   3.174 +  thus "\<exists>f. bij_betw f A B" by auto
   3.175 +qed
   3.176 +
   3.177 +lemma card_of_ordLeq:
   3.178 +"(\<exists>f. inj_on f A \<and> f ` A \<le> B) = ( |A| \<le>o |B| )"
   3.179 +proof(auto)
   3.180 +  fix f assume *: "inj_on f A" and **: "f ` A \<le> B"
   3.181 +  {assume "|B| <o |A|"
   3.182 +   hence "|B| \<le>o |A|" using ordLeq_iff_ordLess_or_ordIso by blast
   3.183 +   then obtain g where "embed ( |B| ) ( |A| ) g"
   3.184 +   unfolding ordLeq_def by auto
   3.185 +   hence 1: "inj_on g B \<and> g ` B \<le> A" using embed_inj_on[of "|B|" "|A|" "g"]
   3.186 +   card_of_Well_order[of "B"] Field_card_of[of "B"] Field_card_of[of "A"]
   3.187 +   embed_Field[of "|B|" "|A|" g] by auto
   3.188 +   obtain h where "bij_betw h A B"
   3.189 +   using * ** 1 Cantor_Bernstein[of f] by fastforce
   3.190 +   hence "|A| =o |B|" using card_of_ordIso by blast
   3.191 +   hence "|A| \<le>o |B|" using ordIso_iff_ordLeq by auto
   3.192 +  }
   3.193 +  thus "|A| \<le>o |B|" using ordLess_or_ordLeq[of "|B|" "|A|"]
   3.194 +  by (auto simp: card_of_Well_order)
   3.195 +next
   3.196 +  assume *: "|A| \<le>o |B|"
   3.197 +  obtain f where "embed ( |A| ) ( |B| ) f"
   3.198 +  using * unfolding ordLeq_def by auto
   3.199 +  hence "inj_on f A \<and> f ` A \<le> B" using embed_inj_on[of "|A|" "|B|" f]
   3.200 +  card_of_Well_order[of "A"] Field_card_of[of "A"] Field_card_of[of "B"]
   3.201 +  embed_Field[of "|A|" "|B|" f] by auto
   3.202 +  thus "\<exists>f. inj_on f A \<and> f ` A \<le> B" by auto
   3.203 +qed
   3.204 +
   3.205 +lemma card_of_ordLeq2:
   3.206 +"A \<noteq> {} \<Longrightarrow> (\<exists>g. g ` B = A) = ( |A| \<le>o |B| )"
   3.207 +using card_of_ordLeq[of A B] inj_on_iff_surj[of A B] by auto
   3.208 +
   3.209 +lemma card_of_ordLess:
   3.210 +"(\<not>(\<exists>f. inj_on f A \<and> f ` A \<le> B)) = ( |B| <o |A| )"
   3.211 +proof-
   3.212 +  have "(\<not>(\<exists>f. inj_on f A \<and> f ` A \<le> B)) = (\<not> |A| \<le>o |B| )"
   3.213 +  using card_of_ordLeq by blast
   3.214 +  also have "\<dots> = ( |B| <o |A| )"
   3.215 +  using card_of_Well_order[of A] card_of_Well_order[of B]
   3.216 +        not_ordLeq_iff_ordLess by blast
   3.217 +  finally show ?thesis .
   3.218 +qed
   3.219 +
   3.220 +lemma card_of_ordLess2:
   3.221 +"B \<noteq> {} \<Longrightarrow> (\<not>(\<exists>f. f ` A = B)) = ( |A| <o |B| )"
   3.222 +using card_of_ordLess[of B A] inj_on_iff_surj[of B A] by auto
   3.223 +
   3.224 +lemma card_of_ordIsoI:
   3.225 +assumes "bij_betw f A B"
   3.226 +shows "|A| =o |B|"
   3.227 +using assms unfolding card_of_ordIso[symmetric] by auto
   3.228 +
   3.229 +lemma card_of_ordLeqI:
   3.230 +assumes "inj_on f A" and "\<And> a. a \<in> A \<Longrightarrow> f a \<in> B"
   3.231 +shows "|A| \<le>o |B|"
   3.232 +using assms unfolding card_of_ordLeq[symmetric] by auto
   3.233 +
   3.234 +lemma card_of_unique:
   3.235 +"card_order_on A r \<Longrightarrow> r =o |A|"
   3.236 +by (simp only: card_order_on_ordIso card_of_card_order_on)
   3.237 +
   3.238 +lemma card_of_mono1:
   3.239 +"A \<le> B \<Longrightarrow> |A| \<le>o |B|"
   3.240 +using inj_on_id[of A] card_of_ordLeq[of A B] by fastforce
   3.241 +
   3.242 +lemma card_of_mono2:
   3.243 +assumes "r \<le>o r'"
   3.244 +shows "|Field r| \<le>o |Field r'|"
   3.245 +proof-
   3.246 +  obtain f where
   3.247 +  1: "well_order_on (Field r) r \<and> well_order_on (Field r) r \<and> embed r r' f"
   3.248 +  using assms unfolding ordLeq_def
   3.249 +  by (auto simp add: well_order_on_Well_order)
   3.250 +  hence "inj_on f (Field r) \<and> f ` (Field r) \<le> Field r'"
   3.251 +  by (auto simp add: embed_inj_on embed_Field)
   3.252 +  thus "|Field r| \<le>o |Field r'|" using card_of_ordLeq by blast
   3.253 +qed
   3.254 +
   3.255 +lemma card_of_cong: "r =o r' \<Longrightarrow> |Field r| =o |Field r'|"
   3.256 +by (simp add: ordIso_iff_ordLeq card_of_mono2)
   3.257 +
   3.258 +lemma card_of_Field_ordLess: "Well_order r \<Longrightarrow> |Field r| \<le>o r"
   3.259 +using card_of_least card_of_well_order_on well_order_on_Well_order by blast
   3.260 +
   3.261 +lemma card_of_Field_ordIso:
   3.262 +assumes "Card_order r"
   3.263 +shows "|Field r| =o r"
   3.264 +proof-
   3.265 +  have "card_order_on (Field r) r"
   3.266 +  using assms card_order_on_Card_order by blast
   3.267 +  moreover have "card_order_on (Field r) |Field r|"
   3.268 +  using card_of_card_order_on by blast
   3.269 +  ultimately show ?thesis using card_order_on_ordIso by blast
   3.270 +qed
   3.271 +
   3.272 +lemma Card_order_iff_ordIso_card_of:
   3.273 +"Card_order r = (r =o |Field r| )"
   3.274 +using ordIso_card_of_imp_Card_order card_of_Field_ordIso ordIso_symmetric by blast
   3.275 +
   3.276 +lemma Card_order_iff_ordLeq_card_of:
   3.277 +"Card_order r = (r \<le>o |Field r| )"
   3.278 +proof-
   3.279 +  have "Card_order r = (r =o |Field r| )"
   3.280 +  unfolding Card_order_iff_ordIso_card_of by simp
   3.281 +  also have "... = (r \<le>o |Field r| \<and> |Field r| \<le>o r)"
   3.282 +  unfolding ordIso_iff_ordLeq by simp
   3.283 +  also have "... = (r \<le>o |Field r| )"
   3.284 +  using card_of_Field_ordLess
   3.285 +  by (auto simp: card_of_Field_ordLess ordLeq_Well_order_simp)
   3.286 +  finally show ?thesis .
   3.287 +qed
   3.288 +
   3.289 +lemma Card_order_iff_Restr_underS:
   3.290 +assumes "Well_order r"
   3.291 +shows "Card_order r = (\<forall>a \<in> Field r. Restr r (underS r a) <o |Field r| )"
   3.292 +using assms unfolding Card_order_iff_ordLeq_card_of
   3.293 +using ordLeq_iff_ordLess_Restr card_of_Well_order by blast
   3.294 +
   3.295 +lemma card_of_underS:
   3.296 +assumes r: "Card_order r" and a: "a : Field r"
   3.297 +shows "|underS r a| <o r"
   3.298 +proof-
   3.299 +  let ?A = "underS r a"  let ?r' = "Restr r ?A"
   3.300 +  have 1: "Well_order r"
   3.301 +  using r unfolding card_order_on_def by simp
   3.302 +  have "Well_order ?r'" using 1 Well_order_Restr by auto
   3.303 +  moreover have "card_order_on (Field ?r') |Field ?r'|"
   3.304 +  using card_of_card_order_on .
   3.305 +  ultimately have "|Field ?r'| \<le>o ?r'"
   3.306 +  unfolding card_order_on_def by simp
   3.307 +  moreover have "Field ?r' = ?A"
   3.308 +  using 1 wo_rel.underS_ofilter Field_Restr_ofilter
   3.309 +  unfolding wo_rel_def by fastforce
   3.310 +  ultimately have "|?A| \<le>o ?r'" by simp
   3.311 +  also have "?r' <o |Field r|"
   3.312 +  using 1 a r Card_order_iff_Restr_underS by blast
   3.313 +  also have "|Field r| =o r"
   3.314 +  using r ordIso_symmetric unfolding Card_order_iff_ordIso_card_of by auto
   3.315 +  finally show ?thesis .
   3.316 +qed
   3.317 +
   3.318 +lemma ordLess_Field:
   3.319 +assumes "r <o r'"
   3.320 +shows "|Field r| <o r'"
   3.321 +proof-
   3.322 +  have "well_order_on (Field r) r" using assms unfolding ordLess_def
   3.323 +  by (auto simp add: well_order_on_Well_order)
   3.324 +  hence "|Field r| \<le>o r" using card_of_least by blast
   3.325 +  thus ?thesis using assms ordLeq_ordLess_trans by blast
   3.326 +qed
   3.327 +
   3.328 +lemma internalize_card_of_ordLeq:
   3.329 +"( |A| \<le>o r) = (\<exists>B \<le> Field r. |A| =o |B| \<and> |B| \<le>o r)"
   3.330 +proof
   3.331 +  assume "|A| \<le>o r"
   3.332 +  then obtain p where 1: "Field p \<le> Field r \<and> |A| =o p \<and> p \<le>o r"
   3.333 +  using internalize_ordLeq[of "|A|" r] by blast
   3.334 +  hence "Card_order p" using card_of_Card_order Card_order_ordIso2 by blast
   3.335 +  hence "|Field p| =o p" using card_of_Field_ordIso by blast
   3.336 +  hence "|A| =o |Field p| \<and> |Field p| \<le>o r"
   3.337 +  using 1 ordIso_equivalence ordIso_ordLeq_trans by blast
   3.338 +  thus "\<exists>B \<le> Field r. |A| =o |B| \<and> |B| \<le>o r" using 1 by blast
   3.339 +next
   3.340 +  assume "\<exists>B \<le> Field r. |A| =o |B| \<and> |B| \<le>o r"
   3.341 +  thus "|A| \<le>o r" using ordIso_ordLeq_trans by blast
   3.342 +qed
   3.343 +
   3.344 +lemma internalize_card_of_ordLeq2:
   3.345 +"( |A| \<le>o |C| ) = (\<exists>B \<le> C. |A| =o |B| \<and> |B| \<le>o |C| )"
   3.346 +using internalize_card_of_ordLeq[of "A" "|C|"] Field_card_of[of C] by auto
   3.347 +
   3.348 +
   3.349 +subsection {* Cardinals versus set operations on arbitrary sets *}
   3.350 +
   3.351 +text{* Here we embark in a long journey of simple results showing
   3.352 +that the standard set-theoretic operations are well-behaved w.r.t. the notion of
   3.353 +cardinal -- essentially, this means that they preserve the ``cardinal identity"
   3.354 +@{text "=o"} and are monotonic w.r.t. @{text "\<le>o"}.
   3.355 +*}
   3.356 +
   3.357 +lemma card_of_empty: "|{}| \<le>o |A|"
   3.358 +using card_of_ordLeq inj_on_id by blast
   3.359 +
   3.360 +lemma card_of_empty1:
   3.361 +assumes "Well_order r \<or> Card_order r"
   3.362 +shows "|{}| \<le>o r"
   3.363 +proof-
   3.364 +  have "Well_order r" using assms unfolding card_order_on_def by auto
   3.365 +  hence "|Field r| <=o r"
   3.366 +  using assms card_of_Field_ordLess by blast
   3.367 +  moreover have "|{}| \<le>o |Field r|" by (simp add: card_of_empty)
   3.368 +  ultimately show ?thesis using ordLeq_transitive by blast
   3.369 +qed
   3.370 +
   3.371 +corollary Card_order_empty:
   3.372 +"Card_order r \<Longrightarrow> |{}| \<le>o r" by (simp add: card_of_empty1)
   3.373 +
   3.374 +lemma card_of_empty2:
   3.375 +assumes LEQ: "|A| =o |{}|"
   3.376 +shows "A = {}"
   3.377 +using assms card_of_ordIso[of A] bij_betw_empty2 by blast
   3.378 +
   3.379 +lemma card_of_empty3:
   3.380 +assumes LEQ: "|A| \<le>o |{}|"
   3.381 +shows "A = {}"
   3.382 +using assms
   3.383 +by (simp add: ordIso_iff_ordLeq card_of_empty1 card_of_empty2
   3.384 +              ordLeq_Well_order_simp)
   3.385 +
   3.386 +lemma card_of_empty_ordIso:
   3.387 +"|{}::'a set| =o |{}::'b set|"
   3.388 +using card_of_ordIso unfolding bij_betw_def inj_on_def by blast
   3.389 +
   3.390 +lemma card_of_image:
   3.391 +"|f ` A| <=o |A|"
   3.392 +proof(cases "A = {}", simp add: card_of_empty)
   3.393 +  assume "A ~= {}"
   3.394 +  hence "f ` A ~= {}" by auto
   3.395 +  thus "|f ` A| \<le>o |A|"
   3.396 +  using card_of_ordLeq2[of "f ` A" A] by auto
   3.397 +qed
   3.398 +
   3.399 +lemma surj_imp_ordLeq:
   3.400 +assumes "B <= f ` A"
   3.401 +shows "|B| <=o |A|"
   3.402 +proof-
   3.403 +  have "|B| <=o |f ` A|" using assms card_of_mono1 by auto
   3.404 +  thus ?thesis using card_of_image ordLeq_transitive by blast
   3.405 +qed
   3.406 +
   3.407 +lemma card_of_ordLeqI2:
   3.408 +assumes "B \<subseteq> f ` A"
   3.409 +shows "|B| \<le>o |A|"
   3.410 +using assms by (metis surj_imp_ordLeq)
   3.411 +
   3.412 +lemma card_of_singl_ordLeq:
   3.413 +assumes "A \<noteq> {}"
   3.414 +shows "|{b}| \<le>o |A|"
   3.415 +proof-
   3.416 +  obtain a where *: "a \<in> A" using assms by auto
   3.417 +  let ?h = "\<lambda> b'::'b. if b' = b then a else undefined"
   3.418 +  have "inj_on ?h {b} \<and> ?h ` {b} \<le> A"
   3.419 +  using * unfolding inj_on_def by auto
   3.420 +  thus ?thesis using card_of_ordLeq by fast
   3.421 +qed
   3.422 +
   3.423 +corollary Card_order_singl_ordLeq:
   3.424 +"\<lbrakk>Card_order r; Field r \<noteq> {}\<rbrakk> \<Longrightarrow> |{b}| \<le>o r"
   3.425 +using card_of_singl_ordLeq[of "Field r" b]
   3.426 +      card_of_Field_ordIso[of r] ordLeq_ordIso_trans by blast
   3.427 +
   3.428 +lemma card_of_Pow: "|A| <o |Pow A|"
   3.429 +using card_of_ordLess2[of "Pow A" A]  Cantors_paradox[of A]
   3.430 +      Pow_not_empty[of A] by auto
   3.431 +
   3.432 +corollary Card_order_Pow:
   3.433 +"Card_order r \<Longrightarrow> r <o |Pow(Field r)|"
   3.434 +using card_of_Pow card_of_Field_ordIso ordIso_ordLess_trans ordIso_symmetric by blast
   3.435 +
   3.436 +lemma card_of_Plus1: "|A| \<le>o |A <+> B|"
   3.437 +proof-
   3.438 +  have "Inl ` A \<le> A <+> B" by auto
   3.439 +  thus ?thesis using inj_Inl[of A] card_of_ordLeq by blast
   3.440 +qed
   3.441 +
   3.442 +corollary Card_order_Plus1:
   3.443 +"Card_order r \<Longrightarrow> r \<le>o |(Field r) <+> B|"
   3.444 +using card_of_Plus1 card_of_Field_ordIso ordIso_ordLeq_trans ordIso_symmetric by blast
   3.445 +
   3.446 +lemma card_of_Plus2: "|B| \<le>o |A <+> B|"
   3.447 +proof-
   3.448 +  have "Inr ` B \<le> A <+> B" by auto
   3.449 +  thus ?thesis using inj_Inr[of B] card_of_ordLeq by blast
   3.450 +qed
   3.451 +
   3.452 +corollary Card_order_Plus2:
   3.453 +"Card_order r \<Longrightarrow> r \<le>o |A <+> (Field r)|"
   3.454 +using card_of_Plus2 card_of_Field_ordIso ordIso_ordLeq_trans ordIso_symmetric by blast
   3.455 +
   3.456 +lemma card_of_Plus_empty1: "|A| =o |A <+> {}|"
   3.457 +proof-
   3.458 +  have "bij_betw Inl A (A <+> {})" unfolding bij_betw_def inj_on_def by auto
   3.459 +  thus ?thesis using card_of_ordIso by auto
   3.460 +qed
   3.461 +
   3.462 +lemma card_of_Plus_empty2: "|A| =o |{} <+> A|"
   3.463 +proof-
   3.464 +  have "bij_betw Inr A ({} <+> A)" unfolding bij_betw_def inj_on_def by auto
   3.465 +  thus ?thesis using card_of_ordIso by auto
   3.466 +qed
   3.467 +
   3.468 +lemma card_of_Plus_commute: "|A <+> B| =o |B <+> A|"
   3.469 +proof-
   3.470 +  let ?f = "\<lambda>(c::'a + 'b). case c of Inl a \<Rightarrow> Inr a
   3.471 +                                   | Inr b \<Rightarrow> Inl b"
   3.472 +  have "bij_betw ?f (A <+> B) (B <+> A)"
   3.473 +  unfolding bij_betw_def inj_on_def by force
   3.474 +  thus ?thesis using card_of_ordIso by blast
   3.475 +qed
   3.476 +
   3.477 +lemma card_of_Plus_assoc:
   3.478 +fixes A :: "'a set" and B :: "'b set" and C :: "'c set"
   3.479 +shows "|(A <+> B) <+> C| =o |A <+> B <+> C|"
   3.480 +proof -
   3.481 +  def f \<equiv> "\<lambda>(k::('a + 'b) + 'c).
   3.482 +  case k of Inl ab \<Rightarrow> (case ab of Inl a \<Rightarrow> Inl a
   3.483 +                                 |Inr b \<Rightarrow> Inr (Inl b))
   3.484 +           |Inr c \<Rightarrow> Inr (Inr c)"
   3.485 +  have "A <+> B <+> C \<subseteq> f ` ((A <+> B) <+> C)"
   3.486 +  proof
   3.487 +    fix x assume x: "x \<in> A <+> B <+> C"
   3.488 +    show "x \<in> f ` ((A <+> B) <+> C)"
   3.489 +    proof(cases x)
   3.490 +      case (Inl a)
   3.491 +      hence "a \<in> A" "x = f (Inl (Inl a))"
   3.492 +      using x unfolding f_def by auto
   3.493 +      thus ?thesis by auto
   3.494 +    next
   3.495 +      case (Inr bc) note 1 = Inr show ?thesis
   3.496 +      proof(cases bc)
   3.497 +        case (Inl b)
   3.498 +        hence "b \<in> B" "x = f (Inl (Inr b))"
   3.499 +        using x 1 unfolding f_def by auto
   3.500 +        thus ?thesis by auto
   3.501 +      next
   3.502 +        case (Inr c)
   3.503 +        hence "c \<in> C" "x = f (Inr c)"
   3.504 +        using x 1 unfolding f_def by auto
   3.505 +        thus ?thesis by auto
   3.506 +      qed
   3.507 +    qed
   3.508 +  qed
   3.509 +  hence "bij_betw f ((A <+> B) <+> C) (A <+> B <+> C)"
   3.510 +  unfolding bij_betw_def inj_on_def f_def by fastforce
   3.511 +  thus ?thesis using card_of_ordIso by blast
   3.512 +qed
   3.513 +
   3.514 +lemma card_of_Plus_mono1:
   3.515 +assumes "|A| \<le>o |B|"
   3.516 +shows "|A <+> C| \<le>o |B <+> C|"
   3.517 +proof-
   3.518 +  obtain f where 1: "inj_on f A \<and> f ` A \<le> B"
   3.519 +  using assms card_of_ordLeq[of A] by fastforce
   3.520 +  obtain g where g_def:
   3.521 +  "g = (\<lambda>d. case d of Inl a \<Rightarrow> Inl(f a) | Inr (c::'c) \<Rightarrow> Inr c)" by blast
   3.522 +  have "inj_on g (A <+> C) \<and> g ` (A <+> C) \<le> (B <+> C)"
   3.523 +  proof-
   3.524 +    {fix d1 and d2 assume "d1 \<in> A <+> C \<and> d2 \<in> A <+> C" and
   3.525 +                          "g d1 = g d2"
   3.526 +     hence "d1 = d2" using 1 unfolding inj_on_def g_def by force
   3.527 +    }
   3.528 +    moreover
   3.529 +    {fix d assume "d \<in> A <+> C"
   3.530 +     hence "g d \<in> B <+> C"  using 1
   3.531 +     by(case_tac d, auto simp add: g_def)
   3.532 +    }
   3.533 +    ultimately show ?thesis unfolding inj_on_def by auto
   3.534 +  qed
   3.535 +  thus ?thesis using card_of_ordLeq by metis
   3.536 +qed
   3.537 +
   3.538 +corollary ordLeq_Plus_mono1:
   3.539 +assumes "r \<le>o r'"
   3.540 +shows "|(Field r) <+> C| \<le>o |(Field r') <+> C|"
   3.541 +using assms card_of_mono2 card_of_Plus_mono1 by blast
   3.542 +
   3.543 +lemma card_of_Plus_mono2:
   3.544 +assumes "|A| \<le>o |B|"
   3.545 +shows "|C <+> A| \<le>o |C <+> B|"
   3.546 +using assms card_of_Plus_mono1[of A B C]
   3.547 +      card_of_Plus_commute[of C A]  card_of_Plus_commute[of B C]
   3.548 +      ordIso_ordLeq_trans[of "|C <+> A|"] ordLeq_ordIso_trans[of "|C <+> A|"]
   3.549 +by blast
   3.550 +
   3.551 +corollary ordLeq_Plus_mono2:
   3.552 +assumes "r \<le>o r'"
   3.553 +shows "|A <+> (Field r)| \<le>o |A <+> (Field r')|"
   3.554 +using assms card_of_mono2 card_of_Plus_mono2 by blast
   3.555 +
   3.556 +lemma card_of_Plus_mono:
   3.557 +assumes "|A| \<le>o |B|" and "|C| \<le>o |D|"
   3.558 +shows "|A <+> C| \<le>o |B <+> D|"
   3.559 +using assms card_of_Plus_mono1[of A B C] card_of_Plus_mono2[of C D B]
   3.560 +      ordLeq_transitive[of "|A <+> C|"] by blast
   3.561 +
   3.562 +corollary ordLeq_Plus_mono:
   3.563 +assumes "r \<le>o r'" and "p \<le>o p'"
   3.564 +shows "|(Field r) <+> (Field p)| \<le>o |(Field r') <+> (Field p')|"
   3.565 +using assms card_of_mono2[of r r'] card_of_mono2[of p p'] card_of_Plus_mono by blast
   3.566 +
   3.567 +lemma card_of_Plus_cong1:
   3.568 +assumes "|A| =o |B|"
   3.569 +shows "|A <+> C| =o |B <+> C|"
   3.570 +using assms by (simp add: ordIso_iff_ordLeq card_of_Plus_mono1)
   3.571 +
   3.572 +corollary ordIso_Plus_cong1:
   3.573 +assumes "r =o r'"
   3.574 +shows "|(Field r) <+> C| =o |(Field r') <+> C|"
   3.575 +using assms card_of_cong card_of_Plus_cong1 by blast
   3.576 +
   3.577 +lemma card_of_Plus_cong2:
   3.578 +assumes "|A| =o |B|"
   3.579 +shows "|C <+> A| =o |C <+> B|"
   3.580 +using assms by (simp add: ordIso_iff_ordLeq card_of_Plus_mono2)
   3.581 +
   3.582 +corollary ordIso_Plus_cong2:
   3.583 +assumes "r =o r'"
   3.584 +shows "|A <+> (Field r)| =o |A <+> (Field r')|"
   3.585 +using assms card_of_cong card_of_Plus_cong2 by blast
   3.586 +
   3.587 +lemma card_of_Plus_cong:
   3.588 +assumes "|A| =o |B|" and "|C| =o |D|"
   3.589 +shows "|A <+> C| =o |B <+> D|"
   3.590 +using assms by (simp add: ordIso_iff_ordLeq card_of_Plus_mono)
   3.591 +
   3.592 +corollary ordIso_Plus_cong:
   3.593 +assumes "r =o r'" and "p =o p'"
   3.594 +shows "|(Field r) <+> (Field p)| =o |(Field r') <+> (Field p')|"
   3.595 +using assms card_of_cong[of r r'] card_of_cong[of p p'] card_of_Plus_cong by blast
   3.596 +
   3.597 +lemma card_of_Un_Plus_ordLeq:
   3.598 +"|A \<union> B| \<le>o |A <+> B|"
   3.599 +proof-
   3.600 +   let ?f = "\<lambda> c. if c \<in> A then Inl c else Inr c"
   3.601 +   have "inj_on ?f (A \<union> B) \<and> ?f ` (A \<union> B) \<le> A <+> B"
   3.602 +   unfolding inj_on_def by auto
   3.603 +   thus ?thesis using card_of_ordLeq by blast
   3.604 +qed
   3.605 +
   3.606 +lemma card_of_Times1:
   3.607 +assumes "A \<noteq> {}"
   3.608 +shows "|B| \<le>o |B \<times> A|"
   3.609 +proof(cases "B = {}", simp add: card_of_empty)
   3.610 +  assume *: "B \<noteq> {}"
   3.611 +  have "fst `(B \<times> A) = B" unfolding image_def using assms by auto
   3.612 +  thus ?thesis using inj_on_iff_surj[of B "B \<times> A"]
   3.613 +                     card_of_ordLeq[of B "B \<times> A"] * by blast
   3.614 +qed
   3.615 +
   3.616 +lemma card_of_Times_commute: "|A \<times> B| =o |B \<times> A|"
   3.617 +proof-
   3.618 +  let ?f = "\<lambda>(a::'a,b::'b). (b,a)"
   3.619 +  have "bij_betw ?f (A \<times> B) (B \<times> A)"
   3.620 +  unfolding bij_betw_def inj_on_def by auto
   3.621 +  thus ?thesis using card_of_ordIso by blast
   3.622 +qed
   3.623 +
   3.624 +lemma card_of_Times2:
   3.625 +assumes "A \<noteq> {}"   shows "|B| \<le>o |A \<times> B|"
   3.626 +using assms card_of_Times1[of A B] card_of_Times_commute[of B A]
   3.627 +      ordLeq_ordIso_trans by blast
   3.628 +
   3.629 +corollary Card_order_Times1:
   3.630 +"\<lbrakk>Card_order r; B \<noteq> {}\<rbrakk> \<Longrightarrow> r \<le>o |(Field r) \<times> B|"
   3.631 +using card_of_Times1[of B] card_of_Field_ordIso
   3.632 +      ordIso_ordLeq_trans ordIso_symmetric by blast
   3.633 +
   3.634 +corollary Card_order_Times2:
   3.635 +"\<lbrakk>Card_order r; A \<noteq> {}\<rbrakk> \<Longrightarrow> r \<le>o |A \<times> (Field r)|"
   3.636 +using card_of_Times2[of A] card_of_Field_ordIso
   3.637 +      ordIso_ordLeq_trans ordIso_symmetric by blast
   3.638 +
   3.639 +lemma card_of_Times3: "|A| \<le>o |A \<times> A|"
   3.640 +using card_of_Times1[of A]
   3.641 +by(cases "A = {}", simp add: card_of_empty, blast)
   3.642 +
   3.643 +lemma card_of_Plus_Times_bool: "|A <+> A| =o |A \<times> (UNIV::bool set)|"
   3.644 +proof-
   3.645 +  let ?f = "\<lambda>c::'a + 'a. case c of Inl a \<Rightarrow> (a,True)
   3.646 +                                  |Inr a \<Rightarrow> (a,False)"
   3.647 +  have "bij_betw ?f (A <+> A) (A \<times> (UNIV::bool set))"
   3.648 +  proof-
   3.649 +    {fix  c1 and c2 assume "?f c1 = ?f c2"
   3.650 +     hence "c1 = c2"
   3.651 +     by(case_tac "c1", case_tac "c2", auto, case_tac "c2", auto)
   3.652 +    }
   3.653 +    moreover
   3.654 +    {fix c assume "c \<in> A <+> A"
   3.655 +     hence "?f c \<in> A \<times> (UNIV::bool set)"
   3.656 +     by(case_tac c, auto)
   3.657 +    }
   3.658 +    moreover
   3.659 +    {fix a bl assume *: "(a,bl) \<in> A \<times> (UNIV::bool set)"
   3.660 +     have "(a,bl) \<in> ?f ` ( A <+> A)"
   3.661 +     proof(cases bl)
   3.662 +       assume bl hence "?f(Inl a) = (a,bl)" by auto
   3.663 +       thus ?thesis using * by force
   3.664 +     next
   3.665 +       assume "\<not> bl" hence "?f(Inr a) = (a,bl)" by auto
   3.666 +       thus ?thesis using * by force
   3.667 +     qed
   3.668 +    }
   3.669 +    ultimately show ?thesis unfolding bij_betw_def inj_on_def by auto
   3.670 +  qed
   3.671 +  thus ?thesis using card_of_ordIso by blast
   3.672 +qed
   3.673 +
   3.674 +lemma card_of_Times_mono1:
   3.675 +assumes "|A| \<le>o |B|"
   3.676 +shows "|A \<times> C| \<le>o |B \<times> C|"
   3.677 +proof-
   3.678 +  obtain f where 1: "inj_on f A \<and> f ` A \<le> B"
   3.679 +  using assms card_of_ordLeq[of A] by fastforce
   3.680 +  obtain g where g_def:
   3.681 +  "g = (\<lambda>(a,c::'c). (f a,c))" by blast
   3.682 +  have "inj_on g (A \<times> C) \<and> g ` (A \<times> C) \<le> (B \<times> C)"
   3.683 +  using 1 unfolding inj_on_def using g_def by auto
   3.684 +  thus ?thesis using card_of_ordLeq by metis
   3.685 +qed
   3.686 +
   3.687 +corollary ordLeq_Times_mono1:
   3.688 +assumes "r \<le>o r'"
   3.689 +shows "|(Field r) \<times> C| \<le>o |(Field r') \<times> C|"
   3.690 +using assms card_of_mono2 card_of_Times_mono1 by blast
   3.691 +
   3.692 +lemma card_of_Times_mono2:
   3.693 +assumes "|A| \<le>o |B|"
   3.694 +shows "|C \<times> A| \<le>o |C \<times> B|"
   3.695 +using assms card_of_Times_mono1[of A B C]
   3.696 +      card_of_Times_commute[of C A]  card_of_Times_commute[of B C]
   3.697 +      ordIso_ordLeq_trans[of "|C \<times> A|"] ordLeq_ordIso_trans[of "|C \<times> A|"]
   3.698 +by blast
   3.699 +
   3.700 +corollary ordLeq_Times_mono2:
   3.701 +assumes "r \<le>o r'"
   3.702 +shows "|A \<times> (Field r)| \<le>o |A \<times> (Field r')|"
   3.703 +using assms card_of_mono2 card_of_Times_mono2 by blast
   3.704 +
   3.705 +lemma card_of_Sigma_mono1:
   3.706 +assumes "\<forall>i \<in> I. |A i| \<le>o |B i|"
   3.707 +shows "|SIGMA i : I. A i| \<le>o |SIGMA i : I. B i|"
   3.708 +proof-
   3.709 +  have "\<forall>i. i \<in> I \<longrightarrow> (\<exists>f. inj_on f (A i) \<and> f ` (A i) \<le> B i)"
   3.710 +  using assms by (auto simp add: card_of_ordLeq)
   3.711 +  with choice[of "\<lambda> i f. i \<in> I \<longrightarrow> inj_on f (A i) \<and> f ` (A i) \<le> B i"]
   3.712 +  obtain F where 1: "\<forall>i \<in> I. inj_on (F i) (A i) \<and> (F i) ` (A i) \<le> B i" by metis
   3.713 +  obtain g where g_def: "g = (\<lambda>(i,a::'b). (i,F i a))" by blast
   3.714 +  have "inj_on g (Sigma I A) \<and> g ` (Sigma I A) \<le> (Sigma I B)"
   3.715 +  using 1 unfolding inj_on_def using g_def by force
   3.716 +  thus ?thesis using card_of_ordLeq by metis
   3.717 +qed
   3.718 +
   3.719 +corollary card_of_Sigma_Times:
   3.720 +"\<forall>i \<in> I. |A i| \<le>o |B| \<Longrightarrow> |SIGMA i : I. A i| \<le>o |I \<times> B|"
   3.721 +using card_of_Sigma_mono1[of I A "\<lambda>i. B"] .
   3.722 +
   3.723 +lemma card_of_UNION_Sigma:
   3.724 +"|\<Union>i \<in> I. A i| \<le>o |SIGMA i : I. A i|"
   3.725 +using Ex_inj_on_UNION_Sigma[of I A] card_of_ordLeq by metis
   3.726 +
   3.727 +lemma card_of_bool:
   3.728 +assumes "a1 \<noteq> a2"
   3.729 +shows "|UNIV::bool set| =o |{a1,a2}|"
   3.730 +proof-
   3.731 +  let ?f = "\<lambda> bl. case bl of True \<Rightarrow> a1 | False \<Rightarrow> a2"
   3.732 +  have "bij_betw ?f UNIV {a1,a2}"
   3.733 +  proof-
   3.734 +    {fix bl1 and bl2 assume "?f  bl1 = ?f bl2"
   3.735 +     hence "bl1 = bl2" using assms by (case_tac bl1, case_tac bl2, auto)
   3.736 +    }
   3.737 +    moreover
   3.738 +    {fix bl have "?f bl \<in> {a1,a2}" by (case_tac bl, auto)
   3.739 +    }
   3.740 +    moreover
   3.741 +    {fix a assume *: "a \<in> {a1,a2}"
   3.742 +     have "a \<in> ?f ` UNIV"
   3.743 +     proof(cases "a = a1")
   3.744 +       assume "a = a1"
   3.745 +       hence "?f True = a" by auto  thus ?thesis by blast
   3.746 +     next
   3.747 +       assume "a \<noteq> a1" hence "a = a2" using * by auto
   3.748 +       hence "?f False = a" by auto  thus ?thesis by blast
   3.749 +     qed
   3.750 +    }
   3.751 +    ultimately show ?thesis unfolding bij_betw_def inj_on_def
   3.752 +    by (metis image_subsetI order_eq_iff subsetI)
   3.753 +  qed
   3.754 +  thus ?thesis using card_of_ordIso by blast
   3.755 +qed
   3.756 +
   3.757 +lemma card_of_Plus_Times_aux:
   3.758 +assumes A2: "a1 \<noteq> a2 \<and> {a1,a2} \<le> A" and
   3.759 +        LEQ: "|A| \<le>o |B|"
   3.760 +shows "|A <+> B| \<le>o |A \<times> B|"
   3.761 +proof-
   3.762 +  have 1: "|UNIV::bool set| \<le>o |A|"
   3.763 +  using A2 card_of_mono1[of "{a1,a2}"] card_of_bool[of a1 a2]
   3.764 +        ordIso_ordLeq_trans[of "|UNIV::bool set|"] by metis
   3.765 +  (*  *)
   3.766 +  have "|A <+> B| \<le>o |B <+> B|"
   3.767 +  using LEQ card_of_Plus_mono1 by blast
   3.768 +  moreover have "|B <+> B| =o |B \<times> (UNIV::bool set)|"
   3.769 +  using card_of_Plus_Times_bool by blast
   3.770 +  moreover have "|B \<times> (UNIV::bool set)| \<le>o |B \<times> A|"
   3.771 +  using 1 by (simp add: card_of_Times_mono2)
   3.772 +  moreover have " |B \<times> A| =o |A \<times> B|"
   3.773 +  using card_of_Times_commute by blast
   3.774 +  ultimately show "|A <+> B| \<le>o |A \<times> B|"
   3.775 +  using ordLeq_ordIso_trans[of "|A <+> B|" "|B <+> B|" "|B \<times> (UNIV::bool set)|"]
   3.776 +        ordLeq_transitive[of "|A <+> B|" "|B \<times> (UNIV::bool set)|" "|B \<times> A|"]
   3.777 +        ordLeq_ordIso_trans[of "|A <+> B|" "|B \<times> A|" "|A \<times> B|"]
   3.778 +  by blast
   3.779 +qed
   3.780 +
   3.781 +lemma card_of_Plus_Times:
   3.782 +assumes A2: "a1 \<noteq> a2 \<and> {a1,a2} \<le> A" and
   3.783 +        B2: "b1 \<noteq> b2 \<and> {b1,b2} \<le> B"
   3.784 +shows "|A <+> B| \<le>o |A \<times> B|"
   3.785 +proof-
   3.786 +  {assume "|A| \<le>o |B|"
   3.787 +   hence ?thesis using assms by (auto simp add: card_of_Plus_Times_aux)
   3.788 +  }
   3.789 +  moreover
   3.790 +  {assume "|B| \<le>o |A|"
   3.791 +   hence "|B <+> A| \<le>o |B \<times> A|"
   3.792 +   using assms by (auto simp add: card_of_Plus_Times_aux)
   3.793 +   hence ?thesis
   3.794 +   using card_of_Plus_commute card_of_Times_commute
   3.795 +         ordIso_ordLeq_trans ordLeq_ordIso_trans by metis
   3.796 +  }
   3.797 +  ultimately show ?thesis
   3.798 +  using card_of_Well_order[of A] card_of_Well_order[of B]
   3.799 +        ordLeq_total[of "|A|"] by metis
   3.800 +qed
   3.801 +
   3.802 +lemma card_of_ordLeq_finite:
   3.803 +assumes "|A| \<le>o |B|" and "finite B"
   3.804 +shows "finite A"
   3.805 +using assms unfolding ordLeq_def
   3.806 +using embed_inj_on[of "|A|" "|B|"]  embed_Field[of "|A|" "|B|"]
   3.807 +      Field_card_of[of "A"] Field_card_of[of "B"] inj_on_finite[of _ "A" "B"] by fastforce
   3.808 +
   3.809 +lemma card_of_ordLeq_infinite:
   3.810 +assumes "|A| \<le>o |B|" and "\<not> finite A"
   3.811 +shows "\<not> finite B"
   3.812 +using assms card_of_ordLeq_finite by auto
   3.813 +
   3.814 +lemma card_of_ordIso_finite:
   3.815 +assumes "|A| =o |B|"
   3.816 +shows "finite A = finite B"
   3.817 +using assms unfolding ordIso_def iso_def[abs_def]
   3.818 +by (auto simp: bij_betw_finite Field_card_of)
   3.819 +
   3.820 +lemma card_of_ordIso_finite_Field:
   3.821 +assumes "Card_order r" and "r =o |A|"
   3.822 +shows "finite(Field r) = finite A"
   3.823 +using assms card_of_Field_ordIso card_of_ordIso_finite ordIso_equivalence by blast
   3.824 +
   3.825 +
   3.826 +subsection {* Cardinals versus set operations involving infinite sets *}
   3.827 +
   3.828 +text{* Here we show that, for infinite sets, most set-theoretic constructions
   3.829 +do not increase the cardinality.  The cornerstone for this is
   3.830 +theorem @{text "Card_order_Times_same_infinite"}, which states that self-product
   3.831 +does not increase cardinality -- the proof of this fact adapts a standard
   3.832 +set-theoretic argument, as presented, e.g., in the proof of theorem 1.5.11
   3.833 +at page 47 in \cite{card-book}. Then everything else follows fairly easily.  *}
   3.834 +
   3.835 +lemma infinite_iff_card_of_nat:
   3.836 +"\<not> finite A \<longleftrightarrow> ( |UNIV::nat set| \<le>o |A| )"
   3.837 +unfolding infinite_iff_countable_subset card_of_ordLeq ..
   3.838 +
   3.839 +text{* The next two results correspond to the ZF fact that all infinite cardinals are
   3.840 +limit ordinals: *}
   3.841 +
   3.842 +lemma Card_order_infinite_not_under:
   3.843 +assumes CARD: "Card_order r" and INF: "\<not>finite (Field r)"
   3.844 +shows "\<not> (\<exists>a. Field r = under r a)"
   3.845 +proof(auto)
   3.846 +  have 0: "Well_order r \<and> wo_rel r \<and> Refl r"
   3.847 +  using CARD unfolding wo_rel_def card_order_on_def order_on_defs by auto
   3.848 +  fix a assume *: "Field r = under r a"
   3.849 +  show False
   3.850 +  proof(cases "a \<in> Field r")
   3.851 +    assume Case1: "a \<notin> Field r"
   3.852 +    hence "under r a = {}" unfolding Field_def under_def by auto
   3.853 +    thus False using INF *  by auto
   3.854 +  next
   3.855 +    let ?r' = "Restr r (underS r a)"
   3.856 +    assume Case2: "a \<in> Field r"
   3.857 +    hence 1: "under r a = underS r a \<union> {a} \<and> a \<notin> underS r a"
   3.858 +    using 0 Refl_under_underS underS_notIn by metis
   3.859 +    have 2: "wo_rel.ofilter r (underS r a) \<and> underS r a < Field r"
   3.860 +    using 0 wo_rel.underS_ofilter * 1 Case2 by fast
   3.861 +    hence "?r' <o r" using 0 using ofilter_ordLess by blast
   3.862 +    moreover
   3.863 +    have "Field ?r' = underS r a \<and> Well_order ?r'"
   3.864 +    using  2 0 Field_Restr_ofilter[of r] Well_order_Restr[of r] by blast
   3.865 +    ultimately have "|underS r a| <o r" using ordLess_Field[of ?r'] by auto
   3.866 +    moreover have "|under r a| =o r" using * CARD card_of_Field_ordIso[of r] by auto
   3.867 +    ultimately have "|underS r a| <o |under r a|"
   3.868 +    using ordIso_symmetric ordLess_ordIso_trans by blast
   3.869 +    moreover
   3.870 +    {have "\<exists>f. bij_betw f (under r a) (underS r a)"
   3.871 +     using infinite_imp_bij_betw[of "Field r" a] INF * 1 by auto
   3.872 +     hence "|under r a| =o |underS r a|" using card_of_ordIso by blast
   3.873 +    }
   3.874 +    ultimately show False using not_ordLess_ordIso ordIso_symmetric by blast
   3.875 +  qed
   3.876 +qed
   3.877 +
   3.878 +lemma infinite_Card_order_limit:
   3.879 +assumes r: "Card_order r" and "\<not>finite (Field r)"
   3.880 +and a: "a : Field r"
   3.881 +shows "EX b : Field r. a \<noteq> b \<and> (a,b) : r"
   3.882 +proof-
   3.883 +  have "Field r \<noteq> under r a"
   3.884 +  using assms Card_order_infinite_not_under by blast
   3.885 +  moreover have "under r a \<le> Field r"
   3.886 +  using under_Field .
   3.887 +  ultimately have "under r a < Field r" by blast
   3.888 +  then obtain b where 1: "b : Field r \<and> ~ (b,a) : r"
   3.889 +  unfolding under_def by blast
   3.890 +  moreover have ba: "b \<noteq> a"
   3.891 +  using 1 r unfolding card_order_on_def well_order_on_def
   3.892 +  linear_order_on_def partial_order_on_def preorder_on_def refl_on_def by auto
   3.893 +  ultimately have "(a,b) : r"
   3.894 +  using a r unfolding card_order_on_def well_order_on_def linear_order_on_def
   3.895 +  total_on_def by blast
   3.896 +  thus ?thesis using 1 ba by auto
   3.897 +qed
   3.898 +
   3.899 +theorem Card_order_Times_same_infinite:
   3.900 +assumes CO: "Card_order r" and INF: "\<not>finite(Field r)"
   3.901 +shows "|Field r \<times> Field r| \<le>o r"
   3.902 +proof-
   3.903 +  obtain phi where phi_def:
   3.904 +  "phi = (\<lambda>r::'a rel. Card_order r \<and> \<not>finite(Field r) \<and>
   3.905 +                      \<not> |Field r \<times> Field r| \<le>o r )" by blast
   3.906 +  have temp1: "\<forall>r. phi r \<longrightarrow> Well_order r"
   3.907 +  unfolding phi_def card_order_on_def by auto
   3.908 +  have Ft: "\<not>(\<exists>r. phi r)"
   3.909 +  proof
   3.910 +    assume "\<exists>r. phi r"
   3.911 +    hence "{r. phi r} \<noteq> {} \<and> {r. phi r} \<le> {r. Well_order r}"
   3.912 +    using temp1 by auto
   3.913 +    then obtain r where 1: "phi r" and 2: "\<forall>r'. phi r' \<longrightarrow> r \<le>o r'" and
   3.914 +                   3: "Card_order r \<and> Well_order r"
   3.915 +    using exists_minim_Well_order[of "{r. phi r}"] temp1 phi_def by blast
   3.916 +    let ?A = "Field r"  let ?r' = "bsqr r"
   3.917 +    have 4: "Well_order ?r' \<and> Field ?r' = ?A \<times> ?A \<and> |?A| =o r"
   3.918 +    using 3 bsqr_Well_order Field_bsqr card_of_Field_ordIso by blast
   3.919 +    have 5: "Card_order |?A \<times> ?A| \<and> Well_order |?A \<times> ?A|"
   3.920 +    using card_of_Card_order card_of_Well_order by blast
   3.921 +    (*  *)
   3.922 +    have "r <o |?A \<times> ?A|"
   3.923 +    using 1 3 5 ordLess_or_ordLeq unfolding phi_def by blast
   3.924 +    moreover have "|?A \<times> ?A| \<le>o ?r'"
   3.925 +    using card_of_least[of "?A \<times> ?A"] 4 by auto
   3.926 +    ultimately have "r <o ?r'" using ordLess_ordLeq_trans by auto
   3.927 +    then obtain f where 6: "embed r ?r' f" and 7: "\<not> bij_betw f ?A (?A \<times> ?A)"
   3.928 +    unfolding ordLess_def embedS_def[abs_def]
   3.929 +    by (auto simp add: Field_bsqr)
   3.930 +    let ?B = "f ` ?A"
   3.931 +    have "|?A| =o |?B|"
   3.932 +    using 3 6 embed_inj_on inj_on_imp_bij_betw card_of_ordIso by blast
   3.933 +    hence 8: "r =o |?B|" using 4 ordIso_transitive ordIso_symmetric by blast
   3.934 +    (*  *)
   3.935 +    have "wo_rel.ofilter ?r' ?B"
   3.936 +    using 6 embed_Field_ofilter 3 4 by blast
   3.937 +    hence "wo_rel.ofilter ?r' ?B \<and> ?B \<noteq> ?A \<times> ?A \<and> ?B \<noteq> Field ?r'"
   3.938 +    using 7 unfolding bij_betw_def using 6 3 embed_inj_on 4 by auto
   3.939 +    hence temp2: "wo_rel.ofilter ?r' ?B \<and> ?B < ?A \<times> ?A"
   3.940 +    using 4 wo_rel_def[of ?r'] wo_rel.ofilter_def[of ?r' ?B] by blast
   3.941 +    have "\<not> (\<exists>a. Field r = under r a)"
   3.942 +    using 1 unfolding phi_def using Card_order_infinite_not_under[of r] by auto
   3.943 +    then obtain A1 where temp3: "wo_rel.ofilter r A1 \<and> A1 < ?A" and 9: "?B \<le> A1 \<times> A1"
   3.944 +    using temp2 3 bsqr_ofilter[of r ?B] by blast
   3.945 +    hence "|?B| \<le>o |A1 \<times> A1|" using card_of_mono1 by blast
   3.946 +    hence 10: "r \<le>o |A1 \<times> A1|" using 8 ordIso_ordLeq_trans by blast
   3.947 +    let ?r1 = "Restr r A1"
   3.948 +    have "?r1 <o r" using temp3 ofilter_ordLess 3 by blast
   3.949 +    moreover
   3.950 +    {have "well_order_on A1 ?r1" using 3 temp3 well_order_on_Restr by blast
   3.951 +     hence "|A1| \<le>o ?r1" using 3 Well_order_Restr card_of_least by blast
   3.952 +    }
   3.953 +    ultimately have 11: "|A1| <o r" using ordLeq_ordLess_trans by blast
   3.954 +    (*  *)
   3.955 +    have "\<not> finite (Field r)" using 1 unfolding phi_def by simp
   3.956 +    hence "\<not> finite ?B" using 8 3 card_of_ordIso_finite_Field[of r ?B] by blast
   3.957 +    hence "\<not> finite A1" using 9 finite_cartesian_product finite_subset by metis
   3.958 +    moreover have temp4: "Field |A1| = A1 \<and> Well_order |A1| \<and> Card_order |A1|"
   3.959 +    using card_of_Card_order[of A1] card_of_Well_order[of A1]
   3.960 +    by (simp add: Field_card_of)
   3.961 +    moreover have "\<not> r \<le>o | A1 |"
   3.962 +    using temp4 11 3 using not_ordLeq_iff_ordLess by blast
   3.963 +    ultimately have "\<not> finite(Field |A1| ) \<and> Card_order |A1| \<and> \<not> r \<le>o | A1 |"
   3.964 +    by (simp add: card_of_card_order_on)
   3.965 +    hence "|Field |A1| \<times> Field |A1| | \<le>o |A1|"
   3.966 +    using 2 unfolding phi_def by blast
   3.967 +    hence "|A1 \<times> A1 | \<le>o |A1|" using temp4 by auto
   3.968 +    hence "r \<le>o |A1|" using 10 ordLeq_transitive by blast
   3.969 +    thus False using 11 not_ordLess_ordLeq by auto
   3.970 +  qed
   3.971 +  thus ?thesis using assms unfolding phi_def by blast
   3.972 +qed
   3.973 +
   3.974 +corollary card_of_Times_same_infinite:
   3.975 +assumes "\<not>finite A"
   3.976 +shows "|A \<times> A| =o |A|"
   3.977 +proof-
   3.978 +  let ?r = "|A|"
   3.979 +  have "Field ?r = A \<and> Card_order ?r"
   3.980 +  using Field_card_of card_of_Card_order[of A] by fastforce
   3.981 +  hence "|A \<times> A| \<le>o |A|"
   3.982 +  using Card_order_Times_same_infinite[of ?r] assms by auto
   3.983 +  thus ?thesis using card_of_Times3 ordIso_iff_ordLeq by blast
   3.984 +qed
   3.985 +
   3.986 +lemma card_of_Times_infinite:
   3.987 +assumes INF: "\<not>finite A" and NE: "B \<noteq> {}" and LEQ: "|B| \<le>o |A|"
   3.988 +shows "|A \<times> B| =o |A| \<and> |B \<times> A| =o |A|"
   3.989 +proof-
   3.990 +  have "|A| \<le>o |A \<times> B| \<and> |A| \<le>o |B \<times> A|"
   3.991 +  using assms by (simp add: card_of_Times1 card_of_Times2)
   3.992 +  moreover
   3.993 +  {have "|A \<times> B| \<le>o |A \<times> A| \<and> |B \<times> A| \<le>o |A \<times> A|"
   3.994 +   using LEQ card_of_Times_mono1 card_of_Times_mono2 by blast
   3.995 +   moreover have "|A \<times> A| =o |A|" using INF card_of_Times_same_infinite by blast
   3.996 +   ultimately have "|A \<times> B| \<le>o |A| \<and> |B \<times> A| \<le>o |A|"
   3.997 +   using ordLeq_ordIso_trans[of "|A \<times> B|"] ordLeq_ordIso_trans[of "|B \<times> A|"] by auto
   3.998 +  }
   3.999 +  ultimately show ?thesis by (simp add: ordIso_iff_ordLeq)
  3.1000 +qed
  3.1001 +
  3.1002 +corollary Card_order_Times_infinite:
  3.1003 +assumes INF: "\<not>finite(Field r)" and CARD: "Card_order r" and
  3.1004 +        NE: "Field p \<noteq> {}" and LEQ: "p \<le>o r"
  3.1005 +shows "| (Field r) \<times> (Field p) | =o r \<and> | (Field p) \<times> (Field r) | =o r"
  3.1006 +proof-
  3.1007 +  have "|Field r \<times> Field p| =o |Field r| \<and> |Field p \<times> Field r| =o |Field r|"
  3.1008 +  using assms by (simp add: card_of_Times_infinite card_of_mono2)
  3.1009 +  thus ?thesis
  3.1010 +  using assms card_of_Field_ordIso[of r]
  3.1011 +        ordIso_transitive[of "|Field r \<times> Field p|"]
  3.1012 +        ordIso_transitive[of _ "|Field r|"] by blast
  3.1013 +qed
  3.1014 +
  3.1015 +lemma card_of_Sigma_ordLeq_infinite:
  3.1016 +assumes INF: "\<not>finite B" and
  3.1017 +        LEQ_I: "|I| \<le>o |B|" and LEQ: "\<forall>i \<in> I. |A i| \<le>o |B|"
  3.1018 +shows "|SIGMA i : I. A i| \<le>o |B|"
  3.1019 +proof(cases "I = {}", simp add: card_of_empty)
  3.1020 +  assume *: "I \<noteq> {}"
  3.1021 +  have "|SIGMA i : I. A i| \<le>o |I \<times> B|"
  3.1022 +  using LEQ card_of_Sigma_Times by blast
  3.1023 +  moreover have "|I \<times> B| =o |B|"
  3.1024 +  using INF * LEQ_I by (auto simp add: card_of_Times_infinite)
  3.1025 +  ultimately show ?thesis using ordLeq_ordIso_trans by blast
  3.1026 +qed
  3.1027 +
  3.1028 +lemma card_of_Sigma_ordLeq_infinite_Field:
  3.1029 +assumes INF: "\<not>finite (Field r)" and r: "Card_order r" and
  3.1030 +        LEQ_I: "|I| \<le>o r" and LEQ: "\<forall>i \<in> I. |A i| \<le>o r"
  3.1031 +shows "|SIGMA i : I. A i| \<le>o r"
  3.1032 +proof-
  3.1033 +  let ?B  = "Field r"
  3.1034 +  have 1: "r =o |?B| \<and> |?B| =o r" using r card_of_Field_ordIso
  3.1035 +  ordIso_symmetric by blast
  3.1036 +  hence "|I| \<le>o |?B|"  "\<forall>i \<in> I. |A i| \<le>o |?B|"
  3.1037 +  using LEQ_I LEQ ordLeq_ordIso_trans by blast+
  3.1038 +  hence  "|SIGMA i : I. A i| \<le>o |?B|" using INF LEQ
  3.1039 +  card_of_Sigma_ordLeq_infinite by blast
  3.1040 +  thus ?thesis using 1 ordLeq_ordIso_trans by blast
  3.1041 +qed
  3.1042 +
  3.1043 +lemma card_of_Times_ordLeq_infinite_Field:
  3.1044 +"\<lbrakk>\<not>finite (Field r); |A| \<le>o r; |B| \<le>o r; Card_order r\<rbrakk>
  3.1045 + \<Longrightarrow> |A <*> B| \<le>o r"
  3.1046 +by(simp add: card_of_Sigma_ordLeq_infinite_Field)
  3.1047 +
  3.1048 +lemma card_of_Times_infinite_simps:
  3.1049 +"\<lbrakk>\<not>finite A; B \<noteq> {}; |B| \<le>o |A|\<rbrakk> \<Longrightarrow> |A \<times> B| =o |A|"
  3.1050 +"\<lbrakk>\<not>finite A; B \<noteq> {}; |B| \<le>o |A|\<rbrakk> \<Longrightarrow> |A| =o |A \<times> B|"
  3.1051 +"\<lbrakk>\<not>finite A; B \<noteq> {}; |B| \<le>o |A|\<rbrakk> \<Longrightarrow> |B \<times> A| =o |A|"
  3.1052 +"\<lbrakk>\<not>finite A; B \<noteq> {}; |B| \<le>o |A|\<rbrakk> \<Longrightarrow> |A| =o |B \<times> A|"
  3.1053 +by (auto simp add: card_of_Times_infinite ordIso_symmetric)
  3.1054 +
  3.1055 +lemma card_of_UNION_ordLeq_infinite:
  3.1056 +assumes INF: "\<not>finite B" and
  3.1057 +        LEQ_I: "|I| \<le>o |B|" and LEQ: "\<forall>i \<in> I. |A i| \<le>o |B|"
  3.1058 +shows "|\<Union> i \<in> I. A i| \<le>o |B|"
  3.1059 +proof(cases "I = {}", simp add: card_of_empty)
  3.1060 +  assume *: "I \<noteq> {}"
  3.1061 +  have "|\<Union> i \<in> I. A i| \<le>o |SIGMA i : I. A i|"
  3.1062 +  using card_of_UNION_Sigma by blast
  3.1063 +  moreover have "|SIGMA i : I. A i| \<le>o |B|"
  3.1064 +  using assms card_of_Sigma_ordLeq_infinite by blast
  3.1065 +  ultimately show ?thesis using ordLeq_transitive by blast
  3.1066 +qed
  3.1067 +
  3.1068 +corollary card_of_UNION_ordLeq_infinite_Field:
  3.1069 +assumes INF: "\<not>finite (Field r)" and r: "Card_order r" and
  3.1070 +        LEQ_I: "|I| \<le>o r" and LEQ: "\<forall>i \<in> I. |A i| \<le>o r"
  3.1071 +shows "|\<Union> i \<in> I. A i| \<le>o r"
  3.1072 +proof-
  3.1073 +  let ?B  = "Field r"
  3.1074 +  have 1: "r =o |?B| \<and> |?B| =o r" using r card_of_Field_ordIso
  3.1075 +  ordIso_symmetric by blast
  3.1076 +  hence "|I| \<le>o |?B|"  "\<forall>i \<in> I. |A i| \<le>o |?B|"
  3.1077 +  using LEQ_I LEQ ordLeq_ordIso_trans by blast+
  3.1078 +  hence  "|\<Union> i \<in> I. A i| \<le>o |?B|" using INF LEQ
  3.1079 +  card_of_UNION_ordLeq_infinite by blast
  3.1080 +  thus ?thesis using 1 ordLeq_ordIso_trans by blast
  3.1081 +qed
  3.1082 +
  3.1083 +lemma card_of_Plus_infinite1:
  3.1084 +assumes INF: "\<not>finite A" and LEQ: "|B| \<le>o |A|"
  3.1085 +shows "|A <+> B| =o |A|"
  3.1086 +proof(cases "B = {}", simp add: card_of_Plus_empty1 card_of_Plus_empty2 ordIso_symmetric)
  3.1087 +  let ?Inl = "Inl::'a \<Rightarrow> 'a + 'b"  let ?Inr = "Inr::'b \<Rightarrow> 'a + 'b"
  3.1088 +  assume *: "B \<noteq> {}"
  3.1089 +  then obtain b1 where 1: "b1 \<in> B" by blast
  3.1090 +  show ?thesis
  3.1091 +  proof(cases "B = {b1}")
  3.1092 +    assume Case1: "B = {b1}"
  3.1093 +    have 2: "bij_betw ?Inl A ((?Inl ` A))"
  3.1094 +    unfolding bij_betw_def inj_on_def by auto
  3.1095 +    hence 3: "\<not>finite (?Inl ` A)"
  3.1096 +    using INF bij_betw_finite[of ?Inl A] by blast
  3.1097 +    let ?A' = "?Inl ` A \<union> {?Inr b1}"
  3.1098 +    obtain g where "bij_betw g (?Inl ` A) ?A'"
  3.1099 +    using 3 infinite_imp_bij_betw2[of "?Inl ` A"] by auto
  3.1100 +    moreover have "?A' = A <+> B" using Case1 by blast
  3.1101 +    ultimately have "bij_betw g (?Inl ` A) (A <+> B)" by simp
  3.1102 +    hence "bij_betw (g o ?Inl) A (A <+> B)"
  3.1103 +    using 2 by (auto simp add: bij_betw_trans)
  3.1104 +    thus ?thesis using card_of_ordIso ordIso_symmetric by blast
  3.1105 +  next
  3.1106 +    assume Case2: "B \<noteq> {b1}"
  3.1107 +    with * 1 obtain b2 where 3: "b1 \<noteq> b2 \<and> {b1,b2} \<le> B" by fastforce
  3.1108 +    obtain f where "inj_on f B \<and> f ` B \<le> A"
  3.1109 +    using LEQ card_of_ordLeq[of B] by fastforce
  3.1110 +    with 3 have "f b1 \<noteq> f b2 \<and> {f b1, f b2} \<le> A"
  3.1111 +    unfolding inj_on_def by auto
  3.1112 +    with 3 have "|A <+> B| \<le>o |A \<times> B|"
  3.1113 +    by (auto simp add: card_of_Plus_Times)
  3.1114 +    moreover have "|A \<times> B| =o |A|"
  3.1115 +    using assms * by (simp add: card_of_Times_infinite_simps)
  3.1116 +    ultimately have "|A <+> B| \<le>o |A|" using ordLeq_ordIso_trans by metis
  3.1117 +    thus ?thesis using card_of_Plus1 ordIso_iff_ordLeq by blast
  3.1118 +  qed
  3.1119 +qed
  3.1120 +
  3.1121 +lemma card_of_Plus_infinite2:
  3.1122 +assumes INF: "\<not>finite A" and LEQ: "|B| \<le>o |A|"
  3.1123 +shows "|B <+> A| =o |A|"
  3.1124 +using assms card_of_Plus_commute card_of_Plus_infinite1
  3.1125 +ordIso_equivalence by blast
  3.1126 +
  3.1127 +lemma card_of_Plus_infinite:
  3.1128 +assumes INF: "\<not>finite A" and LEQ: "|B| \<le>o |A|"
  3.1129 +shows "|A <+> B| =o |A| \<and> |B <+> A| =o |A|"
  3.1130 +using assms by (auto simp: card_of_Plus_infinite1 card_of_Plus_infinite2)
  3.1131 +
  3.1132 +corollary Card_order_Plus_infinite:
  3.1133 +assumes INF: "\<not>finite(Field r)" and CARD: "Card_order r" and
  3.1134 +        LEQ: "p \<le>o r"
  3.1135 +shows "| (Field r) <+> (Field p) | =o r \<and> | (Field p) <+> (Field r) | =o r"
  3.1136 +proof-
  3.1137 +  have "| Field r <+> Field p | =o | Field r | \<and>
  3.1138 +        | Field p <+> Field r | =o | Field r |"
  3.1139 +  using assms by (simp add: card_of_Plus_infinite card_of_mono2)
  3.1140 +  thus ?thesis
  3.1141 +  using assms card_of_Field_ordIso[of r]
  3.1142 +        ordIso_transitive[of "|Field r <+> Field p|"]
  3.1143 +        ordIso_transitive[of _ "|Field r|"] by blast
  3.1144 +qed
  3.1145 +
  3.1146 +
  3.1147 +subsection {* The cardinal $\omega$ and the finite cardinals  *}
  3.1148 +
  3.1149 +text{* The cardinal $\omega$, of natural numbers, shall be the standard non-strict
  3.1150 +order relation on
  3.1151 +@{text "nat"}, that we abbreviate by @{text "natLeq"}.  The finite cardinals
  3.1152 +shall be the restrictions of these relations to the numbers smaller than
  3.1153 +fixed numbers @{text "n"}, that we abbreviate by @{text "natLeq_on n"}.  *}
  3.1154 +
  3.1155 +abbreviation "(natLeq::(nat * nat) set) \<equiv> {(x,y). x \<le> y}"
  3.1156 +abbreviation "(natLess::(nat * nat) set) \<equiv> {(x,y). x < y}"
  3.1157 +
  3.1158 +abbreviation natLeq_on :: "nat \<Rightarrow> (nat * nat) set"
  3.1159 +where "natLeq_on n \<equiv> {(x,y). x < n \<and> y < n \<and> x \<le> y}"
  3.1160 +
  3.1161 +lemma infinite_cartesian_product:
  3.1162 +assumes "\<not>finite A" "\<not>finite B"
  3.1163 +shows "\<not>finite (A \<times> B)"
  3.1164 +proof
  3.1165 +  assume "finite (A \<times> B)"
  3.1166 +  from assms(1) have "A \<noteq> {}" by auto
  3.1167 +  with `finite (A \<times> B)` have "finite B" using finite_cartesian_productD2 by auto
  3.1168 +  with assms(2) show False by simp
  3.1169 +qed
  3.1170 +
  3.1171 +
  3.1172 +subsubsection {* First as well-orders *}
  3.1173 +
  3.1174 +lemma Field_natLeq: "Field natLeq = (UNIV::nat set)"
  3.1175 +by(unfold Field_def, auto)
  3.1176 +
  3.1177 +lemma natLeq_Refl: "Refl natLeq"
  3.1178 +unfolding refl_on_def Field_def by auto
  3.1179 +
  3.1180 +lemma natLeq_trans: "trans natLeq"
  3.1181 +unfolding trans_def by auto
  3.1182 +
  3.1183 +lemma natLeq_Preorder: "Preorder natLeq"
  3.1184 +unfolding preorder_on_def
  3.1185 +by (auto simp add: natLeq_Refl natLeq_trans)
  3.1186 +
  3.1187 +lemma natLeq_antisym: "antisym natLeq"
  3.1188 +unfolding antisym_def by auto
  3.1189 +
  3.1190 +lemma natLeq_Partial_order: "Partial_order natLeq"
  3.1191 +unfolding partial_order_on_def
  3.1192 +by (auto simp add: natLeq_Preorder natLeq_antisym)
  3.1193 +
  3.1194 +lemma natLeq_Total: "Total natLeq"
  3.1195 +unfolding total_on_def by auto
  3.1196 +
  3.1197 +lemma natLeq_Linear_order: "Linear_order natLeq"
  3.1198 +unfolding linear_order_on_def
  3.1199 +by (auto simp add: natLeq_Partial_order natLeq_Total)
  3.1200 +
  3.1201 +lemma natLeq_natLess_Id: "natLess = natLeq - Id"
  3.1202 +by auto
  3.1203 +
  3.1204 +lemma natLeq_Well_order: "Well_order natLeq"
  3.1205 +unfolding well_order_on_def
  3.1206 +using natLeq_Linear_order wf_less natLeq_natLess_Id by auto
  3.1207 +
  3.1208 +lemma Field_natLeq_on: "Field (natLeq_on n) = {x. x < n}"
  3.1209 +unfolding Field_def by auto
  3.1210 +
  3.1211 +lemma natLeq_underS_less: "underS natLeq n = {x. x < n}"
  3.1212 +unfolding underS_def by auto
  3.1213 +
  3.1214 +lemma Restr_natLeq: "Restr natLeq {x. x < n} = natLeq_on n"
  3.1215 +by force
  3.1216 +
  3.1217 +lemma Restr_natLeq2:
  3.1218 +"Restr natLeq (underS natLeq n) = natLeq_on n"
  3.1219 +by (auto simp add: Restr_natLeq natLeq_underS_less)
  3.1220 +
  3.1221 +lemma natLeq_on_Well_order: "Well_order(natLeq_on n)"
  3.1222 +using Restr_natLeq[of n] natLeq_Well_order
  3.1223 +      Well_order_Restr[of natLeq "{x. x < n}"] by auto
  3.1224 +
  3.1225 +corollary natLeq_on_well_order_on: "well_order_on {x. x < n} (natLeq_on n)"
  3.1226 +using natLeq_on_Well_order Field_natLeq_on by auto
  3.1227 +
  3.1228 +lemma natLeq_on_wo_rel: "wo_rel(natLeq_on n)"
  3.1229 +unfolding wo_rel_def using natLeq_on_Well_order .
  3.1230 +
  3.1231 +
  3.1232 +subsubsection {* Then as cardinals *}
  3.1233 +
  3.1234 +lemma natLeq_Card_order: "Card_order natLeq"
  3.1235 +proof(auto simp add: natLeq_Well_order
  3.1236 +      Card_order_iff_Restr_underS Restr_natLeq2, simp add:  Field_natLeq)
  3.1237 +  fix n have "finite(Field (natLeq_on n))" by (auto simp: Field_def)
  3.1238 +  moreover have "\<not>finite(UNIV::nat set)" by auto
  3.1239 +  ultimately show "natLeq_on n <o |UNIV::nat set|"
  3.1240 +  using finite_ordLess_infinite[of "natLeq_on n" "|UNIV::nat set|"]
  3.1241 +        Field_card_of[of "UNIV::nat set"]
  3.1242 +        card_of_Well_order[of "UNIV::nat set"] natLeq_on_Well_order[of n] by auto
  3.1243 +qed
  3.1244 +
  3.1245 +corollary card_of_Field_natLeq:
  3.1246 +"|Field natLeq| =o natLeq"
  3.1247 +using Field_natLeq natLeq_Card_order Card_order_iff_ordIso_card_of[of natLeq]
  3.1248 +      ordIso_symmetric[of natLeq] by blast
  3.1249 +
  3.1250 +corollary card_of_nat:
  3.1251 +"|UNIV::nat set| =o natLeq"
  3.1252 +using Field_natLeq card_of_Field_natLeq by auto
  3.1253 +
  3.1254 +corollary infinite_iff_natLeq_ordLeq:
  3.1255 +"\<not>finite A = ( natLeq \<le>o |A| )"
  3.1256 +using infinite_iff_card_of_nat[of A] card_of_nat
  3.1257 +      ordIso_ordLeq_trans ordLeq_ordIso_trans ordIso_symmetric by blast
  3.1258 +
  3.1259 +corollary finite_iff_ordLess_natLeq:
  3.1260 +"finite A = ( |A| <o natLeq)"
  3.1261 +using infinite_iff_natLeq_ordLeq not_ordLeq_iff_ordLess
  3.1262 +      card_of_Well_order natLeq_Well_order by metis
  3.1263 +
  3.1264 +
  3.1265 +subsection {* The successor of a cardinal *}
  3.1266 +
  3.1267 +text{* First we define @{text "isCardSuc r r'"}, the notion of @{text "r'"}
  3.1268 +being a successor cardinal of @{text "r"}. Although the definition does
  3.1269 +not require @{text "r"} to be a cardinal, only this case will be meaningful.  *}
  3.1270 +
  3.1271 +definition isCardSuc :: "'a rel \<Rightarrow> 'a set rel \<Rightarrow> bool"
  3.1272 +where
  3.1273 +"isCardSuc r r' \<equiv>
  3.1274 + Card_order r' \<and> r <o r' \<and>
  3.1275 + (\<forall>(r''::'a set rel). Card_order r'' \<and> r <o r'' \<longrightarrow> r' \<le>o r'')"
  3.1276 +
  3.1277 +text{* Now we introduce the cardinal-successor operator @{text "cardSuc"},
  3.1278 +by picking {\em some} cardinal-order relation fulfilling @{text "isCardSuc"}.
  3.1279 +Again, the picked item shall be proved unique up to order-isomorphism. *}
  3.1280 +
  3.1281 +definition cardSuc :: "'a rel \<Rightarrow> 'a set rel"
  3.1282 +where
  3.1283 +"cardSuc r \<equiv> SOME r'. isCardSuc r r'"
  3.1284 +
  3.1285 +lemma exists_minim_Card_order:
  3.1286 +"\<lbrakk>R \<noteq> {}; \<forall>r \<in> R. Card_order r\<rbrakk> \<Longrightarrow> \<exists>r \<in> R. \<forall>r' \<in> R. r \<le>o r'"
  3.1287 +unfolding card_order_on_def using exists_minim_Well_order by blast
  3.1288 +
  3.1289 +lemma exists_isCardSuc:
  3.1290 +assumes "Card_order r"
  3.1291 +shows "\<exists>r'. isCardSuc r r'"
  3.1292 +proof-
  3.1293 +  let ?R = "{(r'::'a set rel). Card_order r' \<and> r <o r'}"
  3.1294 +  have "|Pow(Field r)| \<in> ?R \<and> (\<forall>r \<in> ?R. Card_order r)" using assms
  3.1295 +  by (simp add: card_of_Card_order Card_order_Pow)
  3.1296 +  then obtain r where "r \<in> ?R \<and> (\<forall>r' \<in> ?R. r \<le>o r')"
  3.1297 +  using exists_minim_Card_order[of ?R] by blast
  3.1298 +  thus ?thesis unfolding isCardSuc_def by auto
  3.1299 +qed
  3.1300 +
  3.1301 +lemma cardSuc_isCardSuc:
  3.1302 +assumes "Card_order r"
  3.1303 +shows "isCardSuc r (cardSuc r)"
  3.1304 +unfolding cardSuc_def using assms
  3.1305 +by (simp add: exists_isCardSuc someI_ex)
  3.1306 +
  3.1307 +lemma cardSuc_Card_order:
  3.1308 +"Card_order r \<Longrightarrow> Card_order(cardSuc r)"
  3.1309 +using cardSuc_isCardSuc unfolding isCardSuc_def by blast
  3.1310 +
  3.1311 +lemma cardSuc_greater:
  3.1312 +"Card_order r \<Longrightarrow> r <o cardSuc r"
  3.1313 +using cardSuc_isCardSuc unfolding isCardSuc_def by blast
  3.1314 +
  3.1315 +lemma cardSuc_ordLeq:
  3.1316 +"Card_order r \<Longrightarrow> r \<le>o cardSuc r"
  3.1317 +using cardSuc_greater ordLeq_iff_ordLess_or_ordIso by blast
  3.1318 +
  3.1319 +text{* The minimality property of @{text "cardSuc"} originally present in its definition
  3.1320 +is local to the type @{text "'a set rel"}, i.e., that of @{text "cardSuc r"}:  *}
  3.1321 +
  3.1322 +lemma cardSuc_least_aux:
  3.1323 +"\<lbrakk>Card_order (r::'a rel); Card_order (r'::'a set rel); r <o r'\<rbrakk> \<Longrightarrow> cardSuc r \<le>o r'"
  3.1324 +using cardSuc_isCardSuc unfolding isCardSuc_def by blast
  3.1325 +
  3.1326 +text{* But from this we can infer general minimality: *}
  3.1327 +
  3.1328 +lemma cardSuc_least:
  3.1329 +assumes CARD: "Card_order r" and CARD': "Card_order r'" and LESS: "r <o r'"
  3.1330 +shows "cardSuc r \<le>o r'"
  3.1331 +proof-
  3.1332 +  let ?p = "cardSuc r"
  3.1333 +  have 0: "Well_order ?p \<and> Well_order r'"
  3.1334 +  using assms cardSuc_Card_order unfolding card_order_on_def by blast
  3.1335 +  {assume "r' <o ?p"
  3.1336 +   then obtain r'' where 1: "Field r'' < Field ?p" and 2: "r' =o r'' \<and> r'' <o ?p"
  3.1337 +   using internalize_ordLess[of r' ?p] by blast
  3.1338 +   (*  *)
  3.1339 +   have "Card_order r''" using CARD' Card_order_ordIso2 2 by blast
  3.1340 +   moreover have "r <o r''" using LESS 2 ordLess_ordIso_trans by blast
  3.1341 +   ultimately have "?p \<le>o r''" using cardSuc_least_aux CARD by blast
  3.1342 +   hence False using 2 not_ordLess_ordLeq by blast
  3.1343 +  }
  3.1344 +  thus ?thesis using 0 ordLess_or_ordLeq by blast
  3.1345 +qed
  3.1346 +
  3.1347 +lemma cardSuc_ordLess_ordLeq:
  3.1348 +assumes CARD: "Card_order r" and CARD': "Card_order r'"
  3.1349 +shows "(r <o r') = (cardSuc r \<le>o r')"
  3.1350 +proof(auto simp add: assms cardSuc_least)
  3.1351 +  assume "cardSuc r \<le>o r'"
  3.1352 +  thus "r <o r'" using assms cardSuc_greater ordLess_ordLeq_trans by blast
  3.1353 +qed
  3.1354 +
  3.1355 +lemma cardSuc_ordLeq_ordLess:
  3.1356 +assumes CARD: "Card_order r" and CARD': "Card_order r'"
  3.1357 +shows "(r' <o cardSuc r) = (r' \<le>o r)"
  3.1358 +proof-
  3.1359 +  have "Well_order r \<and> Well_order r'"
  3.1360 +  using assms unfolding card_order_on_def by auto
  3.1361 +  moreover have "Well_order(cardSuc r)"
  3.1362 +  using assms cardSuc_Card_order card_order_on_def by blast
  3.1363 +  ultimately show ?thesis
  3.1364 +  using assms cardSuc_ordLess_ordLeq[of r r']
  3.1365 +  not_ordLeq_iff_ordLess[of r r'] not_ordLeq_iff_ordLess[of r' "cardSuc r"] by blast
  3.1366 +qed
  3.1367 +
  3.1368 +lemma cardSuc_mono_ordLeq:
  3.1369 +assumes CARD: "Card_order r" and CARD': "Card_order r'"
  3.1370 +shows "(cardSuc r \<le>o cardSuc r') = (r \<le>o r')"
  3.1371 +using assms cardSuc_ordLeq_ordLess cardSuc_ordLess_ordLeq cardSuc_Card_order by blast
  3.1372 +
  3.1373 +lemma cardSuc_invar_ordIso:
  3.1374 +assumes CARD: "Card_order r" and CARD': "Card_order r'"
  3.1375 +shows "(cardSuc r =o cardSuc r') = (r =o r')"
  3.1376 +proof-
  3.1377 +  have 0: "Well_order r \<and> Well_order r' \<and> Well_order(cardSuc r) \<and> Well_order(cardSuc r')"
  3.1378 +  using assms by (simp add: card_order_on_well_order_on cardSuc_Card_order)
  3.1379 +  thus ?thesis
  3.1380 +  using ordIso_iff_ordLeq[of r r'] ordIso_iff_ordLeq
  3.1381 +  using cardSuc_mono_ordLeq[of r r'] cardSuc_mono_ordLeq[of r' r] assms by blast
  3.1382 +qed
  3.1383 +
  3.1384 +lemma card_of_cardSuc_finite:
  3.1385 +"finite(Field(cardSuc |A| )) = finite A"
  3.1386 +proof
  3.1387 +  assume *: "finite (Field (cardSuc |A| ))"
  3.1388 +  have 0: "|Field(cardSuc |A| )| =o cardSuc |A|"
  3.1389 +  using card_of_Card_order cardSuc_Card_order card_of_Field_ordIso by blast
  3.1390 +  hence "|A| \<le>o |Field(cardSuc |A| )|"
  3.1391 +  using card_of_Card_order[of A] cardSuc_ordLeq[of "|A|"] ordIso_symmetric
  3.1392 +  ordLeq_ordIso_trans by blast
  3.1393 +  thus "finite A" using * card_of_ordLeq_finite by blast
  3.1394 +next
  3.1395 +  assume "finite A"
  3.1396 +  then have "finite ( Field |Pow A| )" unfolding Field_card_of by simp
  3.1397 +  then show "finite (Field (cardSuc |A| ))"
  3.1398 +  proof (rule card_of_ordLeq_finite[OF card_of_mono2, rotated])
  3.1399 +    show "cardSuc |A| \<le>o |Pow A|"
  3.1400 +      by (metis cardSuc_ordLess_ordLeq card_of_Card_order card_of_Pow)
  3.1401 +  qed
  3.1402 +qed
  3.1403 +
  3.1404 +lemma cardSuc_finite:
  3.1405 +assumes "Card_order r"
  3.1406 +shows "finite (Field (cardSuc r)) = finite (Field r)"
  3.1407 +proof-
  3.1408 +  let ?A = "Field r"
  3.1409 +  have "|?A| =o r" using assms by (simp add: card_of_Field_ordIso)
  3.1410 +  hence "cardSuc |?A| =o cardSuc r" using assms
  3.1411 +  by (simp add: card_of_Card_order cardSuc_invar_ordIso)
  3.1412 +  moreover have "|Field (cardSuc |?A| ) | =o cardSuc |?A|"
  3.1413 +  by (simp add: card_of_card_order_on Field_card_of card_of_Field_ordIso cardSuc_Card_order)
  3.1414 +  moreover
  3.1415 +  {have "|Field (cardSuc r) | =o cardSuc r"
  3.1416 +   using assms by (simp add: card_of_Field_ordIso cardSuc_Card_order)
  3.1417 +   hence "cardSuc r =o |Field (cardSuc r) |"
  3.1418 +   using ordIso_symmetric by blast
  3.1419 +  }
  3.1420 +  ultimately have "|Field (cardSuc |?A| ) | =o |Field (cardSuc r) |"
  3.1421 +  using ordIso_transitive by blast
  3.1422 +  hence "finite (Field (cardSuc |?A| )) = finite (Field (cardSuc r))"
  3.1423 +  using card_of_ordIso_finite by blast
  3.1424 +  thus ?thesis by (simp only: card_of_cardSuc_finite)
  3.1425 +qed
  3.1426 +
  3.1427 +lemma card_of_Plus_ordLess_infinite:
  3.1428 +assumes INF: "\<not>finite C" and
  3.1429 +        LESS1: "|A| <o |C|" and LESS2: "|B| <o |C|"
  3.1430 +shows "|A <+> B| <o |C|"
  3.1431 +proof(cases "A = {} \<or> B = {}")
  3.1432 +  assume Case1: "A = {} \<or> B = {}"
  3.1433 +  hence "|A| =o |A <+> B| \<or> |B| =o |A <+> B|"
  3.1434 +  using card_of_Plus_empty1 card_of_Plus_empty2 by blast
  3.1435 +  hence "|A <+> B| =o |A| \<or> |A <+> B| =o |B|"
  3.1436 +  using ordIso_symmetric[of "|A|"] ordIso_symmetric[of "|B|"] by blast
  3.1437 +  thus ?thesis using LESS1 LESS2
  3.1438 +       ordIso_ordLess_trans[of "|A <+> B|" "|A|"]
  3.1439 +       ordIso_ordLess_trans[of "|A <+> B|" "|B|"] by blast
  3.1440 +next
  3.1441 +  assume Case2: "\<not>(A = {} \<or> B = {})"
  3.1442 +  {assume *: "|C| \<le>o |A <+> B|"
  3.1443 +   hence "\<not>finite (A <+> B)" using INF card_of_ordLeq_finite by blast
  3.1444 +   hence 1: "\<not>finite A \<or> \<not>finite B" using finite_Plus by blast
  3.1445 +   {assume Case21: "|A| \<le>o |B|"
  3.1446 +    hence "\<not>finite B" using 1 card_of_ordLeq_finite by blast
  3.1447 +    hence "|A <+> B| =o |B|" using Case2 Case21
  3.1448 +    by (auto simp add: card_of_Plus_infinite)
  3.1449 +    hence False using LESS2 not_ordLess_ordLeq * ordLeq_ordIso_trans by blast
  3.1450 +   }
  3.1451 +   moreover
  3.1452 +   {assume Case22: "|B| \<le>o |A|"
  3.1453 +    hence "\<not>finite A" using 1 card_of_ordLeq_finite by blast
  3.1454 +    hence "|A <+> B| =o |A|" using Case2 Case22
  3.1455 +    by (auto simp add: card_of_Plus_infinite)
  3.1456 +    hence False using LESS1 not_ordLess_ordLeq * ordLeq_ordIso_trans by blast
  3.1457 +   }
  3.1458 +   ultimately have False using ordLeq_total card_of_Well_order[of A]
  3.1459 +   card_of_Well_order[of B] by blast
  3.1460 +  }
  3.1461 +  thus ?thesis using ordLess_or_ordLeq[of "|A <+> B|" "|C|"]
  3.1462 +  card_of_Well_order[of "A <+> B"] card_of_Well_order[of "C"] by auto
  3.1463 +qed
  3.1464 +
  3.1465 +lemma card_of_Plus_ordLess_infinite_Field:
  3.1466 +assumes INF: "\<not>finite (Field r)" and r: "Card_order r" and
  3.1467 +        LESS1: "|A| <o r" and LESS2: "|B| <o r"
  3.1468 +shows "|A <+> B| <o r"
  3.1469 +proof-
  3.1470 +  let ?C  = "Field r"
  3.1471 +  have 1: "r =o |?C| \<and> |?C| =o r" using r card_of_Field_ordIso
  3.1472 +  ordIso_symmetric by blast
  3.1473 +  hence "|A| <o |?C|"  "|B| <o |?C|"
  3.1474 +  using LESS1 LESS2 ordLess_ordIso_trans by blast+
  3.1475 +  hence  "|A <+> B| <o |?C|" using INF
  3.1476 +  card_of_Plus_ordLess_infinite by blast
  3.1477 +  thus ?thesis using 1 ordLess_ordIso_trans by blast
  3.1478 +qed
  3.1479 +
  3.1480 +lemma card_of_Plus_ordLeq_infinite_Field:
  3.1481 +assumes r: "\<not>finite (Field r)" and A: "|A| \<le>o r" and B: "|B| \<le>o r"
  3.1482 +and c: "Card_order r"
  3.1483 +shows "|A <+> B| \<le>o r"
  3.1484 +proof-
  3.1485 +  let ?r' = "cardSuc r"
  3.1486 +  have "Card_order ?r' \<and> \<not>finite (Field ?r')" using assms
  3.1487 +  by (simp add: cardSuc_Card_order cardSuc_finite)
  3.1488 +  moreover have "|A| <o ?r'" and "|B| <o ?r'" using A B c
  3.1489 +  by (auto simp: card_of_card_order_on Field_card_of cardSuc_ordLeq_ordLess)
  3.1490 +  ultimately have "|A <+> B| <o ?r'"
  3.1491 +  using card_of_Plus_ordLess_infinite_Field by blast
  3.1492 +  thus ?thesis using c r
  3.1493 +  by (simp add: card_of_card_order_on Field_card_of cardSuc_ordLeq_ordLess)
  3.1494 +qed
  3.1495 +
  3.1496 +lemma card_of_Un_ordLeq_infinite_Field:
  3.1497 +assumes C: "\<not>finite (Field r)" and A: "|A| \<le>o r" and B: "|B| \<le>o r"
  3.1498 +and "Card_order r"
  3.1499 +shows "|A Un B| \<le>o r"
  3.1500 +using assms card_of_Plus_ordLeq_infinite_Field card_of_Un_Plus_ordLeq
  3.1501 +ordLeq_transitive by fast
  3.1502 +
  3.1503 +
  3.1504 +subsection {* Regular cardinals *}
  3.1505 +
  3.1506 +definition cofinal where
  3.1507 +"cofinal A r \<equiv>
  3.1508 + ALL a : Field r. EX b : A. a \<noteq> b \<and> (a,b) : r"
  3.1509 +
  3.1510 +definition regular where
  3.1511 +"regular r \<equiv>
  3.1512 + ALL K. K \<le> Field r \<and> cofinal K r \<longrightarrow> |K| =o r"
  3.1513 +
  3.1514 +definition relChain where
  3.1515 +"relChain r As \<equiv>
  3.1516 + ALL i j. (i,j) \<in> r \<longrightarrow> As i \<le> As j"
  3.1517 +
  3.1518 +lemma regular_UNION:
  3.1519 +assumes r: "Card_order r"   "regular r"
  3.1520 +and As: "relChain r As"
  3.1521 +and Bsub: "B \<le> (UN i : Field r. As i)"
  3.1522 +and cardB: "|B| <o r"
  3.1523 +shows "EX i : Field r. B \<le> As i"
  3.1524 +proof-
  3.1525 +  let ?phi = "%b j. j : Field r \<and> b : As j"
  3.1526 +  have "ALL b : B. EX j. ?phi b j" using Bsub by blast
  3.1527 +  then obtain f where f: "!! b. b : B \<Longrightarrow> ?phi b (f b)"
  3.1528 +  using bchoice[of B ?phi] by blast
  3.1529 +  let ?K = "f ` B"
  3.1530 +  {assume 1: "!! i. i : Field r \<Longrightarrow> ~ B \<le> As i"
  3.1531 +   have 2: "cofinal ?K r"
  3.1532 +   unfolding cofinal_def proof auto
  3.1533 +     fix i assume i: "i : Field r"
  3.1534 +     with 1 obtain b where b: "b : B \<and> b \<notin> As i" by blast
  3.1535 +     hence "i \<noteq> f b \<and> ~ (f b,i) : r"
  3.1536 +     using As f unfolding relChain_def by auto
  3.1537 +     hence "i \<noteq> f b \<and> (i, f b) : r" using r
  3.1538 +     unfolding card_order_on_def well_order_on_def linear_order_on_def
  3.1539 +     total_on_def using i f b by auto
  3.1540 +     with b show "\<exists>b\<in>B. i \<noteq> f b \<and> (i, f b) \<in> r" by blast
  3.1541 +   qed
  3.1542 +   moreover have "?K \<le> Field r" using f by blast
  3.1543 +   ultimately have "|?K| =o r" using 2 r unfolding regular_def by blast
  3.1544 +   moreover
  3.1545 +   {
  3.1546 +    have "|?K| <=o |B|" using card_of_image .
  3.1547 +    hence "|?K| <o r" using cardB ordLeq_ordLess_trans by blast
  3.1548 +   }
  3.1549 +   ultimately have False using not_ordLess_ordIso by blast
  3.1550 +  }
  3.1551 +  thus ?thesis by blast
  3.1552 +qed
  3.1553 +
  3.1554 +lemma infinite_cardSuc_regular:
  3.1555 +assumes r_inf: "\<not>finite (Field r)" and r_card: "Card_order r"
  3.1556 +shows "regular (cardSuc r)"
  3.1557 +proof-
  3.1558 +  let ?r' = "cardSuc r"
  3.1559 +  have r': "Card_order ?r'"
  3.1560 +  "!! p. Card_order p \<longrightarrow> (p \<le>o r) = (p <o ?r')"
  3.1561 +  using r_card by (auto simp: cardSuc_Card_order cardSuc_ordLeq_ordLess)
  3.1562 +  show ?thesis
  3.1563 +  unfolding regular_def proof auto
  3.1564 +    fix K assume 1: "K \<le> Field ?r'" and 2: "cofinal K ?r'"
  3.1565 +    hence "|K| \<le>o |Field ?r'|" by (simp only: card_of_mono1)
  3.1566 +    also have 22: "|Field ?r'| =o ?r'"
  3.1567 +    using r' by (simp add: card_of_Field_ordIso[of ?r'])
  3.1568 +    finally have "|K| \<le>o ?r'" .
  3.1569 +    moreover
  3.1570 +    {let ?L = "UN j : K. underS ?r' j"
  3.1571 +     let ?J = "Field r"
  3.1572 +     have rJ: "r =o |?J|"
  3.1573 +     using r_card card_of_Field_ordIso ordIso_symmetric by blast
  3.1574 +     assume "|K| <o ?r'"
  3.1575 +     hence "|K| <=o r" using r' card_of_Card_order[of K] by blast
  3.1576 +     hence "|K| \<le>o |?J|" using rJ ordLeq_ordIso_trans by blast
  3.1577 +     moreover
  3.1578 +     {have "ALL j : K. |underS ?r' j| <o ?r'"
  3.1579 +      using r' 1 by (auto simp: card_of_underS)
  3.1580 +      hence "ALL j : K. |underS ?r' j| \<le>o r"
  3.1581 +      using r' card_of_Card_order by blast
  3.1582 +      hence "ALL j : K. |underS ?r' j| \<le>o |?J|"
  3.1583 +      using rJ ordLeq_ordIso_trans by blast
  3.1584 +     }
  3.1585 +     ultimately have "|?L| \<le>o |?J|"
  3.1586 +     using r_inf card_of_UNION_ordLeq_infinite by blast
  3.1587 +     hence "|?L| \<le>o r" using rJ ordIso_symmetric ordLeq_ordIso_trans by blast
  3.1588 +     hence "|?L| <o ?r'" using r' card_of_Card_order by blast
  3.1589 +     moreover
  3.1590 +     {
  3.1591 +      have "Field ?r' \<le> ?L"
  3.1592 +      using 2 unfolding underS_def cofinal_def by auto
  3.1593 +      hence "|Field ?r'| \<le>o |?L|" by (simp add: card_of_mono1)
  3.1594 +      hence "?r' \<le>o |?L|"
  3.1595 +      using 22 ordIso_ordLeq_trans ordIso_symmetric by blast
  3.1596 +     }
  3.1597 +     ultimately have "|?L| <o |?L|" using ordLess_ordLeq_trans by blast
  3.1598 +     hence False using ordLess_irreflexive by blast
  3.1599 +    }
  3.1600 +    ultimately show "|K| =o ?r'"
  3.1601 +    unfolding ordLeq_iff_ordLess_or_ordIso by blast
  3.1602 +  qed
  3.1603 +qed
  3.1604 +
  3.1605 +lemma cardSuc_UNION:
  3.1606 +assumes r: "Card_order r" and "\<not>finite (Field r)"
  3.1607 +and As: "relChain (cardSuc r) As"
  3.1608 +and Bsub: "B \<le> (UN i : Field (cardSuc r). As i)"
  3.1609 +and cardB: "|B| <=o r"
  3.1610 +shows "EX i : Field (cardSuc r). B \<le> As i"
  3.1611 +proof-
  3.1612 +  let ?r' = "cardSuc r"
  3.1613 +  have "Card_order ?r' \<and> |B| <o ?r'"
  3.1614 +  using r cardB cardSuc_ordLeq_ordLess cardSuc_Card_order
  3.1615 +  card_of_Card_order by blast
  3.1616 +  moreover have "regular ?r'"
  3.1617 +  using assms by(simp add: infinite_cardSuc_regular)
  3.1618 +  ultimately show ?thesis
  3.1619 +  using As Bsub cardB regular_UNION by blast
  3.1620 +qed
  3.1621 +
  3.1622 +
  3.1623 +subsection {* Others *}
  3.1624 +
  3.1625 +lemma card_of_Func_Times:
  3.1626 +"|Func (A <*> B) C| =o |Func A (Func B C)|"
  3.1627 +unfolding card_of_ordIso[symmetric]
  3.1628 +using bij_betw_curr by blast
  3.1629 +
  3.1630 +lemma card_of_Pow_Func:
  3.1631 +"|Pow A| =o |Func A (UNIV::bool set)|"
  3.1632 +proof-
  3.1633 +  def F \<equiv> "\<lambda> A' a. if a \<in> A then (if a \<in> A' then True else False)
  3.1634 +                            else undefined"
  3.1635 +  have "bij_betw F (Pow A) (Func A (UNIV::bool set))"
  3.1636 +  unfolding bij_betw_def inj_on_def proof (intro ballI impI conjI)
  3.1637 +    fix A1 A2 assume "A1 \<in> Pow A" "A2 \<in> Pow A" "F A1 = F A2"
  3.1638 +    thus "A1 = A2" unfolding F_def Pow_def fun_eq_iff by (auto split: split_if_asm)
  3.1639 +  next
  3.1640 +    show "F ` Pow A = Func A UNIV"
  3.1641 +    proof safe
  3.1642 +      fix f assume f: "f \<in> Func A (UNIV::bool set)"
  3.1643 +      show "f \<in> F ` Pow A" unfolding image_def mem_Collect_eq proof(intro bexI)
  3.1644 +        let ?A1 = "{a \<in> A. f a = True}"
  3.1645 +        show "f = F ?A1" unfolding F_def apply(rule ext)
  3.1646 +        using f unfolding Func_def mem_Collect_eq by auto
  3.1647 +      qed auto
  3.1648 +    qed(unfold Func_def mem_Collect_eq F_def, auto)
  3.1649 +  qed
  3.1650 +  thus ?thesis unfolding card_of_ordIso[symmetric] by blast
  3.1651 +qed
  3.1652 +
  3.1653 +lemma card_of_Func_UNIV:
  3.1654 +"|Func (UNIV::'a set) (B::'b set)| =o |{f::'a \<Rightarrow> 'b. range f \<subseteq> B}|"
  3.1655 +apply(rule ordIso_symmetric) proof(intro card_of_ordIsoI)
  3.1656 +  let ?F = "\<lambda> f (a::'a). ((f a)::'b)"
  3.1657 +  show "bij_betw ?F {f. range f \<subseteq> B} (Func UNIV B)"
  3.1658 +  unfolding bij_betw_def inj_on_def proof safe
  3.1659 +    fix h :: "'a \<Rightarrow> 'b" assume h: "h \<in> Func UNIV B"
  3.1660 +    hence "\<forall> a. \<exists> b. h a = b" unfolding Func_def by auto
  3.1661 +    then obtain f where f: "\<forall> a. h a = f a" by metis
  3.1662 +    hence "range f \<subseteq> B" using h unfolding Func_def by auto
  3.1663 +    thus "h \<in> (\<lambda>f a. f a) ` {f. range f \<subseteq> B}" using f unfolding image_def by auto
  3.1664 +  qed(unfold Func_def fun_eq_iff, auto)
  3.1665 +qed
  3.1666 +
  3.1667 +end
     4.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     4.2 +++ b/src/HOL/BNF_Constructions_on_Wellorders.thy	Mon Jan 20 18:24:55 2014 +0100
     4.3 @@ -0,0 +1,1774 @@
     4.4 +(*  Title:      HOL/BNF_Constructions_on_Wellorders.thy
     4.5 +    Author:     Andrei Popescu, TU Muenchen
     4.6 +    Copyright   2012
     4.7 +
     4.8 +Constructions on wellorders (BNF).
     4.9 +*)
    4.10 +
    4.11 +header {* Constructions on Wellorders (BNF) *}
    4.12 +
    4.13 +theory BNF_Constructions_on_Wellorders
    4.14 +imports BNF_Wellorder_Embedding
    4.15 +begin
    4.16 +
    4.17 +
    4.18 +text {* In this section, we study basic constructions on well-orders, such as restriction to
    4.19 +a set/order filter, copy via direct images, ordinal-like sum of disjoint well-orders,
    4.20 +and bounded square.  We also define between well-orders
    4.21 +the relations @{text "ordLeq"}, of being embedded (abbreviated @{text "\<le>o"}),
    4.22 +@{text "ordLess"}, of being strictly embedded (abbreviated @{text "<o"}), and
    4.23 +@{text "ordIso"}, of being isomorphic (abbreviated @{text "=o"}).  We study the
    4.24 +connections between these relations, order filters, and the aforementioned constructions.
    4.25 +A main result of this section is that @{text "<o"} is well-founded.  *}
    4.26 +
    4.27 +
    4.28 +subsection {* Restriction to a set  *}
    4.29 +
    4.30 +
    4.31 +abbreviation Restr :: "'a rel \<Rightarrow> 'a set \<Rightarrow> 'a rel"
    4.32 +where "Restr r A \<equiv> r Int (A \<times> A)"
    4.33 +
    4.34 +
    4.35 +lemma Restr_subset:
    4.36 +"A \<le> B \<Longrightarrow> Restr (Restr r B) A = Restr r A"
    4.37 +by blast
    4.38 +
    4.39 +
    4.40 +lemma Restr_Field: "Restr r (Field r) = r"
    4.41 +unfolding Field_def by auto
    4.42 +
    4.43 +
    4.44 +lemma Refl_Restr: "Refl r \<Longrightarrow> Refl(Restr r A)"
    4.45 +unfolding refl_on_def Field_def by auto
    4.46 +
    4.47 +
    4.48 +lemma antisym_Restr:
    4.49 +"antisym r \<Longrightarrow> antisym(Restr r A)"
    4.50 +unfolding antisym_def Field_def by auto
    4.51 +
    4.52 +
    4.53 +lemma Total_Restr:
    4.54 +"Total r \<Longrightarrow> Total(Restr r A)"
    4.55 +unfolding total_on_def Field_def by auto
    4.56 +
    4.57 +
    4.58 +lemma trans_Restr:
    4.59 +"trans r \<Longrightarrow> trans(Restr r A)"
    4.60 +unfolding trans_def Field_def by blast
    4.61 +
    4.62 +
    4.63 +lemma Preorder_Restr:
    4.64 +"Preorder r \<Longrightarrow> Preorder(Restr r A)"
    4.65 +unfolding preorder_on_def by (simp add: Refl_Restr trans_Restr)
    4.66 +
    4.67 +
    4.68 +lemma Partial_order_Restr:
    4.69 +"Partial_order r \<Longrightarrow> Partial_order(Restr r A)"
    4.70 +unfolding partial_order_on_def by (simp add: Preorder_Restr antisym_Restr)
    4.71 +
    4.72 +
    4.73 +lemma Linear_order_Restr:
    4.74 +"Linear_order r \<Longrightarrow> Linear_order(Restr r A)"
    4.75 +unfolding linear_order_on_def by (simp add: Partial_order_Restr Total_Restr)
    4.76 +
    4.77 +
    4.78 +lemma Well_order_Restr:
    4.79 +assumes "Well_order r"
    4.80 +shows "Well_order(Restr r A)"
    4.81 +proof-
    4.82 +  have "Restr r A - Id \<le> r - Id" using Restr_subset by blast
    4.83 +  hence "wf(Restr r A - Id)" using assms
    4.84 +  using well_order_on_def wf_subset by blast
    4.85 +  thus ?thesis using assms unfolding well_order_on_def
    4.86 +  by (simp add: Linear_order_Restr)
    4.87 +qed
    4.88 +
    4.89 +
    4.90 +lemma Field_Restr_subset: "Field(Restr r A) \<le> A"
    4.91 +by (auto simp add: Field_def)
    4.92 +
    4.93 +
    4.94 +lemma Refl_Field_Restr:
    4.95 +"Refl r \<Longrightarrow> Field(Restr r A) = (Field r) Int A"
    4.96 +unfolding refl_on_def Field_def by blast
    4.97 +
    4.98 +
    4.99 +lemma Refl_Field_Restr2:
   4.100 +"\<lbrakk>Refl r; A \<le> Field r\<rbrakk> \<Longrightarrow> Field(Restr r A) = A"
   4.101 +by (auto simp add: Refl_Field_Restr)
   4.102 +
   4.103 +
   4.104 +lemma well_order_on_Restr:
   4.105 +assumes WELL: "Well_order r" and SUB: "A \<le> Field r"
   4.106 +shows "well_order_on A (Restr r A)"
   4.107 +using assms
   4.108 +using Well_order_Restr[of r A] Refl_Field_Restr2[of r A]
   4.109 +     order_on_defs[of "Field r" r] by auto
   4.110 +
   4.111 +
   4.112 +subsection {* Order filters versus restrictions and embeddings  *}
   4.113 +
   4.114 +
   4.115 +lemma Field_Restr_ofilter:
   4.116 +"\<lbrakk>Well_order r; wo_rel.ofilter r A\<rbrakk> \<Longrightarrow> Field(Restr r A) = A"
   4.117 +by (auto simp add: wo_rel_def wo_rel.ofilter_def wo_rel.REFL Refl_Field_Restr2)
   4.118 +
   4.119 +
   4.120 +lemma ofilter_Restr_under:
   4.121 +assumes WELL: "Well_order r" and OF: "wo_rel.ofilter r A" and IN: "a \<in> A"
   4.122 +shows "under (Restr r A) a = under r a"
   4.123 +using assms wo_rel_def
   4.124 +proof(auto simp add: wo_rel.ofilter_def under_def)
   4.125 +  fix b assume *: "a \<in> A" and "(b,a) \<in> r"
   4.126 +  hence "b \<in> under r a \<and> a \<in> Field r"
   4.127 +  unfolding under_def using Field_def by fastforce
   4.128 +  thus "b \<in> A" using * assms by (auto simp add: wo_rel_def wo_rel.ofilter_def)
   4.129 +qed
   4.130 +
   4.131 +
   4.132 +lemma ofilter_embed:
   4.133 +assumes "Well_order r"
   4.134 +shows "wo_rel.ofilter r A = (A \<le> Field r \<and> embed (Restr r A) r id)"
   4.135 +proof
   4.136 +  assume *: "wo_rel.ofilter r A"
   4.137 +  show "A \<le> Field r \<and> embed (Restr r A) r id"
   4.138 +  proof(unfold embed_def, auto)
   4.139 +    fix a assume "a \<in> A" thus "a \<in> Field r" using assms *
   4.140 +    by (auto simp add: wo_rel_def wo_rel.ofilter_def)
   4.141 +  next
   4.142 +    fix a assume "a \<in> Field (Restr r A)"
   4.143 +    thus "bij_betw id (under (Restr r A) a) (under r a)" using assms *
   4.144 +    by (simp add: ofilter_Restr_under Field_Restr_ofilter)
   4.145 +  qed
   4.146 +next
   4.147 +  assume *: "A \<le> Field r \<and> embed (Restr r A) r id"
   4.148 +  hence "Field(Restr r A) \<le> Field r"
   4.149 +  using assms  embed_Field[of "Restr r A" r id] id_def
   4.150 +        Well_order_Restr[of r] by auto
   4.151 +  {fix a assume "a \<in> A"
   4.152 +   hence "a \<in> Field(Restr r A)" using * assms
   4.153 +   by (simp add: order_on_defs Refl_Field_Restr2)
   4.154 +   hence "bij_betw id (under (Restr r A) a) (under r a)"
   4.155 +   using * unfolding embed_def by auto
   4.156 +   hence "under r a \<le> under (Restr r A) a"
   4.157 +   unfolding bij_betw_def by auto
   4.158 +   also have "\<dots> \<le> Field(Restr r A)" by (simp add: under_Field)
   4.159 +   also have "\<dots> \<le> A" by (simp add: Field_Restr_subset)
   4.160 +   finally have "under r a \<le> A" .
   4.161 +  }
   4.162 +  thus "wo_rel.ofilter r A" using assms * by (simp add: wo_rel_def wo_rel.ofilter_def)
   4.163 +qed
   4.164 +
   4.165 +
   4.166 +lemma ofilter_Restr_Int:
   4.167 +assumes WELL: "Well_order r" and OFA: "wo_rel.ofilter r A"
   4.168 +shows "wo_rel.ofilter (Restr r B) (A Int B)"
   4.169 +proof-
   4.170 +  let ?rB = "Restr r B"
   4.171 +  have Well: "wo_rel r" unfolding wo_rel_def using WELL .
   4.172 +  hence Refl: "Refl r" by (simp add: wo_rel.REFL)
   4.173 +  hence Field: "Field ?rB = Field r Int B"
   4.174 +  using Refl_Field_Restr by blast
   4.175 +  have WellB: "wo_rel ?rB \<and> Well_order ?rB" using WELL
   4.176 +  by (simp add: Well_order_Restr wo_rel_def)
   4.177 +  (* Main proof *)
   4.178 +  show ?thesis using WellB assms
   4.179 +  proof(auto simp add: wo_rel.ofilter_def under_def)
   4.180 +    fix a assume "a \<in> A" and *: "a \<in> B"
   4.181 +    hence "a \<in> Field r" using OFA Well by (auto simp add: wo_rel.ofilter_def)
   4.182 +    with * show "a \<in> Field ?rB" using Field by auto
   4.183 +  next
   4.184 +    fix a b assume "a \<in> A" and "(b,a) \<in> r"
   4.185 +    thus "b \<in> A" using Well OFA by (auto simp add: wo_rel.ofilter_def under_def)
   4.186 +  qed
   4.187 +qed
   4.188 +
   4.189 +
   4.190 +lemma ofilter_Restr_subset:
   4.191 +assumes WELL: "Well_order r" and OFA: "wo_rel.ofilter r A" and SUB: "A \<le> B"
   4.192 +shows "wo_rel.ofilter (Restr r B) A"
   4.193 +proof-
   4.194 +  have "A Int B = A" using SUB by blast
   4.195 +  thus ?thesis using assms ofilter_Restr_Int[of r A B] by auto
   4.196 +qed
   4.197 +
   4.198 +
   4.199 +lemma ofilter_subset_embed:
   4.200 +assumes WELL: "Well_order r" and
   4.201 +        OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
   4.202 +shows "(A \<le> B) = (embed (Restr r A) (Restr r B) id)"
   4.203 +proof-
   4.204 +  let ?rA = "Restr r A"  let ?rB = "Restr r B"
   4.205 +  have Well: "wo_rel r" unfolding wo_rel_def using WELL .
   4.206 +  hence Refl: "Refl r" by (simp add: wo_rel.REFL)
   4.207 +  hence FieldA: "Field ?rA = Field r Int A"
   4.208 +  using Refl_Field_Restr by blast
   4.209 +  have FieldB: "Field ?rB = Field r Int B"
   4.210 +  using Refl Refl_Field_Restr by blast
   4.211 +  have WellA: "wo_rel ?rA \<and> Well_order ?rA" using WELL
   4.212 +  by (simp add: Well_order_Restr wo_rel_def)
   4.213 +  have WellB: "wo_rel ?rB \<and> Well_order ?rB" using WELL
   4.214 +  by (simp add: Well_order_Restr wo_rel_def)
   4.215 +  (* Main proof *)
   4.216 +  show ?thesis
   4.217 +  proof
   4.218 +    assume *: "A \<le> B"
   4.219 +    hence "wo_rel.ofilter (Restr r B) A" using assms
   4.220 +    by (simp add: ofilter_Restr_subset)
   4.221 +    hence "embed (Restr ?rB A) (Restr r B) id"
   4.222 +    using WellB ofilter_embed[of "?rB" A] by auto
   4.223 +    thus "embed (Restr r A) (Restr r B) id"
   4.224 +    using * by (simp add: Restr_subset)
   4.225 +  next
   4.226 +    assume *: "embed (Restr r A) (Restr r B) id"
   4.227 +    {fix a assume **: "a \<in> A"
   4.228 +     hence "a \<in> Field r" using Well OFA by (auto simp add: wo_rel.ofilter_def)
   4.229 +     with ** FieldA have "a \<in> Field ?rA" by auto
   4.230 +     hence "a \<in> Field ?rB" using * WellA embed_Field[of ?rA ?rB id] by auto
   4.231 +     hence "a \<in> B" using FieldB by auto
   4.232 +    }
   4.233 +    thus "A \<le> B" by blast
   4.234 +  qed
   4.235 +qed
   4.236 +
   4.237 +
   4.238 +lemma ofilter_subset_embedS_iso:
   4.239 +assumes WELL: "Well_order r" and
   4.240 +        OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
   4.241 +shows "((A < B) = (embedS (Restr r A) (Restr r B) id)) \<and>
   4.242 +       ((A = B) = (iso (Restr r A) (Restr r B) id))"
   4.243 +proof-
   4.244 +  let ?rA = "Restr r A"  let ?rB = "Restr r B"
   4.245 +  have Well: "wo_rel r" unfolding wo_rel_def using WELL .
   4.246 +  hence Refl: "Refl r" by (simp add: wo_rel.REFL)
   4.247 +  hence "Field ?rA = Field r Int A"
   4.248 +  using Refl_Field_Restr by blast
   4.249 +  hence FieldA: "Field ?rA = A" using OFA Well
   4.250 +  by (auto simp add: wo_rel.ofilter_def)
   4.251 +  have "Field ?rB = Field r Int B"
   4.252 +  using Refl Refl_Field_Restr by blast
   4.253 +  hence FieldB: "Field ?rB = B" using OFB Well
   4.254 +  by (auto simp add: wo_rel.ofilter_def)
   4.255 +  (* Main proof *)
   4.256 +  show ?thesis unfolding embedS_def iso_def
   4.257 +  using assms ofilter_subset_embed[of r A B]
   4.258 +        FieldA FieldB bij_betw_id_iff[of A B] by auto
   4.259 +qed
   4.260 +
   4.261 +
   4.262 +lemma ofilter_subset_embedS:
   4.263 +assumes WELL: "Well_order r" and
   4.264 +        OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
   4.265 +shows "(A < B) = embedS (Restr r A) (Restr r B) id"
   4.266 +using assms by (simp add: ofilter_subset_embedS_iso)
   4.267 +
   4.268 +
   4.269 +lemma embed_implies_iso_Restr:
   4.270 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and
   4.271 +        EMB: "embed r' r f"
   4.272 +shows "iso r' (Restr r (f ` (Field r'))) f"
   4.273 +proof-
   4.274 +  let ?A' = "Field r'"
   4.275 +  let ?r'' = "Restr r (f ` ?A')"
   4.276 +  have 0: "Well_order ?r''" using WELL Well_order_Restr by blast
   4.277 +  have 1: "wo_rel.ofilter r (f ` ?A')" using assms embed_Field_ofilter  by blast
   4.278 +  hence "Field ?r'' = f ` (Field r')" using WELL Field_Restr_ofilter by blast
   4.279 +  hence "bij_betw f ?A' (Field ?r'')"
   4.280 +  using EMB embed_inj_on WELL' unfolding bij_betw_def by blast
   4.281 +  moreover
   4.282 +  {have "\<forall>a b. (a,b) \<in> r' \<longrightarrow> a \<in> Field r' \<and> b \<in> Field r'"
   4.283 +   unfolding Field_def by auto
   4.284 +   hence "compat r' ?r'' f"
   4.285 +   using assms embed_iff_compat_inj_on_ofilter
   4.286 +   unfolding compat_def by blast
   4.287 +  }
   4.288 +  ultimately show ?thesis using WELL' 0 iso_iff3 by blast
   4.289 +qed
   4.290 +
   4.291 +
   4.292 +subsection {* The strict inclusion on proper ofilters is well-founded *}
   4.293 +
   4.294 +
   4.295 +definition ofilterIncl :: "'a rel \<Rightarrow> 'a set rel"
   4.296 +where
   4.297 +"ofilterIncl r \<equiv> {(A,B). wo_rel.ofilter r A \<and> A \<noteq> Field r \<and>
   4.298 +                         wo_rel.ofilter r B \<and> B \<noteq> Field r \<and> A < B}"
   4.299 +
   4.300 +
   4.301 +lemma wf_ofilterIncl:
   4.302 +assumes WELL: "Well_order r"
   4.303 +shows "wf(ofilterIncl r)"
   4.304 +proof-
   4.305 +  have Well: "wo_rel r" using WELL by (simp add: wo_rel_def)
   4.306 +  hence Lo: "Linear_order r" by (simp add: wo_rel.LIN)
   4.307 +  let ?h = "(\<lambda> A. wo_rel.suc r A)"
   4.308 +  let ?rS = "r - Id"
   4.309 +  have "wf ?rS" using WELL by (simp add: order_on_defs)
   4.310 +  moreover
   4.311 +  have "compat (ofilterIncl r) ?rS ?h"
   4.312 +  proof(unfold compat_def ofilterIncl_def,
   4.313 +        intro allI impI, simp, elim conjE)
   4.314 +    fix A B
   4.315 +    assume *: "wo_rel.ofilter r A" "A \<noteq> Field r" and
   4.316 +           **: "wo_rel.ofilter r B" "B \<noteq> Field r" and ***: "A < B"
   4.317 +    then obtain a and b where 0: "a \<in> Field r \<and> b \<in> Field r" and
   4.318 +                         1: "A = underS r a \<and> B = underS r b"
   4.319 +    using Well by (auto simp add: wo_rel.ofilter_underS_Field)
   4.320 +    hence "a \<noteq> b" using *** by auto
   4.321 +    moreover
   4.322 +    have "(a,b) \<in> r" using 0 1 Lo ***
   4.323 +    by (auto simp add: underS_incl_iff)
   4.324 +    moreover
   4.325 +    have "a = wo_rel.suc r A \<and> b = wo_rel.suc r B"
   4.326 +    using Well 0 1 by (simp add: wo_rel.suc_underS)
   4.327 +    ultimately
   4.328 +    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"
   4.329 +    by simp
   4.330 +  qed
   4.331 +  ultimately show "wf (ofilterIncl r)" by (simp add: compat_wf)
   4.332 +qed
   4.333 +
   4.334 +
   4.335 +
   4.336 +subsection {* Ordering the well-orders by existence of embeddings *}
   4.337 +
   4.338 +
   4.339 +text {* We define three relations between well-orders:
   4.340 +\begin{itemize}
   4.341 +\item @{text "ordLeq"}, of being embedded (abbreviated @{text "\<le>o"});
   4.342 +\item @{text "ordLess"}, of being strictly embedded (abbreviated @{text "<o"});
   4.343 +\item @{text "ordIso"}, of being isomorphic (abbreviated @{text "=o"}).
   4.344 +\end{itemize}
   4.345 +%
   4.346 +The prefix "ord" and the index "o" in these names stand for "ordinal-like".
   4.347 +These relations shall be proved to be inter-connected in a similar fashion as the trio
   4.348 +@{text "\<le>"}, @{text "<"}, @{text "="} associated to a total order on a set.
   4.349 +*}
   4.350 +
   4.351 +
   4.352 +definition ordLeq :: "('a rel * 'a' rel) set"
   4.353 +where
   4.354 +"ordLeq = {(r,r'). Well_order r \<and> Well_order r' \<and> (\<exists>f. embed r r' f)}"
   4.355 +
   4.356 +
   4.357 +abbreviation ordLeq2 :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> bool" (infix "<=o" 50)
   4.358 +where "r <=o r' \<equiv> (r,r') \<in> ordLeq"
   4.359 +
   4.360 +
   4.361 +abbreviation ordLeq3 :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> bool" (infix "\<le>o" 50)
   4.362 +where "r \<le>o r' \<equiv> r <=o r'"
   4.363 +
   4.364 +
   4.365 +definition ordLess :: "('a rel * 'a' rel) set"
   4.366 +where
   4.367 +"ordLess = {(r,r'). Well_order r \<and> Well_order r' \<and> (\<exists>f. embedS r r' f)}"
   4.368 +
   4.369 +abbreviation ordLess2 :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> bool" (infix "<o" 50)
   4.370 +where "r <o r' \<equiv> (r,r') \<in> ordLess"
   4.371 +
   4.372 +
   4.373 +definition ordIso :: "('a rel * 'a' rel) set"
   4.374 +where
   4.375 +"ordIso = {(r,r'). Well_order r \<and> Well_order r' \<and> (\<exists>f. iso r r' f)}"
   4.376 +
   4.377 +abbreviation ordIso2 :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> bool" (infix "=o" 50)
   4.378 +where "r =o r' \<equiv> (r,r') \<in> ordIso"
   4.379 +
   4.380 +
   4.381 +lemmas ordRels_def = ordLeq_def ordLess_def ordIso_def
   4.382 +
   4.383 +lemma ordLeq_Well_order_simp:
   4.384 +assumes "r \<le>o r'"
   4.385 +shows "Well_order r \<and> Well_order r'"
   4.386 +using assms unfolding ordLeq_def by simp
   4.387 +
   4.388 +
   4.389 +text{* Notice that the relations @{text "\<le>o"}, @{text "<o"}, @{text "=o"} connect well-orders
   4.390 +on potentially {\em distinct} types. However, some of the lemmas below, including the next one,
   4.391 +restrict implicitly the type of these relations to @{text "(('a rel) * ('a rel)) set"} , i.e.,
   4.392 +to @{text "'a rel rel"}.  *}
   4.393 +
   4.394 +
   4.395 +lemma ordLeq_reflexive:
   4.396 +"Well_order r \<Longrightarrow> r \<le>o r"
   4.397 +unfolding ordLeq_def using id_embed[of r] by blast
   4.398 +
   4.399 +
   4.400 +lemma ordLeq_transitive[trans]:
   4.401 +assumes *: "r \<le>o r'" and **: "r' \<le>o r''"
   4.402 +shows "r \<le>o r''"
   4.403 +proof-
   4.404 +  obtain f and f'
   4.405 +  where 1: "Well_order r \<and> Well_order r' \<and> Well_order r''" and
   4.406 +        "embed r r' f" and "embed r' r'' f'"
   4.407 +  using * ** unfolding ordLeq_def by blast
   4.408 +  hence "embed r r'' (f' o f)"
   4.409 +  using comp_embed[of r r' f r'' f'] by auto
   4.410 +  thus "r \<le>o r''" unfolding ordLeq_def using 1 by auto
   4.411 +qed
   4.412 +
   4.413 +
   4.414 +lemma ordLeq_total:
   4.415 +"\<lbrakk>Well_order r; Well_order r'\<rbrakk> \<Longrightarrow> r \<le>o r' \<or> r' \<le>o r"
   4.416 +unfolding ordLeq_def using wellorders_totally_ordered by blast
   4.417 +
   4.418 +
   4.419 +lemma ordIso_reflexive:
   4.420 +"Well_order r \<Longrightarrow> r =o r"
   4.421 +unfolding ordIso_def using id_iso[of r] by blast
   4.422 +
   4.423 +
   4.424 +lemma ordIso_transitive[trans]:
   4.425 +assumes *: "r =o r'" and **: "r' =o r''"
   4.426 +shows "r =o r''"
   4.427 +proof-
   4.428 +  obtain f and f'
   4.429 +  where 1: "Well_order r \<and> Well_order r' \<and> Well_order r''" and
   4.430 +        "iso r r' f" and 3: "iso r' r'' f'"
   4.431 +  using * ** unfolding ordIso_def by auto
   4.432 +  hence "iso r r'' (f' o f)"
   4.433 +  using comp_iso[of r r' f r'' f'] by auto
   4.434 +  thus "r =o r''" unfolding ordIso_def using 1 by auto
   4.435 +qed
   4.436 +
   4.437 +
   4.438 +lemma ordIso_symmetric:
   4.439 +assumes *: "r =o r'"
   4.440 +shows "r' =o r"
   4.441 +proof-
   4.442 +  obtain f where 1: "Well_order r \<and> Well_order r'" and
   4.443 +                 2: "embed r r' f \<and> bij_betw f (Field r) (Field r')"
   4.444 +  using * by (auto simp add: ordIso_def iso_def)
   4.445 +  let ?f' = "inv_into (Field r) f"
   4.446 +  have "embed r' r ?f' \<and> bij_betw ?f' (Field r') (Field r)"
   4.447 +  using 1 2 by (simp add: bij_betw_inv_into inv_into_Field_embed_bij_betw)
   4.448 +  thus "r' =o r" unfolding ordIso_def using 1 by (auto simp add: iso_def)
   4.449 +qed
   4.450 +
   4.451 +
   4.452 +lemma ordLeq_ordLess_trans[trans]:
   4.453 +assumes "r \<le>o r'" and " r' <o r''"
   4.454 +shows "r <o r''"
   4.455 +proof-
   4.456 +  have "Well_order r \<and> Well_order r''"
   4.457 +  using assms unfolding ordLeq_def ordLess_def by auto
   4.458 +  thus ?thesis using assms unfolding ordLeq_def ordLess_def
   4.459 +  using embed_comp_embedS by blast
   4.460 +qed
   4.461 +
   4.462 +
   4.463 +lemma ordLess_ordLeq_trans[trans]:
   4.464 +assumes "r <o r'" and " r' \<le>o r''"
   4.465 +shows "r <o r''"
   4.466 +proof-
   4.467 +  have "Well_order r \<and> Well_order r''"
   4.468 +  using assms unfolding ordLeq_def ordLess_def by auto
   4.469 +  thus ?thesis using assms unfolding ordLeq_def ordLess_def
   4.470 +  using embedS_comp_embed by blast
   4.471 +qed
   4.472 +
   4.473 +
   4.474 +lemma ordLeq_ordIso_trans[trans]:
   4.475 +assumes "r \<le>o r'" and " r' =o r''"
   4.476 +shows "r \<le>o r''"
   4.477 +proof-
   4.478 +  have "Well_order r \<and> Well_order r''"
   4.479 +  using assms unfolding ordLeq_def ordIso_def by auto
   4.480 +  thus ?thesis using assms unfolding ordLeq_def ordIso_def
   4.481 +  using embed_comp_iso by blast
   4.482 +qed
   4.483 +
   4.484 +
   4.485 +lemma ordIso_ordLeq_trans[trans]:
   4.486 +assumes "r =o r'" and " r' \<le>o r''"
   4.487 +shows "r \<le>o r''"
   4.488 +proof-
   4.489 +  have "Well_order r \<and> Well_order r''"
   4.490 +  using assms unfolding ordLeq_def ordIso_def by auto
   4.491 +  thus ?thesis using assms unfolding ordLeq_def ordIso_def
   4.492 +  using iso_comp_embed by blast
   4.493 +qed
   4.494 +
   4.495 +
   4.496 +lemma ordLess_ordIso_trans[trans]:
   4.497 +assumes "r <o r'" and " r' =o r''"
   4.498 +shows "r <o r''"
   4.499 +proof-
   4.500 +  have "Well_order r \<and> Well_order r''"
   4.501 +  using assms unfolding ordLess_def ordIso_def by auto
   4.502 +  thus ?thesis using assms unfolding ordLess_def ordIso_def
   4.503 +  using embedS_comp_iso by blast
   4.504 +qed
   4.505 +
   4.506 +
   4.507 +lemma ordIso_ordLess_trans[trans]:
   4.508 +assumes "r =o r'" and " r' <o r''"
   4.509 +shows "r <o r''"
   4.510 +proof-
   4.511 +  have "Well_order r \<and> Well_order r''"
   4.512 +  using assms unfolding ordLess_def ordIso_def by auto
   4.513 +  thus ?thesis using assms unfolding ordLess_def ordIso_def
   4.514 +  using iso_comp_embedS by blast
   4.515 +qed
   4.516 +
   4.517 +
   4.518 +lemma ordLess_not_embed:
   4.519 +assumes "r <o r'"
   4.520 +shows "\<not>(\<exists>f'. embed r' r f')"
   4.521 +proof-
   4.522 +  obtain f where 1: "Well_order r \<and> Well_order r'" and 2: "embed r r' f" and
   4.523 +                 3: " \<not> bij_betw f (Field r) (Field r')"
   4.524 +  using assms unfolding ordLess_def by (auto simp add: embedS_def)
   4.525 +  {fix f' assume *: "embed r' r f'"
   4.526 +   hence "bij_betw f (Field r) (Field r')" using 1 2
   4.527 +   by (simp add: embed_bothWays_Field_bij_betw)
   4.528 +   with 3 have False by contradiction
   4.529 +  }
   4.530 +  thus ?thesis by blast
   4.531 +qed
   4.532 +
   4.533 +
   4.534 +lemma ordLess_Field:
   4.535 +assumes OL: "r1 <o r2" and EMB: "embed r1 r2 f"
   4.536 +shows "\<not> (f`(Field r1) = Field r2)"
   4.537 +proof-
   4.538 +  let ?A1 = "Field r1"  let ?A2 = "Field r2"
   4.539 +  obtain g where
   4.540 +  0: "Well_order r1 \<and> Well_order r2" and
   4.541 +  1: "embed r1 r2 g \<and> \<not>(bij_betw g ?A1 ?A2)"
   4.542 +  using OL unfolding ordLess_def by (auto simp add: embedS_def)
   4.543 +  hence "\<forall>a \<in> ?A1. f a = g a"
   4.544 +  using 0 EMB embed_unique[of r1] by auto
   4.545 +  hence "\<not>(bij_betw f ?A1 ?A2)"
   4.546 +  using 1 bij_betw_cong[of ?A1] by blast
   4.547 +  moreover
   4.548 +  have "inj_on f ?A1" using EMB 0 by (simp add: embed_inj_on)
   4.549 +  ultimately show ?thesis by (simp add: bij_betw_def)
   4.550 +qed
   4.551 +
   4.552 +
   4.553 +lemma ordLess_iff:
   4.554 +"r <o r' = (Well_order r \<and> Well_order r' \<and> \<not>(\<exists>f'. embed r' r f'))"
   4.555 +proof
   4.556 +  assume *: "r <o r'"
   4.557 +  hence "\<not>(\<exists>f'. embed r' r f')" using ordLess_not_embed[of r r'] by simp
   4.558 +  with * show "Well_order r \<and> Well_order r' \<and> \<not> (\<exists>f'. embed r' r f')"
   4.559 +  unfolding ordLess_def by auto
   4.560 +next
   4.561 +  assume *: "Well_order r \<and> Well_order r' \<and> \<not> (\<exists>f'. embed r' r f')"
   4.562 +  then obtain f where 1: "embed r r' f"
   4.563 +  using wellorders_totally_ordered[of r r'] by blast
   4.564 +  moreover
   4.565 +  {assume "bij_betw f (Field r) (Field r')"
   4.566 +   with * 1 have "embed r' r (inv_into (Field r) f) "
   4.567 +   using inv_into_Field_embed_bij_betw[of r r' f] by auto
   4.568 +   with * have False by blast
   4.569 +  }
   4.570 +  ultimately show "(r,r') \<in> ordLess"
   4.571 +  unfolding ordLess_def using * by (fastforce simp add: embedS_def)
   4.572 +qed
   4.573 +
   4.574 +
   4.575 +lemma ordLess_irreflexive: "\<not> r <o r"
   4.576 +proof
   4.577 +  assume "r <o r"
   4.578 +  hence "Well_order r \<and>  \<not>(\<exists>f. embed r r f)"
   4.579 +  unfolding ordLess_iff ..
   4.580 +  moreover have "embed r r id" using id_embed[of r] .
   4.581 +  ultimately show False by blast
   4.582 +qed
   4.583 +
   4.584 +
   4.585 +lemma ordLeq_iff_ordLess_or_ordIso:
   4.586 +"r \<le>o r' = (r <o r' \<or> r =o r')"
   4.587 +unfolding ordRels_def embedS_defs iso_defs by blast
   4.588 +
   4.589 +
   4.590 +lemma ordIso_iff_ordLeq:
   4.591 +"(r =o r') = (r \<le>o r' \<and> r' \<le>o r)"
   4.592 +proof
   4.593 +  assume "r =o r'"
   4.594 +  then obtain f where 1: "Well_order r \<and> Well_order r' \<and>
   4.595 +                     embed r r' f \<and> bij_betw f (Field r) (Field r')"
   4.596 +  unfolding ordIso_def iso_defs by auto
   4.597 +  hence "embed r r' f \<and> embed r' r (inv_into (Field r) f)"
   4.598 +  by (simp add: inv_into_Field_embed_bij_betw)
   4.599 +  thus  "r \<le>o r' \<and> r' \<le>o r"
   4.600 +  unfolding ordLeq_def using 1 by auto
   4.601 +next
   4.602 +  assume "r \<le>o r' \<and> r' \<le>o r"
   4.603 +  then obtain f and g where 1: "Well_order r \<and> Well_order r' \<and>
   4.604 +                           embed r r' f \<and> embed r' r g"
   4.605 +  unfolding ordLeq_def by auto
   4.606 +  hence "iso r r' f" by (auto simp add: embed_bothWays_iso)
   4.607 +  thus "r =o r'" unfolding ordIso_def using 1 by auto
   4.608 +qed
   4.609 +
   4.610 +
   4.611 +lemma not_ordLess_ordLeq:
   4.612 +"r <o r' \<Longrightarrow> \<not> r' \<le>o r"
   4.613 +using ordLess_ordLeq_trans ordLess_irreflexive by blast
   4.614 +
   4.615 +
   4.616 +lemma ordLess_or_ordLeq:
   4.617 +assumes WELL: "Well_order r" and WELL': "Well_order r'"
   4.618 +shows "r <o r' \<or> r' \<le>o r"
   4.619 +proof-
   4.620 +  have "r \<le>o r' \<or> r' \<le>o r"
   4.621 +  using assms by (simp add: ordLeq_total)
   4.622 +  moreover
   4.623 +  {assume "\<not> r <o r' \<and> r \<le>o r'"
   4.624 +   hence "r =o r'" using ordLeq_iff_ordLess_or_ordIso by blast
   4.625 +   hence "r' \<le>o r" using ordIso_symmetric ordIso_iff_ordLeq by blast
   4.626 +  }
   4.627 +  ultimately show ?thesis by blast
   4.628 +qed
   4.629 +
   4.630 +
   4.631 +lemma not_ordLess_ordIso:
   4.632 +"r <o r' \<Longrightarrow> \<not> r =o r'"
   4.633 +using assms ordLess_ordIso_trans ordIso_symmetric ordLess_irreflexive by blast
   4.634 +
   4.635 +
   4.636 +lemma not_ordLeq_iff_ordLess:
   4.637 +assumes WELL: "Well_order r" and WELL': "Well_order r'"
   4.638 +shows "(\<not> r' \<le>o r) = (r <o r')"
   4.639 +using assms not_ordLess_ordLeq ordLess_or_ordLeq by blast
   4.640 +
   4.641 +
   4.642 +lemma not_ordLess_iff_ordLeq:
   4.643 +assumes WELL: "Well_order r" and WELL': "Well_order r'"
   4.644 +shows "(\<not> r' <o r) = (r \<le>o r')"
   4.645 +using assms not_ordLess_ordLeq ordLess_or_ordLeq by blast
   4.646 +
   4.647 +
   4.648 +lemma ordLess_transitive[trans]:
   4.649 +"\<lbrakk>r <o r'; r' <o r''\<rbrakk> \<Longrightarrow> r <o r''"
   4.650 +using assms ordLess_ordLeq_trans ordLeq_iff_ordLess_or_ordIso by blast
   4.651 +
   4.652 +
   4.653 +corollary ordLess_trans: "trans ordLess"
   4.654 +unfolding trans_def using ordLess_transitive by blast
   4.655 +
   4.656 +
   4.657 +lemmas ordIso_equivalence = ordIso_transitive ordIso_reflexive ordIso_symmetric
   4.658 +
   4.659 +
   4.660 +lemma ordIso_imp_ordLeq:
   4.661 +"r =o r' \<Longrightarrow> r \<le>o r'"
   4.662 +using ordIso_iff_ordLeq by blast
   4.663 +
   4.664 +
   4.665 +lemma ordLess_imp_ordLeq:
   4.666 +"r <o r' \<Longrightarrow> r \<le>o r'"
   4.667 +using ordLeq_iff_ordLess_or_ordIso by blast
   4.668 +
   4.669 +
   4.670 +lemma ofilter_subset_ordLeq:
   4.671 +assumes WELL: "Well_order r" and
   4.672 +        OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
   4.673 +shows "(A \<le> B) = (Restr r A \<le>o Restr r B)"
   4.674 +proof
   4.675 +  assume "A \<le> B"
   4.676 +  thus "Restr r A \<le>o Restr r B"
   4.677 +  unfolding ordLeq_def using assms
   4.678 +  Well_order_Restr Well_order_Restr ofilter_subset_embed by blast
   4.679 +next
   4.680 +  assume *: "Restr r A \<le>o Restr r B"
   4.681 +  then obtain f where "embed (Restr r A) (Restr r B) f"
   4.682 +  unfolding ordLeq_def by blast
   4.683 +  {assume "B < A"
   4.684 +   hence "Restr r B <o Restr r A"
   4.685 +   unfolding ordLess_def using assms
   4.686 +   Well_order_Restr Well_order_Restr ofilter_subset_embedS by blast
   4.687 +   hence False using * not_ordLess_ordLeq by blast
   4.688 +  }
   4.689 +  thus "A \<le> B" using OFA OFB WELL
   4.690 +  wo_rel_def[of r] wo_rel.ofilter_linord[of r A B] by blast
   4.691 +qed
   4.692 +
   4.693 +
   4.694 +lemma ofilter_subset_ordLess:
   4.695 +assumes WELL: "Well_order r" and
   4.696 +        OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
   4.697 +shows "(A < B) = (Restr r A <o Restr r B)"
   4.698 +proof-
   4.699 +  let ?rA = "Restr r A" let ?rB = "Restr r B"
   4.700 +  have 1: "Well_order ?rA \<and> Well_order ?rB"
   4.701 +  using WELL Well_order_Restr by blast
   4.702 +  have "(A < B) = (\<not> B \<le> A)" using assms
   4.703 +  wo_rel_def wo_rel.ofilter_linord[of r A B] by blast
   4.704 +  also have "\<dots> = (\<not> Restr r B \<le>o Restr r A)"
   4.705 +  using assms ofilter_subset_ordLeq by blast
   4.706 +  also have "\<dots> = (Restr r A <o Restr r B)"
   4.707 +  using 1 not_ordLeq_iff_ordLess by blast
   4.708 +  finally show ?thesis .
   4.709 +qed
   4.710 +
   4.711 +
   4.712 +lemma ofilter_ordLess:
   4.713 +"\<lbrakk>Well_order r; wo_rel.ofilter r A\<rbrakk> \<Longrightarrow> (A < Field r) = (Restr r A <o r)"
   4.714 +by (simp add: ofilter_subset_ordLess wo_rel.Field_ofilter
   4.715 +    wo_rel_def Restr_Field)
   4.716 +
   4.717 +
   4.718 +corollary underS_Restr_ordLess:
   4.719 +assumes "Well_order r" and "Field r \<noteq> {}"
   4.720 +shows "Restr r (underS r a) <o r"
   4.721 +proof-
   4.722 +  have "underS r a < Field r" using assms
   4.723 +  by (simp add: underS_Field3)
   4.724 +  thus ?thesis using assms
   4.725 +  by (simp add: ofilter_ordLess wo_rel.underS_ofilter wo_rel_def)
   4.726 +qed
   4.727 +
   4.728 +
   4.729 +lemma embed_ordLess_ofilterIncl:
   4.730 +assumes
   4.731 +  OL12: "r1 <o r2" and OL23: "r2 <o r3" and
   4.732 +  EMB13: "embed r1 r3 f13" and EMB23: "embed r2 r3 f23"
   4.733 +shows "(f13`(Field r1), f23`(Field r2)) \<in> (ofilterIncl r3)"
   4.734 +proof-
   4.735 +  have OL13: "r1 <o r3"
   4.736 +  using OL12 OL23 using ordLess_transitive by auto
   4.737 +  let ?A1 = "Field r1"  let ?A2 ="Field r2" let ?A3 ="Field r3"
   4.738 +  obtain f12 g23 where
   4.739 +  0: "Well_order r1 \<and> Well_order r2 \<and> Well_order r3" and
   4.740 +  1: "embed r1 r2 f12 \<and> \<not>(bij_betw f12 ?A1 ?A2)" and
   4.741 +  2: "embed r2 r3 g23 \<and> \<not>(bij_betw g23 ?A2 ?A3)"
   4.742 +  using OL12 OL23 by (auto simp add: ordLess_def embedS_def)
   4.743 +  hence "\<forall>a \<in> ?A2. f23 a = g23 a"
   4.744 +  using EMB23 embed_unique[of r2 r3] by blast
   4.745 +  hence 3: "\<not>(bij_betw f23 ?A2 ?A3)"
   4.746 +  using 2 bij_betw_cong[of ?A2 f23 g23] by blast
   4.747 +  (*  *)
   4.748 +  have 4: "wo_rel.ofilter r2 (f12 ` ?A1) \<and> f12 ` ?A1 \<noteq> ?A2"
   4.749 +  using 0 1 OL12 by (simp add: embed_Field_ofilter ordLess_Field)
   4.750 +  have 5: "wo_rel.ofilter r3 (f23 ` ?A2) \<and> f23 ` ?A2 \<noteq> ?A3"
   4.751 +  using 0 EMB23 OL23 by (simp add: embed_Field_ofilter ordLess_Field)
   4.752 +  have 6: "wo_rel.ofilter r3 (f13 ` ?A1)  \<and> f13 ` ?A1 \<noteq> ?A3"
   4.753 +  using 0 EMB13 OL13 by (simp add: embed_Field_ofilter ordLess_Field)
   4.754 +  (*  *)
   4.755 +  have "f12 ` ?A1 < ?A2"
   4.756 +  using 0 4 by (auto simp add: wo_rel_def wo_rel.ofilter_def)
   4.757 +  moreover have "inj_on f23 ?A2"
   4.758 +  using EMB23 0 by (simp add: wo_rel_def embed_inj_on)
   4.759 +  ultimately
   4.760 +  have "f23 ` (f12 ` ?A1) < f23 ` ?A2" by (simp add: inj_on_strict_subset)
   4.761 +  moreover
   4.762 +  {have "embed r1 r3 (f23 o f12)"
   4.763 +   using 1 EMB23 0 by (auto simp add: comp_embed)
   4.764 +   hence "\<forall>a \<in> ?A1. f23(f12 a) = f13 a"
   4.765 +   using EMB13 0 embed_unique[of r1 r3 "f23 o f12" f13] by auto
   4.766 +   hence "f23 ` (f12 ` ?A1) = f13 ` ?A1" by force
   4.767 +  }
   4.768 +  ultimately
   4.769 +  have "f13 ` ?A1 < f23 ` ?A2" by simp
   4.770 +  (*  *)
   4.771 +  with 5 6 show ?thesis
   4.772 +  unfolding ofilterIncl_def by auto
   4.773 +qed
   4.774 +
   4.775 +
   4.776 +lemma ordLess_iff_ordIso_Restr:
   4.777 +assumes WELL: "Well_order r" and WELL': "Well_order r'"
   4.778 +shows "(r' <o r) = (\<exists>a \<in> Field r. r' =o Restr r (underS r a))"
   4.779 +proof(auto)
   4.780 +  fix a assume *: "a \<in> Field r" and **: "r' =o Restr r (underS r a)"
   4.781 +  hence "Restr r (underS r a) <o r" using WELL underS_Restr_ordLess[of r] by blast
   4.782 +  thus "r' <o r" using ** ordIso_ordLess_trans by blast
   4.783 +next
   4.784 +  assume "r' <o r"
   4.785 +  then obtain f where 1: "Well_order r \<and> Well_order r'" and
   4.786 +                      2: "embed r' r f \<and> f ` (Field r') \<noteq> Field r"
   4.787 +  unfolding ordLess_def embedS_def[abs_def] bij_betw_def using embed_inj_on by blast
   4.788 +  hence "wo_rel.ofilter r (f ` (Field r'))" using embed_Field_ofilter by blast
   4.789 +  then obtain a where 3: "a \<in> Field r" and 4: "underS r a = f ` (Field r')"
   4.790 +  using 1 2 by (auto simp add: wo_rel.ofilter_underS_Field wo_rel_def)
   4.791 +  have "iso r' (Restr r (f ` (Field r'))) f"
   4.792 +  using embed_implies_iso_Restr 2 assms by blast
   4.793 +  moreover have "Well_order (Restr r (f ` (Field r')))"
   4.794 +  using WELL Well_order_Restr by blast
   4.795 +  ultimately have "r' =o Restr r (f ` (Field r'))"
   4.796 +  using WELL' unfolding ordIso_def by auto
   4.797 +  hence "r' =o Restr r (underS r a)" using 4 by auto
   4.798 +  thus "\<exists>a \<in> Field r. r' =o Restr r (underS r a)" using 3 by auto
   4.799 +qed
   4.800 +
   4.801 +
   4.802 +lemma internalize_ordLess:
   4.803 +"(r' <o r) = (\<exists>p. Field p < Field r \<and> r' =o p \<and> p <o r)"
   4.804 +proof
   4.805 +  assume *: "r' <o r"
   4.806 +  hence 0: "Well_order r \<and> Well_order r'" unfolding ordLess_def by auto
   4.807 +  with * obtain a where 1: "a \<in> Field r" and 2: "r' =o Restr r (underS r a)"
   4.808 +  using ordLess_iff_ordIso_Restr by blast
   4.809 +  let ?p = "Restr r (underS r a)"
   4.810 +  have "wo_rel.ofilter r (underS r a)" using 0
   4.811 +  by (simp add: wo_rel_def wo_rel.underS_ofilter)
   4.812 +  hence "Field ?p = underS r a" using 0 Field_Restr_ofilter by blast
   4.813 +  hence "Field ?p < Field r" using underS_Field2 1 by fast
   4.814 +  moreover have "?p <o r" using underS_Restr_ordLess[of r a] 0 1 by blast
   4.815 +  ultimately
   4.816 +  show "\<exists>p. Field p < Field r \<and> r' =o p \<and> p <o r" using 2 by blast
   4.817 +next
   4.818 +  assume "\<exists>p. Field p < Field r \<and> r' =o p \<and> p <o r"
   4.819 +  thus "r' <o r" using ordIso_ordLess_trans by blast
   4.820 +qed
   4.821 +
   4.822 +
   4.823 +lemma internalize_ordLeq:
   4.824 +"(r' \<le>o r) = (\<exists>p. Field p \<le> Field r \<and> r' =o p \<and> p \<le>o r)"
   4.825 +proof
   4.826 +  assume *: "r' \<le>o r"
   4.827 +  moreover
   4.828 +  {assume "r' <o r"
   4.829 +   then obtain p where "Field p < Field r \<and> r' =o p \<and> p <o r"
   4.830 +   using internalize_ordLess[of r' r] by blast
   4.831 +   hence "\<exists>p. Field p \<le> Field r \<and> r' =o p \<and> p \<le>o r"
   4.832 +   using ordLeq_iff_ordLess_or_ordIso by blast
   4.833 +  }
   4.834 +  moreover
   4.835 +  have "r \<le>o r" using * ordLeq_def ordLeq_reflexive by blast
   4.836 +  ultimately show "\<exists>p. Field p \<le> Field r \<and> r' =o p \<and> p \<le>o r"
   4.837 +  using ordLeq_iff_ordLess_or_ordIso by blast
   4.838 +next
   4.839 +  assume "\<exists>p. Field p \<le> Field r \<and> r' =o p \<and> p \<le>o r"
   4.840 +  thus "r' \<le>o r" using ordIso_ordLeq_trans by blast
   4.841 +qed
   4.842 +
   4.843 +
   4.844 +lemma ordLeq_iff_ordLess_Restr:
   4.845 +assumes WELL: "Well_order r" and WELL': "Well_order r'"
   4.846 +shows "(r \<le>o r') = (\<forall>a \<in> Field r. Restr r (underS r a) <o r')"
   4.847 +proof(auto)
   4.848 +  assume *: "r \<le>o r'"
   4.849 +  fix a assume "a \<in> Field r"
   4.850 +  hence "Restr r (underS r a) <o r"
   4.851 +  using WELL underS_Restr_ordLess[of r] by blast
   4.852 +  thus "Restr r (underS r a) <o r'"
   4.853 +  using * ordLess_ordLeq_trans by blast
   4.854 +next
   4.855 +  assume *: "\<forall>a \<in> Field r. Restr r (underS r a) <o r'"
   4.856 +  {assume "r' <o r"
   4.857 +   then obtain a where "a \<in> Field r \<and> r' =o Restr r (underS r a)"
   4.858 +   using assms ordLess_iff_ordIso_Restr by blast
   4.859 +   hence False using * not_ordLess_ordIso ordIso_symmetric by blast
   4.860 +  }
   4.861 +  thus "r \<le>o r'" using ordLess_or_ordLeq assms by blast
   4.862 +qed
   4.863 +
   4.864 +
   4.865 +lemma finite_ordLess_infinite:
   4.866 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and
   4.867 +        FIN: "finite(Field r)" and INF: "\<not>finite(Field r')"
   4.868 +shows "r <o r'"
   4.869 +proof-
   4.870 +  {assume "r' \<le>o r"
   4.871 +   then obtain h where "inj_on h (Field r') \<and> h ` (Field r') \<le> Field r"
   4.872 +   unfolding ordLeq_def using assms embed_inj_on embed_Field by blast
   4.873 +   hence False using finite_imageD finite_subset FIN INF by metis
   4.874 +  }
   4.875 +  thus ?thesis using WELL WELL' ordLess_or_ordLeq by blast
   4.876 +qed
   4.877 +
   4.878 +
   4.879 +lemma finite_well_order_on_ordIso:
   4.880 +assumes FIN: "finite A" and
   4.881 +        WELL: "well_order_on A r" and WELL': "well_order_on A r'"
   4.882 +shows "r =o r'"
   4.883 +proof-
   4.884 +  have 0: "Well_order r \<and> Well_order r' \<and> Field r = A \<and> Field r' = A"
   4.885 +  using assms well_order_on_Well_order by blast
   4.886 +  moreover
   4.887 +  have "\<forall>r r'. well_order_on A r \<and> well_order_on A r' \<and> r \<le>o r'
   4.888 +                  \<longrightarrow> r =o r'"
   4.889 +  proof(clarify)
   4.890 +    fix r r' assume *: "well_order_on A r" and **: "well_order_on A r'"
   4.891 +    have 2: "Well_order r \<and> Well_order r' \<and> Field r = A \<and> Field r' = A"
   4.892 +    using * ** well_order_on_Well_order by blast
   4.893 +    assume "r \<le>o r'"
   4.894 +    then obtain f where 1: "embed r r' f" and
   4.895 +                        "inj_on f A \<and> f ` A \<le> A"
   4.896 +    unfolding ordLeq_def using 2 embed_inj_on embed_Field by blast
   4.897 +    hence "bij_betw f A A" unfolding bij_betw_def using FIN endo_inj_surj by blast
   4.898 +    thus "r =o r'" unfolding ordIso_def iso_def[abs_def] using 1 2 by auto
   4.899 +  qed
   4.900 +  ultimately show ?thesis using assms ordLeq_total ordIso_symmetric by metis
   4.901 +qed
   4.902 +
   4.903 +
   4.904 +subsection{* @{text "<o"} is well-founded *}
   4.905 +
   4.906 +
   4.907 +text {* Of course, it only makes sense to state that the @{text "<o"} is well-founded
   4.908 +on the restricted type @{text "'a rel rel"}.  We prove this by first showing that, for any set
   4.909 +of well-orders all embedded in a fixed well-order, the function mapping each well-order
   4.910 +in the set to an order filter of the fixed well-order is compatible w.r.t. to @{text "<o"} versus
   4.911 +{\em strict inclusion}; and we already know that strict inclusion of order filters is well-founded. *}
   4.912 +
   4.913 +
   4.914 +definition ord_to_filter :: "'a rel \<Rightarrow> 'a rel \<Rightarrow> 'a set"
   4.915 +where "ord_to_filter r0 r \<equiv> (SOME f. embed r r0 f) ` (Field r)"
   4.916 +
   4.917 +
   4.918 +lemma ord_to_filter_compat:
   4.919 +"compat (ordLess Int (ordLess^-1``{r0} \<times> ordLess^-1``{r0}))
   4.920 +        (ofilterIncl r0)
   4.921 +        (ord_to_filter r0)"
   4.922 +proof(unfold compat_def ord_to_filter_def, clarify)
   4.923 +  fix r1::"'a rel" and r2::"'a rel"
   4.924 +  let ?A1 = "Field r1"  let ?A2 ="Field r2" let ?A0 ="Field r0"
   4.925 +  let ?phi10 = "\<lambda> f10. embed r1 r0 f10" let ?f10 = "SOME f. ?phi10 f"
   4.926 +  let ?phi20 = "\<lambda> f20. embed r2 r0 f20" let ?f20 = "SOME f. ?phi20 f"
   4.927 +  assume *: "r1 <o r0" "r2 <o r0" and **: "r1 <o r2"
   4.928 +  hence "(\<exists>f. ?phi10 f) \<and> (\<exists>f. ?phi20 f)"
   4.929 +  by (auto simp add: ordLess_def embedS_def)
   4.930 +  hence "?phi10 ?f10 \<and> ?phi20 ?f20" by (auto simp add: someI_ex)
   4.931 +  thus "(?f10 ` ?A1, ?f20 ` ?A2) \<in> ofilterIncl r0"
   4.932 +  using * ** by (simp add: embed_ordLess_ofilterIncl)
   4.933 +qed
   4.934 +
   4.935 +
   4.936 +theorem wf_ordLess: "wf ordLess"
   4.937 +proof-
   4.938 +  {fix r0 :: "('a \<times> 'a) set"
   4.939 +   (* need to annotate here!*)
   4.940 +   let ?ordLess = "ordLess::('d rel * 'd rel) set"
   4.941 +   let ?R = "?ordLess Int (?ordLess^-1``{r0} \<times> ?ordLess^-1``{r0})"
   4.942 +   {assume Case1: "Well_order r0"
   4.943 +    hence "wf ?R"
   4.944 +    using wf_ofilterIncl[of r0]
   4.945 +          compat_wf[of ?R "ofilterIncl r0" "ord_to_filter r0"]
   4.946 +          ord_to_filter_compat[of r0] by auto
   4.947 +   }
   4.948 +   moreover
   4.949 +   {assume Case2: "\<not> Well_order r0"
   4.950 +    hence "?R = {}" unfolding ordLess_def by auto
   4.951 +    hence "wf ?R" using wf_empty by simp
   4.952 +   }
   4.953 +   ultimately have "wf ?R" by blast
   4.954 +  }
   4.955 +  thus ?thesis by (simp add: trans_wf_iff ordLess_trans)
   4.956 +qed
   4.957 +
   4.958 +corollary exists_minim_Well_order:
   4.959 +assumes NE: "R \<noteq> {}" and WELL: "\<forall>r \<in> R. Well_order r"
   4.960 +shows "\<exists>r \<in> R. \<forall>r' \<in> R. r \<le>o r'"
   4.961 +proof-
   4.962 +  obtain r where "r \<in> R \<and> (\<forall>r' \<in> R. \<not> r' <o r)"
   4.963 +  using NE spec[OF spec[OF subst[OF wf_eq_minimal, of "%x. x", OF wf_ordLess]], of _ R]
   4.964 +    equals0I[of R] by blast
   4.965 +  with not_ordLeq_iff_ordLess WELL show ?thesis by blast
   4.966 +qed
   4.967 +
   4.968 +
   4.969 +
   4.970 +subsection {* Copy via direct images  *}
   4.971 +
   4.972 +
   4.973 +text{* The direct image operator is the dual of the inverse image operator @{text "inv_image"}
   4.974 +from @{text "Relation.thy"}.  It is useful for transporting a well-order between
   4.975 +different types. *}
   4.976 +
   4.977 +
   4.978 +definition dir_image :: "'a rel \<Rightarrow> ('a \<Rightarrow> 'a') \<Rightarrow> 'a' rel"
   4.979 +where
   4.980 +"dir_image r f = {(f a, f b)| a b. (a,b) \<in> r}"
   4.981 +
   4.982 +
   4.983 +lemma dir_image_Field:
   4.984 +"Field(dir_image r f) \<le> f ` (Field r)"
   4.985 +unfolding dir_image_def Field_def by auto
   4.986 +
   4.987 +
   4.988 +lemma dir_image_minus_Id:
   4.989 +"inj_on f (Field r) \<Longrightarrow> (dir_image r f) - Id = dir_image (r - Id) f"
   4.990 +unfolding inj_on_def Field_def dir_image_def by auto
   4.991 +
   4.992 +
   4.993 +lemma Refl_dir_image:
   4.994 +assumes "Refl r"
   4.995 +shows "Refl(dir_image r f)"
   4.996 +proof-
   4.997 +  {fix a' b'
   4.998 +   assume "(a',b') \<in> dir_image r f"
   4.999 +   then obtain a b where 1: "a' = f a \<and> b' = f b \<and> (a,b) \<in> r"
  4.1000 +   unfolding dir_image_def by blast
  4.1001 +   hence "a \<in> Field r \<and> b \<in> Field r" using Field_def by fastforce
  4.1002 +   hence "(a,a) \<in> r \<and> (b,b) \<in> r" using assms by (simp add: refl_on_def)
  4.1003 +   with 1 have "(a',a') \<in> dir_image r f \<and> (b',b') \<in> dir_image r f"
  4.1004 +   unfolding dir_image_def by auto
  4.1005 +  }
  4.1006 +  thus ?thesis
  4.1007 +  by(unfold refl_on_def Field_def Domain_def Range_def, auto)
  4.1008 +qed
  4.1009 +
  4.1010 +
  4.1011 +lemma trans_dir_image:
  4.1012 +assumes TRANS: "trans r" and INJ: "inj_on f (Field r)"
  4.1013 +shows "trans(dir_image r f)"
  4.1014 +proof(unfold trans_def, auto)
  4.1015 +  fix a' b' c'
  4.1016 +  assume "(a',b') \<in> dir_image r f" "(b',c') \<in> dir_image r f"
  4.1017 +  then obtain a b1 b2 c where 1: "a' = f a \<and> b' = f b1 \<and> b' = f b2 \<and> c' = f c" and
  4.1018 +                         2: "(a,b1) \<in> r \<and> (b2,c) \<in> r"
  4.1019 +  unfolding dir_image_def by blast
  4.1020 +  hence "b1 \<in> Field r \<and> b2 \<in> Field r"
  4.1021 +  unfolding Field_def by auto
  4.1022 +  hence "b1 = b2" using 1 INJ unfolding inj_on_def by auto
  4.1023 +  hence "(a,c): r" using 2 TRANS unfolding trans_def by blast
  4.1024 +  thus "(a',c') \<in> dir_image r f"
  4.1025 +  unfolding dir_image_def using 1 by auto
  4.1026 +qed
  4.1027 +
  4.1028 +
  4.1029 +lemma Preorder_dir_image:
  4.1030 +"\<lbrakk>Preorder r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> Preorder (dir_image r f)"
  4.1031 +by (simp add: preorder_on_def Refl_dir_image trans_dir_image)
  4.1032 +
  4.1033 +
  4.1034 +lemma antisym_dir_image:
  4.1035 +assumes AN: "antisym r" and INJ: "inj_on f (Field r)"
  4.1036 +shows "antisym(dir_image r f)"
  4.1037 +proof(unfold antisym_def, auto)
  4.1038 +  fix a' b'
  4.1039 +  assume "(a',b') \<in> dir_image r f" "(b',a') \<in> dir_image r f"
  4.1040 +  then obtain a1 b1 a2 b2 where 1: "a' = f a1 \<and> a' = f a2 \<and> b' = f b1 \<and> b' = f b2" and
  4.1041 +                           2: "(a1,b1) \<in> r \<and> (b2,a2) \<in> r " and
  4.1042 +                           3: "{a1,a2,b1,b2} \<le> Field r"
  4.1043 +  unfolding dir_image_def Field_def by blast
  4.1044 +  hence "a1 = a2 \<and> b1 = b2" using INJ unfolding inj_on_def by auto
  4.1045 +  hence "a1 = b2" using 2 AN unfolding antisym_def by auto
  4.1046 +  thus "a' = b'" using 1 by auto
  4.1047 +qed
  4.1048 +
  4.1049 +
  4.1050 +lemma Partial_order_dir_image:
  4.1051 +"\<lbrakk>Partial_order r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> Partial_order (dir_image r f)"
  4.1052 +by (simp add: partial_order_on_def Preorder_dir_image antisym_dir_image)
  4.1053 +
  4.1054 +
  4.1055 +lemma Total_dir_image:
  4.1056 +assumes TOT: "Total r" and INJ: "inj_on f (Field r)"
  4.1057 +shows "Total(dir_image r f)"
  4.1058 +proof(unfold total_on_def, intro ballI impI)
  4.1059 +  fix a' b'
  4.1060 +  assume "a' \<in> Field (dir_image r f)" "b' \<in> Field (dir_image r f)"
  4.1061 +  then obtain a and b where 1: "a \<in> Field r \<and> b \<in> Field r \<and> f a = a' \<and> f b = b'"
  4.1062 +  using dir_image_Field[of r f] by blast
  4.1063 +  moreover assume "a' \<noteq> b'"
  4.1064 +  ultimately have "a \<noteq> b" using INJ unfolding inj_on_def by auto
  4.1065 +  hence "(a,b) \<in> r \<or> (b,a) \<in> r" using 1 TOT unfolding total_on_def by auto
  4.1066 +  thus "(a',b') \<in> dir_image r f \<or> (b',a') \<in> dir_image r f"
  4.1067 +  using 1 unfolding dir_image_def by auto
  4.1068 +qed
  4.1069 +
  4.1070 +
  4.1071 +lemma Linear_order_dir_image:
  4.1072 +"\<lbrakk>Linear_order r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> Linear_order (dir_image r f)"
  4.1073 +by (simp add: linear_order_on_def Partial_order_dir_image Total_dir_image)
  4.1074 +
  4.1075 +
  4.1076 +lemma wf_dir_image:
  4.1077 +assumes WF: "wf r" and INJ: "inj_on f (Field r)"
  4.1078 +shows "wf(dir_image r f)"
  4.1079 +proof(unfold wf_eq_minimal2, intro allI impI, elim conjE)
  4.1080 +  fix A'::"'b set"
  4.1081 +  assume SUB: "A' \<le> Field(dir_image r f)" and NE: "A' \<noteq> {}"
  4.1082 +  obtain A where A_def: "A = {a \<in> Field r. f a \<in> A'}" by blast
  4.1083 +  have "A \<noteq> {} \<and> A \<le> Field r"
  4.1084 +  using A_def dir_image_Field[of r f] SUB NE by blast
  4.1085 +  then obtain a where 1: "a \<in> A \<and> (\<forall>b \<in> A. (b,a) \<notin> r)"
  4.1086 +  using WF unfolding wf_eq_minimal2 by metis
  4.1087 +  have "\<forall>b' \<in> A'. (b',f a) \<notin> dir_image r f"
  4.1088 +  proof(clarify)
  4.1089 +    fix b' assume *: "b' \<in> A'" and **: "(b',f a) \<in> dir_image r f"
  4.1090 +    obtain b1 a1 where 2: "b' = f b1 \<and> f a = f a1" and
  4.1091 +                       3: "(b1,a1) \<in> r \<and> {a1,b1} \<le> Field r"
  4.1092 +    using ** unfolding dir_image_def Field_def by blast
  4.1093 +    hence "a = a1" using 1 A_def INJ unfolding inj_on_def by auto
  4.1094 +    hence "b1 \<in> A \<and> (b1,a) \<in> r" using 2 3 A_def * by auto
  4.1095 +    with 1 show False by auto
  4.1096 +  qed
  4.1097 +  thus "\<exists>a'\<in>A'. \<forall>b'\<in>A'. (b', a') \<notin> dir_image r f"
  4.1098 +  using A_def 1 by blast
  4.1099 +qed
  4.1100 +
  4.1101 +
  4.1102 +lemma Well_order_dir_image:
  4.1103 +"\<lbrakk>Well_order r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> Well_order (dir_image r f)"
  4.1104 +using assms unfolding well_order_on_def
  4.1105 +using Linear_order_dir_image[of r f] wf_dir_image[of "r - Id" f]
  4.1106 +  dir_image_minus_Id[of f r]
  4.1107 +  subset_inj_on[of f "Field r" "Field(r - Id)"]
  4.1108 +  mono_Field[of "r - Id" r] by auto
  4.1109 +
  4.1110 +
  4.1111 +lemma dir_image_Field2:
  4.1112 +"Refl r \<Longrightarrow> Field(dir_image r f) = f ` (Field r)"
  4.1113 +unfolding Field_def dir_image_def refl_on_def Domain_def Range_def by blast
  4.1114 +
  4.1115 +
  4.1116 +lemma dir_image_bij_betw:
  4.1117 +"\<lbrakk>Well_order r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> bij_betw f (Field r) (Field (dir_image r f))"
  4.1118 +unfolding bij_betw_def
  4.1119 +by (simp add: dir_image_Field2 order_on_defs)
  4.1120 +
  4.1121 +
  4.1122 +lemma dir_image_compat:
  4.1123 +"compat r (dir_image r f) f"
  4.1124 +unfolding compat_def dir_image_def by auto
  4.1125 +
  4.1126 +
  4.1127 +lemma dir_image_iso:
  4.1128 +"\<lbrakk>Well_order r; inj_on f (Field r)\<rbrakk>  \<Longrightarrow> iso r (dir_image r f) f"
  4.1129 +using iso_iff3 dir_image_compat dir_image_bij_betw Well_order_dir_image by blast
  4.1130 +
  4.1131 +
  4.1132 +lemma dir_image_ordIso:
  4.1133 +"\<lbrakk>Well_order r; inj_on f (Field r)\<rbrakk>  \<Longrightarrow> r =o dir_image r f"
  4.1134 +unfolding ordIso_def using dir_image_iso Well_order_dir_image by blast
  4.1135 +
  4.1136 +
  4.1137 +lemma Well_order_iso_copy:
  4.1138 +assumes WELL: "well_order_on A r" and BIJ: "bij_betw f A A'"
  4.1139 +shows "\<exists>r'. well_order_on A' r' \<and> r =o r'"
  4.1140 +proof-
  4.1141 +   let ?r' = "dir_image r f"
  4.1142 +   have 1: "A = Field r \<and> Well_order r"
  4.1143 +   using WELL well_order_on_Well_order by blast
  4.1144 +   hence 2: "iso r ?r' f"
  4.1145 +   using dir_image_iso using BIJ unfolding bij_betw_def by auto
  4.1146 +   hence "f ` (Field r) = Field ?r'" using 1 iso_iff[of r ?r'] by blast
  4.1147 +   hence "Field ?r' = A'"
  4.1148 +   using 1 BIJ unfolding bij_betw_def by auto
  4.1149 +   moreover have "Well_order ?r'"
  4.1150 +   using 1 Well_order_dir_image BIJ unfolding bij_betw_def by blast
  4.1151 +   ultimately show ?thesis unfolding ordIso_def using 1 2 by blast
  4.1152 +qed
  4.1153 +
  4.1154 +
  4.1155 +
  4.1156 +subsection {* Bounded square  *}
  4.1157 +
  4.1158 +
  4.1159 +text{* This construction essentially defines, for an order relation @{text "r"}, a lexicographic
  4.1160 +order @{text "bsqr r"} on @{text "(Field r) \<times> (Field r)"}, applying the
  4.1161 +following criteria (in this order):
  4.1162 +\begin{itemize}
  4.1163 +\item compare the maximums;
  4.1164 +\item compare the first components;
  4.1165 +\item compare the second components.
  4.1166 +\end{itemize}
  4.1167 +%
  4.1168 +The only application of this construction that we are aware of is
  4.1169 +at proving that the square of an infinite set has the same cardinal
  4.1170 +as that set. The essential property required there (and which is ensured by this
  4.1171 +construction) is that any proper order filter of the product order is included in a rectangle, i.e.,
  4.1172 +in a product of proper filters on the original relation (assumed to be a well-order). *}
  4.1173 +
  4.1174 +
  4.1175 +definition bsqr :: "'a rel => ('a * 'a)rel"
  4.1176 +where
  4.1177 +"bsqr r = {((a1,a2),(b1,b2)).
  4.1178 +           {a1,a2,b1,b2} \<le> Field r \<and>
  4.1179 +           (a1 = b1 \<and> a2 = b2 \<or>
  4.1180 +            (wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r - Id \<or>
  4.1181 +            wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> (a1,b1) \<in> r - Id \<or>
  4.1182 +            wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> a1 = b1  \<and> (a2,b2) \<in> r - Id
  4.1183 +           )}"
  4.1184 +
  4.1185 +
  4.1186 +lemma Field_bsqr:
  4.1187 +"Field (bsqr r) = Field r \<times> Field r"
  4.1188 +proof
  4.1189 +  show "Field (bsqr r) \<le> Field r \<times> Field r"
  4.1190 +  proof-
  4.1191 +    {fix a1 a2 assume "(a1,a2) \<in> Field (bsqr r)"
  4.1192 +     moreover
  4.1193 +     have "\<And> b1 b2. ((a1,a2),(b1,b2)) \<in> bsqr r \<or> ((b1,b2),(a1,a2)) \<in> bsqr r \<Longrightarrow>
  4.1194 +                      a1 \<in> Field r \<and> a2 \<in> Field r" unfolding bsqr_def by auto
  4.1195 +     ultimately have "a1 \<in> Field r \<and> a2 \<in> Field r" unfolding Field_def by auto
  4.1196 +    }
  4.1197 +    thus ?thesis unfolding Field_def by force
  4.1198 +  qed
  4.1199 +next
  4.1200 +  show "Field r \<times> Field r \<le> Field (bsqr r)"
  4.1201 +  proof(auto)
  4.1202 +    fix a1 a2 assume "a1 \<in> Field r" and "a2 \<in> Field r"
  4.1203 +    hence "((a1,a2),(a1,a2)) \<in> bsqr r" unfolding bsqr_def by blast
  4.1204 +    thus "(a1,a2) \<in> Field (bsqr r)" unfolding Field_def by auto
  4.1205 +  qed
  4.1206 +qed
  4.1207 +
  4.1208 +
  4.1209 +lemma bsqr_Refl: "Refl(bsqr r)"
  4.1210 +by(unfold refl_on_def Field_bsqr, auto simp add: bsqr_def)
  4.1211 +
  4.1212 +
  4.1213 +lemma bsqr_Trans:
  4.1214 +assumes "Well_order r"
  4.1215 +shows "trans (bsqr r)"
  4.1216 +proof(unfold trans_def, auto)
  4.1217 +  (* Preliminary facts *)
  4.1218 +  have Well: "wo_rel r" using assms wo_rel_def by auto
  4.1219 +  hence Trans: "trans r" using wo_rel.TRANS by auto
  4.1220 +  have Anti: "antisym r" using wo_rel.ANTISYM Well by auto
  4.1221 +  hence TransS: "trans(r - Id)" using Trans by (simp add: trans_diff_Id)
  4.1222 +  (* Main proof *)
  4.1223 +  fix a1 a2 b1 b2 c1 c2
  4.1224 +  assume *: "((a1,a2),(b1,b2)) \<in> bsqr r" and **: "((b1,b2),(c1,c2)) \<in> bsqr r"
  4.1225 +  hence 0: "{a1,a2,b1,b2,c1,c2} \<le> Field r" unfolding bsqr_def by auto
  4.1226 +  have 1: "a1 = b1 \<and> a2 = b2 \<or> (wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r - Id \<or>
  4.1227 +           wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> (a1,b1) \<in> r - Id \<or>
  4.1228 +           wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> a1 = b1 \<and> (a2,b2) \<in> r - Id"
  4.1229 +  using * unfolding bsqr_def by auto
  4.1230 +  have 2: "b1 = c1 \<and> b2 = c2 \<or> (wo_rel.max2 r b1 b2, wo_rel.max2 r c1 c2) \<in> r - Id \<or>
  4.1231 +           wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> (b1,c1) \<in> r - Id \<or>
  4.1232 +           wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> b1 = c1 \<and> (b2,c2) \<in> r - Id"
  4.1233 +  using ** unfolding bsqr_def by auto
  4.1234 +  show "((a1,a2),(c1,c2)) \<in> bsqr r"
  4.1235 +  proof-
  4.1236 +    {assume Case1: "a1 = b1 \<and> a2 = b2"
  4.1237 +     hence ?thesis using ** by simp
  4.1238 +    }
  4.1239 +    moreover
  4.1240 +    {assume Case2: "(wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r - Id"
  4.1241 +     {assume Case21: "b1 = c1 \<and> b2 = c2"
  4.1242 +      hence ?thesis using * by simp
  4.1243 +     }
  4.1244 +     moreover
  4.1245 +     {assume Case22: "(wo_rel.max2 r b1 b2, wo_rel.max2 r c1 c2) \<in> r - Id"
  4.1246 +      hence "(wo_rel.max2 r a1 a2, wo_rel.max2 r c1 c2) \<in> r - Id"
  4.1247 +      using Case2 TransS trans_def[of "r - Id"] by blast
  4.1248 +      hence ?thesis using 0 unfolding bsqr_def by auto
  4.1249 +     }
  4.1250 +     moreover
  4.1251 +     {assume Case23_4: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2"
  4.1252 +      hence ?thesis using Case2 0 unfolding bsqr_def by auto
  4.1253 +     }
  4.1254 +     ultimately have ?thesis using 0 2 by auto
  4.1255 +    }
  4.1256 +    moreover
  4.1257 +    {assume Case3: "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> (a1,b1) \<in> r - Id"
  4.1258 +     {assume Case31: "b1 = c1 \<and> b2 = c2"
  4.1259 +      hence ?thesis using * by simp
  4.1260 +     }
  4.1261 +     moreover
  4.1262 +     {assume Case32: "(wo_rel.max2 r b1 b2, wo_rel.max2 r c1 c2) \<in> r - Id"
  4.1263 +      hence ?thesis using Case3 0 unfolding bsqr_def by auto
  4.1264 +     }
  4.1265 +     moreover
  4.1266 +     {assume Case33: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> (b1,c1) \<in> r - Id"
  4.1267 +      hence "(a1,c1) \<in> r - Id"
  4.1268 +      using Case3 TransS trans_def[of "r - Id"] by blast
  4.1269 +      hence ?thesis using Case3 Case33 0 unfolding bsqr_def by auto
  4.1270 +     }
  4.1271 +     moreover
  4.1272 +     {assume Case33: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> b1 = c1"
  4.1273 +      hence ?thesis using Case3 0 unfolding bsqr_def by auto
  4.1274 +     }
  4.1275 +     ultimately have ?thesis using 0 2 by auto
  4.1276 +    }
  4.1277 +    moreover
  4.1278 +    {assume Case4: "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> a1 = b1 \<and> (a2,b2) \<in> r - Id"
  4.1279 +     {assume Case41: "b1 = c1 \<and> b2 = c2"
  4.1280 +      hence ?thesis using * by simp
  4.1281 +     }
  4.1282 +     moreover
  4.1283 +     {assume Case42: "(wo_rel.max2 r b1 b2, wo_rel.max2 r c1 c2) \<in> r - Id"
  4.1284 +      hence ?thesis using Case4 0 unfolding bsqr_def by force
  4.1285 +     }
  4.1286 +     moreover
  4.1287 +     {assume Case43: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> (b1,c1) \<in> r - Id"
  4.1288 +      hence ?thesis using Case4 0 unfolding bsqr_def by auto
  4.1289 +     }
  4.1290 +     moreover
  4.1291 +     {assume Case44: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> b1 = c1 \<and> (b2,c2) \<in> r - Id"
  4.1292 +      hence "(a2,c2) \<in> r - Id"
  4.1293 +      using Case4 TransS trans_def[of "r - Id"] by blast
  4.1294 +      hence ?thesis using Case4 Case44 0 unfolding bsqr_def by auto
  4.1295 +     }
  4.1296 +     ultimately have ?thesis using 0 2 by auto
  4.1297 +    }
  4.1298 +    ultimately show ?thesis using 0 1 by auto
  4.1299 +  qed
  4.1300 +qed
  4.1301 +
  4.1302 +
  4.1303 +lemma bsqr_antisym:
  4.1304 +assumes "Well_order r"
  4.1305 +shows "antisym (bsqr r)"
  4.1306 +proof(unfold antisym_def, clarify)
  4.1307 +  (* Preliminary facts *)
  4.1308 +  have Well: "wo_rel r" using assms wo_rel_def by auto
  4.1309 +  hence Trans: "trans r" using wo_rel.TRANS by auto
  4.1310 +  have Anti: "antisym r" using wo_rel.ANTISYM Well by auto
  4.1311 +  hence TransS: "trans(r - Id)" using Trans by (simp add: trans_diff_Id)
  4.1312 +  hence IrrS: "\<forall>a b. \<not>((a,b) \<in> r - Id \<and> (b,a) \<in> r - Id)"
  4.1313 +  using Anti trans_def[of "r - Id"] antisym_def[of "r - Id"] by blast
  4.1314 +  (* Main proof *)
  4.1315 +  fix a1 a2 b1 b2
  4.1316 +  assume *: "((a1,a2),(b1,b2)) \<in> bsqr r" and **: "((b1,b2),(a1,a2)) \<in> bsqr r"
  4.1317 +  hence 0: "{a1,a2,b1,b2} \<le> Field r" unfolding bsqr_def by auto
  4.1318 +  have 1: "a1 = b1 \<and> a2 = b2 \<or> (wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r - Id \<or>
  4.1319 +           wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> (a1,b1) \<in> r - Id \<or>
  4.1320 +           wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> a1 = b1 \<and> (a2,b2) \<in> r - Id"
  4.1321 +  using * unfolding bsqr_def by auto
  4.1322 +  have 2: "b1 = a1 \<and> b2 = a2 \<or> (wo_rel.max2 r b1 b2, wo_rel.max2 r a1 a2) \<in> r - Id \<or>
  4.1323 +           wo_rel.max2 r b1 b2 = wo_rel.max2 r a1 a2 \<and> (b1,a1) \<in> r - Id \<or>
  4.1324 +           wo_rel.max2 r b1 b2 = wo_rel.max2 r a1 a2 \<and> b1 = a1 \<and> (b2,a2) \<in> r - Id"
  4.1325 +  using ** unfolding bsqr_def by auto
  4.1326 +  show "a1 = b1 \<and> a2 = b2"
  4.1327 +  proof-
  4.1328 +    {assume Case1: "(wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r - Id"
  4.1329 +     {assume Case11: "(wo_rel.max2 r b1 b2, wo_rel.max2 r a1 a2) \<in> r - Id"
  4.1330 +      hence False using Case1 IrrS by blast
  4.1331 +     }
  4.1332 +     moreover
  4.1333 +     {assume Case12_3: "wo_rel.max2 r b1 b2 = wo_rel.max2 r a1 a2"
  4.1334 +      hence False using Case1 by auto
  4.1335 +     }
  4.1336 +     ultimately have ?thesis using 0 2 by auto
  4.1337 +    }
  4.1338 +    moreover
  4.1339 +    {assume Case2: "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> (a1,b1) \<in> r - Id"
  4.1340 +     {assume Case21: "(wo_rel.max2 r b1 b2, wo_rel.max2 r a1 a2) \<in> r - Id"
  4.1341 +       hence False using Case2 by auto
  4.1342 +     }
  4.1343 +     moreover
  4.1344 +     {assume Case22: "(b1,a1) \<in> r - Id"
  4.1345 +      hence False using Case2 IrrS by blast
  4.1346 +     }
  4.1347 +     moreover
  4.1348 +     {assume Case23: "b1 = a1"
  4.1349 +      hence False using Case2 by auto
  4.1350 +     }
  4.1351 +     ultimately have ?thesis using 0 2 by auto
  4.1352 +    }
  4.1353 +    moreover
  4.1354 +    {assume Case3: "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> a1 = b1 \<and> (a2,b2) \<in> r - Id"
  4.1355 +     moreover
  4.1356 +     {assume Case31: "(wo_rel.max2 r b1 b2, wo_rel.max2 r a1 a2) \<in> r - Id"
  4.1357 +      hence False using Case3 by auto
  4.1358 +     }
  4.1359 +     moreover
  4.1360 +     {assume Case32: "(b1,a1) \<in> r - Id"
  4.1361 +      hence False using Case3 by auto
  4.1362 +     }
  4.1363 +     moreover
  4.1364 +     {assume Case33: "(b2,a2) \<in> r - Id"
  4.1365 +      hence False using Case3 IrrS by blast
  4.1366 +     }
  4.1367 +     ultimately have ?thesis using 0 2 by auto
  4.1368 +    }
  4.1369 +    ultimately show ?thesis using 0 1 by blast
  4.1370 +  qed
  4.1371 +qed
  4.1372 +
  4.1373 +
  4.1374 +lemma bsqr_Total:
  4.1375 +assumes "Well_order r"
  4.1376 +shows "Total(bsqr r)"
  4.1377 +proof-
  4.1378 +  (* Preliminary facts *)
  4.1379 +  have Well: "wo_rel r" using assms wo_rel_def by auto
  4.1380 +  hence Total: "\<forall>a \<in> Field r. \<forall>b \<in> Field r. (a,b) \<in> r \<or> (b,a) \<in> r"
  4.1381 +  using wo_rel.TOTALS by auto
  4.1382 +  (* Main proof *)
  4.1383 +  {fix a1 a2 b1 b2 assume "{(a1,a2), (b1,b2)} \<le> Field(bsqr r)"
  4.1384 +   hence 0: "a1 \<in> Field r \<and> a2 \<in> Field r \<and> b1 \<in> Field r \<and> b2 \<in> Field r"
  4.1385 +   using Field_bsqr by blast
  4.1386 +   have "((a1,a2) = (b1,b2) \<or> ((a1,a2),(b1,b2)) \<in> bsqr r \<or> ((b1,b2),(a1,a2)) \<in> bsqr r)"
  4.1387 +   proof(rule wo_rel.cases_Total[of r a1 a2], clarsimp simp add: Well, simp add: 0)
  4.1388 +       (* Why didn't clarsimp simp add: Well 0 do the same job? *)
  4.1389 +     assume Case1: "(a1,a2) \<in> r"
  4.1390 +     hence 1: "wo_rel.max2 r a1 a2 = a2"
  4.1391 +     using Well 0 by (simp add: wo_rel.max2_equals2)
  4.1392 +     show ?thesis
  4.1393 +     proof(rule wo_rel.cases_Total[of r b1 b2], clarsimp simp add: Well, simp add: 0)
  4.1394 +       assume Case11: "(b1,b2) \<in> r"
  4.1395 +       hence 2: "wo_rel.max2 r b1 b2 = b2"
  4.1396 +       using Well 0 by (simp add: wo_rel.max2_equals2)
  4.1397 +       show ?thesis
  4.1398 +       proof(rule wo_rel.cases_Total3[of r a2 b2], clarsimp simp add: Well, simp add: 0)
  4.1399 +         assume Case111: "(a2,b2) \<in> r - Id \<or> (b2,a2) \<in> r - Id"
  4.1400 +         thus ?thesis using 0 1 2 unfolding bsqr_def by auto
  4.1401 +       next
  4.1402 +         assume Case112: "a2 = b2"
  4.1403 +         show ?thesis
  4.1404 +         proof(rule wo_rel.cases_Total3[of r a1 b1], clarsimp simp add: Well, simp add: 0)
  4.1405 +           assume Case1121: "(a1,b1) \<in> r - Id \<or> (b1,a1) \<in> r - Id"
  4.1406 +           thus ?thesis using 0 1 2 Case112 unfolding bsqr_def by auto
  4.1407 +         next
  4.1408 +           assume Case1122: "a1 = b1"
  4.1409 +           thus ?thesis using Case112 by auto
  4.1410 +         qed
  4.1411 +       qed
  4.1412 +     next
  4.1413 +       assume Case12: "(b2,b1) \<in> r"
  4.1414 +       hence 3: "wo_rel.max2 r b1 b2 = b1" using Well 0 by (simp add: wo_rel.max2_equals1)
  4.1415 +       show ?thesis
  4.1416 +       proof(rule wo_rel.cases_Total3[of r a2 b1], clarsimp simp add: Well, simp add: 0)
  4.1417 +         assume Case121: "(a2,b1) \<in> r - Id \<or> (b1,a2) \<in> r - Id"
  4.1418 +         thus ?thesis using 0 1 3 unfolding bsqr_def by auto
  4.1419 +       next
  4.1420 +         assume Case122: "a2 = b1"
  4.1421 +         show ?thesis
  4.1422 +         proof(rule wo_rel.cases_Total3[of r a1 b1], clarsimp simp add: Well, simp add: 0)
  4.1423 +           assume Case1221: "(a1,b1) \<in> r - Id \<or> (b1,a1) \<in> r - Id"
  4.1424 +           thus ?thesis using 0 1 3 Case122 unfolding bsqr_def by auto
  4.1425 +         next
  4.1426 +           assume Case1222: "a1 = b1"
  4.1427 +           show ?thesis
  4.1428 +           proof(rule wo_rel.cases_Total3[of r a2 b2], clarsimp simp add: Well, simp add: 0)
  4.1429 +             assume Case12221: "(a2,b2) \<in> r - Id \<or> (b2,a2) \<in> r - Id"
  4.1430 +             thus ?thesis using 0 1 3 Case122 Case1222 unfolding bsqr_def by auto
  4.1431 +           next
  4.1432 +             assume Case12222: "a2 = b2"
  4.1433 +             thus ?thesis using Case122 Case1222 by auto
  4.1434 +           qed
  4.1435 +         qed
  4.1436 +       qed
  4.1437 +     qed
  4.1438 +   next
  4.1439 +     assume Case2: "(a2,a1) \<in> r"
  4.1440 +     hence 1: "wo_rel.max2 r a1 a2 = a1" using Well 0 by (simp add: wo_rel.max2_equals1)
  4.1441 +     show ?thesis
  4.1442 +     proof(rule wo_rel.cases_Total[of r b1 b2], clarsimp simp add: Well, simp add: 0)
  4.1443 +       assume Case21: "(b1,b2) \<in> r"
  4.1444 +       hence 2: "wo_rel.max2 r b1 b2 = b2" using Well 0 by (simp add: wo_rel.max2_equals2)
  4.1445 +       show ?thesis
  4.1446 +       proof(rule wo_rel.cases_Total3[of r a1 b2], clarsimp simp add: Well, simp add: 0)
  4.1447 +         assume Case211: "(a1,b2) \<in> r - Id \<or> (b2,a1) \<in> r - Id"
  4.1448 +         thus ?thesis using 0 1 2 unfolding bsqr_def by auto
  4.1449 +       next
  4.1450 +         assume Case212: "a1 = b2"
  4.1451 +         show ?thesis
  4.1452 +         proof(rule wo_rel.cases_Total3[of r a1 b1], clarsimp simp add: Well, simp add: 0)
  4.1453 +           assume Case2121: "(a1,b1) \<in> r - Id \<or> (b1,a1) \<in> r - Id"
  4.1454 +           thus ?thesis using 0 1 2 Case212 unfolding bsqr_def by auto
  4.1455 +         next
  4.1456 +           assume Case2122: "a1 = b1"
  4.1457 +           show ?thesis
  4.1458 +           proof(rule wo_rel.cases_Total3[of r a2 b2], clarsimp simp add: Well, simp add: 0)
  4.1459 +             assume Case21221: "(a2,b2) \<in> r - Id \<or> (b2,a2) \<in> r - Id"
  4.1460 +             thus ?thesis using 0 1 2 Case212 Case2122 unfolding bsqr_def by auto
  4.1461 +           next
  4.1462 +             assume Case21222: "a2 = b2"
  4.1463 +             thus ?thesis using Case2122 Case212 by auto
  4.1464 +           qed
  4.1465 +         qed
  4.1466 +       qed
  4.1467 +     next
  4.1468 +       assume Case22: "(b2,b1) \<in> r"
  4.1469 +       hence 3: "wo_rel.max2 r b1 b2 = b1"  using Well 0 by (simp add: wo_rel.max2_equals1)
  4.1470 +       show ?thesis
  4.1471 +       proof(rule wo_rel.cases_Total3[of r a1 b1], clarsimp simp add: Well, simp add: 0)
  4.1472 +         assume Case221: "(a1,b1) \<in> r - Id \<or> (b1,a1) \<in> r - Id"
  4.1473 +         thus ?thesis using 0 1 3 unfolding bsqr_def by auto
  4.1474 +       next
  4.1475 +         assume Case222: "a1 = b1"
  4.1476 +         show ?thesis
  4.1477 +         proof(rule wo_rel.cases_Total3[of r a2 b2], clarsimp simp add: Well, simp add: 0)
  4.1478 +           assume Case2221: "(a2,b2) \<in> r - Id \<or> (b2,a2) \<in> r - Id"
  4.1479 +           thus ?thesis using 0 1 3 Case222 unfolding bsqr_def by auto
  4.1480 +         next
  4.1481 +           assume Case2222: "a2 = b2"
  4.1482 +           thus ?thesis using Case222 by auto
  4.1483 +         qed
  4.1484 +       qed
  4.1485 +     qed
  4.1486 +   qed
  4.1487 +  }
  4.1488 +  thus ?thesis unfolding total_on_def by fast
  4.1489 +qed
  4.1490 +
  4.1491 +
  4.1492 +lemma bsqr_Linear_order:
  4.1493 +assumes "Well_order r"
  4.1494 +shows "Linear_order(bsqr r)"
  4.1495 +unfolding order_on_defs
  4.1496 +using assms bsqr_Refl bsqr_Trans bsqr_antisym bsqr_Total by blast
  4.1497 +
  4.1498 +
  4.1499 +lemma bsqr_Well_order:
  4.1500 +assumes "Well_order r"
  4.1501 +shows "Well_order(bsqr r)"
  4.1502 +using assms
  4.1503 +proof(simp add: bsqr_Linear_order Linear_order_Well_order_iff, intro allI impI)
  4.1504 +  have 0: "\<forall>A \<le> Field r. A \<noteq> {} \<longrightarrow> (\<exists>a \<in> A. \<forall>a' \<in> A. (a,a') \<in> r)"
  4.1505 +  using assms well_order_on_def Linear_order_Well_order_iff by blast
  4.1506 +  fix D assume *: "D \<le> Field (bsqr r)" and **: "D \<noteq> {}"
  4.1507 +  hence 1: "D \<le> Field r \<times> Field r" unfolding Field_bsqr by simp
  4.1508 +  (*  *)
  4.1509 +  obtain M where M_def: "M = {wo_rel.max2 r a1 a2| a1 a2. (a1,a2) \<in> D}" by blast
  4.1510 +  have "M \<noteq> {}" using 1 M_def ** by auto
  4.1511 +  moreover
  4.1512 +  have "M \<le> Field r" unfolding M_def
  4.1513 +  using 1 assms wo_rel_def[of r] wo_rel.max2_among[of r] by fastforce
  4.1514 +  ultimately obtain m where m_min: "m \<in> M \<and> (\<forall>a \<in> M. (m,a) \<in> r)"
  4.1515 +  using 0 by blast
  4.1516 +  (*  *)
  4.1517 +  obtain A1 where A1_def: "A1 = {a1. \<exists>a2. (a1,a2) \<in> D \<and> wo_rel.max2 r a1 a2 = m}" by blast
  4.1518 +  have "A1 \<le> Field r" unfolding A1_def using 1 by auto
  4.1519 +  moreover have "A1 \<noteq> {}" unfolding A1_def using m_min unfolding M_def by blast
  4.1520 +  ultimately obtain a1 where a1_min: "a1 \<in> A1 \<and> (\<forall>a \<in> A1. (a1,a) \<in> r)"
  4.1521 +  using 0 by blast
  4.1522 +  (*  *)
  4.1523 +  obtain A2 where A2_def: "A2 = {a2. (a1,a2) \<in> D \<and> wo_rel.max2 r a1 a2 = m}" by blast
  4.1524 +  have "A2 \<le> Field r" unfolding A2_def using 1 by auto
  4.1525 +  moreover have "A2 \<noteq> {}" unfolding A2_def
  4.1526 +  using m_min a1_min unfolding A1_def M_def by blast
  4.1527 +  ultimately obtain a2 where a2_min: "a2 \<in> A2 \<and> (\<forall>a \<in> A2. (a2,a) \<in> r)"
  4.1528 +  using 0 by blast
  4.1529 +  (*   *)
  4.1530 +  have 2: "wo_rel.max2 r a1 a2 = m"
  4.1531 +  using a1_min a2_min unfolding A1_def A2_def by auto
  4.1532 +  have 3: "(a1,a2) \<in> D" using a2_min unfolding A2_def by auto
  4.1533 +  (*  *)
  4.1534 +  moreover
  4.1535 +  {fix b1 b2 assume ***: "(b1,b2) \<in> D"
  4.1536 +   hence 4: "{a1,a2,b1,b2} \<le> Field r" using 1 3 by blast
  4.1537 +   have 5: "(wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r"
  4.1538 +   using *** a1_min a2_min m_min unfolding A1_def A2_def M_def by auto
  4.1539 +   have "((a1,a2),(b1,b2)) \<in> bsqr r"
  4.1540 +   proof(cases "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2")
  4.1541 +     assume Case1: "wo_rel.max2 r a1 a2 \<noteq> wo_rel.max2 r b1 b2"
  4.1542 +     thus ?thesis unfolding bsqr_def using 4 5 by auto
  4.1543 +   next
  4.1544 +     assume Case2: "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2"
  4.1545 +     hence "b1 \<in> A1" unfolding A1_def using 2 *** by auto
  4.1546 +     hence 6: "(a1,b1) \<in> r" using a1_min by auto
  4.1547 +     show ?thesis
  4.1548 +     proof(cases "a1 = b1")
  4.1549 +       assume Case21: "a1 \<noteq> b1"
  4.1550 +       thus ?thesis unfolding bsqr_def using 4 Case2 6 by auto
  4.1551 +     next
  4.1552 +       assume Case22: "a1 = b1"
  4.1553 +       hence "b2 \<in> A2" unfolding A2_def using 2 *** Case2 by auto
  4.1554 +       hence 7: "(a2,b2) \<in> r" using a2_min by auto
  4.1555 +       thus ?thesis unfolding bsqr_def using 4 7 Case2 Case22 by auto
  4.1556 +     qed
  4.1557 +   qed
  4.1558 +  }
  4.1559 +  (*  *)
  4.1560 +  ultimately show "\<exists>d \<in> D. \<forall>d' \<in> D. (d,d') \<in> bsqr r" by fastforce
  4.1561 +qed
  4.1562 +
  4.1563 +
  4.1564 +lemma bsqr_max2:
  4.1565 +assumes WELL: "Well_order r" and LEQ: "((a1,a2),(b1,b2)) \<in> bsqr r"
  4.1566 +shows "(wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r"
  4.1567 +proof-
  4.1568 +  have "{(a1,a2),(b1,b2)} \<le> Field(bsqr r)"
  4.1569 +  using LEQ unfolding Field_def by auto
  4.1570 +  hence "{a1,a2,b1,b2} \<le> Field r" unfolding Field_bsqr by auto
  4.1571 +  hence "{wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2} \<le> Field r"
  4.1572 +  using WELL wo_rel_def[of r] wo_rel.max2_among[of r] by fastforce
  4.1573 +  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"
  4.1574 +  using LEQ unfolding bsqr_def by auto
  4.1575 +  ultimately show ?thesis using WELL unfolding order_on_defs refl_on_def by auto
  4.1576 +qed
  4.1577 +
  4.1578 +
  4.1579 +lemma bsqr_ofilter:
  4.1580 +assumes WELL: "Well_order r" and
  4.1581 +        OF: "wo_rel.ofilter (bsqr r) D" and SUB: "D < Field r \<times> Field r" and
  4.1582 +        NE: "\<not> (\<exists>a. Field r = under r a)"
  4.1583 +shows "\<exists>A. wo_rel.ofilter r A \<and> A < Field r \<and> D \<le> A \<times> A"
  4.1584 +proof-
  4.1585 +  let ?r' = "bsqr r"
  4.1586 +  have Well: "wo_rel r" using WELL wo_rel_def by blast
  4.1587 +  hence Trans: "trans r" using wo_rel.TRANS by blast
  4.1588 +  have Well': "Well_order ?r' \<and> wo_rel ?r'"
  4.1589 +  using WELL bsqr_Well_order wo_rel_def by blast
  4.1590 +  (*  *)
  4.1591 +  have "D < Field ?r'" unfolding Field_bsqr using SUB .
  4.1592 +  with OF obtain a1 and a2 where
  4.1593 +  "(a1,a2) \<in> Field ?r'" and 1: "D = underS ?r' (a1,a2)"
  4.1594 +  using Well' wo_rel.ofilter_underS_Field[of ?r' D] by auto
  4.1595 +  hence 2: "{a1,a2} \<le> Field r" unfolding Field_bsqr by auto
  4.1596 +  let ?m = "wo_rel.max2 r a1 a2"
  4.1597 +  have "D \<le> (under r ?m) \<times> (under r ?m)"
  4.1598 +  proof(unfold 1)
  4.1599 +    {fix b1 b2
  4.1600 +     let ?n = "wo_rel.max2 r b1 b2"
  4.1601 +     assume "(b1,b2) \<in> underS ?r' (a1,a2)"
  4.1602 +     hence 3: "((b1,b2),(a1,a2)) \<in> ?r'"
  4.1603 +     unfolding underS_def by blast
  4.1604 +     hence "(?n,?m) \<in> r" using WELL by (simp add: bsqr_max2)
  4.1605 +     moreover
  4.1606 +     {have "(b1,b2) \<in> Field ?r'" using 3 unfolding Field_def by auto
  4.1607 +      hence "{b1,b2} \<le> Field r" unfolding Field_bsqr by auto
  4.1608 +      hence "(b1,?n) \<in> r \<and> (b2,?n) \<in> r"
  4.1609 +      using Well by (simp add: wo_rel.max2_greater)
  4.1610 +     }
  4.1611 +     ultimately have "(b1,?m) \<in> r \<and> (b2,?m) \<in> r"
  4.1612 +     using Trans trans_def[of r] by blast
  4.1613 +     hence "(b1,b2) \<in> (under r ?m) \<times> (under r ?m)" unfolding under_def by simp}
  4.1614 +     thus "underS ?r' (a1,a2) \<le> (under r ?m) \<times> (under r ?m)" by auto
  4.1615 +  qed
  4.1616 +  moreover have "wo_rel.ofilter r (under r ?m)"
  4.1617 +  using Well by (simp add: wo_rel.under_ofilter)
  4.1618 +  moreover have "under r ?m < Field r"
  4.1619 +  using NE under_Field[of r ?m] by blast
  4.1620 +  ultimately show ?thesis by blast
  4.1621 +qed
  4.1622 +
  4.1623 +definition Func where
  4.1624 +"Func A B = {f . (\<forall> a \<in> A. f a \<in> B) \<and> (\<forall> a. a \<notin> A \<longrightarrow> f a = undefined)}"
  4.1625 +
  4.1626 +lemma Func_empty:
  4.1627 +"Func {} B = {\<lambda>x. undefined}"
  4.1628 +unfolding Func_def by auto
  4.1629 +
  4.1630 +lemma Func_elim:
  4.1631 +assumes "g \<in> Func A B" and "a \<in> A"
  4.1632 +shows "\<exists> b. b \<in> B \<and> g a = b"
  4.1633 +using assms unfolding Func_def by (cases "g a = undefined") auto
  4.1634 +
  4.1635 +definition curr where
  4.1636 +"curr A f \<equiv> \<lambda> a. if a \<in> A then \<lambda>b. f (a,b) else undefined"
  4.1637 +
  4.1638 +lemma curr_in:
  4.1639 +assumes f: "f \<in> Func (A <*> B) C"
  4.1640 +shows "curr A f \<in> Func A (Func B C)"
  4.1641 +using assms unfolding curr_def Func_def by auto
  4.1642 +
  4.1643 +lemma curr_inj:
  4.1644 +assumes "f1 \<in> Func (A <*> B) C" and "f2 \<in> Func (A <*> B) C"
  4.1645 +shows "curr A f1 = curr A f2 \<longleftrightarrow> f1 = f2"
  4.1646 +proof safe
  4.1647 +  assume c: "curr A f1 = curr A f2"
  4.1648 +  show "f1 = f2"
  4.1649 +  proof (rule ext, clarify)
  4.1650 +    fix a b show "f1 (a, b) = f2 (a, b)"
  4.1651 +    proof (cases "(a,b) \<in> A <*> B")
  4.1652 +      case False
  4.1653 +      thus ?thesis using assms unfolding Func_def by auto
  4.1654 +    next
  4.1655 +      case True hence a: "a \<in> A" and b: "b \<in> B" by auto
  4.1656 +      thus ?thesis
  4.1657 +      using c unfolding curr_def fun_eq_iff by(elim allE[of _ a]) simp
  4.1658 +    qed
  4.1659 +  qed
  4.1660 +qed
  4.1661 +
  4.1662 +lemma curr_surj:
  4.1663 +assumes "g \<in> Func A (Func B C)"
  4.1664 +shows "\<exists> f \<in> Func (A <*> B) C. curr A f = g"
  4.1665 +proof
  4.1666 +  let ?f = "\<lambda> ab. if fst ab \<in> A \<and> snd ab \<in> B then g (fst ab) (snd ab) else undefined"
  4.1667 +  show "curr A ?f = g"
  4.1668 +  proof (rule ext)
  4.1669 +    fix a show "curr A ?f a = g a"
  4.1670 +    proof (cases "a \<in> A")
  4.1671 +      case False
  4.1672 +      hence "g a = undefined" using assms unfolding Func_def by auto
  4.1673 +      thus ?thesis unfolding curr_def using False by simp
  4.1674 +    next
  4.1675 +      case True
  4.1676 +      obtain g1 where "g1 \<in> Func B C" and "g a = g1"
  4.1677 +      using assms using Func_elim[OF assms True] by blast
  4.1678 +      thus ?thesis using True unfolding Func_def curr_def by auto
  4.1679 +    qed
  4.1680 +  qed
  4.1681 +  show "?f \<in> Func (A <*> B) C" using assms unfolding Func_def mem_Collect_eq by auto
  4.1682 +qed
  4.1683 +
  4.1684 +lemma bij_betw_curr:
  4.1685 +"bij_betw (curr A) (Func (A <*> B) C) (Func A (Func B C))"
  4.1686 +unfolding bij_betw_def inj_on_def image_def
  4.1687 +apply (intro impI conjI ballI)
  4.1688 +apply (erule curr_inj[THEN iffD1], assumption+)
  4.1689 +apply auto
  4.1690 +apply (erule curr_in)
  4.1691 +using curr_surj by blast
  4.1692 +
  4.1693 +definition Func_map where
  4.1694 +"Func_map B2 f1 f2 g b2 \<equiv> if b2 \<in> B2 then f1 (g (f2 b2)) else undefined"
  4.1695 +
  4.1696 +lemma Func_map:
  4.1697 +assumes g: "g \<in> Func A2 A1" and f1: "f1 ` A1 \<subseteq> B1" and f2: "f2 ` B2 \<subseteq> A2"
  4.1698 +shows "Func_map B2 f1 f2 g \<in> Func B2 B1"
  4.1699 +using assms unfolding Func_def Func_map_def mem_Collect_eq by auto
  4.1700 +
  4.1701 +lemma Func_non_emp:
  4.1702 +assumes "B \<noteq> {}"
  4.1703 +shows "Func A B \<noteq> {}"
  4.1704 +proof-
  4.1705 +  obtain b where b: "b \<in> B" using assms by auto
  4.1706 +  hence "(\<lambda> a. if a \<in> A then b else undefined) \<in> Func A B" unfolding Func_def by auto
  4.1707 +  thus ?thesis by blast
  4.1708 +qed
  4.1709 +
  4.1710 +lemma Func_is_emp:
  4.1711 +"Func A B = {} \<longleftrightarrow> A \<noteq> {} \<and> B = {}" (is "?L \<longleftrightarrow> ?R")
  4.1712 +proof
  4.1713 +  assume L: ?L
  4.1714 +  moreover {assume "A = {}" hence False using L Func_empty by auto}
  4.1715 +  moreover {assume "B \<noteq> {}" hence False using L Func_non_emp by metis}
  4.1716 +  ultimately show ?R by blast
  4.1717 +next
  4.1718 +  assume R: ?R
  4.1719 +  moreover
  4.1720 +  {fix f assume "f \<in> Func A B"
  4.1721 +   moreover obtain a where "a \<in> A" using R by blast
  4.1722 +   ultimately obtain b where "b \<in> B" unfolding Func_def by blast
  4.1723 +   with R have False by blast
  4.1724 +  }
  4.1725 +  thus ?L by blast
  4.1726 +qed
  4.1727 +
  4.1728 +lemma Func_map_surj:
  4.1729 +assumes B1: "f1 ` A1 = B1" and A2: "inj_on f2 B2" "f2 ` B2 \<subseteq> A2"
  4.1730 +and B2A2: "B2 = {} \<Longrightarrow> A2 = {}"
  4.1731 +shows "Func B2 B1 = Func_map B2 f1 f2 ` Func A2 A1"
  4.1732 +proof(cases "B2 = {}")
  4.1733 +  case True
  4.1734 +  thus ?thesis using B2A2 by (auto simp: Func_empty Func_map_def)
  4.1735 +next
  4.1736 +  case False note B2 = False
  4.1737 +  show ?thesis
  4.1738 +  proof safe
  4.1739 +    fix h assume h: "h \<in> Func B2 B1"
  4.1740 +    def j1 \<equiv> "inv_into A1 f1"
  4.1741 +    have "\<forall> a2 \<in> f2 ` B2. \<exists> b2. b2 \<in> B2 \<and> f2 b2 = a2" by blast
  4.1742 +    then obtain k where k: "\<forall> a2 \<in> f2 ` B2. k a2 \<in> B2 \<and> f2 (k a2) = a2" by metis
  4.1743 +    {fix b2 assume b2: "b2 \<in> B2"
  4.1744 +     hence "f2 (k (f2 b2)) = f2 b2" using k A2(2) by auto
  4.1745 +     moreover have "k (f2 b2) \<in> B2" using b2 A2(2) k by auto
  4.1746 +     ultimately have "k (f2 b2) = b2" using b2 A2(1) unfolding inj_on_def by blast
  4.1747 +    } note kk = this
  4.1748 +    obtain b22 where b22: "b22 \<in> B2" using B2 by auto
  4.1749 +    def j2 \<equiv> "\<lambda> a2. if a2 \<in> f2 ` B2 then k a2 else b22"
  4.1750 +    have j2A2: "j2 ` A2 \<subseteq> B2" unfolding j2_def using k b22 by auto
  4.1751 +    have j2: "\<And> b2. b2 \<in> B2 \<Longrightarrow> j2 (f2 b2) = b2"
  4.1752 +    using kk unfolding j2_def by auto
  4.1753 +    def g \<equiv> "Func_map A2 j1 j2 h"
  4.1754 +    have "Func_map B2 f1 f2 g = h"
  4.1755 +    proof (rule ext)
  4.1756 +      fix b2 show "Func_map B2 f1 f2 g b2 = h b2"
  4.1757 +      proof(cases "b2 \<in> B2")
  4.1758 +        case True
  4.1759 +        show ?thesis
  4.1760 +        proof (cases "h b2 = undefined")
  4.1761 +          case True
  4.1762 +          hence b1: "h b2 \<in> f1 ` A1" using h `b2 \<in> B2` unfolding B1 Func_def by auto
  4.1763 +          show ?thesis using A2 f_inv_into_f[OF b1]
  4.1764 +            unfolding True g_def Func_map_def j1_def j2[OF `b2 \<in> B2`] by auto
  4.1765 +        qed(insert A2 True j2[OF True] h B1, unfold j1_def g_def Func_def Func_map_def,
  4.1766 +          auto intro: f_inv_into_f)
  4.1767 +      qed(insert h, unfold Func_def Func_map_def, auto)
  4.1768 +    qed
  4.1769 +    moreover have "g \<in> Func A2 A1" unfolding g_def apply(rule Func_map[OF h])
  4.1770 +    using inv_into_into j2A2 B1 A2 inv_into_into
  4.1771 +    unfolding j1_def image_def by fast+
  4.1772 +    ultimately show "h \<in> Func_map B2 f1 f2 ` Func A2 A1"
  4.1773 +    unfolding Func_map_def[abs_def] unfolding image_def by auto
  4.1774 +  qed(insert B1 Func_map[OF _ _ A2(2)], auto)
  4.1775 +qed
  4.1776 +
  4.1777 +end
     5.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     5.2 +++ b/src/HOL/BNF_Wellorder_Embedding.thy	Mon Jan 20 18:24:55 2014 +0100
     5.3 @@ -0,0 +1,1145 @@
     5.4 +(*  Title:      HOL/BNF_Wellorder_Embedding.thy
     5.5 +    Author:     Andrei Popescu, TU Muenchen
     5.6 +    Copyright   2012
     5.7 +
     5.8 +Well-order embeddings (BNF).
     5.9 +*)
    5.10 +
    5.11 +header {* Well-Order Embeddings (BNF) *}
    5.12 +
    5.13 +theory BNF_Wellorder_Embedding
    5.14 +imports Zorn BNF_Wellorder_Relation
    5.15 +begin
    5.16 +
    5.17 +
    5.18 +text{* In this section, we introduce well-order {\em embeddings} and {\em isomorphisms} and
    5.19 +prove their basic properties.  The notion of embedding is considered from the point
    5.20 +of view of the theory of ordinals, and therefore requires the source to be injected
    5.21 +as an {\em initial segment} (i.e., {\em order filter}) of the target.  A main result
    5.22 +of this section is the existence of embeddings (in one direction or another) between
    5.23 +any two well-orders, having as a consequence the fact that, given any two sets on
    5.24 +any two types, one is smaller than (i.e., can be injected into) the other. *}
    5.25 +
    5.26 +
    5.27 +subsection {* Auxiliaries *}
    5.28 +
    5.29 +lemma UNION_inj_on_ofilter:
    5.30 +assumes WELL: "Well_order r" and
    5.31 +        OF: "\<And> i. i \<in> I \<Longrightarrow> wo_rel.ofilter r (A i)" and
    5.32 +       INJ: "\<And> i. i \<in> I \<Longrightarrow> inj_on f (A i)"
    5.33 +shows "inj_on f (\<Union> i \<in> I. A i)"
    5.34 +proof-
    5.35 +  have "wo_rel r" using WELL by (simp add: wo_rel_def)
    5.36 +  hence "\<And> i j. \<lbrakk>i \<in> I; j \<in> I\<rbrakk> \<Longrightarrow> A i <= A j \<or> A j <= A i"
    5.37 +  using wo_rel.ofilter_linord[of r] OF by blast
    5.38 +  with WELL INJ show ?thesis
    5.39 +  by (auto simp add: inj_on_UNION_chain)
    5.40 +qed
    5.41 +
    5.42 +
    5.43 +lemma under_underS_bij_betw:
    5.44 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and
    5.45 +        IN: "a \<in> Field r" and IN': "f a \<in> Field r'" and
    5.46 +        BIJ: "bij_betw f (underS r a) (underS r' (f a))"
    5.47 +shows "bij_betw f (under r a) (under r' (f a))"
    5.48 +proof-
    5.49 +  have "a \<notin> underS r a \<and> f a \<notin> underS r' (f a)"
    5.50 +  unfolding underS_def by auto
    5.51 +  moreover
    5.52 +  {have "Refl r \<and> Refl r'" using WELL WELL'
    5.53 +   by (auto simp add: order_on_defs)
    5.54 +   hence "under r a = underS r a \<union> {a} \<and>
    5.55 +          under r' (f a) = underS r' (f a) \<union> {f a}"
    5.56 +   using IN IN' by(auto simp add: Refl_under_underS)
    5.57 +  }
    5.58 +  ultimately show ?thesis
    5.59 +  using BIJ notIn_Un_bij_betw[of a "underS r a" f "underS r' (f a)"] by auto
    5.60 +qed
    5.61 +
    5.62 +
    5.63 +
    5.64 +subsection {* (Well-order) embeddings, strict embeddings, isomorphisms and order-compatible
    5.65 +functions  *}
    5.66 +
    5.67 +
    5.68 +text{* Standardly, a function is an embedding of a well-order in another if it injectively and
    5.69 +order-compatibly maps the former into an order filter of the latter.
    5.70 +Here we opt for a more succinct definition (operator @{text "embed"}),
    5.71 +asking that, for any element in the source, the function should be a bijection
    5.72 +between the set of strict lower bounds of that element
    5.73 +and the set of strict lower bounds of its image.  (Later we prove equivalence with
    5.74 +the standard definition -- lemma @{text "embed_iff_compat_inj_on_ofilter"}.)
    5.75 +A {\em strict embedding} (operator @{text "embedS"})  is a non-bijective embedding
    5.76 +and an isomorphism (operator @{text "iso"}) is a bijective embedding.   *}
    5.77 +
    5.78 +
    5.79 +definition embed :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> ('a \<Rightarrow> 'a') \<Rightarrow> bool"
    5.80 +where
    5.81 +"embed r r' f \<equiv> \<forall>a \<in> Field r. bij_betw f (under r a) (under r' (f a))"
    5.82 +
    5.83 +
    5.84 +lemmas embed_defs = embed_def embed_def[abs_def]
    5.85 +
    5.86 +
    5.87 +text {* Strict embeddings: *}
    5.88 +
    5.89 +definition embedS :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> ('a \<Rightarrow> 'a') \<Rightarrow> bool"
    5.90 +where
    5.91 +"embedS r r' f \<equiv> embed r r' f \<and> \<not> bij_betw f (Field r) (Field r')"
    5.92 +
    5.93 +
    5.94 +lemmas embedS_defs = embedS_def embedS_def[abs_def]
    5.95 +
    5.96 +
    5.97 +definition iso :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> ('a \<Rightarrow> 'a') \<Rightarrow> bool"
    5.98 +where
    5.99 +"iso r r' f \<equiv> embed r r' f \<and> bij_betw f (Field r) (Field r')"
   5.100 +
   5.101 +
   5.102 +lemmas iso_defs = iso_def iso_def[abs_def]
   5.103 +
   5.104 +
   5.105 +definition compat :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> ('a \<Rightarrow> 'a') \<Rightarrow> bool"
   5.106 +where
   5.107 +"compat r r' f \<equiv> \<forall>a b. (a,b) \<in> r \<longrightarrow> (f a, f b) \<in> r'"
   5.108 +
   5.109 +
   5.110 +lemma compat_wf:
   5.111 +assumes CMP: "compat r r' f" and WF: "wf r'"
   5.112 +shows "wf r"
   5.113 +proof-
   5.114 +  have "r \<le> inv_image r' f"
   5.115 +  unfolding inv_image_def using CMP
   5.116 +  by (auto simp add: compat_def)
   5.117 +  with WF show ?thesis
   5.118 +  using wf_inv_image[of r' f] wf_subset[of "inv_image r' f"] by auto
   5.119 +qed
   5.120 +
   5.121 +
   5.122 +lemma id_embed: "embed r r id"
   5.123 +by(auto simp add: id_def embed_def bij_betw_def)
   5.124 +
   5.125 +
   5.126 +lemma id_iso: "iso r r id"
   5.127 +by(auto simp add: id_def embed_def iso_def bij_betw_def)
   5.128 +
   5.129 +
   5.130 +lemma embed_in_Field:
   5.131 +assumes WELL: "Well_order r" and
   5.132 +        EMB: "embed r r' f" and IN: "a \<in> Field r"
   5.133 +shows "f a \<in> Field r'"
   5.134 +proof-
   5.135 +  have Well: "wo_rel r"
   5.136 +  using WELL by (auto simp add: wo_rel_def)
   5.137 +  hence 1: "Refl r"
   5.138 +  by (auto simp add: wo_rel.REFL)
   5.139 +  hence "a \<in> under r a" using IN Refl_under_in by fastforce
   5.140 +  hence "f a \<in> under r' (f a)"
   5.141 +  using EMB IN by (auto simp add: embed_def bij_betw_def)
   5.142 +  thus ?thesis unfolding Field_def
   5.143 +  by (auto simp: under_def)
   5.144 +qed
   5.145 +
   5.146 +
   5.147 +lemma comp_embed:
   5.148 +assumes WELL: "Well_order r" and
   5.149 +        EMB: "embed r r' f" and EMB': "embed r' r'' f'"
   5.150 +shows "embed r r'' (f' o f)"
   5.151 +proof(unfold embed_def, auto)
   5.152 +  fix a assume *: "a \<in> Field r"
   5.153 +  hence "bij_betw f (under r a) (under r' (f a))"
   5.154 +  using embed_def[of r] EMB by auto
   5.155 +  moreover
   5.156 +  {have "f a \<in> Field r'"
   5.157 +   using EMB WELL * by (auto simp add: embed_in_Field)
   5.158 +   hence "bij_betw f' (under r' (f a)) (under r'' (f' (f a)))"
   5.159 +   using embed_def[of r'] EMB' by auto
   5.160 +  }
   5.161 +  ultimately
   5.162 +  show "bij_betw (f' \<circ> f) (under r a) (under r'' (f'(f a)))"
   5.163 +  by(auto simp add: bij_betw_trans)
   5.164 +qed
   5.165 +
   5.166 +
   5.167 +lemma comp_iso:
   5.168 +assumes WELL: "Well_order r" and
   5.169 +        EMB: "iso r r' f" and EMB': "iso r' r'' f'"
   5.170 +shows "iso r r'' (f' o f)"
   5.171 +using assms unfolding iso_def
   5.172 +by (auto simp add: comp_embed bij_betw_trans)
   5.173 +
   5.174 +
   5.175 +text{* That @{text "embedS"} is also preserved by function composition shall be proved only later.  *}
   5.176 +
   5.177 +
   5.178 +lemma embed_Field:
   5.179 +"\<lbrakk>Well_order r; embed r r' f\<rbrakk> \<Longrightarrow> f`(Field r) \<le> Field r'"
   5.180 +by (auto simp add: embed_in_Field)
   5.181 +
   5.182 +
   5.183 +lemma embed_preserves_ofilter:
   5.184 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and
   5.185 +        EMB: "embed r r' f" and OF: "wo_rel.ofilter r A"
   5.186 +shows "wo_rel.ofilter r' (f`A)"
   5.187 +proof-
   5.188 +  (* Preliminary facts *)
   5.189 +  from WELL have Well: "wo_rel r" unfolding wo_rel_def .
   5.190 +  from WELL' have Well': "wo_rel r'" unfolding wo_rel_def .
   5.191 +  from OF have 0: "A \<le> Field r" by(auto simp add: Well wo_rel.ofilter_def)
   5.192 +  (* Main proof *)
   5.193 +  show ?thesis  using Well' WELL EMB 0 embed_Field[of r r' f]
   5.194 +  proof(unfold wo_rel.ofilter_def, auto simp add: image_def)
   5.195 +    fix a b'
   5.196 +    assume *: "a \<in> A" and **: "b' \<in> under r' (f a)"
   5.197 +    hence "a \<in> Field r" using 0 by auto
   5.198 +    hence "bij_betw f (under r a) (under r' (f a))"
   5.199 +    using * EMB by (auto simp add: embed_def)
   5.200 +    hence "f`(under r a) = under r' (f a)"
   5.201 +    by (simp add: bij_betw_def)
   5.202 +    with ** image_def[of f "under r a"] obtain b where
   5.203 +    1: "b \<in> under r a \<and> b' = f b" by blast
   5.204 +    hence "b \<in> A" using Well * OF
   5.205 +    by (auto simp add: wo_rel.ofilter_def)
   5.206 +    with 1 show "\<exists>b \<in> A. b' = f b" by blast
   5.207 +  qed
   5.208 +qed
   5.209 +
   5.210 +
   5.211 +lemma embed_Field_ofilter:
   5.212 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and
   5.213 +        EMB: "embed r r' f"
   5.214 +shows "wo_rel.ofilter r' (f`(Field r))"
   5.215 +proof-
   5.216 +  have "wo_rel.ofilter r (Field r)"
   5.217 +  using WELL by (auto simp add: wo_rel_def wo_rel.Field_ofilter)
   5.218 +  with WELL WELL' EMB
   5.219 +  show ?thesis by (auto simp add: embed_preserves_ofilter)
   5.220 +qed
   5.221 +
   5.222 +
   5.223 +lemma embed_compat:
   5.224 +assumes EMB: "embed r r' f"
   5.225 +shows "compat r r' f"
   5.226 +proof(unfold compat_def, clarify)
   5.227 +  fix a b
   5.228 +  assume *: "(a,b) \<in> r"
   5.229 +  hence 1: "b \<in> Field r" using Field_def[of r] by blast
   5.230 +  have "a \<in> under r b"
   5.231 +  using * under_def[of r] by simp
   5.232 +  hence "f a \<in> under r' (f b)"
   5.233 +  using EMB embed_def[of r r' f]
   5.234 +        bij_betw_def[of f "under r b" "under r' (f b)"]
   5.235 +        image_def[of f "under r b"] 1 by auto
   5.236 +  thus "(f a, f b) \<in> r'"
   5.237 +  by (auto simp add: under_def)
   5.238 +qed
   5.239 +
   5.240 +
   5.241 +lemma embed_inj_on:
   5.242 +assumes WELL: "Well_order r" and EMB: "embed r r' f"
   5.243 +shows "inj_on f (Field r)"
   5.244 +proof(unfold inj_on_def, clarify)
   5.245 +  (* Preliminary facts *)
   5.246 +  from WELL have Well: "wo_rel r" unfolding wo_rel_def .
   5.247 +  with wo_rel.TOTAL[of r]
   5.248 +  have Total: "Total r" by simp
   5.249 +  from Well wo_rel.REFL[of r]
   5.250 +  have Refl: "Refl r" by simp
   5.251 +  (* Main proof *)
   5.252 +  fix a b
   5.253 +  assume *: "a \<in> Field r" and **: "b \<in> Field r" and
   5.254 +         ***: "f a = f b"
   5.255 +  hence 1: "a \<in> Field r \<and> b \<in> Field r"
   5.256 +  unfolding Field_def by auto
   5.257 +  {assume "(a,b) \<in> r"
   5.258 +   hence "a \<in> under r b \<and> b \<in> under r b"
   5.259 +   using Refl by(auto simp add: under_def refl_on_def)
   5.260 +   hence "a = b"
   5.261 +   using EMB 1 ***
   5.262 +   by (auto simp add: embed_def bij_betw_def inj_on_def)
   5.263 +  }
   5.264 +  moreover
   5.265 +  {assume "(b,a) \<in> r"
   5.266 +   hence "a \<in> under r a \<and> b \<in> under r a"
   5.267 +   using Refl by(auto simp add: under_def refl_on_def)
   5.268 +   hence "a = b"
   5.269 +   using EMB 1 ***
   5.270 +   by (auto simp add: embed_def bij_betw_def inj_on_def)
   5.271 +  }
   5.272 +  ultimately
   5.273 +  show "a = b" using Total 1
   5.274 +  by (auto simp add: total_on_def)
   5.275 +qed
   5.276 +
   5.277 +
   5.278 +lemma embed_underS:
   5.279 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and
   5.280 +        EMB: "embed r r' f" and IN: "a \<in> Field r"
   5.281 +shows "bij_betw f (underS r a) (underS r' (f a))"
   5.282 +proof-
   5.283 +  have "bij_betw f (under r a) (under r' (f a))"
   5.284 +  using assms by (auto simp add: embed_def)
   5.285 +  moreover
   5.286 +  {have "f a \<in> Field r'" using assms  embed_Field[of r r' f] by auto
   5.287 +   hence "under r a = underS r a \<union> {a} \<and>
   5.288 +          under r' (f a) = underS r' (f a) \<union> {f a}"
   5.289 +   using assms by (auto simp add: order_on_defs Refl_under_underS)
   5.290 +  }
   5.291 +  moreover
   5.292 +  {have "a \<notin> underS r a \<and> f a \<notin> underS r' (f a)"
   5.293 +   unfolding underS_def by blast
   5.294 +  }
   5.295 +  ultimately show ?thesis
   5.296 +  by (auto simp add: notIn_Un_bij_betw3)
   5.297 +qed
   5.298 +
   5.299 +
   5.300 +lemma embed_iff_compat_inj_on_ofilter:
   5.301 +assumes WELL: "Well_order r" and WELL': "Well_order r'"
   5.302 +shows "embed r r' f = (compat r r' f \<and> inj_on f (Field r) \<and> wo_rel.ofilter r' (f`(Field r)))"
   5.303 +using assms
   5.304 +proof(auto simp add: embed_compat embed_inj_on embed_Field_ofilter,
   5.305 +      unfold embed_def, auto) (* get rid of one implication *)
   5.306 +  fix a
   5.307 +  assume *: "inj_on f (Field r)" and
   5.308 +         **: "compat r r' f" and
   5.309 +         ***: "wo_rel.ofilter r' (f`(Field r))" and
   5.310 +         ****: "a \<in> Field r"
   5.311 +  (* Preliminary facts *)
   5.312 +  have Well: "wo_rel r"
   5.313 +  using WELL wo_rel_def[of r] by simp
   5.314 +  hence Refl: "Refl r"
   5.315 +  using wo_rel.REFL[of r] by simp
   5.316 +  have Total: "Total r"
   5.317 +  using Well wo_rel.TOTAL[of r] by simp
   5.318 +  have Well': "wo_rel r'"
   5.319 +  using WELL' wo_rel_def[of r'] by simp
   5.320 +  hence Antisym': "antisym r'"
   5.321 +  using wo_rel.ANTISYM[of r'] by simp
   5.322 +  have "(a,a) \<in> r"
   5.323 +  using **** Well wo_rel.REFL[of r]
   5.324 +        refl_on_def[of _ r] by auto
   5.325 +  hence "(f a, f a) \<in> r'"
   5.326 +  using ** by(auto simp add: compat_def)
   5.327 +  hence 0: "f a \<in> Field r'"
   5.328 +  unfolding Field_def by auto
   5.329 +  have "f a \<in> f`(Field r)"
   5.330 +  using **** by auto
   5.331 +  hence 2: "under r' (f a) \<le> f`(Field r)"
   5.332 +  using Well' *** wo_rel.ofilter_def[of r' "f`(Field r)"] by fastforce
   5.333 +  (* Main proof *)
   5.334 +  show "bij_betw f (under r a) (under r' (f a))"
   5.335 +  proof(unfold bij_betw_def, auto)
   5.336 +    show  "inj_on f (under r a)"
   5.337 +    using * by (metis (no_types) under_Field subset_inj_on)
   5.338 +  next
   5.339 +    fix b assume "b \<in> under r a"
   5.340 +    thus "f b \<in> under r' (f a)"
   5.341 +    unfolding under_def using **
   5.342 +    by (auto simp add: compat_def)
   5.343 +  next
   5.344 +    fix b' assume *****: "b' \<in> under r' (f a)"
   5.345 +    hence "b' \<in> f`(Field r)"
   5.346 +    using 2 by auto
   5.347 +    with Field_def[of r] obtain b where
   5.348 +    3: "b \<in> Field r" and 4: "b' = f b" by auto
   5.349 +    have "(b,a): r"
   5.350 +    proof-
   5.351 +      {assume "(a,b) \<in> r"
   5.352 +       with ** 4 have "(f a, b'): r'"
   5.353 +       by (auto simp add: compat_def)
   5.354 +       with ***** Antisym' have "f a = b'"
   5.355 +       by(auto simp add: under_def antisym_def)
   5.356 +       with 3 **** 4 * have "a = b"
   5.357 +       by(auto simp add: inj_on_def)
   5.358 +      }
   5.359 +      moreover
   5.360 +      {assume "a = b"
   5.361 +       hence "(b,a) \<in> r" using Refl **** 3
   5.362 +       by (auto simp add: refl_on_def)
   5.363 +      }
   5.364 +      ultimately
   5.365 +      show ?thesis using Total **** 3 by (fastforce simp add: total_on_def)
   5.366 +    qed
   5.367 +    with 4 show  "b' \<in> f`(under r a)"
   5.368 +    unfolding under_def by auto
   5.369 +  qed
   5.370 +qed
   5.371 +
   5.372 +
   5.373 +lemma inv_into_ofilter_embed:
   5.374 +assumes WELL: "Well_order r" and OF: "wo_rel.ofilter r A" and
   5.375 +        BIJ: "\<forall>b \<in> A. bij_betw f (under r b) (under r' (f b))" and
   5.376 +        IMAGE: "f ` A = Field r'"
   5.377 +shows "embed r' r (inv_into A f)"
   5.378 +proof-
   5.379 +  (* Preliminary facts *)
   5.380 +  have Well: "wo_rel r"
   5.381 +  using WELL wo_rel_def[of r] by simp
   5.382 +  have Refl: "Refl r"
   5.383 +  using Well wo_rel.REFL[of r] by simp
   5.384 +  have Total: "Total r"
   5.385 +  using Well wo_rel.TOTAL[of r] by simp
   5.386 +  (* Main proof *)
   5.387 +  have 1: "bij_betw f A (Field r')"
   5.388 +  proof(unfold bij_betw_def inj_on_def, auto simp add: IMAGE)
   5.389 +    fix b1 b2
   5.390 +    assume *: "b1 \<in> A" and **: "b2 \<in> A" and
   5.391 +           ***: "f b1 = f b2"
   5.392 +    have 11: "b1 \<in> Field r \<and> b2 \<in> Field r"
   5.393 +    using * ** Well OF by (auto simp add: wo_rel.ofilter_def)
   5.394 +    moreover
   5.395 +    {assume "(b1,b2) \<in> r"
   5.396 +     hence "b1 \<in> under r b2 \<and> b2 \<in> under r b2"
   5.397 +     unfolding under_def using 11 Refl
   5.398 +     by (auto simp add: refl_on_def)
   5.399 +     hence "b1 = b2" using BIJ * ** ***
   5.400 +     by (simp add: bij_betw_def inj_on_def)
   5.401 +    }
   5.402 +    moreover
   5.403 +     {assume "(b2,b1) \<in> r"
   5.404 +     hence "b1 \<in> under r b1 \<and> b2 \<in> under r b1"
   5.405 +     unfolding under_def using 11 Refl
   5.406 +     by (auto simp add: refl_on_def)
   5.407 +     hence "b1 = b2" using BIJ * ** ***
   5.408 +     by (simp add: bij_betw_def inj_on_def)
   5.409 +    }
   5.410 +    ultimately
   5.411 +    show "b1 = b2"
   5.412 +    using Total by (auto simp add: total_on_def)
   5.413 +  qed
   5.414 +  (*  *)
   5.415 +  let ?f' = "(inv_into A f)"
   5.416 +  (*  *)
   5.417 +  have 2: "\<forall>b \<in> A. bij_betw ?f' (under r' (f b)) (under r b)"
   5.418 +  proof(clarify)
   5.419 +    fix b assume *: "b \<in> A"
   5.420 +    hence "under r b \<le> A"
   5.421 +    using Well OF by(auto simp add: wo_rel.ofilter_def)
   5.422 +    moreover
   5.423 +    have "f ` (under r b) = under r' (f b)"
   5.424 +    using * BIJ by (auto simp add: bij_betw_def)
   5.425 +    ultimately
   5.426 +    show "bij_betw ?f' (under r' (f b)) (under r b)"
   5.427 +    using 1 by (auto simp add: bij_betw_inv_into_subset)
   5.428 +  qed
   5.429 +  (*  *)
   5.430 +  have 3: "\<forall>b' \<in> Field r'. bij_betw ?f' (under r' b') (under r (?f' b'))"
   5.431 +  proof(clarify)
   5.432 +    fix b' assume *: "b' \<in> Field r'"
   5.433 +    have "b' = f (?f' b')" using * 1
   5.434 +    by (auto simp add: bij_betw_inv_into_right)
   5.435 +    moreover
   5.436 +    {obtain b where 31: "b \<in> A" and "f b = b'" using IMAGE * by force
   5.437 +     hence "?f' b' = b" using 1 by (auto simp add: bij_betw_inv_into_left)
   5.438 +     with 31 have "?f' b' \<in> A" by auto
   5.439 +    }
   5.440 +    ultimately
   5.441 +    show  "bij_betw ?f' (under r' b') (under r (?f' b'))"
   5.442 +    using 2 by auto
   5.443 +  qed
   5.444 +  (*  *)
   5.445 +  thus ?thesis unfolding embed_def .
   5.446 +qed
   5.447 +
   5.448 +
   5.449 +lemma inv_into_underS_embed:
   5.450 +assumes WELL: "Well_order r" and
   5.451 +        BIJ: "\<forall>b \<in> underS r a. bij_betw f (under r b) (under r' (f b))" and
   5.452 +        IN: "a \<in> Field r" and
   5.453 +        IMAGE: "f ` (underS r a) = Field r'"
   5.454 +shows "embed r' r (inv_into (underS r a) f)"
   5.455 +using assms
   5.456 +by(auto simp add: wo_rel_def wo_rel.underS_ofilter inv_into_ofilter_embed)
   5.457 +
   5.458 +
   5.459 +lemma inv_into_Field_embed:
   5.460 +assumes WELL: "Well_order r" and EMB: "embed r r' f" and
   5.461 +        IMAGE: "Field r' \<le> f ` (Field r)"
   5.462 +shows "embed r' r (inv_into (Field r) f)"
   5.463 +proof-
   5.464 +  have "(\<forall>b \<in> Field r. bij_betw f (under r b) (under r' (f b)))"
   5.465 +  using EMB by (auto simp add: embed_def)
   5.466 +  moreover
   5.467 +  have "f ` (Field r) \<le> Field r'"
   5.468 +  using EMB WELL by (auto simp add: embed_Field)
   5.469 +  ultimately
   5.470 +  show ?thesis using assms
   5.471 +  by(auto simp add: wo_rel_def wo_rel.Field_ofilter inv_into_ofilter_embed)
   5.472 +qed
   5.473 +
   5.474 +
   5.475 +lemma inv_into_Field_embed_bij_betw:
   5.476 +assumes WELL: "Well_order r" and
   5.477 +        EMB: "embed r r' f" and BIJ: "bij_betw f (Field r) (Field r')"
   5.478 +shows "embed r' r (inv_into (Field r) f)"
   5.479 +proof-
   5.480 +  have "Field r' \<le> f ` (Field r)"
   5.481 +  using BIJ by (auto simp add: bij_betw_def)
   5.482 +  thus ?thesis using assms
   5.483 +  by(auto simp add: inv_into_Field_embed)
   5.484 +qed
   5.485 +
   5.486 +
   5.487 +
   5.488 +
   5.489 +
   5.490 +subsection {* Given any two well-orders, one can be embedded in the other *}
   5.491 +
   5.492 +
   5.493 +text{* Here is an overview of the proof of of this fact, stated in theorem
   5.494 +@{text "wellorders_totally_ordered"}:
   5.495 +
   5.496 +   Fix the well-orders @{text "r::'a rel"} and @{text "r'::'a' rel"}.
   5.497 +   Attempt to define an embedding @{text "f::'a \<Rightarrow> 'a'"} from @{text "r"} to @{text "r'"} in the
   5.498 +   natural way by well-order recursion ("hoping" that @{text "Field r"} turns out to be smaller
   5.499 +   than @{text "Field r'"}), but also record, at the recursive step, in a function
   5.500 +   @{text "g::'a \<Rightarrow> bool"}, the extra information of whether @{text "Field r'"}
   5.501 +   gets exhausted or not.
   5.502 +
   5.503 +   If @{text "Field r'"} does not get exhausted, then @{text "Field r"} is indeed smaller
   5.504 +   and @{text "f"} is the desired embedding from @{text "r"} to @{text "r'"}
   5.505 +   (lemma @{text "wellorders_totally_ordered_aux"}).
   5.506 +
   5.507 +   Otherwise, it means that @{text "Field r'"} is the smaller one, and the inverse of
   5.508 +   (the "good" segment of) @{text "f"} is the desired embedding from @{text "r'"} to @{text "r"}
   5.509 +   (lemma @{text "wellorders_totally_ordered_aux2"}).
   5.510 +*}
   5.511 +
   5.512 +
   5.513 +lemma wellorders_totally_ordered_aux:
   5.514 +fixes r ::"'a rel"  and r'::"'a' rel" and
   5.515 +      f :: "'a \<Rightarrow> 'a'" and a::'a
   5.516 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and IN: "a \<in> Field r" and
   5.517 +        IH: "\<forall>b \<in> underS r a. bij_betw f (under r b) (under r' (f b))" and
   5.518 +        NOT: "f ` (underS r a) \<noteq> Field r'" and SUC: "f a = wo_rel.suc r' (f`(underS r a))"
   5.519 +shows "bij_betw f (under r a) (under r' (f a))"
   5.520 +proof-
   5.521 +  (* Preliminary facts *)
   5.522 +  have Well: "wo_rel r" using WELL unfolding wo_rel_def .
   5.523 +  hence Refl: "Refl r" using wo_rel.REFL[of r] by auto
   5.524 +  have Trans: "trans r" using Well wo_rel.TRANS[of r] by auto
   5.525 +  have Well': "wo_rel r'" using WELL' unfolding wo_rel_def .
   5.526 +  have OF: "wo_rel.ofilter r (underS r a)"
   5.527 +  by (auto simp add: Well wo_rel.underS_ofilter)
   5.528 +  hence UN: "underS r a = (\<Union>  b \<in> underS r a. under r b)"
   5.529 +  using Well wo_rel.ofilter_under_UNION[of r "underS r a"] by blast
   5.530 +  (* Gather facts about elements of underS r a *)
   5.531 +  {fix b assume *: "b \<in> underS r a"
   5.532 +   hence t0: "(b,a) \<in> r \<and> b \<noteq> a" unfolding underS_def by auto
   5.533 +   have t1: "b \<in> Field r"
   5.534 +   using * underS_Field[of r a] by auto
   5.535 +   have t2: "f`(under r b) = under r' (f b)"
   5.536 +   using IH * by (auto simp add: bij_betw_def)
   5.537 +   hence t3: "wo_rel.ofilter r' (f`(under r b))"
   5.538 +   using Well' by (auto simp add: wo_rel.under_ofilter)
   5.539 +   have "f`(under r b) \<le> Field r'"
   5.540 +   using t2 by (auto simp add: under_Field)
   5.541 +   moreover
   5.542 +   have "b \<in> under r b"
   5.543 +   using t1 by(auto simp add: Refl Refl_under_in)
   5.544 +   ultimately
   5.545 +   have t4:  "f b \<in> Field r'" by auto
   5.546 +   have "f`(under r b) = under r' (f b) \<and>
   5.547 +         wo_rel.ofilter r' (f`(under r b)) \<and>
   5.548 +         f b \<in> Field r'"
   5.549 +   using t2 t3 t4 by auto
   5.550 +  }
   5.551 +  hence bFact:
   5.552 +  "\<forall>b \<in> underS r a. f`(under r b) = under r' (f b) \<and>
   5.553 +                       wo_rel.ofilter r' (f`(under r b)) \<and>
   5.554 +                       f b \<in> Field r'" by blast
   5.555 +  (*  *)
   5.556 +  have subField: "f`(underS r a) \<le> Field r'"
   5.557 +  using bFact by blast
   5.558 +  (*  *)
   5.559 +  have OF': "wo_rel.ofilter r' (f`(underS r a))"
   5.560 +  proof-
   5.561 +    have "f`(underS r a) = f`(\<Union>  b \<in> underS r a. under r b)"
   5.562 +    using UN by auto
   5.563 +    also have "\<dots> = (\<Union>  b \<in> underS r a. f`(under r b))" by blast
   5.564 +    also have "\<dots> = (\<Union>  b \<in> underS r a. (under r' (f b)))"
   5.565 +    using bFact by auto
   5.566 +    finally
   5.567 +    have "f`(underS r a) = (\<Union>  b \<in> underS r a. (under r' (f b)))" .
   5.568 +    thus ?thesis
   5.569 +    using Well' bFact
   5.570 +          wo_rel.ofilter_UNION[of r' "underS r a" "\<lambda> b. under r' (f b)"] by fastforce
   5.571 +  qed
   5.572 +  (*  *)
   5.573 +  have "f`(underS r a) \<union> AboveS r' (f`(underS r a)) = Field r'"
   5.574 +  using Well' OF' by (auto simp add: wo_rel.ofilter_AboveS_Field)
   5.575 +  hence NE: "AboveS r' (f`(underS r a)) \<noteq> {}"
   5.576 +  using subField NOT by blast
   5.577 +  (* Main proof *)
   5.578 +  have INCL1: "f`(underS r a) \<le> underS r' (f a) "
   5.579 +  proof(auto)
   5.580 +    fix b assume *: "b \<in> underS r a"
   5.581 +    have "f b \<noteq> f a \<and> (f b, f a) \<in> r'"
   5.582 +    using subField Well' SUC NE *
   5.583 +          wo_rel.suc_greater[of r' "f`(underS r a)" "f b"] by force
   5.584 +    thus "f b \<in> underS r' (f a)"
   5.585 +    unfolding underS_def by simp
   5.586 +  qed
   5.587 +  (*  *)
   5.588 +  have INCL2: "underS r' (f a) \<le> f`(underS r a)"
   5.589 +  proof
   5.590 +    fix b' assume "b' \<in> underS r' (f a)"
   5.591 +    hence "b' \<noteq> f a \<and> (b', f a) \<in> r'"
   5.592 +    unfolding underS_def by simp
   5.593 +    thus "b' \<in> f`(underS r a)"
   5.594 +    using Well' SUC NE OF'
   5.595 +          wo_rel.suc_ofilter_in[of r' "f ` underS r a" b'] by auto
   5.596 +  qed
   5.597 +  (*  *)
   5.598 +  have INJ: "inj_on f (underS r a)"
   5.599 +  proof-
   5.600 +    have "\<forall>b \<in> underS r a. inj_on f (under r b)"
   5.601 +    using IH by (auto simp add: bij_betw_def)
   5.602 +    moreover
   5.603 +    have "\<forall>b. wo_rel.ofilter r (under r b)"
   5.604 +    using Well by (auto simp add: wo_rel.under_ofilter)
   5.605 +    ultimately show  ?thesis
   5.606 +    using WELL bFact UN
   5.607 +          UNION_inj_on_ofilter[of r "underS r a" "\<lambda>b. under r b" f]
   5.608 +    by auto
   5.609 +  qed
   5.610 +  (*  *)
   5.611 +  have BIJ: "bij_betw f (underS r a) (underS r' (f a))"
   5.612 +  unfolding bij_betw_def
   5.613 +  using INJ INCL1 INCL2 by auto
   5.614 +  (*  *)
   5.615 +  have "f a \<in> Field r'"
   5.616 +  using Well' subField NE SUC
   5.617 +  by (auto simp add: wo_rel.suc_inField)
   5.618 +  thus ?thesis
   5.619 +  using WELL WELL' IN BIJ under_underS_bij_betw[of r r' a f] by auto
   5.620 +qed
   5.621 +
   5.622 +
   5.623 +lemma wellorders_totally_ordered_aux2:
   5.624 +fixes r ::"'a rel"  and r'::"'a' rel" and
   5.625 +      f :: "'a \<Rightarrow> 'a'" and g :: "'a \<Rightarrow> bool"  and a::'a
   5.626 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and
   5.627 +MAIN1:
   5.628 +  "\<And> a. (False \<notin> g`(underS r a) \<and> f`(underS r a) \<noteq> Field r'
   5.629 +          \<longrightarrow> f a = wo_rel.suc r' (f`(underS r a)) \<and> g a = True)
   5.630 +         \<and>
   5.631 +         (\<not>(False \<notin> (g`(underS r a)) \<and> f`(underS r a) \<noteq> Field r')
   5.632 +          \<longrightarrow> g a = False)" and
   5.633 +MAIN2: "\<And> a. a \<in> Field r \<and> False \<notin> g`(under r a) \<longrightarrow>
   5.634 +              bij_betw f (under r a) (under r' (f a))" and
   5.635 +Case: "a \<in> Field r \<and> False \<in> g`(under r a)"
   5.636 +shows "\<exists>f'. embed r' r f'"
   5.637 +proof-
   5.638 +  have Well: "wo_rel r" using WELL unfolding wo_rel_def .
   5.639 +  hence Refl: "Refl r" using wo_rel.REFL[of r] by auto
   5.640 +  have Trans: "trans r" using Well wo_rel.TRANS[of r] by auto
   5.641 +  have Antisym: "antisym r" using Well wo_rel.ANTISYM[of r] by auto
   5.642 +  have Well': "wo_rel r'" using WELL' unfolding wo_rel_def .
   5.643 +  (*  *)
   5.644 +  have 0: "under r a = underS r a \<union> {a}"
   5.645 +  using Refl Case by(auto simp add: Refl_under_underS)
   5.646 +  (*  *)
   5.647 +  have 1: "g a = False"
   5.648 +  proof-
   5.649 +    {assume "g a \<noteq> False"
   5.650 +     with 0 Case have "False \<in> g`(underS r a)" by blast
   5.651 +     with MAIN1 have "g a = False" by blast}
   5.652 +    thus ?thesis by blast
   5.653 +  qed
   5.654 +  let ?A = "{a \<in> Field r. g a = False}"
   5.655 +  let ?a = "(wo_rel.minim r ?A)"
   5.656 +  (*  *)
   5.657 +  have 2: "?A \<noteq> {} \<and> ?A \<le> Field r" using Case 1 by blast
   5.658 +  (*  *)
   5.659 +  have 3: "False \<notin> g`(underS r ?a)"
   5.660 +  proof
   5.661 +    assume "False \<in> g`(underS r ?a)"
   5.662 +    then obtain b where "b \<in> underS r ?a" and 31: "g b = False" by auto
   5.663 +    hence 32: "(b,?a) \<in> r \<and> b \<noteq> ?a"
   5.664 +    by (auto simp add: underS_def)
   5.665 +    hence "b \<in> Field r" unfolding Field_def by auto
   5.666 +    with 31 have "b \<in> ?A" by auto
   5.667 +    hence "(?a,b) \<in> r" using wo_rel.minim_least 2 Well by fastforce
   5.668 +    (* again: why worked without type annotations? *)
   5.669 +    with 32 Antisym show False
   5.670 +    by (auto simp add: antisym_def)
   5.671 +  qed
   5.672 +  have temp: "?a \<in> ?A"
   5.673 +  using Well 2 wo_rel.minim_in[of r ?A] by auto
   5.674 +  hence 4: "?a \<in> Field r" by auto
   5.675 +  (*   *)
   5.676 +  have 5: "g ?a = False" using temp by blast
   5.677 +  (*  *)
   5.678 +  have 6: "f`(underS r ?a) = Field r'"
   5.679 +  using MAIN1[of ?a] 3 5 by blast
   5.680 +  (*  *)
   5.681 +  have 7: "\<forall>b \<in> underS r ?a. bij_betw f (under r b) (under r' (f b))"
   5.682 +  proof
   5.683 +    fix b assume as: "b \<in> underS r ?a"
   5.684 +    moreover
   5.685 +    have "wo_rel.ofilter r (underS r ?a)"
   5.686 +    using Well by (auto simp add: wo_rel.underS_ofilter)
   5.687 +    ultimately
   5.688 +    have "False \<notin> g`(under r b)" using 3 Well by (subst (asm) wo_rel.ofilter_def) fast+
   5.689 +    moreover have "b \<in> Field r"
   5.690 +    unfolding Field_def using as by (auto simp add: underS_def)
   5.691 +    ultimately
   5.692 +    show "bij_betw f (under r b) (under r' (f b))"
   5.693 +    using MAIN2 by auto
   5.694 +  qed
   5.695 +  (*  *)
   5.696 +  have "embed r' r (inv_into (underS r ?a) f)"
   5.697 +  using WELL WELL' 7 4 6 inv_into_underS_embed[of r ?a f r'] by auto
   5.698 +  thus ?thesis
   5.699 +  unfolding embed_def by blast
   5.700 +qed
   5.701 +
   5.702 +
   5.703 +theorem wellorders_totally_ordered:
   5.704 +fixes r ::"'a rel"  and r'::"'a' rel"
   5.705 +assumes WELL: "Well_order r" and WELL': "Well_order r'"
   5.706 +shows "(\<exists>f. embed r r' f) \<or> (\<exists>f'. embed r' r f')"
   5.707 +proof-
   5.708 +  (* Preliminary facts *)
   5.709 +  have Well: "wo_rel r" using WELL unfolding wo_rel_def .
   5.710 +  hence Refl: "Refl r" using wo_rel.REFL[of r] by auto
   5.711 +  have Trans: "trans r" using Well wo_rel.TRANS[of r] by auto
   5.712 +  have Well': "wo_rel r'" using WELL' unfolding wo_rel_def .
   5.713 +  (* Main proof *)
   5.714 +  obtain H where H_def: "H =
   5.715 +  (\<lambda>h a. if False \<notin> (snd o h)`(underS r a) \<and> (fst o h)`(underS r a) \<noteq> Field r'
   5.716 +                then (wo_rel.suc r' ((fst o h)`(underS r a)), True)
   5.717 +                else (undefined, False))" by blast
   5.718 +  have Adm: "wo_rel.adm_wo r H"
   5.719 +  using Well
   5.720 +  proof(unfold wo_rel.adm_wo_def, clarify)
   5.721 +    fix h1::"'a \<Rightarrow> 'a' * bool" and h2::"'a \<Rightarrow> 'a' * bool" and x
   5.722 +    assume "\<forall>y\<in>underS r x. h1 y = h2 y"
   5.723 +    hence "\<forall>y\<in>underS r x. (fst o h1) y = (fst o h2) y \<and>
   5.724 +                          (snd o h1) y = (snd o h2) y" by auto
   5.725 +    hence "(fst o h1)`(underS r x) = (fst o h2)`(underS r x) \<and>
   5.726 +           (snd o h1)`(underS r x) = (snd o h2)`(underS r x)"
   5.727 +      by (auto simp add: image_def)
   5.728 +    thus "H h1 x = H h2 x" by (simp add: H_def del: not_False_in_image_Ball)
   5.729 +  qed
   5.730 +  (* More constant definitions:  *)
   5.731 +  obtain h::"'a \<Rightarrow> 'a' * bool" and f::"'a \<Rightarrow> 'a'" and g::"'a \<Rightarrow> bool"
   5.732 +  where h_def: "h = wo_rel.worec r H" and
   5.733 +        f_def: "f = fst o h" and g_def: "g = snd o h" by blast
   5.734 +  obtain test where test_def:
   5.735 +  "test = (\<lambda> a. False \<notin> (g`(underS r a)) \<and> f`(underS r a) \<noteq> Field r')" by blast
   5.736 +  (*  *)
   5.737 +  have *: "\<And> a. h a  = H h a"
   5.738 +  using Adm Well wo_rel.worec_fixpoint[of r H] by (simp add: h_def)
   5.739 +  have Main1:
   5.740 +  "\<And> a. (test a \<longrightarrow> f a = wo_rel.suc r' (f`(underS r a)) \<and> g a = True) \<and>
   5.741 +         (\<not>(test a) \<longrightarrow> g a = False)"
   5.742 +  proof-  (* How can I prove this withou fixing a? *)
   5.743 +    fix a show "(test a \<longrightarrow> f a = wo_rel.suc r' (f`(underS r a)) \<and> g a = True) \<and>
   5.744 +                (\<not>(test a) \<longrightarrow> g a = False)"
   5.745 +    using *[of a] test_def f_def g_def H_def by auto
   5.746 +  qed
   5.747 +  (*  *)
   5.748 +  let ?phi = "\<lambda> a. a \<in> Field r \<and> False \<notin> g`(under r a) \<longrightarrow>
   5.749 +                   bij_betw f (under r a) (under r' (f a))"
   5.750 +  have Main2: "\<And> a. ?phi a"
   5.751 +  proof-
   5.752 +    fix a show "?phi a"
   5.753 +    proof(rule wo_rel.well_order_induct[of r ?phi],
   5.754 +          simp only: Well, clarify)
   5.755 +      fix a
   5.756 +      assume IH: "\<forall>b. b \<noteq> a \<and> (b,a) \<in> r \<longrightarrow> ?phi b" and
   5.757 +             *: "a \<in> Field r" and
   5.758 +             **: "False \<notin> g`(under r a)"
   5.759 +      have 1: "\<forall>b \<in> underS r a. bij_betw f (under r b) (under r' (f b))"
   5.760 +      proof(clarify)
   5.761 +        fix b assume ***: "b \<in> underS r a"
   5.762 +        hence 0: "(b,a) \<in> r \<and> b \<noteq> a" unfolding underS_def by auto
   5.763 +        moreover have "b \<in> Field r"
   5.764 +        using *** underS_Field[of r a] by auto
   5.765 +        moreover have "False \<notin> g`(under r b)"
   5.766 +        using 0 ** Trans under_incr[of r b a] by auto
   5.767 +        ultimately show "bij_betw f (under r b) (under r' (f b))"
   5.768 +        using IH by auto
   5.769 +      qed
   5.770 +      (*  *)
   5.771 +      have 21: "False \<notin> g`(underS r a)"
   5.772 +      using ** underS_subset_under[of r a] by auto
   5.773 +      have 22: "g`(under r a) \<le> {True}" using ** by auto
   5.774 +      moreover have 23: "a \<in> under r a"
   5.775 +      using Refl * by (auto simp add: Refl_under_in)
   5.776 +      ultimately have 24: "g a = True" by blast
   5.777 +      have 2: "f`(underS r a) \<noteq> Field r'"
   5.778 +      proof
   5.779 +        assume "f`(underS r a) = Field r'"
   5.780 +        hence "g a = False" using Main1 test_def by blast
   5.781 +        with 24 show False using ** by blast
   5.782 +      qed
   5.783 +      (*  *)
   5.784 +      have 3: "f a = wo_rel.suc r' (f`(underS r a))"
   5.785 +      using 21 2 Main1 test_def by blast
   5.786 +      (*  *)
   5.787 +      show "bij_betw f (under r a) (under r' (f a))"
   5.788 +      using WELL  WELL' 1 2 3 *
   5.789 +            wellorders_totally_ordered_aux[of r r' a f] by auto
   5.790 +    qed
   5.791 +  qed
   5.792 +  (*  *)
   5.793 +  let ?chi = "(\<lambda> a. a \<in> Field r \<and> False \<in> g`(under r a))"
   5.794 +  show ?thesis
   5.795 +  proof(cases "\<exists>a. ?chi a")
   5.796 +    assume "\<not> (\<exists>a. ?chi a)"
   5.797 +    hence "\<forall>a \<in> Field r.  bij_betw f (under r a) (under r' (f a))"
   5.798 +    using Main2 by blast
   5.799 +    thus ?thesis unfolding embed_def by blast
   5.800 +  next
   5.801 +    assume "\<exists>a. ?chi a"
   5.802 +    then obtain a where "?chi a" by blast
   5.803 +    hence "\<exists>f'. embed r' r f'"
   5.804 +    using wellorders_totally_ordered_aux2[of r r' g f a]
   5.805 +          WELL WELL' Main1 Main2 test_def by fast
   5.806 +    thus ?thesis by blast
   5.807 +  qed
   5.808 +qed
   5.809 +
   5.810 +
   5.811 +subsection {* Uniqueness of embeddings  *}
   5.812 +
   5.813 +
   5.814 +text{* Here we show a fact complementary to the one from the previous subsection -- namely,
   5.815 +that between any two well-orders there is {\em at most} one embedding, and is the one
   5.816 +definable by the expected well-order recursive equation.  As a consequence, any two
   5.817 +embeddings of opposite directions are mutually inverse. *}
   5.818 +
   5.819 +
   5.820 +lemma embed_determined:
   5.821 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and
   5.822 +        EMB: "embed r r' f" and IN: "a \<in> Field r"
   5.823 +shows "f a = wo_rel.suc r' (f`(underS r a))"
   5.824 +proof-
   5.825 +  have "bij_betw f (underS r a) (underS r' (f a))"
   5.826 +  using assms by (auto simp add: embed_underS)
   5.827 +  hence "f`(underS r a) = underS r' (f a)"
   5.828 +  by (auto simp add: bij_betw_def)
   5.829 +  moreover
   5.830 +  {have "f a \<in> Field r'" using IN
   5.831 +   using EMB WELL embed_Field[of r r' f] by auto
   5.832 +   hence "f a = wo_rel.suc r' (underS r' (f a))"
   5.833 +   using WELL' by (auto simp add: wo_rel_def wo_rel.suc_underS)
   5.834 +  }
   5.835 +  ultimately show ?thesis by simp
   5.836 +qed
   5.837 +
   5.838 +
   5.839 +lemma embed_unique:
   5.840 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and
   5.841 +        EMBf: "embed r r' f" and EMBg: "embed r r' g"
   5.842 +shows "a \<in> Field r \<longrightarrow> f a = g a"
   5.843 +proof(rule wo_rel.well_order_induct[of r], auto simp add: WELL wo_rel_def)
   5.844 +  fix a
   5.845 +  assume IH: "\<forall>b. b \<noteq> a \<and> (b,a): r \<longrightarrow> b \<in> Field r \<longrightarrow> f b = g b" and
   5.846 +         *: "a \<in> Field r"
   5.847 +  hence "\<forall>b \<in> underS r a. f b = g b"
   5.848 +  unfolding underS_def by (auto simp add: Field_def)
   5.849 +  hence "f`(underS r a) = g`(underS r a)" by force
   5.850 +  thus "f a = g a"
   5.851 +  using assms * embed_determined[of r r' f a] embed_determined[of r r' g a] by auto
   5.852 +qed
   5.853 +
   5.854 +
   5.855 +lemma embed_bothWays_inverse:
   5.856 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and
   5.857 +        EMB: "embed r r' f" and EMB': "embed r' r f'"
   5.858 +shows "(\<forall>a \<in> Field r. f'(f a) = a) \<and> (\<forall>a' \<in> Field r'. f(f' a') = a')"
   5.859 +proof-
   5.860 +  have "embed r r (f' o f)" using assms
   5.861 +  by(auto simp add: comp_embed)
   5.862 +  moreover have "embed r r id" using assms
   5.863 +  by (auto simp add: id_embed)
   5.864 +  ultimately have "\<forall>a \<in> Field r. f'(f a) = a"
   5.865 +  using assms embed_unique[of r r "f' o f" id] id_def by auto
   5.866 +  moreover
   5.867 +  {have "embed r' r' (f o f')" using assms
   5.868 +   by(auto simp add: comp_embed)
   5.869 +   moreover have "embed r' r' id" using assms
   5.870 +   by (auto simp add: id_embed)
   5.871 +   ultimately have "\<forall>a' \<in> Field r'. f(f' a') = a'"
   5.872 +   using assms embed_unique[of r' r' "f o f'" id] id_def by auto
   5.873 +  }
   5.874 +  ultimately show ?thesis by blast
   5.875 +qed
   5.876 +
   5.877 +
   5.878 +lemma embed_bothWays_bij_betw:
   5.879 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and
   5.880 +        EMB: "embed r r' f" and EMB': "embed r' r g"
   5.881 +shows "bij_betw f (Field r) (Field r')"
   5.882 +proof-
   5.883 +  let ?A = "Field r"  let ?A' = "Field r'"
   5.884 +  have "embed r r (g o f) \<and> embed r' r' (f o g)"
   5.885 +  using assms by (auto simp add: comp_embed)
   5.886 +  hence 1: "(\<forall>a \<in> ?A. g(f a) = a) \<and> (\<forall>a' \<in> ?A'. f(g a') = a')"
   5.887 +  using WELL id_embed[of r] embed_unique[of r r "g o f" id]
   5.888 +        WELL' id_embed[of r'] embed_unique[of r' r' "f o g" id]
   5.889 +        id_def by auto
   5.890 +  have 2: "(\<forall>a \<in> ?A. f a \<in> ?A') \<and> (\<forall>a' \<in> ?A'. g a' \<in> ?A)"
   5.891 +  using assms embed_Field[of r r' f] embed_Field[of r' r g] by blast
   5.892 +  (*  *)
   5.893 +  show ?thesis
   5.894 +  proof(unfold bij_betw_def inj_on_def, auto simp add: 2)
   5.895 +    fix a b assume *: "a \<in> ?A" "b \<in> ?A" and **: "f a = f b"
   5.896 +    have "a = g(f a) \<and> b = g(f b)" using * 1 by auto
   5.897 +    with ** show "a = b" by auto
   5.898 +  next
   5.899 +    fix a' assume *: "a' \<in> ?A'"
   5.900 +    hence "g a' \<in> ?A \<and> f(g a') = a'" using 1 2 by auto
   5.901 +    thus "a' \<in> f ` ?A" by force
   5.902 +  qed
   5.903 +qed
   5.904 +
   5.905 +
   5.906 +lemma embed_bothWays_iso:
   5.907 +assumes WELL: "Well_order r"  and WELL': "Well_order r'" and
   5.908 +        EMB: "embed r r' f" and EMB': "embed r' r g"
   5.909 +shows "iso r r' f"
   5.910 +unfolding iso_def using assms by (auto simp add: embed_bothWays_bij_betw)
   5.911 +
   5.912 +
   5.913 +subsection {* More properties of embeddings, strict embeddings and isomorphisms  *}
   5.914 +
   5.915 +
   5.916 +lemma embed_bothWays_Field_bij_betw:
   5.917 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and
   5.918 +        EMB: "embed r r' f" and EMB': "embed r' r f'"
   5.919 +shows "bij_betw f (Field r) (Field r')"
   5.920 +proof-
   5.921 +  have "(\<forall>a \<in> Field r. f'(f a) = a) \<and> (\<forall>a' \<in> Field r'. f(f' a') = a')"
   5.922 +  using assms by (auto simp add: embed_bothWays_inverse)
   5.923 +  moreover
   5.924 +  have "f`(Field r) \<le> Field r' \<and> f' ` (Field r') \<le> Field r"
   5.925 +  using assms by (auto simp add: embed_Field)
   5.926 +  ultimately
   5.927 +  show ?thesis using bij_betw_byWitness[of "Field r" f' f "Field r'"] by auto
   5.928 +qed
   5.929 +
   5.930 +
   5.931 +lemma embedS_comp_embed:
   5.932 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and WELL'': "Well_order r''"
   5.933 +        and  EMB: "embedS r r' f" and EMB': "embed r' r'' f'"
   5.934 +shows "embedS r r'' (f' o f)"
   5.935 +proof-
   5.936 +  let ?g = "(f' o f)"  let ?h = "inv_into (Field r) ?g"
   5.937 +  have 1: "embed r r' f \<and> \<not> (bij_betw f (Field r) (Field r'))"
   5.938 +  using EMB by (auto simp add: embedS_def)
   5.939 +  hence 2: "embed r r'' ?g"
   5.940 +  using WELL EMB' comp_embed[of r r' f r'' f'] by auto
   5.941 +  moreover
   5.942 +  {assume "bij_betw ?g (Field r) (Field r'')"
   5.943 +   hence "embed r'' r ?h" using 2 WELL
   5.944 +   by (auto simp add: inv_into_Field_embed_bij_betw)
   5.945 +   hence "embed r' r (?h o f')" using WELL' EMB'
   5.946 +   by (auto simp add: comp_embed)
   5.947 +   hence "bij_betw f (Field r) (Field r')" using WELL WELL' 1
   5.948 +   by (auto simp add: embed_bothWays_Field_bij_betw)
   5.949 +   with 1 have False by blast
   5.950 +  }
   5.951 +  ultimately show ?thesis unfolding embedS_def by auto
   5.952 +qed
   5.953 +
   5.954 +
   5.955 +lemma embed_comp_embedS:
   5.956 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and WELL'': "Well_order r''"
   5.957 +        and  EMB: "embed r r' f" and EMB': "embedS r' r'' f'"
   5.958 +shows "embedS r r'' (f' o f)"
   5.959 +proof-
   5.960 +  let ?g = "(f' o f)"  let ?h = "inv_into (Field r) ?g"
   5.961 +  have 1: "embed r' r'' f' \<and> \<not> (bij_betw f' (Field r') (Field r''))"
   5.962 +  using EMB' by (auto simp add: embedS_def)
   5.963 +  hence 2: "embed r r'' ?g"
   5.964 +  using WELL EMB comp_embed[of r r' f r'' f'] by auto
   5.965 +  moreover
   5.966 +  {assume "bij_betw ?g (Field r) (Field r'')"
   5.967 +   hence "embed r'' r ?h" using 2 WELL
   5.968 +   by (auto simp add: inv_into_Field_embed_bij_betw)
   5.969 +   hence "embed r'' r' (f o ?h)" using WELL'' EMB
   5.970 +   by (auto simp add: comp_embed)
   5.971 +   hence "bij_betw f' (Field r') (Field r'')" using WELL' WELL'' 1
   5.972 +   by (auto simp add: embed_bothWays_Field_bij_betw)
   5.973 +   with 1 have False by blast
   5.974 +  }
   5.975 +  ultimately show ?thesis unfolding embedS_def by auto
   5.976 +qed
   5.977 +
   5.978 +
   5.979 +lemma embed_comp_iso:
   5.980 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and WELL'': "Well_order r''"
   5.981 +        and  EMB: "embed r r' f" and EMB': "iso r' r'' f'"
   5.982 +shows "embed r r'' (f' o f)"
   5.983 +using assms unfolding iso_def
   5.984 +by (auto simp add: comp_embed)
   5.985 +
   5.986 +
   5.987 +lemma iso_comp_embed:
   5.988 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and WELL'': "Well_order r''"
   5.989 +        and  EMB: "iso r r' f" and EMB': "embed r' r'' f'"
   5.990 +shows "embed r r'' (f' o f)"
   5.991 +using assms unfolding iso_def
   5.992 +by (auto simp add: comp_embed)
   5.993 +
   5.994 +
   5.995 +lemma embedS_comp_iso:
   5.996 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and WELL'': "Well_order r''"
   5.997 +        and  EMB: "embedS r r' f" and EMB': "iso r' r'' f'"
   5.998 +shows "embedS r r'' (f' o f)"
   5.999 +using assms unfolding iso_def
  5.1000 +by (auto simp add: embedS_comp_embed)
  5.1001 +
  5.1002 +
  5.1003 +lemma iso_comp_embedS:
  5.1004 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and WELL'': "Well_order r''"
  5.1005 +        and  EMB: "iso r r' f" and EMB': "embedS r' r'' f'"
  5.1006 +shows "embedS r r'' (f' o f)"
  5.1007 +using assms unfolding iso_def  using embed_comp_embedS
  5.1008 +by (auto simp add: embed_comp_embedS)
  5.1009 +
  5.1010 +
  5.1011 +lemma embedS_Field:
  5.1012 +assumes WELL: "Well_order r" and EMB: "embedS r r' f"
  5.1013 +shows "f ` (Field r) < Field r'"
  5.1014 +proof-
  5.1015 +  have "f`(Field r) \<le> Field r'" using assms
  5.1016 +  by (auto simp add: embed_Field embedS_def)
  5.1017 +  moreover
  5.1018 +  {have "inj_on f (Field r)" using assms
  5.1019 +   by (auto simp add: embedS_def embed_inj_on)
  5.1020 +   hence "f`(Field r) \<noteq> Field r'" using EMB
  5.1021 +   by (auto simp add: embedS_def bij_betw_def)
  5.1022 +  }
  5.1023 +  ultimately show ?thesis by blast
  5.1024 +qed
  5.1025 +
  5.1026 +
  5.1027 +lemma embedS_iff:
  5.1028 +assumes WELL: "Well_order r" and ISO: "embed r r' f"
  5.1029 +shows "embedS r r' f = (f ` (Field r) < Field r')"
  5.1030 +proof
  5.1031 +  assume "embedS r r' f"
  5.1032 +  thus "f ` Field r \<subset> Field r'"
  5.1033 +  using WELL by (auto simp add: embedS_Field)
  5.1034 +next
  5.1035 +  assume "f ` Field r \<subset> Field r'"
  5.1036 +  hence "\<not> bij_betw f (Field r) (Field r')"
  5.1037 +  unfolding bij_betw_def by blast
  5.1038 +  thus "embedS r r' f" unfolding embedS_def
  5.1039 +  using ISO by auto
  5.1040 +qed
  5.1041 +
  5.1042 +
  5.1043 +lemma iso_Field:
  5.1044 +"iso r r' f \<Longrightarrow> f ` (Field r) = Field r'"
  5.1045 +using assms by (auto simp add: iso_def bij_betw_def)
  5.1046 +
  5.1047 +
  5.1048 +lemma iso_iff:
  5.1049 +assumes "Well_order r"
  5.1050 +shows "iso r r' f = (embed r r' f \<and> f ` (Field r) = Field r')"
  5.1051 +proof
  5.1052 +  assume "iso r r' f"
  5.1053 +  thus "embed r r' f \<and> f ` (Field r) = Field r'"
  5.1054 +  by (auto simp add: iso_Field iso_def)
  5.1055 +next
  5.1056 +  assume *: "embed r r' f \<and> f ` Field r = Field r'"
  5.1057 +  hence "inj_on f (Field r)" using assms by (auto simp add: embed_inj_on)
  5.1058 +  with * have "bij_betw f (Field r) (Field r')"
  5.1059 +  unfolding bij_betw_def by simp
  5.1060 +  with * show "iso r r' f" unfolding iso_def by auto
  5.1061 +qed
  5.1062 +
  5.1063 +
  5.1064 +lemma iso_iff2:
  5.1065 +assumes "Well_order r"
  5.1066 +shows "iso r r' f = (bij_betw f (Field r) (Field r') \<and>
  5.1067 +                     (\<forall>a \<in> Field r. \<forall>b \<in> Field r.
  5.1068 +                         (((a,b) \<in> r) = ((f a, f b) \<in> r'))))"
  5.1069 +using assms
  5.1070 +proof(auto simp add: iso_def)
  5.1071 +  fix a b
  5.1072 +  assume "embed r r' f"
  5.1073 +  hence "compat r r' f" using embed_compat[of r] by auto
  5.1074 +  moreover assume "(a,b) \<in> r"
  5.1075 +  ultimately show "(f a, f b) \<in> r'" using compat_def[of r] by auto
  5.1076 +next
  5.1077 +  let ?f' = "inv_into (Field r) f"
  5.1078 +  assume "embed r r' f" and 1: "bij_betw f (Field r) (Field r')"
  5.1079 +  hence "embed r' r ?f'" using assms
  5.1080 +  by (auto simp add: inv_into_Field_embed_bij_betw)
  5.1081 +  hence 2: "compat r' r ?f'" using embed_compat[of r'] by auto
  5.1082 +  fix a b assume *: "a \<in> Field r" "b \<in> Field r" and **: "(f a,f b) \<in> r'"
  5.1083 +  hence "?f'(f a) = a \<and> ?f'(f b) = b" using 1
  5.1084 +  by (auto simp add: bij_betw_inv_into_left)
  5.1085 +  thus "(a,b) \<in> r" using ** 2 compat_def[of r' r ?f'] by fastforce
  5.1086 +next
  5.1087 +  assume *: "bij_betw f (Field r) (Field r')" and
  5.1088 +         **: "\<forall>a\<in>Field r. \<forall>b\<in>Field r. ((a, b) \<in> r) = ((f a, f b) \<in> r')"
  5.1089 +  have 1: "\<And> a. under r a \<le> Field r \<and> under r' (f a) \<le> Field r'"
  5.1090 +  by (auto simp add: under_Field)
  5.1091 +  have 2: "inj_on f (Field r)" using * by (auto simp add: bij_betw_def)
  5.1092 +  {fix a assume ***: "a \<in> Field r"
  5.1093 +   have "bij_betw f (under r a) (under r' (f a))"
  5.1094 +   proof(unfold bij_betw_def, auto)
  5.1095 +     show "inj_on f (under r a)"
  5.1096 +     using 1 2 by (metis subset_inj_on)
  5.1097 +   next
  5.1098 +     fix b assume "b \<in> under r a"
  5.1099 +     hence "a \<in> Field r \<and> b \<in> Field r \<and> (b,a) \<in> r"
  5.1100 +     unfolding under_def by (auto simp add: Field_def Range_def Domain_def)
  5.1101 +     with 1 ** show "f b \<in> under r' (f a)"
  5.1102 +     unfolding under_def by auto
  5.1103 +   next
  5.1104 +     fix b' assume "b' \<in> under r' (f a)"
  5.1105 +     hence 3: "(b',f a) \<in> r'" unfolding under_def by simp
  5.1106 +     hence "b' \<in> Field r'" unfolding Field_def by auto
  5.1107 +     with * obtain b where "b \<in> Field r \<and> f b = b'"
  5.1108 +     unfolding bij_betw_def by force
  5.1109 +     with 3 ** ***
  5.1110 +     show "b' \<in> f ` (under r a)" unfolding under_def by blast
  5.1111 +   qed
  5.1112 +  }
  5.1113 +  thus "embed r r' f" unfolding embed_def using * by auto
  5.1114 +qed
  5.1115 +
  5.1116 +
  5.1117 +lemma iso_iff3:
  5.1118 +assumes WELL: "Well_order r" and WELL': "Well_order r'"
  5.1119 +shows "iso r r' f = (bij_betw f (Field r) (Field r') \<and> compat r r' f)"
  5.1120 +proof
  5.1121 +  assume "iso r r' f"
  5.1122 +  thus "bij_betw f (Field r) (Field r') \<and> compat r r' f"
  5.1123 +  unfolding compat_def using WELL by (auto simp add: iso_iff2 Field_def)
  5.1124 +next
  5.1125 +  have Well: "wo_rel r \<and> wo_rel r'" using WELL WELL'
  5.1126 +  by (auto simp add: wo_rel_def)
  5.1127 +  assume *: "bij_betw f (Field r) (Field r') \<and> compat r r' f"
  5.1128 +  thus "iso r r' f"
  5.1129 +  unfolding "compat_def" using assms
  5.1130 +  proof(auto simp add: iso_iff2)
  5.1131 +    fix a b assume **: "a \<in> Field r" "b \<in> Field r" and
  5.1132 +                  ***: "(f a, f b) \<in> r'"
  5.1133 +    {assume "(b,a) \<in> r \<or> b = a"
  5.1134 +     hence "(b,a): r"using Well ** wo_rel.REFL[of r] refl_on_def[of _ r] by blast
  5.1135 +     hence "(f b, f a) \<in> r'" using * unfolding compat_def by auto
  5.1136 +     hence "f a = f b"
  5.1137 +     using Well *** wo_rel.ANTISYM[of r'] antisym_def[of r'] by blast
  5.1138 +     hence "a = b" using * ** unfolding bij_betw_def inj_on_def by auto
  5.1139 +     hence "(a,b) \<in> r" using Well ** wo_rel.REFL[of r] refl_on_def[of _ r] by blast
  5.1140 +    }
  5.1141 +    thus "(a,b) \<in> r"
  5.1142 +    using Well ** wo_rel.TOTAL[of r] total_on_def[of _ r] by blast
  5.1143 +  qed
  5.1144 +qed
  5.1145 +
  5.1146 +
  5.1147 +
  5.1148 +end
     6.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     6.2 +++ b/src/HOL/BNF_Wellorder_Relation.thy	Mon Jan 20 18:24:55 2014 +0100
     6.3 @@ -0,0 +1,642 @@
     6.4 +(*  Title:      HOL/BNF_Wellorder_Relation.thy
     6.5 +    Author:     Andrei Popescu, TU Muenchen
     6.6 +    Copyright   2012
     6.7 +
     6.8 +Well-order relations (BNF).
     6.9 +*)
    6.10 +
    6.11 +header {* Well-Order Relations (BNF) *}
    6.12 +
    6.13 +theory BNF_Wellorder_Relation
    6.14 +imports Order_Relation
    6.15 +begin
    6.16 +
    6.17 +
    6.18 +text{* In this section, we develop basic concepts and results pertaining
    6.19 +to well-order relations.  Note that we consider well-order relations
    6.20 +as {\em non-strict relations},
    6.21 +i.e., as containing the diagonals of their fields. *}
    6.22 +
    6.23 +
    6.24 +locale wo_rel =
    6.25 +  fixes r :: "'a rel"
    6.26 +  assumes WELL: "Well_order r"
    6.27 +begin
    6.28 +
    6.29 +text{* The following context encompasses all this section. In other words,
    6.30 +for the whole section, we consider a fixed well-order relation @{term "r"}. *}
    6.31 +
    6.32 +(* context wo_rel  *)
    6.33 +
    6.34 +abbreviation under where "under \<equiv> Order_Relation.under r"
    6.35 +abbreviation underS where "underS \<equiv> Order_Relation.underS r"
    6.36 +abbreviation Under where "Under \<equiv> Order_Relation.Under r"
    6.37 +abbreviation UnderS where "UnderS \<equiv> Order_Relation.UnderS r"
    6.38 +abbreviation above where "above \<equiv> Order_Relation.above r"
    6.39 +abbreviation aboveS where "aboveS \<equiv> Order_Relation.aboveS r"
    6.40 +abbreviation Above where "Above \<equiv> Order_Relation.Above r"
    6.41 +abbreviation AboveS where "AboveS \<equiv> Order_Relation.AboveS r"
    6.42 +
    6.43 +
    6.44 +subsection {* Auxiliaries *}
    6.45 +
    6.46 +
    6.47 +lemma REFL: "Refl r"
    6.48 +using WELL order_on_defs[of _ r] by auto
    6.49 +
    6.50 +
    6.51 +lemma TRANS: "trans r"
    6.52 +using WELL order_on_defs[of _ r] by auto
    6.53 +
    6.54 +
    6.55 +lemma ANTISYM: "antisym r"
    6.56 +using WELL order_on_defs[of _ r] by auto
    6.57 +
    6.58 +
    6.59 +lemma TOTAL: "Total r"
    6.60 +using WELL order_on_defs[of _ r] by auto
    6.61 +
    6.62 +
    6.63 +lemma TOTALS: "\<forall>a \<in> Field r. \<forall>b \<in> Field r. (a,b) \<in> r \<or> (b,a) \<in> r"
    6.64 +using REFL TOTAL refl_on_def[of _ r] total_on_def[of _ r] by force
    6.65 +
    6.66 +
    6.67 +lemma LIN: "Linear_order r"
    6.68 +using WELL well_order_on_def[of _ r] by auto
    6.69 +
    6.70 +
    6.71 +lemma WF: "wf (r - Id)"
    6.72 +using WELL well_order_on_def[of _ r] by auto
    6.73 +
    6.74 +
    6.75 +lemma cases_Total:
    6.76 +"\<And> phi a b. \<lbrakk>{a,b} <= Field r; ((a,b) \<in> r \<Longrightarrow> phi a b); ((b,a) \<in> r \<Longrightarrow> phi a b)\<rbrakk>
    6.77 +             \<Longrightarrow> phi a b"
    6.78 +using TOTALS by auto
    6.79 +
    6.80 +
    6.81 +lemma cases_Total3:
    6.82 +"\<And> phi a b. \<lbrakk>{a,b} \<le> Field r; ((a,b) \<in> r - Id \<or> (b,a) \<in> r - Id \<Longrightarrow> phi a b);
    6.83 +              (a = b \<Longrightarrow> phi a b)\<rbrakk>  \<Longrightarrow> phi a b"
    6.84 +using TOTALS by auto
    6.85 +
    6.86 +
    6.87 +subsection {* Well-founded induction and recursion adapted to non-strict well-order relations  *}
    6.88 +
    6.89 +
    6.90 +text{* Here we provide induction and recursion principles specific to {\em non-strict}
    6.91 +well-order relations.
    6.92 +Although minor variations of those for well-founded relations, they will be useful
    6.93 +for doing away with the tediousness of
    6.94 +having to take out the diagonal each time in order to switch to a well-founded relation. *}
    6.95 +
    6.96 +
    6.97 +lemma well_order_induct:
    6.98 +assumes IND: "\<And>x. \<forall>y. y \<noteq> x \<and> (y, x) \<in> r \<longrightarrow> P y \<Longrightarrow> P x"
    6.99 +shows "P a"
   6.100 +proof-
   6.101 +  have "\<And>x. \<forall>y. (y, x) \<in> r - Id \<longrightarrow> P y \<Longrightarrow> P x"
   6.102 +  using IND by blast
   6.103 +  thus "P a" using WF wf_induct[of "r - Id" P a] by blast
   6.104 +qed
   6.105 +
   6.106 +
   6.107 +definition
   6.108 +worec :: "(('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b"
   6.109 +where
   6.110 +"worec F \<equiv> wfrec (r - Id) F"
   6.111 +
   6.112 +
   6.113 +definition
   6.114 +adm_wo :: "(('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b) \<Rightarrow> bool"
   6.115 +where
   6.116 +"adm_wo H \<equiv> \<forall>f g x. (\<forall>y \<in> underS x. f y = g y) \<longrightarrow> H f x = H g x"
   6.117 +
   6.118 +
   6.119 +lemma worec_fixpoint:
   6.120 +assumes ADM: "adm_wo H"
   6.121 +shows "worec H = H (worec H)"
   6.122 +proof-
   6.123 +  let ?rS = "r - Id"
   6.124 +  have "adm_wf (r - Id) H"
   6.125 +  unfolding adm_wf_def
   6.126 +  using ADM adm_wo_def[of H] underS_def[of r] by auto
   6.127 +  hence "wfrec ?rS H = H (wfrec ?rS H)"
   6.128 +  using WF wfrec_fixpoint[of ?rS H] by simp
   6.129 +  thus ?thesis unfolding worec_def .
   6.130 +qed
   6.131 +
   6.132 +
   6.133 +subsection {* The notions of maximum, minimum, supremum, successor and order filter  *}
   6.134 +
   6.135 +
   6.136 +text{*
   6.137 +We define the successor {\em of a set}, and not of an element (the latter is of course
   6.138 +a particular case).  Also, we define the maximum {\em of two elements}, @{text "max2"},
   6.139 +and the minimum {\em of a set}, @{text "minim"} -- we chose these variants since we
   6.140 +consider them the most useful for well-orders.  The minimum is defined in terms of the
   6.141 +auxiliary relational operator @{text "isMinim"}.  Then, supremum and successor are
   6.142 +defined in terms of minimum as expected.
   6.143 +The minimum is only meaningful for non-empty sets, and the successor is only
   6.144 +meaningful for sets for which strict upper bounds exist.
   6.145 +Order filters for well-orders are also known as ``initial segments". *}
   6.146 +
   6.147 +
   6.148 +definition max2 :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"
   6.149 +where "max2 a b \<equiv> if (a,b) \<in> r then b else a"
   6.150 +
   6.151 +
   6.152 +definition isMinim :: "'a set \<Rightarrow> 'a \<Rightarrow> bool"
   6.153 +where "isMinim A b \<equiv> b \<in> A \<and> (\<forall>a \<in> A. (b,a) \<in> r)"
   6.154 +
   6.155 +definition minim :: "'a set \<Rightarrow> 'a"
   6.156 +where "minim A \<equiv> THE b. isMinim A b"
   6.157 +
   6.158 +
   6.159 +definition supr :: "'a set \<Rightarrow> 'a"
   6.160 +where "supr A \<equiv> minim (Above A)"
   6.161 +
   6.162 +definition suc :: "'a set \<Rightarrow> 'a"
   6.163 +where "suc A \<equiv> minim (AboveS A)"
   6.164 +
   6.165 +definition ofilter :: "'a set \<Rightarrow> bool"
   6.166 +where
   6.167 +"ofilter A \<equiv> (A \<le> Field r) \<and> (\<forall>a \<in> A. under a \<le> A)"
   6.168 +
   6.169 +
   6.170 +subsubsection {* Properties of max2 *}
   6.171 +
   6.172 +
   6.173 +lemma max2_greater_among:
   6.174 +assumes "a \<in> Field r" and "b \<in> Field r"
   6.175 +shows "(a, max2 a b) \<in> r \<and> (b, max2 a b) \<in> r \<and> max2 a b \<in> {a,b}"
   6.176 +proof-
   6.177 +  {assume "(a,b) \<in> r"
   6.178 +   hence ?thesis using max2_def assms REFL refl_on_def
   6.179 +   by (auto simp add: refl_on_def)
   6.180 +  }
   6.181 +  moreover
   6.182 +  {assume "a = b"
   6.183 +   hence "(a,b) \<in> r" using REFL  assms
   6.184 +   by (auto simp add: refl_on_def)
   6.185 +  }
   6.186 +  moreover
   6.187 +  {assume *: "a \<noteq> b \<and> (b,a) \<in> r"
   6.188 +   hence "(a,b) \<notin> r" using ANTISYM
   6.189 +   by (auto simp add: antisym_def)
   6.190 +   hence ?thesis using * max2_def assms REFL refl_on_def
   6.191 +   by (auto simp add: refl_on_def)
   6.192 +  }
   6.193 +  ultimately show ?thesis using assms TOTAL
   6.194 +  total_on_def[of "Field r" r] by blast
   6.195 +qed
   6.196 +
   6.197 +
   6.198 +lemma max2_greater:
   6.199 +assumes "a \<in> Field r" and "b \<in> Field r"
   6.200 +shows "(a, max2 a b) \<in> r \<and> (b, max2 a b) \<in> r"
   6.201 +using assms by (auto simp add: max2_greater_among)
   6.202 +
   6.203 +
   6.204 +lemma max2_among:
   6.205 +assumes "a \<in> Field r" and "b \<in> Field r"
   6.206 +shows "max2 a b \<in> {a, b}"
   6.207 +using assms max2_greater_among[of a b] by simp
   6.208 +
   6.209 +
   6.210 +lemma max2_equals1:
   6.211 +assumes "a \<in> Field r" and "b \<in> Field r"
   6.212 +shows "(max2 a b = a) = ((b,a) \<in> r)"
   6.213 +using assms ANTISYM unfolding antisym_def using TOTALS
   6.214 +by(auto simp add: max2_def max2_among)
   6.215 +
   6.216 +
   6.217 +lemma max2_equals2:
   6.218 +assumes "a \<in> Field r" and "b \<in> Field r"
   6.219 +shows "(max2 a b = b) = ((a,b) \<in> r)"
   6.220 +using assms ANTISYM unfolding antisym_def using TOTALS
   6.221 +unfolding max2_def by auto
   6.222 +
   6.223 +
   6.224 +subsubsection {* Existence and uniqueness for isMinim and well-definedness of minim *}
   6.225 +
   6.226 +
   6.227 +lemma isMinim_unique:
   6.228 +assumes MINIM: "isMinim B a" and MINIM': "isMinim B a'"
   6.229 +shows "a = a'"
   6.230 +proof-
   6.231 +  {have "a \<in> B"
   6.232 +   using MINIM isMinim_def by simp
   6.233 +   hence "(a',a) \<in> r"
   6.234 +   using MINIM' isMinim_def by simp
   6.235 +  }
   6.236 +  moreover
   6.237 +  {have "a' \<in> B"
   6.238 +   using MINIM' isMinim_def by simp
   6.239 +   hence "(a,a') \<in> r"
   6.240 +   using MINIM isMinim_def by simp
   6.241 +  }
   6.242 +  ultimately
   6.243 +  show ?thesis using ANTISYM antisym_def[of r] by blast
   6.244 +qed
   6.245 +
   6.246 +
   6.247 +lemma Well_order_isMinim_exists:
   6.248 +assumes SUB: "B \<le> Field r" and NE: "B \<noteq> {}"
   6.249 +shows "\<exists>b. isMinim B b"
   6.250 +proof-
   6.251 +  from spec[OF WF[unfolded wf_eq_minimal[of "r - Id"]], of B] NE obtain b where
   6.252 +  *: "b \<in> B \<and> (\<forall>b'. b' \<noteq> b \<and> (b',b) \<in> r \<longrightarrow> b' \<notin> B)" by auto
   6.253 +  show ?thesis
   6.254 +  proof(simp add: isMinim_def, rule exI[of _ b], auto)
   6.255 +    show "b \<in> B" using * by simp
   6.256 +  next
   6.257 +    fix b' assume As: "b' \<in> B"
   6.258 +    hence **: "b \<in> Field r \<and> b' \<in> Field r" using As SUB * by auto
   6.259 +    (*  *)
   6.260 +    from As  * have "b' = b \<or> (b',b) \<notin> r" by auto
   6.261 +    moreover
   6.262 +    {assume "b' = b"
   6.263 +     hence "(b,b') \<in> r"
   6.264 +     using ** REFL by (auto simp add: refl_on_def)
   6.265 +    }
   6.266 +    moreover
   6.267 +    {assume "b' \<noteq> b \<and> (b',b) \<notin> r"
   6.268 +     hence "(b,b') \<in> r"
   6.269 +     using ** TOTAL by (auto simp add: total_on_def)
   6.270 +    }
   6.271 +    ultimately show "(b,b') \<in> r" by blast
   6.272 +  qed
   6.273 +qed
   6.274 +
   6.275 +
   6.276 +lemma minim_isMinim:
   6.277 +assumes SUB: "B \<le> Field r" and NE: "B \<noteq> {}"
   6.278 +shows "isMinim B (minim B)"
   6.279 +proof-
   6.280 +  let ?phi = "(\<lambda> b. isMinim B b)"
   6.281 +  from assms Well_order_isMinim_exists
   6.282 +  obtain b where *: "?phi b" by blast
   6.283 +  moreover
   6.284 +  have "\<And> b'. ?phi b' \<Longrightarrow> b' = b"
   6.285 +  using isMinim_unique * by auto
   6.286 +  ultimately show ?thesis
   6.287 +  unfolding minim_def using theI[of ?phi b] by blast
   6.288 +qed
   6.289 +
   6.290 +
   6.291 +subsubsection{* Properties of minim *}
   6.292 +
   6.293 +
   6.294 +lemma minim_in:
   6.295 +assumes "B \<le> Field r" and "B \<noteq> {}"
   6.296 +shows "minim B \<in> B"
   6.297 +proof-
   6.298 +  from minim_isMinim[of B] assms
   6.299 +  have "isMinim B (minim B)" by simp
   6.300 +  thus ?thesis by (simp add: isMinim_def)
   6.301 +qed
   6.302 +
   6.303 +
   6.304 +lemma minim_inField:
   6.305 +assumes "B \<le> Field r" and "B \<noteq> {}"
   6.306 +shows "minim B \<in> Field r"
   6.307 +proof-
   6.308 +  have "minim B \<in> B" using assms by (simp add: minim_in)
   6.309 +  thus ?thesis using assms by blast
   6.310 +qed
   6.311 +
   6.312 +
   6.313 +lemma minim_least:
   6.314 +assumes  SUB: "B \<le> Field r" and IN: "b \<in> B"
   6.315 +shows "(minim B, b) \<in> r"
   6.316 +proof-
   6.317 +  from minim_isMinim[of B] assms
   6.318 +  have "isMinim B (minim B)" by auto
   6.319 +  thus ?thesis by (auto simp add: isMinim_def IN)
   6.320 +qed
   6.321 +
   6.322 +
   6.323 +lemma equals_minim:
   6.324 +assumes SUB: "B \<le> Field r" and IN: "a \<in> B" and
   6.325 +        LEAST: "\<And> b. b \<in> B \<Longrightarrow> (a,b) \<in> r"
   6.326 +shows "a = minim B"
   6.327 +proof-
   6.328 +  from minim_isMinim[of B] assms
   6.329 +  have "isMinim B (minim B)" by auto
   6.330 +  moreover have "isMinim B a" using IN LEAST isMinim_def by auto
   6.331 +  ultimately show ?thesis
   6.332 +  using isMinim_unique by auto
   6.333 +qed
   6.334 +
   6.335 +
   6.336 +subsubsection{* Properties of successor *}
   6.337 +
   6.338 +
   6.339 +lemma suc_AboveS:
   6.340 +assumes SUB: "B \<le> Field r" and ABOVES: "AboveS B \<noteq> {}"
   6.341 +shows "suc B \<in> AboveS B"
   6.342 +proof(unfold suc_def)
   6.343 +  have "AboveS B \<le> Field r"
   6.344 +  using AboveS_Field[of r] by auto
   6.345 +  thus "minim (AboveS B) \<in> AboveS B"
   6.346 +  using assms by (simp add: minim_in)
   6.347 +qed
   6.348 +
   6.349 +
   6.350 +lemma suc_greater:
   6.351 +assumes SUB: "B \<le> Field r" and ABOVES: "AboveS B \<noteq> {}" and
   6.352 +        IN: "b \<in> B"
   6.353 +shows "suc B \<noteq> b \<and> (b,suc B) \<in> r"
   6.354 +proof-
   6.355 +  from assms suc_AboveS
   6.356 +  have "suc B \<in> AboveS B" by simp
   6.357 +  with IN AboveS_def[of r] show ?thesis by simp
   6.358 +qed
   6.359 +
   6.360 +
   6.361 +lemma suc_least_AboveS:
   6.362 +assumes ABOVES: "a \<in> AboveS B"
   6.363 +shows "(suc B,a) \<in> r"
   6.364 +proof(unfold suc_def)
   6.365 +  have "AboveS B \<le> Field r"
   6.366 +  using AboveS_Field[of r] by auto
   6.367 +  thus "(minim (AboveS B),a) \<in> r"
   6.368 +  using assms minim_least by simp
   6.369 +qed
   6.370 +
   6.371 +
   6.372 +lemma suc_inField:
   6.373 +assumes "B \<le> Field r" and "AboveS B \<noteq> {}"
   6.374 +shows "suc B \<in> Field r"
   6.375 +proof-
   6.376 +  have "suc B \<in> AboveS B" using suc_AboveS assms by simp
   6.377 +  thus ?thesis
   6.378 +  using assms AboveS_Field[of r] by auto
   6.379 +qed
   6.380 +
   6.381 +
   6.382 +lemma equals_suc_AboveS:
   6.383 +assumes SUB: "B \<le> Field r" and ABV: "a \<in> AboveS B" and
   6.384 +        MINIM: "\<And> a'. a' \<in> AboveS B \<Longrightarrow> (a,a') \<in> r"
   6.385 +shows "a = suc B"
   6.386 +proof(unfold suc_def)
   6.387 +  have "AboveS B \<le> Field r"
   6.388 +  using AboveS_Field[of r B] by auto
   6.389 +  thus "a = minim (AboveS B)"
   6.390 +  using assms equals_minim
   6.391 +  by simp
   6.392 +qed
   6.393 +
   6.394 +
   6.395 +lemma suc_underS:
   6.396 +assumes IN: "a \<in> Field r"
   6.397 +shows "a = suc (underS a)"
   6.398 +proof-
   6.399 +  have "underS a \<le> Field r"
   6.400 +  using underS_Field[of r] by auto
   6.401 +  moreover
   6.402 +  have "a \<in> AboveS (underS a)"
   6.403 +  using in_AboveS_underS IN by fast
   6.404 +  moreover
   6.405 +  have "\<forall>a' \<in> AboveS (underS a). (a,a') \<in> r"
   6.406 +  proof(clarify)
   6.407 +    fix a'
   6.408 +    assume *: "a' \<in> AboveS (underS a)"
   6.409 +    hence **: "a' \<in> Field r"
   6.410 +    using AboveS_Field by fast
   6.411 +    {assume "(a,a') \<notin> r"
   6.412 +     hence "a' = a \<or> (a',a) \<in> r"
   6.413 +     using TOTAL IN ** by (auto simp add: total_on_def)
   6.414 +     moreover
   6.415 +     {assume "a' = a"
   6.416 +      hence "(a,a') \<in> r"
   6.417 +      using REFL IN ** by (auto simp add: refl_on_def)
   6.418 +     }
   6.419 +     moreover
   6.420 +     {assume "a' \<noteq> a \<and> (a',a) \<in> r"
   6.421 +      hence "a' \<in> underS a"
   6.422 +      unfolding underS_def by simp
   6.423 +      hence "a' \<notin> AboveS (underS a)"
   6.424 +      using AboveS_disjoint by fast
   6.425 +      with * have False by simp
   6.426 +     }
   6.427 +     ultimately have "(a,a') \<in> r" by blast
   6.428 +    }
   6.429 +    thus  "(a, a') \<in> r" by blast
   6.430 +  qed
   6.431 +  ultimately show ?thesis
   6.432 +  using equals_suc_AboveS by auto
   6.433 +qed
   6.434 +
   6.435 +
   6.436 +subsubsection {* Properties of order filters *}
   6.437 +
   6.438 +
   6.439 +lemma under_ofilter:
   6.440 +"ofilter (under a)"
   6.441 +proof(unfold ofilter_def under_def, auto simp add: Field_def)
   6.442 +  fix aa x
   6.443 +  assume "(aa,a) \<in> r" "(x,aa) \<in> r"
   6.444 +  thus "(x,a) \<in> r"
   6.445 +  using TRANS trans_def[of r] by blast
   6.446 +qed
   6.447 +
   6.448 +
   6.449 +lemma underS_ofilter:
   6.450 +"ofilter (underS a)"
   6.451 +proof(unfold ofilter_def underS_def under_def, auto simp add: Field_def)
   6.452 +  fix aa assume "(a, aa) \<in> r" "(aa, a) \<in> r" and DIFF: "aa \<noteq> a"
   6.453 +  thus False
   6.454 +  using ANTISYM antisym_def[of r] by blast
   6.455 +next
   6.456 +  fix aa x
   6.457 +  assume "(aa,a) \<in> r" "aa \<noteq> a" "(x,aa) \<in> r"
   6.458 +  thus "(x,a) \<in> r"
   6.459 +  using TRANS trans_def[of r] by blast
   6.460 +qed
   6.461 +
   6.462 +
   6.463 +lemma Field_ofilter:
   6.464 +"ofilter (Field r)"
   6.465 +by(unfold ofilter_def under_def, auto simp add: Field_def)
   6.466 +
   6.467 +
   6.468 +lemma ofilter_underS_Field:
   6.469 +"ofilter A = ((\<exists>a \<in> Field r. A = underS a) \<or> (A = Field r))"
   6.470 +proof
   6.471 +  assume "(\<exists>a\<in>Field r. A = underS a) \<or> A = Field r"
   6.472 +  thus "ofilter A"
   6.473 +  by (auto simp: underS_ofilter Field_ofilter)
   6.474 +next
   6.475 +  assume *: "ofilter A"
   6.476 +  let ?One = "(\<exists>a\<in>Field r. A = underS a)"
   6.477 +  let ?Two = "(A = Field r)"
   6.478 +  show "?One \<or> ?Two"
   6.479 +  proof(cases ?Two, simp)
   6.480 +    let ?B = "(Field r) - A"
   6.481 +    let ?a = "minim ?B"
   6.482 +    assume "A \<noteq> Field r"
   6.483 +    moreover have "A \<le> Field r" using * ofilter_def by simp
   6.484 +    ultimately have 1: "?B \<noteq> {}" by blast
   6.485 +    hence 2: "?a \<in> Field r" using minim_inField[of ?B] by blast
   6.486 +    have 3: "?a \<in> ?B" using minim_in[of ?B] 1 by blast
   6.487 +    hence 4: "?a \<notin> A" by blast
   6.488 +    have 5: "A \<le> Field r" using * ofilter_def[of A] by auto
   6.489 +    (*  *)
   6.490 +    moreover
   6.491 +    have "A = underS ?a"
   6.492 +    proof
   6.493 +      show "A \<le> underS ?a"
   6.494 +      proof(unfold underS_def, auto simp add: 4)
   6.495 +        fix x assume **: "x \<in> A"
   6.496 +        hence 11: "x \<in> Field r" using 5 by auto
   6.497 +        have 12: "x \<noteq> ?a" using 4 ** by auto
   6.498 +        have 13: "under x \<le> A" using * ofilter_def ** by auto
   6.499 +        {assume "(x,?a) \<notin> r"
   6.500 +         hence "(?a,x) \<in> r"
   6.501 +         using TOTAL total_on_def[of "Field r" r]
   6.502 +               2 4 11 12 by auto
   6.503 +         hence "?a \<in> under x" using under_def[of r] by auto
   6.504 +         hence "?a \<in> A" using ** 13 by blast
   6.505 +         with 4 have False by simp
   6.506 +        }
   6.507 +        thus "(x,?a) \<in> r" by blast
   6.508 +      qed
   6.509 +    next
   6.510 +      show "underS ?a \<le> A"
   6.511 +      proof(unfold underS_def, auto)
   6.512 +        fix x
   6.513 +        assume **: "x \<noteq> ?a" and ***: "(x,?a) \<in> r"
   6.514 +        hence 11: "x \<in> Field r" using Field_def by fastforce
   6.515 +         {assume "x \<notin> A"
   6.516 +          hence "x \<in> ?B" using 11 by auto
   6.517 +          hence "(?a,x) \<in> r" using 3 minim_least[of ?B x] by blast
   6.518 +          hence False
   6.519 +          using ANTISYM antisym_def[of r] ** *** by auto
   6.520 +         }
   6.521 +        thus "x \<in> A" by blast
   6.522 +      qed
   6.523 +    qed
   6.524 +    ultimately have ?One using 2 by blast
   6.525 +    thus ?thesis by simp
   6.526 +  qed
   6.527 +qed
   6.528 +
   6.529 +
   6.530 +lemma ofilter_UNION:
   6.531 +"(\<And> i. i \<in> I \<Longrightarrow> ofilter(A i)) \<Longrightarrow> ofilter (\<Union> i \<in> I. A i)"
   6.532 +unfolding ofilter_def by blast
   6.533 +
   6.534 +
   6.535 +lemma ofilter_under_UNION:
   6.536 +assumes "ofilter A"
   6.537 +shows "A = (\<Union> a \<in> A. under a)"
   6.538 +proof
   6.539 +  have "\<forall>a \<in> A. under a \<le> A"
   6.540 +  using assms ofilter_def by auto
   6.541 +  thus "(\<Union> a \<in> A. under a) \<le> A" by blast
   6.542 +next
   6.543 +  have "\<forall>a \<in> A. a \<in> under a"
   6.544 +  using REFL Refl_under_in[of r] assms ofilter_def[of A] by blast
   6.545 +  thus "A \<le> (\<Union> a \<in> A. under a)" by blast
   6.546 +qed
   6.547 +
   6.548 +
   6.549 +subsubsection{* Other properties *}
   6.550 +
   6.551 +
   6.552 +lemma ofilter_linord:
   6.553 +assumes OF1: "ofilter A" and OF2: "ofilter B"
   6.554 +shows "A \<le> B \<or> B \<le> A"
   6.555 +proof(cases "A = Field r")
   6.556 +  assume Case1: "A = Field r"
   6.557 +  hence "B \<le> A" using OF2 ofilter_def by auto
   6.558 +  thus ?thesis by simp
   6.559 +next
   6.560 +  assume Case2: "A \<noteq> Field r"
   6.561 +  with ofilter_underS_Field OF1 obtain a where
   6.562 +  1: "a \<in> Field r \<and> A = underS a" by auto
   6.563 +  show ?thesis
   6.564 +  proof(cases "B = Field r")
   6.565 +    assume Case21: "B = Field r"
   6.566 +    hence "A \<le> B" using OF1 ofilter_def by auto
   6.567 +    thus ?thesis by simp
   6.568 +  next
   6.569 +    assume Case22: "B \<noteq> Field r"
   6.570 +    with ofilter_underS_Field OF2 obtain b where
   6.571 +    2: "b \<in> Field r \<and> B = underS b" by auto
   6.572 +    have "a = b \<or> (a,b) \<in> r \<or> (b,a) \<in> r"
   6.573 +    using 1 2 TOTAL total_on_def[of _ r] by auto
   6.574 +    moreover
   6.575 +    {assume "a = b" with 1 2 have ?thesis by auto
   6.576 +    }
   6.577 +    moreover
   6.578 +    {assume "(a,b) \<in> r"
   6.579 +     with underS_incr[of r] TRANS ANTISYM 1 2
   6.580 +     have "A \<le> B" by auto
   6.581 +     hence ?thesis by auto
   6.582 +    }
   6.583 +    moreover
   6.584 +     {assume "(b,a) \<in> r"
   6.585 +     with underS_incr[of r] TRANS ANTISYM 1 2
   6.586 +     have "B \<le> A" by auto
   6.587 +     hence ?thesis by auto
   6.588 +    }
   6.589 +    ultimately show ?thesis by blast
   6.590 +  qed
   6.591 +qed
   6.592 +
   6.593 +
   6.594 +lemma ofilter_AboveS_Field:
   6.595 +assumes "ofilter A"
   6.596 +shows "A \<union> (AboveS A) = Field r"
   6.597 +proof
   6.598 +  show "A \<union> (AboveS A) \<le> Field r"
   6.599 +  using assms ofilter_def AboveS_Field[of r] by auto
   6.600 +next
   6.601 +  {fix x assume *: "x \<in> Field r" and **: "x \<notin> A"
   6.602 +   {fix y assume ***: "y \<in> A"
   6.603 +    with ** have 1: "y \<noteq> x" by auto
   6.604 +    {assume "(y,x) \<notin> r"
   6.605 +     moreover
   6.606 +     have "y \<in> Field r" using assms ofilter_def *** by auto
   6.607 +     ultimately have "(x,y) \<in> r"
   6.608 +     using 1 * TOTAL total_on_def[of _ r] by auto
   6.609 +     with *** assms ofilter_def under_def[of r] have "x \<in> A" by auto
   6.610 +     with ** have False by contradiction
   6.611 +    }
   6.612 +    hence "(y,x) \<in> r" by blast
   6.613 +    with 1 have "y \<noteq> x \<and> (y,x) \<in> r" by auto
   6.614 +   }
   6.615 +   with * have "x \<in> AboveS A" unfolding AboveS_def by auto
   6.616 +  }
   6.617 +  thus "Field r \<le> A \<union> (AboveS A)" by blast
   6.618 +qed
   6.619 +
   6.620 +
   6.621 +lemma suc_ofilter_in:
   6.622 +assumes OF: "ofilter A" and ABOVE_NE: "AboveS A \<noteq> {}" and
   6.623 +        REL: "(b,suc A) \<in> r" and DIFF: "b \<noteq> suc A"
   6.624 +shows "b \<in> A"
   6.625 +proof-
   6.626 +  have *: "suc A \<in> Field r \<and> b \<in> Field r"
   6.627 +  using WELL REL well_order_on_domain[of "Field r"] by auto
   6.628 +  {assume **: "b \<notin> A"
   6.629 +   hence "b \<in> AboveS A"
   6.630 +   using OF * ofilter_AboveS_Field by auto
   6.631 +   hence "(suc A, b) \<in> r"
   6.632 +   using suc_least_AboveS by auto
   6.633 +   hence False using REL DIFF ANTISYM *
   6.634 +   by (auto simp add: antisym_def)
   6.635 +  }
   6.636 +  thus ?thesis by blast
   6.637 +qed
   6.638 +
   6.639 +
   6.640 +
   6.641 +end (* context wo_rel *)
   6.642 +
   6.643 +
   6.644 +
   6.645 +end
     7.1 --- a/src/HOL/Cardinal_Arithmetic_FP.thy	Mon Jan 20 18:24:55 2014 +0100
     7.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     7.3 @@ -1,706 +0,0 @@
     7.4 -(*  Title:      HOL/Cardinal_Arithmetic_FP.thy
     7.5 -    Author:     Dmitriy Traytel, TU Muenchen
     7.6 -    Copyright   2012
     7.7 -
     7.8 -Cardinal arithmetic (FP).
     7.9 -*)
    7.10 -
    7.11 -header {* Cardinal Arithmetic (FP) *}
    7.12 -
    7.13 -theory Cardinal_Arithmetic_FP
    7.14 -imports Cardinal_Order_Relation_FP
    7.15 -begin
    7.16 -
    7.17 -lemma dir_image: "\<lbrakk>\<And>x y. (f x = f y) = (x = y); Card_order r\<rbrakk> \<Longrightarrow> r =o dir_image r f"
    7.18 -by (rule dir_image_ordIso) (auto simp add: inj_on_def card_order_on_def)
    7.19 -
    7.20 -(*should supersede a weaker lemma from the library*)
    7.21 -lemma dir_image_Field: "Field (dir_image r f) = f ` Field r"
    7.22 -unfolding dir_image_def Field_def Range_def Domain_def by fast
    7.23 -
    7.24 -lemma card_order_dir_image:
    7.25 -  assumes bij: "bij f" and co: "card_order r"
    7.26 -  shows "card_order (dir_image r f)"
    7.27 -proof -
    7.28 -  from assms have "Field (dir_image r f) = UNIV"
    7.29 -    using card_order_on_Card_order[of UNIV r] unfolding bij_def dir_image_Field by auto
    7.30 -  moreover from bij have "\<And>x y. (f x = f y) = (x = y)" unfolding bij_def inj_on_def by auto
    7.31 -  with co have "Card_order (dir_image r f)"
    7.32 -    using card_order_on_Card_order[of UNIV r] Card_order_ordIso2[OF _ dir_image] by blast
    7.33 -  ultimately show ?thesis by auto
    7.34 -qed
    7.35 -
    7.36 -lemma ordIso_refl: "Card_order r \<Longrightarrow> r =o r"
    7.37 -by (rule card_order_on_ordIso)
    7.38 -
    7.39 -lemma ordLeq_refl: "Card_order r \<Longrightarrow> r \<le>o r"
    7.40 -by (rule ordIso_imp_ordLeq, rule card_order_on_ordIso)
    7.41 -
    7.42 -lemma card_of_ordIso_subst: "A = B \<Longrightarrow> |A| =o |B|"
    7.43 -by (simp only: ordIso_refl card_of_Card_order)
    7.44 -
    7.45 -lemma Field_card_order: "card_order r \<Longrightarrow> Field r = UNIV"
    7.46 -using card_order_on_Card_order[of UNIV r] by simp
    7.47 -
    7.48 -lemma card_of_Times_Plus_distrib:
    7.49 -  "|A <*> (B <+> C)| =o |A <*> B <+> A <*> C|" (is "|?RHS| =o |?LHS|")
    7.50 -proof -
    7.51 -  let ?f = "\<lambda>(a, bc). case bc of Inl b \<Rightarrow> Inl (a, b) | Inr c \<Rightarrow> Inr (a, c)"
    7.52 -  have "bij_betw ?f ?RHS ?LHS" unfolding bij_betw_def inj_on_def by force
    7.53 -  thus ?thesis using card_of_ordIso by blast
    7.54 -qed
    7.55 -
    7.56 -lemma Func_Times_Range:
    7.57 -  "|Func A (B <*> C)| =o |Func A B <*> Func A C|" (is "|?LHS| =o |?RHS|")
    7.58 -proof -
    7.59 -  let ?F = "\<lambda>fg. (\<lambda>x. if x \<in> A then fst (fg x) else undefined,
    7.60 -                  \<lambda>x. if x \<in> A then snd (fg x) else undefined)"
    7.61 -  let ?G = "\<lambda>(f, g) x. if x \<in> A then (f x, g x) else undefined"
    7.62 -  have "bij_betw ?F ?LHS ?RHS" unfolding bij_betw_def inj_on_def
    7.63 -  apply safe
    7.64 -     apply (simp add: Func_def fun_eq_iff)
    7.65 -     apply (metis (no_types) pair_collapse)
    7.66 -    apply (auto simp: Func_def fun_eq_iff)[2]
    7.67 -  proof -
    7.68 -    fix f g assume "f \<in> Func A B" "g \<in> Func A C"
    7.69 -    thus "(f, g) \<in> ?F ` Func A (B \<times> C)"
    7.70 -      by (intro image_eqI[of _ _ "?G (f, g)"]) (auto simp: Func_def)
    7.71 -  qed
    7.72 -  thus ?thesis using card_of_ordIso by blast
    7.73 -qed
    7.74 -
    7.75 -
    7.76 -subsection {* Zero *}
    7.77 -
    7.78 -definition czero where
    7.79 -  "czero = card_of {}"
    7.80 -
    7.81 -lemma czero_ordIso:
    7.82 -  "czero =o czero"
    7.83 -using card_of_empty_ordIso by (simp add: czero_def)
    7.84 -
    7.85 -lemma card_of_ordIso_czero_iff_empty:
    7.86 -  "|A| =o (czero :: 'b rel) \<longleftrightarrow> A = ({} :: 'a set)"
    7.87 -unfolding czero_def by (rule iffI[OF card_of_empty2]) (auto simp: card_of_refl card_of_empty_ordIso)
    7.88 -
    7.89 -(* A "not czero" Cardinal predicate *)
    7.90 -abbreviation Cnotzero where
    7.91 -  "Cnotzero (r :: 'a rel) \<equiv> \<not>(r =o (czero :: 'a rel)) \<and> Card_order r"
    7.92 -
    7.93 -(*helper*)
    7.94 -lemma Cnotzero_imp_not_empty: "Cnotzero r \<Longrightarrow> Field r \<noteq> {}"
    7.95 -by (metis Card_order_iff_ordIso_card_of czero_def)
    7.96 -
    7.97 -lemma czeroI:
    7.98 -  "\<lbrakk>Card_order r; Field r = {}\<rbrakk> \<Longrightarrow> r =o czero"
    7.99 -using Cnotzero_imp_not_empty ordIso_transitive[OF _ czero_ordIso] by blast
   7.100 -
   7.101 -lemma czeroE:
   7.102 -  "r =o czero \<Longrightarrow> Field r = {}"
   7.103 -unfolding czero_def
   7.104 -by (drule card_of_cong) (simp only: Field_card_of card_of_empty2)
   7.105 -
   7.106 -lemma Cnotzero_mono:
   7.107 -  "\<lbrakk>Cnotzero r; Card_order q; r \<le>o q\<rbrakk> \<Longrightarrow> Cnotzero q"
   7.108 -apply (rule ccontr)
   7.109 -apply auto
   7.110 -apply (drule czeroE)
   7.111 -apply (erule notE)
   7.112 -apply (erule czeroI)
   7.113 -apply (drule card_of_mono2)
   7.114 -apply (simp only: card_of_empty3)
   7.115 -done
   7.116 -
   7.117 -subsection {* (In)finite cardinals *}
   7.118 -
   7.119 -definition cinfinite where
   7.120 -  "cinfinite r = (\<not> finite (Field r))"
   7.121 -
   7.122 -abbreviation Cinfinite where
   7.123 -  "Cinfinite r \<equiv> cinfinite r \<and> Card_order r"
   7.124 -
   7.125 -definition cfinite where
   7.126 -  "cfinite r = finite (Field r)"
   7.127 -
   7.128 -abbreviation Cfinite where
   7.129 -  "Cfinite r \<equiv> cfinite r \<and> Card_order r"
   7.130 -
   7.131 -lemma Cfinite_ordLess_Cinfinite: "\<lbrakk>Cfinite r; Cinfinite s\<rbrakk> \<Longrightarrow> r <o s"
   7.132 -  unfolding cfinite_def cinfinite_def
   7.133 -  by (metis card_order_on_well_order_on finite_ordLess_infinite)
   7.134 -
   7.135 -lemmas natLeq_card_order = natLeq_Card_order[unfolded Field_natLeq]
   7.136 -
   7.137 -lemma natLeq_cinfinite: "cinfinite natLeq"
   7.138 -unfolding cinfinite_def Field_natLeq by (metis infinite_UNIV_nat)
   7.139 -
   7.140 -lemma natLeq_ordLeq_cinfinite:
   7.141 -  assumes inf: "Cinfinite r"
   7.142 -  shows "natLeq \<le>o r"
   7.143 -proof -
   7.144 -  from inf have "natLeq \<le>o |Field r|" by (metis cinfinite_def infinite_iff_natLeq_ordLeq)
   7.145 -  also from inf have "|Field r| =o r" by (simp add: card_of_unique ordIso_symmetric)
   7.146 -  finally show ?thesis .
   7.147 -qed
   7.148 -
   7.149 -lemma cinfinite_not_czero: "cinfinite r \<Longrightarrow> \<not> (r =o (czero :: 'a rel))"
   7.150 -unfolding cinfinite_def by (metis czeroE finite.emptyI)
   7.151 -
   7.152 -lemma Cinfinite_Cnotzero: "Cinfinite r \<Longrightarrow> Cnotzero r"
   7.153 -by (metis cinfinite_not_czero)
   7.154 -
   7.155 -lemma Cinfinite_cong: "\<lbrakk>r1 =o r2; Cinfinite r1\<rbrakk> \<Longrightarrow> Cinfinite r2"
   7.156 -by (metis Card_order_ordIso2 card_of_mono2 card_of_ordLeq_infinite cinfinite_def ordIso_iff_ordLeq)
   7.157 -
   7.158 -lemma cinfinite_mono: "\<lbrakk>r1 \<le>o r2; cinfinite r1\<rbrakk> \<Longrightarrow> cinfinite r2"
   7.159 -by (metis card_of_mono2 card_of_ordLeq_infinite cinfinite_def)
   7.160 -
   7.161 -
   7.162 -subsection {* Binary sum *}
   7.163 -
   7.164 -definition csum (infixr "+c" 65) where
   7.165 -  "r1 +c r2 \<equiv> |Field r1 <+> Field r2|"
   7.166 -
   7.167 -lemma Field_csum: "Field (r +c s) = Inl ` Field r \<union> Inr ` Field s"
   7.168 -  unfolding csum_def Field_card_of by auto
   7.169 -
   7.170 -lemma Card_order_csum:
   7.171 -  "Card_order (r1 +c r2)"
   7.172 -unfolding csum_def by (simp add: card_of_Card_order)
   7.173 -
   7.174 -lemma csum_Cnotzero1:
   7.175 -  "Cnotzero r1 \<Longrightarrow> Cnotzero (r1 +c r2)"
   7.176 -unfolding csum_def
   7.177 -by (metis Cnotzero_imp_not_empty Plus_eq_empty_conv card_of_Card_order card_of_ordIso_czero_iff_empty)
   7.178 -
   7.179 -lemma card_order_csum:
   7.180 -  assumes "card_order r1" "card_order r2"
   7.181 -  shows "card_order (r1 +c r2)"
   7.182 -proof -
   7.183 -  have "Field r1 = UNIV" "Field r2 = UNIV" using assms card_order_on_Card_order by auto
   7.184 -  thus ?thesis unfolding csum_def by (auto simp: card_of_card_order_on)
   7.185 -qed
   7.186 -
   7.187 -lemma cinfinite_csum:
   7.188 -  "cinfinite r1 \<or> cinfinite r2 \<Longrightarrow> cinfinite (r1 +c r2)"
   7.189 -unfolding cinfinite_def csum_def by (auto simp: Field_card_of)
   7.190 -
   7.191 -lemma Cinfinite_csum1:
   7.192 -  "Cinfinite r1 \<Longrightarrow> Cinfinite (r1 +c r2)"
   7.193 -unfolding cinfinite_def csum_def by (metis Field_card_of card_of_Card_order finite_Plus_iff)
   7.194 -
   7.195 -lemma Cinfinite_csum:
   7.196 -  "Cinfinite r1 \<or> Cinfinite r2 \<Longrightarrow> Cinfinite (r1 +c r2)"
   7.197 -unfolding cinfinite_def csum_def by (metis Field_card_of card_of_Card_order finite_Plus_iff)
   7.198 -
   7.199 -lemma Cinfinite_csum_strong:
   7.200 -  "\<lbrakk>Cinfinite r1; Cinfinite r2\<rbrakk> \<Longrightarrow> Cinfinite (r1 +c r2)"
   7.201 -by (metis Cinfinite_csum)
   7.202 -
   7.203 -lemma csum_cong: "\<lbrakk>p1 =o r1; p2 =o r2\<rbrakk> \<Longrightarrow> p1 +c p2 =o r1 +c r2"
   7.204 -by (simp only: csum_def ordIso_Plus_cong)
   7.205 -
   7.206 -lemma csum_cong1: "p1 =o r1 \<Longrightarrow> p1 +c q =o r1 +c q"
   7.207 -by (simp only: csum_def ordIso_Plus_cong1)
   7.208 -
   7.209 -lemma csum_cong2: "p2 =o r2 \<Longrightarrow> q +c p2 =o q +c r2"
   7.210 -by (simp only: csum_def ordIso_Plus_cong2)
   7.211 -
   7.212 -lemma csum_mono: "\<lbrakk>p1 \<le>o r1; p2 \<le>o r2\<rbrakk> \<Longrightarrow> p1 +c p2 \<le>o r1 +c r2"
   7.213 -by (simp only: csum_def ordLeq_Plus_mono)
   7.214 -
   7.215 -lemma csum_mono1: "p1 \<le>o r1 \<Longrightarrow> p1 +c q \<le>o r1 +c q"
   7.216 -by (simp only: csum_def ordLeq_Plus_mono1)
   7.217 -
   7.218 -lemma csum_mono2: "p2 \<le>o r2 \<Longrightarrow> q +c p2 \<le>o q +c r2"
   7.219 -by (simp only: csum_def ordLeq_Plus_mono2)
   7.220 -
   7.221 -lemma ordLeq_csum1: "Card_order p1 \<Longrightarrow> p1 \<le>o p1 +c p2"
   7.222 -by (simp only: csum_def Card_order_Plus1)
   7.223 -
   7.224 -lemma ordLeq_csum2: "Card_order p2 \<Longrightarrow> p2 \<le>o p1 +c p2"
   7.225 -by (simp only: csum_def Card_order_Plus2)
   7.226 -
   7.227 -lemma csum_com: "p1 +c p2 =o p2 +c p1"
   7.228 -by (simp only: csum_def card_of_Plus_commute)
   7.229 -
   7.230 -lemma csum_assoc: "(p1 +c p2) +c p3 =o p1 +c p2 +c p3"
   7.231 -by (simp only: csum_def Field_card_of card_of_Plus_assoc)
   7.232 -
   7.233 -lemma Cfinite_csum: "\<lbrakk>Cfinite r; Cfinite s\<rbrakk> \<Longrightarrow> Cfinite (r +c s)"
   7.234 -  unfolding cfinite_def csum_def Field_card_of using card_of_card_order_on by simp
   7.235 -
   7.236 -lemma csum_csum: "(r1 +c r2) +c (r3 +c r4) =o (r1 +c r3) +c (r2 +c r4)"
   7.237 -proof -
   7.238 -  have "(r1 +c r2) +c (r3 +c r4) =o r1 +c r2 +c (r3 +c r4)"
   7.239 -    by (metis csum_assoc)
   7.240 -  also have "r1 +c r2 +c (r3 +c r4) =o r1 +c (r2 +c r3) +c r4"
   7.241 -    by (metis csum_assoc csum_cong2 ordIso_symmetric)
   7.242 -  also have "r1 +c (r2 +c r3) +c r4 =o r1 +c (r3 +c r2) +c r4"
   7.243 -    by (metis csum_com csum_cong1 csum_cong2)
   7.244 -  also have "r1 +c (r3 +c r2) +c r4 =o r1 +c r3 +c r2 +c r4"
   7.245 -    by (metis csum_assoc csum_cong2 ordIso_symmetric)
   7.246 -  also have "r1 +c r3 +c r2 +c r4 =o (r1 +c r3) +c (r2 +c r4)"
   7.247 -    by (metis csum_assoc ordIso_symmetric)
   7.248 -  finally show ?thesis .
   7.249 -qed
   7.250 -
   7.251 -lemma Plus_csum: "|A <+> B| =o |A| +c |B|"
   7.252 -by (simp only: csum_def Field_card_of card_of_refl)
   7.253 -
   7.254 -lemma Un_csum: "|A \<union> B| \<le>o |A| +c |B|"
   7.255 -using ordLeq_ordIso_trans[OF card_of_Un_Plus_ordLeq Plus_csum] by blast
   7.256 -
   7.257 -
   7.258 -subsection {* One *}
   7.259 -
   7.260 -definition cone where
   7.261 -  "cone = card_of {()}"
   7.262 -
   7.263 -lemma Card_order_cone: "Card_order cone"
   7.264 -unfolding cone_def by (rule card_of_Card_order)
   7.265 -
   7.266 -lemma Cfinite_cone: "Cfinite cone"
   7.267 -  unfolding cfinite_def by (simp add: Card_order_cone)
   7.268 -
   7.269 -lemma cone_not_czero: "\<not> (cone =o czero)"
   7.270 -unfolding czero_def cone_def by (metis empty_not_insert card_of_empty3[of "{()}"] ordIso_iff_ordLeq)
   7.271 -
   7.272 -lemma cone_ordLeq_Cnotzero: "Cnotzero r \<Longrightarrow> cone \<le>o r"
   7.273 -unfolding cone_def by (metis Card_order_singl_ordLeq czeroI)
   7.274 -
   7.275 -
   7.276 -subsection {* Two *}
   7.277 -
   7.278 -definition ctwo where
   7.279 -  "ctwo = |UNIV :: bool set|"
   7.280 -
   7.281 -lemma Card_order_ctwo: "Card_order ctwo"
   7.282 -unfolding ctwo_def by (rule card_of_Card_order)
   7.283 -
   7.284 -lemma ctwo_not_czero: "\<not> (ctwo =o czero)"
   7.285 -using card_of_empty3[of "UNIV :: bool set"] ordIso_iff_ordLeq
   7.286 -unfolding czero_def ctwo_def by (metis UNIV_not_empty)
   7.287 -
   7.288 -lemma ctwo_Cnotzero: "Cnotzero ctwo"
   7.289 -by (simp add: ctwo_not_czero Card_order_ctwo)
   7.290 -
   7.291 -
   7.292 -subsection {* Family sum *}
   7.293 -
   7.294 -definition Csum where
   7.295 -  "Csum r rs \<equiv> |SIGMA i : Field r. Field (rs i)|"
   7.296 -
   7.297 -(* Similar setup to the one for SIGMA from theory Big_Operators: *)
   7.298 -syntax "_Csum" ::
   7.299 -  "pttrn => ('a * 'a) set => 'b * 'b set => (('a * 'b) * ('a * 'b)) set"
   7.300 -  ("(3CSUM _:_. _)" [0, 51, 10] 10)
   7.301 -
   7.302 -translations
   7.303 -  "CSUM i:r. rs" == "CONST Csum r (%i. rs)"
   7.304 -
   7.305 -lemma SIGMA_CSUM: "|SIGMA i : I. As i| = (CSUM i : |I|. |As i| )"
   7.306 -by (auto simp: Csum_def Field_card_of)
   7.307 -
   7.308 -(* NB: Always, under the cardinal operator,
   7.309 -operations on sets are reduced automatically to operations on cardinals.
   7.310 -This should make cardinal reasoning more direct and natural.  *)
   7.311 -
   7.312 -
   7.313 -subsection {* Product *}
   7.314 -
   7.315 -definition cprod (infixr "*c" 80) where
   7.316 -  "r1 *c r2 = |Field r1 <*> Field r2|"
   7.317 -
   7.318 -lemma card_order_cprod:
   7.319 -  assumes "card_order r1" "card_order r2"
   7.320 -  shows "card_order (r1 *c r2)"
   7.321 -proof -
   7.322 -  have "Field r1 = UNIV" "Field r2 = UNIV" using assms card_order_on_Card_order by auto
   7.323 -  thus ?thesis by (auto simp: cprod_def card_of_card_order_on)
   7.324 -qed
   7.325 -
   7.326 -lemma Card_order_cprod: "Card_order (r1 *c r2)"
   7.327 -by (simp only: cprod_def Field_card_of card_of_card_order_on)
   7.328 -
   7.329 -lemma cprod_mono1: "p1 \<le>o r1 \<Longrightarrow> p1 *c q \<le>o r1 *c q"
   7.330 -by (simp only: cprod_def ordLeq_Times_mono1)
   7.331 -
   7.332 -lemma cprod_mono2: "p2 \<le>o r2 \<Longrightarrow> q *c p2 \<le>o q *c r2"
   7.333 -by (simp only: cprod_def ordLeq_Times_mono2)
   7.334 -
   7.335 -lemma ordLeq_cprod2: "\<lbrakk>Cnotzero p1; Card_order p2\<rbrakk> \<Longrightarrow> p2 \<le>o p1 *c p2"
   7.336 -unfolding cprod_def by (metis Card_order_Times2 czeroI)
   7.337 -
   7.338 -lemma cinfinite_cprod: "\<lbrakk>cinfinite r1; cinfinite r2\<rbrakk> \<Longrightarrow> cinfinite (r1 *c r2)"
   7.339 -by (simp add: cinfinite_def cprod_def Field_card_of infinite_cartesian_product)
   7.340 -
   7.341 -lemma cinfinite_cprod2: "\<lbrakk>Cnotzero r1; Cinfinite r2\<rbrakk> \<Longrightarrow> cinfinite (r1 *c r2)"
   7.342 -by (metis cinfinite_mono ordLeq_cprod2)
   7.343 -
   7.344 -lemma Cinfinite_cprod2: "\<lbrakk>Cnotzero r1; Cinfinite r2\<rbrakk> \<Longrightarrow> Cinfinite (r1 *c r2)"
   7.345 -by (blast intro: cinfinite_cprod2 Card_order_cprod)
   7.346 -
   7.347 -lemma cprod_com: "p1 *c p2 =o p2 *c p1"
   7.348 -by (simp only: cprod_def card_of_Times_commute)
   7.349 -
   7.350 -lemma card_of_Csum_Times:
   7.351 -  "\<forall>i \<in> I. |A i| \<le>o |B| \<Longrightarrow> (CSUM i : |I|. |A i| ) \<le>o |I| *c |B|"
   7.352 -by (simp only: Csum_def cprod_def Field_card_of card_of_Sigma_Times)
   7.353 -
   7.354 -lemma card_of_Csum_Times':
   7.355 -  assumes "Card_order r" "\<forall>i \<in> I. |A i| \<le>o r"
   7.356 -  shows "(CSUM i : |I|. |A i| ) \<le>o |I| *c r"
   7.357 -proof -
   7.358 -  from assms(1) have *: "r =o |Field r|" by (simp add: card_of_unique)
   7.359 -  with assms(2) have "\<forall>i \<in> I. |A i| \<le>o |Field r|" by (blast intro: ordLeq_ordIso_trans)
   7.360 -  hence "(CSUM i : |I|. |A i| ) \<le>o |I| *c |Field r|" by (simp only: card_of_Csum_Times)
   7.361 -  also from * have "|I| *c |Field r| \<le>o |I| *c r"
   7.362 -    by (simp only: Field_card_of card_of_refl cprod_def ordIso_imp_ordLeq)
   7.363 -  finally show ?thesis .
   7.364 -qed
   7.365 -
   7.366 -lemma cprod_csum_distrib1: "r1 *c r2 +c r1 *c r3 =o r1 *c (r2 +c r3)"
   7.367 -unfolding csum_def cprod_def by (simp add: Field_card_of card_of_Times_Plus_distrib ordIso_symmetric)
   7.368 -
   7.369 -lemma csum_absorb2': "\<lbrakk>Card_order r2; r1 \<le>o r2; cinfinite r1 \<or> cinfinite r2\<rbrakk> \<Longrightarrow> r1 +c r2 =o r2"
   7.370 -unfolding csum_def by (metis Card_order_Plus_infinite cinfinite_def cinfinite_mono)
   7.371 -
   7.372 -lemma csum_absorb1':
   7.373 -  assumes card: "Card_order r2"
   7.374 -  and r12: "r1 \<le>o r2" and cr12: "cinfinite r1 \<or> cinfinite r2"
   7.375 -  shows "r2 +c r1 =o r2"
   7.376 -by (rule ordIso_transitive, rule csum_com, rule csum_absorb2', (simp only: assms)+)
   7.377 -
   7.378 -lemma csum_absorb1: "\<lbrakk>Cinfinite r2; r1 \<le>o r2\<rbrakk> \<Longrightarrow> r2 +c r1 =o r2"
   7.379 -by (rule csum_absorb1') auto
   7.380 -
   7.381 -
   7.382 -subsection {* Exponentiation *}
   7.383 -
   7.384 -definition cexp (infixr "^c" 90) where
   7.385 -  "r1 ^c r2 \<equiv> |Func (Field r2) (Field r1)|"
   7.386 -
   7.387 -lemma Card_order_cexp: "Card_order (r1 ^c r2)"
   7.388 -unfolding cexp_def by (rule card_of_Card_order)
   7.389 -
   7.390 -lemma cexp_mono':
   7.391 -  assumes 1: "p1 \<le>o r1" and 2: "p2 \<le>o r2"
   7.392 -  and n: "Field p2 = {} \<Longrightarrow> Field r2 = {}"
   7.393 -  shows "p1 ^c p2 \<le>o r1 ^c r2"
   7.394 -proof(cases "Field p1 = {}")
   7.395 -  case True
   7.396 -  hence "|Field |Func (Field p2) (Field p1)|| \<le>o cone"
   7.397 -    unfolding cone_def Field_card_of
   7.398 -    by (cases "Field p2 = {}", auto intro: card_of_ordLeqI2 simp: Func_empty)
   7.399 -       (metis Func_is_emp card_of_empty ex_in_conv)
   7.400 -  hence "|Func (Field p2) (Field p1)| \<le>o cone" by (simp add: Field_card_of cexp_def)
   7.401 -  hence "p1 ^c p2 \<le>o cone" unfolding cexp_def .
   7.402 -  thus ?thesis
   7.403 -  proof (cases "Field p2 = {}")
   7.404 -    case True
   7.405 -    with n have "Field r2 = {}" .
   7.406 -    hence "cone \<le>o r1 ^c r2" unfolding cone_def cexp_def Func_def by (auto intro: card_of_ordLeqI)
   7.407 -    thus ?thesis using `p1 ^c p2 \<le>o cone` ordLeq_transitive by auto
   7.408 -  next
   7.409 -    case False with True have "|Field (p1 ^c p2)| =o czero"
   7.410 -      unfolding card_of_ordIso_czero_iff_empty cexp_def Field_card_of Func_def by auto
   7.411 -    thus ?thesis unfolding cexp_def card_of_ordIso_czero_iff_empty Field_card_of
   7.412 -      by (simp add: card_of_empty)
   7.413 -  qed
   7.414 -next
   7.415 -  case False
   7.416 -  have 1: "|Field p1| \<le>o |Field r1|" and 2: "|Field p2| \<le>o |Field r2|"
   7.417 -    using 1 2 by (auto simp: card_of_mono2)
   7.418 -  obtain f1 where f1: "f1 ` Field r1 = Field p1"
   7.419 -    using 1 unfolding card_of_ordLeq2[OF False, symmetric] by auto
   7.420 -  obtain f2 where f2: "inj_on f2 (Field p2)" "f2 ` Field p2 \<subseteq> Field r2"
   7.421 -    using 2 unfolding card_of_ordLeq[symmetric] by blast
   7.422 -  have 0: "Func_map (Field p2) f1 f2 ` (Field (r1 ^c r2)) = Field (p1 ^c p2)"
   7.423 -    unfolding cexp_def Field_card_of using Func_map_surj[OF f1 f2 n, symmetric] .
   7.424 -  have 00: "Field (p1 ^c p2) \<noteq> {}" unfolding cexp_def Field_card_of Func_is_emp
   7.425 -    using False by simp
   7.426 -  show ?thesis
   7.427 -    using 0 card_of_ordLeq2[OF 00] unfolding cexp_def Field_card_of by blast
   7.428 -qed
   7.429 -
   7.430 -lemma cexp_mono:
   7.431 -  assumes 1: "p1 \<le>o r1" and 2: "p2 \<le>o r2"
   7.432 -  and n: "p2 =o czero \<Longrightarrow> r2 =o czero" and card: "Card_order p2"
   7.433 -  shows "p1 ^c p2 \<le>o r1 ^c r2"
   7.434 -  by (metis (full_types) "1" "2" card cexp_mono' czeroE czeroI n)
   7.435 -
   7.436 -lemma cexp_mono1:
   7.437 -  assumes 1: "p1 \<le>o r1" and q: "Card_order q"
   7.438 -  shows "p1 ^c q \<le>o r1 ^c q"
   7.439 -using ordLeq_refl[OF q] by (rule cexp_mono[OF 1]) (auto simp: q)
   7.440 -
   7.441 -lemma cexp_mono2':
   7.442 -  assumes 2: "p2 \<le>o r2" and q: "Card_order q"
   7.443 -  and n: "Field p2 = {} \<Longrightarrow> Field r2 = {}"
   7.444 -  shows "q ^c p2 \<le>o q ^c r2"
   7.445 -using ordLeq_refl[OF q] by (rule cexp_mono'[OF _ 2 n]) auto
   7.446 -
   7.447 -lemma cexp_mono2:
   7.448 -  assumes 2: "p2 \<le>o r2" and q: "Card_order q"
   7.449 -  and n: "p2 =o czero \<Longrightarrow> r2 =o czero" and card: "Card_order p2"
   7.450 -  shows "q ^c p2 \<le>o q ^c r2"
   7.451 -using ordLeq_refl[OF q] by (rule cexp_mono[OF _ 2 n card]) auto
   7.452 -
   7.453 -lemma cexp_mono2_Cnotzero:
   7.454 -  assumes "p2 \<le>o r2" "Card_order q" "Cnotzero p2"
   7.455 -  shows "q ^c p2 \<le>o q ^c r2"
   7.456 -by (metis assms cexp_mono2' czeroI)
   7.457 -
   7.458 -lemma cexp_cong:
   7.459 -  assumes 1: "p1 =o r1" and 2: "p2 =o r2"
   7.460 -  and Cr: "Card_order r2"
   7.461 -  and Cp: "Card_order p2"
   7.462 -  shows "p1 ^c p2 =o r1 ^c r2"
   7.463 -proof -
   7.464 -  obtain f where "bij_betw f (Field p2) (Field r2)"
   7.465 -    using 2 card_of_ordIso[of "Field p2" "Field r2"] card_of_cong by auto
   7.466 -  hence 0: "Field p2 = {} \<longleftrightarrow> Field r2 = {}" unfolding bij_betw_def by auto
   7.467 -  have r: "p2 =o czero \<Longrightarrow> r2 =o czero"
   7.468 -    and p: "r2 =o czero \<Longrightarrow> p2 =o czero"
   7.469 -     using 0 Cr Cp czeroE czeroI by auto
   7.470 -  show ?thesis using 0 1 2 unfolding ordIso_iff_ordLeq
   7.471 -    using r p cexp_mono[OF _ _ _ Cp] cexp_mono[OF _ _ _ Cr] by metis
   7.472 -qed
   7.473 -
   7.474 -lemma cexp_cong1:
   7.475 -  assumes 1: "p1 =o r1" and q: "Card_order q"
   7.476 -  shows "p1 ^c q =o r1 ^c q"
   7.477 -by (rule cexp_cong[OF 1 _ q q]) (rule ordIso_refl[OF q])
   7.478 -
   7.479 -lemma cexp_cong2:
   7.480 -  assumes 2: "p2 =o r2" and q: "Card_order q" and p: "Card_order p2"
   7.481 -  shows "q ^c p2 =o q ^c r2"
   7.482 -by (rule cexp_cong[OF _ 2]) (auto simp only: ordIso_refl Card_order_ordIso2[OF p 2] q p)
   7.483 -
   7.484 -lemma cexp_cone:
   7.485 -  assumes "Card_order r"
   7.486 -  shows "r ^c cone =o r"
   7.487 -proof -
   7.488 -  have "r ^c cone =o |Field r|"
   7.489 -    unfolding cexp_def cone_def Field_card_of Func_empty
   7.490 -      card_of_ordIso[symmetric] bij_betw_def Func_def inj_on_def image_def
   7.491 -    by (rule exI[of _ "\<lambda>f. f ()"]) auto
   7.492 -  also have "|Field r| =o r" by (rule card_of_Field_ordIso[OF assms])
   7.493 -  finally show ?thesis .
   7.494 -qed
   7.495 -
   7.496 -lemma cexp_cprod:
   7.497 -  assumes r1: "Card_order r1"
   7.498 -  shows "(r1 ^c r2) ^c r3 =o r1 ^c (r2 *c r3)" (is "?L =o ?R")
   7.499 -proof -
   7.500 -  have "?L =o r1 ^c (r3 *c r2)"
   7.501 -    unfolding cprod_def cexp_def Field_card_of
   7.502 -    using card_of_Func_Times by(rule ordIso_symmetric)
   7.503 -  also have "r1 ^c (r3 *c r2) =o ?R"
   7.504 -    apply(rule cexp_cong2) using cprod_com r1 by (auto simp: Card_order_cprod)
   7.505 -  finally show ?thesis .
   7.506 -qed
   7.507 -
   7.508 -lemma cprod_infinite1': "\<lbrakk>Cinfinite r; Cnotzero p; p \<le>o r\<rbrakk> \<Longrightarrow> r *c p =o r"
   7.509 -unfolding cinfinite_def cprod_def
   7.510 -by (rule Card_order_Times_infinite[THEN conjunct1]) (blast intro: czeroI)+
   7.511 -
   7.512 -lemma cexp_cprod_ordLeq:
   7.513 -  assumes r1: "Card_order r1" and r2: "Cinfinite r2"
   7.514 -  and r3: "Cnotzero r3" "r3 \<le>o r2"
   7.515 -  shows "(r1 ^c r2) ^c r3 =o r1 ^c r2" (is "?L =o ?R")
   7.516 -proof-
   7.517 -  have "?L =o r1 ^c (r2 *c r3)" using cexp_cprod[OF r1] .
   7.518 -  also have "r1 ^c (r2 *c r3) =o ?R"
   7.519 -  apply(rule cexp_cong2)
   7.520 -  apply(rule cprod_infinite1'[OF r2 r3]) using r1 r2 by (fastforce simp: Card_order_cprod)+
   7.521 -  finally show ?thesis .
   7.522 -qed
   7.523 -
   7.524 -lemma Cnotzero_UNIV: "Cnotzero |UNIV|"
   7.525 -by (auto simp: card_of_Card_order card_of_ordIso_czero_iff_empty)
   7.526 -
   7.527 -lemma ordLess_ctwo_cexp:
   7.528 -  assumes "Card_order r"
   7.529 -  shows "r <o ctwo ^c r"
   7.530 -proof -
   7.531 -  have "r <o |Pow (Field r)|" using assms by (rule Card_order_Pow)
   7.532 -  also have "|Pow (Field r)| =o ctwo ^c r"
   7.533 -    unfolding ctwo_def cexp_def Field_card_of by (rule card_of_Pow_Func)
   7.534 -  finally show ?thesis .
   7.535 -qed
   7.536 -
   7.537 -lemma ordLeq_cexp1:
   7.538 -  assumes "Cnotzero r" "Card_order q"
   7.539 -  shows "q \<le>o q ^c r"
   7.540 -proof (cases "q =o (czero :: 'a rel)")
   7.541 -  case True thus ?thesis by (simp only: card_of_empty cexp_def czero_def ordIso_ordLeq_trans)
   7.542 -next
   7.543 -  case False
   7.544 -  thus ?thesis
   7.545 -    apply -
   7.546 -    apply (rule ordIso_ordLeq_trans)
   7.547 -    apply (rule ordIso_symmetric)
   7.548 -    apply (rule cexp_cone)
   7.549 -    apply (rule assms(2))
   7.550 -    apply (rule cexp_mono2)
   7.551 -    apply (rule cone_ordLeq_Cnotzero)
   7.552 -    apply (rule assms(1))
   7.553 -    apply (rule assms(2))
   7.554 -    apply (rule notE)
   7.555 -    apply (rule cone_not_czero)
   7.556 -    apply assumption
   7.557 -    apply (rule Card_order_cone)
   7.558 -  done
   7.559 -qed
   7.560 -
   7.561 -lemma ordLeq_cexp2:
   7.562 -  assumes "ctwo \<le>o q" "Card_order r"
   7.563 -  shows "r \<le>o q ^c r"
   7.564 -proof (cases "r =o (czero :: 'a rel)")
   7.565 -  case True thus ?thesis by (simp only: card_of_empty cexp_def czero_def ordIso_ordLeq_trans)
   7.566 -next
   7.567 -  case False thus ?thesis
   7.568 -    apply -
   7.569 -    apply (rule ordLess_imp_ordLeq)
   7.570 -    apply (rule ordLess_ordLeq_trans)
   7.571 -    apply (rule ordLess_ctwo_cexp)
   7.572 -    apply (rule assms(2))
   7.573 -    apply (rule cexp_mono1)
   7.574 -    apply (rule assms(1))
   7.575 -    apply (rule assms(2))
   7.576 -  done
   7.577 -qed
   7.578 -
   7.579 -lemma cinfinite_cexp: "\<lbrakk>ctwo \<le>o q; Cinfinite r\<rbrakk> \<Longrightarrow> cinfinite (q ^c r)"
   7.580 -by (metis assms cinfinite_mono ordLeq_cexp2)
   7.581 -
   7.582 -lemma Cinfinite_cexp:
   7.583 -  "\<lbrakk>ctwo \<le>o q; Cinfinite r\<rbrakk> \<Longrightarrow> Cinfinite (q ^c r)"
   7.584 -by (simp add: cinfinite_cexp Card_order_cexp)
   7.585 -
   7.586 -lemma ctwo_ordLess_natLeq: "ctwo <o natLeq"
   7.587 -unfolding ctwo_def using finite_UNIV natLeq_cinfinite natLeq_Card_order
   7.588 -by (intro Cfinite_ordLess_Cinfinite) (auto simp: cfinite_def card_of_Card_order)
   7.589 -
   7.590 -lemma ctwo_ordLess_Cinfinite: "Cinfinite r \<Longrightarrow> ctwo <o r"
   7.591 -by (metis ctwo_ordLess_natLeq natLeq_ordLeq_cinfinite ordLess_ordLeq_trans)
   7.592 -
   7.593 -lemma ctwo_ordLeq_Cinfinite:
   7.594 -  assumes "Cinfinite r"
   7.595 -  shows "ctwo \<le>o r"
   7.596 -by (rule ordLess_imp_ordLeq[OF ctwo_ordLess_Cinfinite[OF assms]])
   7.597 -
   7.598 -lemma Un_Cinfinite_bound: "\<lbrakk>|A| \<le>o r; |B| \<le>o r; Cinfinite r\<rbrakk> \<Longrightarrow> |A \<union> B| \<le>o r"
   7.599 -by (auto simp add: cinfinite_def card_of_Un_ordLeq_infinite_Field)
   7.600 -
   7.601 -lemma UNION_Cinfinite_bound: "\<lbrakk>|I| \<le>o r; \<forall>i \<in> I. |A i| \<le>o r; Cinfinite r\<rbrakk> \<Longrightarrow> |\<Union>i \<in> I. A i| \<le>o r"
   7.602 -by (auto simp add: card_of_UNION_ordLeq_infinite_Field cinfinite_def)
   7.603 -
   7.604 -lemma csum_cinfinite_bound:
   7.605 -  assumes "p \<le>o r" "q \<le>o r" "Card_order p" "Card_order q" "Cinfinite r"
   7.606 -  shows "p +c q \<le>o r"
   7.607 -proof -
   7.608 -  from assms(1-4) have "|Field p| \<le>o r" "|Field q| \<le>o r"
   7.609 -    unfolding card_order_on_def using card_of_least ordLeq_transitive by blast+
   7.610 -  with assms show ?thesis unfolding cinfinite_def csum_def
   7.611 -    by (blast intro: card_of_Plus_ordLeq_infinite_Field)
   7.612 -qed
   7.613 -
   7.614 -lemma cprod_cinfinite_bound:
   7.615 -  assumes "p \<le>o r" "q \<le>o r" "Card_order p" "Card_order q" "Cinfinite r"
   7.616 -  shows "p *c q \<le>o r"
   7.617 -proof -
   7.618 -  from assms(1-4) have "|Field p| \<le>o r" "|Field q| \<le>o r"
   7.619 -    unfolding card_order_on_def using card_of_least ordLeq_transitive by blast+
   7.620 -  with assms show ?thesis unfolding cinfinite_def cprod_def
   7.621 -    by (blast intro: card_of_Times_ordLeq_infinite_Field)
   7.622 -qed
   7.623 -
   7.624 -lemma cprod_csum_cexp:
   7.625 -  "r1 *c r2 \<le>o (r1 +c r2) ^c ctwo"
   7.626 -unfolding cprod_def csum_def cexp_def ctwo_def Field_card_of
   7.627 -proof -
   7.628 -  let ?f = "\<lambda>(a, b). %x. if x then Inl a else Inr b"
   7.629 -  have "inj_on ?f (Field r1 \<times> Field r2)" (is "inj_on _ ?LHS")
   7.630 -    by (auto simp: inj_on_def fun_eq_iff split: bool.split)
   7.631 -  moreover
   7.632 -  have "?f ` ?LHS \<subseteq> Func (UNIV :: bool set) (Field r1 <+> Field r2)" (is "_ \<subseteq> ?RHS")
   7.633 -    by (auto simp: Func_def)
   7.634 -  ultimately show "|?LHS| \<le>o |?RHS|" using card_of_ordLeq by blast
   7.635 -qed
   7.636 -
   7.637 -lemma Cfinite_cprod_Cinfinite: "\<lbrakk>Cfinite r; Cinfinite s\<rbrakk> \<Longrightarrow> r *c s \<le>o s"
   7.638 -by (intro cprod_cinfinite_bound)
   7.639 -  (auto intro: ordLeq_refl ordLess_imp_ordLeq[OF Cfinite_ordLess_Cinfinite])
   7.640 -
   7.641 -lemma cprod_cexp: "(r *c s) ^c t =o r ^c t *c s ^c t"
   7.642 -  unfolding cprod_def cexp_def Field_card_of by (rule Func_Times_Range)
   7.643 -
   7.644 -lemma cprod_cexp_csum_cexp_Cinfinite:
   7.645 -  assumes t: "Cinfinite t"
   7.646 -  shows "(r *c s) ^c t \<le>o (r +c s) ^c t"
   7.647 -proof -
   7.648 -  have "(r *c s) ^c t \<le>o ((r +c s) ^c ctwo) ^c t"
   7.649 -    by (rule cexp_mono1[OF cprod_csum_cexp conjunct2[OF t]])
   7.650 -  also have "((r +c s) ^c ctwo) ^c t =o (r +c s) ^c (ctwo *c t)"
   7.651 -    by (rule cexp_cprod[OF Card_order_csum])
   7.652 -  also have "(r +c s) ^c (ctwo *c t) =o (r +c s) ^c (t *c ctwo)"
   7.653 -    by (rule cexp_cong2[OF cprod_com Card_order_csum Card_order_cprod])
   7.654 -  also have "(r +c s) ^c (t *c ctwo) =o ((r +c s) ^c t) ^c ctwo"
   7.655 -    by (rule ordIso_symmetric[OF cexp_cprod[OF Card_order_csum]])
   7.656 -  also have "((r +c s) ^c t) ^c ctwo =o (r +c s) ^c t"
   7.657 -    by (rule cexp_cprod_ordLeq[OF Card_order_csum t ctwo_Cnotzero ctwo_ordLeq_Cinfinite[OF t]])
   7.658 -  finally show ?thesis .
   7.659 -qed
   7.660 -
   7.661 -lemma Cfinite_cexp_Cinfinite:
   7.662 -  assumes s: "Cfinite s" and t: "Cinfinite t"
   7.663 -  shows "s ^c t \<le>o ctwo ^c t"
   7.664 -proof (cases "s \<le>o ctwo")
   7.665 -  case True thus ?thesis using t by (blast intro: cexp_mono1)
   7.666 -next
   7.667 -  case False
   7.668 -  hence "ctwo \<le>o s" by (metis card_order_on_well_order_on ctwo_Cnotzero ordLeq_total s)
   7.669 -  hence "Cnotzero s" by (metis Cnotzero_mono ctwo_Cnotzero s)
   7.670 -  hence st: "Cnotzero (s *c t)" by (metis Cinfinite_cprod2 cinfinite_not_czero t)
   7.671 -  have "s ^c t \<le>o (ctwo ^c s) ^c t"
   7.672 -    using assms by (blast intro: cexp_mono1 ordLess_imp_ordLeq[OF ordLess_ctwo_cexp])
   7.673 -  also have "(ctwo ^c s) ^c t =o ctwo ^c (s *c t)"
   7.674 -    by (blast intro: Card_order_ctwo cexp_cprod)
   7.675 -  also have "ctwo ^c (s *c t) \<le>o ctwo ^c t"
   7.676 -    using assms st by (intro cexp_mono2_Cnotzero Cfinite_cprod_Cinfinite Card_order_ctwo)
   7.677 -  finally show ?thesis .
   7.678 -qed
   7.679 -
   7.680 -lemma csum_Cfinite_cexp_Cinfinite:
   7.681 -  assumes r: "Card_order r" and s: "Cfinite s" and t: "Cinfinite t"
   7.682 -  shows "(r +c s) ^c t \<le>o (r +c ctwo) ^c t"
   7.683 -proof (cases "Cinfinite r")
   7.684 -  case True
   7.685 -  hence "r +c s =o r" by (intro csum_absorb1 ordLess_imp_ordLeq[OF Cfinite_ordLess_Cinfinite] s)
   7.686 -  hence "(r +c s) ^c t =o r ^c t" using t by (blast intro: cexp_cong1)
   7.687 -  also have "r ^c t \<le>o (r +c ctwo) ^c t" using t by (blast intro: cexp_mono1 ordLeq_csum1 r)
   7.688 -  finally show ?thesis .
   7.689 -next
   7.690 -  case False
   7.691 -  with r have "Cfinite r" unfolding cinfinite_def cfinite_def by auto
   7.692 -  hence "Cfinite (r +c s)" by (intro Cfinite_csum s)
   7.693 -  hence "(r +c s) ^c t \<le>o ctwo ^c t" by (intro Cfinite_cexp_Cinfinite t)
   7.694 -  also have "ctwo ^c t \<le>o (r +c ctwo) ^c t" using t
   7.695 -    by (blast intro: cexp_mono1 ordLeq_csum2 Card_order_ctwo)
   7.696 -  finally show ?thesis .
   7.697 -qed
   7.698 -
   7.699 -(* cardSuc *)
   7.700 -
   7.701 -lemma Cinfinite_cardSuc: "Cinfinite r \<Longrightarrow> Cinfinite (cardSuc r)"
   7.702 -by (simp add: cinfinite_def cardSuc_Card_order cardSuc_finite)
   7.703 -
   7.704 -lemma cardSuc_UNION_Cinfinite:
   7.705 -  assumes "Cinfinite r" "relChain (cardSuc r) As" "B \<le> (UN i : Field (cardSuc r). As i)" "|B| <=o r"
   7.706 -  shows "EX i : Field (cardSuc r). B \<le> As i"
   7.707 -using cardSuc_UNION assms unfolding cinfinite_def by blast
   7.708 -
   7.709 -end
     8.1 --- a/src/HOL/Cardinal_Order_Relation_FP.thy	Mon Jan 20 18:24:55 2014 +0100
     8.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     8.3 @@ -1,1664 +0,0 @@
     8.4 -(*  Title:      HOL/Cardinal_Order_Relation_FP.thy
     8.5 -    Author:     Andrei Popescu, TU Muenchen
     8.6 -    Copyright   2012
     8.7 -
     8.8 -Cardinal-order relations (FP).
     8.9 -*)
    8.10 -
    8.11 -header {* Cardinal-Order Relations (FP) *}
    8.12 -
    8.13 -theory Cardinal_Order_Relation_FP
    8.14 -imports Constructions_on_Wellorders_FP
    8.15 -begin
    8.16 -
    8.17 -text{* In this section, we define cardinal-order relations to be minim well-orders
    8.18 -on their field.  Then we define the cardinal of a set to be {\em some} cardinal-order
    8.19 -relation on that set, which will be unique up to order isomorphism.  Then we study
    8.20 -the connection between cardinals and:
    8.21 -\begin{itemize}
    8.22 -\item standard set-theoretic constructions: products,
    8.23 -sums, unions, lists, powersets, set-of finite sets operator;
    8.24 -\item finiteness and infiniteness (in particular, with the numeric cardinal operator
    8.25 -for finite sets, @{text "card"}, from the theory @{text "Finite_Sets.thy"}).
    8.26 -\end{itemize}
    8.27 -%
    8.28 -On the way, we define the canonical $\omega$ cardinal and finite cardinals.  We also
    8.29 -define (again, up to order isomorphism) the successor of a cardinal, and show that
    8.30 -any cardinal admits a successor.
    8.31 -
    8.32 -Main results of this section are the existence of cardinal relations and the
    8.33 -facts that, in the presence of infiniteness,
    8.34 -most of the standard set-theoretic constructions (except for the powerset)
    8.35 -{\em do not increase cardinality}.  In particular, e.g., the set of words/lists over
    8.36 -any infinite set has the same cardinality (hence, is in bijection) with that set.
    8.37 -*}
    8.38 -
    8.39 -
    8.40 -subsection {* Cardinal orders *}
    8.41 -
    8.42 -text{* A cardinal order in our setting shall be a well-order {\em minim} w.r.t. the
    8.43 -order-embedding relation, @{text "\<le>o"} (which is the same as being {\em minimal} w.r.t. the
    8.44 -strict order-embedding relation, @{text "<o"}), among all the well-orders on its field.  *}
    8.45 -
    8.46 -definition card_order_on :: "'a set \<Rightarrow> 'a rel \<Rightarrow> bool"
    8.47 -where
    8.48 -"card_order_on A r \<equiv> well_order_on A r \<and> (\<forall>r'. well_order_on A r' \<longrightarrow> r \<le>o r')"
    8.49 -
    8.50 -abbreviation "Card_order r \<equiv> card_order_on (Field r) r"
    8.51 -abbreviation "card_order r \<equiv> card_order_on UNIV r"
    8.52 -
    8.53 -lemma card_order_on_well_order_on:
    8.54 -assumes "card_order_on A r"
    8.55 -shows "well_order_on A r"
    8.56 -using assms unfolding card_order_on_def by simp
    8.57 -
    8.58 -lemma card_order_on_Card_order:
    8.59 -"card_order_on A r \<Longrightarrow> A = Field r \<and> Card_order r"
    8.60 -unfolding card_order_on_def using well_order_on_Field by blast
    8.61 -
    8.62 -text{* The existence of a cardinal relation on any given set (which will mean
    8.63 -that any set has a cardinal) follows from two facts:
    8.64 -\begin{itemize}
    8.65 -\item Zermelo's theorem (proved in @{text "Zorn.thy"} as theorem @{text "well_order_on"}),
    8.66 -which states that on any given set there exists a well-order;
    8.67 -\item The well-founded-ness of @{text "<o"}, ensuring that then there exists a minimal
    8.68 -such well-order, i.e., a cardinal order.
    8.69 -\end{itemize}
    8.70 -*}
    8.71 -
    8.72 -theorem card_order_on: "\<exists>r. card_order_on A r"
    8.73 -proof-
    8.74 -  obtain R where R_def: "R = {r. well_order_on A r}" by blast
    8.75 -  have 1: "R \<noteq> {} \<and> (\<forall>r \<in> R. Well_order r)"
    8.76 -  using well_order_on[of A] R_def well_order_on_Well_order by blast
    8.77 -  hence "\<exists>r \<in> R. \<forall>r' \<in> R. r \<le>o r'"
    8.78 -  using  exists_minim_Well_order[of R] by auto
    8.79 -  thus ?thesis using R_def unfolding card_order_on_def by auto
    8.80 -qed
    8.81 -
    8.82 -lemma card_order_on_ordIso:
    8.83 -assumes CO: "card_order_on A r" and CO': "card_order_on A r'"
    8.84 -shows "r =o r'"
    8.85 -using assms unfolding card_order_on_def
    8.86 -using ordIso_iff_ordLeq by blast
    8.87 -
    8.88 -lemma Card_order_ordIso:
    8.89 -assumes CO: "Card_order r" and ISO: "r' =o r"
    8.90 -shows "Card_order r'"
    8.91 -using ISO unfolding ordIso_def
    8.92 -proof(unfold card_order_on_def, auto)
    8.93 -  fix p' assume "well_order_on (Field r') p'"
    8.94 -  hence 0: "Well_order p' \<and> Field p' = Field r'"
    8.95 -  using well_order_on_Well_order by blast
    8.96 -  obtain f where 1: "iso r' r f" and 2: "Well_order r \<and> Well_order r'"
    8.97 -  using ISO unfolding ordIso_def by auto
    8.98 -  hence 3: "inj_on f (Field r') \<and> f ` (Field r') = Field r"
    8.99 -  by (auto simp add: iso_iff embed_inj_on)
   8.100 -  let ?p = "dir_image p' f"
   8.101 -  have 4: "p' =o ?p \<and> Well_order ?p"
   8.102 -  using 0 2 3 by (auto simp add: dir_image_ordIso Well_order_dir_image)
   8.103 -  moreover have "Field ?p =  Field r"
   8.104 -  using 0 3 by (auto simp add: dir_image_Field2 order_on_defs)
   8.105 -  ultimately have "well_order_on (Field r) ?p" by auto
   8.106 -  hence "r \<le>o ?p" using CO unfolding card_order_on_def by auto
   8.107 -  thus "r' \<le>o p'"
   8.108 -  using ISO 4 ordLeq_ordIso_trans ordIso_ordLeq_trans ordIso_symmetric by blast
   8.109 -qed
   8.110 -
   8.111 -lemma Card_order_ordIso2:
   8.112 -assumes CO: "Card_order r" and ISO: "r =o r'"
   8.113 -shows "Card_order r'"
   8.114 -using assms Card_order_ordIso ordIso_symmetric by blast
   8.115 -
   8.116 -
   8.117 -subsection {* Cardinal of a set *}
   8.118 -
   8.119 -text{* We define the cardinal of set to be {\em some} cardinal order on that set.
   8.120 -We shall prove that this notion is unique up to order isomorphism, meaning
   8.121 -that order isomorphism shall be the true identity of cardinals.  *}
   8.122 -
   8.123 -definition card_of :: "'a set \<Rightarrow> 'a rel" ("|_|" )
   8.124 -where "card_of A = (SOME r. card_order_on A r)"
   8.125 -
   8.126 -lemma card_of_card_order_on: "card_order_on A |A|"
   8.127 -unfolding card_of_def by (auto simp add: card_order_on someI_ex)
   8.128 -
   8.129 -lemma card_of_well_order_on: "well_order_on A |A|"
   8.130 -using card_of_card_order_on card_order_on_def by blast
   8.131 -
   8.132 -lemma Field_card_of: "Field |A| = A"
   8.133 -using card_of_card_order_on[of A] unfolding card_order_on_def
   8.134 -using well_order_on_Field by blast
   8.135 -
   8.136 -lemma card_of_Card_order: "Card_order |A|"
   8.137 -by (simp only: card_of_card_order_on Field_card_of)
   8.138 -
   8.139 -corollary ordIso_card_of_imp_Card_order:
   8.140 -"r =o |A| \<Longrightarrow> Card_order r"
   8.141 -using card_of_Card_order Card_order_ordIso by blast
   8.142 -
   8.143 -lemma card_of_Well_order: "Well_order |A|"
   8.144 -using card_of_Card_order unfolding card_order_on_def by auto
   8.145 -
   8.146 -lemma card_of_refl: "|A| =o |A|"
   8.147 -using card_of_Well_order ordIso_reflexive by blast
   8.148 -
   8.149 -lemma card_of_least: "well_order_on A r \<Longrightarrow> |A| \<le>o r"
   8.150 -using card_of_card_order_on unfolding card_order_on_def by blast
   8.151 -
   8.152 -lemma card_of_ordIso:
   8.153 -"(\<exists>f. bij_betw f A B) = ( |A| =o |B| )"
   8.154 -proof(auto)
   8.155 -  fix f assume *: "bij_betw f A B"
   8.156 -  then obtain r where "well_order_on B r \<and> |A| =o r"
   8.157 -  using Well_order_iso_copy card_of_well_order_on by blast
   8.158 -  hence "|B| \<le>o |A|" using card_of_least
   8.159 -  ordLeq_ordIso_trans ordIso_symmetric by blast
   8.160 -  moreover
   8.161 -  {let ?g = "inv_into A f"
   8.162 -   have "bij_betw ?g B A" using * bij_betw_inv_into by blast
   8.163 -   then obtain r where "well_order_on A r \<and> |B| =o r"
   8.164 -   using Well_order_iso_copy card_of_well_order_on by blast
   8.165 -   hence "|A| \<le>o |B|" using card_of_least
   8.166 -   ordLeq_ordIso_trans ordIso_symmetric by blast
   8.167 -  }
   8.168 -  ultimately show "|A| =o |B|" using ordIso_iff_ordLeq by blast
   8.169 -next
   8.170 -  assume "|A| =o |B|"
   8.171 -  then obtain f where "iso ( |A| ) ( |B| ) f"
   8.172 -  unfolding ordIso_def by auto
   8.173 -  hence "bij_betw f A B" unfolding iso_def Field_card_of by simp
   8.174 -  thus "\<exists>f. bij_betw f A B" by auto
   8.175 -qed
   8.176 -
   8.177 -lemma card_of_ordLeq:
   8.178 -"(\<exists>f. inj_on f A \<and> f ` A \<le> B) = ( |A| \<le>o |B| )"
   8.179 -proof(auto)
   8.180 -  fix f assume *: "inj_on f A" and **: "f ` A \<le> B"
   8.181 -  {assume "|B| <o |A|"
   8.182 -   hence "|B| \<le>o |A|" using ordLeq_iff_ordLess_or_ordIso by blast
   8.183 -   then obtain g where "embed ( |B| ) ( |A| ) g"
   8.184 -   unfolding ordLeq_def by auto
   8.185 -   hence 1: "inj_on g B \<and> g ` B \<le> A" using embed_inj_on[of "|B|" "|A|" "g"]
   8.186 -   card_of_Well_order[of "B"] Field_card_of[of "B"] Field_card_of[of "A"]
   8.187 -   embed_Field[of "|B|" "|A|" g] by auto
   8.188 -   obtain h where "bij_betw h A B"
   8.189 -   using * ** 1 Cantor_Bernstein[of f] by fastforce
   8.190 -   hence "|A| =o |B|" using card_of_ordIso by blast
   8.191 -   hence "|A| \<le>o |B|" using ordIso_iff_ordLeq by auto
   8.192 -  }
   8.193 -  thus "|A| \<le>o |B|" using ordLess_or_ordLeq[of "|B|" "|A|"]
   8.194 -  by (auto simp: card_of_Well_order)
   8.195 -next
   8.196 -  assume *: "|A| \<le>o |B|"
   8.197 -  obtain f where "embed ( |A| ) ( |B| ) f"
   8.198 -  using * unfolding ordLeq_def by auto
   8.199 -  hence "inj_on f A \<and> f ` A \<le> B" using embed_inj_on[of "|A|" "|B|" f]
   8.200 -  card_of_Well_order[of "A"] Field_card_of[of "A"] Field_card_of[of "B"]
   8.201 -  embed_Field[of "|A|" "|B|" f] by auto
   8.202 -  thus "\<exists>f. inj_on f A \<and> f ` A \<le> B" by auto
   8.203 -qed
   8.204 -
   8.205 -lemma card_of_ordLeq2:
   8.206 -"A \<noteq> {} \<Longrightarrow> (\<exists>g. g ` B = A) = ( |A| \<le>o |B| )"
   8.207 -using card_of_ordLeq[of A B] inj_on_iff_surj[of A B] by auto
   8.208 -
   8.209 -lemma card_of_ordLess:
   8.210 -"(\<not>(\<exists>f. inj_on f A \<and> f ` A \<le> B)) = ( |B| <o |A| )"
   8.211 -proof-
   8.212 -  have "(\<not>(\<exists>f. inj_on f A \<and> f ` A \<le> B)) = (\<not> |A| \<le>o |B| )"
   8.213 -  using card_of_ordLeq by blast
   8.214 -  also have "\<dots> = ( |B| <o |A| )"
   8.215 -  using card_of_Well_order[of A] card_of_Well_order[of B]
   8.216 -        not_ordLeq_iff_ordLess by blast
   8.217 -  finally show ?thesis .
   8.218 -qed
   8.219 -
   8.220 -lemma card_of_ordLess2:
   8.221 -"B \<noteq> {} \<Longrightarrow> (\<not>(\<exists>f. f ` A = B)) = ( |A| <o |B| )"
   8.222 -using card_of_ordLess[of B A] inj_on_iff_surj[of B A] by auto
   8.223 -
   8.224 -lemma card_of_ordIsoI:
   8.225 -assumes "bij_betw f A B"
   8.226 -shows "|A| =o |B|"
   8.227 -using assms unfolding card_of_ordIso[symmetric] by auto
   8.228 -
   8.229 -lemma card_of_ordLeqI:
   8.230 -assumes "inj_on f A" and "\<And> a. a \<in> A \<Longrightarrow> f a \<in> B"
   8.231 -shows "|A| \<le>o |B|"
   8.232 -using assms unfolding card_of_ordLeq[symmetric] by auto
   8.233 -
   8.234 -lemma card_of_unique:
   8.235 -"card_order_on A r \<Longrightarrow> r =o |A|"
   8.236 -by (simp only: card_order_on_ordIso card_of_card_order_on)
   8.237 -
   8.238 -lemma card_of_mono1:
   8.239 -"A \<le> B \<Longrightarrow> |A| \<le>o |B|"
   8.240 -using inj_on_id[of A] card_of_ordLeq[of A B] by fastforce
   8.241 -
   8.242 -lemma card_of_mono2:
   8.243 -assumes "r \<le>o r'"
   8.244 -shows "|Field r| \<le>o |Field r'|"
   8.245 -proof-
   8.246 -  obtain f where
   8.247 -  1: "well_order_on (Field r) r \<and> well_order_on (Field r) r \<and> embed r r' f"
   8.248 -  using assms unfolding ordLeq_def
   8.249 -  by (auto simp add: well_order_on_Well_order)
   8.250 -  hence "inj_on f (Field r) \<and> f ` (Field r) \<le> Field r'"
   8.251 -  by (auto simp add: embed_inj_on embed_Field)
   8.252 -  thus "|Field r| \<le>o |Field r'|" using card_of_ordLeq by blast
   8.253 -qed
   8.254 -
   8.255 -lemma card_of_cong: "r =o r' \<Longrightarrow> |Field r| =o |Field r'|"
   8.256 -by (simp add: ordIso_iff_ordLeq card_of_mono2)
   8.257 -
   8.258 -lemma card_of_Field_ordLess: "Well_order r \<Longrightarrow> |Field r| \<le>o r"
   8.259 -using card_of_least card_of_well_order_on well_order_on_Well_order by blast
   8.260 -
   8.261 -lemma card_of_Field_ordIso:
   8.262 -assumes "Card_order r"
   8.263 -shows "|Field r| =o r"
   8.264 -proof-
   8.265 -  have "card_order_on (Field r) r"
   8.266 -  using assms card_order_on_Card_order by blast
   8.267 -  moreover have "card_order_on (Field r) |Field r|"
   8.268 -  using card_of_card_order_on by blast
   8.269 -  ultimately show ?thesis using card_order_on_ordIso by blast
   8.270 -qed
   8.271 -
   8.272 -lemma Card_order_iff_ordIso_card_of:
   8.273 -"Card_order r = (r =o |Field r| )"
   8.274 -using ordIso_card_of_imp_Card_order card_of_Field_ordIso ordIso_symmetric by blast
   8.275 -
   8.276 -lemma Card_order_iff_ordLeq_card_of:
   8.277 -"Card_order r = (r \<le>o |Field r| )"
   8.278 -proof-
   8.279 -  have "Card_order r = (r =o |Field r| )"
   8.280 -  unfolding Card_order_iff_ordIso_card_of by simp
   8.281 -  also have "... = (r \<le>o |Field r| \<and> |Field r| \<le>o r)"
   8.282 -  unfolding ordIso_iff_ordLeq by simp
   8.283 -  also have "... = (r \<le>o |Field r| )"
   8.284 -  using card_of_Field_ordLess
   8.285 -  by (auto simp: card_of_Field_ordLess ordLeq_Well_order_simp)
   8.286 -  finally show ?thesis .
   8.287 -qed
   8.288 -
   8.289 -lemma Card_order_iff_Restr_underS:
   8.290 -assumes "Well_order r"
   8.291 -shows "Card_order r = (\<forall>a \<in> Field r. Restr r (underS r a) <o |Field r| )"
   8.292 -using assms unfolding Card_order_iff_ordLeq_card_of
   8.293 -using ordLeq_iff_ordLess_Restr card_of_Well_order by blast
   8.294 -
   8.295 -lemma card_of_underS:
   8.296 -assumes r: "Card_order r" and a: "a : Field r"
   8.297 -shows "|underS r a| <o r"
   8.298 -proof-
   8.299 -  let ?A = "underS r a"  let ?r' = "Restr r ?A"
   8.300 -  have 1: "Well_order r"
   8.301 -  using r unfolding card_order_on_def by simp
   8.302 -  have "Well_order ?r'" using 1 Well_order_Restr by auto
   8.303 -  moreover have "card_order_on (Field ?r') |Field ?r'|"
   8.304 -  using card_of_card_order_on .
   8.305 -  ultimately have "|Field ?r'| \<le>o ?r'"
   8.306 -  unfolding card_order_on_def by simp
   8.307 -  moreover have "Field ?r' = ?A"
   8.308 -  using 1 wo_rel.underS_ofilter Field_Restr_ofilter
   8.309 -  unfolding wo_rel_def by fastforce
   8.310 -  ultimately have "|?A| \<le>o ?r'" by simp
   8.311 -  also have "?r' <o |Field r|"
   8.312 -  using 1 a r Card_order_iff_Restr_underS by blast
   8.313 -  also have "|Field r| =o r"
   8.314 -  using r ordIso_symmetric unfolding Card_order_iff_ordIso_card_of by auto
   8.315 -  finally show ?thesis .
   8.316 -qed
   8.317 -
   8.318 -lemma ordLess_Field:
   8.319 -assumes "r <o r'"
   8.320 -shows "|Field r| <o r'"
   8.321 -proof-
   8.322 -  have "well_order_on (Field r) r" using assms unfolding ordLess_def
   8.323 -  by (auto simp add: well_order_on_Well_order)
   8.324 -  hence "|Field r| \<le>o r" using card_of_least by blast
   8.325 -  thus ?thesis using assms ordLeq_ordLess_trans by blast
   8.326 -qed
   8.327 -
   8.328 -lemma internalize_card_of_ordLeq:
   8.329 -"( |A| \<le>o r) = (\<exists>B \<le> Field r. |A| =o |B| \<and> |B| \<le>o r)"
   8.330 -proof
   8.331 -  assume "|A| \<le>o r"
   8.332 -  then obtain p where 1: "Field p \<le> Field r \<and> |A| =o p \<and> p \<le>o r"
   8.333 -  using internalize_ordLeq[of "|A|" r] by blast
   8.334 -  hence "Card_order p" using card_of_Card_order Card_order_ordIso2 by blast
   8.335 -  hence "|Field p| =o p" using card_of_Field_ordIso by blast
   8.336 -  hence "|A| =o |Field p| \<and> |Field p| \<le>o r"
   8.337 -  using 1 ordIso_equivalence ordIso_ordLeq_trans by blast
   8.338 -  thus "\<exists>B \<le> Field r. |A| =o |B| \<and> |B| \<le>o r" using 1 by blast
   8.339 -next
   8.340 -  assume "\<exists>B \<le> Field r. |A| =o |B| \<and> |B| \<le>o r"
   8.341 -  thus "|A| \<le>o r" using ordIso_ordLeq_trans by blast
   8.342 -qed
   8.343 -
   8.344 -lemma internalize_card_of_ordLeq2:
   8.345 -"( |A| \<le>o |C| ) = (\<exists>B \<le> C. |A| =o |B| \<and> |B| \<le>o |C| )"
   8.346 -using internalize_card_of_ordLeq[of "A" "|C|"] Field_card_of[of C] by auto
   8.347 -
   8.348 -
   8.349 -subsection {* Cardinals versus set operations on arbitrary sets *}
   8.350 -
   8.351 -text{* Here we embark in a long journey of simple results showing
   8.352 -that the standard set-theoretic operations are well-behaved w.r.t. the notion of
   8.353 -cardinal -- essentially, this means that they preserve the ``cardinal identity"
   8.354 -@{text "=o"} and are monotonic w.r.t. @{text "\<le>o"}.
   8.355 -*}
   8.356 -
   8.357 -lemma card_of_empty: "|{}| \<le>o |A|"
   8.358 -using card_of_ordLeq inj_on_id by blast
   8.359 -
   8.360 -lemma card_of_empty1:
   8.361 -assumes "Well_order r \<or> Card_order r"
   8.362 -shows "|{}| \<le>o r"
   8.363 -proof-
   8.364 -  have "Well_order r" using assms unfolding card_order_on_def by auto
   8.365 -  hence "|Field r| <=o r"
   8.366 -  using assms card_of_Field_ordLess by blast
   8.367 -  moreover have "|{}| \<le>o |Field r|" by (simp add: card_of_empty)
   8.368 -  ultimately show ?thesis using ordLeq_transitive by blast
   8.369 -qed
   8.370 -
   8.371 -corollary Card_order_empty:
   8.372 -"Card_order r \<Longrightarrow> |{}| \<le>o r" by (simp add: card_of_empty1)
   8.373 -
   8.374 -lemma card_of_empty2:
   8.375 -assumes LEQ: "|A| =o |{}|"
   8.376 -shows "A = {}"
   8.377 -using assms card_of_ordIso[of A] bij_betw_empty2 by blast
   8.378 -
   8.379 -lemma card_of_empty3:
   8.380 -assumes LEQ: "|A| \<le>o |{}|"
   8.381 -shows "A = {}"
   8.382 -using assms
   8.383 -by (simp add: ordIso_iff_ordLeq card_of_empty1 card_of_empty2
   8.384 -              ordLeq_Well_order_simp)
   8.385 -
   8.386 -lemma card_of_empty_ordIso:
   8.387 -"|{}::'a set| =o |{}::'b set|"
   8.388 -using card_of_ordIso unfolding bij_betw_def inj_on_def by blast
   8.389 -
   8.390 -lemma card_of_image:
   8.391 -"|f ` A| <=o |A|"
   8.392 -proof(cases "A = {}", simp add: card_of_empty)
   8.393 -  assume "A ~= {}"
   8.394 -  hence "f ` A ~= {}" by auto
   8.395 -  thus "|f ` A| \<le>o |A|"
   8.396 -  using card_of_ordLeq2[of "f ` A" A] by auto
   8.397 -qed
   8.398 -
   8.399 -lemma surj_imp_ordLeq:
   8.400 -assumes "B <= f ` A"
   8.401 -shows "|B| <=o |A|"
   8.402 -proof-
   8.403 -  have "|B| <=o |f ` A|" using assms card_of_mono1 by auto
   8.404 -  thus ?thesis using card_of_image ordLeq_transitive by blast
   8.405 -qed
   8.406 -
   8.407 -lemma card_of_ordLeqI2:
   8.408 -assumes "B \<subseteq> f ` A"
   8.409 -shows "|B| \<le>o |A|"
   8.410 -using assms by (metis surj_imp_ordLeq)
   8.411 -
   8.412 -lemma card_of_singl_ordLeq:
   8.413 -assumes "A \<noteq> {}"
   8.414 -shows "|{b}| \<le>o |A|"
   8.415 -proof-
   8.416 -  obtain a where *: "a \<in> A" using assms by auto
   8.417 -  let ?h = "\<lambda> b'::'b. if b' = b then a else undefined"
   8.418 -  have "inj_on ?h {b} \<and> ?h ` {b} \<le> A"
   8.419 -  using * unfolding inj_on_def by auto
   8.420 -  thus ?thesis using card_of_ordLeq by fast
   8.421 -qed
   8.422 -
   8.423 -corollary Card_order_singl_ordLeq:
   8.424 -"\<lbrakk>Card_order r; Field r \<noteq> {}\<rbrakk> \<Longrightarrow> |{b}| \<le>o r"
   8.425 -using card_of_singl_ordLeq[of "Field r" b]
   8.426 -      card_of_Field_ordIso[of r] ordLeq_ordIso_trans by blast
   8.427 -
   8.428 -lemma card_of_Pow: "|A| <o |Pow A|"
   8.429 -using card_of_ordLess2[of "Pow A" A]  Cantors_paradox[of A]
   8.430 -      Pow_not_empty[of A] by auto
   8.431 -
   8.432 -corollary Card_order_Pow:
   8.433 -"Card_order r \<Longrightarrow> r <o |Pow(Field r)|"
   8.434 -using card_of_Pow card_of_Field_ordIso ordIso_ordLess_trans ordIso_symmetric by blast
   8.435 -
   8.436 -lemma card_of_Plus1: "|A| \<le>o |A <+> B|"
   8.437 -proof-
   8.438 -  have "Inl ` A \<le> A <+> B" by auto
   8.439 -  thus ?thesis using inj_Inl[of A] card_of_ordLeq by blast
   8.440 -qed
   8.441 -
   8.442 -corollary Card_order_Plus1:
   8.443 -"Card_order r \<Longrightarrow> r \<le>o |(Field r) <+> B|"
   8.444 -using card_of_Plus1 card_of_Field_ordIso ordIso_ordLeq_trans ordIso_symmetric by blast
   8.445 -
   8.446 -lemma card_of_Plus2: "|B| \<le>o |A <+> B|"
   8.447 -proof-
   8.448 -  have "Inr ` B \<le> A <+> B" by auto
   8.449 -  thus ?thesis using inj_Inr[of B] card_of_ordLeq by blast
   8.450 -qed
   8.451 -
   8.452 -corollary Card_order_Plus2:
   8.453 -"Card_order r \<Longrightarrow> r \<le>o |A <+> (Field r)|"
   8.454 -using card_of_Plus2 card_of_Field_ordIso ordIso_ordLeq_trans ordIso_symmetric by blast
   8.455 -
   8.456 -lemma card_of_Plus_empty1: "|A| =o |A <+> {}|"
   8.457 -proof-
   8.458 -  have "bij_betw Inl A (A <+> {})" unfolding bij_betw_def inj_on_def by auto
   8.459 -  thus ?thesis using card_of_ordIso by auto
   8.460 -qed
   8.461 -
   8.462 -lemma card_of_Plus_empty2: "|A| =o |{} <+> A|"
   8.463 -proof-
   8.464 -  have "bij_betw Inr A ({} <+> A)" unfolding bij_betw_def inj_on_def by auto
   8.465 -  thus ?thesis using card_of_ordIso by auto
   8.466 -qed
   8.467 -
   8.468 -lemma card_of_Plus_commute: "|A <+> B| =o |B <+> A|"
   8.469 -proof-
   8.470 -  let ?f = "\<lambda>(c::'a + 'b). case c of Inl a \<Rightarrow> Inr a
   8.471 -                                   | Inr b \<Rightarrow> Inl b"
   8.472 -  have "bij_betw ?f (A <+> B) (B <+> A)"
   8.473 -  unfolding bij_betw_def inj_on_def by force
   8.474 -  thus ?thesis using card_of_ordIso by blast
   8.475 -qed
   8.476 -
   8.477 -lemma card_of_Plus_assoc:
   8.478 -fixes A :: "'a set" and B :: "'b set" and C :: "'c set"
   8.479 -shows "|(A <+> B) <+> C| =o |A <+> B <+> C|"
   8.480 -proof -
   8.481 -  def f \<equiv> "\<lambda>(k::('a + 'b) + 'c).
   8.482 -  case k of Inl ab \<Rightarrow> (case ab of Inl a \<Rightarrow> Inl a
   8.483 -                                 |Inr b \<Rightarrow> Inr (Inl b))
   8.484 -           |Inr c \<Rightarrow> Inr (Inr c)"
   8.485 -  have "A <+> B <+> C \<subseteq> f ` ((A <+> B) <+> C)"
   8.486 -  proof
   8.487 -    fix x assume x: "x \<in> A <+> B <+> C"
   8.488 -    show "x \<in> f ` ((A <+> B) <+> C)"
   8.489 -    proof(cases x)
   8.490 -      case (Inl a)
   8.491 -      hence "a \<in> A" "x = f (Inl (Inl a))"
   8.492 -      using x unfolding f_def by auto
   8.493 -      thus ?thesis by auto
   8.494 -    next
   8.495 -      case (Inr bc) note 1 = Inr show ?thesis
   8.496 -      proof(cases bc)
   8.497 -        case (Inl b)
   8.498 -        hence "b \<in> B" "x = f (Inl (Inr b))"
   8.499 -        using x 1 unfolding f_def by auto
   8.500 -        thus ?thesis by auto
   8.501 -      next
   8.502 -        case (Inr c)
   8.503 -        hence "c \<in> C" "x = f (Inr c)"
   8.504 -        using x 1 unfolding f_def by auto
   8.505 -        thus ?thesis by auto
   8.506 -      qed
   8.507 -    qed
   8.508 -  qed
   8.509 -  hence "bij_betw f ((A <+> B) <+> C) (A <+> B <+> C)"
   8.510 -  unfolding bij_betw_def inj_on_def f_def by fastforce
   8.511 -  thus ?thesis using card_of_ordIso by blast
   8.512 -qed
   8.513 -
   8.514 -lemma card_of_Plus_mono1:
   8.515 -assumes "|A| \<le>o |B|"
   8.516 -shows "|A <+> C| \<le>o |B <+> C|"
   8.517 -proof-
   8.518 -  obtain f where 1: "inj_on f A \<and> f ` A \<le> B"
   8.519 -  using assms card_of_ordLeq[of A] by fastforce
   8.520 -  obtain g where g_def:
   8.521 -  "g = (\<lambda>d. case d of Inl a \<Rightarrow> Inl(f a) | Inr (c::'c) \<Rightarrow> Inr c)" by blast
   8.522 -  have "inj_on g (A <+> C) \<and> g ` (A <+> C) \<le> (B <+> C)"
   8.523 -  proof-
   8.524 -    {fix d1 and d2 assume "d1 \<in> A <+> C \<and> d2 \<in> A <+> C" and
   8.525 -                          "g d1 = g d2"
   8.526 -     hence "d1 = d2" using 1 unfolding inj_on_def g_def by force
   8.527 -    }
   8.528 -    moreover
   8.529 -    {fix d assume "d \<in> A <+> C"
   8.530 -     hence "g d \<in> B <+> C"  using 1
   8.531 -     by(case_tac d, auto simp add: g_def)
   8.532 -    }
   8.533 -    ultimately show ?thesis unfolding inj_on_def by auto
   8.534 -  qed
   8.535 -  thus ?thesis using card_of_ordLeq by metis
   8.536 -qed
   8.537 -
   8.538 -corollary ordLeq_Plus_mono1:
   8.539 -assumes "r \<le>o r'"
   8.540 -shows "|(Field r) <+> C| \<le>o |(Field r') <+> C|"
   8.541 -using assms card_of_mono2 card_of_Plus_mono1 by blast
   8.542 -
   8.543 -lemma card_of_Plus_mono2:
   8.544 -assumes "|A| \<le>o |B|"
   8.545 -shows "|C <+> A| \<le>o |C <+> B|"
   8.546 -using assms card_of_Plus_mono1[of A B C]
   8.547 -      card_of_Plus_commute[of C A]  card_of_Plus_commute[of B C]
   8.548 -      ordIso_ordLeq_trans[of "|C <+> A|"] ordLeq_ordIso_trans[of "|C <+> A|"]
   8.549 -by blast
   8.550 -
   8.551 -corollary ordLeq_Plus_mono2:
   8.552 -assumes "r \<le>o r'"
   8.553 -shows "|A <+> (Field r)| \<le>o |A <+> (Field r')|"
   8.554 -using assms card_of_mono2 card_of_Plus_mono2 by blast
   8.555 -
   8.556 -lemma card_of_Plus_mono:
   8.557 -assumes "|A| \<le>o |B|" and "|C| \<le>o |D|"
   8.558 -shows "|A <+> C| \<le>o |B <+> D|"
   8.559 -using assms card_of_Plus_mono1[of A B C] card_of_Plus_mono2[of C D B]
   8.560 -      ordLeq_transitive[of "|A <+> C|"] by blast
   8.561 -
   8.562 -corollary ordLeq_Plus_mono:
   8.563 -assumes "r \<le>o r'" and "p \<le>o p'"
   8.564 -shows "|(Field r) <+> (Field p)| \<le>o |(Field r') <+> (Field p')|"
   8.565 -using assms card_of_mono2[of r r'] card_of_mono2[of p p'] card_of_Plus_mono by blast
   8.566 -
   8.567 -lemma card_of_Plus_cong1:
   8.568 -assumes "|A| =o |B|"
   8.569 -shows "|A <+> C| =o |B <+> C|"
   8.570 -using assms by (simp add: ordIso_iff_ordLeq card_of_Plus_mono1)
   8.571 -
   8.572 -corollary ordIso_Plus_cong1:
   8.573 -assumes "r =o r'"
   8.574 -shows "|(Field r) <+> C| =o |(Field r') <+> C|"
   8.575 -using assms card_of_cong card_of_Plus_cong1 by blast
   8.576 -
   8.577 -lemma card_of_Plus_cong2:
   8.578 -assumes "|A| =o |B|"
   8.579 -shows "|C <+> A| =o |C <+> B|"
   8.580 -using assms by (simp add: ordIso_iff_ordLeq card_of_Plus_mono2)
   8.581 -
   8.582 -corollary ordIso_Plus_cong2:
   8.583 -assumes "r =o r'"
   8.584 -shows "|A <+> (Field r)| =o |A <+> (Field r')|"
   8.585 -using assms card_of_cong card_of_Plus_cong2 by blast
   8.586 -
   8.587 -lemma card_of_Plus_cong:
   8.588 -assumes "|A| =o |B|" and "|C| =o |D|"
   8.589 -shows "|A <+> C| =o |B <+> D|"
   8.590 -using assms by (simp add: ordIso_iff_ordLeq card_of_Plus_mono)
   8.591 -
   8.592 -corollary ordIso_Plus_cong:
   8.593 -assumes "r =o r'" and "p =o p'"
   8.594 -shows "|(Field r) <+> (Field p)| =o |(Field r') <+> (Field p')|"
   8.595 -using assms card_of_cong[of r r'] card_of_cong[of p p'] card_of_Plus_cong by blast
   8.596 -
   8.597 -lemma card_of_Un_Plus_ordLeq:
   8.598 -"|A \<union> B| \<le>o |A <+> B|"
   8.599 -proof-
   8.600 -   let ?f = "\<lambda> c. if c \<in> A then Inl c else Inr c"
   8.601 -   have "inj_on ?f (A \<union> B) \<and> ?f ` (A \<union> B) \<le> A <+> B"
   8.602 -   unfolding inj_on_def by auto
   8.603 -   thus ?thesis using card_of_ordLeq by blast
   8.604 -qed
   8.605 -
   8.606 -lemma card_of_Times1:
   8.607 -assumes "A \<noteq> {}"
   8.608 -shows "|B| \<le>o |B \<times> A|"
   8.609 -proof(cases "B = {}", simp add: card_of_empty)
   8.610 -  assume *: "B \<noteq> {}"
   8.611 -  have "fst `(B \<times> A) = B" unfolding image_def using assms by auto
   8.612 -  thus ?thesis using inj_on_iff_surj[of B "B \<times> A"]
   8.613 -                     card_of_ordLeq[of B "B \<times> A"] * by blast
   8.614 -qed
   8.615 -
   8.616 -lemma card_of_Times_commute: "|A \<times> B| =o |B \<times> A|"
   8.617 -proof-
   8.618 -  let ?f = "\<lambda>(a::'a,b::'b). (b,a)"
   8.619 -  have "bij_betw ?f (A \<times> B) (B \<times> A)"
   8.620 -  unfolding bij_betw_def inj_on_def by auto
   8.621 -  thus ?thesis using card_of_ordIso by blast
   8.622 -qed
   8.623 -
   8.624 -lemma card_of_Times2:
   8.625 -assumes "A \<noteq> {}"   shows "|B| \<le>o |A \<times> B|"
   8.626 -using assms card_of_Times1[of A B] card_of_Times_commute[of B A]
   8.627 -      ordLeq_ordIso_trans by blast
   8.628 -
   8.629 -corollary Card_order_Times1:
   8.630 -"\<lbrakk>Card_order r; B \<noteq> {}\<rbrakk> \<Longrightarrow> r \<le>o |(Field r) \<times> B|"
   8.631 -using card_of_Times1[of B] card_of_Field_ordIso
   8.632 -      ordIso_ordLeq_trans ordIso_symmetric by blast
   8.633 -
   8.634 -corollary Card_order_Times2:
   8.635 -"\<lbrakk>Card_order r; A \<noteq> {}\<rbrakk> \<Longrightarrow> r \<le>o |A \<times> (Field r)|"
   8.636 -using card_of_Times2[of A] card_of_Field_ordIso
   8.637 -      ordIso_ordLeq_trans ordIso_symmetric by blast
   8.638 -
   8.639 -lemma card_of_Times3: "|A| \<le>o |A \<times> A|"
   8.640 -using card_of_Times1[of A]
   8.641 -by(cases "A = {}", simp add: card_of_empty, blast)
   8.642 -
   8.643 -lemma card_of_Plus_Times_bool: "|A <+> A| =o |A \<times> (UNIV::bool set)|"
   8.644 -proof-
   8.645 -  let ?f = "\<lambda>c::'a + 'a. case c of Inl a \<Rightarrow> (a,True)
   8.646 -                                  |Inr a \<Rightarrow> (a,False)"
   8.647 -  have "bij_betw ?f (A <+> A) (A \<times> (UNIV::bool set))"
   8.648 -  proof-
   8.649 -    {fix  c1 and c2 assume "?f c1 = ?f c2"
   8.650 -     hence "c1 = c2"
   8.651 -     by(case_tac "c1", case_tac "c2", auto, case_tac "c2", auto)
   8.652 -    }
   8.653 -    moreover
   8.654 -    {fix c assume "c \<in> A <+> A"
   8.655 -     hence "?f c \<in> A \<times> (UNIV::bool set)"
   8.656 -     by(case_tac c, auto)
   8.657 -    }
   8.658 -    moreover
   8.659 -    {fix a bl assume *: "(a,bl) \<in> A \<times> (UNIV::bool set)"
   8.660 -     have "(a,bl) \<in> ?f ` ( A <+> A)"
   8.661 -     proof(cases bl)
   8.662 -       assume bl hence "?f(Inl a) = (a,bl)" by auto
   8.663 -       thus ?thesis using * by force
   8.664 -     next
   8.665 -       assume "\<not> bl" hence "?f(Inr a) = (a,bl)" by auto
   8.666 -       thus ?thesis using * by force
   8.667 -     qed
   8.668 -    }
   8.669 -    ultimately show ?thesis unfolding bij_betw_def inj_on_def by auto
   8.670 -  qed
   8.671 -  thus ?thesis using card_of_ordIso by blast
   8.672 -qed
   8.673 -
   8.674 -lemma card_of_Times_mono1:
   8.675 -assumes "|A| \<le>o |B|"
   8.676 -shows "|A \<times> C| \<le>o |B \<times> C|"
   8.677 -proof-
   8.678 -  obtain f where 1: "inj_on f A \<and> f ` A \<le> B"
   8.679 -  using assms card_of_ordLeq[of A] by fastforce
   8.680 -  obtain g where g_def:
   8.681 -  "g = (\<lambda>(a,c::'c). (f a,c))" by blast
   8.682 -  have "inj_on g (A \<times> C) \<and> g ` (A \<times> C) \<le> (B \<times> C)"
   8.683 -  using 1 unfolding inj_on_def using g_def by auto
   8.684 -  thus ?thesis using card_of_ordLeq by metis
   8.685 -qed
   8.686 -
   8.687 -corollary ordLeq_Times_mono1:
   8.688 -assumes "r \<le>o r'"
   8.689 -shows "|(Field r) \<times> C| \<le>o |(Field r') \<times> C|"
   8.690 -using assms card_of_mono2 card_of_Times_mono1 by blast
   8.691 -
   8.692 -lemma card_of_Times_mono2:
   8.693 -assumes "|A| \<le>o |B|"
   8.694 -shows "|C \<times> A| \<le>o |C \<times> B|"
   8.695 -using assms card_of_Times_mono1[of A B C]
   8.696 -      card_of_Times_commute[of C A]  card_of_Times_commute[of B C]
   8.697 -      ordIso_ordLeq_trans[of "|C \<times> A|"] ordLeq_ordIso_trans[of "|C \<times> A|"]
   8.698 -by blast
   8.699 -
   8.700 -corollary ordLeq_Times_mono2:
   8.701 -assumes "r \<le>o r'"
   8.702 -shows "|A \<times> (Field r)| \<le>o |A \<times> (Field r')|"
   8.703 -using assms card_of_mono2 card_of_Times_mono2 by blast
   8.704 -
   8.705 -lemma card_of_Sigma_mono1:
   8.706 -assumes "\<forall>i \<in> I. |A i| \<le>o |B i|"
   8.707 -shows "|SIGMA i : I. A i| \<le>o |SIGMA i : I. B i|"
   8.708 -proof-
   8.709 -  have "\<forall>i. i \<in> I \<longrightarrow> (\<exists>f. inj_on f (A i) \<and> f ` (A i) \<le> B i)"
   8.710 -  using assms by (auto simp add: card_of_ordLeq)
   8.711 -  with choice[of "\<lambda> i f. i \<in> I \<longrightarrow> inj_on f (A i) \<and> f ` (A i) \<le> B i"]
   8.712 -  obtain F where 1: "\<forall>i \<in> I. inj_on (F i) (A i) \<and> (F i) ` (A i) \<le> B i" by metis
   8.713 -  obtain g where g_def: "g = (\<lambda>(i,a::'b). (i,F i a))" by blast
   8.714 -  have "inj_on g (Sigma I A) \<and> g ` (Sigma I A) \<le> (Sigma I B)"
   8.715 -  using 1 unfolding inj_on_def using g_def by force
   8.716 -  thus ?thesis using card_of_ordLeq by metis
   8.717 -qed
   8.718 -
   8.719 -corollary card_of_Sigma_Times:
   8.720 -"\<forall>i \<in> I. |A i| \<le>o |B| \<Longrightarrow> |SIGMA i : I. A i| \<le>o |I \<times> B|"
   8.721 -using card_of_Sigma_mono1[of I A "\<lambda>i. B"] .
   8.722 -
   8.723 -lemma card_of_UNION_Sigma:
   8.724 -"|\<Union>i \<in> I. A i| \<le>o |SIGMA i : I. A i|"
   8.725 -using Ex_inj_on_UNION_Sigma[of I A] card_of_ordLeq by metis
   8.726 -
   8.727 -lemma card_of_bool:
   8.728 -assumes "a1 \<noteq> a2"
   8.729 -shows "|UNIV::bool set| =o |{a1,a2}|"
   8.730 -proof-
   8.731 -  let ?f = "\<lambda> bl. case bl of True \<Rightarrow> a1 | False \<Rightarrow> a2"
   8.732 -  have "bij_betw ?f UNIV {a1,a2}"
   8.733 -  proof-
   8.734 -    {fix bl1 and bl2 assume "?f  bl1 = ?f bl2"
   8.735 -     hence "bl1 = bl2" using assms by (case_tac bl1, case_tac bl2, auto)
   8.736 -    }
   8.737 -    moreover
   8.738 -    {fix bl have "?f bl \<in> {a1,a2}" by (case_tac bl, auto)
   8.739 -    }
   8.740 -    moreover
   8.741 -    {fix a assume *: "a \<in> {a1,a2}"
   8.742 -     have "a \<in> ?f ` UNIV"
   8.743 -     proof(cases "a = a1")
   8.744 -       assume "a = a1"
   8.745 -       hence "?f True = a" by auto  thus ?thesis by blast
   8.746 -     next
   8.747 -       assume "a \<noteq> a1" hence "a = a2" using * by auto
   8.748 -       hence "?f False = a" by auto  thus ?thesis by blast
   8.749 -     qed
   8.750 -    }
   8.751 -    ultimately show ?thesis unfolding bij_betw_def inj_on_def
   8.752 -    by (metis image_subsetI order_eq_iff subsetI)
   8.753 -  qed
   8.754 -  thus ?thesis using card_of_ordIso by blast
   8.755 -qed
   8.756 -
   8.757 -lemma card_of_Plus_Times_aux:
   8.758 -assumes A2: "a1 \<noteq> a2 \<and> {a1,a2} \<le> A" and
   8.759 -        LEQ: "|A| \<le>o |B|"
   8.760 -shows "|A <+> B| \<le>o |A \<times> B|"
   8.761 -proof-
   8.762 -  have 1: "|UNIV::bool set| \<le>o |A|"
   8.763 -  using A2 card_of_mono1[of "{a1,a2}"] card_of_bool[of a1 a2]
   8.764 -        ordIso_ordLeq_trans[of "|UNIV::bool set|"] by metis
   8.765 -  (*  *)
   8.766 -  have "|A <+> B| \<le>o |B <+> B|"
   8.767 -  using LEQ card_of_Plus_mono1 by blast
   8.768 -  moreover have "|B <+> B| =o |B \<times> (UNIV::bool set)|"
   8.769 -  using card_of_Plus_Times_bool by blast
   8.770 -  moreover have "|B \<times> (UNIV::bool set)| \<le>o |B \<times> A|"
   8.771 -  using 1 by (simp add: card_of_Times_mono2)
   8.772 -  moreover have " |B \<times> A| =o |A \<times> B|"
   8.773 -  using card_of_Times_commute by blast
   8.774 -  ultimately show "|A <+> B| \<le>o |A \<times> B|"
   8.775 -  using ordLeq_ordIso_trans[of "|A <+> B|" "|B <+> B|" "|B \<times> (UNIV::bool set)|"]
   8.776 -        ordLeq_transitive[of