moved subset of 'HOL-Cardinals' needed for BNF into 'HOL'
authorblanchet
Mon Jan 20 18:24:55 2014 +0100 (2014-01-20)
changeset 55054e1f3714bc508
parent 55053 f69530f22f5a
child 55055 3f0dfce0e27a
moved subset of 'HOL-Cardinals' needed for BNF into 'HOL'
src/HOL/BNF/BNF_Util.thy
src/HOL/Cardinal_Arithmetic_FP.thy
src/HOL/Cardinal_Order_Relation_FP.thy
src/HOL/Cardinals/Cardinal_Arithmetic_FP.thy
src/HOL/Cardinals/Cardinal_Order_Relation_FP.thy
src/HOL/Cardinals/Constructions_on_Wellorders_FP.thy
src/HOL/Cardinals/Wellorder_Embedding_FP.thy
src/HOL/Cardinals/Wellorder_Relation_FP.thy
src/HOL/Constructions_on_Wellorders_FP.thy
src/HOL/Main.thy
src/HOL/ROOT
src/HOL/Wellorder_Embedding_FP.thy
src/HOL/Wellorder_Relation_FP.thy
     1.1 --- a/src/HOL/BNF/BNF_Util.thy	Mon Jan 20 16:14:19 2014 +0100
     1.2 +++ b/src/HOL/BNF/BNF_Util.thy	Mon Jan 20 18:24:55 2014 +0100
     1.3 @@ -9,9 +9,8 @@
     1.4  header {* Library for Bounded Natural Functors *}
     1.5  
     1.6  theory BNF_Util
     1.7 -imports "../Cardinals/Cardinal_Arithmetic_FP"
     1.8 -   (*FIXME: define fun_rel here, reuse in Transfer once this theory is in HOL*)
     1.9 -  Transfer
    1.10 +imports Cardinal_Arithmetic_FP
    1.11 +  Transfer (*FIXME: define fun_rel here, reuse in Transfer once this theory is in HOL*)
    1.12  begin
    1.13  
    1.14  definition collect where
     2.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     2.2 +++ b/src/HOL/Cardinal_Arithmetic_FP.thy	Mon Jan 20 18:24:55 2014 +0100
     2.3 @@ -0,0 +1,713 @@
     2.4 +(*  Title:      HOL/Cardinal_Arithmetic_FP.thy
     2.5 +    Author:     Dmitriy Traytel, TU Muenchen
     2.6 +    Copyright   2012
     2.7 +
     2.8 +Cardinal arithmetic (FP).
     2.9 +*)
    2.10 +
    2.11 +header {* Cardinal Arithmetic (FP) *}
    2.12 +
    2.13 +theory Cardinal_Arithmetic_FP
    2.14 +imports Cardinal_Order_Relation_FP
    2.15 +begin
    2.16 +
    2.17 +(*library candidate*)
    2.18 +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.19 +by (rule dir_image_ordIso) (auto simp add: inj_on_def card_order_on_def)
    2.20 +
    2.21 +(*should supersede a weaker lemma from the library*)
    2.22 +lemma dir_image_Field: "Field (dir_image r f) = f ` Field r"
    2.23 +unfolding dir_image_def Field_def Range_def Domain_def by fast
    2.24 +
    2.25 +lemma card_order_dir_image:
    2.26 +  assumes bij: "bij f" and co: "card_order r"
    2.27 +  shows "card_order (dir_image r f)"
    2.28 +proof -
    2.29 +  from assms have "Field (dir_image r f) = UNIV"
    2.30 +    using card_order_on_Card_order[of UNIV r] unfolding bij_def dir_image_Field by auto
    2.31 +  moreover from bij have "\<And>x y. (f x = f y) = (x = y)" unfolding bij_def inj_on_def by auto
    2.32 +  with co have "Card_order (dir_image r f)"
    2.33 +    using card_order_on_Card_order[of UNIV r] Card_order_ordIso2[OF _ dir_image] by blast
    2.34 +  ultimately show ?thesis by auto
    2.35 +qed
    2.36 +
    2.37 +(*library candidate*)
    2.38 +lemma ordIso_refl: "Card_order r \<Longrightarrow> r =o r"
    2.39 +by (rule card_order_on_ordIso)
    2.40 +
    2.41 +(*library candidate*)
    2.42 +lemma ordLeq_refl: "Card_order r \<Longrightarrow> r \<le>o r"
    2.43 +by (rule ordIso_imp_ordLeq, rule card_order_on_ordIso)
    2.44 +
    2.45 +(*library candidate*)
    2.46 +lemma card_of_ordIso_subst: "A = B \<Longrightarrow> |A| =o |B|"
    2.47 +by (simp only: ordIso_refl card_of_Card_order)
    2.48 +
    2.49 +(*library candidate*)
    2.50 +lemma Field_card_order: "card_order r \<Longrightarrow> Field r = UNIV"
    2.51 +using card_order_on_Card_order[of UNIV r] by simp
    2.52 +
    2.53 +(*library candidate*)
    2.54 +lemma card_of_Times_Plus_distrib:
    2.55 +  "|A <*> (B <+> C)| =o |A <*> B <+> A <*> C|" (is "|?RHS| =o |?LHS|")
    2.56 +proof -
    2.57 +  let ?f = "\<lambda>(a, bc). case bc of Inl b \<Rightarrow> Inl (a, b) | Inr c \<Rightarrow> Inr (a, c)"
    2.58 +  have "bij_betw ?f ?RHS ?LHS" unfolding bij_betw_def inj_on_def by force
    2.59 +  thus ?thesis using card_of_ordIso by blast
    2.60 +qed
    2.61 +
    2.62 +(*library candidate*)
    2.63 +lemma Func_Times_Range:
    2.64 +  "|Func A (B <*> C)| =o |Func A B <*> Func A C|" (is "|?LHS| =o |?RHS|")
    2.65 +proof -
    2.66 +  let ?F = "\<lambda>fg. (\<lambda>x. if x \<in> A then fst (fg x) else undefined,
    2.67 +                  \<lambda>x. if x \<in> A then snd (fg x) else undefined)"
    2.68 +  let ?G = "\<lambda>(f, g) x. if x \<in> A then (f x, g x) else undefined"
    2.69 +  have "bij_betw ?F ?LHS ?RHS" unfolding bij_betw_def inj_on_def
    2.70 +  apply safe
    2.71 +     apply (simp add: Func_def fun_eq_iff)
    2.72 +     apply (metis (no_types) pair_collapse)
    2.73 +    apply (auto simp: Func_def fun_eq_iff)[2]
    2.74 +  proof -
    2.75 +    fix f g assume "f \<in> Func A B" "g \<in> Func A C"
    2.76 +    thus "(f, g) \<in> ?F ` Func A (B \<times> C)"
    2.77 +      by (intro image_eqI[of _ _ "?G (f, g)"]) (auto simp: Func_def)
    2.78 +  qed
    2.79 +  thus ?thesis using card_of_ordIso by blast
    2.80 +qed
    2.81 +
    2.82 +
    2.83 +subsection {* Zero *}
    2.84 +
    2.85 +definition czero where
    2.86 +  "czero = card_of {}"
    2.87 +
    2.88 +lemma czero_ordIso:
    2.89 +  "czero =o czero"
    2.90 +using card_of_empty_ordIso by (simp add: czero_def)
    2.91 +
    2.92 +lemma card_of_ordIso_czero_iff_empty:
    2.93 +  "|A| =o (czero :: 'b rel) \<longleftrightarrow> A = ({} :: 'a set)"
    2.94 +unfolding czero_def by (rule iffI[OF card_of_empty2]) (auto simp: card_of_refl card_of_empty_ordIso)
    2.95 +
    2.96 +(* A "not czero" Cardinal predicate *)
    2.97 +abbreviation Cnotzero where
    2.98 +  "Cnotzero (r :: 'a rel) \<equiv> \<not>(r =o (czero :: 'a rel)) \<and> Card_order r"
    2.99 +
   2.100 +(*helper*)
   2.101 +lemma Cnotzero_imp_not_empty: "Cnotzero r \<Longrightarrow> Field r \<noteq> {}"
   2.102 +by (metis Card_order_iff_ordIso_card_of czero_def)
   2.103 +
   2.104 +lemma czeroI:
   2.105 +  "\<lbrakk>Card_order r; Field r = {}\<rbrakk> \<Longrightarrow> r =o czero"
   2.106 +using Cnotzero_imp_not_empty ordIso_transitive[OF _ czero_ordIso] by blast
   2.107 +
   2.108 +lemma czeroE:
   2.109 +  "r =o czero \<Longrightarrow> Field r = {}"
   2.110 +unfolding czero_def
   2.111 +by (drule card_of_cong) (simp only: Field_card_of card_of_empty2)
   2.112 +
   2.113 +lemma Cnotzero_mono:
   2.114 +  "\<lbrakk>Cnotzero r; Card_order q; r \<le>o q\<rbrakk> \<Longrightarrow> Cnotzero q"
   2.115 +apply (rule ccontr)
   2.116 +apply auto
   2.117 +apply (drule czeroE)
   2.118 +apply (erule notE)
   2.119 +apply (erule czeroI)
   2.120 +apply (drule card_of_mono2)
   2.121 +apply (simp only: card_of_empty3)
   2.122 +done
   2.123 +
   2.124 +subsection {* (In)finite cardinals *}
   2.125 +
   2.126 +definition cinfinite where
   2.127 +  "cinfinite r = (\<not> finite (Field r))"
   2.128 +
   2.129 +abbreviation Cinfinite where
   2.130 +  "Cinfinite r \<equiv> cinfinite r \<and> Card_order r"
   2.131 +
   2.132 +definition cfinite where
   2.133 +  "cfinite r = finite (Field r)"
   2.134 +
   2.135 +abbreviation Cfinite where
   2.136 +  "Cfinite r \<equiv> cfinite r \<and> Card_order r"
   2.137 +
   2.138 +lemma Cfinite_ordLess_Cinfinite: "\<lbrakk>Cfinite r; Cinfinite s\<rbrakk> \<Longrightarrow> r <o s"
   2.139 +  unfolding cfinite_def cinfinite_def
   2.140 +  by (metis card_order_on_well_order_on finite_ordLess_infinite)
   2.141 +
   2.142 +lemmas natLeq_card_order = natLeq_Card_order[unfolded Field_natLeq]
   2.143 +
   2.144 +lemma natLeq_cinfinite: "cinfinite natLeq"
   2.145 +unfolding cinfinite_def Field_natLeq by (metis infinite_UNIV_nat)
   2.146 +
   2.147 +lemma natLeq_ordLeq_cinfinite:
   2.148 +  assumes inf: "Cinfinite r"
   2.149 +  shows "natLeq \<le>o r"
   2.150 +proof -
   2.151 +  from inf have "natLeq \<le>o |Field r|" by (metis cinfinite_def infinite_iff_natLeq_ordLeq)
   2.152 +  also from inf have "|Field r| =o r" by (simp add: card_of_unique ordIso_symmetric)
   2.153 +  finally show ?thesis .
   2.154 +qed
   2.155 +
   2.156 +lemma cinfinite_not_czero: "cinfinite r \<Longrightarrow> \<not> (r =o (czero :: 'a rel))"
   2.157 +unfolding cinfinite_def by (metis czeroE finite.emptyI)
   2.158 +
   2.159 +lemma Cinfinite_Cnotzero: "Cinfinite r \<Longrightarrow> Cnotzero r"
   2.160 +by (metis cinfinite_not_czero)
   2.161 +
   2.162 +lemma Cinfinite_cong: "\<lbrakk>r1 =o r2; Cinfinite r1\<rbrakk> \<Longrightarrow> Cinfinite r2"
   2.163 +by (metis Card_order_ordIso2 card_of_mono2 card_of_ordLeq_infinite cinfinite_def ordIso_iff_ordLeq)
   2.164 +
   2.165 +lemma cinfinite_mono: "\<lbrakk>r1 \<le>o r2; cinfinite r1\<rbrakk> \<Longrightarrow> cinfinite r2"
   2.166 +by (metis card_of_mono2 card_of_ordLeq_infinite cinfinite_def)
   2.167 +
   2.168 +
   2.169 +subsection {* Binary sum *}
   2.170 +
   2.171 +definition csum (infixr "+c" 65) where
   2.172 +  "r1 +c r2 \<equiv> |Field r1 <+> Field r2|"
   2.173 +
   2.174 +lemma Field_csum: "Field (r +c s) = Inl ` Field r \<union> Inr ` Field s"
   2.175 +  unfolding csum_def Field_card_of by auto
   2.176 +
   2.177 +lemma Card_order_csum:
   2.178 +  "Card_order (r1 +c r2)"
   2.179 +unfolding csum_def by (simp add: card_of_Card_order)
   2.180 +
   2.181 +lemma csum_Cnotzero1:
   2.182 +  "Cnotzero r1 \<Longrightarrow> Cnotzero (r1 +c r2)"
   2.183 +unfolding csum_def
   2.184 +by (metis Cnotzero_imp_not_empty Plus_eq_empty_conv card_of_Card_order card_of_ordIso_czero_iff_empty)
   2.185 +
   2.186 +lemma card_order_csum:
   2.187 +  assumes "card_order r1" "card_order r2"
   2.188 +  shows "card_order (r1 +c r2)"
   2.189 +proof -
   2.190 +  have "Field r1 = UNIV" "Field r2 = UNIV" using assms card_order_on_Card_order by auto
   2.191 +  thus ?thesis unfolding csum_def by (auto simp: card_of_card_order_on)
   2.192 +qed
   2.193 +
   2.194 +lemma cinfinite_csum:
   2.195 +  "cinfinite r1 \<or> cinfinite r2 \<Longrightarrow> cinfinite (r1 +c r2)"
   2.196 +unfolding cinfinite_def csum_def by (auto simp: Field_card_of)
   2.197 +
   2.198 +lemma Cinfinite_csum1:
   2.199 +  "Cinfinite r1 \<Longrightarrow> Cinfinite (r1 +c r2)"
   2.200 +unfolding cinfinite_def csum_def by (metis Field_card_of card_of_Card_order finite_Plus_iff)
   2.201 +
   2.202 +lemma Cinfinite_csum:
   2.203 +  "Cinfinite r1 \<or> Cinfinite r2 \<Longrightarrow> Cinfinite (r1 +c r2)"
   2.204 +unfolding cinfinite_def csum_def by (metis Field_card_of card_of_Card_order finite_Plus_iff)
   2.205 +
   2.206 +lemma Cinfinite_csum_strong:
   2.207 +  "\<lbrakk>Cinfinite r1; Cinfinite r2\<rbrakk> \<Longrightarrow> Cinfinite (r1 +c r2)"
   2.208 +by (metis Cinfinite_csum)
   2.209 +
   2.210 +lemma csum_cong: "\<lbrakk>p1 =o r1; p2 =o r2\<rbrakk> \<Longrightarrow> p1 +c p2 =o r1 +c r2"
   2.211 +by (simp only: csum_def ordIso_Plus_cong)
   2.212 +
   2.213 +lemma csum_cong1: "p1 =o r1 \<Longrightarrow> p1 +c q =o r1 +c q"
   2.214 +by (simp only: csum_def ordIso_Plus_cong1)
   2.215 +
   2.216 +lemma csum_cong2: "p2 =o r2 \<Longrightarrow> q +c p2 =o q +c r2"
   2.217 +by (simp only: csum_def ordIso_Plus_cong2)
   2.218 +
   2.219 +lemma csum_mono: "\<lbrakk>p1 \<le>o r1; p2 \<le>o r2\<rbrakk> \<Longrightarrow> p1 +c p2 \<le>o r1 +c r2"
   2.220 +by (simp only: csum_def ordLeq_Plus_mono)
   2.221 +
   2.222 +lemma csum_mono1: "p1 \<le>o r1 \<Longrightarrow> p1 +c q \<le>o r1 +c q"
   2.223 +by (simp only: csum_def ordLeq_Plus_mono1)
   2.224 +
   2.225 +lemma csum_mono2: "p2 \<le>o r2 \<Longrightarrow> q +c p2 \<le>o q +c r2"
   2.226 +by (simp only: csum_def ordLeq_Plus_mono2)
   2.227 +
   2.228 +lemma ordLeq_csum1: "Card_order p1 \<Longrightarrow> p1 \<le>o p1 +c p2"
   2.229 +by (simp only: csum_def Card_order_Plus1)
   2.230 +
   2.231 +lemma ordLeq_csum2: "Card_order p2 \<Longrightarrow> p2 \<le>o p1 +c p2"
   2.232 +by (simp only: csum_def Card_order_Plus2)
   2.233 +
   2.234 +lemma csum_com: "p1 +c p2 =o p2 +c p1"
   2.235 +by (simp only: csum_def card_of_Plus_commute)
   2.236 +
   2.237 +lemma csum_assoc: "(p1 +c p2) +c p3 =o p1 +c p2 +c p3"
   2.238 +by (simp only: csum_def Field_card_of card_of_Plus_assoc)
   2.239 +
   2.240 +lemma Cfinite_csum: "\<lbrakk>Cfinite r; Cfinite s\<rbrakk> \<Longrightarrow> Cfinite (r +c s)"
   2.241 +  unfolding cfinite_def csum_def Field_card_of using card_of_card_order_on by simp
   2.242 +
   2.243 +lemma csum_csum: "(r1 +c r2) +c (r3 +c r4) =o (r1 +c r3) +c (r2 +c r4)"
   2.244 +proof -
   2.245 +  have "(r1 +c r2) +c (r3 +c r4) =o r1 +c r2 +c (r3 +c r4)"
   2.246 +    by (metis csum_assoc)
   2.247 +  also have "r1 +c r2 +c (r3 +c r4) =o r1 +c (r2 +c r3) +c r4"
   2.248 +    by (metis csum_assoc csum_cong2 ordIso_symmetric)
   2.249 +  also have "r1 +c (r2 +c r3) +c r4 =o r1 +c (r3 +c r2) +c r4"
   2.250 +    by (metis csum_com csum_cong1 csum_cong2)
   2.251 +  also have "r1 +c (r3 +c r2) +c r4 =o r1 +c r3 +c r2 +c r4"
   2.252 +    by (metis csum_assoc csum_cong2 ordIso_symmetric)
   2.253 +  also have "r1 +c r3 +c r2 +c r4 =o (r1 +c r3) +c (r2 +c r4)"
   2.254 +    by (metis csum_assoc ordIso_symmetric)
   2.255 +  finally show ?thesis .
   2.256 +qed
   2.257 +
   2.258 +lemma Plus_csum: "|A <+> B| =o |A| +c |B|"
   2.259 +by (simp only: csum_def Field_card_of card_of_refl)
   2.260 +
   2.261 +lemma Un_csum: "|A \<union> B| \<le>o |A| +c |B|"
   2.262 +using ordLeq_ordIso_trans[OF card_of_Un_Plus_ordLeq Plus_csum] by blast
   2.263 +
   2.264 +
   2.265 +subsection {* One *}
   2.266 +
   2.267 +definition cone where
   2.268 +  "cone = card_of {()}"
   2.269 +
   2.270 +lemma Card_order_cone: "Card_order cone"
   2.271 +unfolding cone_def by (rule card_of_Card_order)
   2.272 +
   2.273 +lemma Cfinite_cone: "Cfinite cone"
   2.274 +  unfolding cfinite_def by (simp add: Card_order_cone)
   2.275 +
   2.276 +lemma cone_not_czero: "\<not> (cone =o czero)"
   2.277 +unfolding czero_def cone_def by (metis empty_not_insert card_of_empty3[of "{()}"] ordIso_iff_ordLeq)
   2.278 +
   2.279 +lemma cone_ordLeq_Cnotzero: "Cnotzero r \<Longrightarrow> cone \<le>o r"
   2.280 +unfolding cone_def by (metis Card_order_singl_ordLeq czeroI)
   2.281 +
   2.282 +
   2.283 +subsection{* Two *}
   2.284 +
   2.285 +definition ctwo where
   2.286 +  "ctwo = |UNIV :: bool set|"
   2.287 +
   2.288 +lemma Card_order_ctwo: "Card_order ctwo"
   2.289 +unfolding ctwo_def by (rule card_of_Card_order)
   2.290 +
   2.291 +lemma ctwo_not_czero: "\<not> (ctwo =o czero)"
   2.292 +using card_of_empty3[of "UNIV :: bool set"] ordIso_iff_ordLeq
   2.293 +unfolding czero_def ctwo_def by (metis UNIV_not_empty)
   2.294 +
   2.295 +lemma ctwo_Cnotzero: "Cnotzero ctwo"
   2.296 +by (simp add: ctwo_not_czero Card_order_ctwo)
   2.297 +
   2.298 +
   2.299 +subsection {* Family sum *}
   2.300 +
   2.301 +definition Csum where
   2.302 +  "Csum r rs \<equiv> |SIGMA i : Field r. Field (rs i)|"
   2.303 +
   2.304 +(* Similar setup to the one for SIGMA from theory Big_Operators: *)
   2.305 +syntax "_Csum" ::
   2.306 +  "pttrn => ('a * 'a) set => 'b * 'b set => (('a * 'b) * ('a * 'b)) set"
   2.307 +  ("(3CSUM _:_. _)" [0, 51, 10] 10)
   2.308 +
   2.309 +translations
   2.310 +  "CSUM i:r. rs" == "CONST Csum r (%i. rs)"
   2.311 +
   2.312 +lemma SIGMA_CSUM: "|SIGMA i : I. As i| = (CSUM i : |I|. |As i| )"
   2.313 +by (auto simp: Csum_def Field_card_of)
   2.314 +
   2.315 +(* NB: Always, under the cardinal operator,
   2.316 +operations on sets are reduced automatically to operations on cardinals.
   2.317 +This should make cardinal reasoning more direct and natural.  *)
   2.318 +
   2.319 +
   2.320 +subsection {* Product *}
   2.321 +
   2.322 +definition cprod (infixr "*c" 80) where
   2.323 +  "r1 *c r2 = |Field r1 <*> Field r2|"
   2.324 +
   2.325 +lemma card_order_cprod:
   2.326 +  assumes "card_order r1" "card_order r2"
   2.327 +  shows "card_order (r1 *c r2)"
   2.328 +proof -
   2.329 +  have "Field r1 = UNIV" "Field r2 = UNIV" using assms card_order_on_Card_order by auto
   2.330 +  thus ?thesis by (auto simp: cprod_def card_of_card_order_on)
   2.331 +qed
   2.332 +
   2.333 +lemma Card_order_cprod: "Card_order (r1 *c r2)"
   2.334 +by (simp only: cprod_def Field_card_of card_of_card_order_on)
   2.335 +
   2.336 +lemma cprod_mono1: "p1 \<le>o r1 \<Longrightarrow> p1 *c q \<le>o r1 *c q"
   2.337 +by (simp only: cprod_def ordLeq_Times_mono1)
   2.338 +
   2.339 +lemma cprod_mono2: "p2 \<le>o r2 \<Longrightarrow> q *c p2 \<le>o q *c r2"
   2.340 +by (simp only: cprod_def ordLeq_Times_mono2)
   2.341 +
   2.342 +lemma ordLeq_cprod2: "\<lbrakk>Cnotzero p1; Card_order p2\<rbrakk> \<Longrightarrow> p2 \<le>o p1 *c p2"
   2.343 +unfolding cprod_def by (metis Card_order_Times2 czeroI)
   2.344 +
   2.345 +lemma cinfinite_cprod: "\<lbrakk>cinfinite r1; cinfinite r2\<rbrakk> \<Longrightarrow> cinfinite (r1 *c r2)"
   2.346 +by (simp add: cinfinite_def cprod_def Field_card_of infinite_cartesian_product)
   2.347 +
   2.348 +lemma cinfinite_cprod2: "\<lbrakk>Cnotzero r1; Cinfinite r2\<rbrakk> \<Longrightarrow> cinfinite (r1 *c r2)"
   2.349 +by (metis cinfinite_mono ordLeq_cprod2)
   2.350 +
   2.351 +lemma Cinfinite_cprod2: "\<lbrakk>Cnotzero r1; Cinfinite r2\<rbrakk> \<Longrightarrow> Cinfinite (r1 *c r2)"
   2.352 +by (blast intro: cinfinite_cprod2 Card_order_cprod)
   2.353 +
   2.354 +lemma cprod_com: "p1 *c p2 =o p2 *c p1"
   2.355 +by (simp only: cprod_def card_of_Times_commute)
   2.356 +
   2.357 +lemma card_of_Csum_Times:
   2.358 +  "\<forall>i \<in> I. |A i| \<le>o |B| \<Longrightarrow> (CSUM i : |I|. |A i| ) \<le>o |I| *c |B|"
   2.359 +by (simp only: Csum_def cprod_def Field_card_of card_of_Sigma_Times)
   2.360 +
   2.361 +lemma card_of_Csum_Times':
   2.362 +  assumes "Card_order r" "\<forall>i \<in> I. |A i| \<le>o r"
   2.363 +  shows "(CSUM i : |I|. |A i| ) \<le>o |I| *c r"
   2.364 +proof -
   2.365 +  from assms(1) have *: "r =o |Field r|" by (simp add: card_of_unique)
   2.366 +  with assms(2) have "\<forall>i \<in> I. |A i| \<le>o |Field r|" by (blast intro: ordLeq_ordIso_trans)
   2.367 +  hence "(CSUM i : |I|. |A i| ) \<le>o |I| *c |Field r|" by (simp only: card_of_Csum_Times)
   2.368 +  also from * have "|I| *c |Field r| \<le>o |I| *c r"
   2.369 +    by (simp only: Field_card_of card_of_refl cprod_def ordIso_imp_ordLeq)
   2.370 +  finally show ?thesis .
   2.371 +qed
   2.372 +
   2.373 +lemma cprod_csum_distrib1: "r1 *c r2 +c r1 *c r3 =o r1 *c (r2 +c r3)"
   2.374 +unfolding csum_def cprod_def by (simp add: Field_card_of card_of_Times_Plus_distrib ordIso_symmetric)
   2.375 +
   2.376 +lemma csum_absorb2': "\<lbrakk>Card_order r2; r1 \<le>o r2; cinfinite r1 \<or> cinfinite r2\<rbrakk> \<Longrightarrow> r1 +c r2 =o r2"
   2.377 +unfolding csum_def by (metis Card_order_Plus_infinite cinfinite_def cinfinite_mono)
   2.378 +
   2.379 +lemma csum_absorb1':
   2.380 +  assumes card: "Card_order r2"
   2.381 +  and r12: "r1 \<le>o r2" and cr12: "cinfinite r1 \<or> cinfinite r2"
   2.382 +  shows "r2 +c r1 =o r2"
   2.383 +by (rule ordIso_transitive, rule csum_com, rule csum_absorb2', (simp only: assms)+)
   2.384 +
   2.385 +lemma csum_absorb1: "\<lbrakk>Cinfinite r2; r1 \<le>o r2\<rbrakk> \<Longrightarrow> r2 +c r1 =o r2"
   2.386 +by (rule csum_absorb1') auto
   2.387 +
   2.388 +
   2.389 +subsection {* Exponentiation *}
   2.390 +
   2.391 +definition cexp (infixr "^c" 90) where
   2.392 +  "r1 ^c r2 \<equiv> |Func (Field r2) (Field r1)|"
   2.393 +
   2.394 +lemma Card_order_cexp: "Card_order (r1 ^c r2)"
   2.395 +unfolding cexp_def by (rule card_of_Card_order)
   2.396 +
   2.397 +lemma cexp_mono':
   2.398 +  assumes 1: "p1 \<le>o r1" and 2: "p2 \<le>o r2"
   2.399 +  and n: "Field p2 = {} \<Longrightarrow> Field r2 = {}"
   2.400 +  shows "p1 ^c p2 \<le>o r1 ^c r2"
   2.401 +proof(cases "Field p1 = {}")
   2.402 +  case True
   2.403 +  hence "|Field |Func (Field p2) (Field p1)|| \<le>o cone"
   2.404 +    unfolding cone_def Field_card_of
   2.405 +    by (cases "Field p2 = {}", auto intro: card_of_ordLeqI2 simp: Func_empty)
   2.406 +       (metis Func_is_emp card_of_empty ex_in_conv)
   2.407 +  hence "|Func (Field p2) (Field p1)| \<le>o cone" by (simp add: Field_card_of cexp_def)
   2.408 +  hence "p1 ^c p2 \<le>o cone" unfolding cexp_def .
   2.409 +  thus ?thesis
   2.410 +  proof (cases "Field p2 = {}")
   2.411 +    case True
   2.412 +    with n have "Field r2 = {}" .
   2.413 +    hence "cone \<le>o r1 ^c r2" unfolding cone_def cexp_def Func_def by (auto intro: card_of_ordLeqI)
   2.414 +    thus ?thesis using `p1 ^c p2 \<le>o cone` ordLeq_transitive by auto
   2.415 +  next
   2.416 +    case False with True have "|Field (p1 ^c p2)| =o czero"
   2.417 +      unfolding card_of_ordIso_czero_iff_empty cexp_def Field_card_of Func_def by auto
   2.418 +    thus ?thesis unfolding cexp_def card_of_ordIso_czero_iff_empty Field_card_of
   2.419 +      by (simp add: card_of_empty)
   2.420 +  qed
   2.421 +next
   2.422 +  case False
   2.423 +  have 1: "|Field p1| \<le>o |Field r1|" and 2: "|Field p2| \<le>o |Field r2|"
   2.424 +    using 1 2 by (auto simp: card_of_mono2)
   2.425 +  obtain f1 where f1: "f1 ` Field r1 = Field p1"
   2.426 +    using 1 unfolding card_of_ordLeq2[OF False, symmetric] by auto
   2.427 +  obtain f2 where f2: "inj_on f2 (Field p2)" "f2 ` Field p2 \<subseteq> Field r2"
   2.428 +    using 2 unfolding card_of_ordLeq[symmetric] by blast
   2.429 +  have 0: "Func_map (Field p2) f1 f2 ` (Field (r1 ^c r2)) = Field (p1 ^c p2)"
   2.430 +    unfolding cexp_def Field_card_of using Func_map_surj[OF f1 f2 n, symmetric] .
   2.431 +  have 00: "Field (p1 ^c p2) \<noteq> {}" unfolding cexp_def Field_card_of Func_is_emp
   2.432 +    using False by simp
   2.433 +  show ?thesis
   2.434 +    using 0 card_of_ordLeq2[OF 00] unfolding cexp_def Field_card_of by blast
   2.435 +qed
   2.436 +
   2.437 +lemma cexp_mono:
   2.438 +  assumes 1: "p1 \<le>o r1" and 2: "p2 \<le>o r2"
   2.439 +  and n: "p2 =o czero \<Longrightarrow> r2 =o czero" and card: "Card_order p2"
   2.440 +  shows "p1 ^c p2 \<le>o r1 ^c r2"
   2.441 +  by (metis (full_types) "1" "2" card cexp_mono' czeroE czeroI n)
   2.442 +
   2.443 +lemma cexp_mono1:
   2.444 +  assumes 1: "p1 \<le>o r1" and q: "Card_order q"
   2.445 +  shows "p1 ^c q \<le>o r1 ^c q"
   2.446 +using ordLeq_refl[OF q] by (rule cexp_mono[OF 1]) (auto simp: q)
   2.447 +
   2.448 +lemma cexp_mono2':
   2.449 +  assumes 2: "p2 \<le>o r2" and q: "Card_order q"
   2.450 +  and n: "Field p2 = {} \<Longrightarrow> Field r2 = {}"
   2.451 +  shows "q ^c p2 \<le>o q ^c r2"
   2.452 +using ordLeq_refl[OF q] by (rule cexp_mono'[OF _ 2 n]) auto
   2.453 +
   2.454 +lemma cexp_mono2:
   2.455 +  assumes 2: "p2 \<le>o r2" and q: "Card_order q"
   2.456 +  and n: "p2 =o czero \<Longrightarrow> r2 =o czero" and card: "Card_order p2"
   2.457 +  shows "q ^c p2 \<le>o q ^c r2"
   2.458 +using ordLeq_refl[OF q] by (rule cexp_mono[OF _ 2 n card]) auto
   2.459 +
   2.460 +lemma cexp_mono2_Cnotzero:
   2.461 +  assumes "p2 \<le>o r2" "Card_order q" "Cnotzero p2"
   2.462 +  shows "q ^c p2 \<le>o q ^c r2"
   2.463 +by (metis assms cexp_mono2' czeroI)
   2.464 +
   2.465 +lemma cexp_cong:
   2.466 +  assumes 1: "p1 =o r1" and 2: "p2 =o r2"
   2.467 +  and Cr: "Card_order r2"
   2.468 +  and Cp: "Card_order p2"
   2.469 +  shows "p1 ^c p2 =o r1 ^c r2"
   2.470 +proof -
   2.471 +  obtain f where "bij_betw f (Field p2) (Field r2)"
   2.472 +    using 2 card_of_ordIso[of "Field p2" "Field r2"] card_of_cong by auto
   2.473 +  hence 0: "Field p2 = {} \<longleftrightarrow> Field r2 = {}" unfolding bij_betw_def by auto
   2.474 +  have r: "p2 =o czero \<Longrightarrow> r2 =o czero"
   2.475 +    and p: "r2 =o czero \<Longrightarrow> p2 =o czero"
   2.476 +     using 0 Cr Cp czeroE czeroI by auto
   2.477 +  show ?thesis using 0 1 2 unfolding ordIso_iff_ordLeq
   2.478 +    using r p cexp_mono[OF _ _ _ Cp] cexp_mono[OF _ _ _ Cr] by metis
   2.479 +qed
   2.480 +
   2.481 +lemma cexp_cong1:
   2.482 +  assumes 1: "p1 =o r1" and q: "Card_order q"
   2.483 +  shows "p1 ^c q =o r1 ^c q"
   2.484 +by (rule cexp_cong[OF 1 _ q q]) (rule ordIso_refl[OF q])
   2.485 +
   2.486 +lemma cexp_cong2:
   2.487 +  assumes 2: "p2 =o r2" and q: "Card_order q" and p: "Card_order p2"
   2.488 +  shows "q ^c p2 =o q ^c r2"
   2.489 +by (rule cexp_cong[OF _ 2]) (auto simp only: ordIso_refl Card_order_ordIso2[OF p 2] q p)
   2.490 +
   2.491 +lemma cexp_cone:
   2.492 +  assumes "Card_order r"
   2.493 +  shows "r ^c cone =o r"
   2.494 +proof -
   2.495 +  have "r ^c cone =o |Field r|"
   2.496 +    unfolding cexp_def cone_def Field_card_of Func_empty
   2.497 +      card_of_ordIso[symmetric] bij_betw_def Func_def inj_on_def image_def
   2.498 +    by (rule exI[of _ "\<lambda>f. f ()"]) auto
   2.499 +  also have "|Field r| =o r" by (rule card_of_Field_ordIso[OF assms])
   2.500 +  finally show ?thesis .
   2.501 +qed
   2.502 +
   2.503 +lemma cexp_cprod:
   2.504 +  assumes r1: "Card_order r1"
   2.505 +  shows "(r1 ^c r2) ^c r3 =o r1 ^c (r2 *c r3)" (is "?L =o ?R")
   2.506 +proof -
   2.507 +  have "?L =o r1 ^c (r3 *c r2)"
   2.508 +    unfolding cprod_def cexp_def Field_card_of
   2.509 +    using card_of_Func_Times by(rule ordIso_symmetric)
   2.510 +  also have "r1 ^c (r3 *c r2) =o ?R"
   2.511 +    apply(rule cexp_cong2) using cprod_com r1 by (auto simp: Card_order_cprod)
   2.512 +  finally show ?thesis .
   2.513 +qed
   2.514 +
   2.515 +lemma cprod_infinite1': "\<lbrakk>Cinfinite r; Cnotzero p; p \<le>o r\<rbrakk> \<Longrightarrow> r *c p =o r"
   2.516 +unfolding cinfinite_def cprod_def
   2.517 +by (rule Card_order_Times_infinite[THEN conjunct1]) (blast intro: czeroI)+
   2.518 +
   2.519 +lemma cexp_cprod_ordLeq:
   2.520 +  assumes r1: "Card_order r1" and r2: "Cinfinite r2"
   2.521 +  and r3: "Cnotzero r3" "r3 \<le>o r2"
   2.522 +  shows "(r1 ^c r2) ^c r3 =o r1 ^c r2" (is "?L =o ?R")
   2.523 +proof-
   2.524 +  have "?L =o r1 ^c (r2 *c r3)" using cexp_cprod[OF r1] .
   2.525 +  also have "r1 ^c (r2 *c r3) =o ?R"
   2.526 +  apply(rule cexp_cong2)
   2.527 +  apply(rule cprod_infinite1'[OF r2 r3]) using r1 r2 by (fastforce simp: Card_order_cprod)+
   2.528 +  finally show ?thesis .
   2.529 +qed
   2.530 +
   2.531 +lemma Cnotzero_UNIV: "Cnotzero |UNIV|"
   2.532 +by (auto simp: card_of_Card_order card_of_ordIso_czero_iff_empty)
   2.533 +
   2.534 +lemma ordLess_ctwo_cexp:
   2.535 +  assumes "Card_order r"
   2.536 +  shows "r <o ctwo ^c r"
   2.537 +proof -
   2.538 +  have "r <o |Pow (Field r)|" using assms by (rule Card_order_Pow)
   2.539 +  also have "|Pow (Field r)| =o ctwo ^c r"
   2.540 +    unfolding ctwo_def cexp_def Field_card_of by (rule card_of_Pow_Func)
   2.541 +  finally show ?thesis .
   2.542 +qed
   2.543 +
   2.544 +lemma ordLeq_cexp1:
   2.545 +  assumes "Cnotzero r" "Card_order q"
   2.546 +  shows "q \<le>o q ^c r"
   2.547 +proof (cases "q =o (czero :: 'a rel)")
   2.548 +  case True thus ?thesis by (simp only: card_of_empty cexp_def czero_def ordIso_ordLeq_trans)
   2.549 +next
   2.550 +  case False
   2.551 +  thus ?thesis
   2.552 +    apply -
   2.553 +    apply (rule ordIso_ordLeq_trans)
   2.554 +    apply (rule ordIso_symmetric)
   2.555 +    apply (rule cexp_cone)
   2.556 +    apply (rule assms(2))
   2.557 +    apply (rule cexp_mono2)
   2.558 +    apply (rule cone_ordLeq_Cnotzero)
   2.559 +    apply (rule assms(1))
   2.560 +    apply (rule assms(2))
   2.561 +    apply (rule notE)
   2.562 +    apply (rule cone_not_czero)
   2.563 +    apply assumption
   2.564 +    apply (rule Card_order_cone)
   2.565 +  done
   2.566 +qed
   2.567 +
   2.568 +lemma ordLeq_cexp2:
   2.569 +  assumes "ctwo \<le>o q" "Card_order r"
   2.570 +  shows "r \<le>o q ^c r"
   2.571 +proof (cases "r =o (czero :: 'a rel)")
   2.572 +  case True thus ?thesis by (simp only: card_of_empty cexp_def czero_def ordIso_ordLeq_trans)
   2.573 +next
   2.574 +  case False thus ?thesis
   2.575 +    apply -
   2.576 +    apply (rule ordLess_imp_ordLeq)
   2.577 +    apply (rule ordLess_ordLeq_trans)
   2.578 +    apply (rule ordLess_ctwo_cexp)
   2.579 +    apply (rule assms(2))
   2.580 +    apply (rule cexp_mono1)
   2.581 +    apply (rule assms(1))
   2.582 +    apply (rule assms(2))
   2.583 +  done
   2.584 +qed
   2.585 +
   2.586 +lemma cinfinite_cexp: "\<lbrakk>ctwo \<le>o q; Cinfinite r\<rbrakk> \<Longrightarrow> cinfinite (q ^c r)"
   2.587 +by (metis assms cinfinite_mono ordLeq_cexp2)
   2.588 +
   2.589 +lemma Cinfinite_cexp:
   2.590 +  "\<lbrakk>ctwo \<le>o q; Cinfinite r\<rbrakk> \<Longrightarrow> Cinfinite (q ^c r)"
   2.591 +by (simp add: cinfinite_cexp Card_order_cexp)
   2.592 +
   2.593 +lemma ctwo_ordLess_natLeq: "ctwo <o natLeq"
   2.594 +unfolding ctwo_def using finite_UNIV natLeq_cinfinite natLeq_Card_order
   2.595 +by (intro Cfinite_ordLess_Cinfinite) (auto simp: cfinite_def card_of_Card_order)
   2.596 +
   2.597 +lemma ctwo_ordLess_Cinfinite: "Cinfinite r \<Longrightarrow> ctwo <o r"
   2.598 +by (metis ctwo_ordLess_natLeq natLeq_ordLeq_cinfinite ordLess_ordLeq_trans)
   2.599 +
   2.600 +lemma ctwo_ordLeq_Cinfinite:
   2.601 +  assumes "Cinfinite r"
   2.602 +  shows "ctwo \<le>o r"
   2.603 +by (rule ordLess_imp_ordLeq[OF ctwo_ordLess_Cinfinite[OF assms]])
   2.604 +
   2.605 +lemma Un_Cinfinite_bound: "\<lbrakk>|A| \<le>o r; |B| \<le>o r; Cinfinite r\<rbrakk> \<Longrightarrow> |A \<union> B| \<le>o r"
   2.606 +by (auto simp add: cinfinite_def card_of_Un_ordLeq_infinite_Field)
   2.607 +
   2.608 +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.609 +by (auto simp add: card_of_UNION_ordLeq_infinite_Field cinfinite_def)
   2.610 +
   2.611 +lemma csum_cinfinite_bound:
   2.612 +  assumes "p \<le>o r" "q \<le>o r" "Card_order p" "Card_order q" "Cinfinite r"
   2.613 +  shows "p +c q \<le>o r"
   2.614 +proof -
   2.615 +  from assms(1-4) have "|Field p| \<le>o r" "|Field q| \<le>o r"
   2.616 +    unfolding card_order_on_def using card_of_least ordLeq_transitive by blast+
   2.617 +  with assms show ?thesis unfolding cinfinite_def csum_def
   2.618 +    by (blast intro: card_of_Plus_ordLeq_infinite_Field)
   2.619 +qed
   2.620 +
   2.621 +lemma cprod_cinfinite_bound:
   2.622 +  assumes "p \<le>o r" "q \<le>o r" "Card_order p" "Card_order q" "Cinfinite r"
   2.623 +  shows "p *c q \<le>o r"
   2.624 +proof -
   2.625 +  from assms(1-4) have "|Field p| \<le>o r" "|Field q| \<le>o r"
   2.626 +    unfolding card_order_on_def using card_of_least ordLeq_transitive by blast+
   2.627 +  with assms show ?thesis unfolding cinfinite_def cprod_def
   2.628 +    by (blast intro: card_of_Times_ordLeq_infinite_Field)
   2.629 +qed
   2.630 +
   2.631 +lemma cprod_csum_cexp:
   2.632 +  "r1 *c r2 \<le>o (r1 +c r2) ^c ctwo"
   2.633 +unfolding cprod_def csum_def cexp_def ctwo_def Field_card_of
   2.634 +proof -
   2.635 +  let ?f = "\<lambda>(a, b). %x. if x then Inl a else Inr b"
   2.636 +  have "inj_on ?f (Field r1 \<times> Field r2)" (is "inj_on _ ?LHS")
   2.637 +    by (auto simp: inj_on_def fun_eq_iff split: bool.split)
   2.638 +  moreover
   2.639 +  have "?f ` ?LHS \<subseteq> Func (UNIV :: bool set) (Field r1 <+> Field r2)" (is "_ \<subseteq> ?RHS")
   2.640 +    by (auto simp: Func_def)
   2.641 +  ultimately show "|?LHS| \<le>o |?RHS|" using card_of_ordLeq by blast
   2.642 +qed
   2.643 +
   2.644 +lemma Cfinite_cprod_Cinfinite: "\<lbrakk>Cfinite r; Cinfinite s\<rbrakk> \<Longrightarrow> r *c s \<le>o s"
   2.645 +by (intro cprod_cinfinite_bound)
   2.646 +  (auto intro: ordLeq_refl ordLess_imp_ordLeq[OF Cfinite_ordLess_Cinfinite])
   2.647 +
   2.648 +lemma cprod_cexp: "(r *c s) ^c t =o r ^c t *c s ^c t"
   2.649 +  unfolding cprod_def cexp_def Field_card_of by (rule Func_Times_Range)
   2.650 +
   2.651 +lemma cprod_cexp_csum_cexp_Cinfinite:
   2.652 +  assumes t: "Cinfinite t"
   2.653 +  shows "(r *c s) ^c t \<le>o (r +c s) ^c t"
   2.654 +proof -
   2.655 +  have "(r *c s) ^c t \<le>o ((r +c s) ^c ctwo) ^c t"
   2.656 +    by (rule cexp_mono1[OF cprod_csum_cexp conjunct2[OF t]])
   2.657 +  also have "((r +c s) ^c ctwo) ^c t =o (r +c s) ^c (ctwo *c t)"
   2.658 +    by (rule cexp_cprod[OF Card_order_csum])
   2.659 +  also have "(r +c s) ^c (ctwo *c t) =o (r +c s) ^c (t *c ctwo)"
   2.660 +    by (rule cexp_cong2[OF cprod_com Card_order_csum Card_order_cprod])
   2.661 +  also have "(r +c s) ^c (t *c ctwo) =o ((r +c s) ^c t) ^c ctwo"
   2.662 +    by (rule ordIso_symmetric[OF cexp_cprod[OF Card_order_csum]])
   2.663 +  also have "((r +c s) ^c t) ^c ctwo =o (r +c s) ^c t"
   2.664 +    by (rule cexp_cprod_ordLeq[OF Card_order_csum t ctwo_Cnotzero ctwo_ordLeq_Cinfinite[OF t]])
   2.665 +  finally show ?thesis .
   2.666 +qed
   2.667 +
   2.668 +lemma Cfinite_cexp_Cinfinite:
   2.669 +  assumes s: "Cfinite s" and t: "Cinfinite t"
   2.670 +  shows "s ^c t \<le>o ctwo ^c t"
   2.671 +proof (cases "s \<le>o ctwo")
   2.672 +  case True thus ?thesis using t by (blast intro: cexp_mono1)
   2.673 +next
   2.674 +  case False
   2.675 +  hence "ctwo \<le>o s" by (metis card_order_on_well_order_on ctwo_Cnotzero ordLeq_total s)
   2.676 +  hence "Cnotzero s" by (metis Cnotzero_mono ctwo_Cnotzero s)
   2.677 +  hence st: "Cnotzero (s *c t)" by (metis Cinfinite_cprod2 cinfinite_not_czero t)
   2.678 +  have "s ^c t \<le>o (ctwo ^c s) ^c t"
   2.679 +    using assms by (blast intro: cexp_mono1 ordLess_imp_ordLeq[OF ordLess_ctwo_cexp])
   2.680 +  also have "(ctwo ^c s) ^c t =o ctwo ^c (s *c t)"
   2.681 +    by (blast intro: Card_order_ctwo cexp_cprod)
   2.682 +  also have "ctwo ^c (s *c t) \<le>o ctwo ^c t"
   2.683 +    using assms st by (intro cexp_mono2_Cnotzero Cfinite_cprod_Cinfinite Card_order_ctwo)
   2.684 +  finally show ?thesis .
   2.685 +qed
   2.686 +
   2.687 +lemma csum_Cfinite_cexp_Cinfinite:
   2.688 +  assumes r: "Card_order r" and s: "Cfinite s" and t: "Cinfinite t"
   2.689 +  shows "(r +c s) ^c t \<le>o (r +c ctwo) ^c t"
   2.690 +proof (cases "Cinfinite r")
   2.691 +  case True
   2.692 +  hence "r +c s =o r" by (intro csum_absorb1 ordLess_imp_ordLeq[OF Cfinite_ordLess_Cinfinite] s)
   2.693 +  hence "(r +c s) ^c t =o r ^c t" using t by (blast intro: cexp_cong1)
   2.694 +  also have "r ^c t \<le>o (r +c ctwo) ^c t" using t by (blast intro: cexp_mono1 ordLeq_csum1 r)
   2.695 +  finally show ?thesis .
   2.696 +next
   2.697 +  case False
   2.698 +  with r have "Cfinite r" unfolding cinfinite_def cfinite_def by auto
   2.699 +  hence "Cfinite (r +c s)" by (intro Cfinite_csum s)
   2.700 +  hence "(r +c s) ^c t \<le>o ctwo ^c t" by (intro Cfinite_cexp_Cinfinite t)
   2.701 +  also have "ctwo ^c t \<le>o (r +c ctwo) ^c t" using t
   2.702 +    by (blast intro: cexp_mono1 ordLeq_csum2 Card_order_ctwo)
   2.703 +  finally show ?thesis .
   2.704 +qed
   2.705 +
   2.706 +(* cardSuc *)
   2.707 +
   2.708 +lemma Cinfinite_cardSuc: "Cinfinite r \<Longrightarrow> Cinfinite (cardSuc r)"
   2.709 +by (simp add: cinfinite_def cardSuc_Card_order cardSuc_finite)
   2.710 +
   2.711 +lemma cardSuc_UNION_Cinfinite:
   2.712 +  assumes "Cinfinite r" "relChain (cardSuc r) As" "B \<le> (UN i : Field (cardSuc r). As i)" "|B| <=o r"
   2.713 +  shows "EX i : Field (cardSuc r). B \<le> As i"
   2.714 +using cardSuc_UNION assms unfolding cinfinite_def by blast
   2.715 +
   2.716 +end
     3.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     3.2 +++ b/src/HOL/Cardinal_Order_Relation_FP.thy	Mon Jan 20 18:24:55 2014 +0100
     3.3 @@ -0,0 +1,1828 @@
     3.4 +(*  Title:      HOL/Cardinal_Order_Relation_FP.thy
     3.5 +    Author:     Andrei Popescu, TU Muenchen
     3.6 +    Copyright   2012
     3.7 +
     3.8 +Cardinal-order relations (FP).
     3.9 +*)
    3.10 +
    3.11 +header {* Cardinal-Order Relations (FP) *}
    3.12 +
    3.13 +theory Cardinal_Order_Relation_FP
    3.14 +imports Constructions_on_Wellorders_FP
    3.15 +begin
    3.16 +
    3.17 +
    3.18 +text{* In this section, we define cardinal-order relations to be minim well-orders
    3.19 +on their field.  Then we define the cardinal of a set to be {\em some} cardinal-order
    3.20 +relation on that set, which will be unique up to order isomorphism.  Then we study
    3.21 +the connection between cardinals and:
    3.22 +\begin{itemize}
    3.23 +\item standard set-theoretic constructions: products,
    3.24 +sums, unions, lists, powersets, set-of finite sets operator;
    3.25 +\item finiteness and infiniteness (in particular, with the numeric cardinal operator
    3.26 +for finite sets, @{text "card"}, from the theory @{text "Finite_Sets.thy"}).
    3.27 +\end{itemize}
    3.28 +%
    3.29 +On the way, we define the canonical $\omega$ cardinal and finite cardinals.  We also
    3.30 +define (again, up to order isomorphism) the successor of a cardinal, and show that
    3.31 +any cardinal admits a successor.
    3.32 +
    3.33 +Main results of this section are the existence of cardinal relations and the
    3.34 +facts that, in the presence of infiniteness,
    3.35 +most of the standard set-theoretic constructions (except for the powerset)
    3.36 +{\em do not increase cardinality}.  In particular, e.g., the set of words/lists over
    3.37 +any infinite set has the same cardinality (hence, is in bijection) with that set.
    3.38 +*}
    3.39 +
    3.40 +
    3.41 +subsection {* Cardinal orders *}
    3.42 +
    3.43 +
    3.44 +text{* A cardinal order in our setting shall be a well-order {\em minim} w.r.t. the
    3.45 +order-embedding relation, @{text "\<le>o"} (which is the same as being {\em minimal} w.r.t. the
    3.46 +strict order-embedding relation, @{text "<o"}), among all the well-orders on its field.  *}
    3.47 +
    3.48 +definition card_order_on :: "'a set \<Rightarrow> 'a rel \<Rightarrow> bool"
    3.49 +where
    3.50 +"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.51 +
    3.52 +
    3.53 +abbreviation "Card_order r \<equiv> card_order_on (Field r) r"
    3.54 +abbreviation "card_order r \<equiv> card_order_on UNIV r"
    3.55 +
    3.56 +
    3.57 +lemma card_order_on_well_order_on:
    3.58 +assumes "card_order_on A r"
    3.59 +shows "well_order_on A r"
    3.60 +using assms unfolding card_order_on_def by simp
    3.61 +
    3.62 +
    3.63 +lemma card_order_on_Card_order:
    3.64 +"card_order_on A r \<Longrightarrow> A = Field r \<and> Card_order r"
    3.65 +unfolding card_order_on_def using well_order_on_Field by blast
    3.66 +
    3.67 +
    3.68 +text{* The existence of a cardinal relation on any given set (which will mean
    3.69 +that any set has a cardinal) follows from two facts:
    3.70 +\begin{itemize}
    3.71 +\item Zermelo's theorem (proved in @{text "Zorn.thy"} as theorem @{text "well_order_on"}),
    3.72 +which states that on any given set there exists a well-order;
    3.73 +\item The well-founded-ness of @{text "<o"}, ensuring that then there exists a minimal
    3.74 +such well-order, i.e., a cardinal order.
    3.75 +\end{itemize}
    3.76 +*}
    3.77 +
    3.78 +
    3.79 +theorem card_order_on: "\<exists>r. card_order_on A r"
    3.80 +proof-
    3.81 +  obtain R where R_def: "R = {r. well_order_on A r}" by blast
    3.82 +  have 1: "R \<noteq> {} \<and> (\<forall>r \<in> R. Well_order r)"
    3.83 +  using well_order_on[of A] R_def well_order_on_Well_order by blast
    3.84 +  hence "\<exists>r \<in> R. \<forall>r' \<in> R. r \<le>o r'"
    3.85 +  using  exists_minim_Well_order[of R] by auto
    3.86 +  thus ?thesis using R_def unfolding card_order_on_def by auto
    3.87 +qed
    3.88 +
    3.89 +
    3.90 +lemma card_order_on_ordIso:
    3.91 +assumes CO: "card_order_on A r" and CO': "card_order_on A r'"
    3.92 +shows "r =o r'"
    3.93 +using assms unfolding card_order_on_def
    3.94 +using ordIso_iff_ordLeq by blast
    3.95 +
    3.96 +
    3.97 +lemma Card_order_ordIso:
    3.98 +assumes CO: "Card_order r" and ISO: "r' =o r"
    3.99 +shows "Card_order r'"
   3.100 +using ISO unfolding ordIso_def
   3.101 +proof(unfold card_order_on_def, auto)
   3.102 +  fix p' assume "well_order_on (Field r') p'"
   3.103 +  hence 0: "Well_order p' \<and> Field p' = Field r'"
   3.104 +  using well_order_on_Well_order by blast
   3.105 +  obtain f where 1: "iso r' r f" and 2: "Well_order r \<and> Well_order r'"
   3.106 +  using ISO unfolding ordIso_def by auto
   3.107 +  hence 3: "inj_on f (Field r') \<and> f ` (Field r') = Field r"
   3.108 +  by (auto simp add: iso_iff embed_inj_on)
   3.109 +  let ?p = "dir_image p' f"
   3.110 +  have 4: "p' =o ?p \<and> Well_order ?p"
   3.111 +  using 0 2 3 by (auto simp add: dir_image_ordIso Well_order_dir_image)
   3.112 +  moreover have "Field ?p =  Field r"
   3.113 +  using 0 3 by (auto simp add: dir_image_Field2 order_on_defs)
   3.114 +  ultimately have "well_order_on (Field r) ?p" by auto
   3.115 +  hence "r \<le>o ?p" using CO unfolding card_order_on_def by auto
   3.116 +  thus "r' \<le>o p'"
   3.117 +  using ISO 4 ordLeq_ordIso_trans ordIso_ordLeq_trans ordIso_symmetric by blast
   3.118 +qed
   3.119 +
   3.120 +
   3.121 +lemma Card_order_ordIso2:
   3.122 +assumes CO: "Card_order r" and ISO: "r =o r'"
   3.123 +shows "Card_order r'"
   3.124 +using assms Card_order_ordIso ordIso_symmetric by blast
   3.125 +
   3.126 +
   3.127 +subsection {* Cardinal of a set *}
   3.128 +
   3.129 +
   3.130 +text{* We define the cardinal of set to be {\em some} cardinal order on that set.
   3.131 +We shall prove that this notion is unique up to order isomorphism, meaning
   3.132 +that order isomorphism shall be the true identity of cardinals.  *}
   3.133 +
   3.134 +
   3.135 +definition card_of :: "'a set \<Rightarrow> 'a rel" ("|_|" )
   3.136 +where "card_of A = (SOME r. card_order_on A r)"
   3.137 +
   3.138 +
   3.139 +lemma card_of_card_order_on: "card_order_on A |A|"
   3.140 +unfolding card_of_def by (auto simp add: card_order_on someI_ex)
   3.141 +
   3.142 +
   3.143 +lemma card_of_well_order_on: "well_order_on A |A|"
   3.144 +using card_of_card_order_on card_order_on_def by blast
   3.145 +
   3.146 +
   3.147 +lemma Field_card_of: "Field |A| = A"
   3.148 +using card_of_card_order_on[of A] unfolding card_order_on_def
   3.149 +using well_order_on_Field by blast
   3.150 +
   3.151 +
   3.152 +lemma card_of_Card_order: "Card_order |A|"
   3.153 +by (simp only: card_of_card_order_on Field_card_of)
   3.154 +
   3.155 +
   3.156 +corollary ordIso_card_of_imp_Card_order:
   3.157 +"r =o |A| \<Longrightarrow> Card_order r"
   3.158 +using card_of_Card_order Card_order_ordIso by blast
   3.159 +
   3.160 +
   3.161 +lemma card_of_Well_order: "Well_order |A|"
   3.162 +using card_of_Card_order unfolding card_order_on_def by auto
   3.163 +
   3.164 +
   3.165 +lemma card_of_refl: "|A| =o |A|"
   3.166 +using card_of_Well_order ordIso_reflexive by blast
   3.167 +
   3.168 +
   3.169 +lemma card_of_least: "well_order_on A r \<Longrightarrow> |A| \<le>o r"
   3.170 +using card_of_card_order_on unfolding card_order_on_def by blast
   3.171 +
   3.172 +
   3.173 +lemma card_of_ordIso:
   3.174 +"(\<exists>f. bij_betw f A B) = ( |A| =o |B| )"
   3.175 +proof(auto)
   3.176 +  fix f assume *: "bij_betw f A B"
   3.177 +  then obtain r where "well_order_on B r \<and> |A| =o r"
   3.178 +  using Well_order_iso_copy card_of_well_order_on by blast
   3.179 +  hence "|B| \<le>o |A|" using card_of_least
   3.180 +  ordLeq_ordIso_trans ordIso_symmetric by blast
   3.181 +  moreover
   3.182 +  {let ?g = "inv_into A f"
   3.183 +   have "bij_betw ?g B A" using * bij_betw_inv_into by blast
   3.184 +   then obtain r where "well_order_on A r \<and> |B| =o r"
   3.185 +   using Well_order_iso_copy card_of_well_order_on by blast
   3.186 +   hence "|A| \<le>o |B|" using card_of_least
   3.187 +   ordLeq_ordIso_trans ordIso_symmetric by blast
   3.188 +  }
   3.189 +  ultimately show "|A| =o |B|" using ordIso_iff_ordLeq by blast
   3.190 +next
   3.191 +  assume "|A| =o |B|"
   3.192 +  then obtain f where "iso ( |A| ) ( |B| ) f"
   3.193 +  unfolding ordIso_def by auto
   3.194 +  hence "bij_betw f A B" unfolding iso_def Field_card_of by simp
   3.195 +  thus "\<exists>f. bij_betw f A B" by auto
   3.196 +qed
   3.197 +
   3.198 +
   3.199 +lemma card_of_ordLeq:
   3.200 +"(\<exists>f. inj_on f A \<and> f ` A \<le> B) = ( |A| \<le>o |B| )"
   3.201 +proof(auto)
   3.202 +  fix f assume *: "inj_on f A" and **: "f ` A \<le> B"
   3.203 +  {assume "|B| <o |A|"
   3.204 +   hence "|B| \<le>o |A|" using ordLeq_iff_ordLess_or_ordIso by blast
   3.205 +   then obtain g where "embed ( |B| ) ( |A| ) g"
   3.206 +   unfolding ordLeq_def by auto
   3.207 +   hence 1: "inj_on g B \<and> g ` B \<le> A" using embed_inj_on[of "|B|" "|A|" "g"]
   3.208 +   card_of_Well_order[of "B"] Field_card_of[of "B"] Field_card_of[of "A"]
   3.209 +   embed_Field[of "|B|" "|A|" g] by auto
   3.210 +   obtain h where "bij_betw h A B"
   3.211 +   using * ** 1 Cantor_Bernstein[of f] by fastforce
   3.212 +   hence "|A| =o |B|" using card_of_ordIso by blast
   3.213 +   hence "|A| \<le>o |B|" using ordIso_iff_ordLeq by auto
   3.214 +  }
   3.215 +  thus "|A| \<le>o |B|" using ordLess_or_ordLeq[of "|B|" "|A|"]
   3.216 +  by (auto simp: card_of_Well_order)
   3.217 +next
   3.218 +  assume *: "|A| \<le>o |B|"
   3.219 +  obtain f where "embed ( |A| ) ( |B| ) f"
   3.220 +  using * unfolding ordLeq_def by auto
   3.221 +  hence "inj_on f A \<and> f ` A \<le> B" using embed_inj_on[of "|A|" "|B|" f]
   3.222 +  card_of_Well_order[of "A"] Field_card_of[of "A"] Field_card_of[of "B"]
   3.223 +  embed_Field[of "|A|" "|B|" f] by auto
   3.224 +  thus "\<exists>f. inj_on f A \<and> f ` A \<le> B" by auto
   3.225 +qed
   3.226 +
   3.227 +
   3.228 +lemma card_of_ordLeq2:
   3.229 +"A \<noteq> {} \<Longrightarrow> (\<exists>g. g ` B = A) = ( |A| \<le>o |B| )"
   3.230 +using card_of_ordLeq[of A B] inj_on_iff_surj[of A B] by auto
   3.231 +
   3.232 +
   3.233 +lemma card_of_ordLess:
   3.234 +"(\<not>(\<exists>f. inj_on f A \<and> f ` A \<le> B)) = ( |B| <o |A| )"
   3.235 +proof-
   3.236 +  have "(\<not>(\<exists>f. inj_on f A \<and> f ` A \<le> B)) = (\<not> |A| \<le>o |B| )"
   3.237 +  using card_of_ordLeq by blast
   3.238 +  also have "\<dots> = ( |B| <o |A| )"
   3.239 +  using card_of_Well_order[of A] card_of_Well_order[of B]
   3.240 +        not_ordLeq_iff_ordLess by blast
   3.241 +  finally show ?thesis .
   3.242 +qed
   3.243 +
   3.244 +
   3.245 +lemma card_of_ordLess2:
   3.246 +"B \<noteq> {} \<Longrightarrow> (\<not>(\<exists>f. f ` A = B)) = ( |A| <o |B| )"
   3.247 +using card_of_ordLess[of B A] inj_on_iff_surj[of B A] by auto
   3.248 +
   3.249 +
   3.250 +lemma card_of_ordIsoI:
   3.251 +assumes "bij_betw f A B"
   3.252 +shows "|A| =o |B|"
   3.253 +using assms unfolding card_of_ordIso[symmetric] by auto
   3.254 +
   3.255 +
   3.256 +lemma card_of_ordLeqI:
   3.257 +assumes "inj_on f A" and "\<And> a. a \<in> A \<Longrightarrow> f a \<in> B"
   3.258 +shows "|A| \<le>o |B|"
   3.259 +using assms unfolding card_of_ordLeq[symmetric] by auto
   3.260 +
   3.261 +
   3.262 +lemma card_of_unique:
   3.263 +"card_order_on A r \<Longrightarrow> r =o |A|"
   3.264 +by (simp only: card_order_on_ordIso card_of_card_order_on)
   3.265 +
   3.266 +
   3.267 +lemma card_of_mono1:
   3.268 +"A \<le> B \<Longrightarrow> |A| \<le>o |B|"
   3.269 +using inj_on_id[of A] card_of_ordLeq[of A B] by fastforce
   3.270 +
   3.271 +
   3.272 +lemma card_of_mono2:
   3.273 +assumes "r \<le>o r'"
   3.274 +shows "|Field r| \<le>o |Field r'|"
   3.275 +proof-
   3.276 +  obtain f where
   3.277 +  1: "well_order_on (Field r) r \<and> well_order_on (Field r) r \<and> embed r r' f"
   3.278 +  using assms unfolding ordLeq_def
   3.279 +  by (auto simp add: well_order_on_Well_order)
   3.280 +  hence "inj_on f (Field r) \<and> f ` (Field r) \<le> Field r'"
   3.281 +  by (auto simp add: embed_inj_on embed_Field)
   3.282 +  thus "|Field r| \<le>o |Field r'|" using card_of_ordLeq by blast
   3.283 +qed
   3.284 +
   3.285 +
   3.286 +lemma card_of_cong: "r =o r' \<Longrightarrow> |Field r| =o |Field r'|"
   3.287 +by (simp add: ordIso_iff_ordLeq card_of_mono2)
   3.288 +
   3.289 +
   3.290 +lemma card_of_Field_ordLess: "Well_order r \<Longrightarrow> |Field r| \<le>o r"
   3.291 +using card_of_least card_of_well_order_on well_order_on_Well_order by blast
   3.292 +
   3.293 +
   3.294 +lemma card_of_Field_ordIso:
   3.295 +assumes "Card_order r"
   3.296 +shows "|Field r| =o r"
   3.297 +proof-
   3.298 +  have "card_order_on (Field r) r"
   3.299 +  using assms card_order_on_Card_order by blast
   3.300 +  moreover have "card_order_on (Field r) |Field r|"
   3.301 +  using card_of_card_order_on by blast
   3.302 +  ultimately show ?thesis using card_order_on_ordIso by blast
   3.303 +qed
   3.304 +
   3.305 +
   3.306 +lemma Card_order_iff_ordIso_card_of:
   3.307 +"Card_order r = (r =o |Field r| )"
   3.308 +using ordIso_card_of_imp_Card_order card_of_Field_ordIso ordIso_symmetric by blast
   3.309 +
   3.310 +
   3.311 +lemma Card_order_iff_ordLeq_card_of:
   3.312 +"Card_order r = (r \<le>o |Field r| )"
   3.313 +proof-
   3.314 +  have "Card_order r = (r =o |Field r| )"
   3.315 +  unfolding Card_order_iff_ordIso_card_of by simp
   3.316 +  also have "... = (r \<le>o |Field r| \<and> |Field r| \<le>o r)"
   3.317 +  unfolding ordIso_iff_ordLeq by simp
   3.318 +  also have "... = (r \<le>o |Field r| )"
   3.319 +  using card_of_Field_ordLess
   3.320 +  by (auto simp: card_of_Field_ordLess ordLeq_Well_order_simp)
   3.321 +  finally show ?thesis .
   3.322 +qed
   3.323 +
   3.324 +
   3.325 +lemma Card_order_iff_Restr_underS:
   3.326 +assumes "Well_order r"
   3.327 +shows "Card_order r = (\<forall>a \<in> Field r. Restr r (underS r a) <o |Field r| )"
   3.328 +using assms unfolding Card_order_iff_ordLeq_card_of
   3.329 +using ordLeq_iff_ordLess_Restr card_of_Well_order by blast
   3.330 +
   3.331 +
   3.332 +lemma card_of_underS:
   3.333 +assumes r: "Card_order r" and a: "a : Field r"
   3.334 +shows "|underS r a| <o r"
   3.335 +proof-
   3.336 +  let ?A = "underS r a"  let ?r' = "Restr r ?A"
   3.337 +  have 1: "Well_order r"
   3.338 +  using r unfolding card_order_on_def by simp
   3.339 +  have "Well_order ?r'" using 1 Well_order_Restr by auto
   3.340 +  moreover have "card_order_on (Field ?r') |Field ?r'|"
   3.341 +  using card_of_card_order_on .
   3.342 +  ultimately have "|Field ?r'| \<le>o ?r'"
   3.343 +  unfolding card_order_on_def by simp
   3.344 +  moreover have "Field ?r' = ?A"
   3.345 +  using 1 wo_rel.underS_ofilter Field_Restr_ofilter
   3.346 +  unfolding wo_rel_def by fastforce
   3.347 +  ultimately have "|?A| \<le>o ?r'" by simp
   3.348 +  also have "?r' <o |Field r|"
   3.349 +  using 1 a r Card_order_iff_Restr_underS by blast
   3.350 +  also have "|Field r| =o r"
   3.351 +  using r ordIso_symmetric unfolding Card_order_iff_ordIso_card_of by auto
   3.352 +  finally show ?thesis .
   3.353 +qed
   3.354 +
   3.355 +
   3.356 +lemma ordLess_Field:
   3.357 +assumes "r <o r'"
   3.358 +shows "|Field r| <o r'"
   3.359 +proof-
   3.360 +  have "well_order_on (Field r) r" using assms unfolding ordLess_def
   3.361 +  by (auto simp add: well_order_on_Well_order)
   3.362 +  hence "|Field r| \<le>o r" using card_of_least by blast
   3.363 +  thus ?thesis using assms ordLeq_ordLess_trans by blast
   3.364 +qed
   3.365 +
   3.366 +
   3.367 +lemma internalize_card_of_ordLeq:
   3.368 +"( |A| \<le>o r) = (\<exists>B \<le> Field r. |A| =o |B| \<and> |B| \<le>o r)"
   3.369 +proof
   3.370 +  assume "|A| \<le>o r"
   3.371 +  then obtain p where 1: "Field p \<le> Field r \<and> |A| =o p \<and> p \<le>o r"
   3.372 +  using internalize_ordLeq[of "|A|" r] by blast
   3.373 +  hence "Card_order p" using card_of_Card_order Card_order_ordIso2 by blast
   3.374 +  hence "|Field p| =o p" using card_of_Field_ordIso by blast
   3.375 +  hence "|A| =o |Field p| \<and> |Field p| \<le>o r"
   3.376 +  using 1 ordIso_equivalence ordIso_ordLeq_trans by blast
   3.377 +  thus "\<exists>B \<le> Field r. |A| =o |B| \<and> |B| \<le>o r" using 1 by blast
   3.378 +next
   3.379 +  assume "\<exists>B \<le> Field r. |A| =o |B| \<and> |B| \<le>o r"
   3.380 +  thus "|A| \<le>o r" using ordIso_ordLeq_trans by blast
   3.381 +qed
   3.382 +
   3.383 +
   3.384 +lemma internalize_card_of_ordLeq2:
   3.385 +"( |A| \<le>o |C| ) = (\<exists>B \<le> C. |A| =o |B| \<and> |B| \<le>o |C| )"
   3.386 +using internalize_card_of_ordLeq[of "A" "|C|"] Field_card_of[of C] by auto
   3.387 +
   3.388 +
   3.389 +
   3.390 +subsection {* Cardinals versus set operations on arbitrary sets *}
   3.391 +
   3.392 +
   3.393 +text{* Here we embark in a long journey of simple results showing
   3.394 +that the standard set-theoretic operations are well-behaved w.r.t. the notion of
   3.395 +cardinal -- essentially, this means that they preserve the ``cardinal identity"
   3.396 +@{text "=o"} and are monotonic w.r.t. @{text "\<le>o"}.
   3.397 +*}
   3.398 +
   3.399 +
   3.400 +lemma card_of_empty: "|{}| \<le>o |A|"
   3.401 +using card_of_ordLeq inj_on_id by blast
   3.402 +
   3.403 +
   3.404 +lemma card_of_empty1:
   3.405 +assumes "Well_order r \<or> Card_order r"
   3.406 +shows "|{}| \<le>o r"
   3.407 +proof-
   3.408 +  have "Well_order r" using assms unfolding card_order_on_def by auto
   3.409 +  hence "|Field r| <=o r"
   3.410 +  using assms card_of_Field_ordLess by blast
   3.411 +  moreover have "|{}| \<le>o |Field r|" by (simp add: card_of_empty)
   3.412 +  ultimately show ?thesis using ordLeq_transitive by blast
   3.413 +qed
   3.414 +
   3.415 +
   3.416 +corollary Card_order_empty:
   3.417 +"Card_order r \<Longrightarrow> |{}| \<le>o r" by (simp add: card_of_empty1)
   3.418 +
   3.419 +
   3.420 +lemma card_of_empty2:
   3.421 +assumes LEQ: "|A| =o |{}|"
   3.422 +shows "A = {}"
   3.423 +using assms card_of_ordIso[of A] bij_betw_empty2 by blast
   3.424 +
   3.425 +
   3.426 +lemma card_of_empty3:
   3.427 +assumes LEQ: "|A| \<le>o |{}|"
   3.428 +shows "A = {}"
   3.429 +using assms
   3.430 +by (simp add: ordIso_iff_ordLeq card_of_empty1 card_of_empty2
   3.431 +              ordLeq_Well_order_simp)
   3.432 +
   3.433 +
   3.434 +lemma card_of_empty_ordIso:
   3.435 +"|{}::'a set| =o |{}::'b set|"
   3.436 +using card_of_ordIso unfolding bij_betw_def inj_on_def by blast
   3.437 +
   3.438 +
   3.439 +lemma card_of_image:
   3.440 +"|f ` A| <=o |A|"
   3.441 +proof(cases "A = {}", simp add: card_of_empty)
   3.442 +  assume "A ~= {}"
   3.443 +  hence "f ` A ~= {}" by auto
   3.444 +  thus "|f ` A| \<le>o |A|"
   3.445 +  using card_of_ordLeq2[of "f ` A" A] by auto
   3.446 +qed
   3.447 +
   3.448 +
   3.449 +lemma surj_imp_ordLeq:
   3.450 +assumes "B <= f ` A"
   3.451 +shows "|B| <=o |A|"
   3.452 +proof-
   3.453 +  have "|B| <=o |f ` A|" using assms card_of_mono1 by auto
   3.454 +  thus ?thesis using card_of_image ordLeq_transitive by blast
   3.455 +qed
   3.456 +
   3.457 +
   3.458 +lemma card_of_ordLeqI2:
   3.459 +assumes "B \<subseteq> f ` A"
   3.460 +shows "|B| \<le>o |A|"
   3.461 +using assms by (metis surj_imp_ordLeq)
   3.462 +
   3.463 +
   3.464 +lemma card_of_singl_ordLeq:
   3.465 +assumes "A \<noteq> {}"
   3.466 +shows "|{b}| \<le>o |A|"
   3.467 +proof-
   3.468 +  obtain a where *: "a \<in> A" using assms by auto
   3.469 +  let ?h = "\<lambda> b'::'b. if b' = b then a else undefined"
   3.470 +  have "inj_on ?h {b} \<and> ?h ` {b} \<le> A"
   3.471 +  using * unfolding inj_on_def by auto
   3.472 +  thus ?thesis using card_of_ordLeq by fast
   3.473 +qed
   3.474 +
   3.475 +
   3.476 +corollary Card_order_singl_ordLeq:
   3.477 +"\<lbrakk>Card_order r; Field r \<noteq> {}\<rbrakk> \<Longrightarrow> |{b}| \<le>o r"
   3.478 +using card_of_singl_ordLeq[of "Field r" b]
   3.479 +      card_of_Field_ordIso[of r] ordLeq_ordIso_trans by blast
   3.480 +
   3.481 +
   3.482 +lemma card_of_Pow: "|A| <o |Pow A|"
   3.483 +using card_of_ordLess2[of "Pow A" A]  Cantors_paradox[of A]
   3.484 +      Pow_not_empty[of A] by auto
   3.485 +
   3.486 +
   3.487 +corollary Card_order_Pow:
   3.488 +"Card_order r \<Longrightarrow> r <o |Pow(Field r)|"
   3.489 +using card_of_Pow card_of_Field_ordIso ordIso_ordLess_trans ordIso_symmetric by blast
   3.490 +
   3.491 +
   3.492 +lemma card_of_Plus1: "|A| \<le>o |A <+> B|"
   3.493 +proof-
   3.494 +  have "Inl ` A \<le> A <+> B" by auto
   3.495 +  thus ?thesis using inj_Inl[of A] card_of_ordLeq by blast
   3.496 +qed
   3.497 +
   3.498 +
   3.499 +corollary Card_order_Plus1:
   3.500 +"Card_order r \<Longrightarrow> r \<le>o |(Field r) <+> B|"
   3.501 +using card_of_Plus1 card_of_Field_ordIso ordIso_ordLeq_trans ordIso_symmetric by blast
   3.502 +
   3.503 +
   3.504 +lemma card_of_Plus2: "|B| \<le>o |A <+> B|"
   3.505 +proof-
   3.506 +  have "Inr ` B \<le> A <+> B" by auto
   3.507 +  thus ?thesis using inj_Inr[of B] card_of_ordLeq by blast
   3.508 +qed
   3.509 +
   3.510 +
   3.511 +corollary Card_order_Plus2:
   3.512 +"Card_order r \<Longrightarrow> r \<le>o |A <+> (Field r)|"
   3.513 +using card_of_Plus2 card_of_Field_ordIso ordIso_ordLeq_trans ordIso_symmetric by blast
   3.514 +
   3.515 +
   3.516 +lemma card_of_Plus_empty1: "|A| =o |A <+> {}|"
   3.517 +proof-
   3.518 +  have "bij_betw Inl A (A <+> {})" unfolding bij_betw_def inj_on_def by auto
   3.519 +  thus ?thesis using card_of_ordIso by auto
   3.520 +qed
   3.521 +
   3.522 +
   3.523 +lemma card_of_Plus_empty2: "|A| =o |{} <+> A|"
   3.524 +proof-
   3.525 +  have "bij_betw Inr A ({} <+> A)" unfolding bij_betw_def inj_on_def by auto
   3.526 +  thus ?thesis using card_of_ordIso by auto
   3.527 +qed
   3.528 +
   3.529 +
   3.530 +lemma card_of_Plus_commute: "|A <+> B| =o |B <+> A|"
   3.531 +proof-
   3.532 +  let ?f = "\<lambda>(c::'a + 'b). case c of Inl a \<Rightarrow> Inr a
   3.533 +                                   | Inr b \<Rightarrow> Inl b"
   3.534 +  have "bij_betw ?f (A <+> B) (B <+> A)"
   3.535 +  unfolding bij_betw_def inj_on_def by force
   3.536 +  thus ?thesis using card_of_ordIso by blast
   3.537 +qed
   3.538 +
   3.539 +
   3.540 +lemma card_of_Plus_assoc:
   3.541 +fixes A :: "'a set" and B :: "'b set" and C :: "'c set"
   3.542 +shows "|(A <+> B) <+> C| =o |A <+> B <+> C|"
   3.543 +proof -
   3.544 +  def f \<equiv> "\<lambda>(k::('a + 'b) + 'c).
   3.545 +  case k of Inl ab \<Rightarrow> (case ab of Inl a \<Rightarrow> Inl a
   3.546 +                                 |Inr b \<Rightarrow> Inr (Inl b))
   3.547 +           |Inr c \<Rightarrow> Inr (Inr c)"
   3.548 +  have "A <+> B <+> C \<subseteq> f ` ((A <+> B) <+> C)"
   3.549 +  proof
   3.550 +    fix x assume x: "x \<in> A <+> B <+> C"
   3.551 +    show "x \<in> f ` ((A <+> B) <+> C)"
   3.552 +    proof(cases x)
   3.553 +      case (Inl a)
   3.554 +      hence "a \<in> A" "x = f (Inl (Inl a))"
   3.555 +      using x unfolding f_def by auto
   3.556 +      thus ?thesis by auto
   3.557 +    next
   3.558 +      case (Inr bc) note 1 = Inr show ?thesis
   3.559 +      proof(cases bc)
   3.560 +        case (Inl b)
   3.561 +        hence "b \<in> B" "x = f (Inl (Inr b))"
   3.562 +        using x 1 unfolding f_def by auto
   3.563 +        thus ?thesis by auto
   3.564 +      next
   3.565 +        case (Inr c)
   3.566 +        hence "c \<in> C" "x = f (Inr c)"
   3.567 +        using x 1 unfolding f_def by auto
   3.568 +        thus ?thesis by auto
   3.569 +      qed
   3.570 +    qed
   3.571 +  qed
   3.572 +  hence "bij_betw f ((A <+> B) <+> C) (A <+> B <+> C)"
   3.573 +  unfolding bij_betw_def inj_on_def f_def by fastforce
   3.574 +  thus ?thesis using card_of_ordIso by blast
   3.575 +qed
   3.576 +
   3.577 +
   3.578 +lemma card_of_Plus_mono1:
   3.579 +assumes "|A| \<le>o |B|"
   3.580 +shows "|A <+> C| \<le>o |B <+> C|"
   3.581 +proof-
   3.582 +  obtain f where 1: "inj_on f A \<and> f ` A \<le> B"
   3.583 +  using assms card_of_ordLeq[of A] by fastforce
   3.584 +  obtain g where g_def:
   3.585 +  "g = (\<lambda>d. case d of Inl a \<Rightarrow> Inl(f a) | Inr (c::'c) \<Rightarrow> Inr c)" by blast
   3.586 +  have "inj_on g (A <+> C) \<and> g ` (A <+> C) \<le> (B <+> C)"
   3.587 +  proof-
   3.588 +    {fix d1 and d2 assume "d1 \<in> A <+> C \<and> d2 \<in> A <+> C" and
   3.589 +                          "g d1 = g d2"
   3.590 +     hence "d1 = d2" using 1 unfolding inj_on_def g_def by force
   3.591 +    }
   3.592 +    moreover
   3.593 +    {fix d assume "d \<in> A <+> C"
   3.594 +     hence "g d \<in> B <+> C"  using 1
   3.595 +     by(case_tac d, auto simp add: g_def)
   3.596 +    }
   3.597 +    ultimately show ?thesis unfolding inj_on_def by auto
   3.598 +  qed
   3.599 +  thus ?thesis using card_of_ordLeq by metis
   3.600 +qed
   3.601 +
   3.602 +
   3.603 +corollary ordLeq_Plus_mono1:
   3.604 +assumes "r \<le>o r'"
   3.605 +shows "|(Field r) <+> C| \<le>o |(Field r') <+> C|"
   3.606 +using assms card_of_mono2 card_of_Plus_mono1 by blast
   3.607 +
   3.608 +
   3.609 +lemma card_of_Plus_mono2:
   3.610 +assumes "|A| \<le>o |B|"
   3.611 +shows "|C <+> A| \<le>o |C <+> B|"
   3.612 +using assms card_of_Plus_mono1[of A B C]
   3.613 +      card_of_Plus_commute[of C A]  card_of_Plus_commute[of B C]
   3.614 +      ordIso_ordLeq_trans[of "|C <+> A|"] ordLeq_ordIso_trans[of "|C <+> A|"]
   3.615 +by blast
   3.616 +
   3.617 +
   3.618 +corollary ordLeq_Plus_mono2:
   3.619 +assumes "r \<le>o r'"
   3.620 +shows "|A <+> (Field r)| \<le>o |A <+> (Field r')|"
   3.621 +using assms card_of_mono2 card_of_Plus_mono2 by blast
   3.622 +
   3.623 +
   3.624 +lemma card_of_Plus_mono:
   3.625 +assumes "|A| \<le>o |B|" and "|C| \<le>o |D|"
   3.626 +shows "|A <+> C| \<le>o |B <+> D|"
   3.627 +using assms card_of_Plus_mono1[of A B C] card_of_Plus_mono2[of C D B]
   3.628 +      ordLeq_transitive[of "|A <+> C|"] by blast
   3.629 +
   3.630 +
   3.631 +corollary ordLeq_Plus_mono:
   3.632 +assumes "r \<le>o r'" and "p \<le>o p'"
   3.633 +shows "|(Field r) <+> (Field p)| \<le>o |(Field r') <+> (Field p')|"
   3.634 +using assms card_of_mono2[of r r'] card_of_mono2[of p p'] card_of_Plus_mono by blast
   3.635 +
   3.636 +
   3.637 +lemma card_of_Plus_cong1:
   3.638 +assumes "|A| =o |B|"
   3.639 +shows "|A <+> C| =o |B <+> C|"
   3.640 +using assms by (simp add: ordIso_iff_ordLeq card_of_Plus_mono1)
   3.641 +
   3.642 +
   3.643 +corollary ordIso_Plus_cong1:
   3.644 +assumes "r =o r'"
   3.645 +shows "|(Field r) <+> C| =o |(Field r') <+> C|"
   3.646 +using assms card_of_cong card_of_Plus_cong1 by blast
   3.647 +
   3.648 +
   3.649 +lemma card_of_Plus_cong2:
   3.650 +assumes "|A| =o |B|"
   3.651 +shows "|C <+> A| =o |C <+> B|"
   3.652 +using assms by (simp add: ordIso_iff_ordLeq card_of_Plus_mono2)
   3.653 +
   3.654 +
   3.655 +corollary ordIso_Plus_cong2:
   3.656 +assumes "r =o r'"
   3.657 +shows "|A <+> (Field r)| =o |A <+> (Field r')|"
   3.658 +using assms card_of_cong card_of_Plus_cong2 by blast
   3.659 +
   3.660 +
   3.661 +lemma card_of_Plus_cong:
   3.662 +assumes "|A| =o |B|" and "|C| =o |D|"
   3.663 +shows "|A <+> C| =o |B <+> D|"
   3.664 +using assms by (simp add: ordIso_iff_ordLeq card_of_Plus_mono)
   3.665 +
   3.666 +
   3.667 +corollary ordIso_Plus_cong:
   3.668 +assumes "r =o r'" and "p =o p'"
   3.669 +shows "|(Field r) <+> (Field p)| =o |(Field r') <+> (Field p')|"
   3.670 +using assms card_of_cong[of r r'] card_of_cong[of p p'] card_of_Plus_cong by blast
   3.671 +
   3.672 +
   3.673 +lemma card_of_Un_Plus_ordLeq:
   3.674 +"|A \<union> B| \<le>o |A <+> B|"
   3.675 +proof-
   3.676 +   let ?f = "\<lambda> c. if c \<in> A then Inl c else Inr c"
   3.677 +   have "inj_on ?f (A \<union> B) \<and> ?f ` (A \<union> B) \<le> A <+> B"
   3.678 +   unfolding inj_on_def by auto
   3.679 +   thus ?thesis using card_of_ordLeq by blast
   3.680 +qed
   3.681 +
   3.682 +
   3.683 +lemma card_of_Times1:
   3.684 +assumes "A \<noteq> {}"
   3.685 +shows "|B| \<le>o |B \<times> A|"
   3.686 +proof(cases "B = {}", simp add: card_of_empty)
   3.687 +  assume *: "B \<noteq> {}"
   3.688 +  have "fst `(B \<times> A) = B" unfolding image_def using assms by auto
   3.689 +  thus ?thesis using inj_on_iff_surj[of B "B \<times> A"]
   3.690 +                     card_of_ordLeq[of B "B \<times> A"] * by blast
   3.691 +qed
   3.692 +
   3.693 +
   3.694 +lemma card_of_Times_commute: "|A \<times> B| =o |B \<times> A|"
   3.695 +proof-
   3.696 +  let ?f = "\<lambda>(a::'a,b::'b). (b,a)"
   3.697 +  have "bij_betw ?f (A \<times> B) (B \<times> A)"
   3.698 +  unfolding bij_betw_def inj_on_def by auto
   3.699 +  thus ?thesis using card_of_ordIso by blast
   3.700 +qed
   3.701 +
   3.702 +
   3.703 +lemma card_of_Times2:
   3.704 +assumes "A \<noteq> {}"   shows "|B| \<le>o |A \<times> B|"
   3.705 +using assms card_of_Times1[of A B] card_of_Times_commute[of B A]
   3.706 +      ordLeq_ordIso_trans by blast
   3.707 +
   3.708 +
   3.709 +corollary Card_order_Times1:
   3.710 +"\<lbrakk>Card_order r; B \<noteq> {}\<rbrakk> \<Longrightarrow> r \<le>o |(Field r) \<times> B|"
   3.711 +using card_of_Times1[of B] card_of_Field_ordIso
   3.712 +      ordIso_ordLeq_trans ordIso_symmetric by blast
   3.713 +
   3.714 +
   3.715 +corollary Card_order_Times2:
   3.716 +"\<lbrakk>Card_order r; A \<noteq> {}\<rbrakk> \<Longrightarrow> r \<le>o |A \<times> (Field r)|"
   3.717 +using card_of_Times2[of A] card_of_Field_ordIso
   3.718 +      ordIso_ordLeq_trans ordIso_symmetric by blast
   3.719 +
   3.720 +
   3.721 +lemma card_of_Times3: "|A| \<le>o |A \<times> A|"
   3.722 +using card_of_Times1[of A]
   3.723 +by(cases "A = {}", simp add: card_of_empty, blast)
   3.724 +
   3.725 +
   3.726 +lemma card_of_Plus_Times_bool: "|A <+> A| =o |A \<times> (UNIV::bool set)|"
   3.727 +proof-
   3.728 +  let ?f = "\<lambda>c::'a + 'a. case c of Inl a \<Rightarrow> (a,True)
   3.729 +                                  |Inr a \<Rightarrow> (a,False)"
   3.730 +  have "bij_betw ?f (A <+> A) (A \<times> (UNIV::bool set))"
   3.731 +  proof-
   3.732 +    {fix  c1 and c2 assume "?f c1 = ?f c2"
   3.733 +     hence "c1 = c2"
   3.734 +     by(case_tac "c1", case_tac "c2", auto, case_tac "c2", auto)
   3.735 +    }
   3.736 +    moreover
   3.737 +    {fix c assume "c \<in> A <+> A"
   3.738 +     hence "?f c \<in> A \<times> (UNIV::bool set)"
   3.739 +     by(case_tac c, auto)
   3.740 +    }
   3.741 +    moreover
   3.742 +    {fix a bl assume *: "(a,bl) \<in> A \<times> (UNIV::bool set)"
   3.743 +     have "(a,bl) \<in> ?f ` ( A <+> A)"
   3.744 +     proof(cases bl)
   3.745 +       assume bl hence "?f(Inl a) = (a,bl)" by auto
   3.746 +       thus ?thesis using * by force
   3.747 +     next
   3.748 +       assume "\<not> bl" hence "?f(Inr a) = (a,bl)" by auto
   3.749 +       thus ?thesis using * by force
   3.750 +     qed
   3.751 +    }
   3.752 +    ultimately show ?thesis unfolding bij_betw_def inj_on_def by auto
   3.753 +  qed
   3.754 +  thus ?thesis using card_of_ordIso by blast
   3.755 +qed
   3.756 +
   3.757 +
   3.758 +lemma card_of_Times_mono1:
   3.759 +assumes "|A| \<le>o |B|"
   3.760 +shows "|A \<times> C| \<le>o |B \<times> C|"
   3.761 +proof-
   3.762 +  obtain f where 1: "inj_on f A \<and> f ` A \<le> B"
   3.763 +  using assms card_of_ordLeq[of A] by fastforce
   3.764 +  obtain g where g_def:
   3.765 +  "g = (\<lambda>(a,c::'c). (f a,c))" by blast
   3.766 +  have "inj_on g (A \<times> C) \<and> g ` (A \<times> C) \<le> (B \<times> C)"
   3.767 +  using 1 unfolding inj_on_def using g_def by auto
   3.768 +  thus ?thesis using card_of_ordLeq by metis
   3.769 +qed
   3.770 +
   3.771 +
   3.772 +corollary ordLeq_Times_mono1:
   3.773 +assumes "r \<le>o r'"
   3.774 +shows "|(Field r) \<times> C| \<le>o |(Field r') \<times> C|"
   3.775 +using assms card_of_mono2 card_of_Times_mono1 by blast
   3.776 +
   3.777 +
   3.778 +lemma card_of_Times_mono2:
   3.779 +assumes "|A| \<le>o |B|"
   3.780 +shows "|C \<times> A| \<le>o |C \<times> B|"
   3.781 +using assms card_of_Times_mono1[of A B C]
   3.782 +      card_of_Times_commute[of C A]  card_of_Times_commute[of B C]
   3.783 +      ordIso_ordLeq_trans[of "|C \<times> A|"] ordLeq_ordIso_trans[of "|C \<times> A|"]
   3.784 +by blast
   3.785 +
   3.786 +
   3.787 +corollary ordLeq_Times_mono2:
   3.788 +assumes "r \<le>o r'"
   3.789 +shows "|A \<times> (Field r)| \<le>o |A \<times> (Field r')|"
   3.790 +using assms card_of_mono2 card_of_Times_mono2 by blast
   3.791 +
   3.792 +
   3.793 +lemma card_of_Sigma_mono1:
   3.794 +assumes "\<forall>i \<in> I. |A i| \<le>o |B i|"
   3.795 +shows "|SIGMA i : I. A i| \<le>o |SIGMA i : I. B i|"
   3.796 +proof-
   3.797 +  have "\<forall>i. i \<in> I \<longrightarrow> (\<exists>f. inj_on f (A i) \<and> f ` (A i) \<le> B i)"
   3.798 +  using assms by (auto simp add: card_of_ordLeq)
   3.799 +  with choice[of "\<lambda> i f. i \<in> I \<longrightarrow> inj_on f (A i) \<and> f ` (A i) \<le> B i"]
   3.800 +  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.801 +  obtain g where g_def: "g = (\<lambda>(i,a::'b). (i,F i a))" by blast
   3.802 +  have "inj_on g (Sigma I A) \<and> g ` (Sigma I A) \<le> (Sigma I B)"
   3.803 +  using 1 unfolding inj_on_def using g_def by force
   3.804 +  thus ?thesis using card_of_ordLeq by metis
   3.805 +qed
   3.806 +
   3.807 +
   3.808 +corollary card_of_Sigma_Times:
   3.809 +"\<forall>i \<in> I. |A i| \<le>o |B| \<Longrightarrow> |SIGMA i : I. A i| \<le>o |I \<times> B|"
   3.810 +using card_of_Sigma_mono1[of I A "\<lambda>i. B"] .
   3.811 +
   3.812 +
   3.813 +lemma card_of_UNION_Sigma:
   3.814 +"|\<Union>i \<in> I. A i| \<le>o |SIGMA i : I. A i|"
   3.815 +using Ex_inj_on_UNION_Sigma[of I A] card_of_ordLeq by metis
   3.816 +
   3.817 +
   3.818 +lemma card_of_bool:
   3.819 +assumes "a1 \<noteq> a2"
   3.820 +shows "|UNIV::bool set| =o |{a1,a2}|"
   3.821 +proof-
   3.822 +  let ?f = "\<lambda> bl. case bl of True \<Rightarrow> a1 | False \<Rightarrow> a2"
   3.823 +  have "bij_betw ?f UNIV {a1,a2}"
   3.824 +  proof-
   3.825 +    {fix bl1 and bl2 assume "?f  bl1 = ?f bl2"
   3.826 +     hence "bl1 = bl2" using assms by (case_tac bl1, case_tac bl2, auto)
   3.827 +    }
   3.828 +    moreover
   3.829 +    {fix bl have "?f bl \<in> {a1,a2}" by (case_tac bl, auto)
   3.830 +    }
   3.831 +    moreover
   3.832 +    {fix a assume *: "a \<in> {a1,a2}"
   3.833 +     have "a \<in> ?f ` UNIV"
   3.834 +     proof(cases "a = a1")
   3.835 +       assume "a = a1"
   3.836 +       hence "?f True = a" by auto  thus ?thesis by blast
   3.837 +     next
   3.838 +       assume "a \<noteq> a1" hence "a = a2" using * by auto
   3.839 +       hence "?f False = a" by auto  thus ?thesis by blast
   3.840 +     qed
   3.841 +    }
   3.842 +    ultimately show ?thesis unfolding bij_betw_def inj_on_def
   3.843 +    by (metis image_subsetI order_eq_iff subsetI)
   3.844 +  qed
   3.845 +  thus ?thesis using card_of_ordIso by blast
   3.846 +qed
   3.847 +
   3.848 +
   3.849 +lemma card_of_Plus_Times_aux:
   3.850 +assumes A2: "a1 \<noteq> a2 \<and> {a1,a2} \<le> A" and
   3.851 +        LEQ: "|A| \<le>o |B|"
   3.852 +shows "|A <+> B| \<le>o |A \<times> B|"
   3.853 +proof-
   3.854 +  have 1: "|UNIV::bool set| \<le>o |A|"
   3.855 +  using A2 card_of_mono1[of "{a1,a2}"] card_of_bool[of a1 a2]
   3.856 +        ordIso_ordLeq_trans[of "|UNIV::bool set|"] by metis
   3.857 +  (*  *)
   3.858 +  have "|A <+> B| \<le>o |B <+> B|"
   3.859 +  using LEQ card_of_Plus_mono1 by blast
   3.860 +  moreover have "|B <+> B| =o |B \<times> (UNIV::bool set)|"
   3.861 +  using card_of_Plus_Times_bool by blast
   3.862 +  moreover have "|B \<times> (UNIV::bool set)| \<le>o |B \<times> A|"
   3.863 +  using 1 by (simp add: card_of_Times_mono2)
   3.864 +  moreover have " |B \<times> A| =o |A \<times> B|"
   3.865 +  using card_of_Times_commute by blast
   3.866 +  ultimately show "|A <+> B| \<le>o |A \<times> B|"
   3.867 +  using ordLeq_ordIso_trans[of "|A <+> B|" "|B <+> B|" "|B \<times> (UNIV::bool set)|"]
   3.868 +        ordLeq_transitive[of "|A <+> B|" "|B \<times> (UNIV::bool set)|" "|B \<times> A|"]
   3.869 +        ordLeq_ordIso_trans[of "|A <+> B|" "|B \<times> A|" "|A \<times> B|"]
   3.870 +  by blast
   3.871 +qed
   3.872 +
   3.873 +
   3.874 +lemma card_of_Plus_Times:
   3.875 +assumes A2: "a1 \<noteq> a2 \<and> {a1,a2} \<le> A" and
   3.876 +        B2: "b1 \<noteq> b2 \<and> {b1,b2} \<le> B"
   3.877 +shows "|A <+> B| \<le>o |A \<times> B|"
   3.878 +proof-
   3.879 +  {assume "|A| \<le>o |B|"
   3.880 +   hence ?thesis using assms by (auto simp add: card_of_Plus_Times_aux)
   3.881 +  }
   3.882 +  moreover
   3.883 +  {assume "|B| \<le>o |A|"
   3.884 +   hence "|B <+> A| \<le>o |B \<times> A|"
   3.885 +   using assms by (auto simp add: card_of_Plus_Times_aux)
   3.886 +   hence ?thesis
   3.887 +   using card_of_Plus_commute card_of_Times_commute
   3.888 +         ordIso_ordLeq_trans ordLeq_ordIso_trans by metis
   3.889 +  }
   3.890 +  ultimately show ?thesis
   3.891 +  using card_of_Well_order[of A] card_of_Well_order[of B]
   3.892 +        ordLeq_total[of "|A|"] by metis
   3.893 +qed
   3.894 +
   3.895 +
   3.896 +lemma card_of_ordLeq_finite:
   3.897 +assumes "|A| \<le>o |B|" and "finite B"
   3.898 +shows "finite A"
   3.899 +using assms unfolding ordLeq_def
   3.900 +using embed_inj_on[of "|A|" "|B|"]  embed_Field[of "|A|" "|B|"]
   3.901 +      Field_card_of[of "A"] Field_card_of[of "B"] inj_on_finite[of _ "A" "B"] by fastforce
   3.902 +
   3.903 +
   3.904 +lemma card_of_ordLeq_infinite:
   3.905 +assumes "|A| \<le>o |B|" and "\<not> finite A"
   3.906 +shows "\<not> finite B"
   3.907 +using assms card_of_ordLeq_finite by auto
   3.908 +
   3.909 +
   3.910 +lemma card_of_ordIso_finite:
   3.911 +assumes "|A| =o |B|"
   3.912 +shows "finite A = finite B"
   3.913 +using assms unfolding ordIso_def iso_def[abs_def]
   3.914 +by (auto simp: bij_betw_finite Field_card_of)
   3.915 +
   3.916 +
   3.917 +lemma card_of_ordIso_finite_Field:
   3.918 +assumes "Card_order r" and "r =o |A|"
   3.919 +shows "finite(Field r) = finite A"
   3.920 +using assms card_of_Field_ordIso card_of_ordIso_finite ordIso_equivalence by blast
   3.921 +
   3.922 +
   3.923 +subsection {* Cardinals versus set operations involving infinite sets *}
   3.924 +
   3.925 +
   3.926 +text{* Here we show that, for infinite sets, most set-theoretic constructions
   3.927 +do not increase the cardinality.  The cornerstone for this is
   3.928 +theorem @{text "Card_order_Times_same_infinite"}, which states that self-product
   3.929 +does not increase cardinality -- the proof of this fact adapts a standard
   3.930 +set-theoretic argument, as presented, e.g., in the proof of theorem 1.5.11
   3.931 +at page 47 in \cite{card-book}. Then everything else follows fairly easily.  *}
   3.932 +
   3.933 +
   3.934 +lemma infinite_iff_card_of_nat:
   3.935 +"\<not> finite A \<longleftrightarrow> ( |UNIV::nat set| \<le>o |A| )"
   3.936 +unfolding infinite_iff_countable_subset card_of_ordLeq ..
   3.937 +
   3.938 +text{* The next two results correspond to the ZF fact that all infinite cardinals are
   3.939 +limit ordinals: *}
   3.940 +
   3.941 +lemma Card_order_infinite_not_under:
   3.942 +assumes CARD: "Card_order r" and INF: "\<not>finite (Field r)"
   3.943 +shows "\<not> (\<exists>a. Field r = under r a)"
   3.944 +proof(auto)
   3.945 +  have 0: "Well_order r \<and> wo_rel r \<and> Refl r"
   3.946 +  using CARD unfolding wo_rel_def card_order_on_def order_on_defs by auto
   3.947 +  fix a assume *: "Field r = under r a"
   3.948 +  show False
   3.949 +  proof(cases "a \<in> Field r")
   3.950 +    assume Case1: "a \<notin> Field r"
   3.951 +    hence "under r a = {}" unfolding Field_def under_def by auto
   3.952 +    thus False using INF *  by auto
   3.953 +  next
   3.954 +    let ?r' = "Restr r (underS r a)"
   3.955 +    assume Case2: "a \<in> Field r"
   3.956 +    hence 1: "under r a = underS r a \<union> {a} \<and> a \<notin> underS r a"
   3.957 +    using 0 Refl_under_underS underS_notIn by metis
   3.958 +    have 2: "wo_rel.ofilter r (underS r a) \<and> underS r a < Field r"
   3.959 +    using 0 wo_rel.underS_ofilter * 1 Case2 by fast
   3.960 +    hence "?r' <o r" using 0 using ofilter_ordLess by blast
   3.961 +    moreover
   3.962 +    have "Field ?r' = underS r a \<and> Well_order ?r'"
   3.963 +    using  2 0 Field_Restr_ofilter[of r] Well_order_Restr[of r] by blast
   3.964 +    ultimately have "|underS r a| <o r" using ordLess_Field[of ?r'] by auto
   3.965 +    moreover have "|under r a| =o r" using * CARD card_of_Field_ordIso[of r] by auto
   3.966 +    ultimately have "|underS r a| <o |under r a|"
   3.967 +    using ordIso_symmetric ordLess_ordIso_trans by blast
   3.968 +    moreover
   3.969 +    {have "\<exists>f. bij_betw f (under r a) (underS r a)"
   3.970 +     using infinite_imp_bij_betw[of "Field r" a] INF * 1 by auto
   3.971 +     hence "|under r a| =o |underS r a|" using card_of_ordIso by blast
   3.972 +    }
   3.973 +    ultimately show False using not_ordLess_ordIso ordIso_symmetric by blast
   3.974 +  qed
   3.975 +qed
   3.976 +
   3.977 +
   3.978 +lemma infinite_Card_order_limit:
   3.979 +assumes r: "Card_order r" and "\<not>finite (Field r)"
   3.980 +and a: "a : Field r"
   3.981 +shows "EX b : Field r. a \<noteq> b \<and> (a,b) : r"
   3.982 +proof-
   3.983 +  have "Field r \<noteq> under r a"
   3.984 +  using assms Card_order_infinite_not_under by blast
   3.985 +  moreover have "under r a \<le> Field r"
   3.986 +  using under_Field .
   3.987 +  ultimately have "under r a < Field r" by blast
   3.988 +  then obtain b where 1: "b : Field r \<and> ~ (b,a) : r"
   3.989 +  unfolding under_def by blast
   3.990 +  moreover have ba: "b \<noteq> a"
   3.991 +  using 1 r unfolding card_order_on_def well_order_on_def
   3.992 +  linear_order_on_def partial_order_on_def preorder_on_def refl_on_def by auto
   3.993 +  ultimately have "(a,b) : r"
   3.994 +  using a r unfolding card_order_on_def well_order_on_def linear_order_on_def
   3.995 +  total_on_def by blast
   3.996 +  thus ?thesis using 1 ba by auto
   3.997 +qed
   3.998 +
   3.999 +
  3.1000 +theorem Card_order_Times_same_infinite:
  3.1001 +assumes CO: "Card_order r" and INF: "\<not>finite(Field r)"
  3.1002 +shows "|Field r \<times> Field r| \<le>o r"
  3.1003 +proof-
  3.1004 +  obtain phi where phi_def:
  3.1005 +  "phi = (\<lambda>r::'a rel. Card_order r \<and> \<not>finite(Field r) \<and>
  3.1006 +                      \<not> |Field r \<times> Field r| \<le>o r )" by blast
  3.1007 +  have temp1: "\<forall>r. phi r \<longrightarrow> Well_order r"
  3.1008 +  unfolding phi_def card_order_on_def by auto
  3.1009 +  have Ft: "\<not>(\<exists>r. phi r)"
  3.1010 +  proof
  3.1011 +    assume "\<exists>r. phi r"
  3.1012 +    hence "{r. phi r} \<noteq> {} \<and> {r. phi r} \<le> {r. Well_order r}"
  3.1013 +    using temp1 by auto
  3.1014 +    then obtain r where 1: "phi r" and 2: "\<forall>r'. phi r' \<longrightarrow> r \<le>o r'" and
  3.1015 +                   3: "Card_order r \<and> Well_order r"
  3.1016 +    using exists_minim_Well_order[of "{r. phi r}"] temp1 phi_def by blast
  3.1017 +    let ?A = "Field r"  let ?r' = "bsqr r"
  3.1018 +    have 4: "Well_order ?r' \<and> Field ?r' = ?A \<times> ?A \<and> |?A| =o r"
  3.1019 +    using 3 bsqr_Well_order Field_bsqr card_of_Field_ordIso by blast
  3.1020 +    have 5: "Card_order |?A \<times> ?A| \<and> Well_order |?A \<times> ?A|"
  3.1021 +    using card_of_Card_order card_of_Well_order by blast
  3.1022 +    (*  *)
  3.1023 +    have "r <o |?A \<times> ?A|"
  3.1024 +    using 1 3 5 ordLess_or_ordLeq unfolding phi_def by blast
  3.1025 +    moreover have "|?A \<times> ?A| \<le>o ?r'"
  3.1026 +    using card_of_least[of "?A \<times> ?A"] 4 by auto
  3.1027 +    ultimately have "r <o ?r'" using ordLess_ordLeq_trans by auto
  3.1028 +    then obtain f where 6: "embed r ?r' f" and 7: "\<not> bij_betw f ?A (?A \<times> ?A)"
  3.1029 +    unfolding ordLess_def embedS_def[abs_def]
  3.1030 +    by (auto simp add: Field_bsqr)
  3.1031 +    let ?B = "f ` ?A"
  3.1032 +    have "|?A| =o |?B|"
  3.1033 +    using 3 6 embed_inj_on inj_on_imp_bij_betw card_of_ordIso by blast
  3.1034 +    hence 8: "r =o |?B|" using 4 ordIso_transitive ordIso_symmetric by blast
  3.1035 +    (*  *)
  3.1036 +    have "wo_rel.ofilter ?r' ?B"
  3.1037 +    using 6 embed_Field_ofilter 3 4 by blast
  3.1038 +    hence "wo_rel.ofilter ?r' ?B \<and> ?B \<noteq> ?A \<times> ?A \<and> ?B \<noteq> Field ?r'"
  3.1039 +    using 7 unfolding bij_betw_def using 6 3 embed_inj_on 4 by auto
  3.1040 +    hence temp2: "wo_rel.ofilter ?r' ?B \<and> ?B < ?A \<times> ?A"
  3.1041 +    using 4 wo_rel_def[of ?r'] wo_rel.ofilter_def[of ?r' ?B] by blast
  3.1042 +    have "\<not> (\<exists>a. Field r = under r a)"
  3.1043 +    using 1 unfolding phi_def using Card_order_infinite_not_under[of r] by auto
  3.1044 +    then obtain A1 where temp3: "wo_rel.ofilter r A1 \<and> A1 < ?A" and 9: "?B \<le> A1 \<times> A1"
  3.1045 +    using temp2 3 bsqr_ofilter[of r ?B] by blast
  3.1046 +    hence "|?B| \<le>o |A1 \<times> A1|" using card_of_mono1 by blast
  3.1047 +    hence 10: "r \<le>o |A1 \<times> A1|" using 8 ordIso_ordLeq_trans by blast
  3.1048 +    let ?r1 = "Restr r A1"
  3.1049 +    have "?r1 <o r" using temp3 ofilter_ordLess 3 by blast
  3.1050 +    moreover
  3.1051 +    {have "well_order_on A1 ?r1" using 3 temp3 well_order_on_Restr by blast
  3.1052 +     hence "|A1| \<le>o ?r1" using 3 Well_order_Restr card_of_least by blast
  3.1053 +    }
  3.1054 +    ultimately have 11: "|A1| <o r" using ordLeq_ordLess_trans by blast
  3.1055 +    (*  *)
  3.1056 +    have "\<not> finite (Field r)" using 1 unfolding phi_def by simp
  3.1057 +    hence "\<not> finite ?B" using 8 3 card_of_ordIso_finite_Field[of r ?B] by blast
  3.1058 +    hence "\<not> finite A1" using 9 finite_cartesian_product finite_subset by metis
  3.1059 +    moreover have temp4: "Field |A1| = A1 \<and> Well_order |A1| \<and> Card_order |A1|"
  3.1060 +    using card_of_Card_order[of A1] card_of_Well_order[of A1]
  3.1061 +    by (simp add: Field_card_of)
  3.1062 +    moreover have "\<not> r \<le>o | A1 |"
  3.1063 +    using temp4 11 3 using not_ordLeq_iff_ordLess by blast
  3.1064 +    ultimately have "\<not> finite(Field |A1| ) \<and> Card_order |A1| \<and> \<not> r \<le>o | A1 |"
  3.1065 +    by (simp add: card_of_card_order_on)
  3.1066 +    hence "|Field |A1| \<times> Field |A1| | \<le>o |A1|"
  3.1067 +    using 2 unfolding phi_def by blast
  3.1068 +    hence "|A1 \<times> A1 | \<le>o |A1|" using temp4 by auto
  3.1069 +    hence "r \<le>o |A1|" using 10 ordLeq_transitive by blast
  3.1070 +    thus False using 11 not_ordLess_ordLeq by auto
  3.1071 +  qed
  3.1072 +  thus ?thesis using assms unfolding phi_def by blast
  3.1073 +qed
  3.1074 +
  3.1075 +
  3.1076 +corollary card_of_Times_same_infinite:
  3.1077 +assumes "\<not>finite A"
  3.1078 +shows "|A \<times> A| =o |A|"
  3.1079 +proof-
  3.1080 +  let ?r = "|A|"
  3.1081 +  have "Field ?r = A \<and> Card_order ?r"
  3.1082 +  using Field_card_of card_of_Card_order[of A] by fastforce
  3.1083 +  hence "|A \<times> A| \<le>o |A|"
  3.1084 +  using Card_order_Times_same_infinite[of ?r] assms by auto
  3.1085 +  thus ?thesis using card_of_Times3 ordIso_iff_ordLeq by blast
  3.1086 +qed
  3.1087 +
  3.1088 +
  3.1089 +lemma card_of_Times_infinite:
  3.1090 +assumes INF: "\<not>finite A" and NE: "B \<noteq> {}" and LEQ: "|B| \<le>o |A|"
  3.1091 +shows "|A \<times> B| =o |A| \<and> |B \<times> A| =o |A|"
  3.1092 +proof-
  3.1093 +  have "|A| \<le>o |A \<times> B| \<and> |A| \<le>o |B \<times> A|"
  3.1094 +  using assms by (simp add: card_of_Times1 card_of_Times2)
  3.1095 +  moreover
  3.1096 +  {have "|A \<times> B| \<le>o |A \<times> A| \<and> |B \<times> A| \<le>o |A \<times> A|"
  3.1097 +   using LEQ card_of_Times_mono1 card_of_Times_mono2 by blast
  3.1098 +   moreover have "|A \<times> A| =o |A|" using INF card_of_Times_same_infinite by blast
  3.1099 +   ultimately have "|A \<times> B| \<le>o |A| \<and> |B \<times> A| \<le>o |A|"
  3.1100 +   using ordLeq_ordIso_trans[of "|A \<times> B|"] ordLeq_ordIso_trans[of "|B \<times> A|"] by auto
  3.1101 +  }
  3.1102 +  ultimately show ?thesis by (simp add: ordIso_iff_ordLeq)
  3.1103 +qed
  3.1104 +
  3.1105 +
  3.1106 +corollary Card_order_Times_infinite:
  3.1107 +assumes INF: "\<not>finite(Field r)" and CARD: "Card_order r" and
  3.1108 +        NE: "Field p \<noteq> {}" and LEQ: "p \<le>o r"
  3.1109 +shows "| (Field r) \<times> (Field p) | =o r \<and> | (Field p) \<times> (Field r) | =o r"
  3.1110 +proof-
  3.1111 +  have "|Field r \<times> Field p| =o |Field r| \<and> |Field p \<times> Field r| =o |Field r|"
  3.1112 +  using assms by (simp add: card_of_Times_infinite card_of_mono2)
  3.1113 +  thus ?thesis
  3.1114 +  using assms card_of_Field_ordIso[of r]
  3.1115 +        ordIso_transitive[of "|Field r \<times> Field p|"]
  3.1116 +        ordIso_transitive[of _ "|Field r|"] by blast
  3.1117 +qed
  3.1118 +
  3.1119 +
  3.1120 +lemma card_of_Sigma_ordLeq_infinite:
  3.1121 +assumes INF: "\<not>finite B" and
  3.1122 +        LEQ_I: "|I| \<le>o |B|" and LEQ: "\<forall>i \<in> I. |A i| \<le>o |B|"
  3.1123 +shows "|SIGMA i : I. A i| \<le>o |B|"
  3.1124 +proof(cases "I = {}", simp add: card_of_empty)
  3.1125 +  assume *: "I \<noteq> {}"
  3.1126 +  have "|SIGMA i : I. A i| \<le>o |I \<times> B|"
  3.1127 +  using LEQ card_of_Sigma_Times by blast
  3.1128 +  moreover have "|I \<times> B| =o |B|"
  3.1129 +  using INF * LEQ_I by (auto simp add: card_of_Times_infinite)
  3.1130 +  ultimately show ?thesis using ordLeq_ordIso_trans by blast
  3.1131 +qed
  3.1132 +
  3.1133 +
  3.1134 +lemma card_of_Sigma_ordLeq_infinite_Field:
  3.1135 +assumes INF: "\<not>finite (Field r)" and r: "Card_order r" and
  3.1136 +        LEQ_I: "|I| \<le>o r" and LEQ: "\<forall>i \<in> I. |A i| \<le>o r"
  3.1137 +shows "|SIGMA i : I. A i| \<le>o r"
  3.1138 +proof-
  3.1139 +  let ?B  = "Field r"
  3.1140 +  have 1: "r =o |?B| \<and> |?B| =o r" using r card_of_Field_ordIso
  3.1141 +  ordIso_symmetric by blast
  3.1142 +  hence "|I| \<le>o |?B|"  "\<forall>i \<in> I. |A i| \<le>o |?B|"
  3.1143 +  using LEQ_I LEQ ordLeq_ordIso_trans by blast+
  3.1144 +  hence  "|SIGMA i : I. A i| \<le>o |?B|" using INF LEQ
  3.1145 +  card_of_Sigma_ordLeq_infinite by blast
  3.1146 +  thus ?thesis using 1 ordLeq_ordIso_trans by blast
  3.1147 +qed
  3.1148 +
  3.1149 +
  3.1150 +lemma card_of_Times_ordLeq_infinite_Field:
  3.1151 +"\<lbrakk>\<not>finite (Field r); |A| \<le>o r; |B| \<le>o r; Card_order r\<rbrakk>
  3.1152 + \<Longrightarrow> |A <*> B| \<le>o r"
  3.1153 +by(simp add: card_of_Sigma_ordLeq_infinite_Field)
  3.1154 +
  3.1155 +
  3.1156 +lemma card_of_Times_infinite_simps:
  3.1157 +"\<lbrakk>\<not>finite A; B \<noteq> {}; |B| \<le>o |A|\<rbrakk> \<Longrightarrow> |A \<times> B| =o |A|"
  3.1158 +"\<lbrakk>\<not>finite A; B \<noteq> {}; |B| \<le>o |A|\<rbrakk> \<Longrightarrow> |A| =o |A \<times> B|"
  3.1159 +"\<lbrakk>\<not>finite A; B \<noteq> {}; |B| \<le>o |A|\<rbrakk> \<Longrightarrow> |B \<times> A| =o |A|"
  3.1160 +"\<lbrakk>\<not>finite A; B \<noteq> {}; |B| \<le>o |A|\<rbrakk> \<Longrightarrow> |A| =o |B \<times> A|"
  3.1161 +by (auto simp add: card_of_Times_infinite ordIso_symmetric)
  3.1162 +
  3.1163 +
  3.1164 +lemma card_of_UNION_ordLeq_infinite:
  3.1165 +assumes INF: "\<not>finite B" and
  3.1166 +        LEQ_I: "|I| \<le>o |B|" and LEQ: "\<forall>i \<in> I. |A i| \<le>o |B|"
  3.1167 +shows "|\<Union> i \<in> I. A i| \<le>o |B|"
  3.1168 +proof(cases "I = {}", simp add: card_of_empty)
  3.1169 +  assume *: "I \<noteq> {}"
  3.1170 +  have "|\<Union> i \<in> I. A i| \<le>o |SIGMA i : I. A i|"
  3.1171 +  using card_of_UNION_Sigma by blast
  3.1172 +  moreover have "|SIGMA i : I. A i| \<le>o |B|"
  3.1173 +  using assms card_of_Sigma_ordLeq_infinite by blast
  3.1174 +  ultimately show ?thesis using ordLeq_transitive by blast
  3.1175 +qed
  3.1176 +
  3.1177 +
  3.1178 +corollary card_of_UNION_ordLeq_infinite_Field:
  3.1179 +assumes INF: "\<not>finite (Field r)" and r: "Card_order r" and
  3.1180 +        LEQ_I: "|I| \<le>o r" and LEQ: "\<forall>i \<in> I. |A i| \<le>o r"
  3.1181 +shows "|\<Union> i \<in> I. A i| \<le>o r"
  3.1182 +proof-
  3.1183 +  let ?B  = "Field r"
  3.1184 +  have 1: "r =o |?B| \<and> |?B| =o r" using r card_of_Field_ordIso
  3.1185 +  ordIso_symmetric by blast
  3.1186 +  hence "|I| \<le>o |?B|"  "\<forall>i \<in> I. |A i| \<le>o |?B|"
  3.1187 +  using LEQ_I LEQ ordLeq_ordIso_trans by blast+
  3.1188 +  hence  "|\<Union> i \<in> I. A i| \<le>o |?B|" using INF LEQ
  3.1189 +  card_of_UNION_ordLeq_infinite by blast
  3.1190 +  thus ?thesis using 1 ordLeq_ordIso_trans by blast
  3.1191 +qed
  3.1192 +
  3.1193 +
  3.1194 +lemma card_of_Plus_infinite1:
  3.1195 +assumes INF: "\<not>finite A" and LEQ: "|B| \<le>o |A|"
  3.1196 +shows "|A <+> B| =o |A|"
  3.1197 +proof(cases "B = {}", simp add: card_of_Plus_empty1 card_of_Plus_empty2 ordIso_symmetric)
  3.1198 +  let ?Inl = "Inl::'a \<Rightarrow> 'a + 'b"  let ?Inr = "Inr::'b \<Rightarrow> 'a + 'b"
  3.1199 +  assume *: "B \<noteq> {}"
  3.1200 +  then obtain b1 where 1: "b1 \<in> B" by blast
  3.1201 +  show ?thesis
  3.1202 +  proof(cases "B = {b1}")
  3.1203 +    assume Case1: "B = {b1}"
  3.1204 +    have 2: "bij_betw ?Inl A ((?Inl ` A))"
  3.1205 +    unfolding bij_betw_def inj_on_def by auto
  3.1206 +    hence 3: "\<not>finite (?Inl ` A)"
  3.1207 +    using INF bij_betw_finite[of ?Inl A] by blast
  3.1208 +    let ?A' = "?Inl ` A \<union> {?Inr b1}"
  3.1209 +    obtain g where "bij_betw g (?Inl ` A) ?A'"
  3.1210 +    using 3 infinite_imp_bij_betw2[of "?Inl ` A"] by auto
  3.1211 +    moreover have "?A' = A <+> B" using Case1 by blast
  3.1212 +    ultimately have "bij_betw g (?Inl ` A) (A <+> B)" by simp
  3.1213 +    hence "bij_betw (g o ?Inl) A (A <+> B)"
  3.1214 +    using 2 by (auto simp add: bij_betw_trans)
  3.1215 +    thus ?thesis using card_of_ordIso ordIso_symmetric by blast
  3.1216 +  next
  3.1217 +    assume Case2: "B \<noteq> {b1}"
  3.1218 +    with * 1 obtain b2 where 3: "b1 \<noteq> b2 \<and> {b1,b2} \<le> B" by fastforce
  3.1219 +    obtain f where "inj_on f B \<and> f ` B \<le> A"
  3.1220 +    using LEQ card_of_ordLeq[of B] by fastforce
  3.1221 +    with 3 have "f b1 \<noteq> f b2 \<and> {f b1, f b2} \<le> A"
  3.1222 +    unfolding inj_on_def by auto
  3.1223 +    with 3 have "|A <+> B| \<le>o |A \<times> B|"
  3.1224 +    by (auto simp add: card_of_Plus_Times)
  3.1225 +    moreover have "|A \<times> B| =o |A|"
  3.1226 +    using assms * by (simp add: card_of_Times_infinite_simps)
  3.1227 +    ultimately have "|A <+> B| \<le>o |A|" using ordLeq_ordIso_trans by metis
  3.1228 +    thus ?thesis using card_of_Plus1 ordIso_iff_ordLeq by blast
  3.1229 +  qed
  3.1230 +qed
  3.1231 +
  3.1232 +
  3.1233 +lemma card_of_Plus_infinite2:
  3.1234 +assumes INF: "\<not>finite A" and LEQ: "|B| \<le>o |A|"
  3.1235 +shows "|B <+> A| =o |A|"
  3.1236 +using assms card_of_Plus_commute card_of_Plus_infinite1
  3.1237 +ordIso_equivalence by blast
  3.1238 +
  3.1239 +
  3.1240 +lemma card_of_Plus_infinite:
  3.1241 +assumes INF: "\<not>finite A" and LEQ: "|B| \<le>o |A|"
  3.1242 +shows "|A <+> B| =o |A| \<and> |B <+> A| =o |A|"
  3.1243 +using assms by (auto simp: card_of_Plus_infinite1 card_of_Plus_infinite2)
  3.1244 +
  3.1245 +
  3.1246 +corollary Card_order_Plus_infinite:
  3.1247 +assumes INF: "\<not>finite(Field r)" and CARD: "Card_order r" and
  3.1248 +        LEQ: "p \<le>o r"
  3.1249 +shows "| (Field r) <+> (Field p) | =o r \<and> | (Field p) <+> (Field r) | =o r"
  3.1250 +proof-
  3.1251 +  have "| Field r <+> Field p | =o | Field r | \<and>
  3.1252 +        | Field p <+> Field r | =o | Field r |"
  3.1253 +  using assms by (simp add: card_of_Plus_infinite card_of_mono2)
  3.1254 +  thus ?thesis
  3.1255 +  using assms card_of_Field_ordIso[of r]
  3.1256 +        ordIso_transitive[of "|Field r <+> Field p|"]
  3.1257 +        ordIso_transitive[of _ "|Field r|"] by blast
  3.1258 +qed
  3.1259 +
  3.1260 +
  3.1261 +subsection {* The cardinal $\omega$ and the finite cardinals  *}
  3.1262 +
  3.1263 +
  3.1264 +text{* The cardinal $\omega$, of natural numbers, shall be the standard non-strict
  3.1265 +order relation on
  3.1266 +@{text "nat"}, that we abbreviate by @{text "natLeq"}.  The finite cardinals
  3.1267 +shall be the restrictions of these relations to the numbers smaller than
  3.1268 +fixed numbers @{text "n"}, that we abbreviate by @{text "natLeq_on n"}.  *}
  3.1269 +
  3.1270 +abbreviation "(natLeq::(nat * nat) set) \<equiv> {(x,y). x \<le> y}"
  3.1271 +abbreviation "(natLess::(nat * nat) set) \<equiv> {(x,y). x < y}"
  3.1272 +
  3.1273 +abbreviation natLeq_on :: "nat \<Rightarrow> (nat * nat) set"
  3.1274 +where "natLeq_on n \<equiv> {(x,y). x < n \<and> y < n \<and> x \<le> y}"
  3.1275 +
  3.1276 +lemma infinite_cartesian_product:
  3.1277 +assumes "\<not>finite A" "\<not>finite B"
  3.1278 +shows "\<not>finite (A \<times> B)"
  3.1279 +proof
  3.1280 +  assume "finite (A \<times> B)"
  3.1281 +  from assms(1) have "A \<noteq> {}" by auto
  3.1282 +  with `finite (A \<times> B)` have "finite B" using finite_cartesian_productD2 by auto
  3.1283 +  with assms(2) show False by simp
  3.1284 +qed
  3.1285 +
  3.1286 +
  3.1287 +subsubsection {* First as well-orders *}
  3.1288 +
  3.1289 +
  3.1290 +lemma Field_natLeq: "Field natLeq = (UNIV::nat set)"
  3.1291 +by(unfold Field_def, auto)
  3.1292 +
  3.1293 +
  3.1294 +lemma natLeq_Refl: "Refl natLeq"
  3.1295 +unfolding refl_on_def Field_def by auto
  3.1296 +
  3.1297 +
  3.1298 +lemma natLeq_trans: "trans natLeq"
  3.1299 +unfolding trans_def by auto
  3.1300 +
  3.1301 +
  3.1302 +lemma natLeq_Preorder: "Preorder natLeq"
  3.1303 +unfolding preorder_on_def
  3.1304 +by (auto simp add: natLeq_Refl natLeq_trans)
  3.1305 +
  3.1306 +
  3.1307 +lemma natLeq_antisym: "antisym natLeq"
  3.1308 +unfolding antisym_def by auto
  3.1309 +
  3.1310 +
  3.1311 +lemma natLeq_Partial_order: "Partial_order natLeq"
  3.1312 +unfolding partial_order_on_def
  3.1313 +by (auto simp add: natLeq_Preorder natLeq_antisym)
  3.1314 +
  3.1315 +
  3.1316 +lemma natLeq_Total: "Total natLeq"
  3.1317 +unfolding total_on_def by auto
  3.1318 +
  3.1319 +
  3.1320 +lemma natLeq_Linear_order: "Linear_order natLeq"
  3.1321 +unfolding linear_order_on_def
  3.1322 +by (auto simp add: natLeq_Partial_order natLeq_Total)
  3.1323 +
  3.1324 +
  3.1325 +lemma natLeq_natLess_Id: "natLess = natLeq - Id"
  3.1326 +by auto
  3.1327 +
  3.1328 +
  3.1329 +lemma natLeq_Well_order: "Well_order natLeq"
  3.1330 +unfolding well_order_on_def
  3.1331 +using natLeq_Linear_order wf_less natLeq_natLess_Id by auto
  3.1332 +
  3.1333 +
  3.1334 +lemma Field_natLeq_on: "Field (natLeq_on n) = {x. x < n}"
  3.1335 +unfolding Field_def by auto
  3.1336 +
  3.1337 +
  3.1338 +lemma natLeq_underS_less: "underS natLeq n = {x. x < n}"
  3.1339 +unfolding underS_def by auto
  3.1340 +
  3.1341 +
  3.1342 +lemma Restr_natLeq: "Restr natLeq {x. x < n} = natLeq_on n"
  3.1343 +by force
  3.1344 +
  3.1345 +
  3.1346 +lemma Restr_natLeq2:
  3.1347 +"Restr natLeq (underS natLeq n) = natLeq_on n"
  3.1348 +by (auto simp add: Restr_natLeq natLeq_underS_less)
  3.1349 +
  3.1350 +
  3.1351 +lemma natLeq_on_Well_order: "Well_order(natLeq_on n)"
  3.1352 +using Restr_natLeq[of n] natLeq_Well_order
  3.1353 +      Well_order_Restr[of natLeq "{x. x < n}"] by auto
  3.1354 +
  3.1355 +
  3.1356 +corollary natLeq_on_well_order_on: "well_order_on {x. x < n} (natLeq_on n)"
  3.1357 +using natLeq_on_Well_order Field_natLeq_on by auto
  3.1358 +
  3.1359 +
  3.1360 +lemma natLeq_on_wo_rel: "wo_rel(natLeq_on n)"
  3.1361 +unfolding wo_rel_def using natLeq_on_Well_order .
  3.1362 +
  3.1363 +
  3.1364 +
  3.1365 +subsubsection {* Then as cardinals *}
  3.1366 +
  3.1367 +
  3.1368 +lemma natLeq_Card_order: "Card_order natLeq"
  3.1369 +proof(auto simp add: natLeq_Well_order
  3.1370 +      Card_order_iff_Restr_underS Restr_natLeq2, simp add:  Field_natLeq)
  3.1371 +  fix n have "finite(Field (natLeq_on n))" by (auto simp: Field_def)
  3.1372 +  moreover have "\<not>finite(UNIV::nat set)" by auto
  3.1373 +  ultimately show "natLeq_on n <o |UNIV::nat set|"
  3.1374 +  using finite_ordLess_infinite[of "natLeq_on n" "|UNIV::nat set|"]
  3.1375 +        Field_card_of[of "UNIV::nat set"]
  3.1376 +        card_of_Well_order[of "UNIV::nat set"] natLeq_on_Well_order[of n] by auto
  3.1377 +qed
  3.1378 +
  3.1379 +
  3.1380 +corollary card_of_Field_natLeq:
  3.1381 +"|Field natLeq| =o natLeq"
  3.1382 +using Field_natLeq natLeq_Card_order Card_order_iff_ordIso_card_of[of natLeq]
  3.1383 +      ordIso_symmetric[of natLeq] by blast
  3.1384 +
  3.1385 +
  3.1386 +corollary card_of_nat:
  3.1387 +"|UNIV::nat set| =o natLeq"
  3.1388 +using Field_natLeq card_of_Field_natLeq by auto
  3.1389 +
  3.1390 +
  3.1391 +corollary infinite_iff_natLeq_ordLeq:
  3.1392 +"\<not>finite A = ( natLeq \<le>o |A| )"
  3.1393 +using infinite_iff_card_of_nat[of A] card_of_nat
  3.1394 +      ordIso_ordLeq_trans ordLeq_ordIso_trans ordIso_symmetric by blast
  3.1395 +
  3.1396 +corollary finite_iff_ordLess_natLeq:
  3.1397 +"finite A = ( |A| <o natLeq)"
  3.1398 +using infinite_iff_natLeq_ordLeq not_ordLeq_iff_ordLess
  3.1399 +      card_of_Well_order natLeq_Well_order by metis
  3.1400 +
  3.1401 +
  3.1402 +subsection {* The successor of a cardinal *}
  3.1403 +
  3.1404 +
  3.1405 +text{* First we define @{text "isCardSuc r r'"}, the notion of @{text "r'"}
  3.1406 +being a successor cardinal of @{text "r"}. Although the definition does
  3.1407 +not require @{text "r"} to be a cardinal, only this case will be meaningful.  *}
  3.1408 +
  3.1409 +
  3.1410 +definition isCardSuc :: "'a rel \<Rightarrow> 'a set rel \<Rightarrow> bool"
  3.1411 +where
  3.1412 +"isCardSuc r r' \<equiv>
  3.1413 + Card_order r' \<and> r <o r' \<and>
  3.1414 + (\<forall>(r''::'a set rel). Card_order r'' \<and> r <o r'' \<longrightarrow> r' \<le>o r'')"
  3.1415 +
  3.1416 +
  3.1417 +text{* Now we introduce the cardinal-successor operator @{text "cardSuc"},
  3.1418 +by picking {\em some} cardinal-order relation fulfilling @{text "isCardSuc"}.
  3.1419 +Again, the picked item shall be proved unique up to order-isomorphism. *}
  3.1420 +
  3.1421 +
  3.1422 +definition cardSuc :: "'a rel \<Rightarrow> 'a set rel"
  3.1423 +where
  3.1424 +"cardSuc r \<equiv> SOME r'. isCardSuc r r'"
  3.1425 +
  3.1426 +
  3.1427 +lemma exists_minim_Card_order:
  3.1428 +"\<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.1429 +unfolding card_order_on_def using exists_minim_Well_order by blast
  3.1430 +
  3.1431 +
  3.1432 +lemma exists_isCardSuc:
  3.1433 +assumes "Card_order r"
  3.1434 +shows "\<exists>r'. isCardSuc r r'"
  3.1435 +proof-
  3.1436 +  let ?R = "{(r'::'a set rel). Card_order r' \<and> r <o r'}"
  3.1437 +  have "|Pow(Field r)| \<in> ?R \<and> (\<forall>r \<in> ?R. Card_order r)" using assms
  3.1438 +  by (simp add: card_of_Card_order Card_order_Pow)
  3.1439 +  then obtain r where "r \<in> ?R \<and> (\<forall>r' \<in> ?R. r \<le>o r')"
  3.1440 +  using exists_minim_Card_order[of ?R] by blast
  3.1441 +  thus ?thesis unfolding isCardSuc_def by auto
  3.1442 +qed
  3.1443 +
  3.1444 +
  3.1445 +lemma cardSuc_isCardSuc:
  3.1446 +assumes "Card_order r"
  3.1447 +shows "isCardSuc r (cardSuc r)"
  3.1448 +unfolding cardSuc_def using assms
  3.1449 +by (simp add: exists_isCardSuc someI_ex)
  3.1450 +
  3.1451 +
  3.1452 +lemma cardSuc_Card_order:
  3.1453 +"Card_order r \<Longrightarrow> Card_order(cardSuc r)"
  3.1454 +using cardSuc_isCardSuc unfolding isCardSuc_def by blast
  3.1455 +
  3.1456 +
  3.1457 +lemma cardSuc_greater:
  3.1458 +"Card_order r \<Longrightarrow> r <o cardSuc r"
  3.1459 +using cardSuc_isCardSuc unfolding isCardSuc_def by blast
  3.1460 +
  3.1461 +
  3.1462 +lemma cardSuc_ordLeq:
  3.1463 +"Card_order r \<Longrightarrow> r \<le>o cardSuc r"
  3.1464 +using cardSuc_greater ordLeq_iff_ordLess_or_ordIso by blast
  3.1465 +
  3.1466 +
  3.1467 +text{* The minimality property of @{text "cardSuc"} originally present in its definition
  3.1468 +is local to the type @{text "'a set rel"}, i.e., that of @{text "cardSuc r"}:  *}
  3.1469 +
  3.1470 +lemma cardSuc_least_aux:
  3.1471 +"\<lbrakk>Card_order (r::'a rel); Card_order (r'::'a set rel); r <o r'\<rbrakk> \<Longrightarrow> cardSuc r \<le>o r'"
  3.1472 +using cardSuc_isCardSuc unfolding isCardSuc_def by blast
  3.1473 +
  3.1474 +
  3.1475 +text{* But from this we can infer general minimality: *}
  3.1476 +
  3.1477 +lemma cardSuc_least:
  3.1478 +assumes CARD: "Card_order r" and CARD': "Card_order r'" and LESS: "r <o r'"
  3.1479 +shows "cardSuc r \<le>o r'"
  3.1480 +proof-
  3.1481 +  let ?p = "cardSuc r"
  3.1482 +  have 0: "Well_order ?p \<and> Well_order r'"
  3.1483 +  using assms cardSuc_Card_order unfolding card_order_on_def by blast
  3.1484 +  {assume "r' <o ?p"
  3.1485 +   then obtain r'' where 1: "Field r'' < Field ?p" and 2: "r' =o r'' \<and> r'' <o ?p"
  3.1486 +   using internalize_ordLess[of r' ?p] by blast
  3.1487 +   (*  *)
  3.1488 +   have "Card_order r''" using CARD' Card_order_ordIso2 2 by blast
  3.1489 +   moreover have "r <o r''" using LESS 2 ordLess_ordIso_trans by blast
  3.1490 +   ultimately have "?p \<le>o r''" using cardSuc_least_aux CARD by blast
  3.1491 +   hence False using 2 not_ordLess_ordLeq by blast
  3.1492 +  }
  3.1493 +  thus ?thesis using 0 ordLess_or_ordLeq by blast
  3.1494 +qed
  3.1495 +
  3.1496 +
  3.1497 +lemma cardSuc_ordLess_ordLeq:
  3.1498 +assumes CARD: "Card_order r" and CARD': "Card_order r'"
  3.1499 +shows "(r <o r') = (cardSuc r \<le>o r')"
  3.1500 +proof(auto simp add: assms cardSuc_least)
  3.1501 +  assume "cardSuc r \<le>o r'"
  3.1502 +  thus "r <o r'" using assms cardSuc_greater ordLess_ordLeq_trans by blast
  3.1503 +qed
  3.1504 +
  3.1505 +
  3.1506 +lemma cardSuc_ordLeq_ordLess:
  3.1507 +assumes CARD: "Card_order r" and CARD': "Card_order r'"
  3.1508 +shows "(r' <o cardSuc r) = (r' \<le>o r)"
  3.1509 +proof-
  3.1510 +  have "Well_order r \<and> Well_order r'"
  3.1511 +  using assms unfolding card_order_on_def by auto
  3.1512 +  moreover have "Well_order(cardSuc r)"
  3.1513 +  using assms cardSuc_Card_order card_order_on_def by blast
  3.1514 +  ultimately show ?thesis
  3.1515 +  using assms cardSuc_ordLess_ordLeq[of r r']
  3.1516 +  not_ordLeq_iff_ordLess[of r r'] not_ordLeq_iff_ordLess[of r' "cardSuc r"] by blast
  3.1517 +qed
  3.1518 +
  3.1519 +
  3.1520 +lemma cardSuc_mono_ordLeq:
  3.1521 +assumes CARD: "Card_order r" and CARD': "Card_order r'"
  3.1522 +shows "(cardSuc r \<le>o cardSuc r') = (r \<le>o r')"
  3.1523 +using assms cardSuc_ordLeq_ordLess cardSuc_ordLess_ordLeq cardSuc_Card_order by blast
  3.1524 +
  3.1525 +
  3.1526 +lemma cardSuc_invar_ordIso:
  3.1527 +assumes CARD: "Card_order r" and CARD': "Card_order r'"
  3.1528 +shows "(cardSuc r =o cardSuc r') = (r =o r')"
  3.1529 +proof-
  3.1530 +  have 0: "Well_order r \<and> Well_order r' \<and> Well_order(cardSuc r) \<and> Well_order(cardSuc r')"
  3.1531 +  using assms by (simp add: card_order_on_well_order_on cardSuc_Card_order)
  3.1532 +  thus ?thesis
  3.1533 +  using ordIso_iff_ordLeq[of r r'] ordIso_iff_ordLeq
  3.1534 +  using cardSuc_mono_ordLeq[of r r'] cardSuc_mono_ordLeq[of r' r] assms by blast
  3.1535 +qed
  3.1536 +
  3.1537 +
  3.1538 +lemma card_of_cardSuc_finite:
  3.1539 +"finite(Field(cardSuc |A| )) = finite A"
  3.1540 +proof
  3.1541 +  assume *: "finite (Field (cardSuc |A| ))"
  3.1542 +  have 0: "|Field(cardSuc |A| )| =o cardSuc |A|"
  3.1543 +  using card_of_Card_order cardSuc_Card_order card_of_Field_ordIso by blast
  3.1544 +  hence "|A| \<le>o |Field(cardSuc |A| )|"
  3.1545 +  using card_of_Card_order[of A] cardSuc_ordLeq[of "|A|"] ordIso_symmetric
  3.1546 +  ordLeq_ordIso_trans by blast
  3.1547 +  thus "finite A" using * card_of_ordLeq_finite by blast
  3.1548 +next
  3.1549 +  assume "finite A"
  3.1550 +  then have "finite ( Field |Pow A| )" unfolding Field_card_of by simp
  3.1551 +  then show "finite (Field (cardSuc |A| ))"
  3.1552 +  proof (rule card_of_ordLeq_finite[OF card_of_mono2, rotated])
  3.1553 +    show "cardSuc |A| \<le>o |Pow A|"
  3.1554 +      by (metis cardSuc_ordLess_ordLeq card_of_Card_order card_of_Pow)
  3.1555 +  qed
  3.1556 +qed
  3.1557 +
  3.1558 +
  3.1559 +lemma cardSuc_finite:
  3.1560 +assumes "Card_order r"
  3.1561 +shows "finite (Field (cardSuc r)) = finite (Field r)"
  3.1562 +proof-
  3.1563 +  let ?A = "Field r"
  3.1564 +  have "|?A| =o r" using assms by (simp add: card_of_Field_ordIso)
  3.1565 +  hence "cardSuc |?A| =o cardSuc r" using assms
  3.1566 +  by (simp add: card_of_Card_order cardSuc_invar_ordIso)
  3.1567 +  moreover have "|Field (cardSuc |?A| ) | =o cardSuc |?A|"
  3.1568 +  by (simp add: card_of_card_order_on Field_card_of card_of_Field_ordIso cardSuc_Card_order)
  3.1569 +  moreover
  3.1570 +  {have "|Field (cardSuc r) | =o cardSuc r"
  3.1571 +   using assms by (simp add: card_of_Field_ordIso cardSuc_Card_order)
  3.1572 +   hence "cardSuc r =o |Field (cardSuc r) |"
  3.1573 +   using ordIso_symmetric by blast
  3.1574 +  }
  3.1575 +  ultimately have "|Field (cardSuc |?A| ) | =o |Field (cardSuc r) |"
  3.1576 +  using ordIso_transitive by blast
  3.1577 +  hence "finite (Field (cardSuc |?A| )) = finite (Field (cardSuc r))"
  3.1578 +  using card_of_ordIso_finite by blast
  3.1579 +  thus ?thesis by (simp only: card_of_cardSuc_finite)
  3.1580 +qed
  3.1581 +
  3.1582 +
  3.1583 +lemma card_of_Plus_ordLess_infinite:
  3.1584 +assumes INF: "\<not>finite C" and
  3.1585 +        LESS1: "|A| <o |C|" and LESS2: "|B| <o |C|"
  3.1586 +shows "|A <+> B| <o |C|"
  3.1587 +proof(cases "A = {} \<or> B = {}")
  3.1588 +  assume Case1: "A = {} \<or> B = {}"
  3.1589 +  hence "|A| =o |A <+> B| \<or> |B| =o |A <+> B|"
  3.1590 +  using card_of_Plus_empty1 card_of_Plus_empty2 by blast
  3.1591 +  hence "|A <+> B| =o |A| \<or> |A <+> B| =o |B|"
  3.1592 +  using ordIso_symmetric[of "|A|"] ordIso_symmetric[of "|B|"] by blast
  3.1593 +  thus ?thesis using LESS1 LESS2
  3.1594 +       ordIso_ordLess_trans[of "|A <+> B|" "|A|"]
  3.1595 +       ordIso_ordLess_trans[of "|A <+> B|" "|B|"] by blast
  3.1596 +next
  3.1597 +  assume Case2: "\<not>(A = {} \<or> B = {})"
  3.1598 +  {assume *: "|C| \<le>o |A <+> B|"
  3.1599 +   hence "\<not>finite (A <+> B)" using INF card_of_ordLeq_finite by blast
  3.1600 +   hence 1: "\<not>finite A \<or> \<not>finite B" using finite_Plus by blast
  3.1601 +   {assume Case21: "|A| \<le>o |B|"
  3.1602 +    hence "\<not>finite B" using 1 card_of_ordLeq_finite by blast
  3.1603 +    hence "|A <+> B| =o |B|" using Case2 Case21
  3.1604 +    by (auto simp add: card_of_Plus_infinite)
  3.1605 +    hence False using LESS2 not_ordLess_ordLeq * ordLeq_ordIso_trans by blast
  3.1606 +   }
  3.1607 +   moreover
  3.1608 +   {assume Case22: "|B| \<le>o |A|"
  3.1609 +    hence "\<not>finite A" using 1 card_of_ordLeq_finite by blast
  3.1610 +    hence "|A <+> B| =o |A|" using Case2 Case22
  3.1611 +    by (auto simp add: card_of_Plus_infinite)
  3.1612 +    hence False using LESS1 not_ordLess_ordLeq * ordLeq_ordIso_trans by blast
  3.1613 +   }
  3.1614 +   ultimately have False using ordLeq_total card_of_Well_order[of A]
  3.1615 +   card_of_Well_order[of B] by blast
  3.1616 +  }
  3.1617 +  thus ?thesis using ordLess_or_ordLeq[of "|A <+> B|" "|C|"]
  3.1618 +  card_of_Well_order[of "A <+> B"] card_of_Well_order[of "C"] by auto
  3.1619 +qed
  3.1620 +
  3.1621 +
  3.1622 +lemma card_of_Plus_ordLess_infinite_Field:
  3.1623 +assumes INF: "\<not>finite (Field r)" and r: "Card_order r" and
  3.1624 +        LESS1: "|A| <o r" and LESS2: "|B| <o r"
  3.1625 +shows "|A <+> B| <o r"
  3.1626 +proof-
  3.1627 +  let ?C  = "Field r"
  3.1628 +  have 1: "r =o |?C| \<and> |?C| =o r" using r card_of_Field_ordIso
  3.1629 +  ordIso_symmetric by blast
  3.1630 +  hence "|A| <o |?C|"  "|B| <o |?C|"
  3.1631 +  using LESS1 LESS2 ordLess_ordIso_trans by blast+
  3.1632 +  hence  "|A <+> B| <o |?C|" using INF
  3.1633 +  card_of_Plus_ordLess_infinite by blast
  3.1634 +  thus ?thesis using 1 ordLess_ordIso_trans by blast
  3.1635 +qed
  3.1636 +
  3.1637 +
  3.1638 +lemma card_of_Plus_ordLeq_infinite_Field:
  3.1639 +assumes r: "\<not>finite (Field r)" and A: "|A| \<le>o r" and B: "|B| \<le>o r"
  3.1640 +and c: "Card_order r"
  3.1641 +shows "|A <+> B| \<le>o r"
  3.1642 +proof-
  3.1643 +  let ?r' = "cardSuc r"
  3.1644 +  have "Card_order ?r' \<and> \<not>finite (Field ?r')" using assms
  3.1645 +  by (simp add: cardSuc_Card_order cardSuc_finite)
  3.1646 +  moreover have "|A| <o ?r'" and "|B| <o ?r'" using A B c
  3.1647 +  by (auto simp: card_of_card_order_on Field_card_of cardSuc_ordLeq_ordLess)
  3.1648 +  ultimately have "|A <+> B| <o ?r'"
  3.1649 +  using card_of_Plus_ordLess_infinite_Field by blast
  3.1650 +  thus ?thesis using c r
  3.1651 +  by (simp add: card_of_card_order_on Field_card_of cardSuc_ordLeq_ordLess)
  3.1652 +qed
  3.1653 +
  3.1654 +
  3.1655 +lemma card_of_Un_ordLeq_infinite_Field:
  3.1656 +assumes C: "\<not>finite (Field r)" and A: "|A| \<le>o r" and B: "|B| \<le>o r"
  3.1657 +and "Card_order r"
  3.1658 +shows "|A Un B| \<le>o r"
  3.1659 +using assms card_of_Plus_ordLeq_infinite_Field card_of_Un_Plus_ordLeq
  3.1660 +ordLeq_transitive by fast
  3.1661 +
  3.1662 +
  3.1663 +
  3.1664 +subsection {* Regular cardinals *}
  3.1665 +
  3.1666 +
  3.1667 +definition cofinal where
  3.1668 +"cofinal A r \<equiv>
  3.1669 + ALL a : Field r. EX b : A. a \<noteq> b \<and> (a,b) : r"
  3.1670 +
  3.1671 +
  3.1672 +definition regular where
  3.1673 +"regular r \<equiv>
  3.1674 + ALL K. K \<le> Field r \<and> cofinal K r \<longrightarrow> |K| =o r"
  3.1675 +
  3.1676 +
  3.1677 +definition relChain where
  3.1678 +"relChain r As \<equiv>
  3.1679 + ALL i j. (i,j) \<in> r \<longrightarrow> As i \<le> As j"
  3.1680 +
  3.1681 +lemma regular_UNION:
  3.1682 +assumes r: "Card_order r"   "regular r"
  3.1683 +and As: "relChain r As"
  3.1684 +and Bsub: "B \<le> (UN i : Field r. As i)"
  3.1685 +and cardB: "|B| <o r"
  3.1686 +shows "EX i : Field r. B \<le> As i"
  3.1687 +proof-
  3.1688 +  let ?phi = "%b j. j : Field r \<and> b : As j"
  3.1689 +  have "ALL b : B. EX j. ?phi b j" using Bsub by blast
  3.1690 +  then obtain f where f: "!! b. b : B \<Longrightarrow> ?phi b (f b)"
  3.1691 +  using bchoice[of B ?phi] by blast
  3.1692 +  let ?K = "f ` B"
  3.1693 +  {assume 1: "!! i. i : Field r \<Longrightarrow> ~ B \<le> As i"
  3.1694 +   have 2: "cofinal ?K r"
  3.1695 +   unfolding cofinal_def proof auto
  3.1696 +     fix i assume i: "i : Field r"
  3.1697 +     with 1 obtain b where b: "b : B \<and> b \<notin> As i" by blast
  3.1698 +     hence "i \<noteq> f b \<and> ~ (f b,i) : r"
  3.1699 +     using As f unfolding relChain_def by auto
  3.1700 +     hence "i \<noteq> f b \<and> (i, f b) : r" using r
  3.1701 +     unfolding card_order_on_def well_order_on_def linear_order_on_def
  3.1702 +     total_on_def using i f b by auto
  3.1703 +     with b show "\<exists>b\<in>B. i \<noteq> f b \<and> (i, f b) \<in> r" by blast
  3.1704 +   qed
  3.1705 +   moreover have "?K \<le> Field r" using f by blast
  3.1706 +   ultimately have "|?K| =o r" using 2 r unfolding regular_def by blast
  3.1707 +   moreover
  3.1708 +   {
  3.1709 +    have "|?K| <=o |B|" using card_of_image .
  3.1710 +    hence "|?K| <o r" using cardB ordLeq_ordLess_trans by blast
  3.1711 +   }
  3.1712 +   ultimately have False using not_ordLess_ordIso by blast
  3.1713 +  }
  3.1714 +  thus ?thesis by blast
  3.1715 +qed
  3.1716 +
  3.1717 +
  3.1718 +lemma infinite_cardSuc_regular:
  3.1719 +assumes r_inf: "\<not>finite (Field r)" and r_card: "Card_order r"
  3.1720 +shows "regular (cardSuc r)"
  3.1721 +proof-
  3.1722 +  let ?r' = "cardSuc r"
  3.1723 +  have r': "Card_order ?r'"
  3.1724 +  "!! p. Card_order p \<longrightarrow> (p \<le>o r) = (p <o ?r')"
  3.1725 +  using r_card by (auto simp: cardSuc_Card_order cardSuc_ordLeq_ordLess)
  3.1726 +  show ?thesis
  3.1727 +  unfolding regular_def proof auto
  3.1728 +    fix K assume 1: "K \<le> Field ?r'" and 2: "cofinal K ?r'"
  3.1729 +    hence "|K| \<le>o |Field ?r'|" by (simp only: card_of_mono1)
  3.1730 +    also have 22: "|Field ?r'| =o ?r'"
  3.1731 +    using r' by (simp add: card_of_Field_ordIso[of ?r'])
  3.1732 +    finally have "|K| \<le>o ?r'" .
  3.1733 +    moreover
  3.1734 +    {let ?L = "UN j : K. underS ?r' j"
  3.1735 +     let ?J = "Field r"
  3.1736 +     have rJ: "r =o |?J|"
  3.1737 +     using r_card card_of_Field_ordIso ordIso_symmetric by blast
  3.1738 +     assume "|K| <o ?r'"
  3.1739 +     hence "|K| <=o r" using r' card_of_Card_order[of K] by blast
  3.1740 +     hence "|K| \<le>o |?J|" using rJ ordLeq_ordIso_trans by blast
  3.1741 +     moreover
  3.1742 +     {have "ALL j : K. |underS ?r' j| <o ?r'"
  3.1743 +      using r' 1 by (auto simp: card_of_underS)
  3.1744 +      hence "ALL j : K. |underS ?r' j| \<le>o r"
  3.1745 +      using r' card_of_Card_order by blast
  3.1746 +      hence "ALL j : K. |underS ?r' j| \<le>o |?J|"
  3.1747 +      using rJ ordLeq_ordIso_trans by blast
  3.1748 +     }
  3.1749 +     ultimately have "|?L| \<le>o |?J|"
  3.1750 +     using r_inf card_of_UNION_ordLeq_infinite by blast
  3.1751 +     hence "|?L| \<le>o r" using rJ ordIso_symmetric ordLeq_ordIso_trans by blast
  3.1752 +     hence "|?L| <o ?r'" using r' card_of_Card_order by blast
  3.1753 +     moreover
  3.1754 +     {
  3.1755 +      have "Field ?r' \<le> ?L"
  3.1756 +      using 2 unfolding underS_def cofinal_def by auto
  3.1757 +      hence "|Field ?r'| \<le>o |?L|" by (simp add: card_of_mono1)
  3.1758 +      hence "?r' \<le>o |?L|"
  3.1759 +      using 22 ordIso_ordLeq_trans ordIso_symmetric by blast
  3.1760 +     }
  3.1761 +     ultimately have "|?L| <o |?L|" using ordLess_ordLeq_trans by blast
  3.1762 +     hence False using ordLess_irreflexive by blast
  3.1763 +    }
  3.1764 +    ultimately show "|K| =o ?r'"
  3.1765 +    unfolding ordLeq_iff_ordLess_or_ordIso by blast
  3.1766 +  qed
  3.1767 +qed
  3.1768 +
  3.1769 +lemma cardSuc_UNION:
  3.1770 +assumes r: "Card_order r" and "\<not>finite (Field r)"
  3.1771 +and As: "relChain (cardSuc r) As"
  3.1772 +and Bsub: "B \<le> (UN i : Field (cardSuc r). As i)"
  3.1773 +and cardB: "|B| <=o r"
  3.1774 +shows "EX i : Field (cardSuc r). B \<le> As i"
  3.1775 +proof-
  3.1776 +  let ?r' = "cardSuc r"
  3.1777 +  have "Card_order ?r' \<and> |B| <o ?r'"
  3.1778 +  using r cardB cardSuc_ordLeq_ordLess cardSuc_Card_order
  3.1779 +  card_of_Card_order by blast
  3.1780 +  moreover have "regular ?r'"
  3.1781 +  using assms by(simp add: infinite_cardSuc_regular)
  3.1782 +  ultimately show ?thesis
  3.1783 +  using As Bsub cardB regular_UNION by blast
  3.1784 +qed
  3.1785 +
  3.1786 +
  3.1787 +subsection {* Others *}
  3.1788 +
  3.1789 +lemma card_of_Func_Times:
  3.1790 +"|Func (A <*> B) C| =o |Func A (Func B C)|"
  3.1791 +unfolding card_of_ordIso[symmetric]
  3.1792 +using bij_betw_curr by blast
  3.1793 +
  3.1794 +lemma card_of_Pow_Func:
  3.1795 +"|Pow A| =o |Func A (UNIV::bool set)|"
  3.1796 +proof-
  3.1797 +  def F \<equiv> "\<lambda> A' a. if a \<in> A then (if a \<in> A' then True else False)
  3.1798 +                            else undefined"
  3.1799 +  have "bij_betw F (Pow A) (Func A (UNIV::bool set))"
  3.1800 +  unfolding bij_betw_def inj_on_def proof (intro ballI impI conjI)
  3.1801 +    fix A1 A2 assume "A1 \<in> Pow A" "A2 \<in> Pow A" "F A1 = F A2"
  3.1802 +    thus "A1 = A2" unfolding F_def Pow_def fun_eq_iff by (auto split: split_if_asm)
  3.1803 +  next
  3.1804 +    show "F ` Pow A = Func A UNIV"
  3.1805 +    proof safe
  3.1806 +      fix f assume f: "f \<in> Func A (UNIV::bool set)"
  3.1807 +      show "f \<in> F ` Pow A" unfolding image_def mem_Collect_eq proof(intro bexI)
  3.1808 +        let ?A1 = "{a \<in> A. f a = True}"
  3.1809 +        show "f = F ?A1" unfolding F_def apply(rule ext)
  3.1810 +        using f unfolding Func_def mem_Collect_eq by auto
  3.1811 +      qed auto
  3.1812 +    qed(unfold Func_def mem_Collect_eq F_def, auto)
  3.1813 +  qed
  3.1814 +  thus ?thesis unfolding card_of_ordIso[symmetric] by blast
  3.1815 +qed
  3.1816 +
  3.1817 +lemma card_of_Func_UNIV:
  3.1818 +"|Func (UNIV::'a set) (B::'b set)| =o |{f::'a \<Rightarrow> 'b. range f \<subseteq> B}|"
  3.1819 +apply(rule ordIso_symmetric) proof(intro card_of_ordIsoI)
  3.1820 +  let ?F = "\<lambda> f (a::'a). ((f a)::'b)"
  3.1821 +  show "bij_betw ?F {f. range f \<subseteq> B} (Func UNIV B)"
  3.1822 +  unfolding bij_betw_def inj_on_def proof safe
  3.1823 +    fix h :: "'a \<Rightarrow> 'b" assume h: "h \<in> Func UNIV B"
  3.1824 +    hence "\<forall> a. \<exists> b. h a = b" unfolding Func_def by auto
  3.1825 +    then obtain f where f: "\<forall> a. h a = f a" by metis
  3.1826 +    hence "range f \<subseteq> B" using h unfolding Func_def by auto
  3.1827 +    thus "h \<in> (\<lambda>f a. f a) ` {f. range f \<subseteq> B}" using f unfolding image_def by auto
  3.1828 +  qed(unfold Func_def fun_eq_iff, auto)
  3.1829 +qed
  3.1830 +
  3.1831 +end
     4.1 --- a/src/HOL/Cardinals/Cardinal_Arithmetic_FP.thy	Mon Jan 20 16:14:19 2014 +0100
     4.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     4.3 @@ -1,713 +0,0 @@
     4.4 -(*  Title:      HOL/Cardinals/Cardinal_Arithmetic_FP.thy
     4.5 -    Author:     Dmitriy Traytel, TU Muenchen
     4.6 -    Copyright   2012
     4.7 -
     4.8 -Cardinal arithmetic (FP).
     4.9 -*)
    4.10 -
    4.11 -header {* Cardinal Arithmetic (FP) *}
    4.12 -
    4.13 -theory Cardinal_Arithmetic_FP
    4.14 -imports Cardinal_Order_Relation_FP
    4.15 -begin
    4.16 -
    4.17 -(*library candidate*)
    4.18 -lemma dir_image: "\<lbrakk>\<And>x y. (f x = f y) = (x = y); Card_order r\<rbrakk> \<Longrightarrow> r =o dir_image r f"
    4.19 -by (rule dir_image_ordIso) (auto simp add: inj_on_def card_order_on_def)
    4.20 -
    4.21 -(*should supersede a weaker lemma from the library*)
    4.22 -lemma dir_image_Field: "Field (dir_image r f) = f ` Field r"
    4.23 -unfolding dir_image_def Field_def Range_def Domain_def by fast
    4.24 -
    4.25 -lemma card_order_dir_image:
    4.26 -  assumes bij: "bij f" and co: "card_order r"
    4.27 -  shows "card_order (dir_image r f)"
    4.28 -proof -
    4.29 -  from assms have "Field (dir_image r f) = UNIV"
    4.30 -    using card_order_on_Card_order[of UNIV r] unfolding bij_def dir_image_Field by auto
    4.31 -  moreover from bij have "\<And>x y. (f x = f y) = (x = y)" unfolding bij_def inj_on_def by auto
    4.32 -  with co have "Card_order (dir_image r f)"
    4.33 -    using card_order_on_Card_order[of UNIV r] Card_order_ordIso2[OF _ dir_image] by blast
    4.34 -  ultimately show ?thesis by auto
    4.35 -qed
    4.36 -
    4.37 -(*library candidate*)
    4.38 -lemma ordIso_refl: "Card_order r \<Longrightarrow> r =o r"
    4.39 -by (rule card_order_on_ordIso)
    4.40 -
    4.41 -(*library candidate*)
    4.42 -lemma ordLeq_refl: "Card_order r \<Longrightarrow> r \<le>o r"
    4.43 -by (rule ordIso_imp_ordLeq, rule card_order_on_ordIso)
    4.44 -
    4.45 -(*library candidate*)
    4.46 -lemma card_of_ordIso_subst: "A = B \<Longrightarrow> |A| =o |B|"
    4.47 -by (simp only: ordIso_refl card_of_Card_order)
    4.48 -
    4.49 -(*library candidate*)
    4.50 -lemma Field_card_order: "card_order r \<Longrightarrow> Field r = UNIV"
    4.51 -using card_order_on_Card_order[of UNIV r] by simp
    4.52 -
    4.53 -(*library candidate*)
    4.54 -lemma card_of_Times_Plus_distrib:
    4.55 -  "|A <*> (B <+> C)| =o |A <*> B <+> A <*> C|" (is "|?RHS| =o |?LHS|")
    4.56 -proof -
    4.57 -  let ?f = "\<lambda>(a, bc). case bc of Inl b \<Rightarrow> Inl (a, b) | Inr c \<Rightarrow> Inr (a, c)"
    4.58 -  have "bij_betw ?f ?RHS ?LHS" unfolding bij_betw_def inj_on_def by force
    4.59 -  thus ?thesis using card_of_ordIso by blast
    4.60 -qed
    4.61 -
    4.62 -(*library candidate*)
    4.63 -lemma Func_Times_Range:
    4.64 -  "|Func A (B <*> C)| =o |Func A B <*> Func A C|" (is "|?LHS| =o |?RHS|")
    4.65 -proof -
    4.66 -  let ?F = "\<lambda>fg. (\<lambda>x. if x \<in> A then fst (fg x) else undefined,
    4.67 -                  \<lambda>x. if x \<in> A then snd (fg x) else undefined)"
    4.68 -  let ?G = "\<lambda>(f, g) x. if x \<in> A then (f x, g x) else undefined"
    4.69 -  have "bij_betw ?F ?LHS ?RHS" unfolding bij_betw_def inj_on_def
    4.70 -  apply safe
    4.71 -     apply (simp add: Func_def fun_eq_iff)
    4.72 -     apply (metis (no_types) pair_collapse)
    4.73 -    apply (auto simp: Func_def fun_eq_iff)[2]
    4.74 -  proof -
    4.75 -    fix f g assume "f \<in> Func A B" "g \<in> Func A C"
    4.76 -    thus "(f, g) \<in> ?F ` Func A (B \<times> C)"
    4.77 -      by (intro image_eqI[of _ _ "?G (f, g)"]) (auto simp: Func_def)
    4.78 -  qed
    4.79 -  thus ?thesis using card_of_ordIso by blast
    4.80 -qed
    4.81 -
    4.82 -
    4.83 -subsection {* Zero *}
    4.84 -
    4.85 -definition czero where
    4.86 -  "czero = card_of {}"
    4.87 -
    4.88 -lemma czero_ordIso:
    4.89 -  "czero =o czero"
    4.90 -using card_of_empty_ordIso by (simp add: czero_def)
    4.91 -
    4.92 -lemma card_of_ordIso_czero_iff_empty:
    4.93 -  "|A| =o (czero :: 'b rel) \<longleftrightarrow> A = ({} :: 'a set)"
    4.94 -unfolding czero_def by (rule iffI[OF card_of_empty2]) (auto simp: card_of_refl card_of_empty_ordIso)
    4.95 -
    4.96 -(* A "not czero" Cardinal predicate *)
    4.97 -abbreviation Cnotzero where
    4.98 -  "Cnotzero (r :: 'a rel) \<equiv> \<not>(r =o (czero :: 'a rel)) \<and> Card_order r"
    4.99 -
   4.100 -(*helper*)
   4.101 -lemma Cnotzero_imp_not_empty: "Cnotzero r \<Longrightarrow> Field r \<noteq> {}"
   4.102 -by (metis Card_order_iff_ordIso_card_of czero_def)
   4.103 -
   4.104 -lemma czeroI:
   4.105 -  "\<lbrakk>Card_order r; Field r = {}\<rbrakk> \<Longrightarrow> r =o czero"
   4.106 -using Cnotzero_imp_not_empty ordIso_transitive[OF _ czero_ordIso] by blast
   4.107 -
   4.108 -lemma czeroE:
   4.109 -  "r =o czero \<Longrightarrow> Field r = {}"
   4.110 -unfolding czero_def
   4.111 -by (drule card_of_cong) (simp only: Field_card_of card_of_empty2)
   4.112 -
   4.113 -lemma Cnotzero_mono:
   4.114 -  "\<lbrakk>Cnotzero r; Card_order q; r \<le>o q\<rbrakk> \<Longrightarrow> Cnotzero q"
   4.115 -apply (rule ccontr)
   4.116 -apply auto
   4.117 -apply (drule czeroE)
   4.118 -apply (erule notE)
   4.119 -apply (erule czeroI)
   4.120 -apply (drule card_of_mono2)
   4.121 -apply (simp only: card_of_empty3)
   4.122 -done
   4.123 -
   4.124 -subsection {* (In)finite cardinals *}
   4.125 -
   4.126 -definition cinfinite where
   4.127 -  "cinfinite r = (\<not> finite (Field r))"
   4.128 -
   4.129 -abbreviation Cinfinite where
   4.130 -  "Cinfinite r \<equiv> cinfinite r \<and> Card_order r"
   4.131 -
   4.132 -definition cfinite where
   4.133 -  "cfinite r = finite (Field r)"
   4.134 -
   4.135 -abbreviation Cfinite where
   4.136 -  "Cfinite r \<equiv> cfinite r \<and> Card_order r"
   4.137 -
   4.138 -lemma Cfinite_ordLess_Cinfinite: "\<lbrakk>Cfinite r; Cinfinite s\<rbrakk> \<Longrightarrow> r <o s"
   4.139 -  unfolding cfinite_def cinfinite_def
   4.140 -  by (metis card_order_on_well_order_on finite_ordLess_infinite)
   4.141 -
   4.142 -lemmas natLeq_card_order = natLeq_Card_order[unfolded Field_natLeq]
   4.143 -
   4.144 -lemma natLeq_cinfinite: "cinfinite natLeq"
   4.145 -unfolding cinfinite_def Field_natLeq by (metis infinite_UNIV_nat)
   4.146 -
   4.147 -lemma natLeq_ordLeq_cinfinite:
   4.148 -  assumes inf: "Cinfinite r"
   4.149 -  shows "natLeq \<le>o r"
   4.150 -proof -
   4.151 -  from inf have "natLeq \<le>o |Field r|" by (metis cinfinite_def infinite_iff_natLeq_ordLeq)
   4.152 -  also from inf have "|Field r| =o r" by (simp add: card_of_unique ordIso_symmetric)
   4.153 -  finally show ?thesis .
   4.154 -qed
   4.155 -
   4.156 -lemma cinfinite_not_czero: "cinfinite r \<Longrightarrow> \<not> (r =o (czero :: 'a rel))"
   4.157 -unfolding cinfinite_def by (metis czeroE finite.emptyI)
   4.158 -
   4.159 -lemma Cinfinite_Cnotzero: "Cinfinite r \<Longrightarrow> Cnotzero r"
   4.160 -by (metis cinfinite_not_czero)
   4.161 -
   4.162 -lemma Cinfinite_cong: "\<lbrakk>r1 =o r2; Cinfinite r1\<rbrakk> \<Longrightarrow> Cinfinite r2"
   4.163 -by (metis Card_order_ordIso2 card_of_mono2 card_of_ordLeq_infinite cinfinite_def ordIso_iff_ordLeq)
   4.164 -
   4.165 -lemma cinfinite_mono: "\<lbrakk>r1 \<le>o r2; cinfinite r1\<rbrakk> \<Longrightarrow> cinfinite r2"
   4.166 -by (metis card_of_mono2 card_of_ordLeq_infinite cinfinite_def)
   4.167 -
   4.168 -
   4.169 -subsection {* Binary sum *}
   4.170 -
   4.171 -definition csum (infixr "+c" 65) where
   4.172 -  "r1 +c r2 \<equiv> |Field r1 <+> Field r2|"
   4.173 -
   4.174 -lemma Field_csum: "Field (r +c s) = Inl ` Field r \<union> Inr ` Field s"
   4.175 -  unfolding csum_def Field_card_of by auto
   4.176 -
   4.177 -lemma Card_order_csum:
   4.178 -  "Card_order (r1 +c r2)"
   4.179 -unfolding csum_def by (simp add: card_of_Card_order)
   4.180 -
   4.181 -lemma csum_Cnotzero1:
   4.182 -  "Cnotzero r1 \<Longrightarrow> Cnotzero (r1 +c r2)"
   4.183 -unfolding csum_def
   4.184 -by (metis Cnotzero_imp_not_empty Plus_eq_empty_conv card_of_Card_order card_of_ordIso_czero_iff_empty)
   4.185 -
   4.186 -lemma card_order_csum:
   4.187 -  assumes "card_order r1" "card_order r2"
   4.188 -  shows "card_order (r1 +c r2)"
   4.189 -proof -
   4.190 -  have "Field r1 = UNIV" "Field r2 = UNIV" using assms card_order_on_Card_order by auto
   4.191 -  thus ?thesis unfolding csum_def by (auto simp: card_of_card_order_on)
   4.192 -qed
   4.193 -
   4.194 -lemma cinfinite_csum:
   4.195 -  "cinfinite r1 \<or> cinfinite r2 \<Longrightarrow> cinfinite (r1 +c r2)"
   4.196 -unfolding cinfinite_def csum_def by (auto simp: Field_card_of)
   4.197 -
   4.198 -lemma Cinfinite_csum1:
   4.199 -  "Cinfinite r1 \<Longrightarrow> Cinfinite (r1 +c r2)"
   4.200 -unfolding cinfinite_def csum_def by (metis Field_card_of card_of_Card_order finite_Plus_iff)
   4.201 -
   4.202 -lemma Cinfinite_csum:
   4.203 -  "Cinfinite r1 \<or> Cinfinite r2 \<Longrightarrow> Cinfinite (r1 +c r2)"
   4.204 -unfolding cinfinite_def csum_def by (metis Field_card_of card_of_Card_order finite_Plus_iff)
   4.205 -
   4.206 -lemma Cinfinite_csum_strong:
   4.207 -  "\<lbrakk>Cinfinite r1; Cinfinite r2\<rbrakk> \<Longrightarrow> Cinfinite (r1 +c r2)"
   4.208 -by (metis Cinfinite_csum)
   4.209 -
   4.210 -lemma csum_cong: "\<lbrakk>p1 =o r1; p2 =o r2\<rbrakk> \<Longrightarrow> p1 +c p2 =o r1 +c r2"
   4.211 -by (simp only: csum_def ordIso_Plus_cong)
   4.212 -
   4.213 -lemma csum_cong1: "p1 =o r1 \<Longrightarrow> p1 +c q =o r1 +c q"
   4.214 -by (simp only: csum_def ordIso_Plus_cong1)
   4.215 -
   4.216 -lemma csum_cong2: "p2 =o r2 \<Longrightarrow> q +c p2 =o q +c r2"
   4.217 -by (simp only: csum_def ordIso_Plus_cong2)
   4.218 -
   4.219 -lemma csum_mono: "\<lbrakk>p1 \<le>o r1; p2 \<le>o r2\<rbrakk> \<Longrightarrow> p1 +c p2 \<le>o r1 +c r2"
   4.220 -by (simp only: csum_def ordLeq_Plus_mono)
   4.221 -
   4.222 -lemma csum_mono1: "p1 \<le>o r1 \<Longrightarrow> p1 +c q \<le>o r1 +c q"
   4.223 -by (simp only: csum_def ordLeq_Plus_mono1)
   4.224 -
   4.225 -lemma csum_mono2: "p2 \<le>o r2 \<Longrightarrow> q +c p2 \<le>o q +c r2"
   4.226 -by (simp only: csum_def ordLeq_Plus_mono2)
   4.227 -
   4.228 -lemma ordLeq_csum1: "Card_order p1 \<Longrightarrow> p1 \<le>o p1 +c p2"
   4.229 -by (simp only: csum_def Card_order_Plus1)
   4.230 -
   4.231 -lemma ordLeq_csum2: "Card_order p2 \<Longrightarrow> p2 \<le>o p1 +c p2"
   4.232 -by (simp only: csum_def Card_order_Plus2)
   4.233 -
   4.234 -lemma csum_com: "p1 +c p2 =o p2 +c p1"
   4.235 -by (simp only: csum_def card_of_Plus_commute)
   4.236 -
   4.237 -lemma csum_assoc: "(p1 +c p2) +c p3 =o p1 +c p2 +c p3"
   4.238 -by (simp only: csum_def Field_card_of card_of_Plus_assoc)
   4.239 -
   4.240 -lemma Cfinite_csum: "\<lbrakk>Cfinite r; Cfinite s\<rbrakk> \<Longrightarrow> Cfinite (r +c s)"
   4.241 -  unfolding cfinite_def csum_def Field_card_of using card_of_card_order_on by simp
   4.242 -
   4.243 -lemma csum_csum: "(r1 +c r2) +c (r3 +c r4) =o (r1 +c r3) +c (r2 +c r4)"
   4.244 -proof -
   4.245 -  have "(r1 +c r2) +c (r3 +c r4) =o r1 +c r2 +c (r3 +c r4)"
   4.246 -    by (metis csum_assoc)
   4.247 -  also have "r1 +c r2 +c (r3 +c r4) =o r1 +c (r2 +c r3) +c r4"
   4.248 -    by (metis csum_assoc csum_cong2 ordIso_symmetric)
   4.249 -  also have "r1 +c (r2 +c r3) +c r4 =o r1 +c (r3 +c r2) +c r4"
   4.250 -    by (metis csum_com csum_cong1 csum_cong2)
   4.251 -  also have "r1 +c (r3 +c r2) +c r4 =o r1 +c r3 +c r2 +c r4"
   4.252 -    by (metis csum_assoc csum_cong2 ordIso_symmetric)
   4.253 -  also have "r1 +c r3 +c r2 +c r4 =o (r1 +c r3) +c (r2 +c r4)"
   4.254 -    by (metis csum_assoc ordIso_symmetric)
   4.255 -  finally show ?thesis .
   4.256 -qed
   4.257 -
   4.258 -lemma Plus_csum: "|A <+> B| =o |A| +c |B|"
   4.259 -by (simp only: csum_def Field_card_of card_of_refl)
   4.260 -
   4.261 -lemma Un_csum: "|A \<union> B| \<le>o |A| +c |B|"
   4.262 -using ordLeq_ordIso_trans[OF card_of_Un_Plus_ordLeq Plus_csum] by blast
   4.263 -
   4.264 -
   4.265 -subsection {* One *}
   4.266 -
   4.267 -definition cone where
   4.268 -  "cone = card_of {()}"
   4.269 -
   4.270 -lemma Card_order_cone: "Card_order cone"
   4.271 -unfolding cone_def by (rule card_of_Card_order)
   4.272 -
   4.273 -lemma Cfinite_cone: "Cfinite cone"
   4.274 -  unfolding cfinite_def by (simp add: Card_order_cone)
   4.275 -
   4.276 -lemma cone_not_czero: "\<not> (cone =o czero)"
   4.277 -unfolding czero_def cone_def by (metis empty_not_insert card_of_empty3[of "{()}"] ordIso_iff_ordLeq)
   4.278 -
   4.279 -lemma cone_ordLeq_Cnotzero: "Cnotzero r \<Longrightarrow> cone \<le>o r"
   4.280 -unfolding cone_def by (metis Card_order_singl_ordLeq czeroI)
   4.281 -
   4.282 -
   4.283 -subsection{* Two *}
   4.284 -
   4.285 -definition ctwo where
   4.286 -  "ctwo = |UNIV :: bool set|"
   4.287 -
   4.288 -lemma Card_order_ctwo: "Card_order ctwo"
   4.289 -unfolding ctwo_def by (rule card_of_Card_order)
   4.290 -
   4.291 -lemma ctwo_not_czero: "\<not> (ctwo =o czero)"
   4.292 -using card_of_empty3[of "UNIV :: bool set"] ordIso_iff_ordLeq
   4.293 -unfolding czero_def ctwo_def by (metis UNIV_not_empty)
   4.294 -
   4.295 -lemma ctwo_Cnotzero: "Cnotzero ctwo"
   4.296 -by (simp add: ctwo_not_czero Card_order_ctwo)
   4.297 -
   4.298 -
   4.299 -subsection {* Family sum *}
   4.300 -
   4.301 -definition Csum where
   4.302 -  "Csum r rs \<equiv> |SIGMA i : Field r. Field (rs i)|"
   4.303 -
   4.304 -(* Similar setup to the one for SIGMA from theory Big_Operators: *)
   4.305 -syntax "_Csum" ::
   4.306 -  "pttrn => ('a * 'a) set => 'b * 'b set => (('a * 'b) * ('a * 'b)) set"
   4.307 -  ("(3CSUM _:_. _)" [0, 51, 10] 10)
   4.308 -
   4.309 -translations
   4.310 -  "CSUM i:r. rs" == "CONST Csum r (%i. rs)"
   4.311 -
   4.312 -lemma SIGMA_CSUM: "|SIGMA i : I. As i| = (CSUM i : |I|. |As i| )"
   4.313 -by (auto simp: Csum_def Field_card_of)
   4.314 -
   4.315 -(* NB: Always, under the cardinal operator,
   4.316 -operations on sets are reduced automatically to operations on cardinals.
   4.317 -This should make cardinal reasoning more direct and natural.  *)
   4.318 -
   4.319 -
   4.320 -subsection {* Product *}
   4.321 -
   4.322 -definition cprod (infixr "*c" 80) where
   4.323 -  "r1 *c r2 = |Field r1 <*> Field r2|"
   4.324 -
   4.325 -lemma card_order_cprod:
   4.326 -  assumes "card_order r1" "card_order r2"
   4.327 -  shows "card_order (r1 *c r2)"
   4.328 -proof -
   4.329 -  have "Field r1 = UNIV" "Field r2 = UNIV" using assms card_order_on_Card_order by auto
   4.330 -  thus ?thesis by (auto simp: cprod_def card_of_card_order_on)
   4.331 -qed
   4.332 -
   4.333 -lemma Card_order_cprod: "Card_order (r1 *c r2)"
   4.334 -by (simp only: cprod_def Field_card_of card_of_card_order_on)
   4.335 -
   4.336 -lemma cprod_mono1: "p1 \<le>o r1 \<Longrightarrow> p1 *c q \<le>o r1 *c q"
   4.337 -by (simp only: cprod_def ordLeq_Times_mono1)
   4.338 -
   4.339 -lemma cprod_mono2: "p2 \<le>o r2 \<Longrightarrow> q *c p2 \<le>o q *c r2"
   4.340 -by (simp only: cprod_def ordLeq_Times_mono2)
   4.341 -
   4.342 -lemma ordLeq_cprod2: "\<lbrakk>Cnotzero p1; Card_order p2\<rbrakk> \<Longrightarrow> p2 \<le>o p1 *c p2"
   4.343 -unfolding cprod_def by (metis Card_order_Times2 czeroI)
   4.344 -
   4.345 -lemma cinfinite_cprod: "\<lbrakk>cinfinite r1; cinfinite r2\<rbrakk> \<Longrightarrow> cinfinite (r1 *c r2)"
   4.346 -by (simp add: cinfinite_def cprod_def Field_card_of infinite_cartesian_product)
   4.347 -
   4.348 -lemma cinfinite_cprod2: "\<lbrakk>Cnotzero r1; Cinfinite r2\<rbrakk> \<Longrightarrow> cinfinite (r1 *c r2)"
   4.349 -by (metis cinfinite_mono ordLeq_cprod2)
   4.350 -
   4.351 -lemma Cinfinite_cprod2: "\<lbrakk>Cnotzero r1; Cinfinite r2\<rbrakk> \<Longrightarrow> Cinfinite (r1 *c r2)"
   4.352 -by (blast intro: cinfinite_cprod2 Card_order_cprod)
   4.353 -
   4.354 -lemma cprod_com: "p1 *c p2 =o p2 *c p1"
   4.355 -by (simp only: cprod_def card_of_Times_commute)
   4.356 -
   4.357 -lemma card_of_Csum_Times:
   4.358 -  "\<forall>i \<in> I. |A i| \<le>o |B| \<Longrightarrow> (CSUM i : |I|. |A i| ) \<le>o |I| *c |B|"
   4.359 -by (simp only: Csum_def cprod_def Field_card_of card_of_Sigma_Times)
   4.360 -
   4.361 -lemma card_of_Csum_Times':
   4.362 -  assumes "Card_order r" "\<forall>i \<in> I. |A i| \<le>o r"
   4.363 -  shows "(CSUM i : |I|. |A i| ) \<le>o |I| *c r"
   4.364 -proof -
   4.365 -  from assms(1) have *: "r =o |Field r|" by (simp add: card_of_unique)
   4.366 -  with assms(2) have "\<forall>i \<in> I. |A i| \<le>o |Field r|" by (blast intro: ordLeq_ordIso_trans)
   4.367 -  hence "(CSUM i : |I|. |A i| ) \<le>o |I| *c |Field r|" by (simp only: card_of_Csum_Times)
   4.368 -  also from * have "|I| *c |Field r| \<le>o |I| *c r"
   4.369 -    by (simp only: Field_card_of card_of_refl cprod_def ordIso_imp_ordLeq)
   4.370 -  finally show ?thesis .
   4.371 -qed
   4.372 -
   4.373 -lemma cprod_csum_distrib1: "r1 *c r2 +c r1 *c r3 =o r1 *c (r2 +c r3)"
   4.374 -unfolding csum_def cprod_def by (simp add: Field_card_of card_of_Times_Plus_distrib ordIso_symmetric)
   4.375 -
   4.376 -lemma csum_absorb2': "\<lbrakk>Card_order r2; r1 \<le>o r2; cinfinite r1 \<or> cinfinite r2\<rbrakk> \<Longrightarrow> r1 +c r2 =o r2"
   4.377 -unfolding csum_def by (metis Card_order_Plus_infinite cinfinite_def cinfinite_mono)
   4.378 -
   4.379 -lemma csum_absorb1':
   4.380 -  assumes card: "Card_order r2"
   4.381 -  and r12: "r1 \<le>o r2" and cr12: "cinfinite r1 \<or> cinfinite r2"
   4.382 -  shows "r2 +c r1 =o r2"
   4.383 -by (rule ordIso_transitive, rule csum_com, rule csum_absorb2', (simp only: assms)+)
   4.384 -
   4.385 -lemma csum_absorb1: "\<lbrakk>Cinfinite r2; r1 \<le>o r2\<rbrakk> \<Longrightarrow> r2 +c r1 =o r2"
   4.386 -by (rule csum_absorb1') auto
   4.387 -
   4.388 -
   4.389 -subsection {* Exponentiation *}
   4.390 -
   4.391 -definition cexp (infixr "^c" 90) where
   4.392 -  "r1 ^c r2 \<equiv> |Func (Field r2) (Field r1)|"
   4.393 -
   4.394 -lemma Card_order_cexp: "Card_order (r1 ^c r2)"
   4.395 -unfolding cexp_def by (rule card_of_Card_order)
   4.396 -
   4.397 -lemma cexp_mono':
   4.398 -  assumes 1: "p1 \<le>o r1" and 2: "p2 \<le>o r2"
   4.399 -  and n: "Field p2 = {} \<Longrightarrow> Field r2 = {}"
   4.400 -  shows "p1 ^c p2 \<le>o r1 ^c r2"
   4.401 -proof(cases "Field p1 = {}")
   4.402 -  case True
   4.403 -  hence "|Field |Func (Field p2) (Field p1)|| \<le>o cone"
   4.404 -    unfolding cone_def Field_card_of
   4.405 -    by (cases "Field p2 = {}", auto intro: card_of_ordLeqI2 simp: Func_empty)
   4.406 -       (metis Func_is_emp card_of_empty ex_in_conv)
   4.407 -  hence "|Func (Field p2) (Field p1)| \<le>o cone" by (simp add: Field_card_of cexp_def)
   4.408 -  hence "p1 ^c p2 \<le>o cone" unfolding cexp_def .
   4.409 -  thus ?thesis
   4.410 -  proof (cases "Field p2 = {}")
   4.411 -    case True
   4.412 -    with n have "Field r2 = {}" .
   4.413 -    hence "cone \<le>o r1 ^c r2" unfolding cone_def cexp_def Func_def by (auto intro: card_of_ordLeqI)
   4.414 -    thus ?thesis using `p1 ^c p2 \<le>o cone` ordLeq_transitive by auto
   4.415 -  next
   4.416 -    case False with True have "|Field (p1 ^c p2)| =o czero"
   4.417 -      unfolding card_of_ordIso_czero_iff_empty cexp_def Field_card_of Func_def by auto
   4.418 -    thus ?thesis unfolding cexp_def card_of_ordIso_czero_iff_empty Field_card_of
   4.419 -      by (simp add: card_of_empty)
   4.420 -  qed
   4.421 -next
   4.422 -  case False
   4.423 -  have 1: "|Field p1| \<le>o |Field r1|" and 2: "|Field p2| \<le>o |Field r2|"
   4.424 -    using 1 2 by (auto simp: card_of_mono2)
   4.425 -  obtain f1 where f1: "f1 ` Field r1 = Field p1"
   4.426 -    using 1 unfolding card_of_ordLeq2[OF False, symmetric] by auto
   4.427 -  obtain f2 where f2: "inj_on f2 (Field p2)" "f2 ` Field p2 \<subseteq> Field r2"
   4.428 -    using 2 unfolding card_of_ordLeq[symmetric] by blast
   4.429 -  have 0: "Func_map (Field p2) f1 f2 ` (Field (r1 ^c r2)) = Field (p1 ^c p2)"
   4.430 -    unfolding cexp_def Field_card_of using Func_map_surj[OF f1 f2 n, symmetric] .
   4.431 -  have 00: "Field (p1 ^c p2) \<noteq> {}" unfolding cexp_def Field_card_of Func_is_emp
   4.432 -    using False by simp
   4.433 -  show ?thesis
   4.434 -    using 0 card_of_ordLeq2[OF 00] unfolding cexp_def Field_card_of by blast
   4.435 -qed
   4.436 -
   4.437 -lemma cexp_mono:
   4.438 -  assumes 1: "p1 \<le>o r1" and 2: "p2 \<le>o r2"
   4.439 -  and n: "p2 =o czero \<Longrightarrow> r2 =o czero" and card: "Card_order p2"
   4.440 -  shows "p1 ^c p2 \<le>o r1 ^c r2"
   4.441 -  by (metis (full_types) "1" "2" card cexp_mono' czeroE czeroI n)
   4.442 -
   4.443 -lemma cexp_mono1:
   4.444 -  assumes 1: "p1 \<le>o r1" and q: "Card_order q"
   4.445 -  shows "p1 ^c q \<le>o r1 ^c q"
   4.446 -using ordLeq_refl[OF q] by (rule cexp_mono[OF 1]) (auto simp: q)
   4.447 -
   4.448 -lemma cexp_mono2':
   4.449 -  assumes 2: "p2 \<le>o r2" and q: "Card_order q"
   4.450 -  and n: "Field p2 = {} \<Longrightarrow> Field r2 = {}"
   4.451 -  shows "q ^c p2 \<le>o q ^c r2"
   4.452 -using ordLeq_refl[OF q] by (rule cexp_mono'[OF _ 2 n]) auto
   4.453 -
   4.454 -lemma cexp_mono2:
   4.455 -  assumes 2: "p2 \<le>o r2" and q: "Card_order q"
   4.456 -  and n: "p2 =o czero \<Longrightarrow> r2 =o czero" and card: "Card_order p2"
   4.457 -  shows "q ^c p2 \<le>o q ^c r2"
   4.458 -using ordLeq_refl[OF q] by (rule cexp_mono[OF _ 2 n card]) auto
   4.459 -
   4.460 -lemma cexp_mono2_Cnotzero:
   4.461 -  assumes "p2 \<le>o r2" "Card_order q" "Cnotzero p2"
   4.462 -  shows "q ^c p2 \<le>o q ^c r2"
   4.463 -by (metis assms cexp_mono2' czeroI)
   4.464 -
   4.465 -lemma cexp_cong:
   4.466 -  assumes 1: "p1 =o r1" and 2: "p2 =o r2"
   4.467 -  and Cr: "Card_order r2"
   4.468 -  and Cp: "Card_order p2"
   4.469 -  shows "p1 ^c p2 =o r1 ^c r2"
   4.470 -proof -
   4.471 -  obtain f where "bij_betw f (Field p2) (Field r2)"
   4.472 -    using 2 card_of_ordIso[of "Field p2" "Field r2"] card_of_cong by auto
   4.473 -  hence 0: "Field p2 = {} \<longleftrightarrow> Field r2 = {}" unfolding bij_betw_def by auto
   4.474 -  have r: "p2 =o czero \<Longrightarrow> r2 =o czero"
   4.475 -    and p: "r2 =o czero \<Longrightarrow> p2 =o czero"
   4.476 -     using 0 Cr Cp czeroE czeroI by auto
   4.477 -  show ?thesis using 0 1 2 unfolding ordIso_iff_ordLeq
   4.478 -    using r p cexp_mono[OF _ _ _ Cp] cexp_mono[OF _ _ _ Cr] by metis
   4.479 -qed
   4.480 -
   4.481 -lemma cexp_cong1:
   4.482 -  assumes 1: "p1 =o r1" and q: "Card_order q"
   4.483 -  shows "p1 ^c q =o r1 ^c q"
   4.484 -by (rule cexp_cong[OF 1 _ q q]) (rule ordIso_refl[OF q])
   4.485 -
   4.486 -lemma cexp_cong2:
   4.487 -  assumes 2: "p2 =o r2" and q: "Card_order q" and p: "Card_order p2"
   4.488 -  shows "q ^c p2 =o q ^c r2"
   4.489 -by (rule cexp_cong[OF _ 2]) (auto simp only: ordIso_refl Card_order_ordIso2[OF p 2] q p)
   4.490 -
   4.491 -lemma cexp_cone:
   4.492 -  assumes "Card_order r"
   4.493 -  shows "r ^c cone =o r"
   4.494 -proof -
   4.495 -  have "r ^c cone =o |Field r|"
   4.496 -    unfolding cexp_def cone_def Field_card_of Func_empty
   4.497 -      card_of_ordIso[symmetric] bij_betw_def Func_def inj_on_def image_def
   4.498 -    by (rule exI[of _ "\<lambda>f. f ()"]) auto
   4.499 -  also have "|Field r| =o r" by (rule card_of_Field_ordIso[OF assms])
   4.500 -  finally show ?thesis .
   4.501 -qed
   4.502 -
   4.503 -lemma cexp_cprod:
   4.504 -  assumes r1: "Card_order r1"
   4.505 -  shows "(r1 ^c r2) ^c r3 =o r1 ^c (r2 *c r3)" (is "?L =o ?R")
   4.506 -proof -
   4.507 -  have "?L =o r1 ^c (r3 *c r2)"
   4.508 -    unfolding cprod_def cexp_def Field_card_of
   4.509 -    using card_of_Func_Times by(rule ordIso_symmetric)
   4.510 -  also have "r1 ^c (r3 *c r2) =o ?R"
   4.511 -    apply(rule cexp_cong2) using cprod_com r1 by (auto simp: Card_order_cprod)
   4.512 -  finally show ?thesis .
   4.513 -qed
   4.514 -
   4.515 -lemma cprod_infinite1': "\<lbrakk>Cinfinite r; Cnotzero p; p \<le>o r\<rbrakk> \<Longrightarrow> r *c p =o r"
   4.516 -unfolding cinfinite_def cprod_def
   4.517 -by (rule Card_order_Times_infinite[THEN conjunct1]) (blast intro: czeroI)+
   4.518 -
   4.519 -lemma cexp_cprod_ordLeq:
   4.520 -  assumes r1: "Card_order r1" and r2: "Cinfinite r2"
   4.521 -  and r3: "Cnotzero r3" "r3 \<le>o r2"
   4.522 -  shows "(r1 ^c r2) ^c r3 =o r1 ^c r2" (is "?L =o ?R")
   4.523 -proof-
   4.524 -  have "?L =o r1 ^c (r2 *c r3)" using cexp_cprod[OF r1] .
   4.525 -  also have "r1 ^c (r2 *c r3) =o ?R"
   4.526 -  apply(rule cexp_cong2)
   4.527 -  apply(rule cprod_infinite1'[OF r2 r3]) using r1 r2 by (fastforce simp: Card_order_cprod)+
   4.528 -  finally show ?thesis .
   4.529 -qed
   4.530 -
   4.531 -lemma Cnotzero_UNIV: "Cnotzero |UNIV|"
   4.532 -by (auto simp: card_of_Card_order card_of_ordIso_czero_iff_empty)
   4.533 -
   4.534 -lemma ordLess_ctwo_cexp:
   4.535 -  assumes "Card_order r"
   4.536 -  shows "r <o ctwo ^c r"
   4.537 -proof -
   4.538 -  have "r <o |Pow (Field r)|" using assms by (rule Card_order_Pow)
   4.539 -  also have "|Pow (Field r)| =o ctwo ^c r"
   4.540 -    unfolding ctwo_def cexp_def Field_card_of by (rule card_of_Pow_Func)
   4.541 -  finally show ?thesis .
   4.542 -qed
   4.543 -
   4.544 -lemma ordLeq_cexp1:
   4.545 -  assumes "Cnotzero r" "Card_order q"
   4.546 -  shows "q \<le>o q ^c r"
   4.547 -proof (cases "q =o (czero :: 'a rel)")
   4.548 -  case True thus ?thesis by (simp only: card_of_empty cexp_def czero_def ordIso_ordLeq_trans)
   4.549 -next
   4.550 -  case False
   4.551 -  thus ?thesis
   4.552 -    apply -
   4.553 -    apply (rule ordIso_ordLeq_trans)
   4.554 -    apply (rule ordIso_symmetric)
   4.555 -    apply (rule cexp_cone)
   4.556 -    apply (rule assms(2))
   4.557 -    apply (rule cexp_mono2)
   4.558 -    apply (rule cone_ordLeq_Cnotzero)
   4.559 -    apply (rule assms(1))
   4.560 -    apply (rule assms(2))
   4.561 -    apply (rule notE)
   4.562 -    apply (rule cone_not_czero)
   4.563 -    apply assumption
   4.564 -    apply (rule Card_order_cone)
   4.565 -  done
   4.566 -qed
   4.567 -
   4.568 -lemma ordLeq_cexp2:
   4.569 -  assumes "ctwo \<le>o q" "Card_order r"
   4.570 -  shows "r \<le>o q ^c r"
   4.571 -proof (cases "r =o (czero :: 'a rel)")
   4.572 -  case True thus ?thesis by (simp only: card_of_empty cexp_def czero_def ordIso_ordLeq_trans)
   4.573 -next
   4.574 -  case False thus ?thesis
   4.575 -    apply -
   4.576 -    apply (rule ordLess_imp_ordLeq)
   4.577 -    apply (rule ordLess_ordLeq_trans)
   4.578 -    apply (rule ordLess_ctwo_cexp)
   4.579 -    apply (rule assms(2))
   4.580 -    apply (rule cexp_mono1)
   4.581 -    apply (rule assms(1))
   4.582 -    apply (rule assms(2))
   4.583 -  done
   4.584 -qed
   4.585 -
   4.586 -lemma cinfinite_cexp: "\<lbrakk>ctwo \<le>o q; Cinfinite r\<rbrakk> \<Longrightarrow> cinfinite (q ^c r)"
   4.587 -by (metis assms cinfinite_mono ordLeq_cexp2)
   4.588 -
   4.589 -lemma Cinfinite_cexp:
   4.590 -  "\<lbrakk>ctwo \<le>o q; Cinfinite r\<rbrakk> \<Longrightarrow> Cinfinite (q ^c r)"
   4.591 -by (simp add: cinfinite_cexp Card_order_cexp)
   4.592 -
   4.593 -lemma ctwo_ordLess_natLeq: "ctwo <o natLeq"
   4.594 -unfolding ctwo_def using finite_UNIV natLeq_cinfinite natLeq_Card_order
   4.595 -by (intro Cfinite_ordLess_Cinfinite) (auto simp: cfinite_def card_of_Card_order)
   4.596 -
   4.597 -lemma ctwo_ordLess_Cinfinite: "Cinfinite r \<Longrightarrow> ctwo <o r"
   4.598 -by (metis ctwo_ordLess_natLeq natLeq_ordLeq_cinfinite ordLess_ordLeq_trans)
   4.599 -
   4.600 -lemma ctwo_ordLeq_Cinfinite:
   4.601 -  assumes "Cinfinite r"
   4.602 -  shows "ctwo \<le>o r"
   4.603 -by (rule ordLess_imp_ordLeq[OF ctwo_ordLess_Cinfinite[OF assms]])
   4.604 -
   4.605 -lemma Un_Cinfinite_bound: "\<lbrakk>|A| \<le>o r; |B| \<le>o r; Cinfinite r\<rbrakk> \<Longrightarrow> |A \<union> B| \<le>o r"
   4.606 -by (auto simp add: cinfinite_def card_of_Un_ordLeq_infinite_Field)
   4.607 -
   4.608 -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"
   4.609 -by (auto simp add: card_of_UNION_ordLeq_infinite_Field cinfinite_def)
   4.610 -
   4.611 -lemma csum_cinfinite_bound:
   4.612 -  assumes "p \<le>o r" "q \<le>o r" "Card_order p" "Card_order q" "Cinfinite r"
   4.613 -  shows "p +c q \<le>o r"
   4.614 -proof -
   4.615 -  from assms(1-4) have "|Field p| \<le>o r" "|Field q| \<le>o r"
   4.616 -    unfolding card_order_on_def using card_of_least ordLeq_transitive by blast+
   4.617 -  with assms show ?thesis unfolding cinfinite_def csum_def
   4.618 -    by (blast intro: card_of_Plus_ordLeq_infinite_Field)
   4.619 -qed
   4.620 -
   4.621 -lemma cprod_cinfinite_bound:
   4.622 -  assumes "p \<le>o r" "q \<le>o r" "Card_order p" "Card_order q" "Cinfinite r"
   4.623 -  shows "p *c q \<le>o r"
   4.624 -proof -
   4.625 -  from assms(1-4) have "|Field p| \<le>o r" "|Field q| \<le>o r"
   4.626 -    unfolding card_order_on_def using card_of_least ordLeq_transitive by blast+
   4.627 -  with assms show ?thesis unfolding cinfinite_def cprod_def
   4.628 -    by (blast intro: card_of_Times_ordLeq_infinite_Field)
   4.629 -qed
   4.630 -
   4.631 -lemma cprod_csum_cexp:
   4.632 -  "r1 *c r2 \<le>o (r1 +c r2) ^c ctwo"
   4.633 -unfolding cprod_def csum_def cexp_def ctwo_def Field_card_of
   4.634 -proof -
   4.635 -  let ?f = "\<lambda>(a, b). %x. if x then Inl a else Inr b"
   4.636 -  have "inj_on ?f (Field r1 \<times> Field r2)" (is "inj_on _ ?LHS")
   4.637 -    by (auto simp: inj_on_def fun_eq_iff split: bool.split)
   4.638 -  moreover
   4.639 -  have "?f ` ?LHS \<subseteq> Func (UNIV :: bool set) (Field r1 <+> Field r2)" (is "_ \<subseteq> ?RHS")
   4.640 -    by (auto simp: Func_def)
   4.641 -  ultimately show "|?LHS| \<le>o |?RHS|" using card_of_ordLeq by blast
   4.642 -qed
   4.643 -
   4.644 -lemma Cfinite_cprod_Cinfinite: "\<lbrakk>Cfinite r; Cinfinite s\<rbrakk> \<Longrightarrow> r *c s \<le>o s"
   4.645 -by (intro cprod_cinfinite_bound)
   4.646 -  (auto intro: ordLeq_refl ordLess_imp_ordLeq[OF Cfinite_ordLess_Cinfinite])
   4.647 -
   4.648 -lemma cprod_cexp: "(r *c s) ^c t =o r ^c t *c s ^c t"
   4.649 -  unfolding cprod_def cexp_def Field_card_of by (rule Func_Times_Range)
   4.650 -
   4.651 -lemma cprod_cexp_csum_cexp_Cinfinite:
   4.652 -  assumes t: "Cinfinite t"
   4.653 -  shows "(r *c s) ^c t \<le>o (r +c s) ^c t"
   4.654 -proof -
   4.655 -  have "(r *c s) ^c t \<le>o ((r +c s) ^c ctwo) ^c t"
   4.656 -    by (rule cexp_mono1[OF cprod_csum_cexp conjunct2[OF t]])
   4.657 -  also have "((r +c s) ^c ctwo) ^c t =o (r +c s) ^c (ctwo *c t)"
   4.658 -    by (rule cexp_cprod[OF Card_order_csum])
   4.659 -  also have "(r +c s) ^c (ctwo *c t) =o (r +c s) ^c (t *c ctwo)"
   4.660 -    by (rule cexp_cong2[OF cprod_com Card_order_csum Card_order_cprod])
   4.661 -  also have "(r +c s) ^c (t *c ctwo) =o ((r +c s) ^c t) ^c ctwo"
   4.662 -    by (rule ordIso_symmetric[OF cexp_cprod[OF Card_order_csum]])
   4.663 -  also have "((r +c s) ^c t) ^c ctwo =o (r +c s) ^c t"
   4.664 -    by (rule cexp_cprod_ordLeq[OF Card_order_csum t ctwo_Cnotzero ctwo_ordLeq_Cinfinite[OF t]])
   4.665 -  finally show ?thesis .
   4.666 -qed
   4.667 -
   4.668 -lemma Cfinite_cexp_Cinfinite:
   4.669 -  assumes s: "Cfinite s" and t: "Cinfinite t"
   4.670 -  shows "s ^c t \<le>o ctwo ^c t"
   4.671 -proof (cases "s \<le>o ctwo")
   4.672 -  case True thus ?thesis using t by (blast intro: cexp_mono1)
   4.673 -next
   4.674 -  case False
   4.675 -  hence "ctwo \<le>o s" by (metis card_order_on_well_order_on ctwo_Cnotzero ordLeq_total s)
   4.676 -  hence "Cnotzero s" by (metis Cnotzero_mono ctwo_Cnotzero s)
   4.677 -  hence st: "Cnotzero (s *c t)" by (metis Cinfinite_cprod2 cinfinite_not_czero t)
   4.678 -  have "s ^c t \<le>o (ctwo ^c s) ^c t"
   4.679 -    using assms by (blast intro: cexp_mono1 ordLess_imp_ordLeq[OF ordLess_ctwo_cexp])
   4.680 -  also have "(ctwo ^c s) ^c t =o ctwo ^c (s *c t)"
   4.681 -    by (blast intro: Card_order_ctwo cexp_cprod)
   4.682 -  also have "ctwo ^c (s *c t) \<le>o ctwo ^c t"
   4.683 -    using assms st by (intro cexp_mono2_Cnotzero Cfinite_cprod_Cinfinite Card_order_ctwo)
   4.684 -  finally show ?thesis .
   4.685 -qed
   4.686 -
   4.687 -lemma csum_Cfinite_cexp_Cinfinite:
   4.688 -  assumes r: "Card_order r" and s: "Cfinite s" and t: "Cinfinite t"
   4.689 -  shows "(r +c s) ^c t \<le>o (r +c ctwo) ^c t"
   4.690 -proof (cases "Cinfinite r")
   4.691 -  case True
   4.692 -  hence "r +c s =o r" by (intro csum_absorb1 ordLess_imp_ordLeq[OF Cfinite_ordLess_Cinfinite] s)
   4.693 -  hence "(r +c s) ^c t =o r ^c t" using t by (blast intro: cexp_cong1)
   4.694 -  also have "r ^c t \<le>o (r +c ctwo) ^c t" using t by (blast intro: cexp_mono1 ordLeq_csum1 r)
   4.695 -  finally show ?thesis .
   4.696 -next
   4.697 -  case False
   4.698 -  with r have "Cfinite r" unfolding cinfinite_def cfinite_def by auto
   4.699 -  hence "Cfinite (r +c s)" by (intro Cfinite_csum s)
   4.700 -  hence "(r +c s) ^c t \<le>o ctwo ^c t" by (intro Cfinite_cexp_Cinfinite t)
   4.701 -  also have "ctwo ^c t \<le>o (r +c ctwo) ^c t" using t
   4.702 -    by (blast intro: cexp_mono1 ordLeq_csum2 Card_order_ctwo)
   4.703 -  finally show ?thesis .
   4.704 -qed
   4.705 -
   4.706 -(* cardSuc *)
   4.707 -
   4.708 -lemma Cinfinite_cardSuc: "Cinfinite r \<Longrightarrow> Cinfinite (cardSuc r)"
   4.709 -by (simp add: cinfinite_def cardSuc_Card_order cardSuc_finite)
   4.710 -
   4.711 -lemma cardSuc_UNION_Cinfinite:
   4.712 -  assumes "Cinfinite r" "relChain (cardSuc r) As" "B \<le> (UN i : Field (cardSuc r). As i)" "|B| <=o r"
   4.713 -  shows "EX i : Field (cardSuc r). B \<le> As i"
   4.714 -using cardSuc_UNION assms unfolding cinfinite_def by blast
   4.715 -
   4.716 -end
     5.1 --- a/src/HOL/Cardinals/Cardinal_Order_Relation_FP.thy	Mon Jan 20 16:14:19 2014 +0100
     5.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     5.3 @@ -1,1828 +0,0 @@
     5.4 -(*  Title:      HOL/Cardinals/Cardinal_Order_Relation_FP.thy
     5.5 -    Author:     Andrei Popescu, TU Muenchen
     5.6 -    Copyright   2012
     5.7 -
     5.8 -Cardinal-order relations (FP).
     5.9 -*)
    5.10 -
    5.11 -header {* Cardinal-Order Relations (FP) *}
    5.12 -
    5.13 -theory Cardinal_Order_Relation_FP
    5.14 -imports Constructions_on_Wellorders_FP
    5.15 -begin
    5.16 -
    5.17 -
    5.18 -text{* In this section, we define cardinal-order relations to be minim well-orders
    5.19 -on their field.  Then we define the cardinal of a set to be {\em some} cardinal-order
    5.20 -relation on that set, which will be unique up to order isomorphism.  Then we study
    5.21 -the connection between cardinals and:
    5.22 -\begin{itemize}
    5.23 -\item standard set-theoretic constructions: products,
    5.24 -sums, unions, lists, powersets, set-of finite sets operator;
    5.25 -\item finiteness and infiniteness (in particular, with the numeric cardinal operator
    5.26 -for finite sets, @{text "card"}, from the theory @{text "Finite_Sets.thy"}).
    5.27 -\end{itemize}
    5.28 -%
    5.29 -On the way, we define the canonical $\omega$ cardinal and finite cardinals.  We also
    5.30 -define (again, up to order isomorphism) the successor of a cardinal, and show that
    5.31 -any cardinal admits a successor.
    5.32 -
    5.33 -Main results of this section are the existence of cardinal relations and the
    5.34 -facts that, in the presence of infiniteness,
    5.35 -most of the standard set-theoretic constructions (except for the powerset)
    5.36 -{\em do not increase cardinality}.  In particular, e.g., the set of words/lists over
    5.37 -any infinite set has the same cardinality (hence, is in bijection) with that set.
    5.38 -*}
    5.39 -
    5.40 -
    5.41 -subsection {* Cardinal orders *}
    5.42 -
    5.43 -
    5.44 -text{* A cardinal order in our setting shall be a well-order {\em minim} w.r.t. the
    5.45 -order-embedding relation, @{text "\<le>o"} (which is the same as being {\em minimal} w.r.t. the
    5.46 -strict order-embedding relation, @{text "<o"}), among all the well-orders on its field.  *}
    5.47 -
    5.48 -definition card_order_on :: "'a set \<Rightarrow> 'a rel \<Rightarrow> bool"
    5.49 -where
    5.50 -"card_order_on A r \<equiv> well_order_on A r \<and> (\<forall>r'. well_order_on A r' \<longrightarrow> r \<le>o r')"
    5.51 -
    5.52 -
    5.53 -abbreviation "Card_order r \<equiv> card_order_on (Field r) r"
    5.54 -abbreviation "card_order r \<equiv> card_order_on UNIV r"
    5.55 -
    5.56 -
    5.57 -lemma card_order_on_well_order_on:
    5.58 -assumes "card_order_on A r"
    5.59 -shows "well_order_on A r"
    5.60 -using assms unfolding card_order_on_def by simp
    5.61 -
    5.62 -
    5.63 -lemma card_order_on_Card_order:
    5.64 -"card_order_on A r \<Longrightarrow> A = Field r \<and> Card_order r"
    5.65 -unfolding card_order_on_def using well_order_on_Field by blast
    5.66 -
    5.67 -
    5.68 -text{* The existence of a cardinal relation on any given set (which will mean
    5.69 -that any set has a cardinal) follows from two facts:
    5.70 -\begin{itemize}
    5.71 -\item Zermelo's theorem (proved in @{text "Zorn.thy"} as theorem @{text "well_order_on"}),
    5.72 -which states that on any given set there exists a well-order;
    5.73 -\item The well-founded-ness of @{text "<o"}, ensuring that then there exists a minimal
    5.74 -such well-order, i.e., a cardinal order.
    5.75 -\end{itemize}
    5.76 -*}
    5.77 -
    5.78 -
    5.79 -theorem card_order_on: "\<exists>r. card_order_on A r"
    5.80 -proof-
    5.81 -  obtain R where R_def: "R = {r. well_order_on A r}" by blast
    5.82 -  have 1: "R \<noteq> {} \<and> (\<forall>r \<in> R. Well_order r)"
    5.83 -  using well_order_on[of A] R_def well_order_on_Well_order by blast
    5.84 -  hence "\<exists>r \<in> R. \<forall>r' \<in> R. r \<le>o r'"
    5.85 -  using  exists_minim_Well_order[of R] by auto
    5.86 -  thus ?thesis using R_def unfolding card_order_on_def by auto
    5.87 -qed
    5.88 -
    5.89 -
    5.90 -lemma card_order_on_ordIso:
    5.91 -assumes CO: "card_order_on A r" and CO': "card_order_on A r'"
    5.92 -shows "r =o r'"
    5.93 -using assms unfolding card_order_on_def
    5.94 -using ordIso_iff_ordLeq by blast
    5.95 -
    5.96 -
    5.97 -lemma Card_order_ordIso:
    5.98 -assumes CO: "Card_order r" and ISO: "r' =o r"
    5.99 -shows "Card_order r'"
   5.100 -using ISO unfolding ordIso_def
   5.101 -proof(unfold card_order_on_def, auto)
   5.102 -  fix p' assume "well_order_on (Field r') p'"
   5.103 -  hence 0: "Well_order p' \<and> Field p' = Field r'"
   5.104 -  using well_order_on_Well_order by blast
   5.105 -  obtain f where 1: "iso r' r f" and 2: "Well_order r \<and> Well_order r'"
   5.106 -  using ISO unfolding ordIso_def by auto
   5.107 -  hence 3: "inj_on f (Field r') \<and> f ` (Field r') = Field r"
   5.108 -  by (auto simp add: iso_iff embed_inj_on)
   5.109 -  let ?p = "dir_image p' f"
   5.110 -  have 4: "p' =o ?p \<and> Well_order ?p"
   5.111 -  using 0 2 3 by (auto simp add: dir_image_ordIso Well_order_dir_image)
   5.112 -  moreover have "Field ?p =  Field r"
   5.113 -  using 0 3 by (auto simp add: dir_image_Field2 order_on_defs)
   5.114 -  ultimately have "well_order_on (Field r) ?p" by auto
   5.115 -  hence "r \<le>o ?p" using CO unfolding card_order_on_def by auto
   5.116 -  thus "r' \<le>o p'"
   5.117 -  using ISO 4 ordLeq_ordIso_trans ordIso_ordLeq_trans ordIso_symmetric by blast
   5.118 -qed
   5.119 -
   5.120 -
   5.121 -lemma Card_order_ordIso2:
   5.122 -assumes CO: "Card_order r" and ISO: "r =o r'"
   5.123 -shows "Card_order r'"
   5.124 -using assms Card_order_ordIso ordIso_symmetric by blast
   5.125 -
   5.126 -
   5.127 -subsection {* Cardinal of a set *}
   5.128 -
   5.129 -
   5.130 -text{* We define the cardinal of set to be {\em some} cardinal order on that set.
   5.131 -We shall prove that this notion is unique up to order isomorphism, meaning
   5.132 -that order isomorphism shall be the true identity of cardinals.  *}
   5.133 -
   5.134 -
   5.135 -definition card_of :: "'a set \<Rightarrow> 'a rel" ("|_|" )
   5.136 -where "card_of A = (SOME r. card_order_on A r)"
   5.137 -
   5.138 -
   5.139 -lemma card_of_card_order_on: "card_order_on A |A|"
   5.140 -unfolding card_of_def by (auto simp add: card_order_on someI_ex)
   5.141 -
   5.142 -
   5.143 -lemma card_of_well_order_on: "well_order_on A |A|"
   5.144 -using card_of_card_order_on card_order_on_def by blast
   5.145 -
   5.146 -
   5.147 -lemma Field_card_of: "Field |A| = A"
   5.148 -using card_of_card_order_on[of A] unfolding card_order_on_def
   5.149 -using well_order_on_Field by blast
   5.150 -
   5.151 -
   5.152 -lemma card_of_Card_order: "Card_order |A|"
   5.153 -by (simp only: card_of_card_order_on Field_card_of)
   5.154 -
   5.155 -
   5.156 -corollary ordIso_card_of_imp_Card_order:
   5.157 -"r =o |A| \<Longrightarrow> Card_order r"
   5.158 -using card_of_Card_order Card_order_ordIso by blast
   5.159 -
   5.160 -
   5.161 -lemma card_of_Well_order: "Well_order |A|"
   5.162 -using card_of_Card_order unfolding card_order_on_def by auto
   5.163 -
   5.164 -
   5.165 -lemma card_of_refl: "|A| =o |A|"
   5.166 -using card_of_Well_order ordIso_reflexive by blast
   5.167 -
   5.168 -
   5.169 -lemma card_of_least: "well_order_on A r \<Longrightarrow> |A| \<le>o r"
   5.170 -using card_of_card_order_on unfolding card_order_on_def by blast
   5.171 -
   5.172 -
   5.173 -lemma card_of_ordIso:
   5.174 -"(\<exists>f. bij_betw f A B) = ( |A| =o |B| )"
   5.175 -proof(auto)
   5.176 -  fix f assume *: "bij_betw f A B"
   5.177 -  then obtain r where "well_order_on B r \<and> |A| =o r"
   5.178 -  using Well_order_iso_copy card_of_well_order_on by blast
   5.179 -  hence "|B| \<le>o |A|" using card_of_least
   5.180 -  ordLeq_ordIso_trans ordIso_symmetric by blast
   5.181 -  moreover
   5.182 -  {let ?g = "inv_into A f"
   5.183 -   have "bij_betw ?g B A" using * bij_betw_inv_into by blast
   5.184 -   then obtain r where "well_order_on A r \<and> |B| =o r"
   5.185 -   using Well_order_iso_copy card_of_well_order_on by blast
   5.186 -   hence "|A| \<le>o |B|" using card_of_least
   5.187 -   ordLeq_ordIso_trans ordIso_symmetric by blast
   5.188 -  }
   5.189 -  ultimately show "|A| =o |B|" using ordIso_iff_ordLeq by blast
   5.190 -next
   5.191 -  assume "|A| =o |B|"
   5.192 -  then obtain f where "iso ( |A| ) ( |B| ) f"
   5.193 -  unfolding ordIso_def by auto
   5.194 -  hence "bij_betw f A B" unfolding iso_def Field_card_of by simp
   5.195 -  thus "\<exists>f. bij_betw f A B" by auto
   5.196 -qed
   5.197 -
   5.198 -
   5.199 -lemma card_of_ordLeq:
   5.200 -"(\<exists>f. inj_on f A \<and> f ` A \<le> B) = ( |A| \<le>o |B| )"
   5.201 -proof(auto)
   5.202 -  fix f assume *: "inj_on f A" and **: "f ` A \<le> B"
   5.203 -  {assume "|B| <o |A|"
   5.204 -   hence "|B| \<le>o |A|" using ordLeq_iff_ordLess_or_ordIso by blast
   5.205 -   then obtain g where "embed ( |B| ) ( |A| ) g"
   5.206 -   unfolding ordLeq_def by auto
   5.207 -   hence 1: "inj_on g B \<and> g ` B \<le> A" using embed_inj_on[of "|B|" "|A|" "g"]
   5.208 -   card_of_Well_order[of "B"] Field_card_of[of "B"] Field_card_of[of "A"]
   5.209 -   embed_Field[of "|B|" "|A|" g] by auto
   5.210 -   obtain h where "bij_betw h A B"
   5.211 -   using * ** 1 Cantor_Bernstein[of f] by fastforce
   5.212 -   hence "|A| =o |B|" using card_of_ordIso by blast
   5.213 -   hence "|A| \<le>o |B|" using ordIso_iff_ordLeq by auto
   5.214 -  }
   5.215 -  thus "|A| \<le>o |B|" using ordLess_or_ordLeq[of "|B|" "|A|"]
   5.216 -  by (auto simp: card_of_Well_order)
   5.217 -next
   5.218 -  assume *: "|A| \<le>o |B|"
   5.219 -  obtain f where "embed ( |A| ) ( |B| ) f"
   5.220 -  using * unfolding ordLeq_def by auto
   5.221 -  hence "inj_on f A \<and> f ` A \<le> B" using embed_inj_on[of "|A|" "|B|" f]
   5.222 -  card_of_Well_order[of "A"] Field_card_of[of "A"] Field_card_of[of "B"]
   5.223 -  embed_Field[of "|A|" "|B|" f] by auto
   5.224 -  thus "\<exists>f. inj_on f A \<and> f ` A \<le> B" by auto
   5.225 -qed
   5.226 -
   5.227 -
   5.228 -lemma card_of_ordLeq2:
   5.229 -"A \<noteq> {} \<Longrightarrow> (\<exists>g. g ` B = A) = ( |A| \<le>o |B| )"
   5.230 -using card_of_ordLeq[of A B] inj_on_iff_surj[of A B] by auto
   5.231 -
   5.232 -
   5.233 -lemma card_of_ordLess:
   5.234 -"(\<not>(\<exists>f. inj_on f A \<and> f ` A \<le> B)) = ( |B| <o |A| )"
   5.235 -proof-
   5.236 -  have "(\<not>(\<exists>f. inj_on f A \<and> f ` A \<le> B)) = (\<not> |A| \<le>o |B| )"
   5.237 -  using card_of_ordLeq by blast
   5.238 -  also have "\<dots> = ( |B| <o |A| )"
   5.239 -  using card_of_Well_order[of A] card_of_Well_order[of B]
   5.240 -        not_ordLeq_iff_ordLess by blast
   5.241 -  finally show ?thesis .
   5.242 -qed
   5.243 -
   5.244 -
   5.245 -lemma card_of_ordLess2:
   5.246 -"B \<noteq> {} \<Longrightarrow> (\<not>(\<exists>f. f ` A = B)) = ( |A| <o |B| )"
   5.247 -using card_of_ordLess[of B A] inj_on_iff_surj[of B A] by auto
   5.248 -
   5.249 -
   5.250 -lemma card_of_ordIsoI:
   5.251 -assumes "bij_betw f A B"
   5.252 -shows "|A| =o |B|"
   5.253 -using assms unfolding card_of_ordIso[symmetric] by auto
   5.254 -
   5.255 -
   5.256 -lemma card_of_ordLeqI:
   5.257 -assumes "inj_on f A" and "\<And> a. a \<in> A \<Longrightarrow> f a \<in> B"
   5.258 -shows "|A| \<le>o |B|"
   5.259 -using assms unfolding card_of_ordLeq[symmetric] by auto
   5.260 -
   5.261 -
   5.262 -lemma card_of_unique:
   5.263 -"card_order_on A r \<Longrightarrow> r =o |A|"
   5.264 -by (simp only: card_order_on_ordIso card_of_card_order_on)
   5.265 -
   5.266 -
   5.267 -lemma card_of_mono1:
   5.268 -"A \<le> B \<Longrightarrow> |A| \<le>o |B|"
   5.269 -using inj_on_id[of A] card_of_ordLeq[of A B] by fastforce
   5.270 -
   5.271 -
   5.272 -lemma card_of_mono2:
   5.273 -assumes "r \<le>o r'"
   5.274 -shows "|Field r| \<le>o |Field r'|"
   5.275 -proof-
   5.276 -  obtain f where
   5.277 -  1: "well_order_on (Field r) r \<and> well_order_on (Field r) r \<and> embed r r' f"
   5.278 -  using assms unfolding ordLeq_def
   5.279 -  by (auto simp add: well_order_on_Well_order)
   5.280 -  hence "inj_on f (Field r) \<and> f ` (Field r) \<le> Field r'"
   5.281 -  by (auto simp add: embed_inj_on embed_Field)
   5.282 -  thus "|Field r| \<le>o |Field r'|" using card_of_ordLeq by blast
   5.283 -qed
   5.284 -
   5.285 -
   5.286 -lemma card_of_cong: "r =o r' \<Longrightarrow> |Field r| =o |Field r'|"
   5.287 -by (simp add: ordIso_iff_ordLeq card_of_mono2)
   5.288 -
   5.289 -
   5.290 -lemma card_of_Field_ordLess: "Well_order r \<Longrightarrow> |Field r| \<le>o r"
   5.291 -using card_of_least card_of_well_order_on well_order_on_Well_order by blast
   5.292 -
   5.293 -
   5.294 -lemma card_of_Field_ordIso:
   5.295 -assumes "Card_order r"
   5.296 -shows "|Field r| =o r"
   5.297 -proof-
   5.298 -  have "card_order_on (Field r) r"
   5.299 -  using assms card_order_on_Card_order by blast
   5.300 -  moreover have "card_order_on (Field r) |Field r|"
   5.301 -  using card_of_card_order_on by blast
   5.302 -  ultimately show ?thesis using card_order_on_ordIso by blast
   5.303 -qed
   5.304 -
   5.305 -
   5.306 -lemma Card_order_iff_ordIso_card_of:
   5.307 -"Card_order r = (r =o |Field r| )"
   5.308 -using ordIso_card_of_imp_Card_order card_of_Field_ordIso ordIso_symmetric by blast
   5.309 -
   5.310 -
   5.311 -lemma Card_order_iff_ordLeq_card_of:
   5.312 -"Card_order r = (r \<le>o |Field r| )"
   5.313 -proof-
   5.314 -  have "Card_order r = (r =o |Field r| )"
   5.315 -  unfolding Card_order_iff_ordIso_card_of by simp
   5.316 -  also have "... = (r \<le>o |Field r| \<and> |Field r| \<le>o r)"
   5.317 -  unfolding ordIso_iff_ordLeq by simp
   5.318 -  also have "... = (r \<le>o |Field r| )"
   5.319 -  using card_of_Field_ordLess
   5.320 -  by (auto simp: card_of_Field_ordLess ordLeq_Well_order_simp)
   5.321 -  finally show ?thesis .
   5.322 -qed
   5.323 -
   5.324 -
   5.325 -lemma Card_order_iff_Restr_underS:
   5.326 -assumes "Well_order r"
   5.327 -shows "Card_order r = (\<forall>a \<in> Field r. Restr r (underS r a) <o |Field r| )"
   5.328 -using assms unfolding Card_order_iff_ordLeq_card_of
   5.329 -using ordLeq_iff_ordLess_Restr card_of_Well_order by blast
   5.330 -
   5.331 -
   5.332 -lemma card_of_underS:
   5.333 -assumes r: "Card_order r" and a: "a : Field r"
   5.334 -shows "|underS r a| <o r"
   5.335 -proof-
   5.336 -  let ?A = "underS r a"  let ?r' = "Restr r ?A"
   5.337 -  have 1: "Well_order r"
   5.338 -  using r unfolding card_order_on_def by simp
   5.339 -  have "Well_order ?r'" using 1 Well_order_Restr by auto
   5.340 -  moreover have "card_order_on (Field ?r') |Field ?r'|"
   5.341 -  using card_of_card_order_on .
   5.342 -  ultimately have "|Field ?r'| \<le>o ?r'"
   5.343 -  unfolding card_order_on_def by simp
   5.344 -  moreover have "Field ?r' = ?A"
   5.345 -  using 1 wo_rel.underS_ofilter Field_Restr_ofilter
   5.346 -  unfolding wo_rel_def by fastforce
   5.347 -  ultimately have "|?A| \<le>o ?r'" by simp
   5.348 -  also have "?r' <o |Field r|"
   5.349 -  using 1 a r Card_order_iff_Restr_underS by blast
   5.350 -  also have "|Field r| =o r"
   5.351 -  using r ordIso_symmetric unfolding Card_order_iff_ordIso_card_of by auto
   5.352 -  finally show ?thesis .
   5.353 -qed
   5.354 -
   5.355 -
   5.356 -lemma ordLess_Field:
   5.357 -assumes "r <o r'"
   5.358 -shows "|Field r| <o r'"
   5.359 -proof-
   5.360 -  have "well_order_on (Field r) r" using assms unfolding ordLess_def
   5.361 -  by (auto simp add: well_order_on_Well_order)
   5.362 -  hence "|Field r| \<le>o r" using card_of_least by blast
   5.363 -  thus ?thesis using assms ordLeq_ordLess_trans by blast
   5.364 -qed
   5.365 -
   5.366 -
   5.367 -lemma internalize_card_of_ordLeq:
   5.368 -"( |A| \<le>o r) = (\<exists>B \<le> Field r. |A| =o |B| \<and> |B| \<le>o r)"
   5.369 -proof
   5.370 -  assume "|A| \<le>o r"
   5.371 -  then obtain p where 1: "Field p \<le> Field r \<and> |A| =o p \<and> p \<le>o r"
   5.372 -  using internalize_ordLeq[of "|A|" r] by blast
   5.373 -  hence "Card_order p" using card_of_Card_order Card_order_ordIso2 by blast
   5.374 -  hence "|Field p| =o p" using card_of_Field_ordIso by blast
   5.375 -  hence "|A| =o |Field p| \<and> |Field p| \<le>o r"
   5.376 -  using 1 ordIso_equivalence ordIso_ordLeq_trans by blast
   5.377 -  thus "\<exists>B \<le> Field r. |A| =o |B| \<and> |B| \<le>o r" using 1 by blast
   5.378 -next
   5.379 -  assume "\<exists>B \<le> Field r. |A| =o |B| \<and> |B| \<le>o r"
   5.380 -  thus "|A| \<le>o r" using ordIso_ordLeq_trans by blast
   5.381 -qed
   5.382 -
   5.383 -
   5.384 -lemma internalize_card_of_ordLeq2:
   5.385 -"( |A| \<le>o |C| ) = (\<exists>B \<le> C. |A| =o |B| \<and> |B| \<le>o |C| )"
   5.386 -using internalize_card_of_ordLeq[of "A" "|C|"] Field_card_of[of C] by auto
   5.387 -
   5.388 -
   5.389 -
   5.390 -subsection {* Cardinals versus set operations on arbitrary sets *}
   5.391 -
   5.392 -
   5.393 -text{* Here we embark in a long journey of simple results showing
   5.394 -that the standard set-theoretic operations are well-behaved w.r.t. the notion of
   5.395 -cardinal -- essentially, this means that they preserve the ``cardinal identity"
   5.396 -@{text "=o"} and are monotonic w.r.t. @{text "\<le>o"}.
   5.397 -*}
   5.398 -
   5.399 -
   5.400 -lemma card_of_empty: "|{}| \<le>o |A|"
   5.401 -using card_of_ordLeq inj_on_id by blast
   5.402 -
   5.403 -
   5.404 -lemma card_of_empty1:
   5.405 -assumes "Well_order r \<or> Card_order r"
   5.406 -shows "|{}| \<le>o r"
   5.407 -proof-
   5.408 -  have "Well_order r" using assms unfolding card_order_on_def by auto
   5.409 -  hence "|Field r| <=o r"
   5.410 -  using assms card_of_Field_ordLess by blast
   5.411 -  moreover have "|{}| \<le>o |Field r|" by (simp add: card_of_empty)
   5.412 -  ultimately show ?thesis using ordLeq_transitive by blast
   5.413 -qed
   5.414 -
   5.415 -
   5.416 -corollary Card_order_empty:
   5.417 -"Card_order r \<Longrightarrow> |{}| \<le>o r" by (simp add: card_of_empty1)
   5.418 -
   5.419 -
   5.420 -lemma card_of_empty2:
   5.421 -assumes LEQ: "|A| =o |{}|"
   5.422 -shows "A = {}"
   5.423 -using assms card_of_ordIso[of A] bij_betw_empty2 by blast
   5.424 -
   5.425 -
   5.426 -lemma card_of_empty3:
   5.427 -assumes LEQ: "|A| \<le>o |{}|"
   5.428 -shows "A = {}"
   5.429 -using assms
   5.430 -by (simp add: ordIso_iff_ordLeq card_of_empty1 card_of_empty2
   5.431 -              ordLeq_Well_order_simp)
   5.432 -
   5.433 -
   5.434 -lemma card_of_empty_ordIso:
   5.435 -"|{}::'a set| =o |{}::'b set|"
   5.436 -using card_of_ordIso unfolding bij_betw_def inj_on_def by blast
   5.437 -
   5.438 -
   5.439 -lemma card_of_image:
   5.440 -"|f ` A| <=o |A|"
   5.441 -proof(cases "A = {}", simp add: card_of_empty)
   5.442 -  assume "A ~= {}"
   5.443 -  hence "f ` A ~= {}" by auto
   5.444 -  thus "|f ` A| \<le>o |A|"
   5.445 -  using card_of_ordLeq2[of "f ` A" A] by auto
   5.446 -qed
   5.447 -
   5.448 -
   5.449 -lemma surj_imp_ordLeq:
   5.450 -assumes "B <= f ` A"
   5.451 -shows "|B| <=o |A|"
   5.452 -proof-
   5.453 -  have "|B| <=o |f ` A|" using assms card_of_mono1 by auto
   5.454 -  thus ?thesis using card_of_image ordLeq_transitive by blast
   5.455 -qed
   5.456 -
   5.457 -
   5.458 -lemma card_of_ordLeqI2:
   5.459 -assumes "B \<subseteq> f ` A"
   5.460 -shows "|B| \<le>o |A|"
   5.461 -using assms by (metis surj_imp_ordLeq)
   5.462 -
   5.463 -
   5.464 -lemma card_of_singl_ordLeq:
   5.465 -assumes "A \<noteq> {}"
   5.466 -shows "|{b}| \<le>o |A|"
   5.467 -proof-
   5.468 -  obtain a where *: "a \<in> A" using assms by auto
   5.469 -  let ?h = "\<lambda> b'::'b. if b' = b then a else undefined"
   5.470 -  have "inj_on ?h {b} \<and> ?h ` {b} \<le> A"
   5.471 -  using * unfolding inj_on_def by auto
   5.472 -  thus ?thesis using card_of_ordLeq by fast
   5.473 -qed
   5.474 -
   5.475 -
   5.476 -corollary Card_order_singl_ordLeq:
   5.477 -"\<lbrakk>Card_order r; Field r \<noteq> {}\<rbrakk> \<Longrightarrow> |{b}| \<le>o r"
   5.478 -using card_of_singl_ordLeq[of "Field r" b]
   5.479 -      card_of_Field_ordIso[of r] ordLeq_ordIso_trans by blast
   5.480 -
   5.481 -
   5.482 -lemma card_of_Pow: "|A| <o |Pow A|"
   5.483 -using card_of_ordLess2[of "Pow A" A]  Cantors_paradox[of A]
   5.484 -      Pow_not_empty[of A] by auto
   5.485 -
   5.486 -
   5.487 -corollary Card_order_Pow:
   5.488 -"Card_order r \<Longrightarrow> r <o |Pow(Field r)|"
   5.489 -using card_of_Pow card_of_Field_ordIso ordIso_ordLess_trans ordIso_symmetric by blast
   5.490 -
   5.491 -
   5.492 -lemma card_of_Plus1: "|A| \<le>o |A <+> B|"
   5.493 -proof-
   5.494 -  have "Inl ` A \<le> A <+> B" by auto
   5.495 -  thus ?thesis using inj_Inl[of A] card_of_ordLeq by blast
   5.496 -qed
   5.497 -
   5.498 -
   5.499 -corollary Card_order_Plus1:
   5.500 -"Card_order r \<Longrightarrow> r \<le>o |(Field r) <+> B|"
   5.501 -using card_of_Plus1 card_of_Field_ordIso ordIso_ordLeq_trans ordIso_symmetric by blast
   5.502 -
   5.503 -
   5.504 -lemma card_of_Plus2: "|B| \<le>o |A <+> B|"
   5.505 -proof-
   5.506 -  have "Inr ` B \<le> A <+> B" by auto
   5.507 -  thus ?thesis using inj_Inr[of B] card_of_ordLeq by blast
   5.508 -qed
   5.509 -
   5.510 -
   5.511 -corollary Card_order_Plus2:
   5.512 -"Card_order r \<Longrightarrow> r \<le>o |A <+> (Field r)|"
   5.513 -using card_of_Plus2 card_of_Field_ordIso ordIso_ordLeq_trans ordIso_symmetric by blast
   5.514 -
   5.515 -
   5.516 -lemma card_of_Plus_empty1: "|A| =o |A <+> {}|"
   5.517 -proof-
   5.518 -  have "bij_betw Inl A (A <+> {})" unfolding bij_betw_def inj_on_def by auto
   5.519 -  thus ?thesis using card_of_ordIso by auto
   5.520 -qed
   5.521 -
   5.522 -
   5.523 -lemma card_of_Plus_empty2: "|A| =o |{} <+> A|"
   5.524 -proof-
   5.525 -  have "bij_betw Inr A ({} <+> A)" unfolding bij_betw_def inj_on_def by auto
   5.526 -  thus ?thesis using card_of_ordIso by auto
   5.527 -qed
   5.528 -
   5.529 -
   5.530 -lemma card_of_Plus_commute: "|A <+> B| =o |B <+> A|"
   5.531 -proof-
   5.532 -  let ?f = "\<lambda>(c::'a + 'b). case c of Inl a \<Rightarrow> Inr a
   5.533 -                                   | Inr b \<Rightarrow> Inl b"
   5.534 -  have "bij_betw ?f (A <+> B) (B <+> A)"
   5.535 -  unfolding bij_betw_def inj_on_def by force
   5.536 -  thus ?thesis using card_of_ordIso by blast
   5.537 -qed
   5.538 -
   5.539 -
   5.540 -lemma card_of_Plus_assoc:
   5.541 -fixes A :: "'a set" and B :: "'b set" and C :: "'c set"
   5.542 -shows "|(A <+> B) <+> C| =o |A <+> B <+> C|"
   5.543 -proof -
   5.544 -  def f \<equiv> "\<lambda>(k::('a + 'b) + 'c).
   5.545 -  case k of Inl ab \<Rightarrow> (case ab of Inl a \<Rightarrow> Inl a
   5.546 -                                 |Inr b \<Rightarrow> Inr (Inl b))
   5.547 -           |Inr c \<Rightarrow> Inr (Inr c)"
   5.548 -  have "A <+> B <+> C \<subseteq> f ` ((A <+> B) <+> C)"
   5.549 -  proof
   5.550 -    fix x assume x: "x \<in> A <+> B <+> C"
   5.551 -    show "x \<in> f ` ((A <+> B) <+> C)"
   5.552 -    proof(cases x)
   5.553 -      case (Inl a)
   5.554 -      hence "a \<in> A" "x = f (Inl (Inl a))"
   5.555 -      using x unfolding f_def by auto
   5.556 -      thus ?thesis by auto
   5.557 -    next
   5.558 -      case (Inr bc) note 1 = Inr show ?thesis
   5.559 -      proof(cases bc)
   5.560 -        case (Inl b)
   5.561 -        hence "b \<in> B" "x = f (Inl (Inr b))"
   5.562 -        using x 1 unfolding f_def by auto
   5.563 -        thus ?thesis by auto
   5.564 -      next
   5.565 -        case (Inr c)
   5.566 -        hence "c \<in> C" "x = f (Inr c)"
   5.567 -        using x 1 unfolding f_def by auto
   5.568 -        thus ?thesis by auto
   5.569 -      qed
   5.570 -    qed
   5.571 -  qed
   5.572 -  hence "bij_betw f ((A <+> B) <+> C) (A <+> B <+> C)"
   5.573 -  unfolding bij_betw_def inj_on_def f_def by fastforce
   5.574 -  thus ?thesis using card_of_ordIso by blast
   5.575 -qed
   5.576 -
   5.577 -
   5.578 -lemma card_of_Plus_mono1:
   5.579 -assumes "|A| \<le>o |B|"
   5.580 -shows "|A <+> C| \<le>o |B <+> C|"
   5.581 -proof-
   5.582 -  obtain f where 1: "inj_on f A \<and> f ` A \<le> B"
   5.583 -  using assms card_of_ordLeq[of A] by fastforce
   5.584 -  obtain g where g_def:
   5.585 -  "g = (\<lambda>d. case d of Inl a \<Rightarrow> Inl(f a) | Inr (c::'c) \<Rightarrow> Inr c)" by blast
   5.586 -  have "inj_on g (A <+> C) \<and> g ` (A <+> C) \<le> (B <+> C)"
   5.587 -  proof-
   5.588 -    {fix d1 and d2 assume "d1 \<in> A <+> C \<and> d2 \<in> A <+> C" and
   5.589 -                          "g d1 = g d2"
   5.590 -     hence "d1 = d2" using 1 unfolding inj_on_def g_def by force
   5.591 -    }
   5.592 -    moreover
   5.593 -    {fix d assume "d \<in> A <+> C"
   5.594 -     hence "g d \<in> B <+> C"  using 1
   5.595 -     by(case_tac d, auto simp add: g_def)
   5.596 -    }
   5.597 -    ultimately show ?thesis unfolding inj_on_def by auto
   5.598 -  qed
   5.599 -  thus ?thesis using card_of_ordLeq by metis
   5.600 -qed
   5.601 -
   5.602 -
   5.603 -corollary ordLeq_Plus_mono1:
   5.604 -assumes "r \<le>o r'"
   5.605 -shows "|(Field r) <+> C| \<le>o |(Field r') <+> C|"
   5.606 -using assms card_of_mono2 card_of_Plus_mono1 by blast
   5.607 -
   5.608 -
   5.609 -lemma card_of_Plus_mono2:
   5.610 -assumes "|A| \<le>o |B|"
   5.611 -shows "|C <+> A| \<le>o |C <+> B|"
   5.612 -using assms card_of_Plus_mono1[of A B C]
   5.613 -      card_of_Plus_commute[of C A]  card_of_Plus_commute[of B C]
   5.614 -      ordIso_ordLeq_trans[of "|C <+> A|"] ordLeq_ordIso_trans[of "|C <+> A|"]
   5.615 -by blast
   5.616 -
   5.617 -
   5.618 -corollary ordLeq_Plus_mono2:
   5.619 -assumes "r \<le>o r'"
   5.620 -shows "|A <+> (Field r)| \<le>o |A <+> (Field r')|"
   5.621 -using assms card_of_mono2 card_of_Plus_mono2 by blast
   5.622 -
   5.623 -
   5.624 -lemma card_of_Plus_mono:
   5.625 -assumes "|A| \<le>o |B|" and "|C| \<le>o |D|"
   5.626 -shows "|A <+> C| \<le>o |B <+> D|"
   5.627 -using assms card_of_Plus_mono1[of A B C] card_of_Plus_mono2[of C D B]
   5.628 -      ordLeq_transitive[of "|A <+> C|"] by blast
   5.629 -
   5.630 -
   5.631 -corollary ordLeq_Plus_mono:
   5.632 -assumes "r \<le>o r'" and "p \<le>o p'"
   5.633 -shows "|(Field r) <+> (Field p)| \<le>o |(Field r') <+> (Field p')|"
   5.634 -using assms card_of_mono2[of r r'] card_of_mono2[of p p'] card_of_Plus_mono by blast
   5.635 -
   5.636 -
   5.637 -lemma card_of_Plus_cong1:
   5.638 -assumes "|A| =o |B|"
   5.639 -shows "|A <+> C| =o |B <+> C|"
   5.640 -using assms by (simp add: ordIso_iff_ordLeq card_of_Plus_mono1)
   5.641 -
   5.642 -
   5.643 -corollary ordIso_Plus_cong1:
   5.644 -assumes "r =o r'"
   5.645 -shows "|(Field r) <+> C| =o |(Field r') <+> C|"
   5.646 -using assms card_of_cong card_of_Plus_cong1 by blast
   5.647 -
   5.648 -
   5.649 -lemma card_of_Plus_cong2:
   5.650 -assumes "|A| =o |B|"
   5.651 -shows "|C <+> A| =o |C <+> B|"
   5.652 -using assms by (simp add: ordIso_iff_ordLeq card_of_Plus_mono2)
   5.653 -
   5.654 -
   5.655 -corollary ordIso_Plus_cong2:
   5.656 -assumes "r =o r'"
   5.657 -shows "|A <+> (Field r)| =o |A <+> (Field r')|"
   5.658 -using assms card_of_cong card_of_Plus_cong2 by blast
   5.659 -
   5.660 -
   5.661 -lemma card_of_Plus_cong:
   5.662 -assumes "|A| =o |B|" and "|C| =o |D|"
   5.663 -shows "|A <+> C| =o |B <+> D|"
   5.664 -using assms by (simp add: ordIso_iff_ordLeq card_of_Plus_mono)
   5.665 -
   5.666 -
   5.667 -corollary ordIso_Plus_cong:
   5.668 -assumes "r =o r'" and "p =o p'"
   5.669 -shows "|(Field r) <+> (Field p)| =o |(Field r') <+> (Field p')|"
   5.670 -using assms card_of_cong[of r r'] card_of_cong[of p p'] card_of_Plus_cong by blast
   5.671 -
   5.672 -
   5.673 -lemma card_of_Un_Plus_ordLeq:
   5.674 -"|A \<union> B| \<le>o |A <+> B|"
   5.675 -proof-
   5.676 -   let ?f = "\<lambda> c. if c \<in> A then Inl c else Inr c"
   5.677 -   have "inj_on ?f (A \<union> B) \<and> ?f ` (A \<union> B) \<le> A <+> B"
   5.678 -   unfolding inj_on_def by auto
   5.679 -   thus ?thesis using card_of_ordLeq by blast
   5.680 -qed
   5.681 -
   5.682 -
   5.683 -lemma card_of_Times1:
   5.684 -assumes "A \<noteq> {}"
   5.685 -shows "|B| \<le>o |B \<times> A|"
   5.686 -proof(cases "B = {}", simp add: card_of_empty)
   5.687 -  assume *: "B \<noteq> {}"
   5.688 -  have "fst `(B \<times> A) = B" unfolding image_def using assms by auto
   5.689 -  thus ?thesis using inj_on_iff_surj[of B "B \<times> A"]
   5.690 -                     card_of_ordLeq[of B "B \<times> A"] * by blast
   5.691 -qed
   5.692 -
   5.693 -
   5.694 -lemma card_of_Times_commute: "|A \<times> B| =o |B \<times> A|"
   5.695 -proof-
   5.696 -  let ?f = "\<lambda>(a::'a,b::'b). (b,a)"
   5.697 -  have "bij_betw ?f (A \<times> B) (B \<times> A)"
   5.698 -  unfolding bij_betw_def inj_on_def by auto
   5.699 -  thus ?thesis using card_of_ordIso by blast
   5.700 -qed
   5.701 -
   5.702 -
   5.703 -lemma card_of_Times2:
   5.704 -assumes "A \<noteq> {}"   shows "|B| \<le>o |A \<times> B|"
   5.705 -using assms card_of_Times1[of A B] card_of_Times_commute[of B A]
   5.706 -      ordLeq_ordIso_trans by blast
   5.707 -
   5.708 -
   5.709 -corollary Card_order_Times1:
   5.710 -"\<lbrakk>Card_order r; B \<noteq> {}\<rbrakk> \<Longrightarrow> r \<le>o |(Field r) \<times> B|"
   5.711 -using card_of_Times1[of B] card_of_Field_ordIso
   5.712 -      ordIso_ordLeq_trans ordIso_symmetric by blast
   5.713 -
   5.714 -
   5.715 -corollary Card_order_Times2:
   5.716 -"\<lbrakk>Card_order r; A \<noteq> {}\<rbrakk> \<Longrightarrow> r \<le>o |A \<times> (Field r)|"
   5.717 -using card_of_Times2[of A] card_of_Field_ordIso
   5.718 -      ordIso_ordLeq_trans ordIso_symmetric by blast
   5.719 -
   5.720 -
   5.721 -lemma card_of_Times3: "|A| \<le>o |A \<times> A|"
   5.722 -using card_of_Times1[of A]
   5.723 -by(cases "A = {}", simp add: card_of_empty, blast)
   5.724 -
   5.725 -
   5.726 -lemma card_of_Plus_Times_bool: "|A <+> A| =o |A \<times> (UNIV::bool set)|"
   5.727 -proof-
   5.728 -  let ?f = "\<lambda>c::'a + 'a. case c of Inl a \<Rightarrow> (a,True)
   5.729 -                                  |Inr a \<Rightarrow> (a,False)"
   5.730 -  have "bij_betw ?f (A <+> A) (A \<times> (UNIV::bool set))"
   5.731 -  proof-
   5.732 -    {fix  c1 and c2 assume "?f c1 = ?f c2"
   5.733 -     hence "c1 = c2"
   5.734 -     by(case_tac "c1", case_tac "c2", auto, case_tac "c2", auto)
   5.735 -    }
   5.736 -    moreover
   5.737 -    {fix c assume "c \<in> A <+> A"
   5.738 -     hence "?f c \<in> A \<times> (UNIV::bool set)"
   5.739 -     by(case_tac c, auto)
   5.740 -    }
   5.741 -    moreover
   5.742 -    {fix a bl assume *: "(a,bl) \<in> A \<times> (UNIV::bool set)"
   5.743 -     have "(a,bl) \<in> ?f ` ( A <+> A)"
   5.744 -     proof(cases bl)
   5.745 -       assume bl hence "?f(Inl a) = (a,bl)" by auto
   5.746 -       thus ?thesis using * by force
   5.747 -     next
   5.748 -       assume "\<not> bl" hence "?f(Inr a) = (a,bl)" by auto
   5.749 -       thus ?thesis using * by force
   5.750 -     qed
   5.751 -    }
   5.752 -    ultimately show ?thesis unfolding bij_betw_def inj_on_def by auto
   5.753 -  qed
   5.754 -  thus ?thesis using card_of_ordIso by blast
   5.755 -qed
   5.756 -
   5.757 -
   5.758 -lemma card_of_Times_mono1:
   5.759 -assumes "|A| \<le>o |B|"
   5.760 -shows "|A \<times> C| \<le>o |B \<times> C|"
   5.761 -proof-
   5.762 -  obtain f where 1: "inj_on f A \<and> f ` A \<le> B"
   5.763 -  using assms card_of_ordLeq[of A] by fastforce
   5.764 -  obtain g where g_def:
   5.765 -  "g = (\<lambda>(a,c::'c). (f a,c))" by blast
   5.766 -  have "inj_on g (A \<times> C) \<and> g ` (A \<times> C) \<le> (B \<times> C)"
   5.767 -  using 1 unfolding inj_on_def using g_def by auto
   5.768 -  thus ?thesis using card_of_ordLeq by metis
   5.769 -qed
   5.770 -
   5.771 -
   5.772 -corollary ordLeq_Times_mono1:
   5.773 -assumes "r \<le>o r'"
   5.774 -shows "|(Field r) \<times> C| \<le>o |(Field r') \<times> C|"
   5.775 -using assms card_of_mono2 card_of_Times_mono1 by blast
   5.776 -
   5.777 -
   5.778 -lemma card_of_Times_mono2:
   5.779 -assumes "|A| \<le>o |B|"
   5.780 -shows "|C \<times> A| \<le>o |C \<times> B|"
   5.781 -using assms card_of_Times_mono1[of A B C]
   5.782 -      card_of_Times_commute[of C A]  card_of_Times_commute[of B C]
   5.783 -      ordIso_ordLeq_trans[of "|C \<times> A|"] ordLeq_ordIso_trans[of "|C \<times> A|"]
   5.784 -by blast
   5.785 -
   5.786 -
   5.787 -corollary ordLeq_Times_mono2:
   5.788 -assumes "r \<le>o r'"
   5.789 -shows "|A \<times> (Field r)| \<le>o |A \<times> (Field r')|"
   5.790 -using assms card_of_mono2 card_of_Times_mono2 by blast
   5.791 -
   5.792 -
   5.793 -lemma card_of_Sigma_mono1:
   5.794 -assumes "\<forall>i \<in> I. |A i| \<le>o |B i|"
   5.795 -shows "|SIGMA i : I. A i| \<le>o |SIGMA i : I. B i|"
   5.796 -proof-
   5.797 -  have "\<forall>i. i \<in> I \<longrightarrow> (\<exists>f. inj_on f (A i) \<and> f ` (A i) \<le> B i)"
   5.798 -  using assms by (auto simp add: card_of_ordLeq)
   5.799 -  with choice[of "\<lambda> i f. i \<in> I \<longrightarrow> inj_on f (A i) \<and> f ` (A i) \<le> B i"]
   5.800 -  obtain F where 1: "\<forall>i \<in> I. inj_on (F i) (A i) \<and> (F i) ` (A i) \<le> B i" by metis
   5.801 -  obtain g where g_def: "g = (\<lambda>(i,a::'b). (i,F i a))" by blast
   5.802 -  have "inj_on g (Sigma I A) \<and> g ` (Sigma I A) \<le> (Sigma I B)"
   5.803 -  using 1 unfolding inj_on_def using g_def by force
   5.804 -  thus ?thesis using card_of_ordLeq by metis
   5.805 -qed
   5.806 -
   5.807 -
   5.808 -corollary card_of_Sigma_Times:
   5.809 -"\<forall>i \<in> I. |A i| \<le>o |B| \<Longrightarrow> |SIGMA i : I. A i| \<le>o |I \<times> B|"
   5.810 -using card_of_Sigma_mono1[of I A "\<lambda>i. B"] .
   5.811 -
   5.812 -
   5.813 -lemma card_of_UNION_Sigma:
   5.814 -"|\<Union>i \<in> I. A i| \<le>o |SIGMA i : I. A i|"
   5.815 -using Ex_inj_on_UNION_Sigma[of I A] card_of_ordLeq by metis
   5.816 -
   5.817 -
   5.818 -lemma card_of_bool:
   5.819 -assumes "a1 \<noteq> a2"
   5.820 -shows "|UNIV::bool set| =o |{a1,a2}|"
   5.821 -proof-
   5.822 -  let ?f = "\<lambda> bl. case bl of True \<Rightarrow> a1 | False \<Rightarrow> a2"
   5.823 -  have "bij_betw ?f UNIV {a1,a2}"
   5.824 -  proof-
   5.825 -    {fix bl1 and bl2 assume "?f  bl1 = ?f bl2"
   5.826 -     hence "bl1 = bl2" using assms by (case_tac bl1, case_tac bl2, auto)
   5.827 -    }
   5.828 -    moreover
   5.829 -    {fix bl have "?f bl \<in> {a1,a2}" by (case_tac bl, auto)
   5.830 -    }
   5.831 -    moreover
   5.832 -    {fix a assume *: "a \<in> {a1,a2}"
   5.833 -     have "a \<in> ?f ` UNIV"
   5.834 -     proof(cases "a = a1")
   5.835 -       assume "a = a1"
   5.836 -       hence "?f True = a" by auto  thus ?thesis by blast
   5.837 -     next
   5.838 -       assume "a \<noteq> a1" hence "a = a2" using * by auto
   5.839 -       hence "?f False = a" by auto  thus ?thesis by blast
   5.840 -     qed
   5.841 -    }
   5.842 -    ultimately show ?thesis unfolding bij_betw_def inj_on_def
   5.843 -    by (metis image_subsetI order_eq_iff subsetI)
   5.844 -  qed
   5.845 -  thus ?thesis using card_of_ordIso by blast
   5.846 -qed
   5.847 -
   5.848 -
   5.849 -lemma card_of_Plus_Times_aux:
   5.850 -assumes A2: "a1 \<noteq> a2 \<and> {a1,a2} \<le> A" and
   5.851 -        LEQ: "|A| \<le>o |B|"
   5.852 -shows "|A <+> B| \<le>o |A \<times> B|"
   5.853 -proof-
   5.854 -  have 1: "|UNIV::bool set| \<le>o |A|"
   5.855 -  using A2 card_of_mono1[of "{a1,a2}"] card_of_bool[of a1 a2]
   5.856 -        ordIso_ordLeq_trans[of "|UNIV::bool set|"] by metis
   5.857 -  (*  *)
   5.858 -  have "|A <+> B| \<le>o |B <+> B|"
   5.859 -  using LEQ card_of_Plus_mono1 by blast
   5.860 -  moreover have "|B <+> B| =o |B \<times> (UNIV::bool set)|"
   5.861 -  using card_of_Plus_Times_bool by blast
   5.862 -  moreover have "|B \<times> (UNIV::bool set)| \<le>o |B \<times> A|"
   5.863 -  using 1 by (simp add: card_of_Times_mono2)
   5.864 -  moreover have " |B \<times> A| =o |A \<times> B|"
   5.865 -  using card_of_Times_commute by blast
   5.866 -  ultimately show "|A <+> B| \<le>o |A \<times> B|"
   5.867 -  using ordLeq_ordIso_trans[of "|A <+> B|" "|B <+> B|" "|B \<times> (UNIV::bool set)|"]
   5.868 -        ordLeq_transitive[of "|A <+> B|" "|B \<times> (UNIV::bool set)|" "|B \<times> A|"]
   5.869 -        ordLeq_ordIso_trans[of "|A <+> B|" "|B \<times> A|" "|A \<times> B|"]
   5.870 -  by blast
   5.871 -qed
   5.872 -
   5.873 -
   5.874 -lemma card_of_Plus_Times:
   5.875 -assumes A2: "a1 \<noteq> a2 \<and> {a1,a2} \<le> A" and
   5.876 -        B2: "b1 \<noteq> b2 \<and> {b1,b2} \<le> B"
   5.877 -shows "|A <+> B| \<le>o |A \<times> B|"
   5.878 -proof-
   5.879 -  {assume "|A| \<le>o |B|"
   5.880 -   hence ?thesis using assms by (auto simp add: card_of_Plus_Times_aux)
   5.881 -  }
   5.882 -  moreover
   5.883 -  {assume "|B| \<le>o |A|"
   5.884 -   hence "|B <+> A| \<le>o |B \<times> A|"
   5.885 -   using assms by (auto simp add: card_of_Plus_Times_aux)
   5.886 -   hence ?thesis
   5.887 -   using card_of_Plus_commute card_of_Times_commute
   5.888 -         ordIso_ordLeq_trans ordLeq_ordIso_trans by metis
   5.889 -  }
   5.890 -  ultimately show ?thesis
   5.891 -  using card_of_Well_order[of A] card_of_Well_order[of B]
   5.892 -        ordLeq_total[of "|A|"] by metis
   5.893 -qed
   5.894 -
   5.895 -
   5.896 -lemma card_of_ordLeq_finite:
   5.897 -assumes "|A| \<le>o |B|" and "finite B"
   5.898 -shows "finite A"
   5.899 -using assms unfolding ordLeq_def
   5.900 -using embed_inj_on[of "|A|" "|B|"]  embed_Field[of "|A|" "|B|"]
   5.901 -      Field_card_of[of "A"] Field_card_of[of "B"] inj_on_finite[of _ "A" "B"] by fastforce
   5.902 -
   5.903 -
   5.904 -lemma card_of_ordLeq_infinite:
   5.905 -assumes "|A| \<le>o |B|" and "\<not> finite A"
   5.906 -shows "\<not> finite B"
   5.907 -using assms card_of_ordLeq_finite by auto
   5.908 -
   5.909 -
   5.910 -lemma card_of_ordIso_finite:
   5.911 -assumes "|A| =o |B|"
   5.912 -shows "finite A = finite B"
   5.913 -using assms unfolding ordIso_def iso_def[abs_def]
   5.914 -by (auto simp: bij_betw_finite Field_card_of)
   5.915 -
   5.916 -
   5.917 -lemma card_of_ordIso_finite_Field:
   5.918 -assumes "Card_order r" and "r =o |A|"
   5.919 -shows "finite(Field r) = finite A"
   5.920 -using assms card_of_Field_ordIso card_of_ordIso_finite ordIso_equivalence by blast
   5.921 -
   5.922 -
   5.923 -subsection {* Cardinals versus set operations involving infinite sets *}
   5.924 -
   5.925 -
   5.926 -text{* Here we show that, for infinite sets, most set-theoretic constructions
   5.927 -do not increase the cardinality.  The cornerstone for this is
   5.928 -theorem @{text "Card_order_Times_same_infinite"}, which states that self-product
   5.929 -does not increase cardinality -- the proof of this fact adapts a standard
   5.930 -set-theoretic argument, as presented, e.g., in the proof of theorem 1.5.11
   5.931 -at page 47 in \cite{card-book}. Then everything else follows fairly easily.  *}
   5.932 -
   5.933 -
   5.934 -lemma infinite_iff_card_of_nat:
   5.935 -"\<not> finite A \<longleftrightarrow> ( |UNIV::nat set| \<le>o |A| )"
   5.936 -unfolding infinite_iff_countable_subset card_of_ordLeq ..
   5.937 -
   5.938 -text{* The next two results correspond to the ZF fact that all infinite cardinals are
   5.939 -limit ordinals: *}
   5.940 -
   5.941 -lemma Card_order_infinite_not_under:
   5.942 -assumes CARD: "Card_order r" and INF: "\<not>finite (Field r)"
   5.943 -shows "\<not> (\<exists>a. Field r = under r a)"
   5.944 -proof(auto)
   5.945 -  have 0: "Well_order r \<and> wo_rel r \<and> Refl r"
   5.946 -  using CARD unfolding wo_rel_def card_order_on_def order_on_defs by auto
   5.947 -  fix a assume *: "Field r = under r a"
   5.948 -  show False
   5.949 -  proof(cases "a \<in> Field r")
   5.950 -    assume Case1: "a \<notin> Field r"
   5.951 -    hence "under r a = {}" unfolding Field_def under_def by auto
   5.952 -    thus False using INF *  by auto
   5.953 -  next
   5.954 -    let ?r' = "Restr r (underS r a)"
   5.955 -    assume Case2: "a \<in> Field r"
   5.956 -    hence 1: "under r a = underS r a \<union> {a} \<and> a \<notin> underS r a"
   5.957 -    using 0 Refl_under_underS underS_notIn by metis
   5.958 -    have 2: "wo_rel.ofilter r (underS r a) \<and> underS r a < Field r"
   5.959 -    using 0 wo_rel.underS_ofilter * 1 Case2 by fast
   5.960 -    hence "?r' <o r" using 0 using ofilter_ordLess by blast
   5.961 -    moreover
   5.962 -    have "Field ?r' = underS r a \<and> Well_order ?r'"
   5.963 -    using  2 0 Field_Restr_ofilter[of r] Well_order_Restr[of r] by blast
   5.964 -    ultimately have "|underS r a| <o r" using ordLess_Field[of ?r'] by auto
   5.965 -    moreover have "|under r a| =o r" using * CARD card_of_Field_ordIso[of r] by auto
   5.966 -    ultimately have "|underS r a| <o |under r a|"
   5.967 -    using ordIso_symmetric ordLess_ordIso_trans by blast
   5.968 -    moreover
   5.969 -    {have "\<exists>f. bij_betw f (under r a) (underS r a)"
   5.970 -     using infinite_imp_bij_betw[of "Field r" a] INF * 1 by auto
   5.971 -     hence "|under r a| =o |underS r a|" using card_of_ordIso by blast
   5.972 -    }
   5.973 -    ultimately show False using not_ordLess_ordIso ordIso_symmetric by blast
   5.974 -  qed
   5.975 -qed
   5.976 -
   5.977 -
   5.978 -lemma infinite_Card_order_limit:
   5.979 -assumes r: "Card_order r" and "\<not>finite (Field r)"
   5.980 -and a: "a : Field r"
   5.981 -shows "EX b : Field r. a \<noteq> b \<and> (a,b) : r"
   5.982 -proof-
   5.983 -  have "Field r \<noteq> under r a"
   5.984 -  using assms Card_order_infinite_not_under by blast
   5.985 -  moreover have "under r a \<le> Field r"
   5.986 -  using under_Field .
   5.987 -  ultimately have "under r a < Field r" by blast
   5.988 -  then obtain b where 1: "b : Field r \<and> ~ (b,a) : r"
   5.989 -  unfolding under_def by blast
   5.990 -  moreover have ba: "b \<noteq> a"
   5.991 -  using 1 r unfolding card_order_on_def well_order_on_def
   5.992 -  linear_order_on_def partial_order_on_def preorder_on_def refl_on_def by auto
   5.993 -  ultimately have "(a,b) : r"
   5.994 -  using a r unfolding card_order_on_def well_order_on_def linear_order_on_def
   5.995 -  total_on_def by blast
   5.996 -  thus ?thesis using 1 ba by auto
   5.997 -qed
   5.998 -
   5.999 -
  5.1000 -theorem Card_order_Times_same_infinite:
  5.1001 -assumes CO: "Card_order r" and INF: "\<not>finite(Field r)"
  5.1002 -shows "|Field r \<times> Field r| \<le>o r"
  5.1003 -proof-
  5.1004 -  obtain phi where phi_def:
  5.1005 -  "phi = (\<lambda>r::'a rel. Card_order r \<and> \<not>finite(Field r) \<and>
  5.1006 -                      \<not> |Field r \<times> Field r| \<le>o r )" by blast
  5.1007 -  have temp1: "\<forall>r. phi r \<longrightarrow> Well_order r"
  5.1008 -  unfolding phi_def card_order_on_def by auto
  5.1009 -  have Ft: "\<not>(\<exists>r. phi r)"
  5.1010 -  proof
  5.1011 -    assume "\<exists>r. phi r"
  5.1012 -    hence "{r. phi r} \<noteq> {} \<and> {r. phi r} \<le> {r. Well_order r}"
  5.1013 -    using temp1 by auto
  5.1014 -    then obtain r where 1: "phi r" and 2: "\<forall>r'. phi r' \<longrightarrow> r \<le>o r'" and
  5.1015 -                   3: "Card_order r \<and> Well_order r"
  5.1016 -    using exists_minim_Well_order[of "{r. phi r}"] temp1 phi_def by blast
  5.1017 -    let ?A = "Field r"  let ?r' = "bsqr r"
  5.1018 -    have 4: "Well_order ?r' \<and> Field ?r' = ?A \<times> ?A \<and> |?A| =o r"
  5.1019 -    using 3 bsqr_Well_order Field_bsqr card_of_Field_ordIso by blast
  5.1020 -    have 5: "Card_order |?A \<times> ?A| \<and> Well_order |?A \<times> ?A|"
  5.1021 -    using card_of_Card_order card_of_Well_order by blast
  5.1022 -    (*  *)
  5.1023 -    have "r <o |?A \<times> ?A|"
  5.1024 -    using 1 3 5 ordLess_or_ordLeq unfolding phi_def by blast
  5.1025 -    moreover have "|?A \<times> ?A| \<le>o ?r'"
  5.1026 -    using card_of_least[of "?A \<times> ?A"] 4 by auto
  5.1027 -    ultimately have "r <o ?r'" using ordLess_ordLeq_trans by auto
  5.1028 -    then obtain f where 6: "embed r ?r' f" and 7: "\<not> bij_betw f ?A (?A \<times> ?A)"
  5.1029 -    unfolding ordLess_def embedS_def[abs_def]
  5.1030 -    by (auto simp add: Field_bsqr)
  5.1031 -    let ?B = "f ` ?A"
  5.1032 -    have "|?A| =o |?B|"
  5.1033 -    using 3 6 embed_inj_on inj_on_imp_bij_betw card_of_ordIso by blast
  5.1034 -    hence 8: "r =o |?B|" using 4 ordIso_transitive ordIso_symmetric by blast
  5.1035 -    (*  *)
  5.1036 -    have "wo_rel.ofilter ?r' ?B"
  5.1037 -    using 6 embed_Field_ofilter 3 4 by blast
  5.1038 -    hence "wo_rel.ofilter ?r' ?B \<and> ?B \<noteq> ?A \<times> ?A \<and> ?B \<noteq> Field ?r'"
  5.1039 -    using 7 unfolding bij_betw_def using 6 3 embed_inj_on 4 by auto
  5.1040 -    hence temp2: "wo_rel.ofilter ?r' ?B \<and> ?B < ?A \<times> ?A"
  5.1041 -    using 4 wo_rel_def[of ?r'] wo_rel.ofilter_def[of ?r' ?B] by blast
  5.1042 -    have "\<not> (\<exists>a. Field r = under r a)"
  5.1043 -    using 1 unfolding phi_def using Card_order_infinite_not_under[of r] by auto
  5.1044 -    then obtain A1 where temp3: "wo_rel.ofilter r A1 \<and> A1 < ?A" and 9: "?B \<le> A1 \<times> A1"
  5.1045 -    using temp2 3 bsqr_ofilter[of r ?B] by blast
  5.1046 -    hence "|?B| \<le>o |A1 \<times> A1|" using card_of_mono1 by blast
  5.1047 -    hence 10: "r \<le>o |A1 \<times> A1|" using 8 ordIso_ordLeq_trans by blast
  5.1048 -    let ?r1 = "Restr r A1"
  5.1049 -    have "?r1 <o r" using temp3 ofilter_ordLess 3 by blast
  5.1050 -    moreover
  5.1051 -    {have "well_order_on A1 ?r1" using 3 temp3 well_order_on_Restr by blast
  5.1052 -     hence "|A1| \<le>o ?r1" using 3 Well_order_Restr card_of_least by blast
  5.1053 -    }
  5.1054 -    ultimately have 11: "|A1| <o r" using ordLeq_ordLess_trans by blast
  5.1055 -    (*  *)
  5.1056 -    have "\<not> finite (Field r)" using 1 unfolding phi_def by simp
  5.1057 -    hence "\<not> finite ?B" using 8 3 card_of_ordIso_finite_Field[of r ?B] by blast
  5.1058 -    hence "\<not> finite A1" using 9 finite_cartesian_product finite_subset by metis
  5.1059 -    moreover have temp4: "Field |A1| = A1 \<and> Well_order |A1| \<and> Card_order |A1|"
  5.1060 -    using card_of_Card_order[of A1] card_of_Well_order[of A1]
  5.1061 -    by (simp add: Field_card_of)
  5.1062 -    moreover have "\<not> r \<le>o | A1 |"
  5.1063 -    using temp4 11 3 using not_ordLeq_iff_ordLess by blast
  5.1064 -    ultimately have "\<not> finite(Field |A1| ) \<and> Card_order |A1| \<and> \<not> r \<le>o | A1 |"
  5.1065 -    by (simp add: card_of_card_order_on)
  5.1066 -    hence "|Field |A1| \<times> Field |A1| | \<le>o |A1|"
  5.1067 -    using 2 unfolding phi_def by blast
  5.1068 -    hence "|A1 \<times> A1 | \<le>o |A1|" using temp4 by auto
  5.1069 -    hence "r \<le>o |A1|" using 10 ordLeq_transitive by blast
  5.1070 -    thus False using 11 not_ordLess_ordLeq by auto
  5.1071 -  qed
  5.1072 -  thus ?thesis using assms unfolding phi_def by blast
  5.1073 -qed
  5.1074 -
  5.1075 -
  5.1076 -corollary card_of_Times_same_infinite:
  5.1077 -assumes "\<not>finite A"
  5.1078 -shows "|A \<times> A| =o |A|"
  5.1079 -proof-
  5.1080 -  let ?r = "|A|"
  5.1081 -  have "Field ?r = A \<and> Card_order ?r"
  5.1082 -  using Field_card_of card_of_Card_order[of A] by fastforce
  5.1083 -  hence "|A \<times> A| \<le>o |A|"
  5.1084 -  using Card_order_Times_same_infinite[of ?r] assms by auto
  5.1085 -  thus ?thesis using card_of_Times3 ordIso_iff_ordLeq by blast
  5.1086 -qed
  5.1087 -
  5.1088 -
  5.1089 -lemma card_of_Times_infinite:
  5.1090 -assumes INF: "\<not>finite A" and NE: "B \<noteq> {}" and LEQ: "|B| \<le>o |A|"
  5.1091 -shows "|A \<times> B| =o |A| \<and> |B \<times> A| =o |A|"
  5.1092 -proof-
  5.1093 -  have "|A| \<le>o |A \<times> B| \<and> |A| \<le>o |B \<times> A|"
  5.1094 -  using assms by (simp add: card_of_Times1 card_of_Times2)
  5.1095 -  moreover
  5.1096 -  {have "|A \<times> B| \<le>o |A \<times> A| \<and> |B \<times> A| \<le>o |A \<times> A|"
  5.1097 -   using LEQ card_of_Times_mono1 card_of_Times_mono2 by blast
  5.1098 -   moreover have "|A \<times> A| =o |A|" using INF card_of_Times_same_infinite by blast
  5.1099 -   ultimately have "|A \<times> B| \<le>o |A| \<and> |B \<times> A| \<le>o |A|"
  5.1100 -   using ordLeq_ordIso_trans[of "|A \<times> B|"] ordLeq_ordIso_trans[of "|B \<times> A|"] by auto
  5.1101 -  }
  5.1102 -  ultimately show ?thesis by (simp add: ordIso_iff_ordLeq)
  5.1103 -qed
  5.1104 -
  5.1105 -
  5.1106 -corollary Card_order_Times_infinite:
  5.1107 -assumes INF: "\<not>finite(Field r)" and CARD: "Card_order r" and
  5.1108 -        NE: "Field p \<noteq> {}" and LEQ: "p \<le>o r"
  5.1109 -shows "| (Field r) \<times> (Field p) | =o r \<and> | (Field p) \<times> (Field r) | =o r"
  5.1110 -proof-
  5.1111 -  have "|Field r \<times> Field p| =o |Field r| \<and> |Field p \<times> Field r| =o |Field r|"
  5.1112 -  using assms by (simp add: card_of_Times_infinite card_of_mono2)
  5.1113 -  thus ?thesis
  5.1114 -  using assms card_of_Field_ordIso[of r]
  5.1115 -        ordIso_transitive[of "|Field r \<times> Field p|"]
  5.1116 -        ordIso_transitive[of _ "|Field r|"] by blast
  5.1117 -qed
  5.1118 -
  5.1119 -
  5.1120 -lemma card_of_Sigma_ordLeq_infinite:
  5.1121 -assumes INF: "\<not>finite B" and
  5.1122 -        LEQ_I: "|I| \<le>o |B|" and LEQ: "\<forall>i \<in> I. |A i| \<le>o |B|"
  5.1123 -shows "|SIGMA i : I. A i| \<le>o |B|"
  5.1124 -proof(cases "I = {}", simp add: card_of_empty)
  5.1125 -  assume *: "I \<noteq> {}"
  5.1126 -  have "|SIGMA i : I. A i| \<le>o |I \<times> B|"
  5.1127 -  using LEQ card_of_Sigma_Times by blast
  5.1128 -  moreover have "|I \<times> B| =o |B|"
  5.1129 -  using INF * LEQ_I by (auto simp add: card_of_Times_infinite)
  5.1130 -  ultimately show ?thesis using ordLeq_ordIso_trans by blast
  5.1131 -qed
  5.1132 -
  5.1133 -
  5.1134 -lemma card_of_Sigma_ordLeq_infinite_Field:
  5.1135 -assumes INF: "\<not>finite (Field r)" and r: "Card_order r" and
  5.1136 -        LEQ_I: "|I| \<le>o r" and LEQ: "\<forall>i \<in> I. |A i| \<le>o r"
  5.1137 -shows "|SIGMA i : I. A i| \<le>o r"
  5.1138 -proof-
  5.1139 -  let ?B  = "Field r"
  5.1140 -  have 1: "r =o |?B| \<and> |?B| =o r" using r card_of_Field_ordIso
  5.1141 -  ordIso_symmetric by blast
  5.1142 -  hence "|I| \<le>o |?B|"  "\<forall>i \<in> I. |A i| \<le>o |?B|"
  5.1143 -  using LEQ_I LEQ ordLeq_ordIso_trans by blast+
  5.1144 -  hence  "|SIGMA i : I. A i| \<le>o |?B|" using INF LEQ
  5.1145 -  card_of_Sigma_ordLeq_infinite by blast
  5.1146 -  thus ?thesis using 1 ordLeq_ordIso_trans by blast
  5.1147 -qed
  5.1148 -
  5.1149 -
  5.1150 -lemma card_of_Times_ordLeq_infinite_Field:
  5.1151 -"\<lbrakk>\<not>finite (Field r); |A| \<le>o r; |B| \<le>o r; Card_order r\<rbrakk>
  5.1152 - \<Longrightarrow> |A <*> B| \<le>o r"
  5.1153 -by(simp add: card_of_Sigma_ordLeq_infinite_Field)
  5.1154 -
  5.1155 -
  5.1156 -lemma card_of_Times_infinite_simps:
  5.1157 -"\<lbrakk>\<not>finite A; B \<noteq> {}; |B| \<le>o |A|\<rbrakk> \<Longrightarrow> |A \<times> B| =o |A|"
  5.1158 -"\<lbrakk>\<not>finite A; B \<noteq> {}; |B| \<le>o |A|\<rbrakk> \<Longrightarrow> |A| =o |A \<times> B|"
  5.1159 -"\<lbrakk>\<not>finite A; B \<noteq> {}; |B| \<le>o |A|\<rbrakk> \<Longrightarrow> |B \<times> A| =o |A|"
  5.1160 -"\<lbrakk>\<not>finite A; B \<noteq> {}; |B| \<le>o |A|\<rbrakk> \<Longrightarrow> |A| =o |B \<times> A|"
  5.1161 -by (auto simp add: card_of_Times_infinite ordIso_symmetric)
  5.1162 -
  5.1163 -
  5.1164 -lemma card_of_UNION_ordLeq_infinite:
  5.1165 -assumes INF: "\<not>finite B" and
  5.1166 -        LEQ_I: "|I| \<le>o |B|" and LEQ: "\<forall>i \<in> I. |A i| \<le>o |B|"
  5.1167 -shows "|\<Union> i \<in> I. A i| \<le>o |B|"
  5.1168 -proof(cases "I = {}", simp add: card_of_empty)
  5.1169 -  assume *: "I \<noteq> {}"
  5.1170 -  have "|\<Union> i \<in> I. A i| \<le>o |SIGMA i : I. A i|"
  5.1171 -  using card_of_UNION_Sigma by blast
  5.1172 -  moreover have "|SIGMA i : I. A i| \<le>o |B|"
  5.1173 -  using assms card_of_Sigma_ordLeq_infinite by blast
  5.1174 -  ultimately show ?thesis using ordLeq_transitive by blast
  5.1175 -qed
  5.1176 -
  5.1177 -
  5.1178 -corollary card_of_UNION_ordLeq_infinite_Field:
  5.1179 -assumes INF: "\<not>finite (Field r)" and r: "Card_order r" and
  5.1180 -        LEQ_I: "|I| \<le>o r" and LEQ: "\<forall>i \<in> I. |A i| \<le>o r"
  5.1181 -shows "|\<Union> i \<in> I. A i| \<le>o r"
  5.1182 -proof-
  5.1183 -  let ?B  = "Field r"
  5.1184 -  have 1: "r =o |?B| \<and> |?B| =o r" using r card_of_Field_ordIso
  5.1185 -  ordIso_symmetric by blast
  5.1186 -  hence "|I| \<le>o |?B|"  "\<forall>i \<in> I. |A i| \<le>o |?B|"
  5.1187 -  using LEQ_I LEQ ordLeq_ordIso_trans by blast+
  5.1188 -  hence  "|\<Union> i \<in> I. A i| \<le>o |?B|" using INF LEQ
  5.1189 -  card_of_UNION_ordLeq_infinite by blast
  5.1190 -  thus ?thesis using 1 ordLeq_ordIso_trans by blast
  5.1191 -qed
  5.1192 -
  5.1193 -
  5.1194 -lemma card_of_Plus_infinite1:
  5.1195 -assumes INF: "\<not>finite A" and LEQ: "|B| \<le>o |A|"
  5.1196 -shows "|A <+> B| =o |A|"
  5.1197 -proof(cases "B = {}", simp add: card_of_Plus_empty1 card_of_Plus_empty2 ordIso_symmetric)
  5.1198 -  let ?Inl = "Inl::'a \<Rightarrow> 'a + 'b"  let ?Inr = "Inr::'b \<Rightarrow> 'a + 'b"
  5.1199 -  assume *: "B \<noteq> {}"
  5.1200 -  then obtain b1 where 1: "b1 \<in> B" by blast
  5.1201 -  show ?thesis
  5.1202 -  proof(cases "B = {b1}")
  5.1203 -    assume Case1: "B = {b1}"
  5.1204 -    have 2: "bij_betw ?Inl A ((?Inl ` A))"
  5.1205 -    unfolding bij_betw_def inj_on_def by auto
  5.1206 -    hence 3: "\<not>finite (?Inl ` A)"
  5.1207 -    using INF bij_betw_finite[of ?Inl A] by blast
  5.1208 -    let ?A' = "?Inl ` A \<union> {?Inr b1}"
  5.1209 -    obtain g where "bij_betw g (?Inl ` A) ?A'"
  5.1210 -    using 3 infinite_imp_bij_betw2[of "?Inl ` A"] by auto
  5.1211 -    moreover have "?A' = A <+> B" using Case1 by blast
  5.1212 -    ultimately have "bij_betw g (?Inl ` A) (A <+> B)" by simp
  5.1213 -    hence "bij_betw (g o ?Inl) A (A <+> B)"
  5.1214 -    using 2 by (auto simp add: bij_betw_trans)
  5.1215 -    thus ?thesis using card_of_ordIso ordIso_symmetric by blast
  5.1216 -  next
  5.1217 -    assume Case2: "B \<noteq> {b1}"
  5.1218 -    with * 1 obtain b2 where 3: "b1 \<noteq> b2 \<and> {b1,b2} \<le> B" by fastforce
  5.1219 -    obtain f where "inj_on f B \<and> f ` B \<le> A"
  5.1220 -    using LEQ card_of_ordLeq[of B] by fastforce
  5.1221 -    with 3 have "f b1 \<noteq> f b2 \<and> {f b1, f b2} \<le> A"
  5.1222 -    unfolding inj_on_def by auto
  5.1223 -    with 3 have "|A <+> B| \<le>o |A \<times> B|"
  5.1224 -    by (auto simp add: card_of_Plus_Times)
  5.1225 -    moreover have "|A \<times> B| =o |A|"
  5.1226 -    using assms * by (simp add: card_of_Times_infinite_simps)
  5.1227 -    ultimately have "|A <+> B| \<le>o |A|" using ordLeq_ordIso_trans by metis
  5.1228 -    thus ?thesis using card_of_Plus1 ordIso_iff_ordLeq by blast
  5.1229 -  qed
  5.1230 -qed
  5.1231 -
  5.1232 -
  5.1233 -lemma card_of_Plus_infinite2:
  5.1234 -assumes INF: "\<not>finite A" and LEQ: "|B| \<le>o |A|"
  5.1235 -shows "|B <+> A| =o |A|"
  5.1236 -using assms card_of_Plus_commute card_of_Plus_infinite1
  5.1237 -ordIso_equivalence by blast
  5.1238 -
  5.1239 -
  5.1240 -lemma card_of_Plus_infinite:
  5.1241 -assumes INF: "\<not>finite A" and LEQ: "|B| \<le>o |A|"
  5.1242 -shows "|A <+> B| =o |A| \<and> |B <+> A| =o |A|"
  5.1243 -using assms by (auto simp: card_of_Plus_infinite1 card_of_Plus_infinite2)
  5.1244 -
  5.1245 -
  5.1246 -corollary Card_order_Plus_infinite:
  5.1247 -assumes INF: "\<not>finite(Field r)" and CARD: "Card_order r" and
  5.1248 -        LEQ: "p \<le>o r"
  5.1249 -shows "| (Field r) <+> (Field p) | =o r \<and> | (Field p) <+> (Field r) | =o r"
  5.1250 -proof-
  5.1251 -  have "| Field r <+> Field p | =o | Field r | \<and>
  5.1252 -        | Field p <+> Field r | =o | Field r |"
  5.1253 -  using assms by (simp add: card_of_Plus_infinite card_of_mono2)
  5.1254 -  thus ?thesis
  5.1255 -  using assms card_of_Field_ordIso[of r]
  5.1256 -        ordIso_transitive[of "|Field r <+> Field p|"]
  5.1257 -        ordIso_transitive[of _ "|Field r|"] by blast
  5.1258 -qed
  5.1259 -
  5.1260 -
  5.1261 -subsection {* The cardinal $\omega$ and the finite cardinals  *}
  5.1262 -
  5.1263 -
  5.1264 -text{* The cardinal $\omega$, of natural numbers, shall be the standard non-strict
  5.1265 -order relation on
  5.1266 -@{text "nat"}, that we abbreviate by @{text "natLeq"}.  The finite cardinals
  5.1267 -shall be the restrictions of these relations to the numbers smaller than
  5.1268 -fixed numbers @{text "n"}, that we abbreviate by @{text "natLeq_on n"}.  *}
  5.1269 -
  5.1270 -abbreviation "(natLeq::(nat * nat) set) \<equiv> {(x,y). x \<le> y}"
  5.1271 -abbreviation "(natLess::(nat * nat) set) \<equiv> {(x,y). x < y}"
  5.1272 -
  5.1273 -abbreviation natLeq_on :: "nat \<Rightarrow> (nat * nat) set"
  5.1274 -where "natLeq_on n \<equiv> {(x,y). x < n \<and> y < n \<and> x \<le> y}"
  5.1275 -
  5.1276 -lemma infinite_cartesian_product:
  5.1277 -assumes "\<not>finite A" "\<not>finite B"
  5.1278 -shows "\<not>finite (A \<times> B)"
  5.1279 -proof
  5.1280 -  assume "finite (A \<times> B)"
  5.1281 -  from assms(1) have "A \<noteq> {}" by auto
  5.1282 -  with `finite (A \<times> B)` have "finite B" using finite_cartesian_productD2 by auto
  5.1283 -  with assms(2) show False by simp
  5.1284 -qed
  5.1285 -
  5.1286 -
  5.1287 -subsubsection {* First as well-orders *}
  5.1288 -
  5.1289 -
  5.1290 -lemma Field_natLeq: "Field natLeq = (UNIV::nat set)"
  5.1291 -by(unfold Field_def, auto)
  5.1292 -
  5.1293 -
  5.1294 -lemma natLeq_Refl: "Refl natLeq"
  5.1295 -unfolding refl_on_def Field_def by auto
  5.1296 -
  5.1297 -
  5.1298 -lemma natLeq_trans: "trans natLeq"
  5.1299 -unfolding trans_def by auto
  5.1300 -
  5.1301 -
  5.1302 -lemma natLeq_Preorder: "Preorder natLeq"
  5.1303 -unfolding preorder_on_def
  5.1304 -by (auto simp add: natLeq_Refl natLeq_trans)
  5.1305 -
  5.1306 -
  5.1307 -lemma natLeq_antisym: "antisym natLeq"
  5.1308 -unfolding antisym_def by auto
  5.1309 -
  5.1310 -
  5.1311 -lemma natLeq_Partial_order: "Partial_order natLeq"
  5.1312 -unfolding partial_order_on_def
  5.1313 -by (auto simp add: natLeq_Preorder natLeq_antisym)
  5.1314 -
  5.1315 -
  5.1316 -lemma natLeq_Total: "Total natLeq"
  5.1317 -unfolding total_on_def by auto
  5.1318 -
  5.1319 -
  5.1320 -lemma natLeq_Linear_order: "Linear_order natLeq"
  5.1321 -unfolding linear_order_on_def
  5.1322 -by (auto simp add: natLeq_Partial_order natLeq_Total)
  5.1323 -
  5.1324 -
  5.1325 -lemma natLeq_natLess_Id: "natLess = natLeq - Id"
  5.1326 -by auto
  5.1327 -
  5.1328 -
  5.1329 -lemma natLeq_Well_order: "Well_order natLeq"
  5.1330 -unfolding well_order_on_def
  5.1331 -using natLeq_Linear_order wf_less natLeq_natLess_Id by auto
  5.1332 -
  5.1333 -
  5.1334 -lemma Field_natLeq_on: "Field (natLeq_on n) = {x. x < n}"
  5.1335 -unfolding Field_def by auto
  5.1336 -
  5.1337 -
  5.1338 -lemma natLeq_underS_less: "underS natLeq n = {x. x < n}"
  5.1339 -unfolding underS_def by auto
  5.1340 -
  5.1341 -
  5.1342 -lemma Restr_natLeq: "Restr natLeq {x. x < n} = natLeq_on n"
  5.1343 -by force
  5.1344 -
  5.1345 -
  5.1346 -lemma Restr_natLeq2:
  5.1347 -"Restr natLeq (underS natLeq n) = natLeq_on n"
  5.1348 -by (auto simp add: Restr_natLeq natLeq_underS_less)
  5.1349 -
  5.1350 -
  5.1351 -lemma natLeq_on_Well_order: "Well_order(natLeq_on n)"
  5.1352 -using Restr_natLeq[of n] natLeq_Well_order
  5.1353 -      Well_order_Restr[of natLeq "{x. x < n}"] by auto
  5.1354 -
  5.1355 -
  5.1356 -corollary natLeq_on_well_order_on: "well_order_on {x. x < n} (natLeq_on n)"
  5.1357 -using natLeq_on_Well_order Field_natLeq_on by auto
  5.1358 -
  5.1359 -
  5.1360 -lemma natLeq_on_wo_rel: "wo_rel(natLeq_on n)"
  5.1361 -unfolding wo_rel_def using natLeq_on_Well_order .
  5.1362 -
  5.1363 -
  5.1364 -
  5.1365 -subsubsection {* Then as cardinals *}
  5.1366 -
  5.1367 -
  5.1368 -lemma natLeq_Card_order: "Card_order natLeq"
  5.1369 -proof(auto simp add: natLeq_Well_order
  5.1370 -      Card_order_iff_Restr_underS Restr_natLeq2, simp add:  Field_natLeq)
  5.1371 -  fix n have "finite(Field (natLeq_on n))" by (auto simp: Field_def)
  5.1372 -  moreover have "\<not>finite(UNIV::nat set)" by auto
  5.1373 -  ultimately show "natLeq_on n <o |UNIV::nat set|"
  5.1374 -  using finite_ordLess_infinite[of "natLeq_on n" "|UNIV::nat set|"]
  5.1375 -        Field_card_of[of "UNIV::nat set"]
  5.1376 -        card_of_Well_order[of "UNIV::nat set"] natLeq_on_Well_order[of n] by auto
  5.1377 -qed
  5.1378 -
  5.1379 -
  5.1380 -corollary card_of_Field_natLeq:
  5.1381 -"|Field natLeq| =o natLeq"
  5.1382 -using Field_natLeq natLeq_Card_order Card_order_iff_ordIso_card_of[of natLeq]
  5.1383 -      ordIso_symmetric[of natLeq] by blast
  5.1384 -
  5.1385 -
  5.1386 -corollary card_of_nat:
  5.1387 -"|UNIV::nat set| =o natLeq"
  5.1388 -using Field_natLeq card_of_Field_natLeq by auto
  5.1389 -
  5.1390 -
  5.1391 -corollary infinite_iff_natLeq_ordLeq:
  5.1392 -"\<not>finite A = ( natLeq \<le>o |A| )"
  5.1393 -using infinite_iff_card_of_nat[of A] card_of_nat
  5.1394 -      ordIso_ordLeq_trans ordLeq_ordIso_trans ordIso_symmetric by blast
  5.1395 -
  5.1396 -corollary finite_iff_ordLess_natLeq:
  5.1397 -"finite A = ( |A| <o natLeq)"
  5.1398 -using infinite_iff_natLeq_ordLeq not_ordLeq_iff_ordLess
  5.1399 -      card_of_Well_order natLeq_Well_order by metis
  5.1400 -
  5.1401 -
  5.1402 -subsection {* The successor of a cardinal *}
  5.1403 -
  5.1404 -
  5.1405 -text{* First we define @{text "isCardSuc r r'"}, the notion of @{text "r'"}
  5.1406 -being a successor cardinal of @{text "r"}. Although the definition does
  5.1407 -not require @{text "r"} to be a cardinal, only this case will be meaningful.  *}
  5.1408 -
  5.1409 -
  5.1410 -definition isCardSuc :: "'a rel \<Rightarrow> 'a set rel \<Rightarrow> bool"
  5.1411 -where
  5.1412 -"isCardSuc r r' \<equiv>
  5.1413 - Card_order r' \<and> r <o r' \<and>
  5.1414 - (\<forall>(r''::'a set rel). Card_order r'' \<and> r <o r'' \<longrightarrow> r' \<le>o r'')"
  5.1415 -
  5.1416 -
  5.1417 -text{* Now we introduce the cardinal-successor operator @{text "cardSuc"},
  5.1418 -by picking {\em some} cardinal-order relation fulfilling @{text "isCardSuc"}.
  5.1419 -Again, the picked item shall be proved unique up to order-isomorphism. *}
  5.1420 -
  5.1421 -
  5.1422 -definition cardSuc :: "'a rel \<Rightarrow> 'a set rel"
  5.1423 -where
  5.1424 -"cardSuc r \<equiv> SOME r'. isCardSuc r r'"
  5.1425 -
  5.1426 -
  5.1427 -lemma exists_minim_Card_order:
  5.1428 -"\<lbrakk>R \<noteq> {}; \<forall>r \<in> R. Card_order r\<rbrakk> \<Longrightarrow> \<exists>r \<in> R. \<forall>r' \<in> R. r \<le>o r'"
  5.1429 -unfolding card_order_on_def using exists_minim_Well_order by blast
  5.1430 -
  5.1431 -
  5.1432 -lemma exists_isCardSuc:
  5.1433 -assumes "Card_order r"
  5.1434 -shows "\<exists>r'. isCardSuc r r'"
  5.1435 -proof-
  5.1436 -  let ?R = "{(r'::'a set rel). Card_order r' \<and> r <o r'}"
  5.1437 -  have "|Pow(Field r)| \<in> ?R \<and> (\<forall>r \<in> ?R. Card_order r)" using assms
  5.1438 -  by (simp add: card_of_Card_order Card_order_Pow)
  5.1439 -  then obtain r where "r \<in> ?R \<and> (\<forall>r' \<in> ?R. r \<le>o r')"
  5.1440 -  using exists_minim_Card_order[of ?R] by blast
  5.1441 -  thus ?thesis unfolding isCardSuc_def by auto
  5.1442 -qed
  5.1443 -
  5.1444 -
  5.1445 -lemma cardSuc_isCardSuc:
  5.1446 -assumes "Card_order r"
  5.1447 -shows "isCardSuc r (cardSuc r)"
  5.1448 -unfolding cardSuc_def using assms
  5.1449 -by (simp add: exists_isCardSuc someI_ex)
  5.1450 -
  5.1451 -
  5.1452 -lemma cardSuc_Card_order:
  5.1453 -"Card_order r \<Longrightarrow> Card_order(cardSuc r)"
  5.1454 -using cardSuc_isCardSuc unfolding isCardSuc_def by blast
  5.1455 -
  5.1456 -
  5.1457 -lemma cardSuc_greater:
  5.1458 -"Card_order r \<Longrightarrow> r <o cardSuc r"
  5.1459 -using cardSuc_isCardSuc unfolding isCardSuc_def by blast
  5.1460 -
  5.1461 -
  5.1462 -lemma cardSuc_ordLeq:
  5.1463 -"Card_order r \<Longrightarrow> r \<le>o cardSuc r"
  5.1464 -using cardSuc_greater ordLeq_iff_ordLess_or_ordIso by blast
  5.1465 -
  5.1466 -
  5.1467 -text{* The minimality property of @{text "cardSuc"} originally present in its definition
  5.1468 -is local to the type @{text "'a set rel"}, i.e., that of @{text "cardSuc r"}:  *}
  5.1469 -
  5.1470 -lemma cardSuc_least_aux:
  5.1471 -"\<lbrakk>Card_order (r::'a rel); Card_order (r'::'a set rel); r <o r'\<rbrakk> \<Longrightarrow> cardSuc r \<le>o r'"
  5.1472 -using cardSuc_isCardSuc unfolding isCardSuc_def by blast
  5.1473 -
  5.1474 -
  5.1475 -text{* But from this we can infer general minimality: *}
  5.1476 -
  5.1477 -lemma cardSuc_least:
  5.1478 -assumes CARD: "Card_order r" and CARD': "Card_order r'" and LESS: "r <o r'"
  5.1479 -shows "cardSuc r \<le>o r'"
  5.1480 -proof-
  5.1481 -  let ?p = "cardSuc r"
  5.1482 -  have 0: "Well_order ?p \<and> Well_order r'"
  5.1483 -  using assms cardSuc_Card_order unfolding card_order_on_def by blast
  5.1484 -  {assume "r' <o ?p"
  5.1485 -   then obtain r'' where 1: "Field r'' < Field ?p" and 2: "r' =o r'' \<and> r'' <o ?p"
  5.1486 -   using internalize_ordLess[of r' ?p] by blast
  5.1487 -   (*  *)
  5.1488 -   have "Card_order r''" using CARD' Card_order_ordIso2 2 by blast
  5.1489 -   moreover have "r <o r''" using LESS 2 ordLess_ordIso_trans by blast
  5.1490 -   ultimately have "?p \<le>o r''" using cardSuc_least_aux CARD by blast
  5.1491 -   hence False using 2 not_ordLess_ordLeq by blast
  5.1492 -  }
  5.1493 -  thus ?thesis using 0 ordLess_or_ordLeq by blast
  5.1494 -qed
  5.1495 -
  5.1496 -
  5.1497 -lemma cardSuc_ordLess_ordLeq:
  5.1498 -assumes CARD: "Card_order r" and CARD': "Card_order r'"
  5.1499 -shows "(r <o r') = (cardSuc r \<le>o r')"
  5.1500 -proof(auto simp add: assms cardSuc_least)
  5.1501 -  assume "cardSuc r \<le>o r'"
  5.1502 -  thus "r <o r'" using assms cardSuc_greater ordLess_ordLeq_trans by blast
  5.1503 -qed
  5.1504 -
  5.1505 -
  5.1506 -lemma cardSuc_ordLeq_ordLess:
  5.1507 -assumes CARD: "Card_order r" and CARD': "Card_order r'"
  5.1508 -shows "(r' <o cardSuc r) = (r' \<le>o r)"
  5.1509 -proof-
  5.1510 -  have "Well_order r \<and> Well_order r'"
  5.1511 -  using assms unfolding card_order_on_def by auto
  5.1512 -  moreover have "Well_order(cardSuc r)"
  5.1513 -  using assms cardSuc_Card_order card_order_on_def by blast
  5.1514 -  ultimately show ?thesis
  5.1515 -  using assms cardSuc_ordLess_ordLeq[of r r']
  5.1516 -  not_ordLeq_iff_ordLess[of r r'] not_ordLeq_iff_ordLess[of r' "cardSuc r"] by blast
  5.1517 -qed
  5.1518 -
  5.1519 -
  5.1520 -lemma cardSuc_mono_ordLeq:
  5.1521 -assumes CARD: "Card_order r" and CARD': "Card_order r'"
  5.1522 -shows "(cardSuc r \<le>o cardSuc r') = (r \<le>o r')"
  5.1523 -using assms cardSuc_ordLeq_ordLess cardSuc_ordLess_ordLeq cardSuc_Card_order by blast
  5.1524 -
  5.1525 -
  5.1526 -lemma cardSuc_invar_ordIso:
  5.1527 -assumes CARD: "Card_order r" and CARD': "Card_order r'"
  5.1528 -shows "(cardSuc r =o cardSuc r') = (r =o r')"
  5.1529 -proof-
  5.1530 -  have 0: "Well_order r \<and> Well_order r' \<and> Well_order(cardSuc r) \<and> Well_order(cardSuc r')"
  5.1531 -  using assms by (simp add: card_order_on_well_order_on cardSuc_Card_order)
  5.1532 -  thus ?thesis
  5.1533 -  using ordIso_iff_ordLeq[of r r'] ordIso_iff_ordLeq
  5.1534 -  using cardSuc_mono_ordLeq[of r r'] cardSuc_mono_ordLeq[of r' r] assms by blast
  5.1535 -qed
  5.1536 -
  5.1537 -
  5.1538 -lemma card_of_cardSuc_finite:
  5.1539 -"finite(Field(cardSuc |A| )) = finite A"
  5.1540 -proof
  5.1541 -  assume *: "finite (Field (cardSuc |A| ))"
  5.1542 -  have 0: "|Field(cardSuc |A| )| =o cardSuc |A|"
  5.1543 -  using card_of_Card_order cardSuc_Card_order card_of_Field_ordIso by blast
  5.1544 -  hence "|A| \<le>o |Field(cardSuc |A| )|"
  5.1545 -  using card_of_Card_order[of A] cardSuc_ordLeq[of "|A|"] ordIso_symmetric
  5.1546 -  ordLeq_ordIso_trans by blast
  5.1547 -  thus "finite A" using * card_of_ordLeq_finite by blast
  5.1548 -next
  5.1549 -  assume "finite A"
  5.1550 -  then have "finite ( Field |Pow A| )" unfolding Field_card_of by simp
  5.1551 -  then show "finite (Field (cardSuc |A| ))"
  5.1552 -  proof (rule card_of_ordLeq_finite[OF card_of_mono2, rotated])
  5.1553 -    show "cardSuc |A| \<le>o |Pow A|"
  5.1554 -      by (metis cardSuc_ordLess_ordLeq card_of_Card_order card_of_Pow)
  5.1555 -  qed
  5.1556 -qed
  5.1557 -
  5.1558 -
  5.1559 -lemma cardSuc_finite:
  5.1560 -assumes "Card_order r"
  5.1561 -shows "finite (Field (cardSuc r)) = finite (Field r)"
  5.1562 -proof-
  5.1563 -  let ?A = "Field r"
  5.1564 -  have "|?A| =o r" using assms by (simp add: card_of_Field_ordIso)
  5.1565 -  hence "cardSuc |?A| =o cardSuc r" using assms
  5.1566 -  by (simp add: card_of_Card_order cardSuc_invar_ordIso)
  5.1567 -  moreover have "|Field (cardSuc |?A| ) | =o cardSuc |?A|"
  5.1568 -  by (simp add: card_of_card_order_on Field_card_of card_of_Field_ordIso cardSuc_Card_order)
  5.1569 -  moreover
  5.1570 -  {have "|Field (cardSuc r) | =o cardSuc r"
  5.1571 -   using assms by (simp add: card_of_Field_ordIso cardSuc_Card_order)
  5.1572 -   hence "cardSuc r =o |Field (cardSuc r) |"
  5.1573 -   using ordIso_symmetric by blast
  5.1574 -  }
  5.1575 -  ultimately have "|Field (cardSuc |?A| ) | =o |Field (cardSuc r) |"
  5.1576 -  using ordIso_transitive by blast
  5.1577 -  hence "finite (Field (cardSuc |?A| )) = finite (Field (cardSuc r))"
  5.1578 -  using card_of_ordIso_finite by blast
  5.1579 -  thus ?thesis by (simp only: card_of_cardSuc_finite)
  5.1580 -qed
  5.1581 -
  5.1582 -
  5.1583 -lemma card_of_Plus_ordLess_infinite:
  5.1584 -assumes INF: "\<not>finite C" and
  5.1585 -        LESS1: "|A| <o |C|" and LESS2: "|B| <o |C|"
  5.1586 -shows "|A <+> B| <o |C|"
  5.1587 -proof(cases "A = {} \<or> B = {}")
  5.1588 -  assume Case1: "A = {} \<or> B = {}"
  5.1589 -  hence "|A| =o |A <+> B| \<or> |B| =o |A <+> B|"
  5.1590 -  using card_of_Plus_empty1 card_of_Plus_empty2 by blast
  5.1591 -  hence "|A <+> B| =o |A| \<or> |A <+> B| =o |B|"
  5.1592 -  using ordIso_symmetric[of "|A|"] ordIso_symmetric[of "|B|"] by blast
  5.1593 -  thus ?thesis using LESS1 LESS2
  5.1594 -       ordIso_ordLess_trans[of "|A <+> B|" "|A|"]
  5.1595 -       ordIso_ordLess_trans[of "|A <+> B|" "|B|"] by blast
  5.1596 -next
  5.1597 -  assume Case2: "\<not>(A = {} \<or> B = {})"
  5.1598 -  {assume *: "|C| \<le>o |A <+> B|"
  5.1599 -   hence "\<not>finite (A <+> B)" using INF card_of_ordLeq_finite by blast
  5.1600 -   hence 1: "\<not>finite A \<or> \<not>finite B" using finite_Plus by blast
  5.1601 -   {assume Case21: "|A| \<le>o |B|"
  5.1602 -    hence "\<not>finite B" using 1 card_of_ordLeq_finite by blast
  5.1603 -    hence "|A <+> B| =o |B|" using Case2 Case21
  5.1604 -    by (auto simp add: card_of_Plus_infinite)
  5.1605 -    hence False using LESS2 not_ordLess_ordLeq * ordLeq_ordIso_trans by blast
  5.1606 -   }
  5.1607 -   moreover
  5.1608 -   {assume Case22: "|B| \<le>o |A|"
  5.1609 -    hence "\<not>finite A" using 1 card_of_ordLeq_finite by blast
  5.1610 -    hence "|A <+> B| =o |A|" using Case2 Case22
  5.1611 -    by (auto simp add: card_of_Plus_infinite)
  5.1612 -    hence False using LESS1 not_ordLess_ordLeq * ordLeq_ordIso_trans by blast
  5.1613 -   }
  5.1614 -   ultimately have False using ordLeq_total card_of_Well_order[of A]
  5.1615 -   card_of_Well_order[of B] by blast
  5.1616 -  }
  5.1617 -  thus ?thesis using ordLess_or_ordLeq[of "|A <+> B|" "|C|"]
  5.1618 -  card_of_Well_order[of "A <+> B"] card_of_Well_order[of "C"] by auto
  5.1619 -qed
  5.1620 -
  5.1621 -
  5.1622 -lemma card_of_Plus_ordLess_infinite_Field:
  5.1623 -assumes INF: "\<not>finite (Field r)" and r: "Card_order r" and
  5.1624 -        LESS1: "|A| <o r" and LESS2: "|B| <o r"
  5.1625 -shows "|A <+> B| <o r"
  5.1626 -proof-
  5.1627 -  let ?C  = "Field r"
  5.1628 -  have 1: "r =o |?C| \<and> |?C| =o r" using r card_of_Field_ordIso
  5.1629 -  ordIso_symmetric by blast
  5.1630 -  hence "|A| <o |?C|"  "|B| <o |?C|"
  5.1631 -  using LESS1 LESS2 ordLess_ordIso_trans by blast+
  5.1632 -  hence  "|A <+> B| <o |?C|" using INF
  5.1633 -  card_of_Plus_ordLess_infinite by blast
  5.1634 -  thus ?thesis using 1 ordLess_ordIso_trans by blast
  5.1635 -qed
  5.1636 -
  5.1637 -
  5.1638 -lemma card_of_Plus_ordLeq_infinite_Field:
  5.1639 -assumes r: "\<not>finite (Field r)" and A: "|A| \<le>o r" and B: "|B| \<le>o r"
  5.1640 -and c: "Card_order r"
  5.1641 -shows "|A <+> B| \<le>o r"
  5.1642 -proof-
  5.1643 -  let ?r' = "cardSuc r"
  5.1644 -  have "Card_order ?r' \<and> \<not>finite (Field ?r')" using assms
  5.1645 -  by (simp add: cardSuc_Card_order cardSuc_finite)
  5.1646 -  moreover have "|A| <o ?r'" and "|B| <o ?r'" using A B c
  5.1647 -  by (auto simp: card_of_card_order_on Field_card_of cardSuc_ordLeq_ordLess)
  5.1648 -  ultimately have "|A <+> B| <o ?r'"
  5.1649 -  using card_of_Plus_ordLess_infinite_Field by blast
  5.1650 -  thus ?thesis using c r
  5.1651 -  by (simp add: card_of_card_order_on Field_card_of cardSuc_ordLeq_ordLess)
  5.1652 -qed
  5.1653 -
  5.1654 -
  5.1655 -lemma card_of_Un_ordLeq_infinite_Field:
  5.1656 -assumes C: "\<not>finite (Field r)" and A: "|A| \<le>o r" and B: "|B| \<le>o r"
  5.1657 -and "Card_order r"
  5.1658 -shows "|A Un B| \<le>o r"
  5.1659 -using assms card_of_Plus_ordLeq_infinite_Field card_of_Un_Plus_ordLeq
  5.1660 -ordLeq_transitive by fast
  5.1661 -
  5.1662 -
  5.1663 -
  5.1664 -subsection {* Regular cardinals *}
  5.1665 -
  5.1666 -
  5.1667 -definition cofinal where
  5.1668 -"cofinal A r \<equiv>
  5.1669 - ALL a : Field r. EX b : A. a \<noteq> b \<and> (a,b) : r"
  5.1670 -
  5.1671 -
  5.1672 -definition regular where
  5.1673 -"regular r \<equiv>
  5.1674 - ALL K. K \<le> Field r \<and> cofinal K r \<longrightarrow> |K| =o r"
  5.1675 -
  5.1676 -
  5.1677 -definition relChain where
  5.1678 -"relChain r As \<equiv>
  5.1679 - ALL i j. (i,j) \<in> r \<longrightarrow> As i \<le> As j"
  5.1680 -
  5.1681 -lemma regular_UNION:
  5.1682 -assumes r: "Card_order r"   "regular r"
  5.1683 -and As: "relChain r As"
  5.1684 -and Bsub: "B \<le> (UN i : Field r. As i)"
  5.1685 -and cardB: "|B| <o r"
  5.1686 -shows "EX i : Field r. B \<le> As i"
  5.1687 -proof-
  5.1688 -  let ?phi = "%b j. j : Field r \<and> b : As j"
  5.1689 -  have "ALL b : B. EX j. ?phi b j" using Bsub by blast
  5.1690 -  then obtain f where f: "!! b. b : B \<Longrightarrow> ?phi b (f b)"
  5.1691 -  using bchoice[of B ?phi] by blast
  5.1692 -  let ?K = "f ` B"
  5.1693 -  {assume 1: "!! i. i : Field r \<Longrightarrow> ~ B \<le> As i"
  5.1694 -   have 2: "cofinal ?K r"
  5.1695 -   unfolding cofinal_def proof auto
  5.1696 -     fix i assume i: "i : Field r"
  5.1697 -     with 1 obtain b where b: "b : B \<and> b \<notin> As i" by blast
  5.1698 -     hence "i \<noteq> f b \<and> ~ (f b,i) : r"
  5.1699 -     using As f unfolding relChain_def by auto
  5.1700 -     hence "i \<noteq> f b \<and> (i, f b) : r" using r
  5.1701 -     unfolding card_order_on_def well_order_on_def linear_order_on_def
  5.1702 -     total_on_def using i f b by auto
  5.1703 -     with b show "\<exists>b\<in>B. i \<noteq> f b \<and> (i, f b) \<in> r" by blast
  5.1704 -   qed
  5.1705 -   moreover have "?K \<le> Field r" using f by blast
  5.1706 -   ultimately have "|?K| =o r" using 2 r unfolding regular_def by blast
  5.1707 -   moreover
  5.1708 -   {
  5.1709 -    have "|?K| <=o |B|" using card_of_image .
  5.1710 -    hence "|?K| <o r" using cardB ordLeq_ordLess_trans by blast
  5.1711 -   }
  5.1712 -   ultimately have False using not_ordLess_ordIso by blast
  5.1713 -  }
  5.1714 -  thus ?thesis by blast
  5.1715 -qed
  5.1716 -
  5.1717 -
  5.1718 -lemma infinite_cardSuc_regular:
  5.1719 -assumes r_inf: "\<not>finite (Field r)" and r_card: "Card_order r"
  5.1720 -shows "regular (cardSuc r)"
  5.1721 -proof-
  5.1722 -  let ?r' = "cardSuc r"
  5.1723 -  have r': "Card_order ?r'"
  5.1724 -  "!! p. Card_order p \<longrightarrow> (p \<le>o r) = (p <o ?r')"
  5.1725 -  using r_card by (auto simp: cardSuc_Card_order cardSuc_ordLeq_ordLess)
  5.1726 -  show ?thesis
  5.1727 -  unfolding regular_def proof auto
  5.1728 -    fix K assume 1: "K \<le> Field ?r'" and 2: "cofinal K ?r'"
  5.1729 -    hence "|K| \<le>o |Field ?r'|" by (simp only: card_of_mono1)
  5.1730 -    also have 22: "|Field ?r'| =o ?r'"
  5.1731 -    using r' by (simp add: card_of_Field_ordIso[of ?r'])
  5.1732 -    finally have "|K| \<le>o ?r'" .
  5.1733 -    moreover
  5.1734 -    {let ?L = "UN j : K. underS ?r' j"
  5.1735 -     let ?J = "Field r"
  5.1736 -     have rJ: "r =o |?J|"
  5.1737 -     using r_card card_of_Field_ordIso ordIso_symmetric by blast
  5.1738 -     assume "|K| <o ?r'"
  5.1739 -     hence "|K| <=o r" using r' card_of_Card_order[of K] by blast
  5.1740 -     hence "|K| \<le>o |?J|" using rJ ordLeq_ordIso_trans by blast
  5.1741 -     moreover
  5.1742 -     {have "ALL j : K. |underS ?r' j| <o ?r'"
  5.1743 -      using r' 1 by (auto simp: card_of_underS)
  5.1744 -      hence "ALL j : K. |underS ?r' j| \<le>o r"
  5.1745 -      using r' card_of_Card_order by blast
  5.1746 -      hence "ALL j : K. |underS ?r' j| \<le>o |?J|"
  5.1747 -      using rJ ordLeq_ordIso_trans by blast
  5.1748 -     }
  5.1749 -     ultimately have "|?L| \<le>o |?J|"
  5.1750 -     using r_inf card_of_UNION_ordLeq_infinite by blast
  5.1751 -     hence "|?L| \<le>o r" using rJ ordIso_symmetric ordLeq_ordIso_trans by blast
  5.1752 -     hence "|?L| <o ?r'" using r' card_of_Card_order by blast
  5.1753 -     moreover
  5.1754 -     {
  5.1755 -      have "Field ?r' \<le> ?L"
  5.1756 -      using 2 unfolding underS_def cofinal_def by auto
  5.1757 -      hence "|Field ?r'| \<le>o |?L|" by (simp add: card_of_mono1)
  5.1758 -      hence "?r' \<le>o |?L|"
  5.1759 -      using 22 ordIso_ordLeq_trans ordIso_symmetric by blast
  5.1760 -     }
  5.1761 -     ultimately have "|?L| <o |?L|" using ordLess_ordLeq_trans by blast
  5.1762 -     hence False using ordLess_irreflexive by blast
  5.1763 -    }
  5.1764 -    ultimately show "|K| =o ?r'"
  5.1765 -    unfolding ordLeq_iff_ordLess_or_ordIso by blast
  5.1766 -  qed
  5.1767 -qed
  5.1768 -
  5.1769 -lemma cardSuc_UNION:
  5.1770 -assumes r: "Card_order r" and "\<not>finite (Field r)"
  5.1771 -and As: "relChain (cardSuc r) As"
  5.1772 -and Bsub: "B \<le> (UN i : Field (cardSuc r). As i)"
  5.1773 -and cardB: "|B| <=o r"
  5.1774 -shows "EX i : Field (cardSuc r). B \<le> As i"
  5.1775 -proof-
  5.1776 -  let ?r' = "cardSuc r"
  5.1777 -  have "Card_order ?r' \<and> |B| <o ?r'"
  5.1778 -  using r cardB cardSuc_ordLeq_ordLess cardSuc_Card_order
  5.1779 -  card_of_Card_order by blast
  5.1780 -  moreover have "regular ?r'"
  5.1781 -  using assms by(simp add: infinite_cardSuc_regular)
  5.1782 -  ultimately show ?thesis
  5.1783 -  using As Bsub cardB regular_UNION by blast
  5.1784 -qed
  5.1785 -
  5.1786 -
  5.1787 -subsection {* Others *}
  5.1788 -
  5.1789 -lemma card_of_Func_Times:
  5.1790 -"|Func (A <*> B) C| =o |Func A (Func B C)|"
  5.1791 -unfolding card_of_ordIso[symmetric]
  5.1792 -using bij_betw_curr by blast
  5.1793 -
  5.1794 -lemma card_of_Pow_Func:
  5.1795 -"|Pow A| =o |Func A (UNIV::bool set)|"
  5.1796 -proof-
  5.1797 -  def F \<equiv> "\<lambda> A' a. if a \<in> A then (if a \<in> A' then True else False)
  5.1798 -                            else undefined"
  5.1799 -  have "bij_betw F (Pow A) (Func A (UNIV::bool set))"
  5.1800 -  unfolding bij_betw_def inj_on_def proof (intro ballI impI conjI)
  5.1801 -    fix A1 A2 assume "A1 \<in> Pow A" "A2 \<in> Pow A" "F A1 = F A2"
  5.1802 -    thus "A1 = A2" unfolding F_def Pow_def fun_eq_iff by (auto split: split_if_asm)
  5.1803 -  next
  5.1804 -    show "F ` Pow A = Func A UNIV"
  5.1805 -    proof safe
  5.1806 -      fix f assume f: "f \<in> Func A (UNIV::bool set)"
  5.1807 -      show "f \<in> F ` Pow A" unfolding image_def mem_Collect_eq proof(intro bexI)
  5.1808 -        let ?A1 = "{a \<in> A. f a = True}"
  5.1809 -        show "f = F ?A1" unfolding F_def apply(rule ext)
  5.1810 -        using f unfolding Func_def mem_Collect_eq by auto
  5.1811 -      qed auto
  5.1812 -    qed(unfold Func_def mem_Collect_eq F_def, auto)
  5.1813 -  qed
  5.1814 -  thus ?thesis unfolding card_of_ordIso[symmetric] by blast
  5.1815 -qed
  5.1816 -
  5.1817 -lemma card_of_Func_UNIV:
  5.1818 -"|Func (UNIV::'a set) (B::'b set)| =o |{f::'a \<Rightarrow> 'b. range f \<subseteq> B}|"
  5.1819 -apply(rule ordIso_symmetric) proof(intro card_of_ordIsoI)
  5.1820 -  let ?F = "\<lambda> f (a::'a). ((f a)::'b)"
  5.1821 -  show "bij_betw ?F {f. range f \<subseteq> B} (Func UNIV B)"
  5.1822 -  unfolding bij_betw_def inj_on_def proof safe
  5.1823 -    fix h :: "'a \<Rightarrow> 'b" assume h: "h \<in> Func UNIV B"
  5.1824 -    hence "\<forall> a. \<exists> b. h a = b" unfolding Func_def by auto
  5.1825 -    then obtain f where f: "\<forall> a. h a = f a" by metis
  5.1826 -    hence "range f \<subseteq> B" using h unfolding Func_def by auto
  5.1827 -    thus "h \<in> (\<lambda>f a. f a) ` {f. range f \<subseteq> B}" using f unfolding image_def by auto
  5.1828 -  qed(unfold Func_def fun_eq_iff, auto)
  5.1829 -qed
  5.1830 -
  5.1831 -end
     6.1 --- a/src/HOL/Cardinals/Constructions_on_Wellorders_FP.thy	Mon Jan 20 16:14:19 2014 +0100
     6.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     6.3 @@ -1,1774 +0,0 @@
     6.4 -(*  Title:      HOL/Cardinals/Constructions_on_Wellorders_FP.thy
     6.5 -    Author:     Andrei Popescu, TU Muenchen
     6.6 -    Copyright   2012
     6.7 -
     6.8 -Constructions on wellorders (FP).
     6.9 -*)
    6.10 -
    6.11 -header {* Constructions on Wellorders (FP) *}
    6.12 -
    6.13 -theory Constructions_on_Wellorders_FP
    6.14 -imports Wellorder_Embedding_FP
    6.15 -begin
    6.16 -
    6.17 -
    6.18 -text {* In this section, we study basic constructions on well-orders, such as restriction to
    6.19 -a set/order filter, copy via direct images, ordinal-like sum of disjoint well-orders,
    6.20 -and bounded square.  We also define between well-orders
    6.21 -the relations @{text "ordLeq"}, of being embedded (abbreviated @{text "\<le>o"}),
    6.22 -@{text "ordLess"}, of being strictly embedded (abbreviated @{text "<o"}), and
    6.23 -@{text "ordIso"}, of being isomorphic (abbreviated @{text "=o"}).  We study the
    6.24 -connections between these relations, order filters, and the aforementioned constructions.
    6.25 -A main result of this section is that @{text "<o"} is well-founded.  *}
    6.26 -
    6.27 -
    6.28 -subsection {* Restriction to a set  *}
    6.29 -
    6.30 -
    6.31 -abbreviation Restr :: "'a rel \<Rightarrow> 'a set \<Rightarrow> 'a rel"
    6.32 -where "Restr r A \<equiv> r Int (A \<times> A)"
    6.33 -
    6.34 -
    6.35 -lemma Restr_subset:
    6.36 -"A \<le> B \<Longrightarrow> Restr (Restr r B) A = Restr r A"
    6.37 -by blast
    6.38 -
    6.39 -
    6.40 -lemma Restr_Field: "Restr r (Field r) = r"
    6.41 -unfolding Field_def by auto
    6.42 -
    6.43 -
    6.44 -lemma Refl_Restr: "Refl r \<Longrightarrow> Refl(Restr r A)"
    6.45 -unfolding refl_on_def Field_def by auto
    6.46 -
    6.47 -
    6.48 -lemma antisym_Restr:
    6.49 -"antisym r \<Longrightarrow> antisym(Restr r A)"
    6.50 -unfolding antisym_def Field_def by auto
    6.51 -
    6.52 -
    6.53 -lemma Total_Restr:
    6.54 -"Total r \<Longrightarrow> Total(Restr r A)"
    6.55 -unfolding total_on_def Field_def by auto
    6.56 -
    6.57 -
    6.58 -lemma trans_Restr:
    6.59 -"trans r \<Longrightarrow> trans(Restr r A)"
    6.60 -unfolding trans_def Field_def by blast
    6.61 -
    6.62 -
    6.63 -lemma Preorder_Restr:
    6.64 -"Preorder r \<Longrightarrow> Preorder(Restr r A)"
    6.65 -unfolding preorder_on_def by (simp add: Refl_Restr trans_Restr)
    6.66 -
    6.67 -
    6.68 -lemma Partial_order_Restr:
    6.69 -"Partial_order r \<Longrightarrow> Partial_order(Restr r A)"
    6.70 -unfolding partial_order_on_def by (simp add: Preorder_Restr antisym_Restr)
    6.71 -
    6.72 -
    6.73 -lemma Linear_order_Restr:
    6.74 -"Linear_order r \<Longrightarrow> Linear_order(Restr r A)"
    6.75 -unfolding linear_order_on_def by (simp add: Partial_order_Restr Total_Restr)
    6.76 -
    6.77 -
    6.78 -lemma Well_order_Restr:
    6.79 -assumes "Well_order r"
    6.80 -shows "Well_order(Restr r A)"
    6.81 -proof-
    6.82 -  have "Restr r A - Id \<le> r - Id" using Restr_subset by blast
    6.83 -  hence "wf(Restr r A - Id)" using assms
    6.84 -  using well_order_on_def wf_subset by blast
    6.85 -  thus ?thesis using assms unfolding well_order_on_def
    6.86 -  by (simp add: Linear_order_Restr)
    6.87 -qed
    6.88 -
    6.89 -
    6.90 -lemma Field_Restr_subset: "Field(Restr r A) \<le> A"
    6.91 -by (auto simp add: Field_def)
    6.92 -
    6.93 -
    6.94 -lemma Refl_Field_Restr:
    6.95 -"Refl r \<Longrightarrow> Field(Restr r A) = (Field r) Int A"
    6.96 -unfolding refl_on_def Field_def by blast
    6.97 -
    6.98 -
    6.99 -lemma Refl_Field_Restr2:
   6.100 -"\<lbrakk>Refl r; A \<le> Field r\<rbrakk> \<Longrightarrow> Field(Restr r A) = A"
   6.101 -by (auto simp add: Refl_Field_Restr)
   6.102 -
   6.103 -
   6.104 -lemma well_order_on_Restr:
   6.105 -assumes WELL: "Well_order r" and SUB: "A \<le> Field r"
   6.106 -shows "well_order_on A (Restr r A)"
   6.107 -using assms
   6.108 -using Well_order_Restr[of r A] Refl_Field_Restr2[of r A]
   6.109 -     order_on_defs[of "Field r" r] by auto
   6.110 -
   6.111 -
   6.112 -subsection {* Order filters versus restrictions and embeddings  *}
   6.113 -
   6.114 -
   6.115 -lemma Field_Restr_ofilter:
   6.116 -"\<lbrakk>Well_order r; wo_rel.ofilter r A\<rbrakk> \<Longrightarrow> Field(Restr r A) = A"
   6.117 -by (auto simp add: wo_rel_def wo_rel.ofilter_def wo_rel.REFL Refl_Field_Restr2)
   6.118 -
   6.119 -
   6.120 -lemma ofilter_Restr_under:
   6.121 -assumes WELL: "Well_order r" and OF: "wo_rel.ofilter r A" and IN: "a \<in> A"
   6.122 -shows "under (Restr r A) a = under r a"
   6.123 -using assms wo_rel_def
   6.124 -proof(auto simp add: wo_rel.ofilter_def under_def)
   6.125 -  fix b assume *: "a \<in> A" and "(b,a) \<in> r"
   6.126 -  hence "b \<in> under r a \<and> a \<in> Field r"
   6.127 -  unfolding under_def using Field_def by fastforce
   6.128 -  thus "b \<in> A" using * assms by (auto simp add: wo_rel_def wo_rel.ofilter_def)
   6.129 -qed
   6.130 -
   6.131 -
   6.132 -lemma ofilter_embed:
   6.133 -assumes "Well_order r"
   6.134 -shows "wo_rel.ofilter r A = (A \<le> Field r \<and> embed (Restr r A) r id)"
   6.135 -proof
   6.136 -  assume *: "wo_rel.ofilter r A"
   6.137 -  show "A \<le> Field r \<and> embed (Restr r A) r id"
   6.138 -  proof(unfold embed_def, auto)
   6.139 -    fix a assume "a \<in> A" thus "a \<in> Field r" using assms *
   6.140 -    by (auto simp add: wo_rel_def wo_rel.ofilter_def)
   6.141 -  next
   6.142 -    fix a assume "a \<in> Field (Restr r A)"
   6.143 -    thus "bij_betw id (under (Restr r A) a) (under r a)" using assms *
   6.144 -    by (simp add: ofilter_Restr_under Field_Restr_ofilter)
   6.145 -  qed
   6.146 -next
   6.147 -  assume *: "A \<le> Field r \<and> embed (Restr r A) r id"
   6.148 -  hence "Field(Restr r A) \<le> Field r"
   6.149 -  using assms  embed_Field[of "Restr r A" r id] id_def
   6.150 -        Well_order_Restr[of r] by auto
   6.151 -  {fix a assume "a \<in> A"
   6.152 -   hence "a \<in> Field(Restr r A)" using * assms
   6.153 -   by (simp add: order_on_defs Refl_Field_Restr2)
   6.154 -   hence "bij_betw id (under (Restr r A) a) (under r a)"
   6.155 -   using * unfolding embed_def by auto
   6.156 -   hence "under r a \<le> under (Restr r A) a"
   6.157 -   unfolding bij_betw_def by auto
   6.158 -   also have "\<dots> \<le> Field(Restr r A)" by (simp add: under_Field)
   6.159 -   also have "\<dots> \<le> A" by (simp add: Field_Restr_subset)
   6.160 -   finally have "under r a \<le> A" .
   6.161 -  }
   6.162 -  thus "wo_rel.ofilter r A" using assms * by (simp add: wo_rel_def wo_rel.ofilter_def)
   6.163 -qed
   6.164 -
   6.165 -
   6.166 -lemma ofilter_Restr_Int:
   6.167 -assumes WELL: "Well_order r" and OFA: "wo_rel.ofilter r A"
   6.168 -shows "wo_rel.ofilter (Restr r B) (A Int B)"
   6.169 -proof-
   6.170 -  let ?rB = "Restr r B"
   6.171 -  have Well: "wo_rel r" unfolding wo_rel_def using WELL .
   6.172 -  hence Refl: "Refl r" by (simp add: wo_rel.REFL)
   6.173 -  hence Field: "Field ?rB = Field r Int B"
   6.174 -  using Refl_Field_Restr by blast
   6.175 -  have WellB: "wo_rel ?rB \<and> Well_order ?rB" using WELL
   6.176 -  by (simp add: Well_order_Restr wo_rel_def)
   6.177 -  (* Main proof *)
   6.178 -  show ?thesis using WellB assms
   6.179 -  proof(auto simp add: wo_rel.ofilter_def under_def)
   6.180 -    fix a assume "a \<in> A" and *: "a \<in> B"
   6.181 -    hence "a \<in> Field r" using OFA Well by (auto simp add: wo_rel.ofilter_def)
   6.182 -    with * show "a \<in> Field ?rB" using Field by auto
   6.183 -  next
   6.184 -    fix a b assume "a \<in> A" and "(b,a) \<in> r"
   6.185 -    thus "b \<in> A" using Well OFA by (auto simp add: wo_rel.ofilter_def under_def)
   6.186 -  qed
   6.187 -qed
   6.188 -
   6.189 -
   6.190 -lemma ofilter_Restr_subset:
   6.191 -assumes WELL: "Well_order r" and OFA: "wo_rel.ofilter r A" and SUB: "A \<le> B"
   6.192 -shows "wo_rel.ofilter (Restr r B) A"
   6.193 -proof-
   6.194 -  have "A Int B = A" using SUB by blast
   6.195 -  thus ?thesis using assms ofilter_Restr_Int[of r A B] by auto
   6.196 -qed
   6.197 -
   6.198 -
   6.199 -lemma ofilter_subset_embed:
   6.200 -assumes WELL: "Well_order r" and
   6.201 -        OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
   6.202 -shows "(A \<le> B) = (embed (Restr r A) (Restr r B) id)"
   6.203 -proof-
   6.204 -  let ?rA = "Restr r A"  let ?rB = "Restr r B"
   6.205 -  have Well: "wo_rel r" unfolding wo_rel_def using WELL .
   6.206 -  hence Refl: "Refl r" by (simp add: wo_rel.REFL)
   6.207 -  hence FieldA: "Field ?rA = Field r Int A"
   6.208 -  using Refl_Field_Restr by blast
   6.209 -  have FieldB: "Field ?rB = Field r Int B"
   6.210 -  using Refl Refl_Field_Restr by blast
   6.211 -  have WellA: "wo_rel ?rA \<and> Well_order ?rA" using WELL
   6.212 -  by (simp add: Well_order_Restr wo_rel_def)
   6.213 -  have WellB: "wo_rel ?rB \<and> Well_order ?rB" using WELL
   6.214 -  by (simp add: Well_order_Restr wo_rel_def)
   6.215 -  (* Main proof *)
   6.216 -  show ?thesis
   6.217 -  proof
   6.218 -    assume *: "A \<le> B"
   6.219 -    hence "wo_rel.ofilter (Restr r B) A" using assms
   6.220 -    by (simp add: ofilter_Restr_subset)
   6.221 -    hence "embed (Restr ?rB A) (Restr r B) id"
   6.222 -    using WellB ofilter_embed[of "?rB" A] by auto
   6.223 -    thus "embed (Restr r A) (Restr r B) id"
   6.224 -    using * by (simp add: Restr_subset)
   6.225 -  next
   6.226 -    assume *: "embed (Restr r A) (Restr r B) id"
   6.227 -    {fix a assume **: "a \<in> A"
   6.228 -     hence "a \<in> Field r" using Well OFA by (auto simp add: wo_rel.ofilter_def)
   6.229 -     with ** FieldA have "a \<in> Field ?rA" by auto
   6.230 -     hence "a \<in> Field ?rB" using * WellA embed_Field[of ?rA ?rB id] by auto
   6.231 -     hence "a \<in> B" using FieldB by auto
   6.232 -    }
   6.233 -    thus "A \<le> B" by blast
   6.234 -  qed
   6.235 -qed
   6.236 -
   6.237 -
   6.238 -lemma ofilter_subset_embedS_iso:
   6.239 -assumes WELL: "Well_order r" and
   6.240 -        OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
   6.241 -shows "((A < B) = (embedS (Restr r A) (Restr r B) id)) \<and>
   6.242 -       ((A = B) = (iso (Restr r A) (Restr r B) id))"
   6.243 -proof-
   6.244 -  let ?rA = "Restr r A"  let ?rB = "Restr r B"
   6.245 -  have Well: "wo_rel r" unfolding wo_rel_def using WELL .
   6.246 -  hence Refl: "Refl r" by (simp add: wo_rel.REFL)
   6.247 -  hence "Field ?rA = Field r Int A"
   6.248 -  using Refl_Field_Restr by blast
   6.249 -  hence FieldA: "Field ?rA = A" using OFA Well
   6.250 -  by (auto simp add: wo_rel.ofilter_def)
   6.251 -  have "Field ?rB = Field r Int B"
   6.252 -  using Refl Refl_Field_Restr by blast
   6.253 -  hence FieldB: "Field ?rB = B" using OFB Well
   6.254 -  by (auto simp add: wo_rel.ofilter_def)
   6.255 -  (* Main proof *)
   6.256 -  show ?thesis unfolding embedS_def iso_def
   6.257 -  using assms ofilter_subset_embed[of r A B]
   6.258 -        FieldA FieldB bij_betw_id_iff[of A B] by auto
   6.259 -qed
   6.260 -
   6.261 -
   6.262 -lemma ofilter_subset_embedS:
   6.263 -assumes WELL: "Well_order r" and
   6.264 -        OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
   6.265 -shows "(A < B) = embedS (Restr r A) (Restr r B) id"
   6.266 -using assms by (simp add: ofilter_subset_embedS_iso)
   6.267 -
   6.268 -
   6.269 -lemma embed_implies_iso_Restr:
   6.270 -assumes WELL: "Well_order r" and WELL': "Well_order r'" and
   6.271 -        EMB: "embed r' r f"
   6.272 -shows "iso r' (Restr r (f ` (Field r'))) f"
   6.273 -proof-
   6.274 -  let ?A' = "Field r'"
   6.275 -  let ?r'' = "Restr r (f ` ?A')"
   6.276 -  have 0: "Well_order ?r''" using WELL Well_order_Restr by blast
   6.277 -  have 1: "wo_rel.ofilter r (f ` ?A')" using assms embed_Field_ofilter  by blast
   6.278 -  hence "Field ?r'' = f ` (Field r')" using WELL Field_Restr_ofilter by blast
   6.279 -  hence "bij_betw f ?A' (Field ?r'')"
   6.280 -  using EMB embed_inj_on WELL' unfolding bij_betw_def by blast
   6.281 -  moreover
   6.282 -  {have "\<forall>a b. (a,b) \<in> r' \<longrightarrow> a \<in> Field r' \<and> b \<in> Field r'"
   6.283 -   unfolding Field_def by auto
   6.284 -   hence "compat r' ?r'' f"
   6.285 -   using assms embed_iff_compat_inj_on_ofilter
   6.286 -   unfolding compat_def by blast
   6.287 -  }
   6.288 -  ultimately show ?thesis using WELL' 0 iso_iff3 by blast
   6.289 -qed
   6.290 -
   6.291 -
   6.292 -subsection {* The strict inclusion on proper ofilters is well-founded *}
   6.293 -
   6.294 -
   6.295 -definition ofilterIncl :: "'a rel \<Rightarrow> 'a set rel"
   6.296 -where
   6.297 -"ofilterIncl r \<equiv> {(A,B). wo_rel.ofilter r A \<and> A \<noteq> Field r \<and>
   6.298 -                         wo_rel.ofilter r B \<and> B \<noteq> Field r \<and> A < B}"
   6.299 -
   6.300 -
   6.301 -lemma wf_ofilterIncl:
   6.302 -assumes WELL: "Well_order r"
   6.303 -shows "wf(ofilterIncl r)"
   6.304 -proof-
   6.305 -  have Well: "wo_rel r" using WELL by (simp add: wo_rel_def)
   6.306 -  hence Lo: "Linear_order r" by (simp add: wo_rel.LIN)
   6.307 -  let ?h = "(\<lambda> A. wo_rel.suc r A)"
   6.308 -  let ?rS = "r - Id"
   6.309 -  have "wf ?rS" using WELL by (simp add: order_on_defs)
   6.310 -  moreover
   6.311 -  have "compat (ofilterIncl r) ?rS ?h"
   6.312 -  proof(unfold compat_def ofilterIncl_def,
   6.313 -        intro allI impI, simp, elim conjE)
   6.314 -    fix A B
   6.315 -    assume *: "wo_rel.ofilter r A" "A \<noteq> Field r" and
   6.316 -           **: "wo_rel.ofilter r B" "B \<noteq> Field r" and ***: "A < B"
   6.317 -    then obtain a and b where 0: "a \<in> Field r \<and> b \<in> Field r" and
   6.318 -                         1: "A = underS r a \<and> B = underS r b"
   6.319 -    using Well by (auto simp add: wo_rel.ofilter_underS_Field)
   6.320 -    hence "a \<noteq> b" using *** by auto
   6.321 -    moreover
   6.322 -    have "(a,b) \<in> r" using 0 1 Lo ***
   6.323 -    by (auto simp add: underS_incl_iff)
   6.324 -    moreover
   6.325 -    have "a = wo_rel.suc r A \<and> b = wo_rel.suc r B"
   6.326 -    using Well 0 1 by (simp add: wo_rel.suc_underS)
   6.327 -    ultimately
   6.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"
   6.329 -    by simp
   6.330 -  qed
   6.331 -  ultimately show "wf (ofilterIncl r)" by (simp add: compat_wf)
   6.332 -qed
   6.333 -
   6.334 -
   6.335 -
   6.336 -subsection {* Ordering the well-orders by existence of embeddings *}
   6.337 -
   6.338 -
   6.339 -text {* We define three relations between well-orders:
   6.340 -\begin{itemize}
   6.341 -\item @{text "ordLeq"}, of being embedded (abbreviated @{text "\<le>o"});
   6.342 -\item @{text "ordLess"}, of being strictly embedded (abbreviated @{text "<o"});
   6.343 -\item @{text "ordIso"}, of being isomorphic (abbreviated @{text "=o"}).
   6.344 -\end{itemize}
   6.345 -%
   6.346 -The prefix "ord" and the index "o" in these names stand for "ordinal-like".
   6.347 -These relations shall be proved to be inter-connected in a similar fashion as the trio
   6.348 -@{text "\<le>"}, @{text "<"}, @{text "="} associated to a total order on a set.
   6.349 -*}
   6.350 -
   6.351 -
   6.352 -definition ordLeq :: "('a rel * 'a' rel) set"
   6.353 -where
   6.354 -"ordLeq = {(r,r'). Well_order r \<and> Well_order r' \<and> (\<exists>f. embed r r' f)}"
   6.355 -
   6.356 -
   6.357 -abbreviation ordLeq2 :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> bool" (infix "<=o" 50)
   6.358 -where "r <=o r' \<equiv> (r,r') \<in> ordLeq"
   6.359 -
   6.360 -
   6.361 -abbreviation ordLeq3 :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> bool" (infix "\<le>o" 50)
   6.362 -where "r \<le>o r' \<equiv> r <=o r'"
   6.363 -
   6.364 -
   6.365 -definition ordLess :: "('a rel * 'a' rel) set"
   6.366 -where
   6.367 -"ordLess = {(r,r'). Well_order r \<and> Well_order r' \<and> (\<exists>f. embedS r r' f)}"
   6.368 -
   6.369 -abbreviation ordLess2 :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> bool" (infix "<o" 50)
   6.370 -where "r <o r' \<equiv> (r,r') \<in> ordLess"
   6.371 -
   6.372 -
   6.373 -definition ordIso :: "('a rel * 'a' rel) set"
   6.374 -where
   6.375 -"ordIso = {(r,r'). Well_order r \<and> Well_order r' \<and> (\<exists>f. iso r r' f)}"
   6.376 -
   6.377 -abbreviation ordIso2 :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> bool" (infix "=o" 50)
   6.378 -where "r =o r' \<equiv> (r,r') \<in> ordIso"
   6.379 -
   6.380 -
   6.381 -lemmas ordRels_def = ordLeq_def ordLess_def ordIso_def
   6.382 -
   6.383 -lemma ordLeq_Well_order_simp:
   6.384 -assumes "r \<le>o r'"
   6.385 -shows "Well_order r \<and> Well_order r'"
   6.386 -using assms unfolding ordLeq_def by simp
   6.387 -
   6.388 -
   6.389 -text{* Notice that the relations @{text "\<le>o"}, @{text "<o"}, @{text "=o"} connect well-orders
   6.390 -on potentially {\em distinct} types. However, some of the lemmas below, including the next one,
   6.391 -restrict implicitly the type of these relations to @{text "(('a rel) * ('a rel)) set"} , i.e.,
   6.392 -to @{text "'a rel rel"}.  *}
   6.393 -
   6.394 -
   6.395 -lemma ordLeq_reflexive:
   6.396 -"Well_order r \<Longrightarrow> r \<le>o r"
   6.397 -unfolding ordLeq_def using id_embed[of r] by blast
   6.398 -
   6.399 -
   6.400 -lemma ordLeq_transitive[trans]:
   6.401 -assumes *: "r \<le>o r'" and **: "r' \<le>o r''"
   6.402 -shows "r \<le>o r''"
   6.403 -proof-
   6.404 -  obtain f and f'
   6.405 -  where 1: "Well_order r \<and> Well_order r' \<and> Well_order r''" and
   6.406 -        "embed r r' f" and "embed r' r'' f'"
   6.407 -  using * ** unfolding ordLeq_def by blast
   6.408 -  hence "embed r r'' (f' o f)"
   6.409 -  using comp_embed[of r r' f r'' f'] by auto
   6.410 -  thus "r \<le>o r''" unfolding ordLeq_def using 1 by auto
   6.411 -qed
   6.412 -
   6.413 -
   6.414 -lemma ordLeq_total:
   6.415 -"\<lbrakk>Well_order r; Well_order r'\<rbrakk> \<Longrightarrow> r \<le>o r' \<or> r' \<le>o r"
   6.416 -unfolding ordLeq_def using wellorders_totally_ordered by blast
   6.417 -
   6.418 -
   6.419 -lemma ordIso_reflexive:
   6.420 -"Well_order r \<Longrightarrow> r =o r"
   6.421 -unfolding ordIso_def using id_iso[of r] by blast
   6.422 -
   6.423 -
   6.424 -lemma ordIso_transitive[trans]:
   6.425 -assumes *: "r =o r'" and **: "r' =o r''"
   6.426 -shows "r =o r''"
   6.427 -proof-
   6.428 -  obtain f and f'
   6.429 -  where 1: "Well_order r \<and> Well_order r' \<and> Well_order r''" and
   6.430 -        "iso r r' f" and 3: "iso r' r'' f'"
   6.431 -  using * ** unfolding ordIso_def by auto
   6.432 -  hence "iso r r'' (f' o f)"
   6.433 -  using comp_iso[of r r' f r'' f'] by auto
   6.434 -  thus "r =o r''" unfolding ordIso_def using 1 by auto
   6.435 -qed
   6.436 -
   6.437 -
   6.438 -lemma ordIso_symmetric:
   6.439 -assumes *: "r =o r'"
   6.440 -shows "r' =o r"
   6.441 -proof-
   6.442 -  obtain f where 1: "Well_order r \<and> Well_order r'" and
   6.443 -                 2: "embed r r' f \<and> bij_betw f (Field r) (Field r')"
   6.444 -  using * by (auto simp add: ordIso_def iso_def)
   6.445 -  let ?f' = "inv_into (Field r) f"
   6.446 -  have "embed r' r ?f' \<and> bij_betw ?f' (Field r') (Field r)"
   6.447 -  using 1 2 by (simp add: bij_betw_inv_into inv_into_Field_embed_bij_betw)
   6.448 -  thus "r' =o r" unfolding ordIso_def using 1 by (auto simp add: iso_def)
   6.449 -qed
   6.450 -
   6.451 -
   6.452 -lemma ordLeq_ordLess_trans[trans]:
   6.453 -assumes "r \<le>o r'" and " r' <o r''"
   6.454 -shows "r <o r''"
   6.455 -proof-
   6.456 -  have "Well_order r \<and> Well_order r''"
   6.457 -  using assms unfolding ordLeq_def ordLess_def by auto
   6.458 -  thus ?thesis using assms unfolding ordLeq_def ordLess_def
   6.459 -  using embed_comp_embedS by blast
   6.460 -qed
   6.461 -
   6.462 -
   6.463 -lemma ordLess_ordLeq_trans[trans]:
   6.464 -assumes "r <o r'" and " r' \<le>o r''"
   6.465 -shows "r <o r''"
   6.466 -proof-
   6.467 -  have "Well_order r \<and> Well_order r''"
   6.468 -  using assms unfolding ordLeq_def ordLess_def by auto
   6.469 -  thus ?thesis using assms unfolding ordLeq_def ordLess_def
   6.470 -  using embedS_comp_embed by blast
   6.471 -qed
   6.472 -
   6.473 -
   6.474 -lemma ordLeq_ordIso_trans[trans]:
   6.475 -assumes "r \<le>o r'" and " r' =o r''"
   6.476 -shows "r \<le>o r''"
   6.477 -proof-
   6.478 -  have "Well_order r \<and> Well_order r''"
   6.479 -  using assms unfolding ordLeq_def ordIso_def by auto
   6.480 -  thus ?thesis using assms unfolding ordLeq_def ordIso_def
   6.481 -  using embed_comp_iso by blast
   6.482 -qed
   6.483 -
   6.484 -
   6.485 -lemma ordIso_ordLeq_trans[trans]:
   6.486 -assumes "r =o r'" and " r' \<le>o r''"
   6.487 -shows "r \<le>o r''"
   6.488 -proof-
   6.489 -  have "Well_order r \<and> Well_order r''"
   6.490 -  using assms unfolding ordLeq_def ordIso_def by auto
   6.491 -  thus ?thesis using assms unfolding ordLeq_def ordIso_def
   6.492 -  using iso_comp_embed by blast
   6.493 -qed
   6.494 -
   6.495 -
   6.496 -lemma ordLess_ordIso_trans[trans]:
   6.497 -assumes "r <o r'" and " r' =o r''"
   6.498 -shows "r <o r''"
   6.499 -proof-
   6.500 -  have "Well_order r \<and> Well_order r''"
   6.501 -  using assms unfolding ordLess_def ordIso_def by auto
   6.502 -  thus ?thesis using assms unfolding ordLess_def ordIso_def
   6.503 -  using embedS_comp_iso by blast
   6.504 -qed
   6.505 -
   6.506 -
   6.507 -lemma ordIso_ordLess_trans[trans]:
   6.508 -assumes "r =o r'" and " r' <o r''"
   6.509 -shows "r <o r''"
   6.510 -proof-
   6.511 -  have "Well_order r \<and> Well_order r''"
   6.512 -  using assms unfolding ordLess_def ordIso_def by auto
   6.513 -  thus ?thesis using assms unfolding ordLess_def ordIso_def
   6.514 -  using iso_comp_embedS by blast
   6.515 -qed
   6.516 -
   6.517 -
   6.518 -lemma ordLess_not_embed:
   6.519 -assumes "r <o r'"
   6.520 -shows "\<not>(\<exists>f'. embed r' r f')"
   6.521 -proof-
   6.522 -  obtain f where 1: "Well_order r \<and> Well_order r'" and 2: "embed r r' f" and
   6.523 -                 3: " \<not> bij_betw f (Field r) (Field r')"
   6.524 -  using assms unfolding ordLess_def by (auto simp add: embedS_def)
   6.525 -  {fix f' assume *: "embed r' r f'"
   6.526 -   hence "bij_betw f (Field r) (Field r')" using 1 2
   6.527 -   by (simp add: embed_bothWays_Field_bij_betw)
   6.528 -   with 3 have False by contradiction
   6.529 -  }
   6.530 -  thus ?thesis by blast
   6.531 -qed
   6.532 -
   6.533 -
   6.534 -lemma ordLess_Field:
   6.535 -assumes OL: "r1 <o r2" and EMB: "embed r1 r2 f"
   6.536 -shows "\<not> (f`(Field r1) = Field r2)"
   6.537 -proof-
   6.538 -  let ?A1 = "Field r1"  let ?A2 = "Field r2"
   6.539 -  obtain g where
   6.540 -  0: "Well_order r1 \<and> Well_order r2" and
   6.541 -  1: "embed r1 r2 g \<and> \<not>(bij_betw g ?A1 ?A2)"
   6.542 -  using OL unfolding ordLess_def by (auto simp add: embedS_def)
   6.543 -  hence "\<forall>a \<in> ?A1. f a = g a"
   6.544 -  using 0 EMB embed_unique[of r1] by auto
   6.545 -  hence "\<not>(bij_betw f ?A1 ?A2)"
   6.546 -  using 1 bij_betw_cong[of ?A1] by blast
   6.547 -  moreover
   6.548 -  have "inj_on f ?A1" using EMB 0 by (simp add: embed_inj_on)
   6.549 -  ultimately show ?thesis by (simp add: bij_betw_def)
   6.550 -qed
   6.551 -
   6.552 -
   6.553 -lemma ordLess_iff:
   6.554 -"r <o r' = (Well_order r \<and> Well_order r' \<and> \<not>(\<exists>f'. embed r' r f'))"
   6.555 -proof
   6.556 -  assume *: "r <o r'"
   6.557 -  hence "\<not>(\<exists>f'. embed r' r f')" using ordLess_not_embed[of r r'] by simp
   6.558 -  with * show "Well_order r \<and> Well_order r' \<and> \<not> (\<exists>f'. embed r' r f')"
   6.559 -  unfolding ordLess_def by auto
   6.560 -next
   6.561 -  assume *: "Well_order r \<and> Well_order r' \<and> \<not> (\<exists>f'. embed r' r f')"
   6.562 -  then obtain f where 1: "embed r r' f"
   6.563 -  using wellorders_totally_ordered[of r r'] by blast
   6.564 -  moreover
   6.565 -  {assume "bij_betw f (Field r) (Field r')"
   6.566 -   with * 1 have "embed r' r (inv_into (Field r) f) "
   6.567 -   using inv_into_Field_embed_bij_betw[of r r' f] by auto
   6.568 -   with * have False by blast
   6.569 -  }
   6.570 -  ultimately show "(r,r') \<in> ordLess"
   6.571 -  unfolding ordLess_def using * by (fastforce simp add: embedS_def)
   6.572 -qed
   6.573 -
   6.574 -
   6.575 -lemma ordLess_irreflexive: "\<not> r <o r"
   6.576 -proof
   6.577 -  assume "r <o r"
   6.578 -  hence "Well_order r \<and>  \<not>(\<exists>f. embed r r f)"
   6.579 -  unfolding ordLess_iff ..
   6.580 -  moreover have "embed r r id" using id_embed[of r] .
   6.581 -  ultimately show False by blast
   6.582 -qed
   6.583 -
   6.584 -
   6.585 -lemma ordLeq_iff_ordLess_or_ordIso:
   6.586 -"r \<le>o r' = (r <o r' \<or> r =o r')"
   6.587 -unfolding ordRels_def embedS_defs iso_defs by blast
   6.588 -
   6.589 -
   6.590 -lemma ordIso_iff_ordLeq:
   6.591 -"(r =o r') = (r \<le>o r' \<and> r' \<le>o r)"
   6.592 -proof
   6.593 -  assume "r =o r'"
   6.594 -  then obtain f where 1: "Well_order r \<and> Well_order r' \<and>
   6.595 -                     embed r r' f \<and> bij_betw f (Field r) (Field r')"
   6.596 -  unfolding ordIso_def iso_defs by auto
   6.597 -  hence "embed r r' f \<and> embed r' r (inv_into (Field r) f)"
   6.598 -  by (simp add: inv_into_Field_embed_bij_betw)
   6.599 -  thus  "r \<le>o r' \<and> r' \<le>o r"
   6.600 -  unfolding ordLeq_def using 1 by auto
   6.601 -next
   6.602 -  assume "r \<le>o r' \<and> r' \<le>o r"
   6.603 -  then obtain f and g where 1: "Well_order r \<and> Well_order r' \<and>
   6.604 -                           embed r r' f \<and> embed r' r g"
   6.605 -  unfolding ordLeq_def by auto
   6.606 -  hence "iso r r' f" by (auto simp add: embed_bothWays_iso)
   6.607 -  thus "r =o r'" unfolding ordIso_def using 1 by auto
   6.608 -qed
   6.609 -
   6.610 -
   6.611 -lemma not_ordLess_ordLeq:
   6.612 -"r <o r' \<Longrightarrow> \<not> r' \<le>o r"
   6.613 -using ordLess_ordLeq_trans ordLess_irreflexive by blast
   6.614 -
   6.615 -
   6.616 -lemma ordLess_or_ordLeq:
   6.617 -assumes WELL: "Well_order r" and WELL': "Well_order r'"
   6.618 -shows "r <o r' \<or> r' \<le>o r"
   6.619 -proof-
   6.620 -  have "r \<le>o r' \<or> r' \<le>o r"
   6.621 -  using assms by (simp add: ordLeq_total)
   6.622 -  moreover
   6.623 -  {assume "\<not> r <o r' \<and> r \<le>o r'"
   6.624 -   hence "r =o r'" using ordLeq_iff_ordLess_or_ordIso by blast
   6.625 -   hence "r' \<le>o r" using ordIso_symmetric ordIso_iff_ordLeq by blast
   6.626 -  }
   6.627 -  ultimately show ?thesis by blast
   6.628 -qed
   6.629 -
   6.630 -
   6.631 -lemma not_ordLess_ordIso:
   6.632 -"r <o r' \<Longrightarrow> \<not> r =o r'"
   6.633 -using assms ordLess_ordIso_trans ordIso_symmetric ordLess_irreflexive by blast
   6.634 -
   6.635 -
   6.636 -lemma not_ordLeq_iff_ordLess:
   6.637 -assumes WELL: "Well_order r" and WELL': "Well_order r'"
   6.638 -shows "(\<not> r' \<le>o r) = (r <o r')"
   6.639 -using assms not_ordLess_ordLeq ordLess_or_ordLeq by blast
   6.640 -
   6.641 -
   6.642 -lemma not_ordLess_iff_ordLeq:
   6.643 -assumes WELL: "Well_order r" and WELL': "Well_order r'"
   6.644 -shows "(\<not> r' <o r) = (r \<le>o r')"
   6.645 -using assms not_ordLess_ordLeq ordLess_or_ordLeq by blast
   6.646 -
   6.647 -
   6.648 -lemma ordLess_transitive[trans]:
   6.649 -"\<lbrakk>r <o r'; r' <o r''\<rbrakk> \<Longrightarrow> r <o r''"
   6.650 -using assms ordLess_ordLeq_trans ordLeq_iff_ordLess_or_ordIso by blast
   6.651 -
   6.652 -
   6.653 -corollary ordLess_trans: "trans ordLess"
   6.654 -unfolding trans_def using ordLess_transitive by blast
   6.655 -
   6.656 -
   6.657 -lemmas ordIso_equivalence = ordIso_transitive ordIso_reflexive ordIso_symmetric
   6.658 -
   6.659 -
   6.660 -lemma ordIso_imp_ordLeq:
   6.661 -"r =o r' \<Longrightarrow> r \<le>o r'"
   6.662 -using ordIso_iff_ordLeq by blast
   6.663 -
   6.664 -
   6.665 -lemma ordLess_imp_ordLeq:
   6.666 -"r <o r' \<Longrightarrow> r \<le>o r'"
   6.667 -using ordLeq_iff_ordLess_or_ordIso by blast
   6.668 -
   6.669 -
   6.670 -lemma ofilter_subset_ordLeq:
   6.671 -assumes WELL: "Well_order r" and
   6.672 -        OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
   6.673 -shows "(A \<le> B) = (Restr r A \<le>o Restr r B)"
   6.674 -proof
   6.675 -  assume "A \<le> B"
   6.676 -  thus "Restr r A \<le>o Restr r B"
   6.677 -  unfolding ordLeq_def using assms
   6.678 -  Well_order_Restr Well_order_Restr ofilter_subset_embed by blast
   6.679 -next
   6.680 -  assume *: "Restr r A \<le>o Restr r B"
   6.681 -  then obtain f where "embed (Restr r A) (Restr r B) f"
   6.682 -  unfolding ordLeq_def by blast
   6.683 -  {assume "B < A"
   6.684 -   hence "Restr r B <o Restr r A"
   6.685 -   unfolding ordLess_def using assms
   6.686 -   Well_order_Restr Well_order_Restr ofilter_subset_embedS by blast
   6.687 -   hence False using * not_ordLess_ordLeq by blast
   6.688 -  }
   6.689 -  thus "A \<le> B" using OFA OFB WELL
   6.690 -  wo_rel_def[of r] wo_rel.ofilter_linord[of r A B] by blast
   6.691 -qed
   6.692 -
   6.693 -
   6.694 -lemma ofilter_subset_ordLess:
   6.695 -assumes WELL: "Well_order r" and
   6.696 -        OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
   6.697 -shows "(A < B) = (Restr r A <o Restr r B)"
   6.698 -proof-
   6.699 -  let ?rA = "Restr r A" let ?rB = "Restr r B"
   6.700 -  have 1: "Well_order ?rA \<and> Well_order ?rB"
   6.701 -  using WELL Well_order_Restr by blast
   6.702 -  have "(A < B) = (\<not> B \<le> A)" using assms
   6.703 -  wo_rel_def wo_rel.ofilter_linord[of r A B] by blast
   6.704 -  also have "\<dots> = (\<not> Restr r B \<le>o Restr r A)"
   6.705 -  using assms ofilter_subset_ordLeq by blast
   6.706 -  also have "\<dots> = (Restr r A <o Restr r B)"
   6.707 -  using 1 not_ordLeq_iff_ordLess by blast
   6.708 -  finally show ?thesis .
   6.709 -qed
   6.710 -
   6.711 -
   6.712 -lemma ofilter_ordLess:
   6.713 -"\<lbrakk>Well_order r; wo_rel.ofilter r A\<rbrakk> \<Longrightarrow> (A < Field r) = (Restr r A <o r)"
   6.714 -by (simp add: ofilter_subset_ordLess wo_rel.Field_ofilter
   6.715 -    wo_rel_def Restr_Field)
   6.716 -
   6.717 -
   6.718 -corollary underS_Restr_ordLess:
   6.719 -assumes "Well_order r" and "Field r \<noteq> {}"
   6.720 -shows "Restr r (underS r a) <o r"
   6.721 -proof-
   6.722 -  have "underS r a < Field r" using assms
   6.723 -  by (simp add: underS_Field3)
   6.724 -  thus ?thesis using assms
   6.725 -  by (simp add: ofilter_ordLess wo_rel.underS_ofilter wo_rel_def)
   6.726 -qed
   6.727 -
   6.728 -
   6.729 -lemma embed_ordLess_ofilterIncl:
   6.730 -assumes
   6.731 -  OL12: "r1 <o r2" and OL23: "r2 <o r3" and
   6.732 -  EMB13: "embed r1 r3 f13" and EMB23: "embed r2 r3 f23"
   6.733 -shows "(f13`(Field r1), f23`(Field r2)) \<in> (ofilterIncl r3)"
   6.734 -proof-
   6.735 -  have OL13: "r1 <o r3"
   6.736 -  using OL12 OL23 using ordLess_transitive by auto
   6.737 -  let ?A1 = "Field r1"  let ?A2 ="Field r2" let ?A3 ="Field r3"
   6.738 -  obtain f12 g23 where
   6.739 -  0: "Well_order r1 \<and> Well_order r2 \<and> Well_order r3" and
   6.740 -  1: "embed r1 r2 f12 \<and> \<not>(bij_betw f12 ?A1 ?A2)" and
   6.741 -  2: "embed r2 r3 g23 \<and> \<not>(bij_betw g23 ?A2 ?A3)"
   6.742 -  using OL12 OL23 by (auto simp add: ordLess_def embedS_def)
   6.743 -  hence "\<forall>a \<in> ?A2. f23 a = g23 a"
   6.744 -  using EMB23 embed_unique[of r2 r3] by blast
   6.745 -  hence 3: "\<not>(bij_betw f23 ?A2 ?A3)"
   6.746 -  using 2 bij_betw_cong[of ?A2 f23 g23] by blast
   6.747 -  (*  *)
   6.748 -  have 4: "wo_rel.ofilter r2 (f12 ` ?A1) \<and> f12 ` ?A1 \<noteq> ?A2"
   6.749 -  using 0 1 OL12 by (simp add: embed_Field_ofilter ordLess_Field)
   6.750 -  have 5: "wo_rel.ofilter r3 (f23 ` ?A2) \<and> f23 ` ?A2 \<noteq> ?A3"
   6.751 -  using 0 EMB23 OL23 by (simp add: embed_Field_ofilter ordLess_Field)
   6.752 -  have 6: "wo_rel.ofilter r3 (f13 ` ?A1)  \<and> f13 ` ?A1 \<noteq> ?A3"
   6.753 -  using 0 EMB13 OL13 by (simp add: embed_Field_ofilter ordLess_Field)
   6.754 -  (*  *)
   6.755 -  have "f12 ` ?A1 < ?A2"
   6.756 -  using 0 4 by (auto simp add: wo_rel_def wo_rel.ofilter_def)
   6.757 -  moreover have "inj_on f23 ?A2"
   6.758 -  using EMB23 0 by (simp add: wo_rel_def embed_inj_on)
   6.759 -  ultimately
   6.760 -  have "f23 ` (f12 ` ?A1) < f23 ` ?A2" by (simp add: inj_on_strict_subset)
   6.761 -  moreover
   6.762 -  {have "embed r1 r3 (f23 o f12)"
   6.763 -   using 1 EMB23 0 by (auto simp add: comp_embed)
   6.764 -   hence "\<forall>a \<in> ?A1. f23(f12 a) = f13 a"
   6.765 -   using EMB13 0 embed_unique[of r1 r3 "f23 o f12" f13] by auto
   6.766 -   hence "f23 ` (f12 ` ?A1) = f13 ` ?A1" by force
   6.767 -  }
   6.768 -  ultimately
   6.769 -  have "f13 ` ?A1 < f23 ` ?A2" by simp
   6.770 -  (*  *)
   6.771 -  with 5 6 show ?thesis
   6.772 -  unfolding ofilterIncl_def by auto
   6.773 -qed
   6.774 -
   6.775 -
   6.776 -lemma ordLess_iff_ordIso_Restr:
   6.777 -assumes WELL: "Well_order r" and WELL': "Well_order r'"
   6.778 -shows "(r' <o r) = (\<exists>a \<in> Field r. r' =o Restr r (underS r a))"
   6.779 -proof(auto)
   6.780 -  fix a assume *: "a \<in> Field r" and **: "r' =o Restr r (underS r a)"
   6.781 -  hence "Restr r (underS r a) <o r" using WELL underS_Restr_ordLess[of r] by blast
   6.782 -  thus "r' <o r" using ** ordIso_ordLess_trans by blast
   6.783 -next
   6.784 -  assume "r' <o r"
   6.785 -  then obtain f where 1: "Well_order r \<and> Well_order r'" and
   6.786 -                      2: "embed r' r f \<and> f ` (Field r') \<noteq> Field r"
   6.787 -  unfolding ordLess_def embedS_def[abs_def] bij_betw_def using embed_inj_on by blast
   6.788 -  hence "wo_rel.ofilter r (f ` (Field r'))" using embed_Field_ofilter by blast
   6.789 -  then obtain a where 3: "a \<in> Field r" and 4: "underS r a = f ` (Field r')"
   6.790 -  using 1 2 by (auto simp add: wo_rel.ofilter_underS_Field wo_rel_def)
   6.791 -  have "iso r' (Restr r (f ` (Field r'))) f"
   6.792 -  using embed_implies_iso_Restr 2 assms by blast
   6.793 -  moreover have "Well_order (Restr r (f ` (Field r')))"
   6.794 -  using WELL Well_order_Restr by blast
   6.795 -  ultimately have "r' =o Restr r (f ` (Field r'))"
   6.796 -  using WELL' unfolding ordIso_def by auto
   6.797 -  hence "r' =o Restr r (underS r a)" using 4 by auto
   6.798 -  thus "\<exists>a \<in> Field r. r' =o Restr r (underS r a)" using 3 by auto
   6.799 -qed
   6.800 -
   6.801 -
   6.802 -lemma internalize_ordLess:
   6.803 -"(r' <o r) = (\<exists>p. Field p < Field r \<and> r' =o p \<and> p <o r)"
   6.804 -proof
   6.805 -  assume *: "r' <o r"
   6.806 -  hence 0: "Well_order r \<and> Well_order r'" unfolding ordLess_def by auto
   6.807 -  with * obtain a where 1: "a \<in> Field r" and 2: "r' =o Restr r (underS r a)"
   6.808 -  using ordLess_iff_ordIso_Restr by blast
   6.809 -  let ?p = "Restr r (underS r a)"
   6.810 -  have "wo_rel.ofilter r (underS r a)" using 0
   6.811 -  by (simp add: wo_rel_def wo_rel.underS_ofilter)
   6.812 -  hence "Field ?p = underS r a" using 0 Field_Restr_ofilter by blast
   6.813 -  hence "Field ?p < Field r" using underS_Field2 1 by fast
   6.814 -  moreover have "?p <o r" using underS_Restr_ordLess[of r a] 0 1 by blast
   6.815 -  ultimately
   6.816 -  show "\<exists>p. Field p < Field r \<and> r' =o p \<and> p <o r" using 2 by blast
   6.817 -next
   6.818 -  assume "\<exists>p. Field p < Field r \<and> r' =o p \<and> p <o r"
   6.819 -  thus "r' <o r" using ordIso_ordLess_trans by blast
   6.820 -qed
   6.821 -
   6.822 -
   6.823 -lemma internalize_ordLeq:
   6.824 -"(r' \<le>o r) = (\<exists>p. Field p \<le> Field r \<and> r' =o p \<and> p \<le>o r)"
   6.825 -proof
   6.826 -  assume *: "r' \<le>o r"
   6.827 -  moreover
   6.828 -  {assume "r' <o r"
   6.829 -   then obtain p where "Field p < Field r \<and> r' =o p \<and> p <o r"
   6.830 -   using internalize_ordLess[of r' r] by blast
   6.831 -   hence "\<exists>p. Field p \<le> Field r \<and> r' =o p \<and> p \<le>o r"
   6.832 -   using ordLeq_iff_ordLess_or_ordIso by blast
   6.833 -  }
   6.834 -  moreover
   6.835 -  have "r \<le>o r" using * ordLeq_def ordLeq_reflexive by blast
   6.836 -  ultimately show "\<exists>p. Field p \<le> Field r \<and> r' =o p \<and> p \<le>o r"
   6.837 -  using ordLeq_iff_ordLess_or_ordIso by blast
   6.838 -next
   6.839 -  assume "\<exists>p. Field p \<le> Field r \<and> r' =o p \<and> p \<le>o r"
   6.840 -  thus "r' \<le>o r" using ordIso_ordLeq_trans by blast
   6.841 -qed
   6.842 -
   6.843 -
   6.844 -lemma ordLeq_iff_ordLess_Restr:
   6.845 -assumes WELL: "Well_order r" and WELL': "Well_order r'"
   6.846 -shows "(r \<le>o r') = (\<forall>a \<in> Field r. Restr r (underS r a) <o r')"
   6.847 -proof(auto)
   6.848 -  assume *: "r \<le>o r'"
   6.849 -  fix a assume "a \<in> Field r"
   6.850 -  hence "Restr r (underS r a) <o r"
   6.851 -  using WELL underS_Restr_ordLess[of r] by blast
   6.852 -  thus "Restr r (underS r a) <o r'"
   6.853 -  using * ordLess_ordLeq_trans by blast
   6.854 -next
   6.855 -  assume *: "\<forall>a \<in> Field r. Restr r (underS r a) <o r'"
   6.856 -  {assume "r' <o r"
   6.857 -   then obtain a where "a \<in> Field r \<and> r' =o Restr r (underS r a)"
   6.858 -   using assms ordLess_iff_ordIso_Restr by blast
   6.859 -   hence False using * not_ordLess_ordIso ordIso_symmetric by blast
   6.860 -  }
   6.861 -  thus "r \<le>o r'" using ordLess_or_ordLeq assms by blast
   6.862 -qed
   6.863 -
   6.864 -
   6.865 -lemma finite_ordLess_infinite:
   6.866 -assumes WELL: "Well_order r" and WELL': "Well_order r'" and
   6.867 -        FIN: "finite(Field r)" and INF: "\<not>finite(Field r')"
   6.868 -shows "r <o r'"
   6.869 -proof-
   6.870 -  {assume "r' \<le>o r"
   6.871 -   then obtain h where "inj_on h (Field r') \<and> h ` (Field r') \<le> Field r"
   6.872 -   unfolding ordLeq_def using assms embed_inj_on embed_Field by blast
   6.873 -   hence False using finite_imageD finite_subset FIN INF by metis
   6.874 -  }
   6.875 -  thus ?thesis using WELL WELL' ordLess_or_ordLeq by blast
   6.876 -qed
   6.877 -
   6.878 -
   6.879 -lemma finite_well_order_on_ordIso:
   6.880 -assumes FIN: "finite A" and
   6.881 -        WELL: "well_order_on A r" and WELL': "well_order_on A r'"
   6.882 -shows "r =o r'"
   6.883 -proof-
   6.884 -  have 0: "Well_order r \<and> Well_order r' \<and> Field r = A \<and> Field r' = A"
   6.885 -  using assms well_order_on_Well_order by blast
   6.886 -  moreover
   6.887 -  have "\<forall>r r'. well_order_on A r \<and> well_order_on A r' \<and> r \<le>o r'
   6.888 -                  \<longrightarrow> r =o r'"
   6.889 -  proof(clarify)
   6.890 -    fix r r' assume *: "well_order_on A r" and **: "well_order_on A r'"
   6.891 -    have 2: "Well_order r \<and> Well_order r' \<and> Field r = A \<and> Field r' = A"
   6.892 -    using * ** well_order_on_Well_order by blast
   6.893 -    assume "r \<le>o r'"
   6.894 -    then obtain f where 1: "embed r r' f" and
   6.895 -                        "inj_on f A \<and> f ` A \<le> A"
   6.896 -    unfolding ordLeq_def using 2 embed_inj_on embed_Field by blast
   6.897 -    hence "bij_betw f A A" unfolding bij_betw_def using FIN endo_inj_surj by blast
   6.898 -    thus "r =o r'" unfolding ordIso_def iso_def[abs_def] using 1 2 by auto
   6.899 -  qed
   6.900 -  ultimately show ?thesis using assms ordLeq_total ordIso_symmetric by metis
   6.901 -qed
   6.902 -
   6.903 -
   6.904 -subsection{* @{text "<o"} is well-founded *}
   6.905 -
   6.906 -
   6.907 -text {* Of course, it only makes sense to state that the @{text "<o"} is well-founded
   6.908 -on the restricted type @{text "'a rel rel"}.  We prove this by first showing that, for any set
   6.909 -of well-orders all embedded in a fixed well-order, the function mapping each well-order
   6.910 -in the set to an order filter of the fixed well-order is compatible w.r.t. to @{text "<o"} versus
   6.911 -{\em strict inclusion}; and we already know that strict inclusion of order filters is well-founded. *}
   6.912 -
   6.913 -
   6.914 -definition ord_to_filter :: "'a rel \<Rightarrow> 'a rel \<Rightarrow> 'a set"
   6.915 -where "ord_to_filter r0 r \<equiv> (SOME f. embed r r0 f) ` (Field r)"
   6.916 -
   6.917 -
   6.918 -lemma ord_to_filter_compat:
   6.919 -"compat (ordLess Int (ordLess^-1``{r0} \<times> ordLess^-1``{r0}))
   6.920 -        (ofilterIncl r0)
   6.921 -        (ord_to_filter r0)"
   6.922 -proof(unfold compat_def ord_to_filter_def, clarify)
   6.923 -  fix r1::"'a rel" and r2::"'a rel"
   6.924 -  let ?A1 = "Field r1"  let ?A2 ="Field r2" let ?A0 ="Field r0"
   6.925 -  let ?phi10 = "\<lambda> f10. embed r1 r0 f10" let ?f10 = "SOME f. ?phi10 f"
   6.926 -  let ?phi20 = "\<lambda> f20. embed r2 r0 f20" let ?f20 = "SOME f. ?phi20 f"
   6.927 -  assume *: "r1 <o r0" "r2 <o r0" and **: "r1 <o r2"
   6.928 -  hence "(\<exists>f. ?phi10 f) \<and> (\<exists>f. ?phi20 f)"
   6.929 -  by (auto simp add: ordLess_def embedS_def)
   6.930 -  hence "?phi10 ?f10 \<and> ?phi20 ?f20" by (auto simp add: someI_ex)
   6.931 -  thus "(?f10 ` ?A1, ?f20 ` ?A2) \<in> ofilterIncl r0"
   6.932 -  using * ** by (simp add: embed_ordLess_ofilterIncl)
   6.933 -qed
   6.934 -
   6.935 -
   6.936 -theorem wf_ordLess: "wf ordLess"
   6.937 -proof-
   6.938 -  {fix r0 :: "('a \<times> 'a) set"
   6.939 -   (* need to annotate here!*)
   6.940 -   let ?ordLess = "ordLess::('d rel * 'd rel) set"
   6.941 -   let ?R = "?ordLess Int (?ordLess^-1``{r0} \<times> ?ordLess^-1``{r0})"
   6.942 -   {assume Case1: "Well_order r0"
   6.943 -    hence "wf ?R"
   6.944 -    using wf_ofilterIncl[of r0]
   6.945 -          compat_wf[of ?R "ofilterIncl r0" "ord_to_filter r0"]
   6.946 -          ord_to_filter_compat[of r0] by auto
   6.947 -   }
   6.948 -   moreover
   6.949 -   {assume Case2: "\<not> Well_order r0"
   6.950 -    hence "?R = {}" unfolding ordLess_def by auto
   6.951 -    hence "wf ?R" using wf_empty by simp
   6.952 -   }
   6.953 -   ultimately have "wf ?R" by blast
   6.954 -  }
   6.955 -  thus ?thesis by (simp add: trans_wf_iff ordLess_trans)
   6.956 -qed
   6.957 -
   6.958 -corollary exists_minim_Well_order:
   6.959 -assumes NE: "R \<noteq> {}" and WELL: "\<forall>r \<in> R. Well_order r"
   6.960 -shows "\<exists>r \<in> R. \<forall>r' \<in> R. r \<le>o r'"
   6.961 -proof-
   6.962 -  obtain r where "r \<in> R \<and> (\<forall>r' \<in> R. \<not> r' <o r)"
   6.963 -  using NE spec[OF spec[OF subst[OF wf_eq_minimal, of "%x. x", OF wf_ordLess]], of _ R]
   6.964 -    equals0I[of R] by blast
   6.965 -  with not_ordLeq_iff_ordLess WELL show ?thesis by blast
   6.966 -qed
   6.967 -
   6.968 -
   6.969 -
   6.970 -subsection {* Copy via direct images  *}
   6.971 -
   6.972 -
   6.973 -text{* The direct image operator is the dual of the inverse image operator @{text "inv_image"}
   6.974 -from @{text "Relation.thy"}.  It is useful for transporting a well-order between
   6.975 -different types. *}
   6.976 -
   6.977 -
   6.978 -definition dir_image :: "'a rel \<Rightarrow> ('a \<Rightarrow> 'a') \<Rightarrow> 'a' rel"
   6.979 -where
   6.980 -"dir_image r f = {(f a, f b)| a b. (a,b) \<in> r}"
   6.981 -
   6.982 -
   6.983 -lemma dir_image_Field:
   6.984 -"Field(dir_image r f) \<le> f ` (Field r)"
   6.985 -unfolding dir_image_def Field_def by auto
   6.986 -
   6.987 -
   6.988 -lemma dir_image_minus_Id:
   6.989 -"inj_on f (Field r) \<Longrightarrow> (dir_image r f) - Id = dir_image (r - Id) f"
   6.990 -unfolding inj_on_def Field_def dir_image_def by auto
   6.991 -
   6.992 -
   6.993 -lemma Refl_dir_image:
   6.994 -assumes "Refl r"
   6.995 -shows "Refl(dir_image r f)"
   6.996 -proof-
   6.997 -  {fix a' b'
   6.998 -   assume "(a',b') \<in> dir_image r f"
   6.999 -   then obtain a b where 1: "a' = f a \<and> b' = f b \<and> (a,b) \<in> r"
  6.1000 -   unfolding dir_image_def by blast
  6.1001 -   hence "a \<in> Field r \<and> b \<in> Field r" using Field_def by fastforce
  6.1002 -   hence "(a,a) \<in> r \<and> (b,b) \<in> r" using assms by (simp add: refl_on_def)
  6.1003 -   with 1 have "(a',a') \<in> dir_image r f \<and> (b',b') \<in> dir_image r f"
  6.1004 -   unfolding dir_image_def by auto
  6.1005 -  }
  6.1006 -  thus ?thesis
  6.1007 -  by(unfold refl_on_def Field_def Domain_def Range_def, auto)
  6.1008 -qed
  6.1009 -
  6.1010 -
  6.1011 -lemma trans_dir_image:
  6.1012 -assumes TRANS: "trans r" and INJ: "inj_on f (Field r)"
  6.1013 -shows "trans(dir_image r f)"
  6.1014 -proof(unfold trans_def, auto)
  6.1015 -  fix a' b' c'
  6.1016 -  assume "(a',b') \<in> dir_image r f" "(b',c') \<in> dir_image r f"
  6.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
  6.1018 -                         2: "(a,b1) \<in> r \<and> (b2,c) \<in> r"
  6.1019 -  unfolding dir_image_def by blast
  6.1020 -  hence "b1 \<in> Field r \<and> b2 \<in> Field r"
  6.1021 -  unfolding Field_def by auto
  6.1022 -  hence "b1 = b2" using 1 INJ unfolding inj_on_def by auto
  6.1023 -  hence "(a,c): r" using 2 TRANS unfolding trans_def by blast
  6.1024 -  thus "(a',c') \<in> dir_image r f"
  6.1025 -  unfolding dir_image_def using 1 by auto
  6.1026 -qed
  6.1027 -
  6.1028 -
  6.1029 -lemma Preorder_dir_image:
  6.1030 -"\<lbrakk>Preorder r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> Preorder (dir_image r f)"
  6.1031 -by (simp add: preorder_on_def Refl_dir_image trans_dir_image)
  6.1032 -
  6.1033 -
  6.1034 -lemma antisym_dir_image:
  6.1035 -assumes AN: "antisym r" and INJ: "inj_on f (Field r)"
  6.1036 -shows "antisym(dir_image r f)"
  6.1037 -proof(unfold antisym_def, auto)
  6.1038 -  fix a' b'
  6.1039 -  assume "(a',b') \<in> dir_image r f" "(b',a') \<in> dir_image r f"
  6.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
  6.1041 -                           2: "(a1,b1) \<in> r \<and> (b2,a2) \<in> r " and
  6.1042 -                           3: "{a1,a2,b1,b2} \<le> Field r"
  6.1043 -  unfolding dir_image_def Field_def by blast
  6.1044 -  hence "a1 = a2 \<and> b1 = b2" using INJ unfolding inj_on_def by auto
  6.1045 -  hence "a1 = b2" using 2 AN unfolding antisym_def by auto
  6.1046 -  thus "a' = b'" using 1 by auto
  6.1047 -qed
  6.1048 -
  6.1049 -
  6.1050 -lemma Partial_order_dir_image:
  6.1051 -"\<lbrakk>Partial_order r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> Partial_order (dir_image r f)"
  6.1052 -by (simp add: partial_order_on_def Preorder_dir_image antisym_dir_image)
  6.1053 -
  6.1054 -
  6.1055 -lemma Total_dir_image:
  6.1056 -assumes TOT: "Total r" and INJ: "inj_on f (Field r)"
  6.1057 -shows "Total(dir_image r f)"
  6.1058 -proof(unfold total_on_def, intro ballI impI)
  6.1059 -  fix a' b'
  6.1060 -  assume "a' \<in> Field (dir_image r f)" "b' \<in> Field (dir_image r f)"
  6.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'"
  6.1062 -  using dir_image_Field[of r f] by blast
  6.1063 -  moreover assume "a' \<noteq> b'"
  6.1064 -  ultimately have "a \<noteq> b" using INJ unfolding inj_on_def by auto
  6.1065 -  hence "(a,b) \<in> r \<or> (b,a) \<in> r" using 1 TOT unfolding total_on_def by auto
  6.1066 -  thus "(a',b') \<in> dir_image r f \<or> (b',a') \<in> dir_image r f"
  6.1067 -  using 1 unfolding dir_image_def by auto
  6.1068 -qed
  6.1069 -
  6.1070 -
  6.1071 -lemma Linear_order_dir_image:
  6.1072 -"\<lbrakk>Linear_order r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> Linear_order (dir_image r f)"
  6.1073 -by (simp add: linear_order_on_def Partial_order_dir_image Total_dir_image)
  6.1074 -
  6.1075 -
  6.1076 -lemma wf_dir_image:
  6.1077 -assumes WF: "wf r" and INJ: "inj_on f (Field r)"
  6.1078 -shows "wf(dir_image r f)"
  6.1079 -proof(unfold wf_eq_minimal2, intro allI impI, elim conjE)
  6.1080 -  fix A'::"'b set"
  6.1081 -  assume SUB: "A' \<le> Field(dir_image r f)" and NE: "A' \<noteq> {}"
  6.1082 -  obtain A where A_def: "A = {a \<in> Field r. f a \<in> A'}" by blast
  6.1083 -  have "A \<noteq> {} \<and> A \<le> Field r"
  6.1084 -  using A_def dir_image_Field[of r f] SUB NE by blast
  6.1085 -  then obtain a where 1: "a \<in> A \<and> (\<forall>b \<in> A. (b,a) \<notin> r)"
  6.1086 -  using WF unfolding wf_eq_minimal2 by metis
  6.1087 -  have "\<forall>b' \<in> A'. (b',f a) \<notin> dir_image r f"
  6.1088 -  proof(clarify)
  6.1089 -    fix b' assume *: "b' \<in> A'" and **: "(b',f a) \<in> dir_image r f"
  6.1090 -    obtain b1 a1 where 2: "b' = f b1 \<and> f a = f a1" and
  6.1091 -                       3: "(b1,a1) \<in> r \<and> {a1,b1} \<le> Field r"
  6.1092 -    using ** unfolding dir_image_def Field_def by blast
  6.1093 -    hence "a = a1" using 1 A_def INJ unfolding inj_on_def by auto
  6.1094 -    hence "b1 \<in> A \<and> (b1,a) \<in> r" using 2 3 A_def * by auto
  6.1095 -    with 1 show False by auto
  6.1096 -  qed
  6.1097 -  thus "\<exists>a'\<in>A'. \<forall>b'\<in>A'. (b', a') \<notin> dir_image r f"
  6.1098 -  using A_def 1 by blast
  6.1099 -qed
  6.1100 -
  6.1101 -
  6.1102 -lemma Well_order_dir_image:
  6.1103 -"\<lbrakk>Well_order r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> Well_order (dir_image r f)"
  6.1104 -using assms unfolding well_order_on_def
  6.1105 -using Linear_order_dir_image[of r f] wf_dir_image[of "r - Id" f]
  6.1106 -  dir_image_minus_Id[of f r]
  6.1107 -  subset_inj_on[of f "Field r" "Field(r - Id)"]
  6.1108 -  mono_Field[of "r - Id" r] by auto
  6.1109 -
  6.1110 -
  6.1111 -lemma dir_image_Field2:
  6.1112 -"Refl r \<Longrightarrow> Field(dir_image r f) = f ` (Field r)"
  6.1113 -unfolding Field_def dir_image_def refl_on_def Domain_def Range_def by blast
  6.1114 -
  6.1115 -
  6.1116 -lemma dir_image_bij_betw:
  6.1117 -"\<lbrakk>Well_order r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> bij_betw f (Field r) (Field (dir_image r f))"
  6.1118 -unfolding bij_betw_def
  6.1119 -by (simp add: dir_image_Field2 order_on_defs)
  6.1120 -
  6.1121 -
  6.1122 -lemma dir_image_compat:
  6.1123 -"compat r (dir_image r f) f"
  6.1124 -unfolding compat_def dir_image_def by auto
  6.1125 -
  6.1126 -
  6.1127 -lemma dir_image_iso:
  6.1128 -"\<lbrakk>Well_order r; inj_on f (Field r)\<rbrakk>  \<Longrightarrow> iso r (dir_image r f) f"
  6.1129 -using iso_iff3 dir_image_compat dir_image_bij_betw Well_order_dir_image by blast
  6.1130 -
  6.1131 -
  6.1132 -lemma dir_image_ordIso:
  6.1133 -"\<lbrakk>Well_order r; inj_on f (Field r)\<rbrakk>  \<Longrightarrow> r =o dir_image r f"
  6.1134 -unfolding ordIso_def using dir_image_iso Well_order_dir_image by blast
  6.1135 -
  6.1136 -
  6.1137 -lemma Well_order_iso_copy:
  6.1138 -assumes WELL: "well_order_on A r" and BIJ: "bij_betw f A A'"
  6.1139 -shows "\<exists>r'. well_order_on A' r' \<and> r =o r'"
  6.1140 -proof-
  6.1141 -   let ?r' = "dir_image r f"
  6.1142 -   have 1: "A = Field r \<and> Well_order r"
  6.1143 -   using WELL well_order_on_Well_order by blast
  6.1144 -   hence 2: "iso r ?r' f"
  6.1145 -   using dir_image_iso using BIJ unfolding bij_betw_def by auto
  6.1146 -   hence "f ` (Field r) = Field ?r'" using 1 iso_iff[of r ?r'] by blast
  6.1147 -   hence "Field ?r' = A'"
  6.1148 -   using 1 BIJ unfolding bij_betw_def by auto
  6.1149 -   moreover have "Well_order ?r'"
  6.1150 -   using 1 Well_order_dir_image BIJ unfolding bij_betw_def by blast
  6.1151 -   ultimately show ?thesis unfolding ordIso_def using 1 2 by blast
  6.1152 -qed
  6.1153 -
  6.1154 -
  6.1155 -
  6.1156 -subsection {* Bounded square  *}
  6.1157 -
  6.1158 -
  6.1159 -text{* This construction essentially defines, for an order relation @{text "r"}, a lexicographic
  6.1160 -order @{text "bsqr r"} on @{text "(Field r) \<times> (Field r)"}, applying the
  6.1161 -following criteria (in this order):
  6.1162 -\begin{itemize}
  6.1163 -\item compare the maximums;
  6.1164 -\item compare the first components;
  6.1165 -\item compare the second components.
  6.1166 -\end{itemize}
  6.1167 -%
  6.1168 -The only application of this construction that we are aware of is
  6.1169 -at proving that the square of an infinite set has the same cardinal
  6.1170 -as that set. The essential property required there (and which is ensured by this
  6.1171 -construction) is that any proper order filter of the product order is included in a rectangle, i.e.,
  6.1172 -in a product of proper filters on the original relation (assumed to be a well-order). *}
  6.1173 -
  6.1174 -
  6.1175 -definition bsqr :: "'a rel => ('a * 'a)rel"
  6.1176 -where
  6.1177 -"bsqr r = {((a1,a2),(b1,b2)).
  6.1178 -           {a1,a2,b1,b2} \<le> Field r \<and>
  6.1179 -           (a1 = b1 \<and> a2 = b2 \<or>
  6.1180 -            (wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r - Id \<or>
  6.1181 -            wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> (a1,b1) \<in> r - Id \<or>
  6.1182 -            wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> a1 = b1  \<and> (a2,b2) \<in> r - Id
  6.1183 -           )}"
  6.1184 -
  6.1185 -
  6.1186 -lemma Field_bsqr:
  6.1187 -"Field (bsqr r) = Field r \<times> Field r"
  6.1188 -proof
  6.1189 -  show "Field (bsqr r) \<le> Field r \<times> Field r"
  6.1190 -  proof-
  6.1191 -    {fix a1 a2 assume "(a1,a2) \<in> Field (bsqr r)"
  6.1192 -     moreover
  6.1193 -     have "\<And> b1 b2. ((a1,a2),(b1,b2)) \<in> bsqr r \<or> ((b1,b2),(a1,a2)) \<in> bsqr r \<Longrightarrow>
  6.1194 -                      a1 \<in> Field r \<and> a2 \<in> Field r" unfolding bsqr_def by auto
  6.1195 -     ultimately have "a1 \<in> Field r \<and> a2 \<in> Field r" unfolding Field_def by auto
  6.1196 -    }
  6.1197 -    thus ?thesis unfolding Field_def by force
  6.1198 -  qed
  6.1199 -next
  6.1200 -  show "Field r \<times> Field r \<le> Field (bsqr r)"
  6.1201 -  proof(auto)
  6.1202 -    fix a1 a2 assume "a1 \<in> Field r" and "a2 \<in> Field r"
  6.1203 -    hence "((a1,a2),(a1,a2)) \<in> bsqr r" unfolding bsqr_def by blast
  6.1204 -    thus "(a1,a2) \<in> Field (bsqr r)" unfolding Field_def by auto
  6.1205 -  qed
  6.1206 -qed
  6.1207 -
  6.1208 -
  6.1209 -lemma bsqr_Refl: "Refl(bsqr r)"
  6.1210 -by(unfold refl_on_def Field_bsqr, auto simp add: bsqr_def)
  6.1211 -
  6.1212 -
  6.1213 -lemma bsqr_Trans:
  6.1214 -assumes "Well_order r"
  6.1215 -shows "trans (bsqr r)"
  6.1216 -proof(unfold trans_def, auto)
  6.1217 -  (* Preliminary facts *)
  6.1218 -  have Well: "wo_rel r" using assms wo_rel_def by auto
  6.1219 -  hence Trans: "trans r" using wo_rel.TRANS by auto
  6.1220 -  have Anti: "antisym r" using wo_rel.ANTISYM Well by auto
  6.1221 -  hence TransS: "trans(r - Id)" using Trans by (simp add: trans_diff_Id)
  6.1222 -  (* Main proof *)
  6.1223 -  fix a1 a2 b1 b2 c1 c2
  6.1224 -  assume *: "((a1,a2),(b1,b2)) \<in> bsqr r" and **: "((b1,b2),(c1,c2)) \<in> bsqr r"
  6.1225 -  hence 0: "{a1,a2,b1,b2,c1,c2} \<le> Field r" unfolding bsqr_def by auto
  6.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>
  6.1227 -           wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> (a1,b1) \<in> r - Id \<or>
  6.1228 -           wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> a1 = b1 \<and> (a2,b2) \<in> r - Id"
  6.1229 -  using * unfolding bsqr_def by auto
  6.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>
  6.1231 -           wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> (b1,c1) \<in> r - Id \<or>
  6.1232 -           wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> b1 = c1 \<and> (b2,c2) \<in> r - Id"
  6.1233 -  using ** unfolding bsqr_def by auto
  6.1234 -  show "((a1,a2),(c1,c2)) \<in> bsqr r"
  6.1235 -  proof-
  6.1236 -    {assume Case1: "a1 = b1 \<and> a2 = b2"
  6.1237 -     hence ?thesis using ** by simp
  6.1238 -    }
  6.1239 -    moreover
  6.1240 -    {assume Case2: "(wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r - Id"
  6.1241 -     {assume Case21: "b1 = c1 \<and> b2 = c2"
  6.1242 -      hence ?thesis using * by simp
  6.1243 -     }
  6.1244 -     moreover
  6.1245 -     {assume Case22: "(wo_rel.max2 r b1 b2, wo_rel.max2 r c1 c2) \<in> r - Id"
  6.1246 -      hence "(wo_rel.max2 r a1 a2, wo_rel.max2 r c1 c2) \<in> r - Id"
  6.1247 -      using Case2 TransS trans_def[of "r - Id"] by blast
  6.1248 -      hence ?thesis using 0 unfolding bsqr_def by auto
  6.1249 -     }
  6.1250 -     moreover
  6.1251 -     {assume Case23_4: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2"
  6.1252 -      hence ?thesis using Case2 0 unfolding bsqr_def by auto
  6.1253 -     }
  6.1254 -     ultimately have ?thesis using 0 2 by auto
  6.1255 -    }
  6.1256 -    moreover
  6.1257 -    {assume Case3: "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> (a1,b1) \<in> r - Id"
  6.1258 -     {assume Case31: "b1 = c1 \<and> b2 = c2"
  6.1259 -      hence ?thesis using * by simp
  6.1260 -     }
  6.1261 -     moreover
  6.1262 -     {assume Case32: "(wo_rel.max2 r b1 b2, wo_rel.max2 r c1 c2) \<in> r - Id"
  6.1263 -      hence ?thesis using Case3 0 unfolding bsqr_def by auto
  6.1264 -     }
  6.1265 -     moreover
  6.1266 -     {assume Case33: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> (b1,c1) \<in> r - Id"
  6.1267 -      hence "(a1,c1) \<in> r - Id"
  6.1268 -      using Case3 TransS trans_def[of "r - Id"] by blast
  6.1269 -      hence ?thesis using Case3 Case33 0 unfolding bsqr_def by auto
  6.1270 -     }
  6.1271 -     moreover
  6.1272 -     {assume Case33: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> b1 = c1"
  6.1273 -      hence ?thesis using Case3 0 unfolding bsqr_def by auto
  6.1274 -     }
  6.1275 -     ultimately have ?thesis using 0 2 by auto
  6.1276 -    }
  6.1277 -    moreover
  6.1278 -    {assume Case4: "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> a1 = b1 \<and> (a2,b2) \<in> r - Id"
  6.1279 -     {assume Case41: "b1 = c1 \<and> b2 = c2"
  6.1280 -      hence ?thesis using * by simp
  6.1281 -     }
  6.1282 -     moreover
  6.1283 -     {assume Case42: "(wo_rel.max2 r b1 b2, wo_rel.max2 r c1 c2) \<in> r - Id"
  6.1284 -      hence ?thesis using Case4 0 unfolding bsqr_def by force
  6.1285 -     }
  6.1286 -     moreover
  6.1287 -     {assume Case43: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> (b1,c1) \<in> r - Id"
  6.1288 -      hence ?thesis using Case4 0 unfolding bsqr_def by auto
  6.1289 -     }
  6.1290 -     moreover
  6.1291 -     {assume Case44: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> b1 = c1 \<and> (b2,c2) \<in> r - Id"
  6.1292 -      hence "(a2,c2) \<in> r - Id"
  6.1293 -      using Case4 TransS trans_def[of "r - Id"] by blast
  6.1294 -      hence ?thesis using Case4 Case44 0 unfolding bsqr_def by auto
  6.1295 -     }
  6.1296 -     ultimately have ?thesis using 0 2 by auto
  6.1297 -    }
  6.1298 -    ultimately show ?thesis using 0 1 by auto
  6.1299 -  qed
  6.1300 -qed
  6.1301 -
  6.1302 -
  6.1303 -lemma bsqr_antisym:
  6.1304 -assumes "Well_order r"
  6.1305 -shows "antisym (bsqr r)"
  6.1306 -proof(unfold antisym_def, clarify)
  6.1307 -  (* Preliminary facts *)
  6.1308 -  have Well: "wo_rel r" using assms wo_rel_def by auto
  6.1309 -  hence Trans: "trans r" using wo_rel.TRANS by auto
  6.1310 -  have Anti: "antisym r" using wo_rel.ANTISYM Well by auto
  6.1311 -  hence TransS: "trans(r - Id)" using Trans by (simp add: trans_diff_Id)
  6.1312 -  hence IrrS: "\<forall>a b. \<not>((a,b) \<in> r - Id \<and> (b,a) \<in> r - Id)"
  6.1313 -  using Anti trans_def[of "r - Id"] antisym_def[of "r - Id"] by blast
  6.1314 -  (* Main proof *)
  6.1315 -  fix a1 a2 b1 b2
  6.1316 -  assume *: "((a1,a2),(b1,b2)) \<in> bsqr r" and **: "((b1,b2),(a1,a2)) \<in> bsqr r"
  6.1317 -  hence 0: "{a1,a2,b1,b2} \<le> Field r" unfolding bsqr_def by auto
  6.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>
  6.1319 -           wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> (a1,b1) \<in> r - Id \<or>
  6.1320 -           wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> a1 = b1 \<and> (a2,b2) \<in> r - Id"
  6.1321 -  using * unfolding bsqr_def by auto
  6.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>
  6.1323 -           wo_rel.max2 r b1 b2 = wo_rel.max2 r a1 a2 \<and> (b1,a1) \<in> r - Id \<or>
  6.1324 -           wo_rel.max2 r b1 b2 = wo_rel.max2 r a1 a2 \<and> b1 = a1 \<and> (b2,a2) \<in> r - Id"
  6.1325 -  using ** unfolding bsqr_def by auto
  6.1326 -  show "a1 = b1 \<and> a2 = b2"
  6.1327 -  proof-
  6.1328 -    {assume Case1: "(wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r - Id"
  6.1329 -     {assume Case11: "(wo_rel.max2 r b1 b2, wo_rel.max2 r a1 a2) \<in> r - Id"
  6.1330 -      hence False using Case1 IrrS by blast
  6.1331 -     }
  6.1332 -     moreover
  6.1333 -     {assume Case12_3: "wo_rel.max2 r b1 b2 = wo_rel.max2 r a1 a2"
  6.1334 -      hence False using Case1 by auto
  6.1335 -     }
  6.1336 -     ultimately have ?thesis using 0 2 by auto
  6.1337 -    }
  6.1338 -    moreover
  6.1339 -    {assume Case2: "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> (a1,b1) \<in> r - Id"
  6.1340 -     {assume Case21: "(wo_rel.max2 r b1 b2, wo_rel.max2 r a1 a2) \<in> r - Id"
  6.1341 -       hence False using Case2 by auto
  6.1342 -     }
  6.1343 -     moreover
  6.1344 -     {assume Case22: "(b1,a1) \<in> r - Id"
  6.1345 -      hence False using Case2 IrrS by blast
  6.1346 -     }
  6.1347 -     moreover
  6.1348 -     {assume Case23: "b1 = a1"
  6.1349 -      hence False using Case2 by auto
  6.1350 -     }
  6.1351 -     ultimately have ?thesis using 0 2 by auto
  6.1352 -    }
  6.1353 -    moreover
  6.1354 -    {assume Case3: "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> a1 = b1 \<and> (a2,b2) \<in> r - Id"
  6.1355 -     moreover
  6.1356 -     {assume Case31: "(wo_rel.max2 r b1 b2, wo_rel.max2 r a1 a2) \<in> r - Id"
  6.1357 -      hence False using Case3 by auto
  6.1358 -     }
  6.1359 -     moreover
  6.1360 -     {assume Case32: "(b1,a1) \<in> r - Id"
  6.1361 -      hence False using Case3 by auto
  6.1362 -     }
  6.1363 -     moreover
  6.1364 -     {assume Case33: "(b2,a2) \<in> r - Id"
  6.1365 -      hence False using Case3 IrrS by blast
  6.1366 -     }
  6.1367 -     ultimately have ?thesis using 0 2 by auto
  6.1368 -    }
  6.1369 -    ultimately show ?thesis using 0 1 by blast
  6.1370 -  qed
  6.1371 -qed
  6.1372 -
  6.1373 -
  6.1374 -lemma bsqr_Total:
  6.1375 -assumes "Well_order r"
  6.1376 -shows "Total(bsqr r)"
  6.1377 -proof-
  6.1378 -  (* Preliminary facts *)
  6.1379 -  have Well: "wo_rel r" using assms wo_rel_def by auto
  6.1380 -  hence Total: "\<forall>a \<in> Field r. \<forall>b \<in> Field r. (a,b) \<in> r \<or> (b,a) \<in> r"
  6.1381 -  using wo_rel.TOTALS by auto
  6.1382 -  (* Main proof *)
  6.1383 -  {fix a1 a2 b1 b2 assume "{(a1,a2), (b1,b2)} \<le> Field(bsqr r)"
  6.1384 -   hence 0: "a1 \<in> Field r \<and> a2 \<in> Field r \<and> b1 \<in> Field r \<and> b2 \<in> Field r"
  6.1385 -   using Field_bsqr by blast
  6.1386 -   have "((a1,a2) = (b1,b2) \<or> ((a1,a2),(b1,b2)) \<in> bsqr r \<or> ((b1,b2),(a1,a2)) \<in> bsqr r)"
  6.1387 -   proof(rule wo_rel.cases_Total[of r a1 a2], clarsimp simp add: Well, simp add: 0)
  6.1388 -       (* Why didn't clarsimp simp add: Well 0 do the same job? *)
  6.1389 -     assume Case1: "(a1,a2) \<in> r"
  6.1390 -     hence 1: "wo_rel.max2 r a1 a2 = a2"
  6.1391 -     using Well 0 by (simp add: wo_rel.max2_equals2)
  6.1392 -     show ?thesis
  6.1393 -     proof(rule wo_rel.cases_Total[of r b1 b2], clarsimp simp add: Well, simp add: 0)
  6.1394 -       assume Case11: "(b1,b2) \<in> r"
  6.1395 -       hence 2: "wo_rel.max2 r b1 b2 = b2"
  6.1396 -       using Well 0 by (simp add: wo_rel.max2_equals2)
  6.1397 -       show ?thesis
  6.1398 -       proof(rule wo_rel.cases_Total3[of r a2 b2], clarsimp simp add: Well, simp add: 0)
  6.1399 -         assume Case111: "(a2,b2) \<in> r - Id \<or> (b2,a2) \<in> r - Id"
  6.1400 -         thus ?thesis using 0 1 2 unfolding bsqr_def by auto
  6.1401 -       next
  6.1402 -         assume Case112: "a2 = b2"
  6.1403 -         show ?thesis
  6.1404 -         proof(rule wo_rel.cases_Total3[of r a1 b1], clarsimp simp add: Well, simp add: 0)
  6.1405 -           assume Case1121: "(a1,b1) \<in> r - Id \<or> (b1,a1) \<in> r - Id"
  6.1406 -           thus ?thesis using 0 1 2 Case112 unfolding bsqr_def by auto
  6.1407 -         next
  6.1408 -           assume Case1122: "a1 = b1"
  6.1409 -           thus ?thesis using Case112 by auto
  6.1410 -         qed
  6.1411 -       qed
  6.1412 -     next
  6.1413 -       assume Case12: "(b2,b1) \<in> r"
  6.1414 -       hence 3: "wo_rel.max2 r b1 b2 = b1" using Well 0 by (simp add: wo_rel.max2_equals1)
  6.1415 -       show ?thesis
  6.1416 -       proof(rule wo_rel.cases_Total3[of r a2 b1], clarsimp simp add: Well, simp add: 0)
  6.1417 -         assume Case121: "(a2,b1) \<in> r - Id \<or> (b1,a2) \<in> r - Id"
  6.1418 -         thus ?thesis using 0 1 3 unfolding bsqr_def by auto
  6.1419 -       next
  6.1420 -         assume Case122: "a2 = b1"
  6.1421 -         show ?thesis
  6.1422 -         proof(rule wo_rel.cases_Total3[of r a1 b1], clarsimp simp add: Well, simp add: 0)
  6.1423 -           assume Case1221: "(a1,b1) \<in> r - Id \<or> (b1,a1) \<in> r - Id"
  6.1424 -           thus ?thesis using 0 1 3 Case122 unfolding bsqr_def by auto
  6.1425 -         next
  6.1426 -           assume Case1222: "a1 = b1"
  6.1427 -           show ?thesis
  6.1428 -           proof(rule wo_rel.cases_Total3[of r a2 b2], clarsimp simp add: Well, simp add: 0)
  6.1429 -             assume Case12221: "(a2,b2) \<in> r - Id \<or> (b2,a2) \<in> r - Id"
  6.1430 -             thus ?thesis using 0 1 3 Case122 Case1222 unfolding bsqr_def by auto
  6.1431 -           next
  6.1432 -             assume Case12222: "a2 = b2"
  6.1433 -             thus ?thesis using Case122 Case1222 by auto
  6.1434 -           qed
  6.1435 -         qed
  6.1436 -       qed
  6.1437 -     qed
  6.1438 -   next
  6.1439 -     assume Case2: "(a2,a1) \<in> r"
  6.1440 -     hence 1: "wo_rel.max2 r a1 a2 = a1" using Well 0 by (simp add: wo_rel.max2_equals1)
  6.1441 -     show ?thesis
  6.1442 -     proof(rule wo_rel.cases_Total[of r b1 b2], clarsimp simp add: Well, simp add: 0)
  6.1443 -       assume Case21: "(b1,b2) \<in> r"
  6.1444 -       hence 2: "wo_rel.max2 r b1 b2 = b2" using Well 0 by (simp add: wo_rel.max2_equals2)
  6.1445 -       show ?thesis
  6.1446 -       proof(rule wo_rel.cases_Total3[of r a1 b2], clarsimp simp add: Well, simp add: 0)
  6.1447 -         assume Case211: "(a1,b2) \<in> r - Id \<or> (b2,a1) \<in> r - Id"
  6.1448 -         thus ?thesis using 0 1 2 unfolding bsqr_def by auto
  6.1449 -       next
  6.1450 -         assume Case212: "a1 = b2"
  6.1451 -         show ?thesis
  6.1452 -         proof(rule wo_rel.cases_Total3[of r a1 b1], clarsimp simp add: Well, simp add: 0)
  6.1453 -           assume Case2121: "(a1,b1) \<in> r - Id \<or> (b1,a1) \<in> r - Id"
  6.1454 -           thus ?thesis using 0 1 2 Case212 unfolding bsqr_def by auto
  6.1455 -         next
  6.1456 -           assume Case2122: "a1 = b1"
  6.1457 -           show ?thesis
  6.1458 -           proof(rule wo_rel.cases_Total3[of r a2 b2], clarsimp simp add: Well, simp add: 0)
  6.1459 -             assume Case21221: "(a2,b2) \<in> r - Id \<or> (b2,a2) \<in> r - Id"
  6.1460 -             thus ?thesis using 0 1 2 Case212 Case2122 unfolding bsqr_def by auto
  6.1461 -           next
  6.1462 -             assume Case21222: "a2 = b2"
  6.1463 -             thus ?thesis using Case2122 Case212 by auto
  6.1464 -           qed
  6.1465 -         qed
  6.1466 -       qed
  6.1467 -     next
  6.1468 -       assume Case22: "(b2,b1) \<in> r"
  6.1469 -       hence 3: "wo_rel.max2 r b1 b2 = b1"  using Well 0 by (simp add: wo_rel.max2_equals1)
  6.1470 -       show ?thesis
  6.1471 -       proof(rule wo_rel.cases_Total3[of r a1 b1], clarsimp simp add: Well, simp add: 0)
  6.1472 -         assume Case221: "(a1,b1) \<in> r - Id \<or> (b1,a1) \<in> r - Id"
  6.1473 -         thus ?thesis using 0 1 3 unfolding bsqr_def by auto
  6.1474 -       next
  6.1475 -         assume Case222: "a1 = b1"
  6.1476 -         show ?thesis
  6.1477 -         proof(rule wo_rel.cases_Total3[of r a2 b2], clarsimp simp add: Well, simp add: 0)
  6.1478 -           assume Case2221: "(a2,b2) \<in> r - Id \<or> (b2,a2) \<in> r - Id"
  6.1479 -           thus ?thesis using 0 1 3 Case222 unfolding bsqr_def by auto
  6.1480 -         next
  6.1481 -           assume Case2222: "a2 = b2"
  6.1482 -           thus ?thesis using Case222 by auto
  6.1483 -         qed
  6.1484 -       qed
  6.1485 -     qed
  6.1486 -   qed
  6.1487 -  }
  6.1488 -  thus ?thesis unfolding total_on_def by fast
  6.1489 -qed
  6.1490 -
  6.1491 -
  6.1492 -lemma bsqr_Linear_order:
  6.1493 -assumes "Well_order r"
  6.1494 -shows "Linear_order(bsqr r)"
  6.1495 -unfolding order_on_defs
  6.1496 -using assms bsqr_Refl bsqr_Trans bsqr_antisym bsqr_Total by blast
  6.1497 -
  6.1498 -
  6.1499 -lemma bsqr_Well_order:
  6.1500 -assumes "Well_order r"
  6.1501 -shows "Well_order(bsqr r)"
  6.1502 -using assms
  6.1503 -proof(simp add: bsqr_Linear_order Linear_order_Well_order_iff, intro allI impI)
  6.1504 -  have 0: "\<forall>A \<le> Field r. A \<noteq> {} \<longrightarrow> (\<exists>a \<in> A. \<forall>a' \<in> A. (a,a') \<in> r)"
  6.1505 -  using assms well_order_on_def Linear_order_Well_order_iff by blast
  6.1506 -  fix D assume *: "D \<le> Field (bsqr r)" and **: "D \<noteq> {}"
  6.1507 -  hence 1: "D \<le> Field r \<times> Field r" unfolding Field_bsqr by simp
  6.1508 -  (*  *)
  6.1509 -  obtain M where M_def: "M = {wo_rel.max2 r a1 a2| a1 a2. (a1,a2) \<in> D}" by blast
  6.1510 -  have "M \<noteq> {}" using 1 M_def ** by auto
  6.1511 -  moreover
  6.1512 -  have "M \<le> Field r" unfolding M_def
  6.1513 -  using 1 assms wo_rel_def[of r] wo_rel.max2_among[of r] by fastforce
  6.1514 -  ultimately obtain m where m_min: "m \<in> M \<and> (\<forall>a \<in> M. (m,a) \<in> r)"
  6.1515 -  using 0 by blast
  6.1516 -  (*  *)
  6.1517 -  obtain A1 where A1_def: "A1 = {a1. \<exists>a2. (a1,a2) \<in> D \<and> wo_rel.max2 r a1 a2 = m}" by blast
  6.1518 -  have "A1 \<le> Field r" unfolding A1_def using 1 by auto
  6.1519 -  moreover have "A1 \<noteq> {}" unfolding A1_def using m_min unfolding M_def by blast
  6.1520 -  ultimately obtain a1 where a1_min: "a1 \<in> A1 \<and> (\<forall>a \<in> A1. (a1,a) \<in> r)"
  6.1521 -  using 0 by blast
  6.1522 -  (*  *)
  6.1523 -  obtain A2 where A2_def: "A2 = {a2. (a1,a2) \<in> D \<and> wo_rel.max2 r a1 a2 = m}" by blast
  6.1524 -  have "A2 \<le> Field r" unfolding A2_def using 1 by auto
  6.1525 -  moreover have "A2 \<noteq> {}" unfolding A2_def
  6.1526 -  using m_min a1_min unfolding A1_def M_def by blast
  6.1527 -  ultimately obtain a2 where a2_min: "a2 \<in> A2 \<and> (\<forall>a \<in> A2. (a2,a) \<in> r)"
  6.1528 -  using 0 by blast
  6.1529 -  (*   *)
  6.1530 -  have 2: "wo_rel.max2 r a1 a2 = m"
  6.1531 -  using a1_min a2_min unfolding A1_def A2_def by auto
  6.1532 -  have 3: "(a1,a2) \<in> D" using a2_min unfolding A2_def by auto
  6.1533 -  (*  *)
  6.1534 -  moreover
  6.1535 -  {fix b1 b2 assume ***: "(b1,b2) \<in> D"
  6.1536 -   hence 4: "{a1,a2,b1,b2} \<le> Field r" using 1 3 by blast
  6.1537 -   have 5: "(wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r"
  6.1538 -   using *** a1_min a2_min m_min unfolding A1_def A2_def M_def by auto
  6.1539 -   have "((a1,a2),(b1,b2)) \<in> bsqr r"
  6.1540 -   proof(cases "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2")
  6.1541 -     assume Case1: "wo_rel.max2 r a1 a2 \<noteq> wo_rel.max2 r b1 b2"
  6.1542 -     thus ?thesis unfolding bsqr_def using 4 5 by auto
  6.1543 -   next
  6.1544 -     assume Case2: "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2"
  6.1545 -     hence "b1 \<in> A1" unfolding A1_def using 2 *** by auto
  6.1546 -     hence 6: "(a1,b1) \<in> r" using a1_min by auto
  6.1547 -     show ?thesis
  6.1548 -     proof(cases "a1 = b1")
  6.1549 -       assume Case21: "a1 \<noteq> b1"
  6.1550 -       thus ?thesis unfolding bsqr_def using 4 Case2 6 by auto
  6.1551 -     next
  6.1552 -       assume Case22: "a1 = b1"
  6.1553 -       hence "b2 \<in> A2" unfolding A2_def using 2 *** Case2 by auto
  6.1554 -       hence 7: "(a2,b2) \<in> r" using a2_min by auto
  6.1555 -       thus ?thesis unfolding bsqr_def using 4 7 Case2 Case22 by auto
  6.1556 -     qed
  6.1557 -   qed
  6.1558 -  }
  6.1559 -  (*  *)
  6.1560 -  ultimately show "\<exists>d \<in> D. \<forall>d' \<in> D. (d,d') \<in> bsqr r" by fastforce
  6.1561 -qed
  6.1562 -
  6.1563 -
  6.1564 -lemma bsqr_max2:
  6.1565 -assumes WELL: "Well_order r" and LEQ: "((a1,a2),(b1,b2)) \<in> bsqr r"
  6.1566 -shows "(wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r"
  6.1567 -proof-
  6.1568 -  have "{(a1,a2),(b1,b2)} \<le> Field(bsqr r)"
  6.1569 -  using LEQ unfolding Field_def by auto
  6.1570 -  hence "{a1,a2,b1,b2} \<le> Field r" unfolding Field_bsqr by auto
  6.1571 -  hence "{wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2} \<le> Field r"
  6.1572 -  using WELL wo_rel_def[of r] wo_rel.max2_among[of r] by fastforce
  6.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"
  6.1574 -  using LEQ unfolding bsqr_def by auto
  6.1575 -  ultimately show ?thesis using WELL unfolding order_on_defs refl_on_def by auto
  6.1576 -qed
  6.1577 -
  6.1578 -
  6.1579 -lemma bsqr_ofilter:
  6.1580 -assumes WELL: "Well_order r" and
  6.1581 -        OF: "wo_rel.ofilter (bsqr r) D" and SUB: "D < Field r \<times> Field r" and
  6.1582 -        NE: "\<not> (\<exists>a. Field r = under r a)"
  6.1583 -shows "\<exists>A. wo_rel.ofilter r A \<and> A < Field r \<and> D \<le> A \<times> A"
  6.1584 -proof-
  6.1585 -  let ?r' = "bsqr r"
  6.1586 -  have Well: "wo_rel r" using WELL wo_rel_def by blast
  6.1587 -  hence Trans: "trans r" using wo_rel.TRANS by blast
  6.1588 -  have Well': "Well_order ?r' \<and> wo_rel ?r'"
  6.1589 -  using WELL bsqr_Well_order wo_rel_def by blast
  6.1590 -  (*  *)
  6.1591 -  have "D < Field ?r'" unfolding Field_bsqr using SUB .
  6.1592 -  with OF obtain a1 and a2 where
  6.1593 -  "(a1,a2) \<in> Field ?r'" and 1: "D = underS ?r' (a1,a2)"
  6.1594 -  using Well' wo_rel.ofilter_underS_Field[of ?r' D] by auto
  6.1595 -  hence 2: "{a1,a2} \<le> Field r" unfolding Field_bsqr by auto
  6.1596 -  let ?m = "wo_rel.max2 r a1 a2"
  6.1597 -  have "D \<le> (under r ?m) \<times> (under r ?m)"
  6.1598 -  proof(unfold 1)
  6.1599 -    {fix b1 b2
  6.1600 -     let ?n = "wo_rel.max2 r b1 b2"
  6.1601 -     assume "(b1,b2) \<in> underS ?r' (a1,a2)"
  6.1602 -     hence 3: "((b1,b2),(a1,a2)) \<in> ?r'"
  6.1603 -     unfolding underS_def by blast
  6.1604 -     hence "(?n,?m) \<in> r" using WELL by (simp add: bsqr_max2)
  6.1605 -     moreover
  6.1606 -     {have "(b1,b2) \<in> Field ?r'" using 3 unfolding Field_def by auto
  6.1607 -      hence "{b1,b2} \<le> Field r" unfolding Field_bsqr by auto
  6.1608 -      hence "(b1,?n) \<in> r \<and> (b2,?n) \<in> r"
  6.1609 -      using Well by (simp add: wo_rel.max2_greater)
  6.1610 -     }
  6.1611 -     ultimately have "(b1,?m) \<in> r \<and> (b2,?m) \<in> r"
  6.1612 -     using Trans trans_def[of r] by blast
  6.1613 -     hence "(b1,b2) \<in> (under r ?m) \<times> (under r ?m)" unfolding under_def by simp}
  6.1614 -     thus "underS ?r' (a1,a2) \<le> (under r ?m) \<times> (under r ?m)" by auto
  6.1615 -  qed
  6.1616 -  moreover have "wo_rel.ofilter r (under r ?m)"
  6.1617 -  using Well by (simp add: wo_rel.under_ofilter)
  6.1618 -  moreover have "under r ?m < Field r"
  6.1619 -  using NE under_Field[of r ?m] by blast
  6.1620 -  ultimately show ?thesis by blast
  6.1621 -qed
  6.1622 -
  6.1623 -definition Func where
  6.1624 -"Func A B = {f . (\<forall> a \<in> A. f a \<in> B) \<and> (\<forall> a. a \<notin> A \<longrightarrow> f a = undefined)}"
  6.1625 -
  6.1626 -lemma Func_empty:
  6.1627 -"Func {} B = {\<lambda>x. undefined}"
  6.1628 -unfolding Func_def by auto
  6.1629 -
  6.1630 -lemma Func_elim:
  6.1631 -assumes "g \<in> Func A B" and "a \<in> A"
  6.1632 -shows "\<exists> b. b \<in> B \<and> g a = b"
  6.1633 -using assms unfolding Func_def by (cases "g a = undefined") auto
  6.1634 -
  6.1635 -definition curr where
  6.1636 -"curr A f \<equiv> \<lambda> a. if a \<in> A then \<lambda>b. f (a,b) else undefined"
  6.1637 -
  6.1638 -lemma curr_in:
  6.1639 -assumes f: "f \<in> Func (A <*> B) C"
  6.1640 -shows "curr A f \<in> Func A (Func B C)"
  6.1641 -using assms unfolding curr_def Func_def by auto
  6.1642 -
  6.1643 -lemma curr_inj:
  6.1644 -assumes "f1 \<in> Func (A <*> B) C" and "f2 \<in> Func (A <*> B) C"
  6.1645 -shows "curr A f1 = curr A f2 \<longleftrightarrow> f1 = f2"
  6.1646 -proof safe
  6.1647 -  assume c: "curr A f1 = curr A f2"
  6.1648 -  show "f1 = f2"
  6.1649 -  proof (rule ext, clarify)
  6.1650 -    fix a b show "f1 (a, b) = f2 (a, b)"
  6.1651 -    proof (cases "(a,b) \<in> A <*> B")
  6.1652 -      case False
  6.1653 -      thus ?thesis using assms unfolding Func_def by auto
  6.1654 -    next
  6.1655 -      case True hence a: "a \<in> A" and b: "b \<in> B" by auto
  6.1656 -      thus ?thesis
  6.1657 -      using c unfolding curr_def fun_eq_iff by(elim allE[of _ a]) simp
  6.1658 -    qed
  6.1659 -  qed
  6.1660 -qed
  6.1661 -
  6.1662 -lemma curr_surj:
  6.1663 -assumes "g \<in> Func A (Func B C)"
  6.1664 -shows "\<exists> f \<in> Func (A <*> B) C. curr A f = g"
  6.1665 -proof
  6.1666 -  let ?f = "\<lambda> ab. if fst ab \<in> A \<and> snd ab \<in> B then g (fst ab) (snd ab) else undefined"
  6.1667 -  show "curr A ?f = g"
  6.1668 -  proof (rule ext)
  6.1669 -    fix a show "curr A ?f a = g a"
  6.1670 -    proof (cases "a \<in> A")
  6.1671 -      case False
  6.1672 -      hence "g a = undefined" using assms unfolding Func_def by auto
  6.1673 -      thus ?thesis unfolding curr_def using False by simp
  6.1674 -    next
  6.1675 -      case True
  6.1676 -      obtain g1 where "g1 \<in> Func B C" and "g a = g1"
  6.1677 -      using assms using Func_elim[OF assms True] by blast
  6.1678 -      thus ?thesis using True unfolding Func_def curr_def by auto
  6.1679 -    qed
  6.1680 -  qed
  6.1681 -  show "?f \<in> Func (A <*> B) C" using assms unfolding Func_def mem_Collect_eq by auto
  6.1682 -qed
  6.1683 -
  6.1684 -lemma bij_betw_curr:
  6.1685 -"bij_betw (curr A) (Func (A <*> B) C) (Func A (Func B C))"
  6.1686 -unfolding bij_betw_def inj_on_def image_def
  6.1687 -apply (intro impI conjI ballI)
  6.1688 -apply (erule curr_inj[THEN iffD1], assumption+)
  6.1689 -apply auto
  6.1690 -apply (erule curr_in)
  6.1691 -using curr_surj by blast
  6.1692 -
  6.1693 -definition Func_map where
  6.1694 -"Func_map B2 f1 f2 g b2 \<equiv> if b2 \<in> B2 then f1 (g (f2 b2)) else undefined"
  6.1695 -
  6.1696 -lemma Func_map:
  6.1697 -assumes g: "g \<in> Func A2 A1" and f1: "f1 ` A1 \<subseteq> B1" and f2: "f2 ` B2 \<subseteq> A2"
  6.1698 -shows "Func_map B2 f1 f2 g \<in> Func B2 B1"
  6.1699 -using assms unfolding Func_def Func_map_def mem_Collect_eq by auto
  6.1700 -
  6.1701 -lemma Func_non_emp:
  6.1702 -assumes "B \<noteq> {}"
  6.1703 -shows "Func A B \<noteq> {}"
  6.1704 -proof-
  6.1705 -  obtain b where b: "b \<in> B" using assms by auto
  6.1706 -  hence "(\<lambda> a. if a \<in> A then b else undefined) \<in> Func A B" unfolding Func_def by auto
  6.1707 -  thus ?thesis by blast
  6.1708 -qed
  6.1709 -
  6.1710 -lemma Func_is_emp:
  6.1711 -"Func A B = {} \<longleftrightarrow> A \<noteq> {} \<and> B = {}" (is "?L \<longleftrightarrow> ?R")
  6.1712 -proof
  6.1713 -  assume L: ?L
  6.1714 -  moreover {assume "A = {}" hence False using L Func_empty by auto}
  6.1715 -  moreover {assume "B \<noteq> {}" hence False using L Func_non_emp by metis}
  6.1716 -  ultimately show ?R by blast
  6.1717 -next
  6.1718 -  assume R: ?R
  6.1719 -  moreover
  6.1720 -  {fix f assume "f \<in> Func A B"
  6.1721 -   moreover obtain a where "a \<in> A" using R by blast
  6.1722 -   ultimately obtain b where "b \<in> B" unfolding Func_def by blast
  6.1723 -   with R have False by blast
  6.1724 -  }
  6.1725 -  thus ?L by blast
  6.1726 -qed
  6.1727 -
  6.1728 -lemma Func_map_surj:
  6.1729 -assumes B1: "f1 ` A1 = B1" and A2: "inj_on f2 B2" "f2 ` B2 \<subseteq> A2"
  6.1730 -and B2A2: "B2 = {} \<Longrightarrow> A2 = {}"
  6.1731 -shows "Func B2 B1 = Func_map B2 f1 f2 ` Func A2 A1"
  6.1732 -proof(cases "B2 = {}")
  6.1733 -  case True
  6.1734 -  thus ?thesis using B2A2 by (auto simp: Func_empty Func_map_def)
  6.1735 -next
  6.1736 -  case False note B2 = False
  6.1737 -  show ?thesis
  6.1738 -  proof safe
  6.1739 -    fix h assume h: "h \<in> Func B2 B1"
  6.1740 -    def j1 \<equiv> "inv_into A1 f1"
  6.1741 -    have "\<forall> a2 \<in> f2 ` B2. \<exists> b2. b2 \<in> B2 \<and> f2 b2 = a2" by blast
  6.1742 -    then obtain k where k: "\<forall> a2 \<in> f2 ` B2. k a2 \<in> B2 \<and> f2 (k a2) = a2" by metis
  6.1743 -    {fix b2 assume b2: "b2 \<in> B2"
  6.1744 -     hence "f2 (k (f2 b2)) = f2 b2" using k A2(2) by auto
  6.1745 -     moreover have "k (f2 b2) \<in> B2" using b2 A2(2) k by auto
  6.1746 -     ultimately have "k (f2 b2) = b2" using b2 A2(1) unfolding inj_on_def by blast
  6.1747 -    } note kk = this
  6.1748 -    obtain b22 where b22: "b22 \<in> B2" using B2 by auto
  6.1749 -    def j2 \<equiv> "\<lambda> a2. if a2 \<in> f2 ` B2 then k a2 else b22"
  6.1750 -    have j2A2: "j2 ` A2 \<subseteq> B2" unfolding j2_def using k b22 by auto
  6.1751 -    have j2: "\<And> b2. b2 \<in> B2 \<Longrightarrow> j2 (f2 b2) = b2"
  6.1752 -    using kk unfolding j2_def by auto
  6.1753 -    def g \<equiv> "Func_map A2 j1 j2 h"
  6.1754 -    have "Func_map B2 f1 f2 g = h"
  6.1755 -    proof (rule ext)
  6.1756 -      fix b2 show "Func_map B2 f1 f2 g b2 = h b2"
  6.1757 -      proof(cases "b2 \<in> B2")
  6.1758 -        case True
  6.1759 -        show ?thesis
  6.1760 -        proof (cases "h b2 = undefined")
  6.1761 -          case True
  6.1762 -          hence b1: "h b2 \<in> f1 ` A1" using h `b2 \<in> B2` unfolding B1 Func_def by auto
  6.1763 -          show ?thesis using A2 f_inv_into_f[OF b1]
  6.1764 -            unfolding True g_def Func_map_def j1_def j2[OF `b2 \<in> B2`] by auto
  6.1765 -        qed(insert A2 True j2[OF True] h B1, unfold j1_def g_def Func_def Func_map_def,
  6.1766 -          auto intro: f_inv_into_f)
  6.1767 -      qed(insert h, unfold Func_def Func_map_def, auto)
  6.1768 -    qed
  6.1769 -    moreover have "g \<in> Func A2 A1" unfolding g_def apply(rule Func_map[OF h])
  6.1770 -    using inv_into_into j2A2 B1 A2 inv_into_into
  6.1771 -    unfolding j1_def image_def by fast+
  6.1772 -    ultimately show "h \<in> Func_map B2 f1 f2 ` Func A2 A1"
  6.1773 -    unfolding Func_map_def[abs_def] unfolding image_def by auto
  6.1774 -  qed(insert B1 Func_map[OF _ _ A2(2)], auto)
  6.1775 -qed
  6.1776 -
  6.1777 -end
     7.1 --- a/src/HOL/Cardinals/Wellorder_Embedding_FP.thy	Mon Jan 20 16:14:19 2014 +0100
     7.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     7.3 @@ -1,1145 +0,0 @@
     7.4 -(*  Title:      HOL/Cardinals/Wellorder_Embedding_FP.thy
     7.5 -    Author:     Andrei Popescu, TU Muenchen
     7.6 -    Copyright   2012
     7.7 -
     7.8 -Well-order embeddings (FP).
     7.9 -*)
    7.10 -
    7.11 -header {* Well-Order Embeddings (FP) *}
    7.12 -
    7.13 -theory Wellorder_Embedding_FP
    7.14 -imports Zorn Wellorder_Relation_FP
    7.15 -begin
    7.16 -
    7.17 -
    7.18 -text{* In this section, we introduce well-order {\em embeddings} and {\em isomorphisms} and
    7.19 -prove their basic properties.  The notion of embedding is considered from the point
    7.20 -of view of the theory of ordinals, and therefore requires the source to be injected
    7.21 -as an {\em initial segment} (i.e., {\em order filter}) of the target.  A main result
    7.22 -of this section is the existence of embeddings (in one direction or another) between
    7.23 -any two well-orders, having as a consequence the fact that, given any two sets on
    7.24 -any two types, one is smaller than (i.e., can be injected into) the other. *}
    7.25 -
    7.26 -
    7.27 -subsection {* Auxiliaries *}
    7.28 -
    7.29 -lemma UNION_inj_on_ofilter:
    7.30 -assumes WELL: "Well_order r" and
    7.31 -        OF: "\<And> i. i \<in> I \<Longrightarrow> wo_rel.ofilter r (A i)" and
    7.32 -       INJ: "\<And> i. i \<in> I \<Longrightarrow> inj_on f (A i)"
    7.33 -shows "inj_on f (\<Union> i \<in> I. A i)"
    7.34 -proof-
    7.35 -  have "wo_rel r" using WELL by (simp add: wo_rel_def)
    7.36 -  hence "\<And> i j. \<lbrakk>i \<in> I; j \<in> I\<rbrakk> \<Longrightarrow> A i <= A j \<or> A j <= A i"
    7.37 -  using wo_rel.ofilter_linord[of r] OF by blast
    7.38 -  with WELL INJ show ?thesis
    7.39 -  by (auto simp add: inj_on_UNION_chain)
    7.40 -qed
    7.41 -
    7.42 -
    7.43 -lemma under_underS_bij_betw:
    7.44 -assumes WELL: "Well_order r" and WELL': "Well_order r'" and
    7.45 -        IN: "a \<in> Field r" and IN': "f a \<in> Field r'" and
    7.46 -        BIJ: "bij_betw f (underS r a) (underS r' (f a))"
    7.47 -shows "bij_betw f (under r a) (under r' (f a))"
    7.48 -proof-
    7.49 -  have "a \<notin> underS r a \<and> f a \<notin> underS r' (f a)"
    7.50 -  unfolding underS_def by auto
    7.51 -  moreover
    7.52 -  {have "Refl r \<and> Refl r'" using WELL WELL'
    7.53 -   by (auto simp add: order_on_defs)
    7.54 -   hence "under r a = underS r a \<union> {a} \<and>
    7.55 -          under r' (f a) = underS r' (f a) \<union> {f a}"
    7.56 -   using IN IN' by(auto simp add: Refl_under_underS)
    7.57 -  }
    7.58 -  ultimately show ?thesis
    7.59 -  using BIJ notIn_Un_bij_betw[of a "underS r a" f "underS r' (f a)"] by auto
    7.60 -qed
    7.61 -
    7.62 -
    7.63 -
    7.64 -subsection {* (Well-order) embeddings, strict embeddings, isomorphisms and order-compatible
    7.65 -functions  *}
    7.66 -
    7.67 -
    7.68 -text{* Standardly, a function is an embedding of a well-order in another if it injectively and
    7.69 -order-compatibly maps the former into an order filter of the latter.
    7.70 -Here we opt for a more succinct definition (operator @{text "embed"}),
    7.71 -asking that, for any element in the source, the function should be a bijection
    7.72 -between the set of strict lower bounds of that element
    7.73 -and the set of strict lower bounds of its image.  (Later we prove equivalence with
    7.74 -the standard definition -- lemma @{text "embed_iff_compat_inj_on_ofilter"}.)
    7.75 -A {\em strict embedding} (operator @{text "embedS"})  is a non-bijective embedding
    7.76 -and an isomorphism (operator @{text "iso"}) is a bijective embedding.   *}
    7.77 -
    7.78 -
    7.79 -definition embed :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> ('a \<Rightarrow> 'a') \<Rightarrow> bool"
    7.80 -where
    7.81 -"embed r r' f \<equiv> \<forall>a \<in> Field r. bij_betw f (under r a) (under r' (f a))"
    7.82 -
    7.83 -
    7.84 -lemmas embed_defs = embed_def embed_def[abs_def]
    7.85 -
    7.86 -
    7.87 -text {* Strict embeddings: *}
    7.88 -
    7.89 -definition embedS :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> ('a \<Rightarrow> 'a') \<Rightarrow> bool"
    7.90 -where
    7.91 -"embedS r r' f \<equiv> embed r r' f \<and> \<not> bij_betw f (Field r) (Field r')"
    7.92 -
    7.93 -
    7.94 -lemmas embedS_defs = embedS_def embedS_def[abs_def]
    7.95 -
    7.96 -
    7.97 -definition iso :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> ('a \<Rightarrow> 'a') \<Rightarrow> bool"
    7.98 -where
    7.99 -"iso r r' f \<equiv> embed r r' f \<and> bij_betw f (Field r) (Field r')"
   7.100 -
   7.101 -
   7.102 -lemmas iso_defs = iso_def iso_def[abs_def]
   7.103 -
   7.104 -
   7.105 -definition compat :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> ('a \<Rightarrow> 'a') \<Rightarrow> bool"
   7.106 -where
   7.107 -"compat r r' f \<equiv> \<forall>a b. (a,b) \<in> r \<longrightarrow> (f a, f b) \<in> r'"
   7.108 -
   7.109 -
   7.110 -lemma compat_wf:
   7.111 -assumes CMP: "compat r r' f" and WF: "wf r'"
   7.112 -shows "wf r"
   7.113 -proof-
   7.114 -  have "r \<le> inv_image r' f"
   7.115 -  unfolding inv_image_def using CMP
   7.116 -  by (auto simp add: compat_def)
   7.117 -  with WF show ?thesis
   7.118 -  using wf_inv_image[of r' f] wf_subset[of "inv_image r' f"] by auto
   7.119 -qed
   7.120 -
   7.121 -
   7.122 -lemma id_embed: "embed r r id"
   7.123 -by(auto simp add: id_def embed_def bij_betw_def)
   7.124 -
   7.125 -
   7.126 -lemma id_iso: "iso r r id"
   7.127 -by(auto simp add: id_def embed_def iso_def bij_betw_def)
   7.128 -
   7.129 -
   7.130 -lemma embed_in_Field:
   7.131 -assumes WELL: "Well_order r" and
   7.132 -        EMB: "embed r r' f" and IN: "a \<in> Field r"
   7.133 -shows "f a \<in> Field r'"
   7.134 -proof-
   7.135 -  have Well: "wo_rel r"
   7.136 -  using WELL by (auto simp add: wo_rel_def)
   7.137 -  hence 1: "Refl r"
   7.138 -  by (auto simp add: wo_rel.REFL)
   7.139 -  hence "a \<in> under r a" using IN Refl_under_in by fastforce
   7.140 -  hence "f a \<in> under r' (f a)"
   7.141 -  using EMB IN by (auto simp add: embed_def bij_betw_def)
   7.142 -  thus ?thesis unfolding Field_def
   7.143 -  by (auto simp: under_def)
   7.144 -qed
   7.145 -
   7.146 -
   7.147 -lemma comp_embed:
   7.148 -assumes WELL: "Well_order r" and
   7.149 -        EMB: "embed r r' f" and EMB': "embed r' r'' f'"
   7.150 -shows "embed r r'' (f' o f)"
   7.151 -proof(unfold embed_def, auto)
   7.152 -  fix a assume *: "a \<in> Field r"
   7.153 -  hence "bij_betw f (under r a) (under r' (f a))"
   7.154 -  using embed_def[of r] EMB by auto
   7.155 -  moreover
   7.156 -  {have "f a \<in> Field r'"
   7.157 -   using EMB WELL * by (auto simp add: embed_in_Field)
   7.158 -   hence "bij_betw f' (under r' (f a)) (under r'' (f' (f a)))"
   7.159 -   using embed_def[of r'] EMB' by auto
   7.160 -  }
   7.161 -  ultimately
   7.162 -  show "bij_betw (f' \<circ> f) (under r a) (under r'' (f'(f a)))"
   7.163 -  by(auto simp add: bij_betw_trans)
   7.164 -qed
   7.165 -
   7.166 -
   7.167 -lemma comp_iso:
   7.168 -assumes WELL: "Well_order r" and
   7.169 -        EMB: "iso r r' f" and EMB': "iso r' r'' f'"
   7.170 -shows "iso r r'' (f' o f)"
   7.171 -using assms unfolding iso_def
   7.172 -by (auto simp add: comp_embed bij_betw_trans)
   7.173 -
   7.174 -
   7.175 -text{* That @{text "embedS"} is also preserved by function composition shall be proved only later.  *}
   7.176 -
   7.177 -
   7.178 -lemma embed_Field:
   7.179 -"\<lbrakk>Well_order r; embed r r' f\<rbrakk> \<Longrightarrow> f`(Field r) \<le> Field r'"
   7.180 -by (auto simp add: embed_in_Field)
   7.181 -
   7.182 -
   7.183 -lemma embed_preserves_ofilter:
   7.184 -assumes WELL: "Well_order r" and WELL': "Well_order r'" and
   7.185 -        EMB: "embed r r' f" and OF: "wo_rel.ofilter r A"
   7.186 -shows "wo_rel.ofilter r' (f`A)"
   7.187 -proof-
   7.188 -  (* Preliminary facts *)
   7.189 -  from WELL have Well: "wo_rel r" unfolding wo_rel_def .
   7.190 -  from WELL' have Well': "wo_rel r'" unfolding wo_rel_def .
   7.191 -  from OF have 0: "A \<le> Field r" by(auto simp add: Well wo_rel.ofilter_def)
   7.192 -  (* Main proof *)
   7.193 -  show ?thesis  using Well' WELL EMB 0 embed_Field[of r r' f]
   7.194 -  proof(unfold wo_rel.ofilter_def, auto simp add: image_def)
   7.195 -    fix a b'
   7.196 -    assume *: "a \<in> A" and **: "b' \<in> under r' (f a)"
   7.197 -    hence "a \<in> Field r" using 0 by auto
   7.198 -    hence "bij_betw f (under r a) (under r' (f a))"
   7.199 -    using * EMB by (auto simp add: embed_def)
   7.200 -    hence "f`(under r a) = under r' (f a)"
   7.201 -    by (simp add: bij_betw_def)
   7.202 -    with ** image_def[of f "under r a"] obtain b where
   7.203 -    1: "b \<in> under r a \<and> b' = f b" by blast
   7.204 -    hence "b \<in> A" using Well * OF
   7.205 -    by (auto simp add: wo_rel.ofilter_def)
   7.206 -    with 1 show "\<exists>b \<in> A. b' = f b" by blast
   7.207 -  qed
   7.208 -qed
   7.209 -
   7.210 -
   7.211 -lemma embed_Field_ofilter:
   7.212 -assumes WELL: "Well_order r" and WELL': "Well_order r'" and
   7.213 -        EMB: "embed r r' f"
   7.214 -shows "wo_rel.ofilter r' (f`(Field r))"
   7.215 -proof-
   7.216 -  have "wo_rel.ofilter r (Field r)"
   7.217 -  using WELL by (auto simp add: wo_rel_def wo_rel.Field_ofilter)
   7.218 -  with WELL WELL' EMB
   7.219 -  show ?thesis by (auto simp add: embed_preserves_ofilter)
   7.220 -qed
   7.221 -
   7.222 -
   7.223 -lemma embed_compat:
   7.224 -assumes EMB: "embed r r' f"
   7.225 -shows "compat r r' f"
   7.226 -proof(unfold compat_def, clarify)
   7.227 -  fix a b
   7.228 -  assume *: "(a,b) \<in> r"
   7.229 -  hence 1: "b \<in> Field r" using Field_def[of r] by blast
   7.230 -  have "a \<in> under r b"
   7.231 -  using * under_def[of r] by simp
   7.232 -  hence "f a \<in> under r' (f b)"
   7.233 -  using EMB embed_def[of r r' f]
   7.234 -        bij_betw_def[of f "under r b" "under r' (f b)"]
   7.235 -        image_def[of f "under r b"] 1 by auto
   7.236 -  thus "(f a, f b) \<in> r'"
   7.237 -  by (auto simp add: under_def)
   7.238 -qed
   7.239 -
   7.240 -
   7.241 -lemma embed_inj_on:
   7.242 -assumes WELL: "Well_order r" and EMB: "embed r r' f"
   7.243 -shows "inj_on f (Field r)"
   7.244 -proof(unfold inj_on_def, clarify)
   7.245 -  (* Preliminary facts *)
   7.246 -  from WELL have Well: "wo_rel r" unfolding wo_rel_def .
   7.247 -  with wo_rel.TOTAL[of r]
   7.248 -  have Total: "Total r" by simp
   7.249 -  from Well wo_rel.REFL[of r]
   7.250 -  have Refl: "Refl r" by simp
   7.251 -  (* Main proof *)
   7.252 -  fix a b
   7.253 -  assume *: "a \<in> Field r" and **: "b \<in> Field r" and
   7.254 -         ***: "f a = f b"
   7.255 -  hence 1: "a \<in> Field r \<and> b \<in> Field r"
   7.256 -  unfolding Field_def by auto
   7.257 -  {assume "(a,b) \<in> r"
   7.258 -   hence "a \<in> under r b \<and> b \<in> under r b"
   7.259 -   using Refl by(auto simp add: under_def refl_on_def)
   7.260 -   hence "a = b"
   7.261 -   using EMB 1 ***
   7.262 -   by (auto simp add: embed_def bij_betw_def inj_on_def)
   7.263 -  }
   7.264 -  moreover
   7.265 -  {assume "(b,a) \<in> r"
   7.266 -   hence "a \<in> under r a \<and> b \<in> under r a"
   7.267 -   using Refl by(auto simp add: under_def refl_on_def)
   7.268 -   hence "a = b"
   7.269 -   using EMB 1 ***
   7.270 -   by (auto simp add: embed_def bij_betw_def inj_on_def)
   7.271 -  }
   7.272 -  ultimately
   7.273 -  show "a = b" using Total 1
   7.274 -  by (auto simp add: total_on_def)
   7.275 -qed
   7.276 -
   7.277 -
   7.278 -lemma embed_underS:
   7.279 -assumes WELL: "Well_order r" and WELL': "Well_order r'" and
   7.280 -        EMB: "embed r r' f" and IN: "a \<in> Field r"
   7.281 -shows "bij_betw f (underS r a) (underS r' (f a))"
   7.282 -proof-
   7.283 -  have "bij_betw f (under r a) (under r' (f a))"
   7.284 -  using assms by (auto simp add: embed_def)
   7.285 -  moreover
   7.286 -  {have "f a \<in> Field r'" using assms  embed_Field[of r r' f] by auto
   7.287 -   hence "under r a = underS r a \<union> {a} \<and>
   7.288 -          under r' (f a) = underS r' (f a) \<union> {f a}"
   7.289 -   using assms by (auto simp add: order_on_defs Refl_under_underS)
   7.290 -  }
   7.291 -  moreover
   7.292 -  {have "a \<notin> underS r a \<and> f a \<notin> underS r' (f a)"
   7.293 -   unfolding underS_def by blast
   7.294 -  }
   7.295 -  ultimately show ?thesis
   7.296 -  by (auto simp add: notIn_Un_bij_betw3)
   7.297 -qed
   7.298 -
   7.299 -
   7.300 -lemma embed_iff_compat_inj_on_ofilter:
   7.301 -assumes WELL: "Well_order r" and WELL': "Well_order r'"
   7.302 -shows "embed r r' f = (compat r r' f \<and> inj_on f (Field r) \<and> wo_rel.ofilter r' (f`(Field r)))"
   7.303 -using assms
   7.304 -proof(auto simp add: embed_compat embed_inj_on embed_Field_ofilter,
   7.305 -      unfold embed_def, auto) (* get rid of one implication *)
   7.306 -  fix a
   7.307 -  assume *: "inj_on f (Field r)" and
   7.308 -         **: "compat r r' f" and
   7.309 -         ***: "wo_rel.ofilter r' (f`(Field r))" and
   7.310 -         ****: "a \<in> Field r"
   7.311 -  (* Preliminary facts *)
   7.312 -  have Well: "wo_rel r"
   7.313 -  using WELL wo_rel_def[of r] by simp
   7.314 -  hence Refl: "Refl r"
   7.315 -  using wo_rel.REFL[of r] by simp
   7.316 -  have Total: "Total r"
   7.317 -  using Well wo_rel.TOTAL[of r] by simp
   7.318 -  have Well': "wo_rel r'"
   7.319 -  using WELL' wo_rel_def[of r'] by simp
   7.320 -  hence Antisym': "antisym r'"
   7.321 -  using wo_rel.ANTISYM[of r'] by simp
   7.322 -  have "(a,a) \<in> r"
   7.323 -  using **** Well wo_rel.REFL[of r]
   7.324 -        refl_on_def[of _ r] by auto
   7.325 -  hence "(f a, f a) \<in> r'"
   7.326 -  using ** by(auto simp add: compat_def)
   7.327 -  hence 0: "f a \<in> Field r'"
   7.328 -  unfolding Field_def by auto
   7.329 -  have "f a \<in> f`(Field r)"
   7.330 -  using **** by auto
   7.331 -  hence 2: "under r' (f a) \<le> f`(Field r)"
   7.332 -  using Well' *** wo_rel.ofilter_def[of r' "f`(Field r)"] by fastforce
   7.333 -  (* Main proof *)
   7.334 -  show "bij_betw f (under r a) (under r' (f a))"
   7.335 -  proof(unfold bij_betw_def, auto)
   7.336 -    show  "inj_on f (under r a)"
   7.337 -    using * by (metis (no_types) under_Field subset_inj_on)
   7.338 -  next
   7.339 -    fix b assume "b \<in> under r a"
   7.340 -    thus "f b \<in> under r' (f a)"
   7.341 -    unfolding under_def using **
   7.342 -    by (auto simp add: compat_def)
   7.343 -  next
   7.344 -    fix b' assume *****: "b' \<in> under r' (f a)"
   7.345 -    hence "b' \<in> f`(Field r)"
   7.346 -    using 2 by auto
   7.347 -    with Field_def[of r] obtain b where
   7.348 -    3: "b \<in> Field r" and 4: "b' = f b" by auto
   7.349 -    have "(b,a): r"
   7.350 -    proof-
   7.351 -      {assume "(a,b) \<in> r"
   7.352 -       with ** 4 have "(f a, b'): r'"
   7.353 -       by (auto simp add: compat_def)
   7.354 -       with ***** Antisym' have "f a = b'"
   7.355 -       by(auto simp add: under_def antisym_def)
   7.356 -       with 3 **** 4 * have "a = b"
   7.357 -       by(auto simp add: inj_on_def)
   7.358 -      }
   7.359 -      moreover
   7.360 -      {assume "a = b"
   7.361 -       hence "(b,a) \<in> r" using Refl **** 3
   7.362 -       by (auto simp add: refl_on_def)
   7.363 -      }
   7.364 -      ultimately
   7.365 -      show ?thesis using Total **** 3 by (fastforce simp add: total_on_def)
   7.366 -    qed
   7.367 -    with 4 show  "b' \<in> f`(under r a)"
   7.368 -    unfolding under_def by auto
   7.369 -  qed
   7.370 -qed
   7.371 -
   7.372 -
   7.373 -lemma inv_into_ofilter_embed:
   7.374 -assumes WELL: "Well_order r" and OF: "wo_rel.ofilter r A" and
   7.375 -        BIJ: "\<forall>b \<in> A. bij_betw f (under r b) (under r' (f b))" and
   7.376 -        IMAGE: "f ` A = Field r'"
   7.377 -shows "embed r' r (inv_into A f)"
   7.378 -proof-
   7.379 -  (* Preliminary facts *)
   7.380 -  have Well: "wo_rel r"
   7.381 -  using WELL wo_rel_def[of r] by simp
   7.382 -  have Refl: "Refl r"
   7.383 -  using Well wo_rel.REFL[of r] by simp
   7.384 -  have Total: "Total r"
   7.385 -  using Well wo_rel.TOTAL[of r] by simp
   7.386 -  (* Main proof *)
   7.387 -  have 1: "bij_betw f A (Field r')"
   7.388 -  proof(unfold bij_betw_def inj_on_def, auto simp add: IMAGE)
   7.389 -    fix b1 b2
   7.390 -    assume *: "b1 \<in> A" and **: "b2 \<in> A" and
   7.391 -           ***: "f b1 = f b2"
   7.392 -    have 11: "b1 \<in> Field r \<and> b2 \<in> Field r"
   7.393 -    using * ** Well OF by (auto simp add: wo_rel.ofilter_def)
   7.394 -    moreover
   7.395 -    {assume "(b1,b2) \<in> r"
   7.396 -     hence "b1 \<in> under r b2 \<and> b2 \<in> under r b2"
   7.397 -     unfolding under_def using 11 Refl
   7.398 -     by (auto simp add: refl_on_def)
   7.399 -     hence "b1 = b2" using BIJ * ** ***
   7.400 -     by (simp add: bij_betw_def inj_on_def)
   7.401 -    }
   7.402 -    moreover
   7.403 -     {assume "(b2,b1) \<in> r"
   7.404 -     hence "b1 \<in> under r b1 \<and> b2 \<in> under r b1"
   7.405 -     unfolding under_def using 11 Refl
   7.406 -     by (auto simp add: refl_on_def)
   7.407 -     hence "b1 = b2" using BIJ * ** ***
   7.408 -     by (simp add: bij_betw_def inj_on_def)
   7.409 -    }
   7.410 -    ultimately
   7.411 -    show "b1 = b2"
   7.412 -    using Total by (auto simp add: total_on_def)
   7.413 -  qed
   7.414 -  (*  *)
   7.415 -  let ?f' = "(inv_into A f)"
   7.416 -  (*  *)
   7.417 -  have 2: "\<forall>b \<in> A. bij_betw ?f' (under r' (f b)) (under r b)"
   7.418 -  proof(clarify)
   7.419 -    fix b assume *: "b \<in> A"
   7.420 -    hence "under r b \<le> A"
   7.421 -    using Well OF by(auto simp add: wo_rel.ofilter_def)
   7.422 -    moreover
   7.423 -    have "f ` (under r b) = under r' (f b)"
   7.424 -    using * BIJ by (auto simp add: bij_betw_def)
   7.425 -    ultimately
   7.426 -    show "bij_betw ?f' (under r' (f b)) (under r b)"
   7.427 -    using 1 by (auto simp add: bij_betw_inv_into_subset)
   7.428 -  qed
   7.429 -  (*  *)
   7.430 -  have 3: "\<forall>b' \<in> Field r'. bij_betw ?f' (under r' b') (under r (?f' b'))"
   7.431 -  proof(clarify)
   7.432 -    fix b' assume *: "b' \<in> Field r'"
   7.433 -    have "b' = f (?f' b')" using * 1
   7.434 -    by (auto simp add: bij_betw_inv_into_right)
   7.435 -    moreover
   7.436 -    {obtain b where 31: "b \<in> A" and "f b = b'" using IMAGE * by force
   7.437 -     hence "?f' b' = b" using 1 by (auto simp add: bij_betw_inv_into_left)
   7.438 -     with 31 have "?f' b' \<in> A" by auto
   7.439 -    }
   7.440 -    ultimately
   7.441 -    show  "bij_betw ?f' (under r' b') (under r (?f' b'))"
   7.442 -    using 2 by auto
   7.443 -  qed
   7.444 -  (*  *)
   7.445 -  thus ?thesis unfolding embed_def .
   7.446 -qed
   7.447 -
   7.448 -
   7.449 -lemma inv_into_underS_embed:
   7.450 -assumes WELL: "Well_order r" and
   7.451 -        BIJ: "\<forall>b \<in> underS r a. bij_betw f (under r b) (under r' (f b))" and
   7.452 -        IN: "a \<in> Field r" and
   7.453 -        IMAGE: "f ` (underS r a) = Field r'"
   7.454 -shows "embed r' r (inv_into (underS r a) f)"
   7.455 -using assms
   7.456 -by(auto simp add: wo_rel_def wo_rel.underS_ofilter inv_into_ofilter_embed)
   7.457 -
   7.458 -
   7.459 -lemma inv_into_Field_embed:
   7.460 -assumes WELL: "Well_order r" and EMB: "embed r r' f" and
   7.461 -        IMAGE: "Field r' \<le> f ` (Field r)"
   7.462 -shows "embed r' r (inv_into (Field r) f)"
   7.463 -proof-
   7.464 -  have "(\<forall>b \<in> Field r. bij_betw f (under r b) (under r' (f b)))"
   7.465 -  using EMB by (auto simp add: embed_def)
   7.466 -  moreover
   7.467 -  have "f ` (Field r) \<le> Field r'"
   7.468 -  using EMB WELL by (auto simp add: embed_Field)
   7.469 -  ultimately
   7.470 -  show ?thesis using assms
   7.471 -  by(auto simp add: wo_rel_def wo_rel.Field_ofilter inv_into_ofilter_embed)
   7.472 -qed
   7.473 -
   7.474 -
   7.475 -lemma inv_into_Field_embed_bij_betw:
   7.476 -assumes WELL: "Well_order r" and
   7.477 -        EMB: "embed r r' f" and BIJ: "bij_betw f (Field r) (Field r')"
   7.478 -shows "embed r' r (inv_into (Field r) f)"
   7.479 -proof-
   7.480 -  have "Field r' \<le> f ` (Field r)"
   7.481 -  using BIJ by (auto simp add: bij_betw_def)
   7.482 -  thus ?thesis using assms
   7.483 -  by(auto simp add: inv_into_Field_embed)
   7.484 -qed
   7.485 -
   7.486 -
   7.487 -
   7.488 -
   7.489 -
   7.490 -subsection {* Given any two well-orders, one can be embedded in the other *}
   7.491 -
   7.492 -
   7.493 -text{* Here is an overview of the proof of of this fact, stated in theorem
   7.494 -@{text "wellorders_totally_ordered"}:
   7.495 -
   7.496 -   Fix the well-orders @{text "r::'a rel"} and @{text "r'::'a' rel"}.
   7.497 -   Attempt to define an embedding @{text "f::'a \<Rightarrow> 'a'"} from @{text "r"} to @{text "r'"} in the
   7.498 -   natural way by well-order recursion ("hoping" that @{text "Field r"} turns out to be smaller
   7.499 -   than @{text "Field r'"}), but also record, at the recursive step, in a function
   7.500 -   @{text "g::'a \<Rightarrow> bool"}, the extra information of whether @{text "Field r'"}
   7.501 -   gets exhausted or not.
   7.502 -
   7.503 -   If @{text "Field r'"} does not get exhausted, then @{text "Field r"} is indeed smaller
   7.504 -   and @{text "f"} is the desired embedding from @{text "r"} to @{text "r'"}
   7.505 -   (lemma @{text "wellorders_totally_ordered_aux"}).
   7.506 -
   7.507 -   Otherwise, it means that @{text "Field r'"} is the smaller one, and the inverse of
   7.508 -   (the "good" segment of) @{text "f"} is the desired embedding from @{text "r'"} to @{text "r"}
   7.509 -   (lemma @{text "wellorders_totally_ordered_aux2"}).
   7.510 -*}
   7.511 -
   7.512 -
   7.513 -lemma wellorders_totally_ordered_aux:
   7.514 -fixes r ::"'a rel"  and r'::"'a' rel" and
   7.515 -      f :: "'a \<Rightarrow> 'a'" and a::'a
   7.516 -assumes WELL: "Well_order r" and WELL': "Well_order r'" and IN: "a \<in> Field r" and
   7.517 -        IH: "\<forall>b \<in> underS r a. bij_betw f (under r b) (under r' (f b))" and
   7.518 -        NOT: "f ` (underS r a) \<noteq> Field r'" and SUC: "f a = wo_rel.suc r' (f`(underS r a))"
   7.519 -shows "bij_betw f (under r a) (under r' (f a))"
   7.520 -proof-
   7.521 -  (* Preliminary facts *)
   7.522 -  have Well: "wo_rel r" using WELL unfolding wo_rel_def .
   7.523 -  hence Refl: "Refl r" using wo_rel.REFL[of r] by auto
   7.524 -  have Trans: "trans r" using Well wo_rel.TRANS[of r] by auto
   7.525 -  have Well': "wo_rel r'" using WELL' unfolding wo_rel_def .
   7.526 -  have OF: "wo_rel.ofilter r (underS r a)"
   7.527 -  by (auto simp add: Well wo_rel.underS_ofilter)
   7.528 -  hence UN: "underS r a = (\<Union>  b \<in> underS r a. under r b)"
   7.529 -  using Well wo_rel.ofilter_under_UNION[of r "underS r a"] by blast
   7.530 -  (* Gather facts about elements of underS r a *)
   7.531 -  {fix b assume *: "b \<in> underS r a"
   7.532 -   hence t0: "(b,a) \<in> r \<and> b \<noteq> a" unfolding underS_def by auto
   7.533 -   have t1: "b \<in> Field r"
   7.534 -   using * underS_Field[of r a] by auto
   7.535 -   have t2: "f`(under r b) = under r' (f b)"
   7.536 -   using IH * by (auto simp add: bij_betw_def)
   7.537 -   hence t3: "wo_rel.ofilter r' (f`(under r b))"
   7.538 -   using Well' by (auto simp add: wo_rel.under_ofilter)
   7.539 -   have "f`(under r b) \<le> Field r'"
   7.540 -   using t2 by (auto simp add: under_Field)
   7.541 -   moreover
   7.542 -   have "b \<in> under r b"
   7.543 -   using t1 by(auto simp add: Refl Refl_under_in)
   7.544 -   ultimately
   7.545 -   have t4:  "f b \<in> Field r'" by auto
   7.546 -   have "f`(under r b) = under r' (f b) \<and>
   7.547 -         wo_rel.ofilter r' (f`(under r b)) \<and>
   7.548 -         f b \<in> Field r'"
   7.549 -   using t2 t3 t4 by auto
   7.550 -  }
   7.551 -  hence bFact:
   7.552 -  "\<forall>b \<in> underS r a. f`(under r b) = under r' (f b) \<and>
   7.553 -                       wo_rel.ofilter r' (f`(under r b)) \<and>
   7.554 -                       f b \<in> Field r'" by blast
   7.555 -  (*  *)
   7.556 -  have subField: "f`(underS r a) \<le> Field r'"
   7.557 -  using bFact by blast
   7.558 -  (*  *)
   7.559 -  have OF': "wo_rel.ofilter r' (f`(underS r a))"
   7.560 -  proof-
   7.561 -    have "f`(underS r a) = f`(\<Union>  b \<in> underS r a. under r b)"
   7.562 -    using UN by auto
   7.563 -    also have "\<dots> = (\<Union>  b \<in> underS r a. f`(under r b))" by blast
   7.564 -    also have "\<dots> = (\<Union>  b \<in> underS r a. (under r' (f b)))"
   7.565 -    using bFact by auto
   7.566 -    finally
   7.567 -    have "f`(underS r a) = (\<Union>  b \<in> underS r a. (under r' (f b)))" .
   7.568 -    thus ?thesis
   7.569 -    using Well' bFact
   7.570 -          wo_rel.ofilter_UNION[of r' "underS r a" "\<lambda> b. under r' (f b)"] by fastforce
   7.571 -  qed
   7.572 -  (*  *)
   7.573 -  have "f`(underS r a) \<union> AboveS r' (f`(underS r a)) = Field r'"
   7.574 -  using Well' OF' by (auto simp add: wo_rel.ofilter_AboveS_Field)
   7.575 -  hence NE: "AboveS r' (f`(underS r a)) \<noteq> {}"
   7.576 -  using subField NOT by blast
   7.577 -  (* Main proof *)
   7.578 -  have INCL1: "f`(underS r a) \<le> underS r' (f a) "
   7.579 -  proof(auto)
   7.580 -    fix b assume *: "b \<in> underS r a"
   7.581 -    have "f b \<noteq> f a \<and> (f b, f a) \<in> r'"
   7.582 -    using subField Well' SUC NE *
   7.583 -          wo_rel.suc_greater[of r' "f`(underS r a)" "f b"] by force
   7.584 -    thus "f b \<in> underS r' (f a)"
   7.585 -    unfolding underS_def by simp
   7.586 -  qed
   7.587 -  (*  *)
   7.588 -  have INCL2: "underS r' (f a) \<le> f`(underS r a)"
   7.589 -  proof
   7.590 -    fix b' assume "b' \<in> underS r' (f a)"
   7.591 -    hence "b' \<noteq> f a \<and> (b', f a) \<in> r'"
   7.592 -    unfolding underS_def by simp
   7.593 -    thus "b' \<in> f`(underS r a)"
   7.594 -    using Well' SUC NE OF'
   7.595 -          wo_rel.suc_ofilter_in[of r' "f ` underS r a" b'] by auto
   7.596 -  qed
   7.597 -  (*  *)
   7.598 -  have INJ: "inj_on f (underS r a)"
   7.599 -  proof-
   7.600 -    have "\<forall>b \<in> underS r a. inj_on f (under r b)"
   7.601 -    using IH by (auto simp add: bij_betw_def)
   7.602 -    moreover
   7.603 -    have "\<forall>b. wo_rel.ofilter r (under r b)"
   7.604 -    using Well by (auto simp add: wo_rel.under_ofilter)
   7.605 -    ultimately show  ?thesis
   7.606 -    using WELL bFact UN