renamed "Ordinals_and_Cardinals" to "Cardinals"
authorblanchet
Wed Sep 12 05:29:21 2012 +0200 (2012-09-12)
changeset 493106e30078de4f0
parent 49309 f20b24214ac2
child 49311 56fcd826f90c
renamed "Ordinals_and_Cardinals" to "Cardinals"
Admin/isatest/isatest-stats
NEWS
src/HOL/Cardinals/Cardinal_Arithmetic.thy
src/HOL/Cardinals/Cardinal_Order_Relation.thy
src/HOL/Cardinals/Cardinal_Order_Relation_Base.thy
src/HOL/Cardinals/Constructions_on_Wellorders.thy
src/HOL/Cardinals/Constructions_on_Wellorders_Base.thy
src/HOL/Cardinals/Fun_More.thy
src/HOL/Cardinals/Fun_More_Base.thy
src/HOL/Cardinals/Order_Relation_More.thy
src/HOL/Cardinals/Order_Relation_More_Base.thy
src/HOL/Cardinals/README.txt
src/HOL/Cardinals/TODO.txt
src/HOL/Cardinals/Wellfounded_More.thy
src/HOL/Cardinals/Wellfounded_More_Base.thy
src/HOL/Cardinals/Wellorder_Embedding.thy
src/HOL/Cardinals/Wellorder_Embedding_Base.thy
src/HOL/Cardinals/Wellorder_Relation.thy
src/HOL/Cardinals/Wellorder_Relation_Base.thy
src/HOL/Cardinals/document/intro.tex
src/HOL/Cardinals/document/root.bib
src/HOL/Cardinals/document/root.tex
src/HOL/Codatatype/BNF_Util.thy
src/HOL/Codatatype/Basic_BNFs.thy
src/HOL/Codatatype/Countable_Set.thy
src/HOL/Codatatype/More_BNFs.thy
src/HOL/Ordinals_and_Cardinals/Cardinal_Arithmetic.thy
src/HOL/Ordinals_and_Cardinals/Cardinal_Order_Relation.thy
src/HOL/Ordinals_and_Cardinals/Cardinal_Order_Relation_Base.thy
src/HOL/Ordinals_and_Cardinals/Constructions_on_Wellorders.thy
src/HOL/Ordinals_and_Cardinals/Constructions_on_Wellorders_Base.thy
src/HOL/Ordinals_and_Cardinals/Fun_More.thy
src/HOL/Ordinals_and_Cardinals/Fun_More_Base.thy
src/HOL/Ordinals_and_Cardinals/Order_Relation_More.thy
src/HOL/Ordinals_and_Cardinals/Order_Relation_More_Base.thy
src/HOL/Ordinals_and_Cardinals/README.txt
src/HOL/Ordinals_and_Cardinals/TODO.txt
src/HOL/Ordinals_and_Cardinals/Wellfounded_More.thy
src/HOL/Ordinals_and_Cardinals/Wellfounded_More_Base.thy
src/HOL/Ordinals_and_Cardinals/Wellorder_Embedding.thy
src/HOL/Ordinals_and_Cardinals/Wellorder_Embedding_Base.thy
src/HOL/Ordinals_and_Cardinals/Wellorder_Relation.thy
src/HOL/Ordinals_and_Cardinals/Wellorder_Relation_Base.thy
src/HOL/Ordinals_and_Cardinals/document/intro.tex
src/HOL/Ordinals_and_Cardinals/document/root.bib
src/HOL/Ordinals_and_Cardinals/document/root.tex
src/HOL/ROOT
     1.1 --- a/Admin/isatest/isatest-stats	Wed Sep 12 05:21:47 2012 +0200
     1.2 +++ b/Admin/isatest/isatest-stats	Wed Sep 12 05:29:21 2012 +0200
     1.3 @@ -97,6 +97,7 @@
     1.4    HOL-Binomial-Heaps
     1.5    HOL-Binomial-Queues
     1.6    HOL-BytecodeLogicJmlTypes
     1.7 +  HOL-Cardinals
     1.8    HOL-Category
     1.9    HOL-Category2
    1.10    HOL-Cauchy
    1.11 @@ -146,7 +147,6 @@
    1.12    HOL-Nominal-Lam-ml-Normalization
    1.13    HOL-Nominal-SequentInvertibility
    1.14    HOL-Ordinal
    1.15 -  HOL-Ordinals_and_Cardinals
    1.16    HOL-POPLmark-deBruijn
    1.17    HOL-Perfect-Number-Thm
    1.18    HOL-Polynomials
     2.1 --- a/NEWS	Wed Sep 12 05:21:47 2012 +0200
     2.2 +++ b/NEWS	Wed Sep 12 05:29:21 2012 +0200
     2.3 @@ -100,8 +100,8 @@
     2.4  * HOL/Codatatype: New (co)datatype package with support for mixed,
     2.5  nested recursion and interesting non-free datatypes.
     2.6  
     2.7 -* HOL/Ordinals_and_Cardinals: Theories of ordinals and cardinals
     2.8 -(supersedes the AFP entry of the same name).
     2.9 +* HOL/Cardinals: Theories of ordinals and cardinals
    2.10 +(supersedes the AFP entry "Ordinals_and_Cardinals").
    2.11  
    2.12  * Library/Debug.thy and Library/Parallel.thy: debugging and parallel
    2.13  execution for code generated towards Isabelle/ML.
     3.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     3.2 +++ b/src/HOL/Cardinals/Cardinal_Arithmetic.thy	Wed Sep 12 05:29:21 2012 +0200
     3.3 @@ -0,0 +1,878 @@
     3.4 +(*  Title:      HOL/Cardinals/Cardinal_Arithmetic.thy
     3.5 +    Author:     Dmitriy Traytel, TU Muenchen
     3.6 +    Copyright   2012
     3.7 +
     3.8 +Cardinal arithmetic.
     3.9 +*)
    3.10 +
    3.11 +header {* Cardinal Arithmetic  *}
    3.12 +
    3.13 +theory Cardinal_Arithmetic
    3.14 +imports Cardinal_Order_Relation_Base
    3.15 +begin
    3.16 +
    3.17 +text {*
    3.18 +  The following collection of lemmas should be seen as an user interface to the HOL Theory
    3.19 +  of cardinals. It is not expected to be complete in any sense, since its
    3.20 +  development was driven by demand arising from the development of the (co)datatype package.
    3.21 +*}
    3.22 +
    3.23 +(*library candidate*)
    3.24 +lemma dir_image: "\<lbrakk>\<And>x y. (f x = f y) = (x = y); Card_order r\<rbrakk> \<Longrightarrow> r =o dir_image r f"
    3.25 +by (rule dir_image_ordIso) (auto simp add: inj_on_def card_order_on_def)
    3.26 +
    3.27 +(*should supersede a weaker lemma from the library*)
    3.28 +lemma dir_image_Field: "Field (dir_image r f) = f ` Field r"
    3.29 +unfolding dir_image_def Field_def Range_def Domain_def by fastforce
    3.30 +
    3.31 +lemma card_order_dir_image:
    3.32 +  assumes bij: "bij f" and co: "card_order r"
    3.33 +  shows "card_order (dir_image r f)"
    3.34 +proof -
    3.35 +  from assms have "Field (dir_image r f) = UNIV"
    3.36 +    using card_order_on_Card_order[of UNIV r] unfolding bij_def dir_image_Field by auto
    3.37 +  moreover from bij have "\<And>x y. (f x = f y) = (x = y)" unfolding bij_def inj_on_def by auto
    3.38 +  with co have "Card_order (dir_image r f)"
    3.39 +    using card_order_on_Card_order[of UNIV r] Card_order_ordIso2[OF _ dir_image] by blast
    3.40 +  ultimately show ?thesis by auto
    3.41 +qed
    3.42 +
    3.43 +(*library candidate*)
    3.44 +lemma ordIso_refl: "Card_order r \<Longrightarrow> r =o r"
    3.45 +by (rule card_order_on_ordIso)
    3.46 +
    3.47 +(*library candidate*)
    3.48 +lemma ordLeq_refl: "Card_order r \<Longrightarrow> r \<le>o r"
    3.49 +by (rule ordIso_imp_ordLeq, rule card_order_on_ordIso)
    3.50 +
    3.51 +(*library candidate*)
    3.52 +lemma card_of_ordIso_subst: "A = B \<Longrightarrow> |A| =o |B|"
    3.53 +by (simp only: ordIso_refl card_of_Card_order)
    3.54 +
    3.55 +(*library candidate*)
    3.56 +lemma card_of_Times_Plus_distrib:
    3.57 +  "|A <*> (B <+> C)| =o |A <*> B <+> A <*> C|" (is "|?RHS| =o |?LHS|")
    3.58 +proof -
    3.59 +  let ?f = "\<lambda>(a, bc). case bc of Inl b \<Rightarrow> Inl (a, b) | Inr c \<Rightarrow> Inr (a, c)"
    3.60 +  have "bij_betw ?f ?RHS ?LHS" unfolding bij_betw_def inj_on_def by force
    3.61 +  thus ?thesis using card_of_ordIso by blast
    3.62 +qed
    3.63 +
    3.64 +(*library candidate*)
    3.65 +lemma Field_card_order: "card_order r \<Longrightarrow> Field r = UNIV"
    3.66 +using card_order_on_Card_order[of UNIV r] by simp
    3.67 +
    3.68 +subsection {* Zero *}
    3.69 +
    3.70 +definition czero where
    3.71 +  "czero = card_of {}"
    3.72 +
    3.73 +lemma czero_ordIso:
    3.74 +  "czero =o czero"
    3.75 +using card_of_empty_ordIso by (simp add: czero_def)
    3.76 +
    3.77 +lemma card_of_ordIso_czero_iff_empty:
    3.78 +  "|A| =o (czero :: 'a rel) \<longleftrightarrow> A = ({} :: 'a set)"
    3.79 +unfolding czero_def by (rule iffI[OF card_of_empty2]) (auto simp: card_of_refl)
    3.80 +
    3.81 +(* A "not czero" Cardinal predicate *)
    3.82 +abbreviation Cnotzero where
    3.83 +  "Cnotzero (r :: 'a rel) \<equiv> \<not>(r =o (czero :: 'a rel)) \<and> Card_order r"
    3.84 +
    3.85 +(*helper*)
    3.86 +lemma Cnotzero_imp_not_empty: "Cnotzero r \<Longrightarrow> Field r \<noteq> {}"
    3.87 +by (metis Card_order_iff_ordIso_card_of czero_def)
    3.88 +
    3.89 +lemma czeroI:
    3.90 +  "\<lbrakk>Card_order r; Field r = {}\<rbrakk> \<Longrightarrow> r =o czero"
    3.91 +using Cnotzero_imp_not_empty ordIso_transitive[OF _ czero_ordIso] by blast
    3.92 +
    3.93 +lemma czeroE:
    3.94 +  "r =o czero \<Longrightarrow> Field r = {}"
    3.95 +unfolding czero_def
    3.96 +by (drule card_of_cong) (simp only: Field_card_of card_of_empty2)
    3.97 +
    3.98 +lemma Cnotzero_mono:
    3.99 +  "\<lbrakk>Cnotzero r; Card_order q; r \<le>o q\<rbrakk> \<Longrightarrow> Cnotzero q"
   3.100 +apply (rule ccontr)
   3.101 +apply auto
   3.102 +apply (drule czeroE)
   3.103 +apply (erule notE)
   3.104 +apply (erule czeroI)
   3.105 +apply (drule card_of_mono2)
   3.106 +apply (simp only: card_of_empty3)
   3.107 +done
   3.108 +
   3.109 +subsection {* Infinite cardinals *}
   3.110 +
   3.111 +definition cinfinite where
   3.112 +  "cinfinite r = infinite (Field r)"
   3.113 +
   3.114 +abbreviation Cinfinite where
   3.115 +  "Cinfinite r \<equiv> cinfinite r \<and> Card_order r"
   3.116 +
   3.117 +lemma natLeq_ordLeq_cinfinite:
   3.118 +  assumes inf: "Cinfinite r"
   3.119 +  shows "natLeq \<le>o r"
   3.120 +proof -
   3.121 +  from inf have "natLeq \<le>o |Field r|" by (simp add: cinfinite_def infinite_iff_natLeq_ordLeq)
   3.122 +  also from inf have "|Field r| =o r" by (simp add: card_of_unique ordIso_symmetric)
   3.123 +  finally show ?thesis .
   3.124 +qed
   3.125 +
   3.126 +lemma cinfinite_not_czero: "cinfinite r \<Longrightarrow> \<not> (r =o (czero :: 'a rel))"
   3.127 +unfolding cinfinite_def by (metis czeroE finite.emptyI)
   3.128 +
   3.129 +lemma Cinfinite_Cnotzero: "Cinfinite r \<Longrightarrow> Cnotzero r"
   3.130 +by (metis cinfinite_not_czero)
   3.131 +
   3.132 +lemma Cinfinite_cong: "\<lbrakk>r1 =o r2; Cinfinite r1\<rbrakk> \<Longrightarrow> Cinfinite r2"
   3.133 +by (metis Card_order_ordIso2 card_of_mono2 card_of_ordLeq_infinite cinfinite_def ordIso_iff_ordLeq)
   3.134 +
   3.135 +lemma cinfinite_mono: "\<lbrakk>r1 \<le>o r2; cinfinite r1\<rbrakk> \<Longrightarrow> cinfinite r2"
   3.136 +by (metis card_of_mono2 card_of_ordLeq_infinite cinfinite_def)
   3.137 +
   3.138 +
   3.139 +subsection {* Binary sum *}
   3.140 +
   3.141 +definition csum (infixr "+c" 65) where
   3.142 +  "r1 +c r2 \<equiv> |Field r1 <+> Field r2|"
   3.143 +
   3.144 +lemma Card_order_csum:
   3.145 +  "Card_order (r1 +c r2)"
   3.146 +unfolding csum_def by (simp add: card_of_Card_order)
   3.147 +
   3.148 +lemma csum_Cnotzero1:
   3.149 +  "Cnotzero r1 \<Longrightarrow> Cnotzero (r1 +c r2)"
   3.150 +unfolding csum_def
   3.151 +by (metis Cnotzero_imp_not_empty Field_card_of Plus_eq_empty_conv card_of_card_order_on czeroE)
   3.152 +
   3.153 +lemma csum_Cnotzero2:
   3.154 +  "Cnotzero r2 \<Longrightarrow> Cnotzero (r1 +c r2)"
   3.155 +unfolding csum_def
   3.156 +by (metis Cnotzero_imp_not_empty Field_card_of Plus_eq_empty_conv card_of_card_order_on czeroE)
   3.157 +
   3.158 +lemma card_order_csum:
   3.159 +  assumes "card_order r1" "card_order r2"
   3.160 +  shows "card_order (r1 +c r2)"
   3.161 +proof -
   3.162 +  have "Field r1 = UNIV" "Field r2 = UNIV" using assms card_order_on_Card_order by auto
   3.163 +  thus ?thesis unfolding csum_def by (auto simp: card_of_card_order_on)
   3.164 +qed
   3.165 +
   3.166 +lemma cinfinite_csum:
   3.167 +  "cinfinite r1 \<or> cinfinite r2 \<Longrightarrow> cinfinite (r1 +c r2)"
   3.168 +unfolding cinfinite_def csum_def by (auto simp: Field_card_of)
   3.169 +
   3.170 +lemma Cinfinite_csum:
   3.171 +  "Cinfinite r1 \<or> Cinfinite r2 \<Longrightarrow> Cinfinite (r1 +c r2)"
   3.172 +unfolding cinfinite_def csum_def by (metis Field_card_of card_of_Card_order finite_Plus_iff)
   3.173 +
   3.174 +lemma Cinfinite_csum_strong:
   3.175 +  "\<lbrakk>Cinfinite r1; Cinfinite r2\<rbrakk> \<Longrightarrow> Cinfinite (r1 +c r2)"
   3.176 +by (metis Cinfinite_csum)
   3.177 +
   3.178 +lemma Cinfinite_csum1:
   3.179 +  "Cinfinite r1 \<Longrightarrow> Cinfinite (r1 +c r2)"
   3.180 +unfolding cinfinite_def csum_def by (metis Field_card_of card_of_Card_order finite_Plus_iff)
   3.181 +
   3.182 +lemma csum_cong: "\<lbrakk>p1 =o r1; p2 =o r2\<rbrakk> \<Longrightarrow> p1 +c p2 =o r1 +c r2"
   3.183 +by (simp only: csum_def ordIso_Plus_cong)
   3.184 +
   3.185 +lemma csum_cong1: "p1 =o r1 \<Longrightarrow> p1 +c q =o r1 +c q"
   3.186 +by (simp only: csum_def ordIso_Plus_cong1)
   3.187 +
   3.188 +lemma csum_cong2: "p2 =o r2 \<Longrightarrow> q +c p2 =o q +c r2"
   3.189 +by (simp only: csum_def ordIso_Plus_cong2)
   3.190 +
   3.191 +lemma csum_mono: "\<lbrakk>p1 \<le>o r1; p2 \<le>o r2\<rbrakk> \<Longrightarrow> p1 +c p2 \<le>o r1 +c r2"
   3.192 +by (simp only: csum_def ordLeq_Plus_mono)
   3.193 +
   3.194 +lemma csum_mono1: "p1 \<le>o r1 \<Longrightarrow> p1 +c q \<le>o r1 +c q"
   3.195 +by (simp only: csum_def ordLeq_Plus_mono1)
   3.196 +
   3.197 +lemma csum_mono2: "p2 \<le>o r2 \<Longrightarrow> q +c p2 \<le>o q +c r2"
   3.198 +by (simp only: csum_def ordLeq_Plus_mono2)
   3.199 +
   3.200 +lemma ordLeq_csum1: "Card_order p1 \<Longrightarrow> p1 \<le>o p1 +c p2"
   3.201 +by (simp only: csum_def Card_order_Plus1)
   3.202 +
   3.203 +lemma ordLeq_csum2: "Card_order p2 \<Longrightarrow> p2 \<le>o p1 +c p2"
   3.204 +by (simp only: csum_def Card_order_Plus2)
   3.205 +
   3.206 +lemma csum_com: "p1 +c p2 =o p2 +c p1"
   3.207 +by (simp only: csum_def card_of_Plus_commute)
   3.208 +
   3.209 +lemma csum_assoc: "(p1 +c p2) +c p3 =o p1 +c p2 +c p3"
   3.210 +by (simp only: csum_def Field_card_of card_of_Plus_assoc)
   3.211 +
   3.212 +lemma Plus_csum: "|A <+> B| =o |A| +c |B|"
   3.213 +by (simp only: csum_def Field_card_of card_of_refl)
   3.214 +
   3.215 +lemma Un_csum: "|A \<union> B| \<le>o |A| +c |B|"
   3.216 +using ordLeq_ordIso_trans[OF card_of_Un_Plus_ordLeq Plus_csum] by blast
   3.217 +
   3.218 +
   3.219 +subsection {* One *}
   3.220 +
   3.221 +definition cone where
   3.222 +  "cone = card_of {()}"
   3.223 +
   3.224 +lemma Card_order_cone: "Card_order cone"
   3.225 +unfolding cone_def by (rule card_of_Card_order)
   3.226 +
   3.227 +lemma single_cone:
   3.228 +  "|{x}| =o cone"
   3.229 +proof -
   3.230 +  let ?f = "\<lambda>x. ()"
   3.231 +  have "bij_betw ?f {x} {()}" unfolding bij_betw_def by auto
   3.232 +  thus ?thesis unfolding cone_def using card_of_ordIso by blast
   3.233 +qed
   3.234 +
   3.235 +lemma cone_not_czero: "\<not> (cone =o czero)"
   3.236 +unfolding czero_def cone_def by (metis empty_not_insert card_of_empty3[of "{()}"] ordIso_iff_ordLeq)
   3.237 +
   3.238 +lemma cone_Cnotzero: "Cnotzero cone"
   3.239 +by (simp add: cone_not_czero Card_order_cone)
   3.240 +
   3.241 +lemma cone_ordLeq_Cnotzero: "Cnotzero r \<Longrightarrow> cone \<le>o r"
   3.242 +unfolding cone_def by (metis Card_order_singl_ordLeq czeroI)
   3.243 +
   3.244 +
   3.245 +subsection{* Two *}
   3.246 +
   3.247 +definition ctwo where
   3.248 +  "ctwo = |UNIV :: bool set|"
   3.249 +
   3.250 +lemma Card_order_ctwo: "Card_order ctwo"
   3.251 +unfolding ctwo_def by (rule card_of_Card_order)
   3.252 +
   3.253 +lemma cone_ordLeq_ctwo: "cone \<le>o ctwo"
   3.254 +unfolding cone_def ctwo_def card_of_ordLeq[symmetric] by auto
   3.255 +
   3.256 +lemma ctwo_not_czero: "\<not> (ctwo =o czero)"
   3.257 +using card_of_empty3[of "UNIV :: bool set"] ordIso_iff_ordLeq
   3.258 +unfolding czero_def ctwo_def by (metis UNIV_not_empty)
   3.259 +
   3.260 +lemma ctwo_Cnotzero: "Cnotzero ctwo"
   3.261 +by (simp add: ctwo_not_czero Card_order_ctwo)
   3.262 +
   3.263 +
   3.264 +subsection {* Family sum *}
   3.265 +
   3.266 +definition Csum where
   3.267 +  "Csum r rs \<equiv> |SIGMA i : Field r. Field (rs i)|"
   3.268 +
   3.269 +(* Similar setup to the one for SIGMA from theory Big_Operators: *)
   3.270 +syntax "_Csum" ::
   3.271 +  "pttrn => ('a * 'a) set => 'b * 'b set => (('a * 'b) * ('a * 'b)) set"
   3.272 +  ("(3CSUM _:_. _)" [0, 51, 10] 10)
   3.273 +
   3.274 +translations
   3.275 +  "CSUM i:r. rs" == "CONST Csum r (%i. rs)"
   3.276 +
   3.277 +lemma SIGMA_CSUM: "|SIGMA i : I. As i| = (CSUM i : |I|. |As i| )"
   3.278 +by (auto simp: Csum_def Field_card_of)
   3.279 +
   3.280 +(* NB: Always, under the cardinal operator,
   3.281 +operations on sets are reduced automatically to operations on cardinals.
   3.282 +This should make cardinal reasoning more direct and natural.  *)
   3.283 +
   3.284 +
   3.285 +subsection {* Product *}
   3.286 +
   3.287 +definition cprod (infixr "*c" 80) where
   3.288 +  "r1 *c r2 = |Field r1 <*> Field r2|"
   3.289 +
   3.290 +lemma Times_cprod: "|A \<times> B| =o |A| *c |B|"
   3.291 +by (simp only: cprod_def Field_card_of card_of_refl)
   3.292 +
   3.293 +lemma card_order_cprod:
   3.294 +  assumes "card_order r1" "card_order r2"
   3.295 +  shows "card_order (r1 *c r2)"
   3.296 +proof -
   3.297 +  have "Field r1 = UNIV" "Field r2 = UNIV" using assms card_order_on_Card_order by auto
   3.298 +  thus ?thesis by (auto simp: cprod_def card_of_card_order_on)
   3.299 +qed
   3.300 +
   3.301 +lemma Card_order_cprod: "Card_order (r1 *c r2)"
   3.302 +by (simp only: cprod_def Field_card_of card_of_card_order_on)
   3.303 +
   3.304 +lemma cprod_cong2: "p2 =o r2 \<Longrightarrow> q *c p2 =o q *c r2"
   3.305 +by (simp only: cprod_def ordIso_Times_cong2)
   3.306 +
   3.307 +lemma cprod_mono1: "p1 \<le>o r1 \<Longrightarrow> p1 *c q \<le>o r1 *c q"
   3.308 +by (simp only: cprod_def ordLeq_Times_mono1)
   3.309 +
   3.310 +lemma cprod_mono2: "p2 \<le>o r2 \<Longrightarrow> q *c p2 \<le>o q *c r2"
   3.311 +by (simp only: cprod_def ordLeq_Times_mono2)
   3.312 +
   3.313 +lemma ordLeq_cprod1: "\<lbrakk>Card_order p1; Cnotzero p2\<rbrakk> \<Longrightarrow> p1 \<le>o p1 *c p2"
   3.314 +unfolding cprod_def by (metis Card_order_Times1 czeroI)
   3.315 +
   3.316 +lemma ordLeq_cprod2: "\<lbrakk>Cnotzero p1; Card_order p2\<rbrakk> \<Longrightarrow> p2 \<le>o p1 *c p2"
   3.317 +unfolding cprod_def by (metis Card_order_Times2 czeroI)
   3.318 +
   3.319 +lemma cinfinite_cprod: "\<lbrakk>cinfinite r1; cinfinite r2\<rbrakk> \<Longrightarrow> cinfinite (r1 *c r2)"
   3.320 +by (simp add: cinfinite_def cprod_def Field_card_of infinite_cartesian_product)
   3.321 +
   3.322 +lemma cinfinite_cprod2: "\<lbrakk>Cnotzero r1; Cinfinite r2\<rbrakk> \<Longrightarrow> cinfinite (r1 *c r2)"
   3.323 +by (metis cinfinite_mono ordLeq_cprod2)
   3.324 +
   3.325 +lemma Cinfinite_cprod2: "\<lbrakk>Cnotzero r1; Cinfinite r2\<rbrakk> \<Longrightarrow> Cinfinite (r1 *c r2)"
   3.326 +by (blast intro: cinfinite_cprod2 Card_order_cprod)
   3.327 +
   3.328 +lemma cprod_com: "p1 *c p2 =o p2 *c p1"
   3.329 +by (simp only: cprod_def card_of_Times_commute)
   3.330 +
   3.331 +lemma card_of_Csum_Times:
   3.332 +  "\<forall>i \<in> I. |A i| \<le>o |B| \<Longrightarrow> (CSUM i : |I|. |A i| ) \<le>o |I| *c |B|"
   3.333 +by (simp only: Csum_def cprod_def Field_card_of card_of_Sigma_Times)
   3.334 +
   3.335 +lemma card_of_Csum_Times':
   3.336 +  assumes "Card_order r" "\<forall>i \<in> I. |A i| \<le>o r"
   3.337 +  shows "(CSUM i : |I|. |A i| ) \<le>o |I| *c r"
   3.338 +proof -
   3.339 +  from assms(1) have *: "r =o |Field r|" by (simp add: card_of_unique)
   3.340 +  with assms(2) have "\<forall>i \<in> I. |A i| \<le>o |Field r|" by (blast intro: ordLeq_ordIso_trans)
   3.341 +  hence "(CSUM i : |I|. |A i| ) \<le>o |I| *c |Field r|" by (simp only: card_of_Csum_Times)
   3.342 +  also from * have "|I| *c |Field r| \<le>o |I| *c r"
   3.343 +    by (simp only: Field_card_of card_of_refl cprod_def ordIso_imp_ordLeq)
   3.344 +  finally show ?thesis .
   3.345 +qed
   3.346 +
   3.347 +lemma cprod_csum_distrib1: "r1 *c r2 +c r1 *c r3 =o r1 *c (r2 +c r3)"
   3.348 +unfolding csum_def cprod_def by (simp add: Field_card_of card_of_Times_Plus_distrib ordIso_symmetric)
   3.349 +
   3.350 +lemma csum_absorb2': "\<lbrakk>Card_order r2; r1 \<le>o r2; cinfinite r1 \<or> cinfinite r2\<rbrakk> \<Longrightarrow> r1 +c r2 =o r2"
   3.351 +unfolding csum_def by (metis Card_order_Plus_infinite cinfinite_def cinfinite_mono)
   3.352 +
   3.353 +lemma csum_absorb1':
   3.354 +  assumes card: "Card_order r2"
   3.355 +  and r12: "r1 \<le>o r2" and cr12: "cinfinite r1 \<or> cinfinite r2"
   3.356 +  shows "r2 +c r1 =o r2"
   3.357 +by (rule ordIso_transitive, rule csum_com, rule csum_absorb2', (simp only: assms)+)
   3.358 +
   3.359 +lemma csum_absorb1: "\<lbrakk>Cinfinite r2; r1 \<le>o r2\<rbrakk> \<Longrightarrow> r2 +c r1 =o r2"
   3.360 +by (rule csum_absorb1') auto
   3.361 +
   3.362 +lemma cprod_infinite1': "\<lbrakk>Cinfinite r; Cnotzero p; p \<le>o r\<rbrakk> \<Longrightarrow> r *c p =o r"
   3.363 +unfolding cinfinite_def cprod_def
   3.364 +by (rule Card_order_Times_infinite[THEN conjunct1]) (blast intro: czeroI)+
   3.365 +
   3.366 +lemma cprod_infinite: "Cinfinite r \<Longrightarrow> r *c r =o r"
   3.367 +using cprod_infinite1' Cinfinite_Cnotzero ordLeq_refl by blast
   3.368 +
   3.369 +
   3.370 +subsection {* Exponentiation *}
   3.371 +
   3.372 +definition cexp (infixr "^c" 80) where
   3.373 +  "r1 ^c r2 \<equiv> |Func (Field r2) (Field r1)|"
   3.374 +
   3.375 +definition ccexp (infixr "^^c" 80) where
   3.376 +  "r1 ^^c r2 \<equiv> |Pfunc (Field r2) (Field r1)|"
   3.377 +
   3.378 +lemma cexp_ordLeq_ccexp: "r1 ^c r2 \<le>o r1 ^^c r2"
   3.379 +unfolding cexp_def ccexp_def by (rule card_of_mono1) (rule Func_Pfunc)
   3.380 +
   3.381 +lemma card_order_ccexp:
   3.382 +  assumes "card_order r1" "card_order r2"
   3.383 +  shows "card_order (r1 ^^c r2)"
   3.384 +proof -
   3.385 +  have "Field r1 = UNIV" "Field r2 = UNIV" using assms card_order_on_Card_order by auto
   3.386 +  thus ?thesis unfolding ccexp_def Pfunc_def
   3.387 +    by (auto simp: card_of_card_order_on split: option.split)
   3.388 +qed
   3.389 +
   3.390 +lemma Card_order_cexp: "Card_order (r1 ^c r2)"
   3.391 +unfolding cexp_def by (rule card_of_Card_order)
   3.392 +
   3.393 +lemma cexp_mono':
   3.394 +  assumes 1: "p1 \<le>o r1" and 2: "p2 \<le>o r2"
   3.395 +  and n1: "Field p1 \<noteq> {} \<or> cone \<le>o r1 ^c r2"
   3.396 +  and n2: "Field p2 = {} \<Longrightarrow> Field r2 = {}"
   3.397 +  shows "p1 ^c p2 \<le>o r1 ^c r2"
   3.398 +proof(cases "Field p1 = {}")
   3.399 +  case True
   3.400 +  hence "|Field (p1 ^c p2)| \<le>o cone"
   3.401 +    unfolding czero_def cone_def cexp_def Field_card_of
   3.402 +    by (cases "Field p2 = {}", auto intro: card_of_ordLeqI2 simp: Func_empty)
   3.403 +       (metis Func_is_emp card_of_empty ex_in_conv)
   3.404 +  hence "p1 ^c p2 \<le>o cone" by (simp add: Field_card_of cexp_def)
   3.405 +  thus ?thesis using True n1 ordLeq_transitive by auto
   3.406 +next
   3.407 +  case False
   3.408 +  have 1: "|Field p1| \<le>o |Field r1|" and 2: "|Field p2| \<le>o |Field r2|"
   3.409 +    using 1 2 by (auto simp: card_of_mono2)
   3.410 +  obtain f1 where f1: "f1 ` Field r1 = Field p1"
   3.411 +    using 1 unfolding card_of_ordLeq2[OF False, symmetric] by auto
   3.412 +  obtain f2 where f2: "inj_on f2 (Field p2)" "f2 ` Field p2 \<subseteq> Field r2"
   3.413 +    using 2 unfolding card_of_ordLeq[symmetric] by blast
   3.414 +  have 0: "Func_map (Field p2) f1 f2 ` (Field (r1 ^c r2)) = Field (p1 ^c p2)"
   3.415 +    unfolding cexp_def Field_card_of using Func_map_surj[OF f1 f2 n2, symmetric] .
   3.416 +  have 00: "Field (p1 ^c p2) \<noteq> {}" unfolding cexp_def Field_card_of Func_is_emp
   3.417 +    using False by simp
   3.418 +  show ?thesis
   3.419 +    using 0 card_of_ordLeq2[OF 00] unfolding cexp_def Field_card_of by blast
   3.420 +qed
   3.421 +
   3.422 +lemma cexp_mono:
   3.423 +  assumes 1: "p1 \<le>o r1" and 2: "p2 \<le>o r2"
   3.424 +  and n1: "Cnotzero p1 \<or> cone \<le>o r1 ^c r2"
   3.425 +  and n2: "p2 =o czero \<Longrightarrow> r2 =o czero" and card: "Card_order p2"
   3.426 +  shows "p1 ^c p2 \<le>o r1 ^c r2"
   3.427 +proof (rule cexp_mono'[OF 1 2])
   3.428 +  show "Field p1 \<noteq> {} \<or> cone \<le>o r1 ^c r2"
   3.429 +  proof (cases "Cnotzero p1")
   3.430 +    case True show ?thesis using Cnotzero_imp_not_empty[OF True] by (rule disjI1)
   3.431 +  next
   3.432 +    case False with n1 show ?thesis by blast
   3.433 +  qed
   3.434 +qed (rule czeroI[OF card, THEN n2, THEN czeroE])
   3.435 +
   3.436 +lemma cexp_mono1:
   3.437 +  assumes 1: "p1 \<le>o r1"
   3.438 +  and n1: "Cnotzero p1 \<or> cone \<le>o r1 ^c q" and q: "Card_order q"
   3.439 +  shows "p1 ^c q \<le>o r1 ^c q"
   3.440 +using ordLeq_refl[OF q] by (rule cexp_mono[OF 1 _ n1]) (auto simp: q)
   3.441 +
   3.442 +lemma cexp_mono1_Cnotzero: "\<lbrakk>p1 \<le>o r1; Cnotzero p1; Card_order q\<rbrakk> \<Longrightarrow> p1 ^c q \<le>o r1 ^c q"
   3.443 +by (simp add: cexp_mono1)
   3.444 +
   3.445 +lemma cexp_mono1_cone_ordLeq: "\<lbrakk>p1 \<le>o r1; cone \<le>o r1 ^c q; Card_order q\<rbrakk> \<Longrightarrow> p1 ^c q \<le>o r1 ^c q"
   3.446 +using assms by (simp add: cexp_mono1)
   3.447 +
   3.448 +lemma cexp_mono2':
   3.449 +  assumes 2: "p2 \<le>o r2" and q: "Card_order q"
   3.450 +  and n1: "Field q \<noteq> {} \<or> cone \<le>o q ^c r2"
   3.451 +  and n2: "Field p2 = {} \<Longrightarrow> Field r2 = {}"
   3.452 +  shows "q ^c p2 \<le>o q ^c r2"
   3.453 +using ordLeq_refl[OF q] by (rule cexp_mono'[OF _ 2 n1 n2]) auto
   3.454 +
   3.455 +lemma cexp_mono2:
   3.456 +  assumes 2: "p2 \<le>o r2" and q: "Card_order q"
   3.457 +  and n1: "Cnotzero q \<or> cone \<le>o q ^c r2"
   3.458 +  and n2: "p2 =o czero \<Longrightarrow> r2 =o czero" and card: "Card_order p2"
   3.459 +  shows "q ^c p2 \<le>o q ^c r2"
   3.460 +using ordLeq_refl[OF q] by (rule cexp_mono[OF _ 2 n1 n2 card]) auto
   3.461 +
   3.462 +lemma cexp_mono2_Cnotzero:
   3.463 +  assumes "p2 \<le>o r2" "Cnotzero q" and n2: "Cnotzero p2"
   3.464 +  shows "q ^c p2 \<le>o q ^c r2"
   3.465 +proof (rule cexp_mono)
   3.466 +  assume *: "p2 =o czero"
   3.467 +  have False using n2 czeroI czeroE[OF *] by blast
   3.468 +  thus "r2 =o czero" by blast
   3.469 +qed (auto simp add: assms ordLeq_refl)
   3.470 +
   3.471 +lemma cexp_cong:
   3.472 +  assumes 1: "p1 =o r1" and 2: "p2 =o r2"
   3.473 +  and p1: "Cnotzero p1 \<or> cone \<le>o r1 ^c r2" and Cr: "Card_order r2"
   3.474 +  and r1: "Cnotzero r1 \<or> cone \<le>o p1 ^c p2" and Cp: "Card_order p2"
   3.475 +  shows "p1 ^c p2 =o r1 ^c r2"
   3.476 +proof -
   3.477 +  obtain f where "bij_betw f (Field p2) (Field r2)"
   3.478 +    using 2 card_of_ordIso[of "Field p2" "Field r2"] card_of_cong by auto
   3.479 +  hence 0: "Field p2 = {} \<longleftrightarrow> Field r2 = {}" unfolding bij_betw_def by auto
   3.480 +  have r: "p2 =o czero \<Longrightarrow> r2 =o czero"
   3.481 +    and p: "r2 =o czero \<Longrightarrow> p2 =o czero"
   3.482 +     using 0 Cr Cp czeroE czeroI by auto
   3.483 +  show ?thesis using 0 1 2 unfolding ordIso_iff_ordLeq
   3.484 +    using r p cexp_mono[OF _ _ p1 _ Cp] cexp_mono[OF _ _ r1 _ Cr]
   3.485 +    by blast
   3.486 +qed
   3.487 +
   3.488 +lemma cexp_cong1:
   3.489 +  assumes 1: "p1 =o r1" and q: "Card_order q"
   3.490 +  and p1: "Cnotzero p1 \<or> cone \<le>o r1 ^c q"
   3.491 +  and r1: "Cnotzero r1 \<or> cone \<le>o p1 ^c q"
   3.492 +  shows "p1 ^c q =o r1 ^c q"
   3.493 +by (rule cexp_cong[OF 1 _ p1 q r1 q]) (rule ordIso_refl[OF q])
   3.494 +
   3.495 +lemma cexp_cong1_Cnotzero:
   3.496 +  assumes "p1 =o r1" "Card_order q" "Cnotzero p1" "Cnotzero r1"
   3.497 +  shows "p1 ^c q =o r1 ^c q"
   3.498 +by (rule cexp_cong1, auto simp add: assms)
   3.499 +
   3.500 +lemma cexp_cong2:
   3.501 +  assumes 2: "p2 =o r2" and q: "Card_order q"
   3.502 +  and p: "Card_order p2" and r: "Card_order r2"
   3.503 +  shows "Cnotzero q \<or> (cone \<le>o q ^c p2 \<and> cone \<le>o q ^c r2) \<Longrightarrow>
   3.504 +    q ^c p2 =o q ^c r2"
   3.505 +by (rule cexp_cong[OF _ 2]) (auto simp only: ordIso_refl q p r)
   3.506 +
   3.507 +lemma cexp_cong2_Cnotzero:
   3.508 +  assumes 2: "p2 =o r2" and q: "Cnotzero q"
   3.509 +  and p: "Card_order p2"
   3.510 +  shows "q ^c p2 =o q ^c r2"
   3.511 +by (rule cexp_cong[OF _ 2]) (auto simp only: ordIso_refl Card_order_ordIso2[OF p 2] q p)
   3.512 +
   3.513 +lemma cexp_czero: "r ^c czero =o cone"
   3.514 +unfolding cexp_def czero_def Field_card_of Func_empty by (rule single_cone)
   3.515 +
   3.516 +lemma cexp_cone:
   3.517 +  assumes "Card_order r"
   3.518 +  shows "r ^c cone =o r"
   3.519 +proof -
   3.520 +  have "r ^c cone =o |Field r|"
   3.521 +    unfolding cexp_def cone_def Field_card_of Func_empty
   3.522 +      card_of_ordIso[symmetric] bij_betw_def Func_def inj_on_def image_def
   3.523 +    by (rule exI[of _ "\<lambda>f. case f () of Some a \<Rightarrow> a"]) auto
   3.524 +  also have "|Field r| =o r" by (rule card_of_Field_ordIso[OF assms])
   3.525 +  finally show ?thesis .
   3.526 +qed
   3.527 +
   3.528 +lemma cexp_cprod:
   3.529 +  assumes r1: "Cnotzero r1"
   3.530 +  shows "(r1 ^c r2) ^c r3 =o r1 ^c (r2 *c r3)" (is "?L =o ?R")
   3.531 +proof -
   3.532 +  have "?L =o r1 ^c (r3 *c r2)"
   3.533 +    unfolding cprod_def cexp_def Field_card_of
   3.534 +    using card_of_Func_Times by(rule ordIso_symmetric)
   3.535 +  also have "r1 ^c (r3 *c r2) =o ?R"
   3.536 +    apply(rule cexp_cong2) using cprod_com r1 by (auto simp: Card_order_cprod)
   3.537 +  finally show ?thesis .
   3.538 +qed
   3.539 +
   3.540 +lemma cexp_cprod_ordLeq:
   3.541 +  assumes r1: "Cnotzero r1" and r2: "Cinfinite r2"
   3.542 +  and r3: "Cnotzero r3" "r3 \<le>o r2"
   3.543 +  shows "(r1 ^c r2) ^c r3 =o r1 ^c r2" (is "?L =o ?R")
   3.544 +proof-
   3.545 +  have "?L =o r1 ^c (r2 *c r3)" using cexp_cprod[OF r1] .
   3.546 +  also have "r1 ^c (r2 *c r3) =o ?R"
   3.547 +  apply(rule cexp_cong2)
   3.548 +  apply(rule cprod_infinite1'[OF r2 r3]) using r1 r2 by (fastforce simp: Card_order_cprod)+
   3.549 +  finally show ?thesis .
   3.550 +qed
   3.551 +
   3.552 +lemma Cnotzero_UNIV: "Cnotzero |UNIV|"
   3.553 +by (auto simp: card_of_Card_order card_of_ordIso_czero_iff_empty)
   3.554 +
   3.555 +lemma Pow_cexp_ctwo:
   3.556 +  "|Pow A| =o ctwo ^c |A|"
   3.557 +unfolding ctwo_def cexp_def Field_card_of by (rule card_of_Pow_Func)
   3.558 +
   3.559 +lemma ordLess_ctwo_cexp:
   3.560 +  assumes "Card_order r"
   3.561 +  shows "r <o ctwo ^c r"
   3.562 +proof -
   3.563 +  have "r <o |Pow (Field r)|" using assms by (rule Card_order_Pow)
   3.564 +  also have "|Pow (Field r)| =o ctwo ^c r"
   3.565 +    unfolding ctwo_def cexp_def Field_card_of by (rule card_of_Pow_Func)
   3.566 +  finally show ?thesis .
   3.567 +qed
   3.568 +
   3.569 +lemma ordLeq_cexp1:
   3.570 +  assumes "Cnotzero r" "Card_order q"
   3.571 +  shows "q \<le>o q ^c r"
   3.572 +proof (cases "q =o (czero :: 'a rel)")
   3.573 +  case True thus ?thesis by (simp only: card_of_empty cexp_def czero_def ordIso_ordLeq_trans)
   3.574 +next
   3.575 +  case False
   3.576 +  thus ?thesis
   3.577 +    apply -
   3.578 +    apply (rule ordIso_ordLeq_trans)
   3.579 +    apply (rule ordIso_symmetric)
   3.580 +    apply (rule cexp_cone)
   3.581 +    apply (rule assms(2))
   3.582 +    apply (rule cexp_mono2)
   3.583 +    apply (rule cone_ordLeq_Cnotzero)
   3.584 +    apply (rule assms(1))
   3.585 +    apply (rule assms(2))
   3.586 +    apply (rule disjI1)
   3.587 +    apply (rule conjI)
   3.588 +    apply (rule notI)
   3.589 +    apply (erule notE)
   3.590 +    apply (rule ordIso_transitive)
   3.591 +    apply assumption
   3.592 +    apply (rule czero_ordIso)
   3.593 +    apply (rule assms(2))
   3.594 +    apply (rule notE)
   3.595 +    apply (rule cone_not_czero)
   3.596 +    apply assumption
   3.597 +    apply (rule Card_order_cone)
   3.598 +  done
   3.599 +qed
   3.600 +
   3.601 +lemma ordLeq_cexp2:
   3.602 +  assumes "ctwo \<le>o q" "Card_order r"
   3.603 +  shows "r \<le>o q ^c r"
   3.604 +proof (cases "r =o (czero :: 'a rel)")
   3.605 +  case True thus ?thesis by (simp only: card_of_empty cexp_def czero_def ordIso_ordLeq_trans)
   3.606 +next
   3.607 +  case False thus ?thesis
   3.608 +    apply -
   3.609 +    apply (rule ordLess_imp_ordLeq)
   3.610 +    apply (rule ordLess_ordLeq_trans)
   3.611 +    apply (rule ordLess_ctwo_cexp)
   3.612 +    apply (rule assms(2))
   3.613 +    apply (rule cexp_mono1)
   3.614 +    apply (rule assms(1))
   3.615 +    apply (rule disjI1)
   3.616 +    apply (rule ctwo_Cnotzero)
   3.617 +    apply (rule assms(2))
   3.618 +  done
   3.619 +qed
   3.620 +
   3.621 +lemma Cnotzero_cexp:
   3.622 +  assumes "Cnotzero q" "Card_order r"
   3.623 +  shows "Cnotzero (q ^c r)"
   3.624 +proof (cases "r =o czero")
   3.625 +  case False thus ?thesis
   3.626 +    apply -
   3.627 +    apply (rule Cnotzero_mono)
   3.628 +    apply (rule assms(1))
   3.629 +    apply (rule Card_order_cexp)
   3.630 +    apply (rule ordLeq_cexp1)
   3.631 +    apply (rule conjI)
   3.632 +    apply (rule notI)
   3.633 +    apply (erule notE)
   3.634 +    apply (rule ordIso_transitive)
   3.635 +    apply assumption
   3.636 +    apply (rule czero_ordIso)
   3.637 +    apply (rule assms(2))
   3.638 +    apply (rule conjunct2)
   3.639 +    apply (rule assms(1))
   3.640 +  done
   3.641 +next
   3.642 +  case True thus ?thesis
   3.643 +    apply -
   3.644 +    apply (rule Cnotzero_mono)
   3.645 +    apply (rule cone_Cnotzero)
   3.646 +    apply (rule Card_order_cexp)
   3.647 +    apply (rule ordIso_imp_ordLeq)
   3.648 +    apply (rule ordIso_symmetric)
   3.649 +    apply (rule ordIso_transitive)
   3.650 +    apply (rule cexp_cong2)
   3.651 +    apply assumption
   3.652 +    apply (rule conjunct2)
   3.653 +    apply (rule assms(1))
   3.654 +    apply (rule assms(2))
   3.655 +    apply (simp only: card_of_Card_order czero_def)
   3.656 +    apply (rule disjI1)
   3.657 +    apply (rule assms(1))
   3.658 +    apply (rule cexp_czero)
   3.659 +  done
   3.660 +qed
   3.661 +
   3.662 +lemma Cinfinite_ctwo_cexp:
   3.663 +  "Cinfinite r \<Longrightarrow> Cinfinite (ctwo ^c r)"
   3.664 +unfolding ctwo_def cexp_def cinfinite_def Field_card_of
   3.665 +by (rule conjI, rule infinite_Func, auto, rule card_of_card_order_on)
   3.666 +
   3.667 +lemma cinfinite_cexp: "\<lbrakk>ctwo \<le>o q; Cinfinite r\<rbrakk> \<Longrightarrow> cinfinite (q ^c r)"
   3.668 +by (metis assms cinfinite_mono ordLeq_cexp2)
   3.669 +
   3.670 +lemma cinfinite_ccexp: "\<lbrakk>ctwo \<le>o q; Cinfinite r\<rbrakk> \<Longrightarrow> cinfinite (q ^^c r)"
   3.671 +by (rule cinfinite_mono[OF cexp_ordLeq_ccexp cinfinite_cexp])
   3.672 +
   3.673 +lemma Cinfinite_cexp:
   3.674 +  "\<lbrakk>ctwo \<le>o q; Cinfinite r\<rbrakk> \<Longrightarrow> Cinfinite (q ^c r)"
   3.675 +by (simp add: cinfinite_cexp Card_order_cexp)
   3.676 +
   3.677 +lemma ctwo_ordLess_natLeq:
   3.678 +  "ctwo <o natLeq"
   3.679 +unfolding ctwo_def using finite_iff_ordLess_natLeq finite_UNIV by fast
   3.680 +
   3.681 +lemma ctwo_ordLess_Cinfinite: "Cinfinite r \<Longrightarrow> ctwo <o r"
   3.682 +by (metis ctwo_ordLess_natLeq natLeq_ordLeq_cinfinite ordLess_ordLeq_trans)
   3.683 +
   3.684 +lemma ctwo_ordLeq_Cinfinite:
   3.685 +  assumes "Cinfinite r"
   3.686 +  shows "ctwo \<le>o r"
   3.687 +by (rule ordLess_imp_ordLeq[OF ctwo_ordLess_Cinfinite[OF assms]])
   3.688 +
   3.689 +lemma Cinfinite_ordLess_cexp:
   3.690 +  assumes r: "Cinfinite r"
   3.691 +  shows "r <o r ^c r"
   3.692 +proof -
   3.693 +  have "r <o ctwo ^c r" using r by (simp only: ordLess_ctwo_cexp)
   3.694 +  also have "ctwo ^c r \<le>o r ^c r"
   3.695 +    by (rule cexp_mono1[OF ctwo_ordLeq_Cinfinite]) (auto simp: r ctwo_not_czero Card_order_ctwo)
   3.696 +  finally show ?thesis .
   3.697 +qed
   3.698 +
   3.699 +lemma infinite_ordLeq_cexp:
   3.700 +  assumes "Cinfinite r"
   3.701 +  shows "r \<le>o r ^c r"
   3.702 +by (rule ordLess_imp_ordLeq[OF Cinfinite_ordLess_cexp[OF assms]])
   3.703 +
   3.704 +lemma cone_ordLeq_iff_Field:
   3.705 +  assumes "cone \<le>o r"
   3.706 +  shows "Field r \<noteq> {}"
   3.707 +proof (rule ccontr)
   3.708 +  assume "\<not> Field r \<noteq> {}"
   3.709 +  hence "Field r = {}" by simp
   3.710 +  thus False using card_of_empty3
   3.711 +    card_of_mono2[OF assms] Cnotzero_imp_not_empty[OF cone_Cnotzero] by auto
   3.712 +qed
   3.713 +
   3.714 +lemma cone_ordLeq_cexp: "cone \<le>o r1 \<Longrightarrow> cone \<le>o r1 ^c r2"
   3.715 +by (simp add: cexp_def cone_def Func_non_emp card_of_singl_ordLeq cone_ordLeq_iff_Field)
   3.716 +
   3.717 +lemma Card_order_czero: "Card_order czero"
   3.718 +by (simp only: card_of_Card_order czero_def)
   3.719 +
   3.720 +lemma cexp_mono2'':
   3.721 +  assumes 2: "p2 \<le>o r2"
   3.722 +  and n1: "Cnotzero q"
   3.723 +  and n2: "Card_order p2"
   3.724 +  shows "q ^c p2 \<le>o q ^c r2"
   3.725 +proof (cases "p2 =o (czero :: 'a rel)")
   3.726 +  case True
   3.727 +  hence "q ^c p2 =o q ^c (czero :: 'a rel)" using n1 n2 cexp_cong2 Card_order_czero by blast
   3.728 +  also have "q ^c (czero :: 'a rel) =o cone" using cexp_czero by blast
   3.729 +  also have "cone \<le>o q ^c r2" using cone_ordLeq_cexp cone_ordLeq_Cnotzero n1 by blast
   3.730 +  finally show ?thesis .
   3.731 +next
   3.732 +  case False thus ?thesis using assms cexp_mono2' czeroI by metis
   3.733 +qed
   3.734 +
   3.735 +lemma Un_Cinfinite_bound: "\<lbrakk>|A| \<le>o r; |B| \<le>o r; Cinfinite r\<rbrakk> \<Longrightarrow> |A \<union> B| \<le>o r"
   3.736 +by (auto simp add: cinfinite_def card_of_Un_ordLeq_infinite_Field)
   3.737 +
   3.738 +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"
   3.739 +by (auto simp add: card_of_UNION_ordLeq_infinite_Field cinfinite_def)
   3.740 +
   3.741 +lemma csum_cinfinite_bound:
   3.742 +  assumes "p \<le>o r" "q \<le>o r" "Card_order p" "Card_order q" "Cinfinite r"
   3.743 +  shows "p +c q \<le>o r"
   3.744 +proof -
   3.745 +  from assms(1-4) have "|Field p| \<le>o r" "|Field q| \<le>o r"
   3.746 +    unfolding card_order_on_def using card_of_least ordLeq_transitive by blast+
   3.747 +  with assms show ?thesis unfolding cinfinite_def csum_def
   3.748 +    by (blast intro: card_of_Plus_ordLeq_infinite_Field)
   3.749 +qed
   3.750 +
   3.751 +lemma csum_cexp: "\<lbrakk>Cinfinite r1; Cinfinite r2; Card_order q; ctwo \<le>o q\<rbrakk> \<Longrightarrow>
   3.752 +  q ^c r1 +c q ^c r2 \<le>o q ^c (r1 +c r2)"
   3.753 +apply (rule csum_cinfinite_bound)
   3.754 +apply (rule cexp_mono2)
   3.755 +apply (rule ordLeq_csum1)
   3.756 +apply (erule conjunct2)
   3.757 +apply assumption
   3.758 +apply (rule disjI2)
   3.759 +apply (rule ordLeq_transitive)
   3.760 +apply (rule cone_ordLeq_ctwo)
   3.761 +apply (rule ordLeq_transitive)
   3.762 +apply assumption
   3.763 +apply (rule ordLeq_cexp1)
   3.764 +apply (rule Cinfinite_Cnotzero)
   3.765 +apply (rule Cinfinite_csum)
   3.766 +apply (rule disjI1)
   3.767 +apply assumption
   3.768 +apply assumption
   3.769 +apply (rule notE)
   3.770 +apply (rule cinfinite_not_czero[of r1])
   3.771 +apply (erule conjunct1)
   3.772 +apply assumption
   3.773 +apply (erule conjunct2)
   3.774 +apply (rule cexp_mono2)
   3.775 +apply (rule ordLeq_csum2)
   3.776 +apply (erule conjunct2)
   3.777 +apply assumption
   3.778 +apply (rule disjI2)
   3.779 +apply (rule ordLeq_transitive)
   3.780 +apply (rule cone_ordLeq_ctwo)
   3.781 +apply (rule ordLeq_transitive)
   3.782 +apply assumption
   3.783 +apply (rule ordLeq_cexp1)
   3.784 +apply (rule Cinfinite_Cnotzero)
   3.785 +apply (rule Cinfinite_csum)
   3.786 +apply (rule disjI1)
   3.787 +apply assumption
   3.788 +apply assumption
   3.789 +apply (rule notE)
   3.790 +apply (rule cinfinite_not_czero[of r2])
   3.791 +apply (erule conjunct1)
   3.792 +apply assumption
   3.793 +apply (erule conjunct2)
   3.794 +apply (rule Card_order_cexp)
   3.795 +apply (rule Card_order_cexp)
   3.796 +apply (rule Cinfinite_cexp)
   3.797 +apply assumption
   3.798 +apply (rule Cinfinite_csum)
   3.799 +by (rule disjI1)
   3.800 +
   3.801 +lemma csum_cexp': "\<lbrakk>Cinfinite r; Card_order q; ctwo \<le>o q\<rbrakk> \<Longrightarrow> q +c r \<le>o q ^c r"
   3.802 +apply (rule csum_cinfinite_bound)
   3.803 +    apply (metis Cinfinite_Cnotzero ordLeq_cexp1)
   3.804 +   apply (metis ordLeq_cexp2)
   3.805 +  apply blast+
   3.806 +by (metis Cinfinite_cexp)
   3.807 +
   3.808 +lemma cprod_cinfinite_bound:
   3.809 +  assumes "p \<le>o r" "q \<le>o r" "Card_order p" "Card_order q" "Cinfinite r"
   3.810 +  shows "p *c q \<le>o r"
   3.811 +proof -
   3.812 +  from assms(1-4) have "|Field p| \<le>o r" "|Field q| \<le>o r"
   3.813 +    unfolding card_order_on_def using card_of_least ordLeq_transitive by blast+
   3.814 +  with assms show ?thesis unfolding cinfinite_def cprod_def
   3.815 +    by (blast intro: card_of_Times_ordLeq_infinite_Field)
   3.816 +qed
   3.817 +
   3.818 +lemma cprod_csum_cexp:
   3.819 +  "r1 *c r2 \<le>o (r1 +c r2) ^c ctwo"
   3.820 +unfolding cprod_def csum_def cexp_def ctwo_def Field_card_of
   3.821 +proof -
   3.822 +  let ?f = "\<lambda>(a, b). %x. if x then Some (Inl a) else Some (Inr b)"
   3.823 +  have "inj_on ?f (Field r1 \<times> Field r2)" (is "inj_on _ ?LHS")
   3.824 +    by (auto simp: inj_on_def fun_eq_iff split: bool.split)
   3.825 +  moreover
   3.826 +  have "?f ` ?LHS \<subseteq> Func (UNIV :: bool set) (Field r1 <+> Field r2)" (is "_ \<subseteq> ?RHS")
   3.827 +    by (auto simp: Func_def)
   3.828 +  ultimately show "|?LHS| \<le>o |?RHS|" using card_of_ordLeq by blast
   3.829 +qed
   3.830 +
   3.831 +lemma card_of_Sigma_ordLeq_Cinfinite:
   3.832 +  "\<lbrakk>Cinfinite r; |I| \<le>o r; \<forall>i \<in> I. |A i| \<le>o r\<rbrakk> \<Longrightarrow> |SIGMA i : I. A i| \<le>o r"
   3.833 +unfolding cinfinite_def by (blast intro: card_of_Sigma_ordLeq_infinite_Field)
   3.834 +
   3.835 +
   3.836 +(* cardSuc *)
   3.837 +
   3.838 +lemma Cinfinite_cardSuc: "Cinfinite r \<Longrightarrow> Cinfinite (cardSuc r)"
   3.839 +by (simp add: cinfinite_def cardSuc_Card_order cardSuc_finite)
   3.840 +
   3.841 +lemma cardSuc_UNION_Cinfinite:
   3.842 +  assumes "Cinfinite r" "relChain (cardSuc r) As" "B \<le> (UN i : Field (cardSuc r). As i)" "|B| <=o r"
   3.843 +  shows "EX i : Field (cardSuc r). B \<le> As i"
   3.844 +using cardSuc_UNION assms unfolding cinfinite_def by blast
   3.845 +
   3.846 +subsection {* Powerset *}
   3.847 +
   3.848 +definition cpow where "cpow r = |Pow (Field r)|"
   3.849 +
   3.850 +lemma card_order_cpow: "card_order r \<Longrightarrow> card_order (cpow r)"
   3.851 +by (simp only: cpow_def Field_card_order Pow_UNIV card_of_card_order_on)
   3.852 +
   3.853 +lemma cpow_greater_eq: "Card_order r \<Longrightarrow> r \<le>o cpow r"
   3.854 +by (rule ordLess_imp_ordLeq) (simp only: cpow_def Card_order_Pow)
   3.855 +
   3.856 +lemma Card_order_cpow: "Card_order (cpow r)"
   3.857 +unfolding cpow_def by (rule card_of_Card_order)
   3.858 +
   3.859 +lemma Cinfinite_cpow: "Cinfinite r \<Longrightarrow> Cinfinite (cpow r)"
   3.860 +unfolding cpow_def cinfinite_def by (metis Field_card_of card_of_Card_order infinite_Pow)
   3.861 +
   3.862 +lemma cardSuc_ordLeq_cpow: "Card_order r \<Longrightarrow> cardSuc r \<le>o cpow r"
   3.863 +unfolding cpow_def by (metis Card_order_Pow cardSuc_ordLess_ordLeq card_of_Card_order)
   3.864 +
   3.865 +lemma cpow_cexp_ctwo: "cpow r =o ctwo ^c r"
   3.866 +unfolding cpow_def ctwo_def cexp_def Field_card_of by (rule card_of_Pow_Func)
   3.867 +
   3.868 +subsection {* Lists *}
   3.869 +
   3.870 +definition clists where "clists r = |lists (Field r)|"
   3.871 +
   3.872 +lemma clists_Cinfinite: "Cinfinite r \<Longrightarrow> clists r =o r"
   3.873 +unfolding cinfinite_def clists_def by (blast intro: Card_order_lists_infinite)
   3.874 +
   3.875 +lemma Card_order_clists: "Card_order (clists r)"
   3.876 +unfolding clists_def by (rule card_of_Card_order)
   3.877 +
   3.878 +lemma Cnotzero_clists: "Cnotzero (clists r)"
   3.879 +by (simp add: clists_def card_of_ordIso_czero_iff_empty lists_not_empty) (rule card_of_Card_order)
   3.880 +
   3.881 +end
     4.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     4.2 +++ b/src/HOL/Cardinals/Cardinal_Order_Relation.thy	Wed Sep 12 05:29:21 2012 +0200
     4.3 @@ -0,0 +1,1097 @@
     4.4 +(*  Title:      HOL/Cardinals/Cardinal_Order_Relation.thy
     4.5 +    Author:     Andrei Popescu, TU Muenchen
     4.6 +    Copyright   2012
     4.7 +
     4.8 +Cardinal-order relations.
     4.9 +*)
    4.10 +
    4.11 +header {* Cardinal-Order Relations *}
    4.12 +
    4.13 +theory Cardinal_Order_Relation
    4.14 +imports Cardinal_Order_Relation_Base Constructions_on_Wellorders
    4.15 +begin
    4.16 +
    4.17 +declare
    4.18 +  card_order_on_well_order_on[simp]
    4.19 +  card_of_card_order_on[simp]
    4.20 +  card_of_well_order_on[simp]
    4.21 +  Field_card_of[simp]
    4.22 +  card_of_Card_order[simp]
    4.23 +  card_of_Well_order[simp]
    4.24 +  card_of_least[simp]
    4.25 +  card_of_unique[simp]
    4.26 +  card_of_mono1[simp]
    4.27 +  card_of_mono2[simp]
    4.28 +  card_of_cong[simp]
    4.29 +  card_of_Field_ordLess[simp]
    4.30 +  card_of_Field_ordIso[simp]
    4.31 +  card_of_underS[simp]
    4.32 +  ordLess_Field[simp]
    4.33 +  card_of_empty[simp]
    4.34 +  card_of_empty1[simp]
    4.35 +  card_of_image[simp]
    4.36 +  card_of_singl_ordLeq[simp]
    4.37 +  Card_order_singl_ordLeq[simp]
    4.38 +  card_of_Pow[simp]
    4.39 +  Card_order_Pow[simp]
    4.40 +  card_of_set_type[simp]
    4.41 +  card_of_Plus1[simp]
    4.42 +  Card_order_Plus1[simp]
    4.43 +  card_of_Plus2[simp]
    4.44 +  Card_order_Plus2[simp]
    4.45 +  card_of_Plus_mono1[simp]
    4.46 +  card_of_Plus_mono2[simp]
    4.47 +  card_of_Plus_mono[simp]
    4.48 +  card_of_Plus_cong2[simp]
    4.49 +  card_of_Plus_cong[simp]
    4.50 +  card_of_Un1[simp]
    4.51 +  card_of_diff[simp]
    4.52 +  card_of_Un_Plus_ordLeq[simp]
    4.53 +  card_of_Times1[simp]
    4.54 +  card_of_Times2[simp]
    4.55 +  card_of_Times3[simp]
    4.56 +  card_of_Times_mono1[simp]
    4.57 +  card_of_Times_mono2[simp]
    4.58 +  card_of_Times_cong1[simp]
    4.59 +  card_of_Times_cong2[simp]
    4.60 +  card_of_ordIso_finite[simp]
    4.61 +  finite_ordLess_infinite2[simp]
    4.62 +  card_of_Times_same_infinite[simp]
    4.63 +  card_of_Times_infinite_simps[simp]
    4.64 +  card_of_Plus_infinite1[simp]
    4.65 +  card_of_Plus_infinite2[simp]
    4.66 +  card_of_Plus_ordLess_infinite[simp]
    4.67 +  card_of_Plus_ordLess_infinite_Field[simp]
    4.68 +  card_of_lists_infinite[simp]
    4.69 +  infinite_cartesian_product[simp]
    4.70 +  cardSuc_Card_order[simp]
    4.71 +  cardSuc_greater[simp]
    4.72 +  cardSuc_ordLeq[simp]
    4.73 +  cardSuc_ordLeq_ordLess[simp]
    4.74 +  cardSuc_mono_ordLeq[simp]
    4.75 +  cardSuc_invar_ordIso[simp]
    4.76 +  card_of_cardSuc_finite[simp]
    4.77 +  cardSuc_finite[simp]
    4.78 +  card_of_Plus_ordLeq_infinite_Field[simp]
    4.79 +  curr_in[intro, simp]
    4.80 +  Func_empty[simp]
    4.81 +  Func_map_empty[simp]
    4.82 +  Func_is_emp[simp]
    4.83 +
    4.84 +
    4.85 +subsection {* Cardinal of a set *}
    4.86 +
    4.87 +lemma card_of_inj_rel: assumes INJ: "!! x y y'. \<lbrakk>(x,y) : R; (x,y') : R\<rbrakk> \<Longrightarrow> y = y'"
    4.88 +shows "|{y. EX x. (x,y) : R}| <=o |{x. EX y. (x,y) : R}|"
    4.89 +proof-
    4.90 +  let ?Y = "{y. EX x. (x,y) : R}"  let ?X = "{x. EX y. (x,y) : R}"
    4.91 +  let ?f = "% y. SOME x. (x,y) : R"
    4.92 +  have "?f ` ?Y <= ?X" using someI by force (* FIXME: takes a bit long *)
    4.93 +  moreover have "inj_on ?f ?Y"
    4.94 +  unfolding inj_on_def proof(auto)
    4.95 +    fix y1 x1 y2 x2
    4.96 +    assume *: "(x1, y1) \<in> R" "(x2, y2) \<in> R" and **: "?f y1 = ?f y2"
    4.97 +    hence "(?f y1,y1) : R" using someI[of "% x. (x,y1) : R"] by auto
    4.98 +    moreover have "(?f y2,y2) : R" using * someI[of "% x. (x,y2) : R"] by auto
    4.99 +    ultimately show "y1 = y2" using ** INJ by auto
   4.100 +  qed
   4.101 +  ultimately show "|?Y| <=o |?X|" using card_of_ordLeq by blast
   4.102 +qed
   4.103 +
   4.104 +lemma card_of_unique2: "\<lbrakk>card_order_on B r; bij_betw f A B\<rbrakk> \<Longrightarrow> r =o |A|"
   4.105 +using card_of_ordIso card_of_unique ordIso_equivalence by blast
   4.106 +
   4.107 +lemma internalize_card_of_ordLess:
   4.108 +"( |A| <o r) = (\<exists>B < Field r. |A| =o |B| \<and> |B| <o r)"
   4.109 +proof
   4.110 +  assume "|A| <o r"
   4.111 +  then obtain p where 1: "Field p < Field r \<and> |A| =o p \<and> p <o r"
   4.112 +  using internalize_ordLess[of "|A|" r] by blast
   4.113 +  hence "Card_order p" using card_of_Card_order Card_order_ordIso2 by blast
   4.114 +  hence "|Field p| =o p" using card_of_Field_ordIso by blast
   4.115 +  hence "|A| =o |Field p| \<and> |Field p| <o r"
   4.116 +  using 1 ordIso_equivalence ordIso_ordLess_trans by blast
   4.117 +  thus "\<exists>B < Field r. |A| =o |B| \<and> |B| <o r" using 1 by blast
   4.118 +next
   4.119 +  assume "\<exists>B < Field r. |A| =o |B| \<and> |B| <o r"
   4.120 +  thus "|A| <o r" using ordIso_ordLess_trans by blast
   4.121 +qed
   4.122 +
   4.123 +lemma internalize_card_of_ordLess2:
   4.124 +"( |A| <o |C| ) = (\<exists>B < C. |A| =o |B| \<and> |B| <o |C| )"
   4.125 +using internalize_card_of_ordLess[of "A" "|C|"] Field_card_of[of C] by auto
   4.126 +
   4.127 +lemma Card_order_omax:
   4.128 +assumes "finite R" and "R \<noteq> {}" and "\<forall>r\<in>R. Card_order r"
   4.129 +shows "Card_order (omax R)"
   4.130 +proof-
   4.131 +  have "\<forall>r\<in>R. Well_order r"
   4.132 +  using assms unfolding card_order_on_def by simp
   4.133 +  thus ?thesis using assms apply - apply(drule omax_in) by auto
   4.134 +qed
   4.135 +
   4.136 +lemma Card_order_omax2:
   4.137 +assumes "finite I" and "I \<noteq> {}"
   4.138 +shows "Card_order (omax {|A i| | i. i \<in> I})"
   4.139 +proof-
   4.140 +  let ?R = "{|A i| | i. i \<in> I}"
   4.141 +  have "finite ?R" and "?R \<noteq> {}" using assms by auto
   4.142 +  moreover have "\<forall>r\<in>?R. Card_order r"
   4.143 +  using card_of_Card_order by auto
   4.144 +  ultimately show ?thesis by(rule Card_order_omax)
   4.145 +qed
   4.146 +
   4.147 +
   4.148 +subsection {* Cardinals versus set operations on arbitrary sets *}
   4.149 +
   4.150 +lemma subset_ordLeq_strict:
   4.151 +assumes "A \<le> B" and "|A| <o |B|"
   4.152 +shows "A < B"
   4.153 +proof-
   4.154 +  {assume "\<not>(A < B)"
   4.155 +   hence "A = B" using assms(1) by blast
   4.156 +   hence False using assms(2) not_ordLess_ordIso card_of_refl by blast
   4.157 +  }
   4.158 +  thus ?thesis by blast
   4.159 +qed
   4.160 +
   4.161 +corollary subset_ordLeq_diff:
   4.162 +assumes "A \<le> B" and "|A| <o |B|"
   4.163 +shows "B - A \<noteq> {}"
   4.164 +using assms subset_ordLeq_strict by blast
   4.165 +
   4.166 +lemma card_of_empty4:
   4.167 +"|{}::'b set| <o |A::'a set| = (A \<noteq> {})"
   4.168 +proof(intro iffI notI)
   4.169 +  assume *: "|{}::'b set| <o |A|" and "A = {}"
   4.170 +  hence "|A| =o |{}::'b set|"
   4.171 +  using card_of_ordIso unfolding bij_betw_def inj_on_def by blast
   4.172 +  hence "|{}::'b set| =o |A|" using ordIso_symmetric by blast
   4.173 +  with * show False using not_ordLess_ordIso[of "|{}::'b set|" "|A|"] by blast
   4.174 +next
   4.175 +  assume "A \<noteq> {}"
   4.176 +  hence "(\<not> (\<exists>f. inj_on f A \<and> f ` A \<subseteq> {}))"
   4.177 +  unfolding inj_on_def by blast
   4.178 +  thus "| {} | <o | A |"
   4.179 +  using card_of_ordLess by blast
   4.180 +qed
   4.181 +
   4.182 +lemma card_of_empty5:
   4.183 +"|A| <o |B| \<Longrightarrow> B \<noteq> {}"
   4.184 +using card_of_empty not_ordLess_ordLeq by blast
   4.185 +
   4.186 +lemma Well_order_card_of_empty:
   4.187 +"Well_order r \<Longrightarrow> |{}| \<le>o r" by simp
   4.188 +
   4.189 +lemma card_of_UNIV[simp]:
   4.190 +"|A :: 'a set| \<le>o |UNIV :: 'a set|"
   4.191 +using card_of_mono1[of A] by simp
   4.192 +
   4.193 +lemma card_of_UNIV2[simp]:
   4.194 +"Card_order r \<Longrightarrow> (r :: 'a rel) \<le>o |UNIV :: 'a set|"
   4.195 +using card_of_UNIV[of "Field r"] card_of_Field_ordIso
   4.196 +      ordIso_symmetric ordIso_ordLeq_trans by blast
   4.197 +
   4.198 +lemma card_of_Pow_mono[simp]:
   4.199 +assumes "|A| \<le>o |B|"
   4.200 +shows "|Pow A| \<le>o |Pow B|"
   4.201 +proof-
   4.202 +  obtain f where "inj_on f A \<and> f ` A \<le> B"
   4.203 +  using assms card_of_ordLeq[of A B] by auto
   4.204 +  hence "inj_on (image f) (Pow A) \<and> (image f) ` (Pow A) \<le> (Pow B)"
   4.205 +  by (auto simp add: inj_on_image_Pow image_Pow_mono)
   4.206 +  thus ?thesis using card_of_ordLeq[of "Pow A"] by metis
   4.207 +qed
   4.208 +
   4.209 +lemma ordIso_Pow_mono[simp]:
   4.210 +assumes "r \<le>o r'"
   4.211 +shows "|Pow(Field r)| \<le>o |Pow(Field r')|"
   4.212 +using assms card_of_mono2 card_of_Pow_mono by blast
   4.213 +
   4.214 +lemma card_of_Pow_cong[simp]:
   4.215 +assumes "|A| =o |B|"
   4.216 +shows "|Pow A| =o |Pow B|"
   4.217 +proof-
   4.218 +  obtain f where "bij_betw f A B"
   4.219 +  using assms card_of_ordIso[of A B] by auto
   4.220 +  hence "bij_betw (image f) (Pow A) (Pow B)"
   4.221 +  by (auto simp add: bij_betw_image_Pow)
   4.222 +  thus ?thesis using card_of_ordIso[of "Pow A"] by auto
   4.223 +qed
   4.224 +
   4.225 +lemma ordIso_Pow_cong[simp]:
   4.226 +assumes "r =o r'"
   4.227 +shows "|Pow(Field r)| =o |Pow(Field r')|"
   4.228 +using assms card_of_cong card_of_Pow_cong by blast
   4.229 +
   4.230 +corollary Card_order_Plus_empty1:
   4.231 +"Card_order r \<Longrightarrow> r =o |(Field r) <+> {}|"
   4.232 +using card_of_Plus_empty1 card_of_Field_ordIso ordIso_equivalence by blast
   4.233 +
   4.234 +corollary Card_order_Plus_empty2:
   4.235 +"Card_order r \<Longrightarrow> r =o |{} <+> (Field r)|"
   4.236 +using card_of_Plus_empty2 card_of_Field_ordIso ordIso_equivalence by blast
   4.237 +
   4.238 +lemma Card_order_Un1:
   4.239 +shows "Card_order r \<Longrightarrow> |Field r| \<le>o |(Field r) \<union> B| "
   4.240 +using card_of_Un1 card_of_Field_ordIso ordIso_symmetric ordIso_ordLeq_trans by auto
   4.241 +
   4.242 +lemma card_of_Un2[simp]:
   4.243 +shows "|A| \<le>o |B \<union> A|"
   4.244 +using inj_on_id[of A] card_of_ordLeq[of A _] by fastforce
   4.245 +
   4.246 +lemma Card_order_Un2:
   4.247 +shows "Card_order r \<Longrightarrow> |Field r| \<le>o |A \<union> (Field r)| "
   4.248 +using card_of_Un2 card_of_Field_ordIso ordIso_symmetric ordIso_ordLeq_trans by auto
   4.249 +
   4.250 +lemma Un_Plus_bij_betw:
   4.251 +assumes "A Int B = {}"
   4.252 +shows "\<exists>f. bij_betw f (A \<union> B) (A <+> B)"
   4.253 +proof-
   4.254 +  let ?f = "\<lambda> c. if c \<in> A then Inl c else Inr c"
   4.255 +  have "bij_betw ?f (A \<union> B) (A <+> B)"
   4.256 +  using assms by(unfold bij_betw_def inj_on_def, auto)
   4.257 +  thus ?thesis by blast
   4.258 +qed
   4.259 +
   4.260 +lemma card_of_Un_Plus_ordIso:
   4.261 +assumes "A Int B = {}"
   4.262 +shows "|A \<union> B| =o |A <+> B|"
   4.263 +using assms card_of_ordIso[of "A \<union> B"] Un_Plus_bij_betw[of A B] by auto
   4.264 +
   4.265 +lemma card_of_Un_Plus_ordIso1:
   4.266 +"|A \<union> B| =o |A <+> (B - A)|"
   4.267 +using card_of_Un_Plus_ordIso[of A "B - A"] by auto
   4.268 +
   4.269 +lemma card_of_Un_Plus_ordIso2:
   4.270 +"|A \<union> B| =o |(A - B) <+> B|"
   4.271 +using card_of_Un_Plus_ordIso[of "A - B" B] by auto
   4.272 +
   4.273 +lemma card_of_Times_singl1: "|A| =o |A \<times> {b}|"
   4.274 +proof-
   4.275 +  have "bij_betw fst (A \<times> {b}) A" unfolding bij_betw_def inj_on_def by force
   4.276 +  thus ?thesis using card_of_ordIso ordIso_symmetric by blast
   4.277 +qed
   4.278 +
   4.279 +corollary Card_order_Times_singl1:
   4.280 +"Card_order r \<Longrightarrow> r =o |(Field r) \<times> {b}|"
   4.281 +using card_of_Times_singl1[of _ b] card_of_Field_ordIso ordIso_equivalence by blast
   4.282 +
   4.283 +lemma card_of_Times_singl2: "|A| =o |{b} \<times> A|"
   4.284 +proof-
   4.285 +  have "bij_betw snd ({b} \<times> A) A" unfolding bij_betw_def inj_on_def by force
   4.286 +  thus ?thesis using card_of_ordIso ordIso_symmetric by blast
   4.287 +qed
   4.288 +
   4.289 +corollary Card_order_Times_singl2:
   4.290 +"Card_order r \<Longrightarrow> r =o |{a} \<times> (Field r)|"
   4.291 +using card_of_Times_singl2[of _ a] card_of_Field_ordIso ordIso_equivalence by blast
   4.292 +
   4.293 +lemma card_of_Times_assoc: "|(A \<times> B) \<times> C| =o |A \<times> B \<times> C|"
   4.294 +proof -
   4.295 +  let ?f = "\<lambda>((a,b),c). (a,(b,c))"
   4.296 +  have "A \<times> B \<times> C \<subseteq> ?f ` ((A \<times> B) \<times> C)"
   4.297 +  proof
   4.298 +    fix x assume "x \<in> A \<times> B \<times> C"
   4.299 +    then obtain a b c where *: "a \<in> A" "b \<in> B" "c \<in> C" "x = (a, b, c)" by blast
   4.300 +    let ?x = "((a, b), c)"
   4.301 +    from * have "?x \<in> (A \<times> B) \<times> C" "x = ?f ?x" by auto
   4.302 +    thus "x \<in> ?f ` ((A \<times> B) \<times> C)" by blast
   4.303 +  qed
   4.304 +  hence "bij_betw ?f ((A \<times> B) \<times> C) (A \<times> B \<times> C)"
   4.305 +  unfolding bij_betw_def inj_on_def by auto
   4.306 +  thus ?thesis using card_of_ordIso by blast
   4.307 +qed
   4.308 +
   4.309 +corollary Card_order_Times3:
   4.310 +"Card_order r \<Longrightarrow> |Field r| \<le>o |(Field r) \<times> (Field r)|"
   4.311 +using card_of_Times3 card_of_Field_ordIso
   4.312 +      ordIso_ordLeq_trans ordIso_symmetric by blast
   4.313 +
   4.314 +lemma card_of_Times_mono[simp]:
   4.315 +assumes "|A| \<le>o |B|" and "|C| \<le>o |D|"
   4.316 +shows "|A \<times> C| \<le>o |B \<times> D|"
   4.317 +using assms card_of_Times_mono1[of A B C] card_of_Times_mono2[of C D B]
   4.318 +      ordLeq_transitive[of "|A \<times> C|"] by blast
   4.319 +
   4.320 +corollary ordLeq_Times_mono:
   4.321 +assumes "r \<le>o r'" and "p \<le>o p'"
   4.322 +shows "|(Field r) \<times> (Field p)| \<le>o |(Field r') \<times> (Field p')|"
   4.323 +using assms card_of_mono2[of r r'] card_of_mono2[of p p'] card_of_Times_mono by blast
   4.324 +
   4.325 +corollary ordIso_Times_cong1[simp]:
   4.326 +assumes "r =o r'"
   4.327 +shows "|(Field r) \<times> C| =o |(Field r') \<times> C|"
   4.328 +using assms card_of_cong card_of_Times_cong1 by blast
   4.329 +
   4.330 +lemma card_of_Times_cong[simp]:
   4.331 +assumes "|A| =o |B|" and "|C| =o |D|"
   4.332 +shows "|A \<times> C| =o |B \<times> D|"
   4.333 +using assms
   4.334 +by (auto simp add: ordIso_iff_ordLeq)
   4.335 +
   4.336 +corollary ordIso_Times_cong:
   4.337 +assumes "r =o r'" and "p =o p'"
   4.338 +shows "|(Field r) \<times> (Field p)| =o |(Field r') \<times> (Field p')|"
   4.339 +using assms card_of_cong[of r r'] card_of_cong[of p p'] card_of_Times_cong by blast
   4.340 +
   4.341 +lemma card_of_Sigma_mono2:
   4.342 +assumes "inj_on f (I::'i set)" and "f ` I \<le> (J::'j set)"
   4.343 +shows "|SIGMA i : I. (A::'j \<Rightarrow> 'a set) (f i)| \<le>o |SIGMA j : J. A j|"
   4.344 +proof-
   4.345 +  let ?LEFT = "SIGMA i : I. A (f i)"
   4.346 +  let ?RIGHT = "SIGMA j : J. A j"
   4.347 +  obtain u where u_def: "u = (\<lambda>(i::'i,a::'a). (f i,a))" by blast
   4.348 +  have "inj_on u ?LEFT \<and> u `?LEFT \<le> ?RIGHT"
   4.349 +  using assms unfolding u_def inj_on_def by auto
   4.350 +  thus ?thesis using card_of_ordLeq by blast
   4.351 +qed
   4.352 +
   4.353 +lemma card_of_Sigma_mono:
   4.354 +assumes INJ: "inj_on f I" and IM: "f ` I \<le> J" and
   4.355 +        LEQ: "\<forall>j \<in> J. |A j| \<le>o |B j|"
   4.356 +shows "|SIGMA i : I. A (f i)| \<le>o |SIGMA j : J. B j|"
   4.357 +proof-
   4.358 +  have "\<forall>i \<in> I. |A(f i)| \<le>o |B(f i)|"
   4.359 +  using IM LEQ by blast
   4.360 +  hence "|SIGMA i : I. A (f i)| \<le>o |SIGMA i : I. B (f i)|"
   4.361 +  using card_of_Sigma_mono1[of I] by metis
   4.362 +  moreover have "|SIGMA i : I. B (f i)| \<le>o |SIGMA j : J. B j|"
   4.363 +  using INJ IM card_of_Sigma_mono2 by blast
   4.364 +  ultimately show ?thesis using ordLeq_transitive by blast
   4.365 +qed
   4.366 +
   4.367 +
   4.368 +lemma ordLeq_Sigma_mono1:
   4.369 +assumes "\<forall>i \<in> I. p i \<le>o r i"
   4.370 +shows "|SIGMA i : I. Field(p i)| \<le>o |SIGMA i : I. Field(r i)|"
   4.371 +using assms by (auto simp add: card_of_Sigma_mono1)
   4.372 +
   4.373 +
   4.374 +lemma ordLeq_Sigma_mono:
   4.375 +assumes "inj_on f I" and "f ` I \<le> J" and
   4.376 +        "\<forall>j \<in> J. p j \<le>o r j"
   4.377 +shows "|SIGMA i : I. Field(p(f i))| \<le>o |SIGMA j : J. Field(r j)|"
   4.378 +using assms card_of_mono2 card_of_Sigma_mono
   4.379 +      [of f I J "\<lambda> i. Field(p i)" "\<lambda> j. Field(r j)"] by metis
   4.380 +
   4.381 +
   4.382 +lemma card_of_Sigma_cong1:
   4.383 +assumes "\<forall>i \<in> I. |A i| =o |B i|"
   4.384 +shows "|SIGMA i : I. A i| =o |SIGMA i : I. B i|"
   4.385 +using assms by (auto simp add: card_of_Sigma_mono1 ordIso_iff_ordLeq)
   4.386 +
   4.387 +
   4.388 +lemma card_of_Sigma_cong2:
   4.389 +assumes "bij_betw f (I::'i set) (J::'j set)"
   4.390 +shows "|SIGMA i : I. (A::'j \<Rightarrow> 'a set) (f i)| =o |SIGMA j : J. A j|"
   4.391 +proof-
   4.392 +  let ?LEFT = "SIGMA i : I. A (f i)"
   4.393 +  let ?RIGHT = "SIGMA j : J. A j"
   4.394 +  obtain u where u_def: "u = (\<lambda>(i::'i,a::'a). (f i,a))" by blast
   4.395 +  have "bij_betw u ?LEFT ?RIGHT"
   4.396 +  using assms unfolding u_def bij_betw_def inj_on_def by auto
   4.397 +  thus ?thesis using card_of_ordIso by blast
   4.398 +qed
   4.399 +
   4.400 +lemma card_of_Sigma_cong:
   4.401 +assumes BIJ: "bij_betw f I J" and
   4.402 +        ISO: "\<forall>j \<in> J. |A j| =o |B j|"
   4.403 +shows "|SIGMA i : I. A (f i)| =o |SIGMA j : J. B j|"
   4.404 +proof-
   4.405 +  have "\<forall>i \<in> I. |A(f i)| =o |B(f i)|"
   4.406 +  using ISO BIJ unfolding bij_betw_def by blast
   4.407 +  hence "|SIGMA i : I. A (f i)| =o |SIGMA i : I. B (f i)|"
   4.408 +  using card_of_Sigma_cong1 by metis
   4.409 +  moreover have "|SIGMA i : I. B (f i)| =o |SIGMA j : J. B j|"
   4.410 +  using BIJ card_of_Sigma_cong2 by blast
   4.411 +  ultimately show ?thesis using ordIso_transitive by blast
   4.412 +qed
   4.413 +
   4.414 +lemma ordIso_Sigma_cong1:
   4.415 +assumes "\<forall>i \<in> I. p i =o r i"
   4.416 +shows "|SIGMA i : I. Field(p i)| =o |SIGMA i : I. Field(r i)|"
   4.417 +using assms by (auto simp add: card_of_Sigma_cong1)
   4.418 +
   4.419 +lemma ordLeq_Sigma_cong:
   4.420 +assumes "bij_betw f I J" and
   4.421 +        "\<forall>j \<in> J. p j =o r j"
   4.422 +shows "|SIGMA i : I. Field(p(f i))| =o |SIGMA j : J. Field(r j)|"
   4.423 +using assms card_of_cong card_of_Sigma_cong
   4.424 +      [of f I J "\<lambda> j. Field(p j)" "\<lambda> j. Field(r j)"] by blast
   4.425 +
   4.426 +corollary ordLeq_Sigma_Times:
   4.427 +"\<forall>i \<in> I. p i \<le>o r \<Longrightarrow> |SIGMA i : I. Field (p i)| \<le>o |I \<times> (Field r)|"
   4.428 +by (auto simp add: card_of_Sigma_Times)
   4.429 +
   4.430 +lemma card_of_UNION_Sigma2:
   4.431 +assumes
   4.432 +"!! i j. \<lbrakk>{i,j} <= I; i ~= j\<rbrakk> \<Longrightarrow> A i Int A j = {}"
   4.433 +shows
   4.434 +"|\<Union>i\<in>I. A i| =o |Sigma I A|"
   4.435 +proof-
   4.436 +  let ?L = "\<Union>i\<in>I. A i"  let ?R = "Sigma I A"
   4.437 +  have "|?L| <=o |?R|" using card_of_UNION_Sigma .
   4.438 +  moreover have "|?R| <=o |?L|"
   4.439 +  proof-
   4.440 +    have "inj_on snd ?R"
   4.441 +    unfolding inj_on_def using assms by auto
   4.442 +    moreover have "snd ` ?R <= ?L" by auto
   4.443 +    ultimately show ?thesis using card_of_ordLeq by blast
   4.444 +  qed
   4.445 +  ultimately show ?thesis by(simp add: ordIso_iff_ordLeq)
   4.446 +qed
   4.447 +
   4.448 +corollary Plus_into_Times:
   4.449 +assumes A2: "a1 \<noteq> a2 \<and> {a1,a2} \<le> A" and
   4.450 +        B2: "b1 \<noteq> b2 \<and> {b1,b2} \<le> B"
   4.451 +shows "\<exists>f. inj_on f (A <+> B) \<and> f ` (A <+> B) \<le> A \<times> B"
   4.452 +using assms by (auto simp add: card_of_Plus_Times card_of_ordLeq)
   4.453 +
   4.454 +corollary Plus_into_Times_types:
   4.455 +assumes A2: "(a1::'a) \<noteq> a2" and  B2: "(b1::'b) \<noteq> b2"
   4.456 +shows "\<exists>(f::'a + 'b \<Rightarrow> 'a * 'b). inj f"
   4.457 +using assms Plus_into_Times[of a1 a2 UNIV b1 b2 UNIV]
   4.458 +by auto
   4.459 +
   4.460 +corollary Times_same_infinite_bij_betw:
   4.461 +assumes "infinite A"
   4.462 +shows "\<exists>f. bij_betw f (A \<times> A) A"
   4.463 +using assms by (auto simp add: card_of_ordIso)
   4.464 +
   4.465 +corollary Times_same_infinite_bij_betw_types:
   4.466 +assumes INF: "infinite(UNIV::'a set)"
   4.467 +shows "\<exists>(f::('a * 'a) => 'a). bij f"
   4.468 +using assms Times_same_infinite_bij_betw[of "UNIV::'a set"]
   4.469 +by auto
   4.470 +
   4.471 +corollary Times_infinite_bij_betw:
   4.472 +assumes INF: "infinite A" and NE: "B \<noteq> {}" and INJ: "inj_on g B \<and> g ` B \<le> A"
   4.473 +shows "(\<exists>f. bij_betw f (A \<times> B) A) \<and> (\<exists>h. bij_betw h (B \<times> A) A)"
   4.474 +proof-
   4.475 +  have "|B| \<le>o |A|" using INJ card_of_ordLeq by blast
   4.476 +  thus ?thesis using INF NE
   4.477 +  by (auto simp add: card_of_ordIso card_of_Times_infinite)
   4.478 +qed
   4.479 +
   4.480 +corollary Times_infinite_bij_betw_types:
   4.481 +assumes INF: "infinite(UNIV::'a set)" and
   4.482 +        BIJ: "inj(g::'b \<Rightarrow> 'a)"
   4.483 +shows "(\<exists>(f::('b * 'a) => 'a). bij f) \<and> (\<exists>(h::('a * 'b) => 'a). bij h)"
   4.484 +using assms Times_infinite_bij_betw[of "UNIV::'a set" "UNIV::'b set" g]
   4.485 +by auto
   4.486 +
   4.487 +lemma card_of_Times_ordLeq_infinite:
   4.488 +"\<lbrakk>infinite C; |A| \<le>o |C|; |B| \<le>o |C|\<rbrakk>
   4.489 + \<Longrightarrow> |A <*> B| \<le>o |C|"
   4.490 +by(simp add: card_of_Sigma_ordLeq_infinite)
   4.491 +
   4.492 +corollary Plus_infinite_bij_betw:
   4.493 +assumes INF: "infinite A" and INJ: "inj_on g B \<and> g ` B \<le> A"
   4.494 +shows "(\<exists>f. bij_betw f (A <+> B) A) \<and> (\<exists>h. bij_betw h (B <+> A) A)"
   4.495 +proof-
   4.496 +  have "|B| \<le>o |A|" using INJ card_of_ordLeq by blast
   4.497 +  thus ?thesis using INF
   4.498 +  by (auto simp add: card_of_ordIso)
   4.499 +qed
   4.500 +
   4.501 +corollary Plus_infinite_bij_betw_types:
   4.502 +assumes INF: "infinite(UNIV::'a set)" and
   4.503 +        BIJ: "inj(g::'b \<Rightarrow> 'a)"
   4.504 +shows "(\<exists>(f::('b + 'a) => 'a). bij f) \<and> (\<exists>(h::('a + 'b) => 'a). bij h)"
   4.505 +using assms Plus_infinite_bij_betw[of "UNIV::'a set" g "UNIV::'b set"]
   4.506 +by auto
   4.507 +
   4.508 +lemma card_of_Un_infinite_simps[simp]:
   4.509 +"\<lbrakk>infinite A; |B| \<le>o |A| \<rbrakk> \<Longrightarrow> |A \<union> B| =o |A|"
   4.510 +"\<lbrakk>infinite A; |B| \<le>o |A| \<rbrakk> \<Longrightarrow> |B \<union> A| =o |A|"
   4.511 +using card_of_Un_infinite by auto
   4.512 +
   4.513 +corollary Card_order_Un_infinite:
   4.514 +assumes INF: "infinite(Field r)" and CARD: "Card_order r" and
   4.515 +        LEQ: "p \<le>o r"
   4.516 +shows "| (Field r) \<union> (Field p) | =o r \<and> | (Field p) \<union> (Field r) | =o r"
   4.517 +proof-
   4.518 +  have "| Field r \<union> Field p | =o | Field r | \<and>
   4.519 +        | Field p \<union> Field r | =o | Field r |"
   4.520 +  using assms by (auto simp add: card_of_Un_infinite)
   4.521 +  thus ?thesis
   4.522 +  using assms card_of_Field_ordIso[of r]
   4.523 +        ordIso_transitive[of "|Field r \<union> Field p|"]
   4.524 +        ordIso_transitive[of _ "|Field r|"] by blast
   4.525 +qed
   4.526 +
   4.527 +corollary subset_ordLeq_diff_infinite:
   4.528 +assumes INF: "infinite B" and SUB: "A \<le> B" and LESS: "|A| <o |B|"
   4.529 +shows "infinite (B - A)"
   4.530 +using assms card_of_Un_diff_infinite card_of_ordIso_finite by blast
   4.531 +
   4.532 +lemma card_of_Times_ordLess_infinite[simp]:
   4.533 +assumes INF: "infinite C" and
   4.534 +        LESS1: "|A| <o |C|" and LESS2: "|B| <o |C|"
   4.535 +shows "|A \<times> B| <o |C|"
   4.536 +proof(cases "A = {} \<or> B = {}")
   4.537 +  assume Case1: "A = {} \<or> B = {}"
   4.538 +  hence "A \<times> B = {}" by blast
   4.539 +  moreover have "C \<noteq> {}" using
   4.540 +  LESS1 card_of_empty5 by blast
   4.541 +  ultimately show ?thesis by(auto simp add:  card_of_empty4)
   4.542 +next
   4.543 +  assume Case2: "\<not>(A = {} \<or> B = {})"
   4.544 +  {assume *: "|C| \<le>o |A \<times> B|"
   4.545 +   hence "infinite (A \<times> B)" using INF card_of_ordLeq_finite by blast
   4.546 +   hence 1: "infinite A \<or> infinite B" using finite_cartesian_product by blast
   4.547 +   {assume Case21: "|A| \<le>o |B|"
   4.548 +    hence "infinite B" using 1 card_of_ordLeq_finite by blast
   4.549 +    hence "|A \<times> B| =o |B|" using Case2 Case21
   4.550 +    by (auto simp add: card_of_Times_infinite)
   4.551 +    hence False using LESS2 not_ordLess_ordLeq * ordLeq_ordIso_trans by blast
   4.552 +   }
   4.553 +   moreover
   4.554 +   {assume Case22: "|B| \<le>o |A|"
   4.555 +    hence "infinite A" using 1 card_of_ordLeq_finite by blast
   4.556 +    hence "|A \<times> B| =o |A|" using Case2 Case22
   4.557 +    by (auto simp add: card_of_Times_infinite)
   4.558 +    hence False using LESS1 not_ordLess_ordLeq * ordLeq_ordIso_trans by blast
   4.559 +   }
   4.560 +   ultimately have False using ordLeq_total card_of_Well_order[of A]
   4.561 +   card_of_Well_order[of B] by blast
   4.562 +  }
   4.563 +  thus ?thesis using ordLess_or_ordLeq[of "|A \<times> B|" "|C|"]
   4.564 +  card_of_Well_order[of "A \<times> B"] card_of_Well_order[of "C"] by auto
   4.565 +qed
   4.566 +
   4.567 +lemma card_of_Times_ordLess_infinite_Field[simp]:
   4.568 +assumes INF: "infinite (Field r)" and r: "Card_order r" and
   4.569 +        LESS1: "|A| <o r" and LESS2: "|B| <o r"
   4.570 +shows "|A \<times> B| <o r"
   4.571 +proof-
   4.572 +  let ?C  = "Field r"
   4.573 +  have 1: "r =o |?C| \<and> |?C| =o r" using r card_of_Field_ordIso
   4.574 +  ordIso_symmetric by blast
   4.575 +  hence "|A| <o |?C|"  "|B| <o |?C|"
   4.576 +  using LESS1 LESS2 ordLess_ordIso_trans by blast+
   4.577 +  hence  "|A <*> B| <o |?C|" using INF
   4.578 +  card_of_Times_ordLess_infinite by blast
   4.579 +  thus ?thesis using 1 ordLess_ordIso_trans by blast
   4.580 +qed
   4.581 +
   4.582 +lemma card_of_Un_ordLess_infinite[simp]:
   4.583 +assumes INF: "infinite C" and
   4.584 +        LESS1: "|A| <o |C|" and LESS2: "|B| <o |C|"
   4.585 +shows "|A \<union> B| <o |C|"
   4.586 +using assms card_of_Plus_ordLess_infinite card_of_Un_Plus_ordLeq
   4.587 +      ordLeq_ordLess_trans by blast
   4.588 +
   4.589 +lemma card_of_Un_ordLess_infinite_Field[simp]:
   4.590 +assumes INF: "infinite (Field r)" and r: "Card_order r" and
   4.591 +        LESS1: "|A| <o r" and LESS2: "|B| <o r"
   4.592 +shows "|A Un B| <o r"
   4.593 +proof-
   4.594 +  let ?C  = "Field r"
   4.595 +  have 1: "r =o |?C| \<and> |?C| =o r" using r card_of_Field_ordIso
   4.596 +  ordIso_symmetric by blast
   4.597 +  hence "|A| <o |?C|"  "|B| <o |?C|"
   4.598 +  using LESS1 LESS2 ordLess_ordIso_trans by blast+
   4.599 +  hence  "|A Un B| <o |?C|" using INF
   4.600 +  card_of_Un_ordLess_infinite by blast
   4.601 +  thus ?thesis using 1 ordLess_ordIso_trans by blast
   4.602 +qed
   4.603 +
   4.604 +lemma card_of_Un_singl_ordLess_infinite1:
   4.605 +assumes "infinite B" and "|A| <o |B|"
   4.606 +shows "|{a} Un A| <o |B|"
   4.607 +proof-
   4.608 +  have "|{a}| <o |B|" using assms by auto
   4.609 +  thus ?thesis using assms card_of_Un_ordLess_infinite[of B] by fastforce
   4.610 +qed
   4.611 +
   4.612 +lemma card_of_Un_singl_ordLess_infinite:
   4.613 +assumes "infinite B"
   4.614 +shows "( |A| <o |B| ) = ( |{a} Un A| <o |B| )"
   4.615 +using assms card_of_Un_singl_ordLess_infinite1[of B A]
   4.616 +proof(auto)
   4.617 +  assume "|insert a A| <o |B|"
   4.618 +  moreover have "|A| <=o |insert a A|" using card_of_mono1[of A] by blast
   4.619 +  ultimately show "|A| <o |B|" using ordLeq_ordLess_trans by blast
   4.620 +qed
   4.621 +
   4.622 +
   4.623 +subsection {* Cardinals versus lists  *}
   4.624 +
   4.625 +lemma Card_order_lists: "Card_order r \<Longrightarrow> r \<le>o |lists(Field r) |"
   4.626 +using card_of_lists card_of_Field_ordIso ordIso_ordLeq_trans ordIso_symmetric by blast
   4.627 +
   4.628 +lemma Union_set_lists:
   4.629 +"Union(set ` (lists A)) = A"
   4.630 +unfolding lists_def2 proof(auto)
   4.631 +  fix a assume "a \<in> A"
   4.632 +  hence "set [a] \<le> A \<and> a \<in> set [a]" by auto
   4.633 +  thus "\<exists>l. set l \<le> A \<and> a \<in> set l" by blast
   4.634 +qed
   4.635 +
   4.636 +lemma inj_on_map_lists:
   4.637 +assumes "inj_on f A"
   4.638 +shows "inj_on (map f) (lists A)"
   4.639 +using assms Union_set_lists[of A] inj_on_mapI[of f "lists A"] by auto
   4.640 +
   4.641 +lemma map_lists_mono:
   4.642 +assumes "f ` A \<le> B"
   4.643 +shows "(map f) ` (lists A) \<le> lists B"
   4.644 +using assms unfolding lists_def2 by (auto, blast) (* lethal combination of methods :)  *)
   4.645 +
   4.646 +lemma map_lists_surjective:
   4.647 +assumes "f ` A = B"
   4.648 +shows "(map f) ` (lists A) = lists B"
   4.649 +using assms unfolding lists_def2
   4.650 +proof (auto, blast)
   4.651 +  fix l' assume *: "set l' \<le> f ` A"
   4.652 +  have "set l' \<le> f ` A \<longrightarrow> l' \<in> map f ` {l. set l \<le> A}"
   4.653 +  proof(induct l', auto)
   4.654 +    fix l a
   4.655 +    assume "a \<in> A" and "set l \<le> A" and
   4.656 +           IH: "f ` (set l) \<le> f ` A"
   4.657 +    hence "set (a # l) \<le> A" by auto
   4.658 +    hence "map f (a # l) \<in> map f ` {l. set l \<le> A}" by blast
   4.659 +    thus "f a # map f l \<in> map f ` {l. set l \<le> A}" by auto
   4.660 +  qed
   4.661 +  thus "l' \<in> map f ` {l. set l \<le> A}" using * by auto
   4.662 +qed
   4.663 +
   4.664 +lemma bij_betw_map_lists:
   4.665 +assumes "bij_betw f A B"
   4.666 +shows "bij_betw (map f) (lists A) (lists B)"
   4.667 +using assms unfolding bij_betw_def
   4.668 +by(auto simp add: inj_on_map_lists map_lists_surjective)
   4.669 +
   4.670 +lemma card_of_lists_mono[simp]:
   4.671 +assumes "|A| \<le>o |B|"
   4.672 +shows "|lists A| \<le>o |lists B|"
   4.673 +proof-
   4.674 +  obtain f where "inj_on f A \<and> f ` A \<le> B"
   4.675 +  using assms card_of_ordLeq[of A B] by auto
   4.676 +  hence "inj_on (map f) (lists A) \<and> (map f) ` (lists A) \<le> (lists B)"
   4.677 +  by (auto simp add: inj_on_map_lists map_lists_mono)
   4.678 +  thus ?thesis using card_of_ordLeq[of "lists A"] by metis
   4.679 +qed
   4.680 +
   4.681 +lemma ordIso_lists_mono:
   4.682 +assumes "r \<le>o r'"
   4.683 +shows "|lists(Field r)| \<le>o |lists(Field r')|"
   4.684 +using assms card_of_mono2 card_of_lists_mono by blast
   4.685 +
   4.686 +lemma card_of_lists_cong[simp]:
   4.687 +assumes "|A| =o |B|"
   4.688 +shows "|lists A| =o |lists B|"
   4.689 +proof-
   4.690 +  obtain f where "bij_betw f A B"
   4.691 +  using assms card_of_ordIso[of A B] by auto
   4.692 +  hence "bij_betw (map f) (lists A) (lists B)"
   4.693 +  by (auto simp add: bij_betw_map_lists)
   4.694 +  thus ?thesis using card_of_ordIso[of "lists A"] by auto
   4.695 +qed
   4.696 +
   4.697 +lemma ordIso_lists_cong:
   4.698 +assumes "r =o r'"
   4.699 +shows "|lists(Field r)| =o |lists(Field r')|"
   4.700 +using assms card_of_cong card_of_lists_cong by blast
   4.701 +
   4.702 +corollary lists_infinite_bij_betw:
   4.703 +assumes "infinite A"
   4.704 +shows "\<exists>f. bij_betw f (lists A) A"
   4.705 +using assms card_of_lists_infinite card_of_ordIso by blast
   4.706 +
   4.707 +corollary lists_infinite_bij_betw_types:
   4.708 +assumes "infinite(UNIV :: 'a set)"
   4.709 +shows "\<exists>(f::'a list \<Rightarrow> 'a). bij f"
   4.710 +using assms assms lists_infinite_bij_betw[of "UNIV::'a set"]
   4.711 +using lists_UNIV by auto
   4.712 +
   4.713 +
   4.714 +subsection {* Cardinals versus the set-of-finite-sets operator  *}
   4.715 +
   4.716 +definition Fpow :: "'a set \<Rightarrow> 'a set set"
   4.717 +where "Fpow A \<equiv> {X. X \<le> A \<and> finite X}"
   4.718 +
   4.719 +lemma Fpow_mono: "A \<le> B \<Longrightarrow> Fpow A \<le> Fpow B"
   4.720 +unfolding Fpow_def by auto
   4.721 +
   4.722 +lemma empty_in_Fpow: "{} \<in> Fpow A"
   4.723 +unfolding Fpow_def by auto
   4.724 +
   4.725 +lemma Fpow_not_empty: "Fpow A \<noteq> {}"
   4.726 +using empty_in_Fpow by blast
   4.727 +
   4.728 +lemma Fpow_subset_Pow: "Fpow A \<le> Pow A"
   4.729 +unfolding Fpow_def by auto
   4.730 +
   4.731 +lemma card_of_Fpow[simp]: "|A| \<le>o |Fpow A|"
   4.732 +proof-
   4.733 +  let ?h = "\<lambda> a. {a}"
   4.734 +  have "inj_on ?h A \<and> ?h ` A \<le> Fpow A"
   4.735 +  unfolding inj_on_def Fpow_def by auto
   4.736 +  thus ?thesis using card_of_ordLeq by metis
   4.737 +qed
   4.738 +
   4.739 +lemma Card_order_Fpow: "Card_order r \<Longrightarrow> r \<le>o |Fpow(Field r) |"
   4.740 +using card_of_Fpow card_of_Field_ordIso ordIso_ordLeq_trans ordIso_symmetric by blast
   4.741 +
   4.742 +lemma Fpow_Pow_finite: "Fpow A = Pow A Int {A. finite A}"
   4.743 +unfolding Fpow_def Pow_def by blast
   4.744 +
   4.745 +lemma inj_on_image_Fpow:
   4.746 +assumes "inj_on f A"
   4.747 +shows "inj_on (image f) (Fpow A)"
   4.748 +using assms Fpow_subset_Pow[of A] subset_inj_on[of "image f" "Pow A"]
   4.749 +      inj_on_image_Pow by blast
   4.750 +
   4.751 +lemma image_Fpow_mono:
   4.752 +assumes "f ` A \<le> B"
   4.753 +shows "(image f) ` (Fpow A) \<le> Fpow B"
   4.754 +using assms by(unfold Fpow_def, auto)
   4.755 +
   4.756 +lemma image_Fpow_surjective:
   4.757 +assumes "f ` A = B"
   4.758 +shows "(image f) ` (Fpow A) = Fpow B"
   4.759 +using assms proof(unfold Fpow_def, auto)
   4.760 +  fix Y assume *: "Y \<le> f ` A" and **: "finite Y"
   4.761 +  hence "\<forall>b \<in> Y. \<exists>a. a \<in> A \<and> f a = b" by auto
   4.762 +  with bchoice[of Y "\<lambda>b a. a \<in> A \<and> f a = b"]
   4.763 +  obtain g where 1: "\<forall>b \<in> Y. g b \<in> A \<and> f(g b) = b" by blast
   4.764 +  obtain X where X_def: "X = g ` Y" by blast
   4.765 +  have "f ` X = Y \<and> X \<le> A \<and> finite X"
   4.766 +  by(unfold X_def, force simp add: ** 1)
   4.767 +  thus "Y \<in> (image f) ` {X. X \<le> A \<and> finite X}" by auto
   4.768 +qed
   4.769 +
   4.770 +lemma bij_betw_image_Fpow:
   4.771 +assumes "bij_betw f A B"
   4.772 +shows "bij_betw (image f) (Fpow A) (Fpow B)"
   4.773 +using assms unfolding bij_betw_def
   4.774 +by (auto simp add: inj_on_image_Fpow image_Fpow_surjective)
   4.775 +
   4.776 +lemma card_of_Fpow_mono[simp]:
   4.777 +assumes "|A| \<le>o |B|"
   4.778 +shows "|Fpow A| \<le>o |Fpow B|"
   4.779 +proof-
   4.780 +  obtain f where "inj_on f A \<and> f ` A \<le> B"
   4.781 +  using assms card_of_ordLeq[of A B] by auto
   4.782 +  hence "inj_on (image f) (Fpow A) \<and> (image f) ` (Fpow A) \<le> (Fpow B)"
   4.783 +  by (auto simp add: inj_on_image_Fpow image_Fpow_mono)
   4.784 +  thus ?thesis using card_of_ordLeq[of "Fpow A"] by auto
   4.785 +qed
   4.786 +
   4.787 +lemma ordIso_Fpow_mono:
   4.788 +assumes "r \<le>o r'"
   4.789 +shows "|Fpow(Field r)| \<le>o |Fpow(Field r')|"
   4.790 +using assms card_of_mono2 card_of_Fpow_mono by blast
   4.791 +
   4.792 +lemma card_of_Fpow_cong[simp]:
   4.793 +assumes "|A| =o |B|"
   4.794 +shows "|Fpow A| =o |Fpow B|"
   4.795 +proof-
   4.796 +  obtain f where "bij_betw f A B"
   4.797 +  using assms card_of_ordIso[of A B] by auto
   4.798 +  hence "bij_betw (image f) (Fpow A) (Fpow B)"
   4.799 +  by (auto simp add: bij_betw_image_Fpow)
   4.800 +  thus ?thesis using card_of_ordIso[of "Fpow A"] by auto
   4.801 +qed
   4.802 +
   4.803 +lemma ordIso_Fpow_cong:
   4.804 +assumes "r =o r'"
   4.805 +shows "|Fpow(Field r)| =o |Fpow(Field r')|"
   4.806 +using assms card_of_cong card_of_Fpow_cong by blast
   4.807 +
   4.808 +lemma card_of_Fpow_lists: "|Fpow A| \<le>o |lists A|"
   4.809 +proof-
   4.810 +  have "set ` (lists A) = Fpow A"
   4.811 +  unfolding lists_def2 Fpow_def using finite_list finite_set by blast
   4.812 +  thus ?thesis using card_of_ordLeq2[of "Fpow A"] Fpow_not_empty[of A] by blast
   4.813 +qed
   4.814 +
   4.815 +lemma card_of_Fpow_infinite[simp]:
   4.816 +assumes "infinite A"
   4.817 +shows "|Fpow A| =o |A|"
   4.818 +using assms card_of_Fpow_lists card_of_lists_infinite card_of_Fpow
   4.819 +      ordLeq_ordIso_trans ordIso_iff_ordLeq by blast
   4.820 +
   4.821 +corollary Fpow_infinite_bij_betw:
   4.822 +assumes "infinite A"
   4.823 +shows "\<exists>f. bij_betw f (Fpow A) A"
   4.824 +using assms card_of_Fpow_infinite card_of_ordIso by blast
   4.825 +
   4.826 +
   4.827 +subsection {* The cardinal $\omega$ and the finite cardinals  *}
   4.828 +
   4.829 +subsubsection {* First as well-orders *}
   4.830 +
   4.831 +lemma Field_natLess: "Field natLess = (UNIV::nat set)"
   4.832 +by(unfold Field_def, auto)
   4.833 +
   4.834 +lemma natLeq_ofilter_less: "ofilter natLeq {0 ..< n}"
   4.835 +by(auto simp add: natLeq_wo_rel wo_rel.ofilter_def,
   4.836 +   simp add:  Field_natLeq, unfold rel.under_def, auto)
   4.837 +
   4.838 +lemma natLeq_ofilter_leq: "ofilter natLeq {0 .. n}"
   4.839 +by(auto simp add: natLeq_wo_rel wo_rel.ofilter_def,
   4.840 +   simp add:  Field_natLeq, unfold rel.under_def, auto)
   4.841 +
   4.842 +lemma natLeq_ofilter_iff:
   4.843 +"ofilter natLeq A = (A = UNIV \<or> (\<exists>n. A = {0 ..< n}))"
   4.844 +proof(rule iffI)
   4.845 +  assume "ofilter natLeq A"
   4.846 +  hence "\<forall>m n. n \<in> A \<and> m \<le> n \<longrightarrow> m \<in> A"
   4.847 +  by(auto simp add: natLeq_wo_rel wo_rel.ofilter_def rel.under_def)
   4.848 +  thus "A = UNIV \<or> (\<exists>n. A = {0 ..< n})" using closed_nat_set_iff by blast
   4.849 +next
   4.850 +  assume "A = UNIV \<or> (\<exists>n. A = {0 ..< n})"
   4.851 +  thus "ofilter natLeq A"
   4.852 +  by(auto simp add: natLeq_ofilter_less natLeq_UNIV_ofilter)
   4.853 +qed
   4.854 +
   4.855 +lemma natLeq_under_leq: "under natLeq n = {0 .. n}"
   4.856 +unfolding rel.under_def by auto
   4.857 +
   4.858 +corollary natLeq_on_ofilter:
   4.859 +"ofilter(natLeq_on n) {0 ..< n}"
   4.860 +by (auto simp add: natLeq_on_ofilter_less_eq)
   4.861 +
   4.862 +lemma natLeq_on_ofilter_less:
   4.863 +"n < m \<Longrightarrow> ofilter (natLeq_on m) {0 .. n}"
   4.864 +by(auto simp add: natLeq_on_wo_rel wo_rel.ofilter_def,
   4.865 +   simp add: Field_natLeq_on, unfold rel.under_def, auto)
   4.866 +
   4.867 +lemma natLeq_on_ordLess_natLeq: "natLeq_on n <o natLeq"
   4.868 +using Field_natLeq Field_natLeq_on[of n] nat_infinite
   4.869 +      finite_ordLess_infinite[of "natLeq_on n" natLeq]
   4.870 +      natLeq_Well_order natLeq_on_Well_order[of n] by auto
   4.871 +
   4.872 +lemma natLeq_on_injective:
   4.873 +"natLeq_on m = natLeq_on n \<Longrightarrow> m = n"
   4.874 +using Field_natLeq_on[of m] Field_natLeq_on[of n]
   4.875 +      atLeastLessThan_injective[of m n] by auto
   4.876 +
   4.877 +lemma natLeq_on_injective_ordIso:
   4.878 +"(natLeq_on m =o natLeq_on n) = (m = n)"
   4.879 +proof(auto simp add: natLeq_on_Well_order ordIso_reflexive)
   4.880 +  assume "natLeq_on m =o natLeq_on n"
   4.881 +  then obtain f where "bij_betw f {0..<m} {0..<n}"
   4.882 +  using Field_natLeq_on assms unfolding ordIso_def iso_def[abs_def] by auto
   4.883 +  thus "m = n" using atLeastLessThan_injective2 by blast
   4.884 +qed
   4.885 +
   4.886 +
   4.887 +subsubsection {* Then as cardinals *}
   4.888 +
   4.889 +lemma ordIso_natLeq_infinite1:
   4.890 +"|A| =o natLeq \<Longrightarrow> infinite A"
   4.891 +using ordIso_symmetric ordIso_imp_ordLeq infinite_iff_natLeq_ordLeq by blast
   4.892 +
   4.893 +lemma ordIso_natLeq_infinite2:
   4.894 +"natLeq =o |A| \<Longrightarrow> infinite A"
   4.895 +using ordIso_imp_ordLeq infinite_iff_natLeq_ordLeq by blast
   4.896 +
   4.897 +lemma ordLeq_natLeq_on_imp_finite:
   4.898 +assumes "|A| \<le>o natLeq_on n"
   4.899 +shows "finite A"
   4.900 +proof-
   4.901 +  have "|A| \<le>o |{0 ..< n}|"
   4.902 +  using assms card_of_less ordIso_symmetric ordLeq_ordIso_trans by blast
   4.903 +  thus ?thesis by (auto simp add: card_of_ordLeq_finite)
   4.904 +qed
   4.905 +
   4.906 +
   4.907 +subsubsection {* "Backwards compatibility" with the numeric cardinal operator for finite sets *}
   4.908 +
   4.909 +lemma finite_card_of_iff_card:
   4.910 +assumes FIN: "finite A" and FIN': "finite B"
   4.911 +shows "( |A| =o |B| ) = (card A = card B)"
   4.912 +using assms card_of_ordIso[of A B] bij_betw_iff_card[of A B] by blast
   4.913 +
   4.914 +lemma finite_card_of_iff_card3:
   4.915 +assumes FIN: "finite A" and FIN': "finite B"
   4.916 +shows "( |A| <o |B| ) = (card A < card B)"
   4.917 +proof-
   4.918 +  have "( |A| <o |B| ) = (~ ( |B| \<le>o |A| ))" by simp
   4.919 +  also have "... = (~ (card B \<le> card A))"
   4.920 +  using assms by(simp add: finite_card_of_iff_card2)
   4.921 +  also have "... = (card A < card B)" by auto
   4.922 +  finally show ?thesis .
   4.923 +qed
   4.924 +
   4.925 +lemma card_Field_natLeq_on:
   4.926 +"card(Field(natLeq_on n)) = n"
   4.927 +using Field_natLeq_on card_atLeastLessThan by auto
   4.928 +
   4.929 +
   4.930 +subsection {* The successor of a cardinal *}
   4.931 +
   4.932 +lemma embed_implies_ordIso_Restr:
   4.933 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and EMB: "embed r' r f"
   4.934 +shows "r' =o Restr r (f ` (Field r'))"
   4.935 +using assms embed_implies_iso_Restr Well_order_Restr unfolding ordIso_def by blast
   4.936 +
   4.937 +lemma cardSuc_Well_order[simp]:
   4.938 +"Card_order r \<Longrightarrow> Well_order(cardSuc r)"
   4.939 +using cardSuc_Card_order unfolding card_order_on_def by blast
   4.940 +
   4.941 +lemma Field_cardSuc_not_empty:
   4.942 +assumes "Card_order r"
   4.943 +shows "Field (cardSuc r) \<noteq> {}"
   4.944 +proof
   4.945 +  assume "Field(cardSuc r) = {}"
   4.946 +  hence "|Field(cardSuc r)| \<le>o r" using assms Card_order_empty[of r] by auto
   4.947 +  hence "cardSuc r \<le>o r" using assms card_of_Field_ordIso
   4.948 +  cardSuc_Card_order ordIso_symmetric ordIso_ordLeq_trans by blast
   4.949 +  thus False using cardSuc_greater not_ordLess_ordLeq assms by blast
   4.950 +qed
   4.951 +
   4.952 +lemma cardSuc_mono_ordLess[simp]:
   4.953 +assumes CARD: "Card_order r" and CARD': "Card_order r'"
   4.954 +shows "(cardSuc r <o cardSuc r') = (r <o r')"
   4.955 +proof-
   4.956 +  have 0: "Well_order r \<and> Well_order r' \<and> Well_order(cardSuc r) \<and> Well_order(cardSuc r')"
   4.957 +  using assms by auto
   4.958 +  thus ?thesis
   4.959 +  using not_ordLeq_iff_ordLess not_ordLeq_iff_ordLess[of r r']
   4.960 +  using cardSuc_mono_ordLeq[of r' r] assms by blast
   4.961 +qed
   4.962 +
   4.963 +lemma card_of_Plus_ordLeq_infinite[simp]:
   4.964 +assumes C: "infinite C" and A: "|A| \<le>o |C|" and B: "|B| \<le>o |C|"
   4.965 +shows "|A <+> B| \<le>o |C|"
   4.966 +proof-
   4.967 +  let ?r = "cardSuc |C|"
   4.968 +  have "Card_order ?r \<and> infinite (Field ?r)" using assms by simp
   4.969 +  moreover have "|A| <o ?r" and "|B| <o ?r" using A B by auto
   4.970 +  ultimately have "|A <+> B| <o ?r"
   4.971 +  using card_of_Plus_ordLess_infinite_Field by blast
   4.972 +  thus ?thesis using C by simp
   4.973 +qed
   4.974 +
   4.975 +lemma card_of_Un_ordLeq_infinite[simp]:
   4.976 +assumes C: "infinite C" and A: "|A| \<le>o |C|" and B: "|B| \<le>o |C|"
   4.977 +shows "|A Un B| \<le>o |C|"
   4.978 +using assms card_of_Plus_ordLeq_infinite card_of_Un_Plus_ordLeq
   4.979 +ordLeq_transitive by metis
   4.980 +
   4.981 +
   4.982 +subsection {* Others *}
   4.983 +
   4.984 +lemma under_mono[simp]:
   4.985 +assumes "Well_order r" and "(i,j) \<in> r"
   4.986 +shows "under r i \<subseteq> under r j"
   4.987 +using assms unfolding rel.under_def order_on_defs
   4.988 +trans_def by blast
   4.989 +
   4.990 +lemma underS_under:
   4.991 +assumes "i \<in> Field r"
   4.992 +shows "underS r i = under r i - {i}"
   4.993 +using assms unfolding rel.underS_def rel.under_def by auto
   4.994 +
   4.995 +lemma relChain_under:
   4.996 +assumes "Well_order r"
   4.997 +shows "relChain r (\<lambda> i. under r i)"
   4.998 +using assms unfolding relChain_def by auto
   4.999 +
  4.1000 +lemma infinite_card_of_diff_singl:
  4.1001 +assumes "infinite A"
  4.1002 +shows "|A - {a}| =o |A|"
  4.1003 +by (metis assms card_of_infinite_diff_finitte finite.emptyI finite_insert)
  4.1004 +
  4.1005 +lemma card_of_vimage:
  4.1006 +assumes "B \<subseteq> range f"
  4.1007 +shows "|B| \<le>o |f -` B|"
  4.1008 +apply(rule surj_imp_ordLeq[of _ f])
  4.1009 +using assms by (metis Int_absorb2 image_vimage_eq order_refl)
  4.1010 +
  4.1011 +lemma surj_card_of_vimage:
  4.1012 +assumes "surj f"
  4.1013 +shows "|B| \<le>o |f -` B|"
  4.1014 +by (metis assms card_of_vimage subset_UNIV)
  4.1015 +
  4.1016 +(* bounded powerset *)
  4.1017 +definition Bpow where
  4.1018 +"Bpow r A \<equiv> {X . X \<subseteq> A \<and> |X| \<le>o r}"
  4.1019 +
  4.1020 +lemma Bpow_empty[simp]:
  4.1021 +assumes "Card_order r"
  4.1022 +shows "Bpow r {} = {{}}"
  4.1023 +using assms unfolding Bpow_def by auto
  4.1024 +
  4.1025 +lemma singl_in_Bpow:
  4.1026 +assumes rc: "Card_order r"
  4.1027 +and r: "Field r \<noteq> {}" and a: "a \<in> A"
  4.1028 +shows "{a} \<in> Bpow r A"
  4.1029 +proof-
  4.1030 +  have "|{a}| \<le>o r" using r rc by auto
  4.1031 +  thus ?thesis unfolding Bpow_def using a by auto
  4.1032 +qed
  4.1033 +
  4.1034 +lemma ordLeq_card_Bpow:
  4.1035 +assumes rc: "Card_order r" and r: "Field r \<noteq> {}"
  4.1036 +shows "|A| \<le>o |Bpow r A|"
  4.1037 +proof-
  4.1038 +  have "inj_on (\<lambda> a. {a}) A" unfolding inj_on_def by auto
  4.1039 +  moreover have "(\<lambda> a. {a}) ` A \<subseteq> Bpow r A"
  4.1040 +  using singl_in_Bpow[OF assms] by auto
  4.1041 +  ultimately show ?thesis unfolding card_of_ordLeq[symmetric] by blast
  4.1042 +qed
  4.1043 +
  4.1044 +lemma infinite_Bpow:
  4.1045 +assumes rc: "Card_order r" and r: "Field r \<noteq> {}"
  4.1046 +and A: "infinite A"
  4.1047 +shows "infinite (Bpow r A)"
  4.1048 +using ordLeq_card_Bpow[OF rc r]
  4.1049 +by (metis A card_of_ordLeq_infinite)
  4.1050 +
  4.1051 +lemma Bpow_ordLeq_Func_Field:
  4.1052 +assumes rc: "Card_order r" and r: "Field r \<noteq> {}" and A: "infinite A"
  4.1053 +shows "|Bpow r A| \<le>o |Func (Field r) A|"
  4.1054 +proof-
  4.1055 +  let ?F = "\<lambda> f. {x | x a. f a = Some x}"
  4.1056 +  {fix X assume "X \<in> Bpow r A - {{}}"
  4.1057 +   hence XA: "X \<subseteq> A" and "|X| \<le>o r"
  4.1058 +   and X: "X \<noteq> {}" unfolding Bpow_def by auto
  4.1059 +   hence "|X| \<le>o |Field r|" by (metis Field_card_of card_of_mono2)
  4.1060 +   then obtain F where 1: "X = F ` (Field r)"
  4.1061 +   using card_of_ordLeq2[OF X] by metis
  4.1062 +   def f \<equiv> "\<lambda> i. if i \<in> Field r then Some (F i) else None"
  4.1063 +   have "\<exists> f \<in> Func (Field r) A. X = ?F f"
  4.1064 +   apply (intro bexI[of _ f]) using 1 XA unfolding Func_def f_def by auto
  4.1065 +  }
  4.1066 +  hence "Bpow r A - {{}} \<subseteq> ?F ` (Func (Field r) A)" by auto
  4.1067 +  hence "|Bpow r A - {{}}| \<le>o |Func (Field r) A|"
  4.1068 +  by (rule surj_imp_ordLeq)
  4.1069 +  moreover
  4.1070 +  {have 2: "infinite (Bpow r A)" using infinite_Bpow[OF rc r A] .
  4.1071 +   have "|Bpow r A| =o |Bpow r A - {{}}|"
  4.1072 +   using card_of_infinite_diff_finitte
  4.1073 +   by (metis Pow_empty 2 finite_Pow_iff infinite_imp_nonempty ordIso_symmetric)
  4.1074 +  }
  4.1075 +  ultimately show ?thesis by (metis ordIso_ordLeq_trans)
  4.1076 +qed
  4.1077 +
  4.1078 +lemma Func_emp2[simp]: "A \<noteq> {} \<Longrightarrow> Func A {} = {}" by auto
  4.1079 +
  4.1080 +lemma empty_in_Func[simp]:
  4.1081 +"B \<noteq> {} \<Longrightarrow> empty \<in> Func {} B"
  4.1082 +unfolding Func_def by auto
  4.1083 +
  4.1084 +lemma Func_mono[simp]:
  4.1085 +assumes "B1 \<subseteq> B2"
  4.1086 +shows "Func A B1 \<subseteq> Func A B2"
  4.1087 +using assms unfolding Func_def by force
  4.1088 +
  4.1089 +lemma Pfunc_mono[simp]:
  4.1090 +assumes "A1 \<subseteq> A2" and "B1 \<subseteq> B2"
  4.1091 +shows "Pfunc A B1 \<subseteq> Pfunc A B2"
  4.1092 +using assms in_mono unfolding Pfunc_def apply safe
  4.1093 +apply(case_tac "x a", auto)
  4.1094 +by (metis in_mono option.simps(5))
  4.1095 +
  4.1096 +lemma card_of_Func_UNIV_UNIV:
  4.1097 +"|Func (UNIV::'a set) (UNIV::'b set)| =o |UNIV::('a \<Rightarrow> 'b) set|"
  4.1098 +using card_of_Func_UNIV[of "UNIV::'b set"] by auto
  4.1099 +
  4.1100 +end
     5.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     5.2 +++ b/src/HOL/Cardinals/Cardinal_Order_Relation_Base.thy	Wed Sep 12 05:29:21 2012 +0200
     5.3 @@ -0,0 +1,2579 @@
     5.4 +(*  Title:      HOL/Cardinals/Cardinal_Order_Relation_Base.thy
     5.5 +    Author:     Andrei Popescu, TU Muenchen
     5.6 +    Copyright   2012
     5.7 +
     5.8 +Cardinal-order relations (base).
     5.9 +*)
    5.10 +
    5.11 +header {* Cardinal-Order Relations (Base)  *}
    5.12 +
    5.13 +theory Cardinal_Order_Relation_Base
    5.14 +imports Constructions_on_Wellorders_Base
    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 rel.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 rel.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 rel.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 rel.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: rel.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 rel.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 (rel.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 "|rel.underS r a| <o r"
   5.335 +proof-
   5.336 +  let ?A = "rel.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: rel.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 blast
   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 +lemma infinite_Pow:
   5.488 +assumes "infinite A"
   5.489 +shows "infinite (Pow A)"
   5.490 +proof-
   5.491 +  have "|A| \<le>o |Pow A|" by (metis card_of_Pow ordLess_imp_ordLeq)
   5.492 +  thus ?thesis by (metis assms finite_Pow_iff)
   5.493 +qed
   5.494 +
   5.495 +
   5.496 +corollary Card_order_Pow:
   5.497 +"Card_order r \<Longrightarrow> r <o |Pow(Field r)|"
   5.498 +using card_of_Pow card_of_Field_ordIso ordIso_ordLess_trans ordIso_symmetric by blast
   5.499 +
   5.500 +
   5.501 +corollary card_of_set_type: "|UNIV::'a set| <o |UNIV::'a set set|"
   5.502 +using card_of_Pow[of "UNIV::'a set"] by simp
   5.503 +
   5.504 +
   5.505 +lemma card_of_Plus1: "|A| \<le>o |A <+> B|"
   5.506 +proof-
   5.507 +  have "Inl ` A \<le> A <+> B" by auto
   5.508 +  thus ?thesis using inj_Inl[of A] card_of_ordLeq by blast
   5.509 +qed
   5.510 +
   5.511 +
   5.512 +corollary Card_order_Plus1:
   5.513 +"Card_order r \<Longrightarrow> r \<le>o |(Field r) <+> B|"
   5.514 +using card_of_Plus1 card_of_Field_ordIso ordIso_ordLeq_trans ordIso_symmetric by blast
   5.515 +
   5.516 +
   5.517 +lemma card_of_Plus2: "|B| \<le>o |A <+> B|"
   5.518 +proof-
   5.519 +  have "Inr ` B \<le> A <+> B" by auto
   5.520 +  thus ?thesis using inj_Inr[of B] card_of_ordLeq by blast
   5.521 +qed
   5.522 +
   5.523 +
   5.524 +corollary Card_order_Plus2:
   5.525 +"Card_order r \<Longrightarrow> r \<le>o |A <+> (Field r)|"
   5.526 +using card_of_Plus2 card_of_Field_ordIso ordIso_ordLeq_trans ordIso_symmetric by blast
   5.527 +
   5.528 +
   5.529 +lemma card_of_Plus_empty1: "|A| =o |A <+> {}|"
   5.530 +proof-
   5.531 +  have "bij_betw Inl A (A <+> {})" unfolding bij_betw_def inj_on_def by auto
   5.532 +  thus ?thesis using card_of_ordIso by auto
   5.533 +qed
   5.534 +
   5.535 +
   5.536 +lemma card_of_Plus_empty2: "|A| =o |{} <+> A|"
   5.537 +proof-
   5.538 +  have "bij_betw Inr A ({} <+> A)" unfolding bij_betw_def inj_on_def by auto
   5.539 +  thus ?thesis using card_of_ordIso by auto
   5.540 +qed
   5.541 +
   5.542 +
   5.543 +lemma card_of_Plus_commute: "|A <+> B| =o |B <+> A|"
   5.544 +proof-
   5.545 +  let ?f = "\<lambda>(c::'a + 'b). case c of Inl a \<Rightarrow> Inr a
   5.546 +                                   | Inr b \<Rightarrow> Inl b"
   5.547 +  have "bij_betw ?f (A <+> B) (B <+> A)"
   5.548 +  unfolding bij_betw_def inj_on_def by force
   5.549 +  thus ?thesis using card_of_ordIso by blast
   5.550 +qed
   5.551 +
   5.552 +
   5.553 +lemma card_of_Plus_assoc:
   5.554 +fixes A :: "'a set" and B :: "'b set" and C :: "'c set"
   5.555 +shows "|(A <+> B) <+> C| =o |A <+> B <+> C|"
   5.556 +proof -
   5.557 +  def f \<equiv> "\<lambda>(k::('a + 'b) + 'c).
   5.558 +  case k of Inl ab \<Rightarrow> (case ab of Inl a \<Rightarrow> Inl a
   5.559 +                                 |Inr b \<Rightarrow> Inr (Inl b))
   5.560 +           |Inr c \<Rightarrow> Inr (Inr c)"
   5.561 +  have "A <+> B <+> C \<subseteq> f ` ((A <+> B) <+> C)"
   5.562 +  proof
   5.563 +    fix x assume x: "x \<in> A <+> B <+> C"
   5.564 +    show "x \<in> f ` ((A <+> B) <+> C)"
   5.565 +    proof(cases x)
   5.566 +      case (Inl a)
   5.567 +      hence "a \<in> A" "x = f (Inl (Inl a))"
   5.568 +      using x unfolding f_def by auto
   5.569 +      thus ?thesis by auto
   5.570 +    next
   5.571 +      case (Inr bc) note 1 = Inr show ?thesis
   5.572 +      proof(cases bc)
   5.573 +        case (Inl b)
   5.574 +        hence "b \<in> B" "x = f (Inl (Inr b))"
   5.575 +        using x 1 unfolding f_def by auto
   5.576 +        thus ?thesis by auto
   5.577 +      next
   5.578 +        case (Inr c)
   5.579 +        hence "c \<in> C" "x = f (Inr c)"
   5.580 +        using x 1 unfolding f_def by auto
   5.581 +        thus ?thesis by auto
   5.582 +      qed
   5.583 +    qed
   5.584 +  qed
   5.585 +  hence "bij_betw f ((A <+> B) <+> C) (A <+> B <+> C)"
   5.586 +  unfolding bij_betw_def inj_on_def f_def by auto
   5.587 +  thus ?thesis using card_of_ordIso by blast
   5.588 +qed
   5.589 +
   5.590 +
   5.591 +lemma card_of_Plus_mono1:
   5.592 +assumes "|A| \<le>o |B|"
   5.593 +shows "|A <+> C| \<le>o |B <+> C|"
   5.594 +proof-
   5.595 +  obtain f where 1: "inj_on f A \<and> f ` A \<le> B"
   5.596 +  using assms card_of_ordLeq[of A] by fastforce
   5.597 +  obtain g where g_def:
   5.598 +  "g = (\<lambda>d. case d of Inl a \<Rightarrow> Inl(f a) | Inr (c::'c) \<Rightarrow> Inr c)" by blast
   5.599 +  have "inj_on g (A <+> C) \<and> g ` (A <+> C) \<le> (B <+> C)"
   5.600 +  proof-
   5.601 +    {fix d1 and d2 assume "d1 \<in> A <+> C \<and> d2 \<in> A <+> C" and
   5.602 +                          "g d1 = g d2"
   5.603 +     hence "d1 = d2" using 1 unfolding inj_on_def
   5.604 +     by(case_tac d1, case_tac d2, auto simp add: g_def)
   5.605 +    }
   5.606 +    moreover
   5.607 +    {fix d assume "d \<in> A <+> C"
   5.608 +     hence "g d \<in> B <+> C"  using 1
   5.609 +     by(case_tac d, auto simp add: g_def)
   5.610 +    }
   5.611 +    ultimately show ?thesis unfolding inj_on_def by auto
   5.612 +  qed
   5.613 +  thus ?thesis using card_of_ordLeq by metis
   5.614 +qed
   5.615 +
   5.616 +
   5.617 +corollary ordLeq_Plus_mono1:
   5.618 +assumes "r \<le>o r'"
   5.619 +shows "|(Field r) <+> C| \<le>o |(Field r') <+> C|"
   5.620 +using assms card_of_mono2 card_of_Plus_mono1 by blast
   5.621 +
   5.622 +
   5.623 +lemma card_of_Plus_mono2:
   5.624 +assumes "|A| \<le>o |B|"
   5.625 +shows "|C <+> A| \<le>o |C <+> B|"
   5.626 +using assms card_of_Plus_mono1[of A B C]
   5.627 +      card_of_Plus_commute[of C A]  card_of_Plus_commute[of B C]
   5.628 +      ordIso_ordLeq_trans[of "|C <+> A|"] ordLeq_ordIso_trans[of "|C <+> A|"]
   5.629 +by blast
   5.630 +
   5.631 +
   5.632 +corollary ordLeq_Plus_mono2:
   5.633 +assumes "r \<le>o r'"
   5.634 +shows "|A <+> (Field r)| \<le>o |A <+> (Field r')|"
   5.635 +using assms card_of_mono2 card_of_Plus_mono2 by blast
   5.636 +
   5.637 +
   5.638 +lemma card_of_Plus_mono:
   5.639 +assumes "|A| \<le>o |B|" and "|C| \<le>o |D|"
   5.640 +shows "|A <+> C| \<le>o |B <+> D|"
   5.641 +using assms card_of_Plus_mono1[of A B C] card_of_Plus_mono2[of C D B]
   5.642 +      ordLeq_transitive[of "|A <+> C|"] by blast
   5.643 +
   5.644 +
   5.645 +corollary ordLeq_Plus_mono:
   5.646 +assumes "r \<le>o r'" and "p \<le>o p'"
   5.647 +shows "|(Field r) <+> (Field p)| \<le>o |(Field r') <+> (Field p')|"
   5.648 +using assms card_of_mono2[of r r'] card_of_mono2[of p p'] card_of_Plus_mono by blast
   5.649 +
   5.650 +
   5.651 +lemma card_of_Plus_cong1:
   5.652 +assumes "|A| =o |B|"
   5.653 +shows "|A <+> C| =o |B <+> C|"
   5.654 +using assms by (simp add: ordIso_iff_ordLeq card_of_Plus_mono1)
   5.655 +
   5.656 +
   5.657 +corollary ordIso_Plus_cong1:
   5.658 +assumes "r =o r'"
   5.659 +shows "|(Field r) <+> C| =o |(Field r') <+> C|"
   5.660 +using assms card_of_cong card_of_Plus_cong1 by blast
   5.661 +
   5.662 +
   5.663 +lemma card_of_Plus_cong2:
   5.664 +assumes "|A| =o |B|"
   5.665 +shows "|C <+> A| =o |C <+> B|"
   5.666 +using assms by (simp add: ordIso_iff_ordLeq card_of_Plus_mono2)
   5.667 +
   5.668 +
   5.669 +corollary ordIso_Plus_cong2:
   5.670 +assumes "r =o r'"
   5.671 +shows "|A <+> (Field r)| =o |A <+> (Field r')|"
   5.672 +using assms card_of_cong card_of_Plus_cong2 by blast
   5.673 +
   5.674 +
   5.675 +lemma card_of_Plus_cong:
   5.676 +assumes "|A| =o |B|" and "|C| =o |D|"
   5.677 +shows "|A <+> C| =o |B <+> D|"
   5.678 +using assms by (simp add: ordIso_iff_ordLeq card_of_Plus_mono)
   5.679 +
   5.680 +
   5.681 +corollary ordIso_Plus_cong:
   5.682 +assumes "r =o r'" and "p =o p'"
   5.683 +shows "|(Field r) <+> (Field p)| =o |(Field r') <+> (Field p')|"
   5.684 +using assms card_of_cong[of r r'] card_of_cong[of p p'] card_of_Plus_cong by blast
   5.685 +
   5.686 +
   5.687 +lemma card_of_Un1:
   5.688 +shows "|A| \<le>o |A \<union> B| "
   5.689 +using inj_on_id[of A] card_of_ordLeq[of A _] by fastforce
   5.690 +
   5.691 +
   5.692 +lemma card_of_diff:
   5.693 +shows "|A - B| \<le>o |A|"
   5.694 +using inj_on_id[of "A - B"] card_of_ordLeq[of "A - B" _] by fastforce
   5.695 +
   5.696 +
   5.697 +lemma card_of_Un_Plus_ordLeq:
   5.698 +"|A \<union> B| \<le>o |A <+> B|"
   5.699 +proof-
   5.700 +   let ?f = "\<lambda> c. if c \<in> A then Inl c else Inr c"
   5.701 +   have "inj_on ?f (A \<union> B) \<and> ?f ` (A \<union> B) \<le> A <+> B"
   5.702 +   unfolding inj_on_def by auto
   5.703 +   thus ?thesis using card_of_ordLeq by blast
   5.704 +qed
   5.705 +
   5.706 +
   5.707 +lemma card_of_Times1:
   5.708 +assumes "A \<noteq> {}"
   5.709 +shows "|B| \<le>o |B \<times> A|"
   5.710 +proof(cases "B = {}", simp add: card_of_empty)
   5.711 +  assume *: "B \<noteq> {}"
   5.712 +  have "fst `(B \<times> A) = B" unfolding image_def using assms by auto
   5.713 +  thus ?thesis using inj_on_iff_surj[of B "B \<times> A"]
   5.714 +                     card_of_ordLeq[of B "B \<times> A"] * by blast
   5.715 +qed
   5.716 +
   5.717 +
   5.718 +corollary Card_order_Times1:
   5.719 +"\<lbrakk>Card_order r; B \<noteq> {}\<rbrakk> \<Longrightarrow> r \<le>o |(Field r) \<times> B|"
   5.720 +using card_of_Times1[of B] card_of_Field_ordIso
   5.721 +      ordIso_ordLeq_trans ordIso_symmetric by blast
   5.722 +
   5.723 +
   5.724 +lemma card_of_Times_commute: "|A \<times> B| =o |B \<times> A|"
   5.725 +proof-
   5.726 +  let ?f = "\<lambda>(a::'a,b::'b). (b,a)"
   5.727 +  have "bij_betw ?f (A \<times> B) (B \<times> A)"
   5.728 +  unfolding bij_betw_def inj_on_def by auto
   5.729 +  thus ?thesis using card_of_ordIso by blast
   5.730 +qed
   5.731 +
   5.732 +
   5.733 +lemma card_of_Times2:
   5.734 +assumes "A \<noteq> {}"   shows "|B| \<le>o |A \<times> B|"
   5.735 +using assms card_of_Times1[of A B] card_of_Times_commute[of B A]
   5.736 +      ordLeq_ordIso_trans by blast
   5.737 +
   5.738 +
   5.739 +corollary Card_order_Times2:
   5.740 +"\<lbrakk>Card_order r; A \<noteq> {}\<rbrakk> \<Longrightarrow> r \<le>o |A \<times> (Field r)|"
   5.741 +using card_of_Times2[of A] card_of_Field_ordIso
   5.742 +      ordIso_ordLeq_trans ordIso_symmetric by blast
   5.743 +
   5.744 +
   5.745 +lemma card_of_Times3: "|A| \<le>o |A \<times> A|"
   5.746 +using card_of_Times1[of A]
   5.747 +by(cases "A = {}", simp add: card_of_empty, blast)
   5.748 +
   5.749 +
   5.750 +lemma card_of_Plus_Times_bool: "|A <+> A| =o |A \<times> (UNIV::bool set)|"
   5.751 +proof-
   5.752 +  let ?f = "\<lambda>c::'a + 'a. case c of Inl a \<Rightarrow> (a,True)
   5.753 +                                  |Inr a \<Rightarrow> (a,False)"
   5.754 +  have "bij_betw ?f (A <+> A) (A \<times> (UNIV::bool set))"
   5.755 +  proof-
   5.756 +    {fix  c1 and c2 assume "?f c1 = ?f c2"
   5.757 +     hence "c1 = c2"
   5.758 +     by(case_tac "c1", case_tac "c2", auto, case_tac "c2", auto)
   5.759 +    }
   5.760 +    moreover
   5.761 +    {fix c assume "c \<in> A <+> A"
   5.762 +     hence "?f c \<in> A \<times> (UNIV::bool set)"
   5.763 +     by(case_tac c, auto)
   5.764 +    }
   5.765 +    moreover
   5.766 +    {fix a bl assume *: "(a,bl) \<in> A \<times> (UNIV::bool set)"
   5.767 +     have "(a,bl) \<in> ?f ` ( A <+> A)"
   5.768 +     proof(cases bl)
   5.769 +       assume bl hence "?f(Inl a) = (a,bl)" by auto
   5.770 +       thus ?thesis using * by force
   5.771 +     next
   5.772 +       assume "\<not> bl" hence "?f(Inr a) = (a,bl)" by auto
   5.773 +       thus ?thesis using * by force
   5.774 +     qed
   5.775 +    }
   5.776 +    ultimately show ?thesis unfolding bij_betw_def inj_on_def by auto
   5.777 +  qed
   5.778 +  thus ?thesis using card_of_ordIso by blast
   5.779 +qed
   5.780 +
   5.781 +
   5.782 +lemma card_of_Times_mono1:
   5.783 +assumes "|A| \<le>o |B|"
   5.784 +shows "|A \<times> C| \<le>o |B \<times> C|"
   5.785 +proof-
   5.786 +  obtain f where 1: "inj_on f A \<and> f ` A \<le> B"
   5.787 +  using assms card_of_ordLeq[of A] by fastforce
   5.788 +  obtain g where g_def:
   5.789 +  "g = (\<lambda>(a,c::'c). (f a,c))" by blast
   5.790 +  have "inj_on g (A \<times> C) \<and> g ` (A \<times> C) \<le> (B \<times> C)"
   5.791 +  using 1 unfolding inj_on_def using g_def by auto
   5.792 +  thus ?thesis using card_of_ordLeq by metis
   5.793 +qed
   5.794 +
   5.795 +
   5.796 +corollary ordLeq_Times_mono1:
   5.797 +assumes "r \<le>o r'"
   5.798 +shows "|(Field r) \<times> C| \<le>o |(Field r') \<times> C|"
   5.799 +using assms card_of_mono2 card_of_Times_mono1 by blast
   5.800 +
   5.801 +
   5.802 +lemma card_of_Times_mono2:
   5.803 +assumes "|A| \<le>o |B|"
   5.804 +shows "|C \<times> A| \<le>o |C \<times> B|"
   5.805 +using assms card_of_Times_mono1[of A B C]
   5.806 +      card_of_Times_commute[of C A]  card_of_Times_commute[of B C]
   5.807 +      ordIso_ordLeq_trans[of "|C \<times> A|"] ordLeq_ordIso_trans[of "|C \<times> A|"]
   5.808 +by blast
   5.809 +
   5.810 +
   5.811 +corollary ordLeq_Times_mono2:
   5.812 +assumes "r \<le>o r'"
   5.813 +shows "|A \<times> (Field r)| \<le>o |A \<times> (Field r')|"
   5.814 +using assms card_of_mono2 card_of_Times_mono2 by blast
   5.815 +
   5.816 +
   5.817 +lemma card_of_Times_cong1:
   5.818 +assumes "|A| =o |B|"
   5.819 +shows "|A \<times> C| =o |B \<times> C|"
   5.820 +using assms by (simp add: ordIso_iff_ordLeq card_of_Times_mono1)
   5.821 +
   5.822 +
   5.823 +lemma card_of_Times_cong2:
   5.824 +assumes "|A| =o |B|"
   5.825 +shows "|C \<times> A| =o |C \<times> B|"
   5.826 +using assms by (simp add: ordIso_iff_ordLeq card_of_Times_mono2)
   5.827 +
   5.828 +
   5.829 +corollary ordIso_Times_cong2:
   5.830 +assumes "r =o r'"
   5.831 +shows "|A \<times> (Field r)| =o |A \<times> (Field r')|"
   5.832 +using assms card_of_cong card_of_Times_cong2 by blast
   5.833 +
   5.834 +
   5.835 +lemma card_of_Sigma_mono1:
   5.836 +assumes "\<forall>i \<in> I. |A i| \<le>o |B i|"
   5.837 +shows "|SIGMA i : I. A i| \<le>o |SIGMA i : I. B i|"
   5.838 +proof-
   5.839 +  have "\<forall>i. i \<in> I \<longrightarrow> (\<exists>f. inj_on f (A i) \<and> f ` (A i) \<le> B i)"
   5.840 +  using assms by (auto simp add: card_of_ordLeq)
   5.841 +  with choice[of "\<lambda> i f. i \<in> I \<longrightarrow> inj_on f (A i) \<and> f ` (A i) \<le> B i"]
   5.842 +  obtain F where 1: "\<forall>i \<in> I. inj_on (F i) (A i) \<and> (F i) ` (A i) \<le> B i" by fastforce
   5.843 +  obtain g where g_def: "g = (\<lambda>(i,a::'b). (i,F i a))" by blast
   5.844 +  have "inj_on g (Sigma I A) \<and> g ` (Sigma I A) \<le> (Sigma I B)"
   5.845 +  using 1 unfolding inj_on_def using g_def by force
   5.846 +  thus ?thesis using card_of_ordLeq by metis
   5.847 +qed
   5.848 +
   5.849 +
   5.850 +corollary card_of_Sigma_Times:
   5.851 +"\<forall>i \<in> I. |A i| \<le>o |B| \<Longrightarrow> |SIGMA i : I. A i| \<le>o |I \<times> B|"
   5.852 +using card_of_Sigma_mono1[of I A "\<lambda>i. B"] .
   5.853 +
   5.854 +
   5.855 +lemma card_of_UNION_Sigma:
   5.856 +"|\<Union>i \<in> I. A i| \<le>o |SIGMA i : I. A i|"
   5.857 +using Ex_inj_on_UNION_Sigma[of I A] card_of_ordLeq by metis
   5.858 +
   5.859 +
   5.860 +lemma card_of_bool:
   5.861 +assumes "a1 \<noteq> a2"
   5.862 +shows "|UNIV::bool set| =o |{a1,a2}|"
   5.863 +proof-
   5.864 +  let ?f = "\<lambda> bl. case bl of True \<Rightarrow> a1 | False \<Rightarrow> a2"
   5.865 +  have "bij_betw ?f UNIV {a1,a2}"
   5.866 +  proof-
   5.867 +    {fix bl1 and bl2 assume "?f  bl1 = ?f bl2"
   5.868 +     hence "bl1 = bl2" using assms by (case_tac bl1, case_tac bl2, auto)
   5.869 +    }
   5.870 +    moreover
   5.871 +    {fix bl have "?f bl \<in> {a1,a2}" by (case_tac bl, auto)
   5.872 +    }
   5.873 +    moreover
   5.874 +    {fix a assume *: "a \<in> {a1,a2}"
   5.875 +     have "a \<in> ?f ` UNIV"
   5.876 +     proof(cases "a = a1")
   5.877 +       assume "a = a1"
   5.878 +       hence "?f True = a" by auto  thus ?thesis by blast
   5.879 +     next
   5.880 +       assume "a \<noteq> a1" hence "a = a2" using * by auto
   5.881 +       hence "?f False = a" by auto  thus ?thesis by blast
   5.882 +     qed
   5.883 +    }
   5.884 +    ultimately show ?thesis unfolding bij_betw_def inj_on_def
   5.885 +    by (metis image_subsetI order_eq_iff subsetI)
   5.886 +  qed
   5.887 +  thus ?thesis using card_of_ordIso by blast
   5.888 +qed
   5.889 +
   5.890 +
   5.891 +lemma card_of_Plus_Times_aux:
   5.892 +assumes A2: "a1 \<noteq> a2 \<and> {a1,a2} \<le> A" and
   5.893 +        LEQ: "|A| \<le>o |B|"
   5.894 +shows "|A <+> B| \<le>o |A \<times> B|"
   5.895 +proof-
   5.896 +  have 1: "|UNIV::bool set| \<le>o |A|"
   5.897 +  using A2 card_of_mono1[of "{a1,a2}"] card_of_bool[of a1 a2]
   5.898 +        ordIso_ordLeq_trans[of "|UNIV::bool set|"] by metis
   5.899 +  (*  *)
   5.900 +  have "|A <+> B| \<le>o |B <+> B|"
   5.901 +  using LEQ card_of_Plus_mono1 by blast
   5.902 +  moreover have "|B <+> B| =o |B \<times> (UNIV::bool set)|"
   5.903 +  using card_of_Plus_Times_bool by blast
   5.904 +  moreover have "|B \<times> (UNIV::bool set)| \<le>o |B \<times> A|"
   5.905 +  using 1 by (simp add: card_of_Times_mono2)
   5.906 +  moreover have " |B \<times> A| =o |A \<times> B|"
   5.907 +  using card_of_Times_commute by blast
   5.908 +  ultimately show "|A <+> B| \<le>o |A \<times> B|"
   5.909 +  using ordLeq_ordIso_trans[of "|A <+> B|" "|B <+> B|" "|B \<times> (UNIV::bool set)|"]
   5.910 +        ordLeq_transitive[of "|A <+> B|" "|B \<times> (UNIV::bool set)|" "|B \<times> A|"]
   5.911 +        ordLeq_ordIso_trans[of "|A <+> B|" "|B \<times> A|" "|A \<times> B|"]
   5.912 +  by blast
   5.913 +qed
   5.914 +
   5.915 +
   5.916 +lemma card_of_Plus_Times:
   5.917 +assumes A2: "a1 \<noteq> a2 \<and> {a1,a2} \<le> A" and
   5.918 +        B2: "b1 \<noteq> b2 \<and> {b1,b2} \<le> B"
   5.919 +shows "|A <+> B| \<le>o |A \<times> B|"
   5.920 +proof-
   5.921 +  {assume "|A| \<le>o |B|"
   5.922 +   hence ?thesis using assms by (auto simp add: card_of_Plus_Times_aux)
   5.923 +  }
   5.924 +  moreover
   5.925 +  {assume "|B| \<le>o |A|"
   5.926 +   hence "|B <+> A| \<le>o |B \<times> A|"
   5.927 +   using assms by (auto simp add: card_of_Plus_Times_aux)
   5.928 +   hence ?thesis
   5.929 +   using card_of_Plus_commute card_of_Times_commute
   5.930 +         ordIso_ordLeq_trans ordLeq_ordIso_trans by metis
   5.931 +  }
   5.932 +  ultimately show ?thesis
   5.933 +  using card_of_Well_order[of A] card_of_Well_order[of B]
   5.934 +        ordLeq_total[of "|A|"] by metis
   5.935 +qed
   5.936 +
   5.937 +
   5.938 +lemma card_of_ordLeq_finite:
   5.939 +assumes "|A| \<le>o |B|" and "finite B"
   5.940 +shows "finite A"
   5.941 +using assms unfolding ordLeq_def
   5.942 +using embed_inj_on[of "|A|" "|B|"]  embed_Field[of "|A|" "|B|"]
   5.943 +      Field_card_of[of "A"] Field_card_of[of "B"] inj_on_finite[of _ "A" "B"] by fastforce
   5.944 +
   5.945 +
   5.946 +lemma card_of_ordLeq_infinite:
   5.947 +assumes "|A| \<le>o |B|" and "infinite A"
   5.948 +shows "infinite B"
   5.949 +using assms card_of_ordLeq_finite by auto
   5.950 +
   5.951 +
   5.952 +lemma card_of_ordIso_finite:
   5.953 +assumes "|A| =o |B|"
   5.954 +shows "finite A = finite B"
   5.955 +using assms unfolding ordIso_def iso_def[abs_def]
   5.956 +by (auto simp: bij_betw_finite Field_card_of)
   5.957 +
   5.958 +
   5.959 +lemma card_of_ordIso_finite_Field:
   5.960 +assumes "Card_order r" and "r =o |A|"
   5.961 +shows "finite(Field r) = finite A"
   5.962 +using assms card_of_Field_ordIso card_of_ordIso_finite ordIso_equivalence by blast
   5.963 +
   5.964 +
   5.965 +subsection {* Cardinals versus set operations involving infinite sets *}
   5.966 +
   5.967 +
   5.968 +text{* Here we show that, for infinite sets, most set-theoretic constructions
   5.969 +do not increase the cardinality.  The cornerstone for this is
   5.970 +theorem @{text "Card_order_Times_same_infinite"}, which states that self-product
   5.971 +does not increase cardinality -- the proof of this fact adapts a standard
   5.972 +set-theoretic argument, as presented, e.g., in the proof of theorem 1.5.11
   5.973 +at page 47 in \cite{card-book}. Then everything else follows fairly easily.  *}
   5.974 +
   5.975 +
   5.976 +lemma infinite_iff_card_of_nat:
   5.977 +"infinite A = ( |UNIV::nat set| \<le>o |A| )"
   5.978 +by (auto simp add: infinite_iff_countable_subset card_of_ordLeq)
   5.979 +
   5.980 +
   5.981 +lemma finite_iff_cardOf_nat:
   5.982 +"finite A = ( |A| <o |UNIV :: nat set| )"
   5.983 +using infinite_iff_card_of_nat[of A]
   5.984 +not_ordLeq_iff_ordLess[of "|A|" "|UNIV :: nat set|"]
   5.985 +by (fastforce simp: card_of_Well_order)
   5.986 +
   5.987 +lemma finite_ordLess_infinite2:
   5.988 +assumes "finite A" and "infinite B"
   5.989 +shows "|A| <o |B|"
   5.990 +using assms
   5.991 +finite_ordLess_infinite[of "|A|" "|B|"]
   5.992 +card_of_Well_order[of A] card_of_Well_order[of B]
   5.993 +Field_card_of[of A] Field_card_of[of B] by auto
   5.994 +
   5.995 +
   5.996 +text{* The next two results correspond to the ZF fact that all infinite cardinals are
   5.997 +limit ordinals: *}
   5.998 +
   5.999 +lemma Card_order_infinite_not_under:
  5.1000 +assumes CARD: "Card_order r" and INF: "infinite (Field r)"
  5.1001 +shows "\<not> (\<exists>a. Field r = rel.under r a)"
  5.1002 +proof(auto)
  5.1003 +  have 0: "Well_order r \<and> wo_rel r \<and> Refl r"
  5.1004 +  using CARD unfolding wo_rel_def card_order_on_def order_on_defs by auto
  5.1005 +  fix a assume *: "Field r = rel.under r a"
  5.1006 +  show False
  5.1007 +  proof(cases "a \<in> Field r")
  5.1008 +    assume Case1: "a \<notin> Field r"
  5.1009 +    hence "rel.under r a = {}" unfolding Field_def rel.under_def by auto
  5.1010 +    thus False using INF *  by auto
  5.1011 +  next
  5.1012 +    let ?r' = "Restr r (rel.underS r a)"
  5.1013 +    assume Case2: "a \<in> Field r"
  5.1014 +    hence 1: "rel.under r a = rel.underS r a \<union> {a} \<and> a \<notin> rel.underS r a"
  5.1015 +    using 0 rel.Refl_under_underS rel.underS_notIn by fastforce
  5.1016 +    have 2: "wo_rel.ofilter r (rel.underS r a) \<and> rel.underS r a < Field r"
  5.1017 +    using 0 wo_rel.underS_ofilter * 1 Case2 by auto
  5.1018 +    hence "?r' <o r" using 0 using ofilter_ordLess by blast
  5.1019 +    moreover
  5.1020 +    have "Field ?r' = rel.underS r a \<and> Well_order ?r'"
  5.1021 +    using  2 0 Field_Restr_ofilter[of r] Well_order_Restr[of r] by blast
  5.1022 +    ultimately have "|rel.underS r a| <o r" using ordLess_Field[of ?r'] by auto
  5.1023 +    moreover have "|rel.under r a| =o r" using * CARD card_of_Field_ordIso[of r] by auto
  5.1024 +    ultimately have "|rel.underS r a| <o |rel.under r a|"
  5.1025 +    using ordIso_symmetric ordLess_ordIso_trans by blast
  5.1026 +    moreover
  5.1027 +    {have "\<exists>f. bij_betw f (rel.under r a) (rel.underS r a)"
  5.1028 +     using infinite_imp_bij_betw[of "Field r" a] INF * 1 by auto
  5.1029 +     hence "|rel.under r a| =o |rel.underS r a|" using card_of_ordIso by blast
  5.1030 +    }
  5.1031 +    ultimately show False using not_ordLess_ordIso ordIso_symmetric by blast
  5.1032 +  qed
  5.1033 +qed
  5.1034 +
  5.1035 +
  5.1036 +lemma infinite_Card_order_limit:
  5.1037 +assumes r: "Card_order r" and "infinite (Field r)"
  5.1038 +and a: "a : Field r"
  5.1039 +shows "EX b : Field r. a \<noteq> b \<and> (a,b) : r"
  5.1040 +proof-
  5.1041 +  have "Field r \<noteq> rel.under r a"
  5.1042 +  using assms Card_order_infinite_not_under by blast
  5.1043 +  moreover have "rel.under r a \<le> Field r"
  5.1044 +  using rel.under_Field .
  5.1045 +  ultimately have "rel.under r a < Field r" by blast
  5.1046 +  then obtain b where 1: "b : Field r \<and> ~ (b,a) : r"
  5.1047 +  unfolding rel.under_def by blast
  5.1048 +  moreover have ba: "b \<noteq> a"
  5.1049 +  using 1 r unfolding card_order_on_def well_order_on_def
  5.1050 +  linear_order_on_def partial_order_on_def preorder_on_def refl_on_def by auto
  5.1051 +  ultimately have "(a,b) : r"
  5.1052 +  using a r unfolding card_order_on_def well_order_on_def linear_order_on_def
  5.1053 +  total_on_def by blast
  5.1054 +  thus ?thesis using 1 ba by auto
  5.1055 +qed
  5.1056 +
  5.1057 +
  5.1058 +theorem Card_order_Times_same_infinite:
  5.1059 +assumes CO: "Card_order r" and INF: "infinite(Field r)"
  5.1060 +shows "|Field r \<times> Field r| \<le>o r"
  5.1061 +proof-
  5.1062 +  obtain phi where phi_def:
  5.1063 +  "phi = (\<lambda>r::'a rel. Card_order r \<and> infinite(Field r) \<and>
  5.1064 +                      \<not> |Field r \<times> Field r| \<le>o r )" by blast
  5.1065 +  have temp1: "\<forall>r. phi r \<longrightarrow> Well_order r"
  5.1066 +  unfolding phi_def card_order_on_def by auto
  5.1067 +  have Ft: "\<not>(\<exists>r. phi r)"
  5.1068 +  proof
  5.1069 +    assume "\<exists>r. phi r"
  5.1070 +    hence "{r. phi r} \<noteq> {} \<and> {r. phi r} \<le> {r. Well_order r}"
  5.1071 +    using temp1 by auto
  5.1072 +    then obtain r where 1: "phi r" and 2: "\<forall>r'. phi r' \<longrightarrow> r \<le>o r'" and
  5.1073 +                   3: "Card_order r \<and> Well_order r"
  5.1074 +    using exists_minim_Well_order[of "{r. phi r}"] temp1 phi_def by blast
  5.1075 +    let ?A = "Field r"  let ?r' = "bsqr r"
  5.1076 +    have 4: "Well_order ?r' \<and> Field ?r' = ?A \<times> ?A \<and> |?A| =o r"
  5.1077 +    using 3 bsqr_Well_order Field_bsqr card_of_Field_ordIso by blast
  5.1078 +    have 5: "Card_order |?A \<times> ?A| \<and> Well_order |?A \<times> ?A|"
  5.1079 +    using card_of_Card_order card_of_Well_order by blast
  5.1080 +    (*  *)
  5.1081 +    have "r <o |?A \<times> ?A|"
  5.1082 +    using 1 3 5 ordLess_or_ordLeq unfolding phi_def by blast
  5.1083 +    moreover have "|?A \<times> ?A| \<le>o ?r'"
  5.1084 +    using card_of_least[of "?A \<times> ?A"] 4 by auto
  5.1085 +    ultimately have "r <o ?r'" using ordLess_ordLeq_trans by auto
  5.1086 +    then obtain f where 6: "embed r ?r' f" and 7: "\<not> bij_betw f ?A (?A \<times> ?A)"
  5.1087 +    unfolding ordLess_def embedS_def[abs_def]
  5.1088 +    by (auto simp add: Field_bsqr)
  5.1089 +    let ?B = "f ` ?A"
  5.1090 +    have "|?A| =o |?B|"
  5.1091 +    using 3 6 embed_inj_on inj_on_imp_bij_betw card_of_ordIso by blast
  5.1092 +    hence 8: "r =o |?B|" using 4 ordIso_transitive ordIso_symmetric by blast
  5.1093 +    (*  *)
  5.1094 +    have "wo_rel.ofilter ?r' ?B"
  5.1095 +    using 6 embed_Field_ofilter 3 4 by blast
  5.1096 +    hence "wo_rel.ofilter ?r' ?B \<and> ?B \<noteq> ?A \<times> ?A \<and> ?B \<noteq> Field ?r'"
  5.1097 +    using 7 unfolding bij_betw_def using 6 3 embed_inj_on 4 by auto
  5.1098 +    hence temp2: "wo_rel.ofilter ?r' ?B \<and> ?B < ?A \<times> ?A"
  5.1099 +    using 4 wo_rel_def[of ?r'] wo_rel.ofilter_def[of ?r' ?B] by blast
  5.1100 +    have "\<not> (\<exists>a. Field r = rel.under r a)"
  5.1101 +    using 1 unfolding phi_def using Card_order_infinite_not_under[of r] by auto
  5.1102 +    then obtain A1 where temp3: "wo_rel.ofilter r A1 \<and> A1 < ?A" and 9: "?B \<le> A1 \<times> A1"
  5.1103 +    using temp2 3 bsqr_ofilter[of r ?B] by blast
  5.1104 +    hence "|?B| \<le>o |A1 \<times> A1|" using card_of_mono1 by blast
  5.1105 +    hence 10: "r \<le>o |A1 \<times> A1|" using 8 ordIso_ordLeq_trans by blast
  5.1106 +    let ?r1 = "Restr r A1"
  5.1107 +    have "?r1 <o r" using temp3 ofilter_ordLess 3 by blast
  5.1108 +    moreover
  5.1109 +    {have "well_order_on A1 ?r1" using 3 temp3 well_order_on_Restr by blast
  5.1110 +     hence "|A1| \<le>o ?r1" using 3 Well_order_Restr card_of_least by blast
  5.1111 +    }
  5.1112 +    ultimately have 11: "|A1| <o r" using ordLeq_ordLess_trans by blast
  5.1113 +    (*  *)
  5.1114 +    have "infinite (Field r)" using 1 unfolding phi_def by simp
  5.1115 +    hence "infinite ?B" using 8 3 card_of_ordIso_finite_Field[of r ?B] by blast
  5.1116 +    hence "infinite A1" using 9 infinite_super finite_cartesian_product by blast
  5.1117 +    moreover have temp4: "Field |A1| = A1 \<and> Well_order |A1| \<and> Card_order |A1|"
  5.1118 +    using card_of_Card_order[of A1] card_of_Well_order[of A1]
  5.1119 +    by (simp add: Field_card_of)
  5.1120 +    moreover have "\<not> r \<le>o | A1 |"
  5.1121 +    using temp4 11 3 using not_ordLeq_iff_ordLess by blast
  5.1122 +    ultimately have "infinite(Field |A1| ) \<and> Card_order |A1| \<and> \<not> r \<le>o | A1 |"
  5.1123 +    by (simp add: card_of_card_order_on)
  5.1124 +    hence "|Field |A1| \<times> Field |A1| | \<le>o |A1|"
  5.1125 +    using 2 unfolding phi_def by blast
  5.1126 +    hence "|A1 \<times> A1 | \<le>o |A1|" using temp4 by auto
  5.1127 +    hence "r \<le>o |A1|" using 10 ordLeq_transitive by blast
  5.1128 +    thus False using 11 not_ordLess_ordLeq by auto
  5.1129 +  qed
  5.1130 +  thus ?thesis using assms unfolding phi_def by blast
  5.1131 +qed
  5.1132 +
  5.1133 +
  5.1134 +corollary card_of_Times_same_infinite:
  5.1135 +assumes "infinite A"
  5.1136 +shows "|A \<times> A| =o |A|"
  5.1137 +proof-
  5.1138 +  let ?r = "|A|"
  5.1139 +  have "Field ?r = A \<and> Card_order ?r"
  5.1140 +  using Field_card_of card_of_Card_order[of A] by fastforce
  5.1141 +  hence "|A \<times> A| \<le>o |A|"
  5.1142 +  using Card_order_Times_same_infinite[of ?r] assms by auto
  5.1143 +  thus ?thesis using card_of_Times3 ordIso_iff_ordLeq by blast
  5.1144 +qed
  5.1145 +
  5.1146 +
  5.1147 +lemma card_of_Times_infinite:
  5.1148 +assumes INF: "infinite A" and NE: "B \<noteq> {}" and LEQ: "|B| \<le>o |A|"
  5.1149 +shows "|A \<times> B| =o |A| \<and> |B \<times> A| =o |A|"
  5.1150 +proof-
  5.1151 +  have "|A| \<le>o |A \<times> B| \<and> |A| \<le>o |B \<times> A|"
  5.1152 +  using assms by (simp add: card_of_Times1 card_of_Times2)
  5.1153 +  moreover
  5.1154 +  {have "|A \<times> B| \<le>o |A \<times> A| \<and> |B \<times> A| \<le>o |A \<times> A|"
  5.1155 +   using LEQ card_of_Times_mono1 card_of_Times_mono2 by blast
  5.1156 +   moreover have "|A \<times> A| =o |A|" using INF card_of_Times_same_infinite by blast
  5.1157 +   ultimately have "|A \<times> B| \<le>o |A| \<and> |B \<times> A| \<le>o |A|"
  5.1158 +   using ordLeq_ordIso_trans[of "|A \<times> B|"] ordLeq_ordIso_trans[of "|B \<times> A|"] by auto
  5.1159 +  }
  5.1160 +  ultimately show ?thesis by (simp add: ordIso_iff_ordLeq)
  5.1161 +qed
  5.1162 +
  5.1163 +
  5.1164 +corollary card_of_Times_infinite_simps:
  5.1165 +"\<lbrakk>infinite A; B \<noteq> {}; |B| \<le>o |A|\<rbrakk> \<Longrightarrow> |A \<times> B| =o |A|"
  5.1166 +"\<lbrakk>infinite A; B \<noteq> {}; |B| \<le>o |A|\<rbrakk> \<Longrightarrow> |A| =o |A \<times> B|"
  5.1167 +"\<lbrakk>infinite A; B \<noteq> {}; |B| \<le>o |A|\<rbrakk> \<Longrightarrow> |B \<times> A| =o |A|"
  5.1168 +"\<lbrakk>infinite A; B \<noteq> {}; |B| \<le>o |A|\<rbrakk> \<Longrightarrow> |A| =o |B \<times> A|"
  5.1169 +by (auto simp add: card_of_Times_infinite ordIso_symmetric)
  5.1170 +
  5.1171 +
  5.1172 +corollary Card_order_Times_infinite:
  5.1173 +assumes INF: "infinite(Field r)" and CARD: "Card_order r" and
  5.1174 +        NE: "Field p \<noteq> {}" and LEQ: "p \<le>o r"
  5.1175 +shows "| (Field r) \<times> (Field p) | =o r \<and> | (Field p) \<times> (Field r) | =o r"
  5.1176 +proof-
  5.1177 +  have "|Field r \<times> Field p| =o |Field r| \<and> |Field p \<times> Field r| =o |Field r|"
  5.1178 +  using assms by (simp add: card_of_Times_infinite card_of_mono2)
  5.1179 +  thus ?thesis
  5.1180 +  using assms card_of_Field_ordIso[of r]
  5.1181 +        ordIso_transitive[of "|Field r \<times> Field p|"]
  5.1182 +        ordIso_transitive[of _ "|Field r|"] by blast
  5.1183 +qed
  5.1184 +
  5.1185 +
  5.1186 +lemma card_of_Sigma_ordLeq_infinite:
  5.1187 +assumes INF: "infinite B" and
  5.1188 +        LEQ_I: "|I| \<le>o |B|" and LEQ: "\<forall>i \<in> I. |A i| \<le>o |B|"
  5.1189 +shows "|SIGMA i : I. A i| \<le>o |B|"
  5.1190 +proof(cases "I = {}", simp add: card_of_empty)
  5.1191 +  assume *: "I \<noteq> {}"
  5.1192 +  have "|SIGMA i : I. A i| \<le>o |I \<times> B|"
  5.1193 +  using LEQ card_of_Sigma_Times by blast
  5.1194 +  moreover have "|I \<times> B| =o |B|"
  5.1195 +  using INF * LEQ_I by (auto simp add: card_of_Times_infinite)
  5.1196 +  ultimately show ?thesis using ordLeq_ordIso_trans by blast
  5.1197 +qed
  5.1198 +
  5.1199 +
  5.1200 +lemma card_of_Sigma_ordLeq_infinite_Field:
  5.1201 +assumes INF: "infinite (Field r)" and r: "Card_order r" and
  5.1202 +        LEQ_I: "|I| \<le>o r" and LEQ: "\<forall>i \<in> I. |A i| \<le>o r"
  5.1203 +shows "|SIGMA i : I. A i| \<le>o r"
  5.1204 +proof-
  5.1205 +  let ?B  = "Field r"
  5.1206 +  have 1: "r =o |?B| \<and> |?B| =o r" using r card_of_Field_ordIso
  5.1207 +  ordIso_symmetric by blast
  5.1208 +  hence "|I| \<le>o |?B|"  "\<forall>i \<in> I. |A i| \<le>o |?B|"
  5.1209 +  using LEQ_I LEQ ordLeq_ordIso_trans by blast+
  5.1210 +  hence  "|SIGMA i : I. A i| \<le>o |?B|" using INF LEQ
  5.1211 +  card_of_Sigma_ordLeq_infinite by blast
  5.1212 +  thus ?thesis using 1 ordLeq_ordIso_trans by blast
  5.1213 +qed
  5.1214 +
  5.1215 +
  5.1216 +lemma card_of_Times_ordLeq_infinite_Field:
  5.1217 +"\<lbrakk>infinite (Field r); |A| \<le>o r; |B| \<le>o r; Card_order r\<rbrakk>
  5.1218 + \<Longrightarrow> |A <*> B| \<le>o r"
  5.1219 +by(simp add: card_of_Sigma_ordLeq_infinite_Field)
  5.1220 +
  5.1221 +
  5.1222 +lemma card_of_UNION_ordLeq_infinite:
  5.1223 +assumes INF: "infinite B" and
  5.1224 +        LEQ_I: "|I| \<le>o |B|" and LEQ: "\<forall>i \<in> I. |A i| \<le>o |B|"
  5.1225 +shows "|\<Union> i \<in> I. A i| \<le>o |B|"
  5.1226 +proof(cases "I = {}", simp add: card_of_empty)
  5.1227 +  assume *: "I \<noteq> {}"
  5.1228 +  have "|\<Union> i \<in> I. A i| \<le>o |SIGMA i : I. A i|"
  5.1229 +  using card_of_UNION_Sigma by blast
  5.1230 +  moreover have "|SIGMA i : I. A i| \<le>o |B|"
  5.1231 +  using assms card_of_Sigma_ordLeq_infinite by blast
  5.1232 +  ultimately show ?thesis using ordLeq_transitive by blast
  5.1233 +qed
  5.1234 +
  5.1235 +
  5.1236 +corollary card_of_UNION_ordLeq_infinite_Field:
  5.1237 +assumes INF: "infinite (Field r)" and r: "Card_order r" and
  5.1238 +        LEQ_I: "|I| \<le>o r" and LEQ: "\<forall>i \<in> I. |A i| \<le>o r"
  5.1239 +shows "|\<Union> i \<in> I. A i| \<le>o r"
  5.1240 +proof-
  5.1241 +  let ?B  = "Field r"
  5.1242 +  have 1: "r =o |?B| \<and> |?B| =o r" using r card_of_Field_ordIso
  5.1243 +  ordIso_symmetric by blast
  5.1244 +  hence "|I| \<le>o |?B|"  "\<forall>i \<in> I. |A i| \<le>o |?B|"
  5.1245 +  using LEQ_I LEQ ordLeq_ordIso_trans by blast+
  5.1246 +  hence  "|\<Union> i \<in> I. A i| \<le>o |?B|" using INF LEQ
  5.1247 +  card_of_UNION_ordLeq_infinite by blast
  5.1248 +  thus ?thesis using 1 ordLeq_ordIso_trans by blast
  5.1249 +qed
  5.1250 +
  5.1251 +
  5.1252 +lemma card_of_Plus_infinite1:
  5.1253 +assumes INF: "infinite A" and LEQ: "|B| \<le>o |A|"
  5.1254 +shows "|A <+> B| =o |A|"
  5.1255 +proof(cases "B = {}", simp add: card_of_Plus_empty1 card_of_Plus_empty2 ordIso_symmetric)
  5.1256 +  let ?Inl = "Inl::'a \<Rightarrow> 'a + 'b"  let ?Inr = "Inr::'b \<Rightarrow> 'a + 'b"
  5.1257 +  assume *: "B \<noteq> {}"
  5.1258 +  then obtain b1 where 1: "b1 \<in> B" by blast
  5.1259 +  show ?thesis
  5.1260 +  proof(cases "B = {b1}")
  5.1261 +    assume Case1: "B = {b1}"
  5.1262 +    have 2: "bij_betw ?Inl A ((?Inl ` A))"
  5.1263 +    unfolding bij_betw_def inj_on_def by auto
  5.1264 +    hence 3: "infinite (?Inl ` A)"
  5.1265 +    using INF bij_betw_finite[of ?Inl A] by blast
  5.1266 +    let ?A' = "?Inl ` A \<union> {?Inr b1}"
  5.1267 +    obtain g where "bij_betw g (?Inl ` A) ?A'"
  5.1268 +    using 3 infinite_imp_bij_betw2[of "?Inl ` A"] by auto
  5.1269 +    moreover have "?A' = A <+> B" using Case1 by blast
  5.1270 +    ultimately have "bij_betw g (?Inl ` A) (A <+> B)" by simp
  5.1271 +    hence "bij_betw (g o ?Inl) A (A <+> B)"
  5.1272 +    using 2 by (auto simp add: bij_betw_trans)
  5.1273 +    thus ?thesis using card_of_ordIso ordIso_symmetric by blast
  5.1274 +  next
  5.1275 +    assume Case2: "B \<noteq> {b1}"
  5.1276 +    with * 1 obtain b2 where 3: "b1 \<noteq> b2 \<and> {b1,b2} \<le> B" by fastforce
  5.1277 +    obtain f where "inj_on f B \<and> f ` B \<le> A"
  5.1278 +    using LEQ card_of_ordLeq[of B] by fastforce
  5.1279 +    with 3 have "f b1 \<noteq> f b2 \<and> {f b1, f b2} \<le> A"
  5.1280 +    unfolding inj_on_def by auto
  5.1281 +    with 3 have "|A <+> B| \<le>o |A \<times> B|"
  5.1282 +    by (auto simp add: card_of_Plus_Times)
  5.1283 +    moreover have "|A \<times> B| =o |A|"
  5.1284 +    using assms * by (simp add: card_of_Times_infinite_simps)
  5.1285 +    ultimately have "|A <+> B| \<le>o |A|" using ordLeq_ordIso_trans by metis
  5.1286 +    thus ?thesis using card_of_Plus1 ordIso_iff_ordLeq by blast
  5.1287 +  qed
  5.1288 +qed
  5.1289 +
  5.1290 +
  5.1291 +lemma card_of_Plus_infinite2:
  5.1292 +assumes INF: "infinite A" and LEQ: "|B| \<le>o |A|"
  5.1293 +shows "|B <+> A| =o |A|"
  5.1294 +using assms card_of_Plus_commute card_of_Plus_infinite1
  5.1295 +ordIso_equivalence by blast
  5.1296 +
  5.1297 +
  5.1298 +lemma card_of_Plus_infinite:
  5.1299 +assumes INF: "infinite A" and LEQ: "|B| \<le>o |A|"
  5.1300 +shows "|A <+> B| =o |A| \<and> |B <+> A| =o |A|"
  5.1301 +using assms by (auto simp: card_of_Plus_infinite1 card_of_Plus_infinite2)
  5.1302 +
  5.1303 +
  5.1304 +corollary Card_order_Plus_infinite:
  5.1305 +assumes INF: "infinite(Field r)" and CARD: "Card_order r" and
  5.1306 +        LEQ: "p \<le>o r"
  5.1307 +shows "| (Field r) <+> (Field p) | =o r \<and> | (Field p) <+> (Field r) | =o r"
  5.1308 +proof-
  5.1309 +  have "| Field r <+> Field p | =o | Field r | \<and>
  5.1310 +        | Field p <+> Field r | =o | Field r |"
  5.1311 +  using assms by (simp add: card_of_Plus_infinite card_of_mono2)
  5.1312 +  thus ?thesis
  5.1313 +  using assms card_of_Field_ordIso[of r]
  5.1314 +        ordIso_transitive[of "|Field r <+> Field p|"]
  5.1315 +        ordIso_transitive[of _ "|Field r|"] by blast
  5.1316 +qed
  5.1317 +
  5.1318 +
  5.1319 +lemma card_of_Un_infinite:
  5.1320 +assumes INF: "infinite A" and LEQ: "|B| \<le>o |A|"
  5.1321 +shows "|A \<union> B| =o |A| \<and> |B \<union> A| =o |A|"
  5.1322 +proof-
  5.1323 +  have "|A \<union> B| \<le>o |A <+> B|" by (rule card_of_Un_Plus_ordLeq)
  5.1324 +  moreover have "|A <+> B| =o |A|"
  5.1325 +  using assms by (metis card_of_Plus_infinite)
  5.1326 +  ultimately have "|A \<union> B| \<le>o |A|" using ordLeq_ordIso_trans by blast
  5.1327 +  hence "|A \<union> B| =o |A|" using card_of_Un1 ordIso_iff_ordLeq by blast
  5.1328 +  thus ?thesis using Un_commute[of B A] by auto
  5.1329 +qed
  5.1330 +
  5.1331 +
  5.1332 +lemma card_of_Un_diff_infinite:
  5.1333 +assumes INF: "infinite A" and LESS: "|B| <o |A|"
  5.1334 +shows "|A - B| =o |A|"
  5.1335 +proof-
  5.1336 +  obtain C where C_def: "C = A - B" by blast
  5.1337 +  have "|A \<union> B| =o |A|"
  5.1338 +  using assms ordLeq_iff_ordLess_or_ordIso card_of_Un_infinite by blast
  5.1339 +  moreover have "C \<union> B = A \<union> B" unfolding C_def by auto
  5.1340 +  ultimately have 1: "|C \<union> B| =o |A|" by auto
  5.1341 +  (*  *)
  5.1342 +  {assume *: "|C| \<le>o |B|"
  5.1343 +   moreover
  5.1344 +   {assume **: "finite B"
  5.1345 +    hence "finite C"
  5.1346 +    using card_of_ordLeq_finite * by blast
  5.1347 +    hence False using ** INF card_of_ordIso_finite 1 by blast
  5.1348 +   }
  5.1349 +   hence "infinite B" by auto
  5.1350 +   ultimately have False
  5.1351 +   using card_of_Un_infinite 1 ordIso_equivalence(1,3) LESS not_ordLess_ordIso by metis
  5.1352 +  }
  5.1353 +  hence 2: "|B| \<le>o |C|" using card_of_Well_order ordLeq_total by blast
  5.1354 +  {assume *: "finite C"
  5.1355 +    hence "finite B" using card_of_ordLeq_finite 2 by blast
  5.1356 +    hence False using * INF card_of_ordIso_finite 1 by blast
  5.1357 +  }
  5.1358 +  hence "infinite C" by auto
  5.1359 +  hence "|C| =o |A|"
  5.1360 +  using  card_of_Un_infinite 1 2 ordIso_equivalence(1,3) by metis
  5.1361 +  thus ?thesis unfolding C_def .
  5.1362 +qed
  5.1363 +
  5.1364 +
  5.1365 +lemma card_of_Plus_ordLess_infinite:
  5.1366 +assumes INF: "infinite C" and
  5.1367 +        LESS1: "|A| <o |C|" and LESS2: "|B| <o |C|"
  5.1368 +shows "|A <+> B| <o |C|"
  5.1369 +proof(cases "A = {} \<or> B = {}")
  5.1370 +  assume Case1: "A = {} \<or> B = {}"
  5.1371 +  hence "|A| =o |A <+> B| \<or> |B| =o |A <+> B|"
  5.1372 +  using card_of_Plus_empty1 card_of_Plus_empty2 by blast
  5.1373 +  hence "|A <+> B| =o |A| \<or> |A <+> B| =o |B|"
  5.1374 +  using ordIso_symmetric[of "|A|"] ordIso_symmetric[of "|B|"] by blast
  5.1375 +  thus ?thesis using LESS1 LESS2
  5.1376 +       ordIso_ordLess_trans[of "|A <+> B|" "|A|"]
  5.1377 +       ordIso_ordLess_trans[of "|A <+> B|" "|B|"] by blast
  5.1378 +next
  5.1379 +  assume Case2: "\<not>(A = {} \<or> B = {})"
  5.1380 +  {assume *: "|C| \<le>o |A <+> B|"
  5.1381 +   hence "infinite (A <+> B)" using INF card_of_ordLeq_finite by blast
  5.1382 +   hence 1: "infinite A \<or> infinite B" using finite_Plus by blast
  5.1383 +   {assume Case21: "|A| \<le>o |B|"
  5.1384 +    hence "infinite B" using 1 card_of_ordLeq_finite by blast
  5.1385 +    hence "|A <+> B| =o |B|" using Case2 Case21
  5.1386 +    by (auto simp add: card_of_Plus_infinite)
  5.1387 +    hence False using LESS2 not_ordLess_ordLeq * ordLeq_ordIso_trans by blast
  5.1388 +   }
  5.1389 +   moreover
  5.1390 +   {assume Case22: "|B| \<le>o |A|"
  5.1391 +    hence "infinite A" using 1 card_of_ordLeq_finite by blast
  5.1392 +    hence "|A <+> B| =o |A|" using Case2 Case22
  5.1393 +    by (auto simp add: card_of_Plus_infinite)
  5.1394 +    hence False using LESS1 not_ordLess_ordLeq * ordLeq_ordIso_trans by blast
  5.1395 +   }
  5.1396 +   ultimately have False using ordLeq_total card_of_Well_order[of A]
  5.1397 +   card_of_Well_order[of B] by blast
  5.1398 +  }
  5.1399 +  thus ?thesis using ordLess_or_ordLeq[of "|A <+> B|" "|C|"]
  5.1400 +  card_of_Well_order[of "A <+> B"] card_of_Well_order[of "C"] by auto
  5.1401 +qed
  5.1402 +
  5.1403 +
  5.1404 +lemma card_of_Plus_ordLess_infinite_Field:
  5.1405 +assumes INF: "infinite (Field r)" and r: "Card_order r" and
  5.1406 +        LESS1: "|A| <o r" and LESS2: "|B| <o r"
  5.1407 +shows "|A <+> B| <o r"
  5.1408 +proof-
  5.1409 +  let ?C  = "Field r"
  5.1410 +  have 1: "r =o |?C| \<and> |?C| =o r" using r card_of_Field_ordIso
  5.1411 +  ordIso_symmetric by blast
  5.1412 +  hence "|A| <o |?C|"  "|B| <o |?C|"
  5.1413 +  using LESS1 LESS2 ordLess_ordIso_trans by blast+
  5.1414 +  hence  "|A <+> B| <o |?C|" using INF
  5.1415 +  card_of_Plus_ordLess_infinite by blast
  5.1416 +  thus ?thesis using 1 ordLess_ordIso_trans by blast
  5.1417 +qed
  5.1418 +
  5.1419 +
  5.1420 +lemma infinite_card_of_insert:
  5.1421 +assumes "infinite A"
  5.1422 +shows "|insert a A| =o |A|"
  5.1423 +proof-
  5.1424 +  have iA: "insert a A = A \<union> {a}" by simp
  5.1425 +  show ?thesis
  5.1426 +  using infinite_imp_bij_betw2[OF assms] unfolding iA
  5.1427 +  by (metis bij_betw_inv card_of_ordIso)
  5.1428 +qed
  5.1429 +
  5.1430 +
  5.1431 +subsection {* Cardinals versus lists  *}
  5.1432 +
  5.1433 +
  5.1434 +text{* The next is an auxiliary operator, which shall be used for inductive
  5.1435 +proofs of facts concerning the cardinality of @{text "List"} : *}
  5.1436 +
  5.1437 +definition nlists :: "'a set \<Rightarrow> nat \<Rightarrow> 'a list set"
  5.1438 +where "nlists A n \<equiv> {l. set l \<le> A \<and> length l = n}"
  5.1439 +
  5.1440 +
  5.1441 +lemma lists_def2: "lists A = {l. set l \<le> A}"
  5.1442 +using in_listsI by blast
  5.1443 +
  5.1444 +
  5.1445 +lemma lists_UNION_nlists: "lists A = (\<Union> n. nlists A n)"
  5.1446 +unfolding lists_def2 nlists_def by blast
  5.1447 +
  5.1448 +
  5.1449 +lemma card_of_lists: "|A| \<le>o |lists A|"
  5.1450 +proof-
  5.1451 +  let ?h = "\<lambda> a. [a]"
  5.1452 +  have "inj_on ?h A \<and> ?h ` A \<le> lists A"
  5.1453 +  unfolding inj_on_def lists_def2 by auto
  5.1454 +  thus ?thesis by (metis card_of_ordLeq)
  5.1455 +qed
  5.1456 +
  5.1457 +
  5.1458 +lemma nlists_0: "nlists A 0 = {[]}"
  5.1459 +unfolding nlists_def by auto
  5.1460 +
  5.1461 +
  5.1462 +lemma nlists_not_empty:
  5.1463 +assumes "A \<noteq> {}"
  5.1464 +shows "nlists A n \<noteq> {}"
  5.1465 +proof(induct n, simp add: nlists_0)
  5.1466 +  fix n assume "nlists A n \<noteq> {}"
  5.1467 +  then obtain a and l where "a \<in> A \<and> l \<in> nlists A n" using assms by auto
  5.1468 +  hence "a # l \<in> nlists A (Suc n)" unfolding nlists_def by auto
  5.1469 +  thus "nlists A (Suc n) \<noteq> {}" by auto
  5.1470 +qed
  5.1471 +
  5.1472 +
  5.1473 +lemma Nil_in_lists: "[] \<in> lists A"
  5.1474 +unfolding lists_def2 by auto
  5.1475 +
  5.1476 +
  5.1477 +lemma lists_not_empty: "lists A \<noteq> {}"
  5.1478 +using Nil_in_lists by blast
  5.1479 +
  5.1480 +
  5.1481 +lemma card_of_nlists_Succ: "|nlists A (Suc n)| =o |A \<times> (nlists A n)|"
  5.1482 +proof-
  5.1483 +  let ?B = "A \<times> (nlists A n)"   let ?h = "\<lambda>(a,l). a # l"
  5.1484 +  have "inj_on ?h ?B \<and> ?h ` ?B \<le> nlists A (Suc n)"
  5.1485 +  unfolding inj_on_def nlists_def by auto
  5.1486 +  moreover have "nlists A (Suc n) \<le> ?h ` ?B"
  5.1487 +  proof(auto)
  5.1488 +    fix l assume "l \<in> nlists A (Suc n)"
  5.1489 +    hence 1: "length l = Suc n \<and> set l \<le> A" unfolding nlists_def by auto
  5.1490 +    then obtain a and l' where 2: "l = a # l'" by (auto simp: length_Suc_conv)
  5.1491 +    hence "a \<in> A \<and> set l' \<le> A \<and> length l' = n" using 1 by auto
  5.1492 +    thus "l \<in> ?h ` ?B"  using 2 unfolding nlists_def by auto
  5.1493 +  qed
  5.1494 +  ultimately have "bij_betw ?h ?B (nlists A (Suc n))"
  5.1495 +  unfolding bij_betw_def by auto
  5.1496 +  thus ?thesis using card_of_ordIso ordIso_symmetric by blast
  5.1497 +qed
  5.1498 +
  5.1499 +
  5.1500 +lemma card_of_nlists_infinite:
  5.1501 +assumes "infinite A"
  5.1502 +shows "|nlists A n| \<le>o |A|"
  5.1503 +proof(induct n)
  5.1504 +  have "A \<noteq> {}" using assms by auto
  5.1505 +  thus "|nlists A 0| \<le>o |A|" by (simp add: nlists_0 card_of_singl_ordLeq)
  5.1506 +next
  5.1507 +  fix n assume IH: "|nlists A n| \<le>o |A|"
  5.1508 +  have "|nlists A (Suc n)| =o |A \<times> (nlists A n)|"
  5.1509 +  using card_of_nlists_Succ by blast
  5.1510 +  moreover
  5.1511 +  {have "nlists A n \<noteq> {}" using assms nlists_not_empty[of A] by blast
  5.1512 +   hence "|A \<times> (nlists A n)| =o |A|"
  5.1513 +   using assms IH by (auto simp add: card_of_Times_infinite)
  5.1514 +  }
  5.1515 +  ultimately show "|nlists A (Suc n)| \<le>o |A|"
  5.1516 +  using ordIso_transitive ordIso_iff_ordLeq by blast
  5.1517 +qed
  5.1518 +
  5.1519 +
  5.1520 +lemma card_of_lists_infinite:
  5.1521 +assumes "infinite A"
  5.1522 +shows "|lists A| =o |A|"
  5.1523 +proof-
  5.1524 +  have "|lists A| \<le>o |A|"
  5.1525 +  using assms
  5.1526 +  by (auto simp add: lists_UNION_nlists card_of_UNION_ordLeq_infinite
  5.1527 +                     infinite_iff_card_of_nat card_of_nlists_infinite)
  5.1528 +  thus ?thesis using card_of_lists ordIso_iff_ordLeq by blast
  5.1529 +qed
  5.1530 +
  5.1531 +
  5.1532 +lemma Card_order_lists_infinite:
  5.1533 +assumes "Card_order r" and "infinite(Field r)"
  5.1534 +shows "|lists(Field r)| =o r"
  5.1535 +using assms card_of_lists_infinite card_of_Field_ordIso ordIso_transitive by blast
  5.1536 +
  5.1537 +
  5.1538 +
  5.1539 +subsection {* The cardinal $\omega$ and the finite cardinals  *}
  5.1540 +
  5.1541 +
  5.1542 +text{* The cardinal $\omega$, of natural numbers, shall be the standard non-strict
  5.1543 +order relation on
  5.1544 +@{text "nat"}, that we abbreviate by @{text "natLeq"}.  The finite cardinals
  5.1545 +shall be the restrictions of these relations to the numbers smaller than
  5.1546 +fixed numbers @{text "n"}, that we abbreviate by @{text "natLeq_on n"}.  *}
  5.1547 +
  5.1548 +abbreviation "(natLeq::(nat * nat) set) \<equiv> {(x,y). x \<le> y}"
  5.1549 +abbreviation "(natLess::(nat * nat) set) \<equiv> {(x,y). x < y}"
  5.1550 +
  5.1551 +abbreviation natLeq_on :: "nat \<Rightarrow> (nat * nat) set"
  5.1552 +where "natLeq_on n \<equiv> {(x,y). x < n \<and> y < n \<and> x \<le> y}"
  5.1553 +
  5.1554 +lemma infinite_cartesian_product:
  5.1555 +assumes "infinite A" "infinite B"
  5.1556 +shows "infinite (A \<times> B)"
  5.1557 +proof
  5.1558 +  assume "finite (A \<times> B)"
  5.1559 +  from assms(1) have "A \<noteq> {}" by auto
  5.1560 +  with `finite (A \<times> B)` have "finite B" using finite_cartesian_productD2 by auto
  5.1561 +  with assms(2) show False by simp
  5.1562 +qed
  5.1563 +
  5.1564 +
  5.1565 +
  5.1566 +subsubsection {* First as well-orders *}
  5.1567 +
  5.1568 +
  5.1569 +lemma Field_natLeq: "Field natLeq = (UNIV::nat set)"
  5.1570 +by(unfold Field_def, auto)
  5.1571 +
  5.1572 +
  5.1573 +lemma natLeq_Refl: "Refl natLeq"
  5.1574 +unfolding refl_on_def Field_def by auto
  5.1575 +
  5.1576 +
  5.1577 +lemma natLeq_trans: "trans natLeq"
  5.1578 +unfolding trans_def by auto
  5.1579 +
  5.1580 +
  5.1581 +lemma natLeq_Preorder: "Preorder natLeq"
  5.1582 +unfolding preorder_on_def
  5.1583 +by (auto simp add: natLeq_Refl natLeq_trans)
  5.1584 +
  5.1585 +
  5.1586 +lemma natLeq_antisym: "antisym natLeq"
  5.1587 +unfolding antisym_def by auto
  5.1588 +
  5.1589 +
  5.1590 +lemma natLeq_Partial_order: "Partial_order natLeq"
  5.1591 +unfolding partial_order_on_def
  5.1592 +by (auto simp add: natLeq_Preorder natLeq_antisym)
  5.1593 +
  5.1594 +
  5.1595 +lemma natLeq_Total: "Total natLeq"
  5.1596 +unfolding total_on_def by auto
  5.1597 +
  5.1598 +
  5.1599 +lemma natLeq_Linear_order: "Linear_order natLeq"
  5.1600 +unfolding linear_order_on_def
  5.1601 +by (auto simp add: natLeq_Partial_order natLeq_Total)
  5.1602 +
  5.1603 +
  5.1604 +lemma natLeq_natLess_Id: "natLess = natLeq - Id"
  5.1605 +by auto
  5.1606 +
  5.1607 +
  5.1608 +lemma natLeq_Well_order: "Well_order natLeq"
  5.1609 +unfolding well_order_on_def
  5.1610 +using natLeq_Linear_order wf_less natLeq_natLess_Id by auto
  5.1611 +
  5.1612 +
  5.1613 +corollary natLeq_well_order_on: "well_order_on UNIV natLeq"
  5.1614 +using natLeq_Well_order Field_natLeq by auto
  5.1615 +
  5.1616 +
  5.1617 +lemma natLeq_wo_rel: "wo_rel natLeq"
  5.1618 +unfolding wo_rel_def using natLeq_Well_order .
  5.1619 +
  5.1620 +
  5.1621 +lemma natLeq_UNIV_ofilter: "wo_rel.ofilter natLeq UNIV"
  5.1622 +using natLeq_wo_rel Field_natLeq wo_rel.Field_ofilter[of natLeq] by auto
  5.1623 +
  5.1624 +
  5.1625 +lemma closed_nat_set_iff:
  5.1626 +assumes "\<forall>(m::nat) n. n \<in> A \<and> m \<le> n \<longrightarrow> m \<in> A"
  5.1627 +shows "A = UNIV \<or> (\<exists>n. A = {0 ..< n})"
  5.1628 +proof-
  5.1629 +  {assume "A \<noteq> UNIV" hence "\<exists>n. n \<notin> A" by blast
  5.1630 +   moreover obtain n where n_def: "n = (LEAST n. n \<notin> A)" by blast
  5.1631 +   ultimately have 1: "n \<notin> A \<and> (\<forall>m. m < n \<longrightarrow> m \<in> A)"
  5.1632 +   using LeastI_ex[of "\<lambda> n. n \<notin> A"] n_def Least_le[of "\<lambda> n. n \<notin> A"] by fastforce
  5.1633 +   have "A = {0 ..< n}"
  5.1634 +   proof(auto simp add: 1)
  5.1635 +     fix m assume *: "m \<in> A"
  5.1636 +     {assume "n \<le> m" with assms * have "n \<in> A" by blast
  5.1637 +      hence False using 1 by auto
  5.1638 +     }
  5.1639 +     thus "m < n" by fastforce
  5.1640 +   qed
  5.1641 +   hence "\<exists>n. A = {0 ..< n}" by blast
  5.1642 +  }
  5.1643 +  thus ?thesis by blast
  5.1644 +qed
  5.1645 +
  5.1646 +
  5.1647 +lemma Field_natLeq_on: "Field (natLeq_on n) = {0 ..< n}"
  5.1648 +unfolding Field_def by auto
  5.1649 +
  5.1650 +
  5.1651 +lemma natLeq_underS_less: "rel.underS natLeq n = {0 ..< n}"
  5.1652 +unfolding rel.underS_def by auto
  5.1653 +
  5.1654 +
  5.1655 +lemma Restr_natLeq: "Restr natLeq {0 ..< n} = natLeq_on n"
  5.1656 +by auto
  5.1657 +
  5.1658 +
  5.1659 +lemma Restr_natLeq2:
  5.1660 +"Restr natLeq (rel.underS natLeq n) = natLeq_on n"
  5.1661 +by (auto simp add: Restr_natLeq natLeq_underS_less)
  5.1662 +
  5.1663 +
  5.1664 +lemma natLeq_on_Well_order: "Well_order(natLeq_on n)"
  5.1665 +using Restr_natLeq[of n] natLeq_Well_order
  5.1666 +      Well_order_Restr[of natLeq "{0..<n}"] by auto
  5.1667 +
  5.1668 +
  5.1669 +corollary natLeq_on_well_order_on: "well_order_on {0 ..< n} (natLeq_on n)"
  5.1670 +using natLeq_on_Well_order Field_natLeq_on by auto
  5.1671 +
  5.1672 +
  5.1673 +lemma natLeq_on_wo_rel: "wo_rel(natLeq_on n)"
  5.1674 +unfolding wo_rel_def using natLeq_on_Well_order .
  5.1675 +
  5.1676 +
  5.1677 +lemma natLeq_on_ofilter_less_eq:
  5.1678 +"n \<le> m \<Longrightarrow> wo_rel.ofilter (natLeq_on m) {0 ..< n}"
  5.1679 +by (auto simp add: natLeq_on_wo_rel wo_rel.ofilter_def,
  5.1680 +    simp add: Field_natLeq_on, unfold rel.under_def, auto)
  5.1681 +
  5.1682 +
  5.1683 +lemma natLeq_on_ofilter_iff:
  5.1684 +"wo_rel.ofilter (natLeq_on m) A = (\<exists>n \<le> m. A = {0 ..< n})"
  5.1685 +proof(rule iffI)
  5.1686 +  assume *: "wo_rel.ofilter (natLeq_on m) A"
  5.1687 +  hence 1: "A \<le> {0..<m}"
  5.1688 +  by (auto simp add: natLeq_on_wo_rel wo_rel.ofilter_def rel.under_def Field_natLeq_on)
  5.1689 +  hence "\<forall>n1 n2. n2 \<in> A \<and> n1 \<le> n2 \<longrightarrow> n1 \<in> A"
  5.1690 +  using * by(fastforce simp add: natLeq_on_wo_rel wo_rel.ofilter_def rel.under_def)
  5.1691 +  hence "A = UNIV \<or> (\<exists>n. A = {0 ..< n})" using closed_nat_set_iff by blast
  5.1692 +  thus "\<exists>n \<le> m. A = {0 ..< n}" using 1 atLeastLessThan_less_eq by blast
  5.1693 +next
  5.1694 +  assume "(\<exists>n\<le>m. A = {0 ..< n})"
  5.1695 +  thus "wo_rel.ofilter (natLeq_on m) A" by (auto simp add: natLeq_on_ofilter_less_eq)
  5.1696 +qed
  5.1697 +
  5.1698 +
  5.1699 +
  5.1700 +subsubsection {* Then as cardinals *}
  5.1701 +
  5.1702 +
  5.1703 +lemma natLeq_Card_order: "Card_order natLeq"
  5.1704 +proof(auto simp add: natLeq_Well_order
  5.1705 +      Card_order_iff_Restr_underS Restr_natLeq2, simp add:  Field_natLeq)
  5.1706 +  fix n have "finite(Field (natLeq_on n))"
  5.1707 +  unfolding Field_natLeq_on by auto
  5.1708 +  moreover have "infinite(UNIV::nat set)" by auto
  5.1709 +  ultimately show "natLeq_on n <o |UNIV::nat set|"
  5.1710 +  using finite_ordLess_infinite[of "natLeq_on n" "|UNIV::nat set|"]
  5.1711 +        Field_card_of[of "UNIV::nat set"]
  5.1712 +        card_of_Well_order[of "UNIV::nat set"] natLeq_on_Well_order[of n] by auto
  5.1713 +qed
  5.1714 +
  5.1715 +
  5.1716 +corollary card_of_Field_natLeq:
  5.1717 +"|Field natLeq| =o natLeq"
  5.1718 +using Field_natLeq natLeq_Card_order Card_order_iff_ordIso_card_of[of natLeq]
  5.1719 +      ordIso_symmetric[of natLeq] by blast
  5.1720 +
  5.1721 +
  5.1722 +corollary card_of_nat:
  5.1723 +"|UNIV::nat set| =o natLeq"
  5.1724 +using Field_natLeq card_of_Field_natLeq by auto
  5.1725 +
  5.1726 +
  5.1727 +corollary infinite_iff_natLeq_ordLeq:
  5.1728 +"infinite A = ( natLeq \<le>o |A| )"
  5.1729 +using infinite_iff_card_of_nat[of A] card_of_nat
  5.1730 +      ordIso_ordLeq_trans ordLeq_ordIso_trans ordIso_symmetric by blast
  5.1731 +
  5.1732 +
  5.1733 +corollary finite_iff_ordLess_natLeq:
  5.1734 +"finite A = ( |A| <o natLeq)"
  5.1735 +using infinite_iff_natLeq_ordLeq not_ordLeq_iff_ordLess
  5.1736 +      card_of_Well_order natLeq_Well_order by blast
  5.1737 +
  5.1738 +
  5.1739 +lemma ordIso_natLeq_on_imp_finite:
  5.1740 +"|A| =o natLeq_on n \<Longrightarrow> finite A"
  5.1741 +unfolding ordIso_def iso_def[abs_def]
  5.1742 +by (auto simp: Field_natLeq_on bij_betw_finite Field_card_of)
  5.1743 +
  5.1744 +
  5.1745 +lemma natLeq_on_Card_order: "Card_order (natLeq_on n)"
  5.1746 +proof(unfold card_order_on_def,
  5.1747 +      auto simp add: natLeq_on_Well_order, simp add: Field_natLeq_on)
  5.1748 +  fix r assume "well_order_on {0..<n} r"
  5.1749 +  thus "natLeq_on n \<le>o r"
  5.1750 +  using finite_atLeastLessThan natLeq_on_well_order_on
  5.1751 +        finite_well_order_on_ordIso ordIso_iff_ordLeq by blast
  5.1752 +qed
  5.1753 +
  5.1754 +
  5.1755 +corollary card_of_Field_natLeq_on:
  5.1756 +"|Field (natLeq_on n)| =o natLeq_on n"
  5.1757 +using Field_natLeq_on natLeq_on_Card_order
  5.1758 +      Card_order_iff_ordIso_card_of[of "natLeq_on n"]
  5.1759 +      ordIso_symmetric[of "natLeq_on n"] by blast
  5.1760 +
  5.1761 +
  5.1762 +corollary card_of_less:
  5.1763 +"|{0 ..< n}| =o natLeq_on n"
  5.1764 +using Field_natLeq_on card_of_Field_natLeq_on by auto
  5.1765 +
  5.1766 +
  5.1767 +lemma natLeq_on_ordLeq_less_eq:
  5.1768 +"((natLeq_on m) \<le>o (natLeq_on n)) = (m \<le> n)"
  5.1769 +proof
  5.1770 +  assume "natLeq_on m \<le>o natLeq_on n"
  5.1771 +  then obtain f where "inj_on f {0..<m} \<and> f ` {0..<m} \<le> {0..<n}"
  5.1772 +  using Field_natLeq_on[of m] Field_natLeq_on[of n]
  5.1773 +  unfolding ordLeq_def using embed_inj_on[of "natLeq_on m"  "natLeq_on n"]
  5.1774 +  embed_Field[of "natLeq_on m" "natLeq_on n"] using natLeq_on_Well_order[of m] by fastforce
  5.1775 +  thus "m \<le> n" using atLeastLessThan_less_eq2 by blast
  5.1776 +next
  5.1777 +  assume "m \<le> n"
  5.1778 +  hence "inj_on id {0..<m} \<and> id ` {0..<m} \<le> {0..<n}" unfolding inj_on_def by auto
  5.1779 +  hence "|{0..<m}| \<le>o |{0..<n}|" using card_of_ordLeq by blast
  5.1780 +  thus "natLeq_on m \<le>o natLeq_on n"
  5.1781 +  using card_of_less ordIso_ordLeq_trans ordLeq_ordIso_trans ordIso_symmetric by blast
  5.1782 +qed
  5.1783 +
  5.1784 +
  5.1785 +lemma natLeq_on_ordLeq_less:
  5.1786 +"((natLeq_on m) <o (natLeq_on n)) = (m < n)"
  5.1787 +using not_ordLeq_iff_ordLess[of "natLeq_on m" "natLeq_on n"]
  5.1788 +natLeq_on_Well_order natLeq_on_ordLeq_less_eq by auto
  5.1789 +
  5.1790 +
  5.1791 +
  5.1792 +subsubsection {* "Backwards compatibility" with the numeric cardinal operator for finite sets *}
  5.1793 +
  5.1794 +
  5.1795 +lemma finite_card_of_iff_card2:
  5.1796 +assumes FIN: "finite A" and FIN': "finite B"
  5.1797 +shows "( |A| \<le>o |B| ) = (card A \<le> card B)"
  5.1798 +using assms card_of_ordLeq[of A B] inj_on_iff_card_le[of A B] by blast
  5.1799 +
  5.1800 +
  5.1801 +lemma finite_imp_card_of_natLeq_on:
  5.1802 +assumes "finite A"
  5.1803 +shows "|A| =o natLeq_on (card A)"
  5.1804 +proof-
  5.1805 +  obtain h where "bij_betw h A {0 ..< card A}"
  5.1806 +  using assms ex_bij_betw_finite_nat by blast
  5.1807 +  thus ?thesis using card_of_ordIso card_of_less ordIso_equivalence by blast
  5.1808 +qed
  5.1809 +
  5.1810 +
  5.1811 +lemma finite_iff_card_of_natLeq_on:
  5.1812 +"finite A = (\<exists>n. |A| =o natLeq_on n)"
  5.1813 +using finite_imp_card_of_natLeq_on[of A]
  5.1814 +by(auto simp add: ordIso_natLeq_on_imp_finite)
  5.1815 +
  5.1816 +
  5.1817 +
  5.1818 +subsection {* The successor of a cardinal *}
  5.1819 +
  5.1820 +
  5.1821 +text{* First we define @{text "isCardSuc r r'"}, the notion of @{text "r'"}
  5.1822 +being a successor cardinal of @{text "r"}. Although the definition does
  5.1823 +not require @{text "r"} to be a cardinal, only this case will be meaningful.  *}
  5.1824 +
  5.1825 +
  5.1826 +definition isCardSuc :: "'a rel \<Rightarrow> 'a set rel \<Rightarrow> bool"
  5.1827 +where
  5.1828 +"isCardSuc r r' \<equiv>
  5.1829 + Card_order r' \<and> r <o r' \<and>
  5.1830 + (\<forall>(r''::'a set rel). Card_order r'' \<and> r <o r'' \<longrightarrow> r' \<le>o r'')"
  5.1831 +
  5.1832 +
  5.1833 +text{* Now we introduce the cardinal-successor operator @{text "cardSuc"},
  5.1834 +by picking {\em some} cardinal-order relation fulfilling @{text "isCardSuc"}.
  5.1835 +Again, the picked item shall be proved unique up to order-isomorphism. *}
  5.1836 +
  5.1837 +
  5.1838 +definition cardSuc :: "'a rel \<Rightarrow> 'a set rel"
  5.1839 +where
  5.1840 +"cardSuc r \<equiv> SOME r'. isCardSuc r r'"
  5.1841 +
  5.1842 +
  5.1843 +lemma exists_minim_Card_order:
  5.1844 +"\<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.1845 +unfolding card_order_on_def using exists_minim_Well_order by blast
  5.1846 +
  5.1847 +
  5.1848 +lemma exists_isCardSuc:
  5.1849 +assumes "Card_order r"
  5.1850 +shows "\<exists>r'. isCardSuc r r'"
  5.1851 +proof-
  5.1852 +  let ?R = "{(r'::'a set rel). Card_order r' \<and> r <o r'}"
  5.1853 +  have "|Pow(Field r)| \<in> ?R \<and> (\<forall>r \<in> ?R. Card_order r)" using assms
  5.1854 +  by (simp add: card_of_Card_order Card_order_Pow)
  5.1855 +  then obtain r where "r \<in> ?R \<and> (\<forall>r' \<in> ?R. r \<le>o r')"
  5.1856 +  using exists_minim_Card_order[of ?R] by blast
  5.1857 +  thus ?thesis unfolding isCardSuc_def by auto
  5.1858 +qed
  5.1859 +
  5.1860 +
  5.1861 +lemma cardSuc_isCardSuc:
  5.1862 +assumes "Card_order r"
  5.1863 +shows "isCardSuc r (cardSuc r)"
  5.1864 +unfolding cardSuc_def using assms
  5.1865 +by (simp add: exists_isCardSuc someI_ex)
  5.1866 +
  5.1867 +
  5.1868 +lemma cardSuc_Card_order:
  5.1869 +"Card_order r \<Longrightarrow> Card_order(cardSuc r)"
  5.1870 +using cardSuc_isCardSuc unfolding isCardSuc_def by blast
  5.1871 +
  5.1872 +
  5.1873 +lemma cardSuc_greater:
  5.1874 +"Card_order r \<Longrightarrow> r <o cardSuc r"
  5.1875 +using cardSuc_isCardSuc unfolding isCardSuc_def by blast
  5.1876 +
  5.1877 +
  5.1878 +lemma cardSuc_ordLeq:
  5.1879 +"Card_order r \<Longrightarrow> r \<le>o cardSuc r"
  5.1880 +using cardSuc_greater ordLeq_iff_ordLess_or_ordIso by blast
  5.1881 +
  5.1882 +
  5.1883 +text{* The minimality property of @{text "cardSuc"} originally present in its definition
  5.1884 +is local to the type @{text "'a set rel"}, i.e., that of @{text "cardSuc r"}:  *}
  5.1885 +
  5.1886 +lemma cardSuc_least_aux:
  5.1887 +"\<lbrakk>Card_order (r::'a rel); Card_order (r'::'a set rel); r <o r'\<rbrakk> \<Longrightarrow> cardSuc r \<le>o r'"
  5.1888 +using cardSuc_isCardSuc unfolding isCardSuc_def by blast
  5.1889 +
  5.1890 +
  5.1891 +text{* But from this we can infer general minimality: *}
  5.1892 +
  5.1893 +lemma cardSuc_least:
  5.1894 +assumes CARD: "Card_order r" and CARD': "Card_order r'" and LESS: "r <o r'"
  5.1895 +shows "cardSuc r \<le>o r'"
  5.1896 +proof-
  5.1897 +  let ?p = "cardSuc r"
  5.1898 +  have 0: "Well_order ?p \<and> Well_order r'"
  5.1899 +  using assms cardSuc_Card_order unfolding card_order_on_def by blast
  5.1900 +  {assume "r' <o ?p"
  5.1901 +   then obtain r'' where 1: "Field r'' < Field ?p" and 2: "r' =o r'' \<and> r'' <o ?p"
  5.1902 +   using internalize_ordLess[of r' ?p] by blast
  5.1903 +   (*  *)
  5.1904 +   have "Card_order r''" using CARD' Card_order_ordIso2 2 by blast
  5.1905 +   moreover have "r <o r''" using LESS 2 ordLess_ordIso_trans by blast
  5.1906 +   ultimately have "?p \<le>o r''" using cardSuc_least_aux CARD by blast
  5.1907 +   hence False using 2 not_ordLess_ordLeq by blast
  5.1908 +  }
  5.1909 +  thus ?thesis using 0 ordLess_or_ordLeq by blast
  5.1910 +qed
  5.1911 +
  5.1912 +
  5.1913 +lemma cardSuc_ordLess_ordLeq:
  5.1914 +assumes CARD: "Card_order r" and CARD': "Card_order r'"
  5.1915 +shows "(r <o r') = (cardSuc r \<le>o r')"
  5.1916 +proof(auto simp add: assms cardSuc_least)
  5.1917 +  assume "cardSuc r \<le>o r'"
  5.1918 +  thus "r <o r'" using assms cardSuc_greater ordLess_ordLeq_trans by blast
  5.1919 +qed
  5.1920 +
  5.1921 +
  5.1922 +lemma cardSuc_ordLeq_ordLess:
  5.1923 +assumes CARD: "Card_order r" and CARD': "Card_order r'"
  5.1924 +shows "(r' <o cardSuc r) = (r' \<le>o r)"
  5.1925 +proof-
  5.1926 +  have "Well_order r \<and> Well_order r'"
  5.1927 +  using assms unfolding card_order_on_def by auto
  5.1928 +  moreover have "Well_order(cardSuc r)"
  5.1929 +  using assms cardSuc_Card_order card_order_on_def by blast
  5.1930 +  ultimately show ?thesis
  5.1931 +  using assms cardSuc_ordLess_ordLeq[of r r']
  5.1932 +  not_ordLeq_iff_ordLess[of r r'] not_ordLeq_iff_ordLess[of r' "cardSuc r"] by blast
  5.1933 +qed
  5.1934 +
  5.1935 +
  5.1936 +lemma cardSuc_mono_ordLeq:
  5.1937 +assumes CARD: "Card_order r" and CARD': "Card_order r'"
  5.1938 +shows "(cardSuc r \<le>o cardSuc r') = (r \<le>o r')"
  5.1939 +using assms cardSuc_ordLeq_ordLess cardSuc_ordLess_ordLeq cardSuc_Card_order by blast
  5.1940 +
  5.1941 +
  5.1942 +lemma cardSuc_invar_ordIso:
  5.1943 +assumes CARD: "Card_order r" and CARD': "Card_order r'"
  5.1944 +shows "(cardSuc r =o cardSuc r') = (r =o r')"
  5.1945 +proof-
  5.1946 +  have 0: "Well_order r \<and> Well_order r' \<and> Well_order(cardSuc r) \<and> Well_order(cardSuc r')"
  5.1947 +  using assms by (simp add: card_order_on_well_order_on cardSuc_Card_order)
  5.1948 +  thus ?thesis
  5.1949 +  using ordIso_iff_ordLeq[of r r'] ordIso_iff_ordLeq
  5.1950 +  using cardSuc_mono_ordLeq[of r r'] cardSuc_mono_ordLeq[of r' r] assms by blast
  5.1951 +qed
  5.1952 +
  5.1953 +
  5.1954 +lemma cardSuc_natLeq_on_Suc:
  5.1955 +"cardSuc(natLeq_on n) =o natLeq_on(Suc n)"
  5.1956 +proof-
  5.1957 +  obtain r r' p where r_def: "r = natLeq_on n" and
  5.1958 +                      r'_def: "r' = cardSuc(natLeq_on n)"  and
  5.1959 +                      p_def: "p = natLeq_on(Suc n)" by blast
  5.1960 +  (* Preliminary facts:  *)
  5.1961 +  have CARD: "Card_order r \<and> Card_order r' \<and> Card_order p" unfolding r_def r'_def p_def
  5.1962 +  using cardSuc_ordLess_ordLeq natLeq_on_Card_order cardSuc_Card_order by blast
  5.1963 +  hence WELL: "Well_order r \<and> Well_order r' \<and>  Well_order p"
  5.1964 +  unfolding card_order_on_def by force
  5.1965 +  have FIELD: "Field r = {0..<n} \<and> Field p = {0..<(Suc n)}"
  5.1966 +  unfolding r_def p_def Field_natLeq_on by simp
  5.1967 +  hence FIN: "finite (Field r)" by force
  5.1968 +  have "r <o r'" using CARD unfolding r_def r'_def using cardSuc_greater by blast
  5.1969 +  hence "|Field r| <o r'" using CARD card_of_Field_ordIso ordIso_ordLess_trans by blast
  5.1970 +  hence LESS: "|Field r| <o |Field r'|"
  5.1971 +  using CARD card_of_Field_ordIso ordLess_ordIso_trans ordIso_symmetric by blast
  5.1972 +  (* Main proof: *)
  5.1973 +  have "r' \<le>o p" using CARD unfolding r_def r'_def p_def
  5.1974 +  using natLeq_on_ordLeq_less cardSuc_ordLess_ordLeq by blast
  5.1975 +  moreover have "p \<le>o r'"
  5.1976 +  proof-
  5.1977 +    {assume "r' <o p"
  5.1978 +     then obtain f where 0: "embedS r' p f" unfolding ordLess_def by force
  5.1979 +     let ?q = "Restr p (f ` Field r')"
  5.1980 +     have 1: "embed r' p f" using 0 unfolding embedS_def by force
  5.1981 +     hence 2: "f ` Field r' < {0..<(Suc n)}"
  5.1982 +     using WELL FIELD 0 by (auto simp add: embedS_iff)
  5.1983 +     have "wo_rel.ofilter p (f ` Field r')" using embed_Field_ofilter 1 WELL by blast
  5.1984 +     then obtain m where "m \<le> Suc n" and 3: "f ` (Field r') = {0..<m}"
  5.1985 +     unfolding p_def by (auto simp add: natLeq_on_ofilter_iff)
  5.1986 +     hence 4: "m \<le> n" using 2 by force
  5.1987 +     (*  *)
  5.1988 +     have "bij_betw f (Field r') (f ` (Field r'))"
  5.1989 +     using 1 WELL embed_inj_on unfolding bij_betw_def by force
  5.1990 +     moreover have "finite(f ` (Field r'))" using 3 finite_atLeastLessThan[of 0 m] by force
  5.1991 +     ultimately have 5: "finite (Field r') \<and> card(Field r') = card (f ` (Field r'))"
  5.1992 +     using bij_betw_same_card bij_betw_finite by metis
  5.1993 +     hence "card(Field r') \<le> card(Field r)" using 3 4 FIELD by force
  5.1994 +     hence "|Field r'| \<le>o |Field r|" using FIN 5 finite_card_of_iff_card2 by blast
  5.1995 +     hence False using LESS not_ordLess_ordLeq by auto
  5.1996 +    }
  5.1997 +    thus ?thesis using WELL CARD by (fastforce simp: not_ordLess_iff_ordLeq)
  5.1998 +  qed
  5.1999 +  ultimately show ?thesis using ordIso_iff_ordLeq unfolding r'_def p_def by blast
  5.2000 +qed
  5.2001 +
  5.2002 +
  5.2003 +lemma card_of_cardSuc_finite:
  5.2004 +"finite(Field(cardSuc |A| )) = finite A"
  5.2005 +proof
  5.2006 +  assume *: "finite (Field (cardSuc |A| ))"
  5.2007 +  have 0: "|Field(cardSuc |A| )| =o cardSuc |A|"
  5.2008 +  using card_of_Card_order cardSuc_Card_order card_of_Field_ordIso by blast
  5.2009 +  hence "|A| \<le>o |Field(cardSuc |A| )|"
  5.2010 +  using card_of_Card_order[of A] cardSuc_ordLeq[of "|A|"] ordIso_symmetric
  5.2011 +  ordLeq_ordIso_trans by blast
  5.2012 +  thus "finite A" using * card_of_ordLeq_finite by blast
  5.2013 +next
  5.2014 +  assume "finite A"
  5.2015 +  then obtain n where "|A| =o natLeq_on n" using finite_iff_card_of_natLeq_on by blast
  5.2016 +  hence "cardSuc |A| =o cardSuc(natLeq_on n)"
  5.2017 +  using card_of_Card_order cardSuc_invar_ordIso natLeq_on_Card_order by blast
  5.2018 +  hence "cardSuc |A| =o natLeq_on(Suc n)"
  5.2019 +  using cardSuc_natLeq_on_Suc ordIso_transitive by blast
  5.2020 +  hence "cardSuc |A| =o |{0..<(Suc n)}|" using card_of_less ordIso_equivalence by blast
  5.2021 +  moreover have "|Field (cardSuc |A| ) | =o cardSuc |A|"
  5.2022 +  using card_of_Field_ordIso cardSuc_Card_order card_of_Card_order by blast
  5.2023 +  ultimately have "|Field (cardSuc |A| ) | =o |{0..<(Suc n)}|"
  5.2024 +  using ordIso_equivalence by blast
  5.2025 +  thus "finite (Field (cardSuc |A| ))"
  5.2026 +  using card_of_ordIso_finite finite_atLeastLessThan by blast
  5.2027 +qed
  5.2028 +
  5.2029 +
  5.2030 +lemma cardSuc_finite:
  5.2031 +assumes "Card_order r"
  5.2032 +shows "finite (Field (cardSuc r)) = finite (Field r)"
  5.2033 +proof-
  5.2034 +  let ?A = "Field r"
  5.2035 +  have "|?A| =o r" using assms by (simp add: card_of_Field_ordIso)
  5.2036 +  hence "cardSuc |?A| =o cardSuc r" using assms
  5.2037 +  by (simp add: card_of_Card_order cardSuc_invar_ordIso)
  5.2038 +  moreover have "|Field (cardSuc |?A| ) | =o cardSuc |?A|"
  5.2039 +  by (simp add: card_of_card_order_on Field_card_of card_of_Field_ordIso cardSuc_Card_order)
  5.2040 +  moreover
  5.2041 +  {have "|Field (cardSuc r) | =o cardSuc r"
  5.2042 +   using assms by (simp add: card_of_Field_ordIso cardSuc_Card_order)
  5.2043 +   hence "cardSuc r =o |Field (cardSuc r) |"
  5.2044 +   using ordIso_symmetric by blast
  5.2045 +  }
  5.2046 +  ultimately have "|Field (cardSuc |?A| ) | =o |Field (cardSuc r) |"
  5.2047 +  using ordIso_transitive by blast
  5.2048 +  hence "finite (Field (cardSuc |?A| )) = finite (Field (cardSuc r))"
  5.2049 +  using card_of_ordIso_finite by blast
  5.2050 +  thus ?thesis by (simp only: card_of_cardSuc_finite)
  5.2051 +qed
  5.2052 +
  5.2053 +
  5.2054 +lemma card_of_Plus_ordLeq_infinite_Field:
  5.2055 +assumes r: "infinite (Field r)" and A: "|A| \<le>o r" and B: "|B| \<le>o r"
  5.2056 +and c: "Card_order r"
  5.2057 +shows "|A <+> B| \<le>o r"
  5.2058 +proof-
  5.2059 +  let ?r' = "cardSuc r"
  5.2060 +  have "Card_order ?r' \<and> infinite (Field ?r')" using assms
  5.2061 +  by (simp add: cardSuc_Card_order cardSuc_finite)
  5.2062 +  moreover have "|A| <o ?r'" and "|B| <o ?r'" using A B c
  5.2063 +  by (auto simp: card_of_card_order_on Field_card_of cardSuc_ordLeq_ordLess)
  5.2064 +  ultimately have "|A <+> B| <o ?r'"
  5.2065 +  using card_of_Plus_ordLess_infinite_Field by blast
  5.2066 +  thus ?thesis using c r
  5.2067 +  by (simp add: card_of_card_order_on Field_card_of cardSuc_ordLeq_ordLess)
  5.2068 +qed
  5.2069 +
  5.2070 +
  5.2071 +lemma card_of_Un_ordLeq_infinite_Field:
  5.2072 +assumes C: "infinite (Field r)" and A: "|A| \<le>o r" and B: "|B| \<le>o r"
  5.2073 +and "Card_order r"
  5.2074 +shows "|A Un B| \<le>o r"
  5.2075 +using assms card_of_Plus_ordLeq_infinite_Field card_of_Un_Plus_ordLeq
  5.2076 +ordLeq_transitive by blast
  5.2077 +
  5.2078 +
  5.2079 +
  5.2080 +subsection {* Regular cardinals *}
  5.2081 +
  5.2082 +
  5.2083 +definition cofinal where
  5.2084 +"cofinal A r \<equiv>
  5.2085 + ALL a : Field r. EX b : A. a \<noteq> b \<and> (a,b) : r"
  5.2086 +
  5.2087 +
  5.2088 +definition regular where
  5.2089 +"regular r \<equiv>
  5.2090 + ALL K. K \<le> Field r \<and> cofinal K r \<longrightarrow> |K| =o r"
  5.2091 +
  5.2092 +
  5.2093 +definition relChain where
  5.2094 +"relChain r As \<equiv>
  5.2095 + ALL i j. (i,j) \<in> r \<longrightarrow> As i \<le> As j"
  5.2096 +
  5.2097 +lemma regular_UNION:
  5.2098 +assumes r: "Card_order r"   "regular r"
  5.2099 +and As: "relChain r As"
  5.2100 +and Bsub: "B \<le> (UN i : Field r. As i)"
  5.2101 +and cardB: "|B| <o r"
  5.2102 +shows "EX i : Field r. B \<le> As i"
  5.2103 +proof-
  5.2104 +  let ?phi = "%b j. j : Field r \<and> b : As j"
  5.2105 +  have "ALL b : B. EX j. ?phi b j" using Bsub by blast
  5.2106 +  then obtain f where f: "!! b. b : B \<Longrightarrow> ?phi b (f b)"
  5.2107 +  using bchoice[of B ?phi] by blast
  5.2108 +  let ?K = "f ` B"
  5.2109 +  {assume 1: "!! i. i : Field r \<Longrightarrow> ~ B \<le> As i"
  5.2110 +   have 2: "cofinal ?K r"
  5.2111 +   unfolding cofinal_def proof auto
  5.2112 +     fix i assume i: "i : Field r"
  5.2113 +     with 1 obtain b where b: "b : B \<and> b \<notin> As i" by blast
  5.2114 +     hence "i \<noteq> f b \<and> ~ (f b,i) : r"
  5.2115 +     using As f unfolding relChain_def by auto
  5.2116 +     hence "i \<noteq> f b \<and> (i, f b) : r" using r
  5.2117 +     unfolding card_order_on_def well_order_on_def linear_order_on_def
  5.2118 +     total_on_def using i f b by auto
  5.2119 +     with b show "\<exists>b\<in>B. i \<noteq> f b \<and> (i, f b) \<in> r" by blast
  5.2120 +   qed
  5.2121 +   moreover have "?K \<le> Field r" using f by blast
  5.2122 +   ultimately have "|?K| =o r" using 2 r unfolding regular_def by blast
  5.2123 +   moreover
  5.2124 +   {
  5.2125 +    have "|?K| <=o |B|" using card_of_image .
  5.2126 +    hence "|?K| <o r" using cardB ordLeq_ordLess_trans by blast
  5.2127 +   }
  5.2128 +   ultimately have False using not_ordLess_ordIso by blast
  5.2129 +  }
  5.2130 +  thus ?thesis by blast
  5.2131 +qed
  5.2132 +
  5.2133 +
  5.2134 +lemma infinite_cardSuc_regular:
  5.2135 +assumes r_inf: "infinite (Field r)" and r_card: "Card_order r"
  5.2136 +shows "regular (cardSuc r)"
  5.2137 +proof-
  5.2138 +  let ?r' = "cardSuc r"
  5.2139 +  have r': "Card_order ?r'"
  5.2140 +  "!! p. Card_order p \<longrightarrow> (p \<le>o r) = (p <o ?r')"
  5.2141 +  using r_card by (auto simp: cardSuc_Card_order cardSuc_ordLeq_ordLess)
  5.2142 +  show ?thesis
  5.2143 +  unfolding regular_def proof auto
  5.2144 +    fix K assume 1: "K \<le> Field ?r'" and 2: "cofinal K ?r'"
  5.2145 +    hence "|K| \<le>o |Field ?r'|" by (simp only: card_of_mono1)
  5.2146 +    also have 22: "|Field ?r'| =o ?r'"
  5.2147 +    using r' by (simp add: card_of_Field_ordIso[of ?r'])
  5.2148 +    finally have "|K| \<le>o ?r'" .
  5.2149 +    moreover
  5.2150 +    {let ?L = "UN j : K. rel.underS ?r' j"
  5.2151 +     let ?J = "Field r"
  5.2152 +     have rJ: "r =o |?J|"
  5.2153 +     using r_card card_of_Field_ordIso ordIso_symmetric by blast
  5.2154 +     assume "|K| <o ?r'"
  5.2155 +     hence "|K| <=o r" using r' card_of_Card_order[of K] by blast
  5.2156 +     hence "|K| \<le>o |?J|" using rJ ordLeq_ordIso_trans by blast
  5.2157 +     moreover
  5.2158 +     {have "ALL j : K. |rel.underS ?r' j| <o ?r'"
  5.2159 +      using r' 1 by (auto simp: card_of_underS)
  5.2160 +      hence "ALL j : K. |rel.underS ?r' j| \<le>o r"
  5.2161 +      using r' card_of_Card_order by blast
  5.2162 +      hence "ALL j : K. |rel.underS ?r' j| \<le>o |?J|"
  5.2163 +      using rJ ordLeq_ordIso_trans by blast
  5.2164 +     }
  5.2165 +     ultimately have "|?L| \<le>o |?J|"
  5.2166 +     using r_inf card_of_UNION_ordLeq_infinite by blast
  5.2167 +     hence "|?L| \<le>o r" using rJ ordIso_symmetric ordLeq_ordIso_trans by blast
  5.2168 +     hence "|?L| <o ?r'" using r' card_of_Card_order by blast
  5.2169 +     moreover
  5.2170 +     {
  5.2171 +      have "Field ?r' \<le> ?L"
  5.2172 +      using 2 unfolding rel.underS_def cofinal_def by auto
  5.2173 +      hence "|Field ?r'| \<le>o |?L|" by (simp add: card_of_mono1)
  5.2174 +      hence "?r' \<le>o |?L|"
  5.2175 +      using 22 ordIso_ordLeq_trans ordIso_symmetric by blast
  5.2176 +     }
  5.2177 +     ultimately have "|?L| <o |?L|" using ordLess_ordLeq_trans by blast
  5.2178 +     hence False using ordLess_irreflexive by blast
  5.2179 +    }
  5.2180 +    ultimately show "|K| =o ?r'"
  5.2181 +    unfolding ordLeq_iff_ordLess_or_ordIso by blast
  5.2182 +  qed
  5.2183 +qed
  5.2184 +
  5.2185 +lemma cardSuc_UNION:
  5.2186 +assumes r: "Card_order r" and "infinite (Field r)"
  5.2187 +and As: "relChain (cardSuc r) As"
  5.2188 +and Bsub: "B \<le> (UN i : Field (cardSuc r). As i)"
  5.2189 +and cardB: "|B| <=o r"
  5.2190 +shows "EX i : Field (cardSuc r). B \<le> As i"
  5.2191 +proof-
  5.2192 +  let ?r' = "cardSuc r"
  5.2193 +  have "Card_order ?r' \<and> |B| <o ?r'"
  5.2194 +  using r cardB cardSuc_ordLeq_ordLess cardSuc_Card_order
  5.2195 +  card_of_Card_order by blast
  5.2196 +  moreover have "regular ?r'"
  5.2197 +  using assms by(simp add: infinite_cardSuc_regular)
  5.2198 +  ultimately show ?thesis
  5.2199 +  using As Bsub cardB regular_UNION by blast
  5.2200 +qed
  5.2201 +
  5.2202 +
  5.2203 +subsection {* Others *}
  5.2204 +
  5.2205 +(* FIXME: finitte ~> finite? *)
  5.2206 +lemma card_of_infinite_diff_finitte:
  5.2207 +assumes "infinite A" and "finite B"
  5.2208 +shows "|A - B| =o |A|"
  5.2209 +by (metis assms card_of_Un_diff_infinite finite_ordLess_infinite2)
  5.2210 +
  5.2211 +(* function space *)
  5.2212 +definition Func where
  5.2213 +"Func A B \<equiv>
  5.2214 + {f. (\<forall> a. f a \<noteq> None \<longleftrightarrow> a \<in> A) \<and> (\<forall> a \<in> A. case f a of Some b \<Rightarrow> b \<in> B |None \<Rightarrow> True)}"
  5.2215 +
  5.2216 +lemma Func_empty:
  5.2217 +"Func {} B = {empty}"
  5.2218 +unfolding Func_def by auto
  5.2219 +
  5.2220 +lemma Func_elim:
  5.2221 +assumes "g \<in> Func A B" and "a \<in> A"
  5.2222 +shows "\<exists> b. b \<in> B \<and> g a = Some b"
  5.2223 +using assms unfolding Func_def by (cases "g a") force+
  5.2224 +
  5.2225 +definition curr where
  5.2226 +"curr A f \<equiv> \<lambda> a. if a \<in> A then Some (\<lambda> b. f (a,b)) else None"
  5.2227 +
  5.2228 +lemma curr_in:
  5.2229 +assumes f: "f \<in> Func (A <*> B) C"
  5.2230 +shows "curr A f \<in> Func A (Func B C)"
  5.2231 +using assms unfolding curr_def Func_def by auto
  5.2232 +
  5.2233 +lemma curr_inj:
  5.2234 +assumes "f1 \<in> Func (A <*> B) C" and "f2 \<in> Func (A <*> B) C"
  5.2235 +shows "curr A f1 = curr A f2 \<longleftrightarrow> f1 = f2"
  5.2236 +proof safe
  5.2237 +  assume c: "curr A f1 = curr A f2"
  5.2238 +  show "f1 = f2"
  5.2239 +  proof (rule ext, clarify)
  5.2240 +    fix a b show "f1 (a, b) = f2 (a, b)"
  5.2241 +    proof (cases "(a,b) \<in> A <*> B")
  5.2242 +      case False
  5.2243 +      thus ?thesis using assms unfolding Func_def
  5.2244 +      apply(cases "f1 (a,b)") apply(cases "f2 (a,b)", fastforce, fastforce)
  5.2245 +      apply(cases "f2 (a,b)") by auto
  5.2246 +    next
  5.2247 +      case True hence a: "a \<in> A" and b: "b \<in> B" by auto
  5.2248 +      thus ?thesis
  5.2249 +      using c unfolding curr_def fun_eq_iff
  5.2250 +      apply(elim allE[of _ a]) apply simp unfolding fun_eq_iff by auto
  5.2251 +    qed
  5.2252 +  qed
  5.2253 +qed
  5.2254 +
  5.2255 +lemma curr_surj:
  5.2256 +assumes "g \<in> Func A (Func B C)"
  5.2257 +shows "\<exists> f \<in> Func (A <*> B) C. curr A f = g"
  5.2258 +proof
  5.2259 +  let ?f = "\<lambda> ab. case g (fst ab) of None \<Rightarrow> None | Some g1 \<Rightarrow> g1 (snd ab)"
  5.2260 +  show "curr A ?f = g"
  5.2261 +  proof (rule ext)
  5.2262 +    fix a show "curr A ?f a = g a"
  5.2263 +    proof (cases "a \<in> A")
  5.2264 +      case False
  5.2265 +      hence "g a = None" using assms unfolding Func_def by auto
  5.2266 +      thus ?thesis unfolding curr_def using False by simp
  5.2267 +    next
  5.2268 +      case True
  5.2269 +      obtain g1 where "g1 \<in> Func B C" and "g a = Some g1"
  5.2270 +      using assms using Func_elim[OF assms True] by blast
  5.2271 +      thus ?thesis using True unfolding curr_def by auto
  5.2272 +    qed
  5.2273 +  qed
  5.2274 +  show "?f \<in> Func (A <*> B) C"
  5.2275 +  unfolding Func_def mem_Collect_eq proof(intro conjI allI ballI)
  5.2276 +    fix ab show "?f ab \<noteq> None \<longleftrightarrow> ab \<in> A \<times> B"
  5.2277 +    proof(cases "g (fst ab)")
  5.2278 +      case None
  5.2279 +      hence "fst ab \<notin> A" using assms unfolding Func_def by force
  5.2280 +      thus ?thesis using None by auto
  5.2281 +    next
  5.2282 +      case (Some g1)
  5.2283 +      hence fst: "fst ab \<in> A" and g1: "g1 \<in> Func B C"
  5.2284 +      using assms unfolding Func_def[of A] by force+
  5.2285 +      hence "?f ab \<noteq> None \<longleftrightarrow> g1 (snd ab) \<noteq> None" using Some by auto
  5.2286 +      also have "... \<longleftrightarrow> snd ab \<in> B" using g1 unfolding Func_def by auto
  5.2287 +      also have "... \<longleftrightarrow> ab \<in> A \<times> B" using fst by (cases ab, auto)
  5.2288 +      finally show ?thesis .
  5.2289 +    qed
  5.2290 +  next
  5.2291 +    fix ab assume ab: "ab \<in> A \<times> B"
  5.2292 +    hence "fst ab \<in> A" and "snd ab \<in> B" by(cases ab, auto)
  5.2293 +    then obtain g1 where "g1 \<in> Func B C" and "g (fst ab) = Some g1"
  5.2294 +    using assms using Func_elim[OF assms] by blast
  5.2295 +    thus "case ?f ab of Some c \<Rightarrow> c \<in> C |None \<Rightarrow> True"
  5.2296 +    unfolding Func_def by auto
  5.2297 +  qed
  5.2298 +qed
  5.2299 +
  5.2300 +(* FIXME: betwe ~> betw? *)
  5.2301 +lemma bij_betwe_curr:
  5.2302 +"bij_betw (curr A) (Func (A <*> B) C) (Func A (Func B C))"
  5.2303 +unfolding bij_betw_def inj_on_def image_def
  5.2304 +using curr_in curr_inj curr_surj by blast
  5.2305 +
  5.2306 +lemma card_of_Func_Times:
  5.2307 +"|Func (A <*> B) C| =o |Func A (Func B C)|"
  5.2308 +unfolding card_of_ordIso[symmetric]
  5.2309 +using bij_betwe_curr by blast
  5.2310 +
  5.2311 +definition Func_map where
  5.2312 +"Func_map B2 f1 f2 g b2 \<equiv>
  5.2313 + if b2 \<in> B2 then case g (f2 b2) of None \<Rightarrow> None | Some a1 \<Rightarrow> Some (f1 a1)
  5.2314 +            else None"
  5.2315 +
  5.2316 +lemma Func_map:
  5.2317 +assumes g: "g \<in> Func A2 A1" and f1: "f1 ` A1 \<subseteq> B1" and f2: "f2 ` B2 \<subseteq> A2"
  5.2318 +shows "Func_map B2 f1 f2 g \<in> Func B2 B1"
  5.2319 +unfolding Func_def mem_Collect_eq proof(intro conjI allI ballI)
  5.2320 +  fix b2 show "Func_map B2 f1 f2 g b2 \<noteq> None \<longleftrightarrow> b2 \<in> B2"
  5.2321 +  proof(cases "b2 \<in> B2")
  5.2322 +    case True
  5.2323 +    hence "f2 b2 \<in> A2" using f2 by auto
  5.2324 +    then obtain a1 where "g (f2 b2) = Some a1" and "a1 \<in> A1"
  5.2325 +    using g unfolding Func_def by(cases "g (f2 b2)", fastforce+)
  5.2326 +    thus ?thesis unfolding Func_map_def using True by auto
  5.2327 +  qed(unfold Func_map_def, auto)
  5.2328 +next
  5.2329 +  fix b2 assume b2: "b2 \<in> B2"
  5.2330 +  hence "f2 b2 \<in> A2" using f2 by auto
  5.2331 +  then obtain a1 where "g (f2 b2) = Some a1" and "a1 \<in> A1"
  5.2332 +  using g unfolding Func_def by(cases "g (f2 b2)", fastforce+)
  5.2333 +  thus "case Func_map B2 f1 f2 g b2 of None \<Rightarrow> True | Some b1 \<Rightarrow> b1 \<in> B1"
  5.2334 +  unfolding Func_map_def using b2 f1 by auto
  5.2335 +qed
  5.2336 +
  5.2337 +lemma Func_map_empty:
  5.2338 +"Func_map B2 f1 f2 empty = empty"
  5.2339 +unfolding Func_map_def[abs_def] by (rule ext, auto)
  5.2340 +
  5.2341 +lemma Func_non_emp:
  5.2342 +assumes "B \<noteq> {}"
  5.2343 +shows "Func A B \<noteq> {}"
  5.2344 +proof-
  5.2345 +  obtain b where b: "b \<in> B" using assms by auto
  5.2346 +  hence "(\<lambda> a. if a \<in> A then Some b else None) \<in> Func A B"
  5.2347 +  unfolding Func_def by auto
  5.2348 +  thus ?thesis by blast
  5.2349 +qed
  5.2350 +
  5.2351 +lemma Func_is_emp:
  5.2352 +"Func A B = {} \<longleftrightarrow> A \<noteq> {} \<and> B = {}" (is "?L \<longleftrightarrow> ?R")
  5.2353 +proof
  5.2354 +  assume L: ?L
  5.2355 +  moreover {assume "A = {}" hence False using L Func_empty by auto}
  5.2356 +  moreover {assume "B \<noteq> {}" hence False using L Func_non_emp by metis}
  5.2357 +  ultimately show ?R by blast
  5.2358 +next
  5.2359 +  assume R: ?R
  5.2360 +  moreover
  5.2361 +  {fix f assume "f \<in> Func A B"
  5.2362 +   moreover obtain a where "a \<in> A" using R by blast
  5.2363 +   ultimately obtain b where "b \<in> B" unfolding Func_def by(cases "f a", force+)
  5.2364 +   with R have False by auto
  5.2365 +  }
  5.2366 +  thus ?L by blast
  5.2367 +qed
  5.2368 +
  5.2369 +lemma Func_map_surj:
  5.2370 +assumes B1: "f1 ` A1 = B1" and A2: "inj_on f2 B2" "f2 ` B2 \<subseteq> A2"
  5.2371 +and B2A2: "B2 = {} \<Longrightarrow> A2 = {}"
  5.2372 +shows "Func B2 B1 = Func_map B2 f1 f2 ` Func A2 A1"
  5.2373 +proof(cases "B2 = {}")
  5.2374 +  case True
  5.2375 +  thus ?thesis using B2A2 by (auto simp: Func_empty Func_map_empty)
  5.2376 +next
  5.2377 +  case False note B2 = False
  5.2378 +  show ?thesis
  5.2379 +proof safe
  5.2380 +  fix h assume h: "h \<in> Func B2 B1"
  5.2381 +  def j1 \<equiv> "inv_into A1 f1"
  5.2382 +  have "\<forall> a2 \<in> f2 ` B2. \<exists> b2. b2 \<in> B2 \<and> f2 b2 = a2" by blast
  5.2383 +  then obtain k where k: "\<forall> a2 \<in> f2 ` B2. k a2 \<in> B2 \<and> f2 (k a2) = a2" by metis
  5.2384 +  {fix b2 assume b2: "b2 \<in> B2"
  5.2385 +   hence "f2 (k (f2 b2)) = f2 b2" using k A2(2) by auto
  5.2386 +   moreover have "k (f2 b2) \<in> B2" using b2 A2(2) k by auto
  5.2387 +   ultimately have "k (f2 b2) = b2" using b2 A2(1) unfolding inj_on_def by blast
  5.2388 +  } note kk = this
  5.2389 +  obtain b22 where b22: "b22 \<in> B2" using B2 by auto
  5.2390 +  def j2 \<equiv> "\<lambda> a2. if a2 \<in> f2 ` B2 then k a2 else b22"
  5.2391 +  have j2A2: "j2 ` A2 \<subseteq> B2" unfolding j2_def using k b22 by auto
  5.2392 +  have j2: "\<And> b2. b2 \<in> B2 \<Longrightarrow> j2 (f2 b2) = b2"
  5.2393 +  using kk unfolding j2_def by auto
  5.2394 +  def g \<equiv> "Func_map A2 j1 j2 h"
  5.2395 +  have "Func_map B2 f1 f2 g = h"
  5.2396 +  proof (rule ext)
  5.2397 +    fix b2 show "Func_map B2 f1 f2 g b2 = h b2"
  5.2398 +    proof(cases "b2 \<in> B2")
  5.2399 +      case True
  5.2400 +      show ?thesis
  5.2401 +      proof (cases "h b2")
  5.2402 +        case (Some b1)
  5.2403 +        hence b1: "b1 \<in> f1 ` A1" using True h unfolding B1 Func_def by auto
  5.2404 +        show ?thesis
  5.2405 +        using Some True A2 f_inv_into_f[OF b1]
  5.2406 +        unfolding g_def Func_map_def j1_def j2[OF True] by auto
  5.2407 +      qed(insert A2 True j2[OF True], unfold g_def Func_map_def, auto)
  5.2408 +    qed(insert h, unfold Func_def Func_map_def, auto)
  5.2409 +  qed
  5.2410 +  moreover have "g \<in> Func A2 A1" unfolding g_def apply(rule Func_map[OF h])
  5.2411 +  using inv_into_into j2A2 B1 A2 inv_into_into
  5.2412 +  unfolding j1_def image_def by(force, force)
  5.2413 +  ultimately show "h \<in> Func_map B2 f1 f2 ` Func A2 A1"
  5.2414 +  unfolding Func_map_def[abs_def] unfolding image_def by auto
  5.2415 +qed(insert B1 Func_map[OF _ _ A2(2)], auto)
  5.2416 +qed
  5.2417 +
  5.2418 +(* partial-function space: *)
  5.2419 +definition Pfunc where
  5.2420 +"Pfunc A B \<equiv>
  5.2421 + {f. (\<forall>a. f a \<noteq> None \<longrightarrow> a \<in> A) \<and>
  5.2422 +     (\<forall>a. case f a of None \<Rightarrow> True | Some b \<Rightarrow> b \<in> B)}"
  5.2423 +
  5.2424 +lemma Func_Pfunc:
  5.2425 +"Func A B \<subseteq> Pfunc A B"
  5.2426 +unfolding Func_def Pfunc_def by auto
  5.2427 +
  5.2428 +lemma Pfunc_Func:
  5.2429 +"Pfunc A B = (\<Union> A' \<in> Pow A. Func A' B)"
  5.2430 +proof safe
  5.2431 +  fix f assume f: "f \<in> Pfunc A B"
  5.2432 +  show "f \<in> (\<Union>A'\<in>Pow A. Func A' B)"
  5.2433 +  proof (intro UN_I)
  5.2434 +    let ?A' = "{a. f a \<noteq> None}"
  5.2435 +    show "?A' \<in> Pow A" using f unfolding Pow_def Pfunc_def by auto
  5.2436 +    show "f \<in> Func ?A' B" using f unfolding Func_def Pfunc_def by auto
  5.2437 +  qed
  5.2438 +next
  5.2439 +  fix f A' assume "f \<in> Func A' B" and "A' \<subseteq> A"
  5.2440 +  thus "f \<in> Pfunc A B" unfolding Func_def Pfunc_def by auto
  5.2441 +qed
  5.2442 +
  5.2443 +lemma card_of_Pow_Func:
  5.2444 +"|Pow A| =o |Func A (UNIV::bool set)|"
  5.2445 +proof-
  5.2446 +  def F \<equiv> "\<lambda> A' a. if a \<in> A then (if a \<in> A' then Some True else Some False)
  5.2447 +                            else None"
  5.2448 +  have "bij_betw F (Pow A) (Func A (UNIV::bool set))"
  5.2449 +  unfolding bij_betw_def inj_on_def proof (intro ballI impI conjI)
  5.2450 +    fix A1 A2 assume A1: "A1 \<in> Pow A" and A2: "A2 \<in> Pow A" and eq: "F A1 = F A2"
  5.2451 +    show "A1 = A2"
  5.2452 +    proof-
  5.2453 +      {fix a
  5.2454 +       have "a \<in> A1 \<longleftrightarrow> F A1 a = Some True" using A1 unfolding F_def Pow_def by auto
  5.2455 +       also have "... \<longleftrightarrow> F A2 a = Some True" unfolding eq ..
  5.2456 +       also have "... \<longleftrightarrow> a \<in> A2" using A2 unfolding F_def Pow_def by auto
  5.2457 +       finally have "a \<in> A1 \<longleftrightarrow> a \<in> A2" .
  5.2458 +      }
  5.2459 +      thus ?thesis by auto
  5.2460 +    qed
  5.2461 +  next
  5.2462 +    show "F ` Pow A = Func A UNIV"
  5.2463 +    proof safe
  5.2464 +      fix f assume f: "f \<in> Func A (UNIV::bool set)"
  5.2465 +      show "f \<in> F ` Pow A" unfolding image_def mem_Collect_eq proof(intro bexI)
  5.2466 +        let ?A1 = "{a \<in> A. f a = Some True}"
  5.2467 +        show "f = F ?A1" unfolding F_def apply(rule ext)
  5.2468 +        using f unfolding Func_def mem_Collect_eq by (auto,force)
  5.2469 +      qed auto
  5.2470 +    qed(unfold Func_def mem_Collect_eq F_def, auto)
  5.2471 +  qed
  5.2472 +  thus ?thesis unfolding card_of_ordIso[symmetric] by blast
  5.2473 +qed
  5.2474 +
  5.2475 +lemma card_of_Func_mono:
  5.2476 +fixes A1 A2 :: "'a set" and B :: "'b set"
  5.2477 +assumes A12: "A1 \<subseteq> A2" and B: "B \<noteq> {}"
  5.2478 +shows "|Func A1 B| \<le>o |Func A2 B|"
  5.2479 +proof-
  5.2480 +  obtain bb where bb: "bb \<in> B" using B by auto
  5.2481 +  def F \<equiv> "\<lambda> (f1::'a \<Rightarrow> 'b option) a. if a \<in> A2 then (if a \<in> A1 then f1 a else Some bb)
  5.2482 +                                                else None"
  5.2483 +  show ?thesis unfolding card_of_ordLeq[symmetric] proof(intro exI[of _ F] conjI)
  5.2484 +    show "inj_on F (Func A1 B)" unfolding inj_on_def proof safe
  5.2485 +      fix f g assume f: "f \<in> Func A1 B" and g: "g \<in> Func A1 B" and eq: "F f = F g"
  5.2486 +      show "f = g"
  5.2487 +      proof(rule ext)
  5.2488 +        fix a show "f a = g a"
  5.2489 +        proof(cases "a \<in> A1")
  5.2490 +          case True
  5.2491 +          thus ?thesis using eq A12 unfolding F_def fun_eq_iff
  5.2492 +          by (elim allE[of _ a]) auto
  5.2493 +        qed(insert f g, unfold Func_def, fastforce)
  5.2494 +      qed
  5.2495 +    qed
  5.2496 +  qed(insert bb, unfold Func_def F_def, force)
  5.2497 +qed
  5.2498 +
  5.2499 +lemma card_of_Pfunc_Pow_Func:
  5.2500 +assumes "B \<noteq> {}"
  5.2501 +shows "|Pfunc A B| \<le>o |Pow A <*> Func A B|"
  5.2502 +proof-
  5.2503 +  have "|Pfunc A B| =o |\<Union> A' \<in> Pow A. Func A' B|" (is "_ =o ?K")
  5.2504 +  unfolding Pfunc_Func by(rule card_of_refl)
  5.2505 +  also have "?K \<le>o |Sigma (Pow A) (\<lambda> A'. Func A' B)|" using card_of_UNION_Sigma .
  5.2506 +  also have "|Sigma (Pow A) (\<lambda> A'. Func A' B)| \<le>o |Pow A <*> Func A B|"
  5.2507 +  apply(rule card_of_Sigma_mono1) using card_of_Func_mono[OF _ assms] by auto
  5.2508 +  finally show ?thesis .
  5.2509 +qed
  5.2510 +
  5.2511 +lemma ordLeq_Func:
  5.2512 +assumes "{b1,b2} \<subseteq> B" "b1 \<noteq> b2"
  5.2513 +shows "|A| \<le>o |Func A B|"
  5.2514 +unfolding card_of_ordLeq[symmetric] proof(intro exI conjI)
  5.2515 +  let ?F = "\<lambda> aa a. if a \<in> A then (if a = aa then Some b1 else Some b2)
  5.2516 +                             else None"
  5.2517 +  show "inj_on ?F A" using assms unfolding inj_on_def fun_eq_iff by auto
  5.2518 +  show "?F ` A \<subseteq> Func A B" using assms unfolding Func_def apply auto
  5.2519 +  by (metis option.simps(3))
  5.2520 +qed
  5.2521 +
  5.2522 +lemma infinite_Func:
  5.2523 +assumes A: "infinite A" and B: "{b1,b2} \<subseteq> B" "b1 \<noteq> b2"
  5.2524 +shows "infinite (Func A B)"
  5.2525 +using ordLeq_Func[OF B] by (metis A card_of_ordLeq_finite)
  5.2526 +
  5.2527 +(* alternative function space avoiding the option type, with undefined instead of None *)
  5.2528 +definition Ffunc where
  5.2529 +"Ffunc A B = {f . (\<forall> a \<in> A. f a \<in> B) \<and> (\<forall> a. a \<notin> A \<longrightarrow> f a = undefined)}"
  5.2530 +
  5.2531 +lemma card_of_Func_Ffunc:
  5.2532 +"|Ffunc A B| =o |Func A B|"
  5.2533 +unfolding card_of_ordIso[symmetric] proof
  5.2534 +  let ?F = "\<lambda> f a. if a \<in> A then Some (f a) else None"
  5.2535 +  show "bij_betw ?F (Ffunc A B) (Func A B)"
  5.2536 +  unfolding bij_betw_def unfolding inj_on_def proof(intro conjI ballI impI)
  5.2537 +    fix f g assume f: "f \<in> Ffunc A B" and g: "g \<in> Ffunc A B" and eq: "?F f = ?F g"
  5.2538 +    show "f = g"
  5.2539 +    proof(rule ext)
  5.2540 +      fix a
  5.2541 +      show "f a = g a"
  5.2542 +      proof(cases "a \<in> A")
  5.2543 +        case True
  5.2544 +        have "Some (f a) = ?F f a" using True by auto
  5.2545 +        also have "... = ?F g a" using eq unfolding fun_eq_iff by(rule allE)
  5.2546 +        also have "... = Some (g a)" using True by auto
  5.2547 +        finally have "Some (f a) = Some (g a)" .
  5.2548 +        thus ?thesis by simp
  5.2549 +      qed(insert f g, unfold Ffunc_def, auto)
  5.2550 +    qed
  5.2551 +  next
  5.2552 +    show "?F ` Ffunc A B = Func A B"
  5.2553 +    proof safe
  5.2554 +      fix f assume f: "f \<in> Func A B"
  5.2555 +      def g \<equiv> "\<lambda> a. case f a of Some b \<Rightarrow> b | None \<Rightarrow> undefined"
  5.2556 +      have "g \<in> Ffunc A B"
  5.2557 +      using f unfolding g_def Func_def Ffunc_def by force+
  5.2558 +      moreover have "f = ?F g"
  5.2559 +      proof(rule ext)
  5.2560 +        fix a show "f a = ?F g a"
  5.2561 +        using f unfolding Func_def g_def by (cases "a \<in> A") force+
  5.2562 +      qed
  5.2563 +      ultimately show "f \<in> ?F ` (Ffunc A B)" by blast
  5.2564 +    qed(unfold Ffunc_def Func_def, auto)
  5.2565 +  qed
  5.2566 +qed
  5.2567 +
  5.2568 +lemma card_of_Func_UNIV:
  5.2569 +"|Func (UNIV::'a set) (B::'b set)| =o |{f::'a \<Rightarrow> 'b. range f \<subseteq> B}|"
  5.2570 +apply(rule ordIso_symmetric) proof(intro card_of_ordIsoI)
  5.2571 +  let ?F = "\<lambda> f (a::'a). Some ((f a)::'b)"
  5.2572 +  show "bij_betw ?F {f. range f \<subseteq> B} (Func UNIV B)"
  5.2573 +  unfolding bij_betw_def inj_on_def proof safe
  5.2574 +    fix h :: "'a \<Rightarrow> 'b option" assume h: "h \<in> Func UNIV B"
  5.2575 +    hence "\<forall> a. \<exists> b. h a = Some b" unfolding Func_def by auto
  5.2576 +    then obtain f where f: "\<forall> a. h a = Some (f a)" by metis
  5.2577 +    hence "range f \<subseteq> B" using h unfolding Func_def by auto
  5.2578 +    thus "h \<in> (\<lambda>f a. Some (f a)) ` {f. range f \<subseteq> B}" using f unfolding image_def by auto
  5.2579 +  qed(unfold Func_def fun_eq_iff, auto)
  5.2580 +qed
  5.2581 +
  5.2582 +end
     6.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     6.2 +++ b/src/HOL/Cardinals/Constructions_on_Wellorders.thy	Wed Sep 12 05:29:21 2012 +0200
     6.3 @@ -0,0 +1,795 @@
     6.4 +(*  Title:      HOL/Cardinals/Constructions_on_Wellorders.thy
     6.5 +    Author:     Andrei Popescu, TU Muenchen
     6.6 +    Copyright   2012
     6.7 +
     6.8 +Constructions on wellorders.
     6.9 +*)
    6.10 +
    6.11 +header {* Constructions on Wellorders *}
    6.12 +
    6.13 +theory Constructions_on_Wellorders
    6.14 +imports Constructions_on_Wellorders_Base Wellorder_Embedding
    6.15 +begin
    6.16 +
    6.17 +declare
    6.18 +  ordLeq_Well_order_simp[simp]
    6.19 +  ordLess_Well_order_simp[simp]
    6.20 +  ordIso_Well_order_simp[simp]
    6.21 +  not_ordLeq_iff_ordLess[simp]
    6.22 +  not_ordLess_iff_ordLeq[simp]
    6.23 +
    6.24 +
    6.25 +subsection {* Restriction to a set  *}
    6.26 +
    6.27 +lemma Restr_incr2:
    6.28 +"r <= r' \<Longrightarrow> Restr r A <= Restr r' A"
    6.29 +by blast
    6.30 +
    6.31 +lemma Restr_incr:
    6.32 +"\<lbrakk>r \<le> r'; A \<le> A'\<rbrakk> \<Longrightarrow> Restr r A \<le> Restr r' A'"
    6.33 +by blast
    6.34 +
    6.35 +lemma Restr_Int:
    6.36 +"Restr (Restr r A) B = Restr r (A Int B)"
    6.37 +by blast
    6.38 +
    6.39 +lemma Restr_iff: "(a,b) : Restr r A = (a : A \<and> b : A \<and> (a,b) : r)"
    6.40 +by (auto simp add: Field_def)
    6.41 +
    6.42 +lemma Restr_subset1: "Restr r A \<le> r"
    6.43 +by auto
    6.44 +
    6.45 +lemma Restr_subset2: "Restr r A \<le> A \<times> A"
    6.46 +by auto
    6.47 +
    6.48 +lemma wf_Restr:
    6.49 +"wf r \<Longrightarrow> wf(Restr r A)"
    6.50 +using wf_subset Restr_subset by blast
    6.51 +
    6.52 +lemma Restr_incr1:
    6.53 +"A \<le> B \<Longrightarrow> Restr r A \<le> Restr r B"
    6.54 +by blast
    6.55 +
    6.56 +
    6.57 +subsection {* Order filters versus restrictions and embeddings  *}
    6.58 +
    6.59 +lemma ofilter_Restr:
    6.60 +assumes WELL: "Well_order r" and
    6.61 +        OFA: "ofilter r A" and OFB: "ofilter r B" and SUB: "A \<le> B"
    6.62 +shows "ofilter (Restr r B) A"
    6.63 +proof-
    6.64 +  let ?rB = "Restr r B"
    6.65 +  have Well: "wo_rel r" unfolding wo_rel_def using WELL .
    6.66 +  hence Refl: "Refl r" by (auto simp add: wo_rel.REFL)
    6.67 +  hence Field: "Field ?rB = Field r Int B"
    6.68 +  using Refl_Field_Restr by blast
    6.69 +  have WellB: "wo_rel ?rB \<and> Well_order ?rB" using WELL
    6.70 +  by (auto simp add: Well_order_Restr wo_rel_def)
    6.71 +  (* Main proof *)
    6.72 +  show ?thesis
    6.73 +  proof(auto simp add: WellB wo_rel.ofilter_def)
    6.74 +    fix a assume "a \<in> A"
    6.75 +    hence "a \<in> Field r \<and> a \<in> B" using assms Well
    6.76 +    by (auto simp add: wo_rel.ofilter_def)
    6.77 +    with Field show "a \<in> Field(Restr r B)" by auto
    6.78 +  next
    6.79 +    fix a b assume *: "a \<in> A"  and "b \<in> under (Restr r B) a"
    6.80 +    hence "b \<in> under r a"
    6.81 +    using WELL OFB SUB ofilter_Restr_under[of r B a] by auto
    6.82 +    thus "b \<in> A" using * Well OFA by(auto simp add: wo_rel.ofilter_def)
    6.83 +  qed
    6.84 +qed
    6.85 +
    6.86 +lemma ofilter_subset_iso:
    6.87 +assumes WELL: "Well_order r" and
    6.88 +        OFA: "ofilter r A" and OFB: "ofilter r B"
    6.89 +shows "(A = B) = iso (Restr r A) (Restr r B) id"
    6.90 +using assms
    6.91 +by (auto simp add: ofilter_subset_embedS_iso)
    6.92 +
    6.93 +
    6.94 +subsection {* Ordering the  well-orders by existence of embeddings *}
    6.95 +
    6.96 +corollary ordLeq_refl_on: "refl_on {r. Well_order r} ordLeq"
    6.97 +using ordLeq_reflexive unfolding ordLeq_def refl_on_def
    6.98 +by blast
    6.99 +
   6.100 +corollary ordLeq_trans: "trans ordLeq"
   6.101 +using trans_def[of ordLeq] ordLeq_transitive by blast
   6.102 +
   6.103 +corollary ordLeq_preorder_on: "preorder_on {r. Well_order r} ordLeq"
   6.104 +by(auto simp add: preorder_on_def ordLeq_refl_on ordLeq_trans)
   6.105 +
   6.106 +corollary ordIso_refl_on: "refl_on {r. Well_order r} ordIso"
   6.107 +using ordIso_reflexive unfolding refl_on_def ordIso_def
   6.108 +by blast
   6.109 +
   6.110 +corollary ordIso_trans: "trans ordIso"
   6.111 +using trans_def[of ordIso] ordIso_transitive by blast
   6.112 +
   6.113 +corollary ordIso_sym: "sym ordIso"
   6.114 +by (auto simp add: sym_def ordIso_symmetric)
   6.115 +
   6.116 +corollary ordIso_equiv: "equiv {r. Well_order r} ordIso"
   6.117 +by (auto simp add:  equiv_def ordIso_sym ordIso_refl_on ordIso_trans)
   6.118 +
   6.119 +lemma ordLess_irrefl: "irrefl ordLess"
   6.120 +by(unfold irrefl_def, auto simp add: ordLess_irreflexive)
   6.121 +
   6.122 +lemma ordLess_or_ordIso:
   6.123 +assumes WELL: "Well_order r" and WELL': "Well_order r'"
   6.124 +shows "r <o r' \<or> r' <o r \<or> r =o r'"
   6.125 +unfolding ordLess_def ordIso_def
   6.126 +using assms embedS_or_iso[of r r'] by auto
   6.127 +
   6.128 +corollary ordLeq_ordLess_Un_ordIso:
   6.129 +"ordLeq = ordLess \<union> ordIso"
   6.130 +by (auto simp add: ordLeq_iff_ordLess_or_ordIso)
   6.131 +
   6.132 +lemma not_ordLeq_ordLess:
   6.133 +"r \<le>o r' \<Longrightarrow> \<not> r' <o r"
   6.134 +using not_ordLess_ordLeq by blast
   6.135 +
   6.136 +lemma ordIso_or_ordLess:
   6.137 +assumes WELL: "Well_order r" and WELL': "Well_order r'"
   6.138 +shows "r =o r' \<or> r <o r' \<or> r' <o r"
   6.139 +using assms ordLess_or_ordLeq ordLeq_iff_ordLess_or_ordIso by blast
   6.140 +
   6.141 +lemmas ord_trans = ordIso_transitive ordLeq_transitive ordLess_transitive
   6.142 +                   ordIso_ordLeq_trans ordLeq_ordIso_trans
   6.143 +                   ordIso_ordLess_trans ordLess_ordIso_trans
   6.144 +                   ordLess_ordLeq_trans ordLeq_ordLess_trans
   6.145 +
   6.146 +lemma ofilter_ordLeq:
   6.147 +assumes "Well_order r" and "ofilter r A"
   6.148 +shows "Restr r A \<le>o r"
   6.149 +proof-
   6.150 +  have "A \<le> Field r" using assms by (auto simp add: wo_rel_def wo_rel.ofilter_def)
   6.151 +  thus ?thesis using assms
   6.152 +  by (simp add: ofilter_subset_ordLeq wo_rel.Field_ofilter
   6.153 +      wo_rel_def Restr_Field)
   6.154 +qed
   6.155 +
   6.156 +corollary under_Restr_ordLeq:
   6.157 +"Well_order r \<Longrightarrow> Restr r (under r a) \<le>o r"
   6.158 +by (auto simp add: ofilter_ordLeq wo_rel.under_ofilter wo_rel_def)
   6.159 +
   6.160 +
   6.161 +subsection {* Copy via direct images  *}
   6.162 +
   6.163 +lemma Id_dir_image: "dir_image Id f \<le> Id"
   6.164 +unfolding dir_image_def by auto
   6.165 +
   6.166 +lemma Un_dir_image:
   6.167 +"dir_image (r1 \<union> r2) f = (dir_image r1 f) \<union> (dir_image r2 f)"
   6.168 +unfolding dir_image_def by auto
   6.169 +
   6.170 +lemma Int_dir_image:
   6.171 +assumes "inj_on f (Field r1 \<union> Field r2)"
   6.172 +shows "dir_image (r1 Int r2) f = (dir_image r1 f) Int (dir_image r2 f)"
   6.173 +proof
   6.174 +  show "dir_image (r1 Int r2) f \<le> (dir_image r1 f) Int (dir_image r2 f)"
   6.175 +  using assms unfolding dir_image_def inj_on_def by auto
   6.176 +next
   6.177 +  show "(dir_image r1 f) Int (dir_image r2 f) \<le> dir_image (r1 Int r2) f"
   6.178 +  proof(clarify)
   6.179 +    fix a' b'
   6.180 +    assume "(a',b') \<in> dir_image r1 f" "(a',b') \<in> dir_image r2 f"
   6.181 +    then obtain a1 b1 a2 b2
   6.182 +    where 1: "a' = f a1 \<and> b' = f b1 \<and> a' = f a2 \<and> b' = f b2" and
   6.183 +          2: "(a1,b1) \<in> r1 \<and> (a2,b2) \<in> r2" and
   6.184 +          3: "{a1,b1} \<le> Field r1 \<and> {a2,b2} \<le> Field r2"
   6.185 +    unfolding dir_image_def Field_def by blast
   6.186 +    hence "a1 = a2 \<and> b1 = b2" using assms unfolding inj_on_def by auto
   6.187 +    hence "a' = f a1 \<and> b' = f b1 \<and> (a1,b1) \<in> r1 Int r2 \<and> (a2,b2) \<in> r1 Int r2"
   6.188 +    using 1 2 by auto
   6.189 +    thus "(a',b') \<in> dir_image (r1 \<inter> r2) f"
   6.190 +    unfolding dir_image_def by blast
   6.191 +  qed
   6.192 +qed
   6.193 +
   6.194 +
   6.195 +subsection {* Ordinal-like sum of two (disjoint) well-orders *}
   6.196 +
   6.197 +text{* This is roughly obtained by ``concatenating" the two well-orders -- thus, all elements
   6.198 +of the first will be smaller than all elements of the second.  This construction
   6.199 +only makes sense if the fields of the two well-order relations are disjoint. *}
   6.200 +
   6.201 +definition Osum :: "'a rel \<Rightarrow> 'a rel \<Rightarrow> 'a rel"  (infix "Osum" 60)
   6.202 +where
   6.203 +"r Osum r' = r \<union> r' \<union> {(a,a'). a \<in> Field r \<and> a' \<in> Field r'}"
   6.204 +
   6.205 +abbreviation Osum2 :: "'a rel \<Rightarrow> 'a rel \<Rightarrow> 'a rel" (infix "\<union>o" 60)
   6.206 +where "r \<union>o r' \<equiv> r Osum r'"
   6.207 +
   6.208 +lemma Field_Osum: "Field(r Osum r') = Field r \<union> Field r'"
   6.209 +unfolding Osum_def Field_def by blast
   6.210 +
   6.211 +lemma Osum_Refl:
   6.212 +assumes FLD: "Field r Int Field r' = {}" and
   6.213 +        REFL: "Refl r" and REFL': "Refl r'"
   6.214 +shows "Refl (r Osum r')"
   6.215 +using assms  (* Need first unfold Field_Osum, only then Osum_def *)
   6.216 +unfolding refl_on_def  Field_Osum unfolding Osum_def by blast
   6.217 +
   6.218 +lemma Osum_trans:
   6.219 +assumes FLD: "Field r Int Field r' = {}" and
   6.220 +        TRANS: "trans r" and TRANS': "trans r'"
   6.221 +shows "trans (r Osum r')"
   6.222 +proof(unfold trans_def, auto)
   6.223 +  fix x y z assume *: "(x, y) \<in> r \<union>o r'" and **: "(y, z) \<in> r \<union>o r'"
   6.224 +  show  "(x, z) \<in> r \<union>o r'"
   6.225 +  proof-
   6.226 +    {assume Case1: "(x,y) \<in> r"
   6.227 +     hence 1: "x \<in> Field r \<and> y \<in> Field r" unfolding Field_def by auto
   6.228 +     have ?thesis
   6.229 +     proof-
   6.230 +       {assume Case11: "(y,z) \<in> r"
   6.231 +        hence "(x,z) \<in> r" using Case1 TRANS trans_def[of r] by blast
   6.232 +        hence ?thesis unfolding Osum_def by auto
   6.233 +       }
   6.234 +       moreover
   6.235 +       {assume Case12: "(y,z) \<in> r'"
   6.236 +        hence "y \<in> Field r'" unfolding Field_def by auto
   6.237 +        hence False using FLD 1 by auto
   6.238 +       }
   6.239 +       moreover
   6.240 +       {assume Case13: "z \<in> Field r'"
   6.241 +        hence ?thesis using 1 unfolding Osum_def by auto
   6.242 +       }
   6.243 +       ultimately show ?thesis using ** unfolding Osum_def by blast
   6.244 +     qed
   6.245 +    }
   6.246 +    moreover
   6.247 +    {assume Case2: "(x,y) \<in> r'"
   6.248 +     hence 2: "x \<in> Field r' \<and> y \<in> Field r'" unfolding Field_def by auto
   6.249 +     have ?thesis
   6.250 +     proof-
   6.251 +       {assume Case21: "(y,z) \<in> r"
   6.252 +        hence "y \<in> Field r" unfolding Field_def by auto
   6.253 +        hence False using FLD 2 by auto
   6.254 +       }
   6.255 +       moreover
   6.256 +       {assume Case22: "(y,z) \<in> r'"
   6.257 +        hence "(x,z) \<in> r'" using Case2 TRANS' trans_def[of r'] by blast
   6.258 +        hence ?thesis unfolding Osum_def by auto
   6.259 +       }
   6.260 +       moreover
   6.261 +       {assume Case23: "y \<in> Field r"
   6.262 +        hence False using FLD 2 by auto
   6.263 +       }
   6.264 +       ultimately show ?thesis using ** unfolding Osum_def by blast
   6.265 +     qed
   6.266 +    }
   6.267 +    moreover
   6.268 +    {assume Case3: "x \<in> Field r \<and> y \<in> Field r'"
   6.269 +     have ?thesis
   6.270 +     proof-
   6.271 +       {assume Case31: "(y,z) \<in> r"
   6.272 +        hence "y \<in> Field r" unfolding Field_def by auto
   6.273 +        hence False using FLD Case3 by auto
   6.274 +       }
   6.275 +       moreover
   6.276 +       {assume Case32: "(y,z) \<in> r'"
   6.277 +        hence "z \<in> Field r'" unfolding Field_def by blast
   6.278 +        hence ?thesis unfolding Osum_def using Case3 by auto
   6.279 +       }
   6.280 +       moreover
   6.281 +       {assume Case33: "y \<in> Field r"
   6.282 +        hence False using FLD Case3 by auto
   6.283 +       }
   6.284 +       ultimately show ?thesis using ** unfolding Osum_def by blast
   6.285 +     qed
   6.286 +    }
   6.287 +    ultimately show ?thesis using * unfolding Osum_def by blast
   6.288 +  qed
   6.289 +qed
   6.290 +
   6.291 +lemma Osum_Preorder:
   6.292 +"\<lbrakk>Field r Int Field r' = {}; Preorder r; Preorder r'\<rbrakk> \<Longrightarrow> Preorder (r Osum r')"
   6.293 +unfolding preorder_on_def using Osum_Refl Osum_trans by blast
   6.294 +
   6.295 +lemma Osum_antisym:
   6.296 +assumes FLD: "Field r Int Field r' = {}" and
   6.297 +        AN: "antisym r" and AN': "antisym r'"
   6.298 +shows "antisym (r Osum r')"
   6.299 +proof(unfold antisym_def, auto)
   6.300 +  fix x y assume *: "(x, y) \<in> r \<union>o r'" and **: "(y, x) \<in> r \<union>o r'"
   6.301 +  show  "x = y"
   6.302 +  proof-
   6.303 +    {assume Case1: "(x,y) \<in> r"
   6.304 +     hence 1: "x \<in> Field r \<and> y \<in> Field r" unfolding Field_def by auto
   6.305 +     have ?thesis
   6.306 +     proof-
   6.307 +       have "(y,x) \<in> r \<Longrightarrow> ?thesis"
   6.308 +       using Case1 AN antisym_def[of r] by blast
   6.309 +       moreover
   6.310 +       {assume "(y,x) \<in> r'"
   6.311 +        hence "y \<in> Field r'" unfolding Field_def by auto
   6.312 +        hence False using FLD 1 by auto
   6.313 +       }
   6.314 +       moreover
   6.315 +       have "x \<in> Field r' \<Longrightarrow> False" using FLD 1 by auto
   6.316 +       ultimately show ?thesis using ** unfolding Osum_def by blast
   6.317 +     qed
   6.318 +    }
   6.319 +    moreover
   6.320 +    {assume Case2: "(x,y) \<in> r'"
   6.321 +     hence 2: "x \<in> Field r' \<and> y \<in> Field r'" unfolding Field_def by auto
   6.322 +     have ?thesis
   6.323 +     proof-
   6.324 +       {assume "(y,x) \<in> r"
   6.325 +        hence "y \<in> Field r" unfolding Field_def by auto
   6.326 +        hence False using FLD 2 by auto
   6.327 +       }
   6.328 +       moreover
   6.329 +       have "(y,x) \<in> r' \<Longrightarrow> ?thesis"
   6.330 +       using Case2 AN' antisym_def[of r'] by blast
   6.331 +       moreover
   6.332 +       {assume "y \<in> Field r"
   6.333 +        hence False using FLD 2 by auto
   6.334 +       }
   6.335 +       ultimately show ?thesis using ** unfolding Osum_def by blast
   6.336 +     qed
   6.337 +    }
   6.338 +    moreover
   6.339 +    {assume Case3: "x \<in> Field r \<and> y \<in> Field r'"
   6.340 +     have ?thesis
   6.341 +     proof-
   6.342 +       {assume "(y,x) \<in> r"
   6.343 +        hence "y \<in> Field r" unfolding Field_def by auto
   6.344 +        hence False using FLD Case3 by auto
   6.345 +       }
   6.346 +       moreover
   6.347 +       {assume Case32: "(y,x) \<in> r'"
   6.348 +        hence "x \<in> Field r'" unfolding Field_def by blast
   6.349 +        hence False using FLD Case3 by auto
   6.350 +       }
   6.351 +       moreover
   6.352 +       have "\<not> y \<in> Field r" using FLD Case3 by auto
   6.353 +       ultimately show ?thesis using ** unfolding Osum_def by blast
   6.354 +     qed
   6.355 +    }
   6.356 +    ultimately show ?thesis using * unfolding Osum_def by blast
   6.357 +  qed
   6.358 +qed
   6.359 +
   6.360 +lemma Osum_Partial_order:
   6.361 +"\<lbrakk>Field r Int Field r' = {}; Partial_order r; Partial_order r'\<rbrakk> \<Longrightarrow>
   6.362 + Partial_order (r Osum r')"
   6.363 +unfolding partial_order_on_def using Osum_Preorder Osum_antisym by blast
   6.364 +
   6.365 +lemma Osum_Total:
   6.366 +assumes FLD: "Field r Int Field r' = {}" and
   6.367 +        TOT: "Total r" and TOT': "Total r'"
   6.368 +shows "Total (r Osum r')"
   6.369 +using assms
   6.370 +unfolding total_on_def  Field_Osum unfolding Osum_def by blast
   6.371 +
   6.372 +lemma Osum_Linear_order:
   6.373 +"\<lbrakk>Field r Int Field r' = {}; Linear_order r; Linear_order r'\<rbrakk> \<Longrightarrow>
   6.374 + Linear_order (r Osum r')"
   6.375 +unfolding linear_order_on_def using Osum_Partial_order Osum_Total by blast
   6.376 +
   6.377 +lemma Osum_wf:
   6.378 +assumes FLD: "Field r Int Field r' = {}" and
   6.379 +        WF: "wf r" and WF': "wf r'"
   6.380 +shows "wf (r Osum r')"
   6.381 +unfolding wf_eq_minimal2 unfolding Field_Osum
   6.382 +proof(intro allI impI, elim conjE)
   6.383 +  fix A assume *: "A \<subseteq> Field r \<union> Field r'" and **: "A \<noteq> {}"
   6.384 +  obtain B where B_def: "B = A Int Field r" by blast
   6.385 +  show "\<exists>a\<in>A. \<forall>a'\<in>A. (a', a) \<notin> r \<union>o r'"
   6.386 +  proof(cases "B = {}")
   6.387 +    assume Case1: "B \<noteq> {}"
   6.388 +    hence "B \<noteq> {} \<and> B \<le> Field r" using B_def by auto
   6.389 +    then obtain a where 1: "a \<in> B" and 2: "\<forall>a1 \<in> B. (a1,a) \<notin> r"
   6.390 +    using WF  unfolding wf_eq_minimal2 by blast
   6.391 +    hence 3: "a \<in> Field r \<and> a \<notin> Field r'" using B_def FLD by auto
   6.392 +    (*  *)
   6.393 +    have "\<forall>a1 \<in> A. (a1,a) \<notin> r Osum r'"
   6.394 +    proof(intro ballI)
   6.395 +      fix a1 assume **: "a1 \<in> A"
   6.396 +      {assume Case11: "a1 \<in> Field r"
   6.397 +       hence "(a1,a) \<notin> r" using B_def ** 2 by auto
   6.398 +       moreover
   6.399 +       have "(a1,a) \<notin> r'" using 3 by (auto simp add: Field_def)
   6.400 +       ultimately have "(a1,a) \<notin> r Osum r'"
   6.401 +       using 3 unfolding Osum_def by auto
   6.402 +      }
   6.403 +      moreover
   6.404 +      {assume Case12: "a1 \<notin> Field r"
   6.405 +       hence "(a1,a) \<notin> r" unfolding Field_def by auto
   6.406 +       moreover
   6.407 +       have "(a1,a) \<notin> r'" using 3 unfolding Field_def by auto
   6.408 +       ultimately have "(a1,a) \<notin> r Osum r'"
   6.409 +       using 3 unfolding Osum_def by auto
   6.410 +      }
   6.411 +      ultimately show "(a1,a) \<notin> r Osum r'" by blast
   6.412 +    qed
   6.413 +    thus ?thesis using 1 B_def by auto
   6.414 +  next
   6.415 +    assume Case2: "B = {}"
   6.416 +    hence 1: "A \<noteq> {} \<and> A \<le> Field r'" using * ** B_def by auto
   6.417 +    then obtain a' where 2: "a' \<in> A" and 3: "\<forall>a1' \<in> A. (a1',a') \<notin> r'"
   6.418 +    using WF' unfolding wf_eq_minimal2 by blast
   6.419 +    hence 4: "a' \<in> Field r' \<and> a' \<notin> Field r" using 1 FLD by blast
   6.420 +    (*  *)
   6.421 +    have "\<forall>a1' \<in> A. (a1',a') \<notin> r Osum r'"
   6.422 +    proof(unfold Osum_def, auto simp add: 3)
   6.423 +      fix a1' assume "(a1', a') \<in> r"
   6.424 +      thus False using 4 unfolding Field_def by blast
   6.425 +    next
   6.426 +      fix a1' assume "a1' \<in> A" and "a1' \<in> Field r"
   6.427 +      thus False using Case2 B_def by auto
   6.428 +    qed
   6.429 +    thus ?thesis using 2 by blast
   6.430 +  qed
   6.431 +qed
   6.432 +
   6.433 +lemma Osum_minus_Id:
   6.434 +assumes TOT: "Total r" and TOT': "Total r'" and
   6.435 +        NID: "\<not> (r \<le> Id)" and NID': "\<not> (r' \<le> Id)"
   6.436 +shows "(r Osum r') - Id \<le> (r - Id) Osum (r' - Id)"
   6.437 +proof-
   6.438 +  {fix a a' assume *: "(a,a') \<in> (r Osum r')" and **: "a \<noteq> a'"
   6.439 +   have "(a,a') \<in> (r - Id) Osum (r' - Id)"
   6.440 +   proof-
   6.441 +     {assume "(a,a') \<in> r \<or> (a,a') \<in> r'"
   6.442 +      with ** have ?thesis unfolding Osum_def by auto
   6.443 +     }
   6.444 +     moreover
   6.445 +     {assume "a \<in> Field r \<and> a' \<in> Field r'"
   6.446 +      hence "a \<in> Field(r - Id) \<and> a' \<in> Field (r' - Id)"
   6.447 +      using assms rel.Total_Id_Field by blast
   6.448 +      hence ?thesis unfolding Osum_def by auto
   6.449 +     }
   6.450 +     ultimately show ?thesis using * unfolding Osum_def by blast
   6.451 +   qed
   6.452 +  }
   6.453 +  thus ?thesis by(auto simp add: Osum_def)
   6.454 +qed
   6.455 +
   6.456 +
   6.457 +lemma wf_Int_Times:
   6.458 +assumes "A Int B = {}"
   6.459 +shows "wf(A \<times> B)"
   6.460 +proof(unfold wf_def, auto)
   6.461 +  fix P x
   6.462 +  assume *: "\<forall>x. (\<forall>y. y \<in> A \<and> x \<in> B \<longrightarrow> P y) \<longrightarrow> P x"
   6.463 +  moreover have "\<forall>y \<in> A. P y" using assms * by blast
   6.464 +  ultimately show "P x" using * by (case_tac "x \<in> B", auto)
   6.465 +qed
   6.466 +
   6.467 +lemma Osum_minus_Id1:
   6.468 +assumes "r \<le> Id"
   6.469 +shows "(r Osum r') - Id \<le> (r' - Id) \<union> (Field r \<times> Field r')"
   6.470 +proof-
   6.471 +  let ?Left = "(r Osum r') - Id"
   6.472 +  let ?Right = "(r' - Id) \<union> (Field r \<times> Field r')"
   6.473 +  {fix a::'a and b assume *: "(a,b) \<notin> Id"
   6.474 +   {assume "(a,b) \<in> r"
   6.475 +    with * have False using assms by auto
   6.476 +   }
   6.477 +   moreover
   6.478 +   {assume "(a,b) \<in> r'"
   6.479 +    with * have "(a,b) \<in> r' - Id" by auto
   6.480 +   }
   6.481 +   ultimately
   6.482 +   have "(a,b) \<in> ?Left \<Longrightarrow> (a,b) \<in> ?Right"
   6.483 +   unfolding Osum_def by auto
   6.484 +  }
   6.485 +  thus ?thesis by auto
   6.486 +qed
   6.487 +
   6.488 +lemma Osum_minus_Id2:
   6.489 +assumes "r' \<le> Id"
   6.490 +shows "(r Osum r') - Id \<le> (r - Id) \<union> (Field r \<times> Field r')"
   6.491 +proof-
   6.492 +  let ?Left = "(r Osum r') - Id"
   6.493 +  let ?Right = "(r - Id) \<union> (Field r \<times> Field r')"
   6.494 +  {fix a::'a and b assume *: "(a,b) \<notin> Id"
   6.495 +   {assume "(a,b) \<in> r'"
   6.496 +    with * have False using assms by auto
   6.497 +   }
   6.498 +   moreover
   6.499 +   {assume "(a,b) \<in> r"
   6.500 +    with * have "(a,b) \<in> r - Id" by auto
   6.501 +   }
   6.502 +   ultimately
   6.503 +   have "(a,b) \<in> ?Left \<Longrightarrow> (a,b) \<in> ?Right"
   6.504 +   unfolding Osum_def by auto
   6.505 +  }
   6.506 +  thus ?thesis by auto
   6.507 +qed
   6.508 +
   6.509 +lemma Osum_wf_Id:
   6.510 +assumes TOT: "Total r" and TOT': "Total r'" and
   6.511 +        FLD: "Field r Int Field r' = {}" and
   6.512 +        WF: "wf(r - Id)" and WF': "wf(r' - Id)"
   6.513 +shows "wf ((r Osum r') - Id)"
   6.514 +proof(cases "r \<le> Id \<or> r' \<le> Id")
   6.515 +  assume Case1: "\<not>(r \<le> Id \<or> r' \<le> Id)"
   6.516 +  have "Field(r - Id) Int Field(r' - Id) = {}"
   6.517 +  using FLD mono_Field[of "r - Id" r]  mono_Field[of "r' - Id" r']
   6.518 +            Diff_subset[of r Id] Diff_subset[of r' Id] by blast
   6.519 +  thus ?thesis
   6.520 +  using Case1 Osum_minus_Id[of r r'] assms Osum_wf[of "r - Id" "r' - Id"]
   6.521 +        wf_subset[of "(r - Id) \<union>o (r' - Id)" "(r Osum r') - Id"] by auto
   6.522 +next
   6.523 +  have 1: "wf(Field r \<times> Field r')"
   6.524 +  using FLD by (auto simp add: wf_Int_Times)
   6.525 +  assume Case2: "r \<le> Id \<or> r' \<le> Id"
   6.526 +  moreover
   6.527 +  {assume Case21: "r \<le> Id"
   6.528 +   hence "(r Osum r') - Id \<le> (r' - Id) \<union> (Field r \<times> Field r')"
   6.529 +   using Osum_minus_Id1[of r r'] by simp
   6.530 +   moreover
   6.531 +   {have "Domain(Field r \<times> Field r') Int Range(r' - Id) = {}"
   6.532 +    using FLD unfolding Field_def by blast
   6.533 +    hence "wf((r' - Id) \<union> (Field r \<times> Field r'))"
   6.534 +    using 1 WF' wf_Un[of "Field r \<times> Field r'" "r' - Id"]
   6.535 +    by (auto simp add: Un_commute)
   6.536 +   }
   6.537 +   ultimately have ?thesis by (auto simp add: wf_subset)
   6.538 +  }
   6.539 +  moreover
   6.540 +  {assume Case22: "r' \<le> Id"
   6.541 +   hence "(r Osum r') - Id \<le> (r - Id) \<union> (Field r \<times> Field r')"
   6.542 +   using Osum_minus_Id2[of r' r] by simp
   6.543 +   moreover
   6.544 +   {have "Range(Field r \<times> Field r') Int Domain(r - Id) = {}"
   6.545 +    using FLD unfolding Field_def by blast
   6.546 +    hence "wf((r - Id) \<union> (Field r \<times> Field r'))"
   6.547 +    using 1 WF wf_Un[of "r - Id" "Field r \<times> Field r'"]
   6.548 +    by (auto simp add: Un_commute)
   6.549 +   }
   6.550 +   ultimately have ?thesis by (auto simp add: wf_subset)
   6.551 +  }
   6.552 +  ultimately show ?thesis by blast
   6.553 +qed
   6.554 +
   6.555 +lemma Osum_Well_order:
   6.556 +assumes FLD: "Field r Int Field r' = {}" and
   6.557 +        WELL: "Well_order r" and WELL': "Well_order r'"
   6.558 +shows "Well_order (r Osum r')"
   6.559 +proof-
   6.560 +  have "Total r \<and> Total r'" using WELL WELL'
   6.561 +  by (auto simp add: order_on_defs)
   6.562 +  thus ?thesis using assms unfolding well_order_on_def
   6.563 +  using Osum_Linear_order Osum_wf_Id by blast
   6.564 +qed
   6.565 +
   6.566 +lemma Osum_embed:
   6.567 +assumes FLD: "Field r Int Field r' = {}" and
   6.568 +        WELL: "Well_order r" and WELL': "Well_order r'"
   6.569 +shows "embed r (r Osum r') id"
   6.570 +proof-
   6.571 +  have 1: "Well_order (r Osum r')"
   6.572 +  using assms by (auto simp add: Osum_Well_order)
   6.573 +  moreover
   6.574 +  have "compat r (r Osum r') id"
   6.575 +  unfolding compat_def Osum_def by auto
   6.576 +  moreover
   6.577 +  have "inj_on id (Field r)" by simp
   6.578 +  moreover
   6.579 +  have "ofilter (r Osum r') (Field r)"
   6.580 +  using 1 proof(auto simp add: wo_rel_def wo_rel.ofilter_def
   6.581 +                               Field_Osum rel.under_def)
   6.582 +    fix a b assume 2: "a \<in> Field r" and 3: "(b,a) \<in> r Osum r'"
   6.583 +    moreover
   6.584 +    {assume "(b,a) \<in> r'"
   6.585 +     hence "a \<in> Field r'" using Field_def[of r'] by blast
   6.586 +     hence False using 2 FLD by blast
   6.587 +    }
   6.588 +    moreover
   6.589 +    {assume "a \<in> Field r'"
   6.590 +     hence False using 2 FLD by blast
   6.591 +    }
   6.592 +    ultimately
   6.593 +    show "b \<in> Field r" by (auto simp add: Osum_def Field_def)
   6.594 +  qed
   6.595 +  ultimately show ?thesis
   6.596 +  using assms by (auto simp add: embed_iff_compat_inj_on_ofilter)
   6.597 +qed
   6.598 +
   6.599 +corollary Osum_ordLeq:
   6.600 +assumes FLD: "Field r Int Field r' = {}" and
   6.601 +        WELL: "Well_order r" and WELL': "Well_order r'"
   6.602 +shows "r \<le>o r Osum r'"
   6.603 +using assms Osum_embed Osum_Well_order
   6.604 +unfolding ordLeq_def by blast
   6.605 +
   6.606 +lemma Well_order_embed_copy:
   6.607 +assumes WELL: "well_order_on A r" and
   6.608 +        INJ: "inj_on f A" and SUB: "f ` A \<le> B"
   6.609 +shows "\<exists>r'. well_order_on B r' \<and> r \<le>o r'"
   6.610 +proof-
   6.611 +  have "bij_betw f A (f ` A)"
   6.612 +  using INJ inj_on_imp_bij_betw by blast
   6.613 +  then obtain r'' where "well_order_on (f ` A) r''" and 1: "r =o r''"
   6.614 +  using WELL  Well_order_iso_copy by blast
   6.615 +  hence 2: "Well_order r'' \<and> Field r'' = (f ` A)"
   6.616 +  using rel.well_order_on_Well_order by blast
   6.617 +  (*  *)
   6.618 +  let ?C = "B - (f ` A)"
   6.619 +  obtain r''' where "well_order_on ?C r'''"
   6.620 +  using well_order_on by blast
   6.621 +  hence 3: "Well_order r''' \<and> Field r''' = ?C"
   6.622 +  using rel.well_order_on_Well_order by blast
   6.623 +  (*  *)
   6.624 +  let ?r' = "r'' Osum r'''"
   6.625 +  have "Field r'' Int Field r''' = {}"
   6.626 +  using 2 3 by auto
   6.627 +  hence "r'' \<le>o ?r'" using Osum_ordLeq[of r'' r'''] 2 3 by blast
   6.628 +  hence 4: "r \<le>o ?r'" using 1 ordIso_ordLeq_trans by blast
   6.629 +  (*  *)
   6.630 +  hence "Well_order ?r'" unfolding ordLeq_def by auto
   6.631 +  moreover
   6.632 +  have "Field ?r' = B" using 2 3 SUB by (auto simp add: Field_Osum)
   6.633 +  ultimately show ?thesis using 4 by blast
   6.634 +qed
   6.635 +
   6.636 +
   6.637 +subsection {* The maxim among a finite set of ordinals  *}
   6.638 +
   6.639 +text {* The correct phrasing would be ``a maxim of ...", as @{text "\<le>o"} is only a preorder. *}
   6.640 +
   6.641 +definition isOmax :: "'a rel set \<Rightarrow> 'a rel \<Rightarrow> bool"
   6.642 +where
   6.643 +"isOmax  R r == r \<in> R \<and> (ALL r' : R. r' \<le>o r)"
   6.644 +
   6.645 +definition omax :: "'a rel set \<Rightarrow> 'a rel"
   6.646 +where
   6.647 +"omax R == SOME r. isOmax R r"
   6.648 +
   6.649 +lemma exists_isOmax:
   6.650 +assumes "finite R" and "R \<noteq> {}" and "\<forall> r \<in> R. Well_order r"
   6.651 +shows "\<exists> r. isOmax R r"
   6.652 +proof-
   6.653 +  have "finite R \<Longrightarrow> R \<noteq> {} \<longrightarrow> (\<forall> r \<in> R. Well_order r) \<longrightarrow> (\<exists> r. isOmax R r)"
   6.654 +  apply(erule finite_induct) apply(simp add: isOmax_def)
   6.655 +  proof(clarsimp)
   6.656 +    fix r :: "('a \<times> 'a) set" and R assume *: "finite R" and **: "r \<notin> R"
   6.657 +    and ***: "Well_order r" and ****: "\<forall>r\<in>R. Well_order r"
   6.658 +    and IH: "R \<noteq> {} \<longrightarrow> (\<exists>p. isOmax R p)"
   6.659 +    let ?R' = "insert r R"
   6.660 +    show "\<exists>p'. (isOmax ?R' p')"
   6.661 +    proof(cases "R = {}")
   6.662 +      assume Case1: "R = {}"
   6.663 +      thus ?thesis unfolding isOmax_def using ***
   6.664 +      by (simp add: ordLeq_reflexive)
   6.665 +    next
   6.666 +      assume Case2: "R \<noteq> {}"
   6.667 +      then obtain p where p: "isOmax R p" using IH by auto
   6.668 +      hence 1: "Well_order p" using **** unfolding isOmax_def by simp
   6.669 +      {assume Case21: "r \<le>o p"
   6.670 +       hence "isOmax ?R' p" using p unfolding isOmax_def by simp
   6.671 +       hence ?thesis by auto
   6.672 +      }
   6.673 +      moreover
   6.674 +      {assume Case22: "p \<le>o r"
   6.675 +       {fix r' assume "r' \<in> ?R'"
   6.676 +        moreover
   6.677 +        {assume "r' \<in> R"
   6.678 +         hence "r' \<le>o p" using p unfolding isOmax_def by simp
   6.679 +         hence "r' \<le>o r" using Case22 by(rule ordLeq_transitive)
   6.680 +        }
   6.681 +        moreover have "r \<le>o r" using *** by(rule ordLeq_reflexive)
   6.682 +        ultimately have "r' \<le>o r" by auto
   6.683 +       }
   6.684 +       hence "isOmax ?R' r" unfolding isOmax_def by simp
   6.685 +       hence ?thesis by auto
   6.686 +      }
   6.687 +      moreover have "r \<le>o p \<or> p \<le>o r"
   6.688 +      using 1 *** ordLeq_total by auto
   6.689 +      ultimately show ?thesis by blast
   6.690 +    qed
   6.691 +  qed
   6.692 +  thus ?thesis using assms by auto
   6.693 +qed
   6.694 +
   6.695 +lemma omax_isOmax:
   6.696 +assumes "finite R" and "R \<noteq> {}" and "\<forall> r \<in> R. Well_order r"
   6.697 +shows "isOmax R (omax R)"
   6.698 +unfolding omax_def using assms
   6.699 +by(simp add: exists_isOmax someI_ex)
   6.700 +
   6.701 +lemma omax_in:
   6.702 +assumes "finite R" and "R \<noteq> {}" and "\<forall> r \<in> R. Well_order r"
   6.703 +shows "omax R \<in> R"
   6.704 +using assms omax_isOmax unfolding isOmax_def by blast
   6.705 +
   6.706 +lemma Well_order_omax:
   6.707 +assumes "finite R" and "R \<noteq> {}" and "\<forall>r\<in>R. Well_order r"
   6.708 +shows "Well_order (omax R)"
   6.709 +using assms apply - apply(drule omax_in) by auto
   6.710 +
   6.711 +lemma omax_maxim:
   6.712 +assumes "finite R" and "\<forall> r \<in> R. Well_order r" and "r \<in> R"
   6.713 +shows "r \<le>o omax R"
   6.714 +using assms omax_isOmax unfolding isOmax_def by blast
   6.715 +
   6.716 +lemma omax_ordLeq:
   6.717 +assumes "finite R" and "R \<noteq> {}" and *: "\<forall> r \<in> R. r \<le>o p"
   6.718 +shows "omax R \<le>o p"
   6.719 +proof-
   6.720 +  have "\<forall> r \<in> R. Well_order r" using * unfolding ordLeq_def by simp
   6.721 +  thus ?thesis using assms omax_in by auto
   6.722 +qed
   6.723 +
   6.724 +lemma omax_ordLess:
   6.725 +assumes "finite R" and "R \<noteq> {}" and *: "\<forall> r \<in> R. r <o p"
   6.726 +shows "omax R <o p"
   6.727 +proof-
   6.728 +  have "\<forall> r \<in> R. Well_order r" using * unfolding ordLess_def by simp
   6.729 +  thus ?thesis using assms omax_in by auto
   6.730 +qed
   6.731 +
   6.732 +lemma omax_ordLeq_elim:
   6.733 +assumes "finite R" and "\<forall> r \<in> R. Well_order r"
   6.734 +and "omax R \<le>o p" and "r \<in> R"
   6.735 +shows "r \<le>o p"
   6.736 +using assms omax_maxim[of R r] apply simp
   6.737 +using ordLeq_transitive by blast
   6.738 +
   6.739 +lemma omax_ordLess_elim:
   6.740 +assumes "finite R" and "\<forall> r \<in> R. Well_order r"
   6.741 +and "omax R <o p" and "r \<in> R"
   6.742 +shows "r <o p"
   6.743 +using assms omax_maxim[of R r] apply simp
   6.744 +using ordLeq_ordLess_trans by blast
   6.745 +
   6.746 +lemma ordLeq_omax:
   6.747 +assumes "finite R" and "\<forall> r \<in> R. Well_order r"
   6.748 +and "r \<in> R" and "p \<le>o r"
   6.749 +shows "p \<le>o omax R"
   6.750 +using assms omax_maxim[of R r] apply simp
   6.751 +using ordLeq_transitive by blast
   6.752 +
   6.753 +lemma ordLess_omax:
   6.754 +assumes "finite R" and "\<forall> r \<in> R. Well_order r"
   6.755 +and "r \<in> R" and "p <o r"
   6.756 +shows "p <o omax R"
   6.757 +using assms omax_maxim[of R r] apply simp
   6.758 +using ordLess_ordLeq_trans by blast
   6.759 +
   6.760 +lemma omax_ordLeq_mono:
   6.761 +assumes P: "finite P" and R: "finite R"
   6.762 +and NE_P: "P \<noteq> {}" and Well_R: "\<forall> r \<in> R. Well_order r"
   6.763 +and LEQ: "\<forall> p \<in> P. \<exists> r \<in> R. p \<le>o r"
   6.764 +shows "omax P \<le>o omax R"
   6.765 +proof-
   6.766 +  let ?mp = "omax P"  let ?mr = "omax R"
   6.767 +  {fix p assume "p : P"
   6.768 +   then obtain r where r: "r : R" and "p \<le>o r"
   6.769 +   using LEQ by blast
   6.770 +   moreover have "r <=o ?mr"
   6.771 +   using r R Well_R omax_maxim by blast
   6.772 +   ultimately have "p <=o ?mr"
   6.773 +   using ordLeq_transitive by blast
   6.774 +  }
   6.775 +  thus "?mp <=o ?mr"
   6.776 +  using NE_P P using omax_ordLeq by blast
   6.777 +qed
   6.778 +
   6.779 +lemma omax_ordLess_mono:
   6.780 +assumes P: "finite P" and R: "finite R"
   6.781 +and NE_P: "P \<noteq> {}" and Well_R: "\<forall> r \<in> R. Well_order r"
   6.782 +and LEQ: "\<forall> p \<in> P. \<exists> r \<in> R. p <o r"
   6.783 +shows "omax P <o omax R"
   6.784 +proof-
   6.785 +  let ?mp = "omax P"  let ?mr = "omax R"
   6.786 +  {fix p assume "p : P"
   6.787 +   then obtain r where r: "r : R" and "p <o r"
   6.788 +   using LEQ by blast
   6.789 +   moreover have "r <=o ?mr"
   6.790 +   using r R Well_R omax_maxim by blast
   6.791 +   ultimately have "p <o ?mr"
   6.792 +   using ordLess_ordLeq_trans by blast
   6.793 +  }
   6.794 +  thus "?mp <o ?mr"
   6.795 +  using NE_P P omax_ordLess by blast
   6.796 +qed
   6.797 +
   6.798 +end
     7.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     7.2 +++ b/src/HOL/Cardinals/Constructions_on_Wellorders_Base.thy	Wed Sep 12 05:29:21 2012 +0200
     7.3 @@ -0,0 +1,1633 @@
     7.4 +(*  Title:      HOL/Cardinals/Constructions_on_Wellorders_Base.thy
     7.5 +    Author:     Andrei Popescu, TU Muenchen
     7.6 +    Copyright   2012
     7.7 +
     7.8 +Constructions on wellorders (base).
     7.9 +*)
    7.10 +
    7.11 +header {* Constructions on Wellorders (Base) *}
    7.12 +
    7.13 +theory Constructions_on_Wellorders_Base
    7.14 +imports Wellorder_Embedding_Base
    7.15 +begin
    7.16 +
    7.17 +
    7.18 +text {* In this section, we study basic constructions on well-orders, such as restriction to
    7.19 +a set/order filter, copy via direct images, ordinal-like sum of disjoint well-orders,
    7.20 +and bounded square.  We also define between well-orders
    7.21 +the relations @{text "ordLeq"}, of being embedded (abbreviated @{text "\<le>o"}),
    7.22 +@{text "ordLess"}, of being strictly embedded (abbreviated @{text "<o"}), and
    7.23 +@{text "ordIso"}, of being isomorphic (abbreviated @{text "=o"}).  We study the
    7.24 +connections between these relations, order filters, and the aforementioned constructions.
    7.25 +A main result of this section is that @{text "<o"} is well-founded.  *}
    7.26 +
    7.27 +
    7.28 +subsection {* Restriction to a set  *}
    7.29 +
    7.30 +
    7.31 +abbreviation Restr :: "'a rel \<Rightarrow> 'a set \<Rightarrow> 'a rel"
    7.32 +where "Restr r A \<equiv> r Int (A \<times> A)"
    7.33 +
    7.34 +
    7.35 +lemma Restr_subset:
    7.36 +"A \<le> B \<Longrightarrow> Restr (Restr r B) A = Restr r A"
    7.37 +by blast
    7.38 +
    7.39 +
    7.40 +lemma Restr_Field: "Restr r (Field r) = r"
    7.41 +unfolding Field_def by auto
    7.42 +
    7.43 +
    7.44 +lemma Refl_Restr: "Refl r \<Longrightarrow> Refl(Restr r A)"
    7.45 +unfolding refl_on_def Field_def by auto
    7.46 +
    7.47 +
    7.48 +lemma antisym_Restr:
    7.49 +"antisym r \<Longrightarrow> antisym(Restr r A)"
    7.50 +unfolding antisym_def Field_def by auto
    7.51 +
    7.52 +
    7.53 +lemma Total_Restr:
    7.54 +"Total r \<Longrightarrow> Total(Restr r A)"
    7.55 +unfolding total_on_def Field_def by auto
    7.56 +
    7.57 +
    7.58 +lemma trans_Restr:
    7.59 +"trans r \<Longrightarrow> trans(Restr r A)"
    7.60 +unfolding trans_def Field_def by blast
    7.61 +
    7.62 +
    7.63 +lemma Preorder_Restr:
    7.64 +"Preorder r \<Longrightarrow> Preorder(Restr r A)"
    7.65 +unfolding preorder_on_def by (simp add: Refl_Restr trans_Restr)
    7.66 +
    7.67 +
    7.68 +lemma Partial_order_Restr:
    7.69 +"Partial_order r \<Longrightarrow> Partial_order(Restr r A)"
    7.70 +unfolding partial_order_on_def by (simp add: Preorder_Restr antisym_Restr)
    7.71 +
    7.72 +
    7.73 +lemma Linear_order_Restr:
    7.74 +"Linear_order r \<Longrightarrow> Linear_order(Restr r A)"
    7.75 +unfolding linear_order_on_def by (simp add: Partial_order_Restr Total_Restr)
    7.76 +
    7.77 +
    7.78 +lemma Well_order_Restr:
    7.79 +assumes "Well_order r"
    7.80 +shows "Well_order(Restr r A)"
    7.81 +proof-
    7.82 +  have "Restr r A - Id \<le> r - Id" using Restr_subset by blast
    7.83 +  hence "wf(Restr r A - Id)" using assms
    7.84 +  using well_order_on_def wf_subset by blast
    7.85 +  thus ?thesis using assms unfolding well_order_on_def
    7.86 +  by (simp add: Linear_order_Restr)
    7.87 +qed
    7.88 +
    7.89 +
    7.90 +lemma Field_Restr_subset: "Field(Restr r A) \<le> A"
    7.91 +by (auto simp add: Field_def)
    7.92 +
    7.93 +
    7.94 +lemma Refl_Field_Restr:
    7.95 +"Refl r \<Longrightarrow> Field(Restr r A) = (Field r) Int A"
    7.96 +by (auto simp add: refl_on_def Field_def)
    7.97 +
    7.98 +
    7.99 +lemma Refl_Field_Restr2:
   7.100 +"\<lbrakk>Refl r; A \<le> Field r\<rbrakk> \<Longrightarrow> Field(Restr r A) = A"
   7.101 +by (auto simp add: Refl_Field_Restr)
   7.102 +
   7.103 +
   7.104 +lemma well_order_on_Restr:
   7.105 +assumes WELL: "Well_order r" and SUB: "A \<le> Field r"
   7.106 +shows "well_order_on A (Restr r A)"
   7.107 +using assms
   7.108 +using Well_order_Restr[of r A] Refl_Field_Restr2[of r A]
   7.109 +     order_on_defs[of "Field r" r] by auto
   7.110 +
   7.111 +
   7.112 +subsection {* Order filters versus restrictions and embeddings  *}
   7.113 +
   7.114 +
   7.115 +lemma Field_Restr_ofilter:
   7.116 +"\<lbrakk>Well_order r; wo_rel.ofilter r A\<rbrakk> \<Longrightarrow> Field(Restr r A) = A"
   7.117 +by (auto simp add: wo_rel_def wo_rel.ofilter_def wo_rel.REFL Refl_Field_Restr2)
   7.118 +
   7.119 +
   7.120 +lemma ofilter_Restr_under:
   7.121 +assumes WELL: "Well_order r" and OF: "wo_rel.ofilter r A" and IN: "a \<in> A"
   7.122 +shows "rel.under (Restr r A) a = rel.under r a"
   7.123 +using assms wo_rel_def
   7.124 +proof(auto simp add: wo_rel.ofilter_def rel.under_def)
   7.125 +  fix b assume *: "a \<in> A" and "(b,a) \<in> r"
   7.126 +  hence "b \<in> rel.under r a \<and> a \<in> Field r"
   7.127 +  unfolding rel.under_def using Field_def by fastforce
   7.128 +  thus "b \<in> A" using * assms by (auto simp add: wo_rel_def wo_rel.ofilter_def)
   7.129 +qed
   7.130 +
   7.131 +
   7.132 +lemma ofilter_embed:
   7.133 +assumes "Well_order r"
   7.134 +shows "wo_rel.ofilter r A = (A \<le> Field r \<and> embed (Restr r A) r id)"
   7.135 +proof
   7.136 +  assume *: "wo_rel.ofilter r A"
   7.137 +  show "A \<le> Field r \<and> embed (Restr r A) r id"
   7.138 +  proof(unfold embed_def, auto)
   7.139 +    fix a assume "a \<in> A" thus "a \<in> Field r" using assms *
   7.140 +    by (auto simp add: wo_rel_def wo_rel.ofilter_def)
   7.141 +  next
   7.142 +    fix a assume "a \<in> Field (Restr r A)"
   7.143 +    thus "bij_betw id (rel.under (Restr r A) a) (rel.under r a)" using assms *
   7.144 +    by (simp add: ofilter_Restr_under Field_Restr_ofilter)
   7.145 +  qed
   7.146 +next
   7.147 +  assume *: "A \<le> Field r \<and> embed (Restr r A) r id"
   7.148 +  hence "Field(Restr r A) \<le> Field r"
   7.149 +  using assms  embed_Field[of "Restr r A" r id] id_def
   7.150 +        Well_order_Restr[of r] by auto
   7.151 +  {fix a assume "a \<in> A"
   7.152 +   hence "a \<in> Field(Restr r A)" using * assms
   7.153 +   by (simp add: order_on_defs Refl_Field_Restr2)
   7.154 +   hence "bij_betw id (rel.under (Restr r A) a) (rel.under r a)"
   7.155 +   using * unfolding embed_def by auto
   7.156 +   hence "rel.under r a \<le> rel.under (Restr r A) a"
   7.157 +   unfolding bij_betw_def by auto
   7.158 +   also have "\<dots> \<le> Field(Restr r A)" by (simp add: rel.under_Field)
   7.159 +   also have "\<dots> \<le> A" by (simp add: Field_Restr_subset)
   7.160 +   finally have "rel.under r a \<le> A" .
   7.161 +  }
   7.162 +  thus "wo_rel.ofilter r A" using assms * by (simp add: wo_rel_def wo_rel.ofilter_def)
   7.163 +qed
   7.164 +
   7.165 +
   7.166 +lemma ofilter_Restr_Int:
   7.167 +assumes WELL: "Well_order r" and OFA: "wo_rel.ofilter r A"
   7.168 +shows "wo_rel.ofilter (Restr r B) (A Int B)"
   7.169 +proof-
   7.170 +  let ?rB = "Restr r B"
   7.171 +  have Well: "wo_rel r" unfolding wo_rel_def using WELL .
   7.172 +  hence Refl: "Refl r" by (simp add: wo_rel.REFL)
   7.173 +  hence Field: "Field ?rB = Field r Int B"
   7.174 +  using Refl_Field_Restr by blast
   7.175 +  have WellB: "wo_rel ?rB \<and> Well_order ?rB" using WELL
   7.176 +  by (simp add: Well_order_Restr wo_rel_def)
   7.177 +  (* Main proof *)
   7.178 +  show ?thesis using WellB assms
   7.179 +  proof(auto simp add: wo_rel.ofilter_def rel.under_def)
   7.180 +    fix a assume "a \<in> A" and *: "a \<in> B"
   7.181 +    hence "a \<in> Field r" using OFA Well by (auto simp add: wo_rel.ofilter_def)
   7.182 +    with * show "a \<in> Field ?rB" using Field by auto
   7.183 +  next
   7.184 +    fix a b assume "a \<in> A" and "(b,a) \<in> r"
   7.185 +    thus "b \<in> A" using Well OFA by (auto simp add: wo_rel.ofilter_def rel.under_def)
   7.186 +  qed
   7.187 +qed
   7.188 +
   7.189 +
   7.190 +lemma ofilter_Restr_subset:
   7.191 +assumes WELL: "Well_order r" and OFA: "wo_rel.ofilter r A" and SUB: "A \<le> B"
   7.192 +shows "wo_rel.ofilter (Restr r B) A"
   7.193 +proof-
   7.194 +  have "A Int B = A" using SUB by blast
   7.195 +  thus ?thesis using assms ofilter_Restr_Int[of r A B] by auto
   7.196 +qed
   7.197 +
   7.198 +
   7.199 +lemma ofilter_subset_embed:
   7.200 +assumes WELL: "Well_order r" and
   7.201 +        OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
   7.202 +shows "(A \<le> B) = (embed (Restr r A) (Restr r B) id)"
   7.203 +proof-
   7.204 +  let ?rA = "Restr r A"  let ?rB = "Restr r B"
   7.205 +  have Well: "wo_rel r" unfolding wo_rel_def using WELL .
   7.206 +  hence Refl: "Refl r" by (simp add: wo_rel.REFL)
   7.207 +  hence FieldA: "Field ?rA = Field r Int A"
   7.208 +  using Refl_Field_Restr by blast
   7.209 +  have FieldB: "Field ?rB = Field r Int B"
   7.210 +  using Refl Refl_Field_Restr by blast
   7.211 +  have WellA: "wo_rel ?rA \<and> Well_order ?rA" using WELL
   7.212 +  by (simp add: Well_order_Restr wo_rel_def)
   7.213 +  have WellB: "wo_rel ?rB \<and> Well_order ?rB" using WELL
   7.214 +  by (simp add: Well_order_Restr wo_rel_def)
   7.215 +  (* Main proof *)
   7.216 +  show ?thesis
   7.217 +  proof
   7.218 +    assume *: "A \<le> B"
   7.219 +    hence "wo_rel.ofilter (Restr r B) A" using assms
   7.220 +    by (simp add: ofilter_Restr_subset)
   7.221 +    hence "embed (Restr ?rB A) (Restr r B) id"
   7.222 +    using WellB ofilter_embed[of "?rB" A] by auto
   7.223 +    thus "embed (Restr r A) (Restr r B) id"
   7.224 +    using * by (simp add: Restr_subset)
   7.225 +  next
   7.226 +    assume *: "embed (Restr r A) (Restr r B) id"
   7.227 +    {fix a assume **: "a \<in> A"
   7.228 +     hence "a \<in> Field r" using Well OFA by (auto simp add: wo_rel.ofilter_def)
   7.229 +     with ** FieldA have "a \<in> Field ?rA" by auto
   7.230 +     hence "a \<in> Field ?rB" using * WellA embed_Field[of ?rA ?rB id] by auto
   7.231 +     hence "a \<in> B" using FieldB by auto
   7.232 +    }
   7.233 +    thus "A \<le> B" by blast
   7.234 +  qed
   7.235 +qed
   7.236 +
   7.237 +
   7.238 +lemma ofilter_subset_embedS_iso:
   7.239 +assumes WELL: "Well_order r" and
   7.240 +        OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
   7.241 +shows "((A < B) = (embedS (Restr r A) (Restr r B) id)) \<and>
   7.242 +       ((A = B) = (iso (Restr r A) (Restr r B) id))"
   7.243 +proof-
   7.244 +  let ?rA = "Restr r A"  let ?rB = "Restr r B"
   7.245 +  have Well: "wo_rel r" unfolding wo_rel_def using WELL .
   7.246 +  hence Refl: "Refl r" by (simp add: wo_rel.REFL)
   7.247 +  hence "Field ?rA = Field r Int A"
   7.248 +  using Refl_Field_Restr by blast
   7.249 +  hence FieldA: "Field ?rA = A" using OFA Well
   7.250 +  by (auto simp add: wo_rel.ofilter_def)
   7.251 +  have "Field ?rB = Field r Int B"
   7.252 +  using Refl Refl_Field_Restr by blast
   7.253 +  hence FieldB: "Field ?rB = B" using OFB Well
   7.254 +  by (auto simp add: wo_rel.ofilter_def)
   7.255 +  (* Main proof *)
   7.256 +  show ?thesis unfolding embedS_def iso_def
   7.257 +  using assms ofilter_subset_embed[of r A B]
   7.258 +        FieldA FieldB bij_betw_id_iff[of A B] by auto
   7.259 +qed
   7.260 +
   7.261 +
   7.262 +lemma ofilter_subset_embedS:
   7.263 +assumes WELL: "Well_order r" and
   7.264 +        OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
   7.265 +shows "(A < B) = embedS (Restr r A) (Restr r B) id"
   7.266 +using assms by (simp add: ofilter_subset_embedS_iso)
   7.267 +
   7.268 +
   7.269 +lemma embed_implies_iso_Restr:
   7.270 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and
   7.271 +        EMB: "embed r' r f"
   7.272 +shows "iso r' (Restr r (f ` (Field r'))) f"
   7.273 +proof-
   7.274 +  let ?A' = "Field r'"
   7.275 +  let ?r'' = "Restr r (f ` ?A')"
   7.276 +  have 0: "Well_order ?r''" using WELL Well_order_Restr by blast
   7.277 +  have 1: "wo_rel.ofilter r (f ` ?A')" using assms embed_Field_ofilter  by blast
   7.278 +  hence "Field ?r'' = f ` (Field r')" using WELL Field_Restr_ofilter by blast
   7.279 +  hence "bij_betw f ?A' (Field ?r'')"
   7.280 +  using EMB embed_inj_on WELL' unfolding bij_betw_def by blast
   7.281 +  moreover
   7.282 +  {have "\<forall>a b. (a,b) \<in> r' \<longrightarrow> a \<in> Field r' \<and> b \<in> Field r'"
   7.283 +   unfolding Field_def by auto
   7.284 +   hence "compat r' ?r'' f"
   7.285 +   using assms embed_iff_compat_inj_on_ofilter
   7.286 +   unfolding compat_def by blast
   7.287 +  }
   7.288 +  ultimately show ?thesis using WELL' 0 iso_iff3 by blast
   7.289 +qed
   7.290 +
   7.291 +
   7.292 +subsection {* The strict inclusion on proper ofilters is well-founded *}
   7.293 +
   7.294 +
   7.295 +definition ofilterIncl :: "'a rel \<Rightarrow> 'a set rel"
   7.296 +where
   7.297 +"ofilterIncl r \<equiv> {(A,B). wo_rel.ofilter r A \<and> A \<noteq> Field r \<and>
   7.298 +                         wo_rel.ofilter r B \<and> B \<noteq> Field r \<and> A < B}"
   7.299 +
   7.300 +
   7.301 +lemma wf_ofilterIncl:
   7.302 +assumes WELL: "Well_order r"
   7.303 +shows "wf(ofilterIncl r)"
   7.304 +proof-
   7.305 +  have Well: "wo_rel r" using WELL by (simp add: wo_rel_def)
   7.306 +  hence Lo: "Linear_order r" by (simp add: wo_rel.LIN)
   7.307 +  let ?h = "(\<lambda> A. wo_rel.suc r A)"
   7.308 +  let ?rS = "r - Id"
   7.309 +  have "wf ?rS" using WELL by (simp add: order_on_defs)
   7.310 +  moreover
   7.311 +  have "compat (ofilterIncl r) ?rS ?h"
   7.312 +  proof(unfold compat_def ofilterIncl_def,
   7.313 +        intro allI impI, simp, elim conjE)
   7.314 +    fix A B
   7.315 +    assume *: "wo_rel.ofilter r A" "A \<noteq> Field r" and
   7.316 +           **: "wo_rel.ofilter r B" "B \<noteq> Field r" and ***: "A < B"
   7.317 +    then obtain a and b where 0: "a \<in> Field r \<and> b \<in> Field r" and
   7.318 +                         1: "A = rel.underS r a \<and> B = rel.underS r b"
   7.319 +    using Well by (auto simp add: wo_rel.ofilter_underS_Field)
   7.320 +    hence "a \<noteq> b" using *** by auto
   7.321 +    moreover
   7.322 +    have "(a,b) \<in> r" using 0 1 Lo ***
   7.323 +    by (auto simp add: rel.underS_incl_iff)
   7.324 +    moreover
   7.325 +    have "a = wo_rel.suc r A \<and> b = wo_rel.suc r B"
   7.326 +    using Well 0 1 by (simp add: wo_rel.suc_underS)
   7.327 +    ultimately
   7.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"
   7.329 +    by simp
   7.330 +  qed
   7.331 +  ultimately show "wf (ofilterIncl r)" by (simp add: compat_wf)
   7.332 +qed
   7.333 +
   7.334 +
   7.335 +
   7.336 +subsection {* Ordering the  well-orders by existence of embeddings *}
   7.337 +
   7.338 +
   7.339 +text {* We define three relations between well-orders:
   7.340 +\begin{itemize}
   7.341 +\item @{text "ordLeq"}, of being embedded (abbreviated @{text "\<le>o"});
   7.342 +\item @{text "ordLess"}, of being strictly embedded (abbreviated @{text "<o"});
   7.343 +\item @{text "ordIso"}, of being isomorphic (abbreviated @{text "=o"}).
   7.344 +\end{itemize}
   7.345 +%
   7.346 +The prefix "ord" and the index "o" in these names stand for "ordinal-like".
   7.347 +These relations shall be proved to be inter-connected in a similar fashion as the trio
   7.348 +@{text "\<le>"}, @{text "<"}, @{text "="} associated to a total order on a set.
   7.349 +*}
   7.350 +
   7.351 +
   7.352 +definition ordLeq :: "('a rel * 'a' rel) set"
   7.353 +where
   7.354 +"ordLeq = {(r,r'). Well_order r \<and> Well_order r' \<and> (\<exists>f. embed r r' f)}"
   7.355 +
   7.356 +
   7.357 +abbreviation ordLeq2 :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> bool" (infix "<=o" 50)
   7.358 +where "r <=o r' \<equiv> (r,r') \<in> ordLeq"
   7.359 +
   7.360 +
   7.361 +abbreviation ordLeq3 :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> bool" (infix "\<le>o" 50)
   7.362 +where "r \<le>o r' \<equiv> r <=o r'"
   7.363 +
   7.364 +
   7.365 +definition ordLess :: "('a rel * 'a' rel) set"
   7.366 +where
   7.367 +"ordLess = {(r,r'). Well_order r \<and> Well_order r' \<and> (\<exists>f. embedS r r' f)}"
   7.368 +
   7.369 +abbreviation ordLess2 :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> bool" (infix "<o" 50)
   7.370 +where "r <o r' \<equiv> (r,r') \<in> ordLess"
   7.371 +
   7.372 +
   7.373 +definition ordIso :: "('a rel * 'a' rel) set"
   7.374 +where
   7.375 +"ordIso = {(r,r'). Well_order r \<and> Well_order r' \<and> (\<exists>f. iso r r' f)}"
   7.376 +
   7.377 +abbreviation ordIso2 :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> bool" (infix "=o" 50)
   7.378 +where "r =o r' \<equiv> (r,r') \<in> ordIso"
   7.379 +
   7.380 +
   7.381 +lemmas ordRels_def = ordLeq_def ordLess_def ordIso_def
   7.382 +
   7.383 +lemma ordLeq_Well_order_simp:
   7.384 +assumes "r \<le>o r'"
   7.385 +shows "Well_order r \<and> Well_order r'"
   7.386 +using assms unfolding ordLeq_def by simp
   7.387 +
   7.388 +
   7.389 +lemma ordLess_Well_order_simp:
   7.390 +assumes "r <o r'"
   7.391 +shows "Well_order r \<and> Well_order r'"
   7.392 +using assms unfolding ordLess_def by simp
   7.393 +
   7.394 +
   7.395 +lemma ordIso_Well_order_simp:
   7.396 +assumes "r =o r'"
   7.397 +shows "Well_order r \<and> Well_order r'"
   7.398 +using assms unfolding ordIso_def by simp
   7.399 +
   7.400 +
   7.401 +text{* Notice that the relations @{text "\<le>o"}, @{text "<o"}, @{text "=o"} connect well-orders
   7.402 +on potentially {\em distinct} types. However, some of the lemmas below, including the next one,
   7.403 +restrict implicitly the type of these relations to @{text "(('a rel) * ('a rel)) set"} , i.e.,
   7.404 +to @{text "'a rel rel"}.  *}
   7.405 +
   7.406 +
   7.407 +lemma ordLeq_reflexive:
   7.408 +"Well_order r \<Longrightarrow> r \<le>o r"
   7.409 +unfolding ordLeq_def using id_embed[of r] by blast
   7.410 +
   7.411 +
   7.412 +lemma ordLeq_transitive[trans]:
   7.413 +assumes *: "r \<le>o r'" and **: "r' \<le>o r''"
   7.414 +shows "r \<le>o r''"
   7.415 +proof-
   7.416 +  obtain f and f'
   7.417 +  where 1: "Well_order r \<and> Well_order r' \<and> Well_order r''" and
   7.418 +        "embed r r' f" and "embed r' r'' f'"
   7.419 +  using * ** unfolding ordLeq_def by blast
   7.420 +  hence "embed r r'' (f' o f)"
   7.421 +  using comp_embed[of r r' f r'' f'] by auto
   7.422 +  thus "r \<le>o r''" unfolding ordLeq_def using 1 by auto
   7.423 +qed
   7.424 +
   7.425 +
   7.426 +lemma ordLeq_total:
   7.427 +"\<lbrakk>Well_order r; Well_order r'\<rbrakk> \<Longrightarrow> r \<le>o r' \<or> r' \<le>o r"
   7.428 +unfolding ordLeq_def using wellorders_totally_ordered by blast
   7.429 +
   7.430 +
   7.431 +lemma ordIso_reflexive:
   7.432 +"Well_order r \<Longrightarrow> r =o r"
   7.433 +unfolding ordIso_def using id_iso[of r] by blast
   7.434 +
   7.435 +
   7.436 +lemma ordIso_transitive[trans]:
   7.437 +assumes *: "r =o r'" and **: "r' =o r''"
   7.438 +shows "r =o r''"
   7.439 +proof-
   7.440 +  obtain f and f'
   7.441 +  where 1: "Well_order r \<and> Well_order r' \<and> Well_order r''" and
   7.442 +        "iso r r' f" and 3: "iso r' r'' f'"
   7.443 +  using * ** unfolding ordIso_def by auto
   7.444 +  hence "iso r r'' (f' o f)"
   7.445 +  using comp_iso[of r r' f r'' f'] by auto
   7.446 +  thus "r =o r''" unfolding ordIso_def using 1 by auto
   7.447 +qed
   7.448 +
   7.449 +
   7.450 +lemma ordIso_symmetric:
   7.451 +assumes *: "r =o r'"
   7.452 +shows "r' =o r"
   7.453 +proof-
   7.454 +  obtain f where 1: "Well_order r \<and> Well_order r'" and
   7.455 +                 2: "embed r r' f \<and> bij_betw f (Field r) (Field r')"
   7.456 +  using * by (auto simp add: ordIso_def iso_def)
   7.457 +  let ?f' = "inv_into (Field r) f"
   7.458 +  have "embed r' r ?f' \<and> bij_betw ?f' (Field r') (Field r)"
   7.459 +  using 1 2 by (simp add: bij_betw_inv_into inv_into_Field_embed_bij_betw)
   7.460 +  thus "r' =o r" unfolding ordIso_def using 1 by (auto simp add: iso_def)
   7.461 +qed
   7.462 +
   7.463 +
   7.464 +lemma ordLeq_ordLess_trans[trans]:
   7.465 +assumes "r \<le>o r'" and " r' <o r''"
   7.466 +shows "r <o r''"
   7.467 +proof-
   7.468 +  have "Well_order r \<and> Well_order r''"
   7.469 +  using assms unfolding ordLeq_def ordLess_def by auto
   7.470 +  thus ?thesis using assms unfolding ordLeq_def ordLess_def
   7.471 +  using embed_comp_embedS by blast
   7.472 +qed
   7.473 +
   7.474 +
   7.475 +lemma ordLess_ordLeq_trans[trans]:
   7.476 +assumes "r <o r'" and " r' \<le>o r''"
   7.477 +shows "r <o r''"
   7.478 +proof-
   7.479 +  have "Well_order r \<and> Well_order r''"
   7.480 +  using assms unfolding ordLeq_def ordLess_def by auto
   7.481 +  thus ?thesis using assms unfolding ordLeq_def ordLess_def
   7.482 +  using embedS_comp_embed by blast
   7.483 +qed
   7.484 +
   7.485 +
   7.486 +lemma ordLeq_ordIso_trans[trans]:
   7.487 +assumes "r \<le>o r'" and " r' =o r''"
   7.488 +shows "r \<le>o r''"
   7.489 +proof-
   7.490 +  have "Well_order r \<and> Well_order r''"
   7.491 +  using assms unfolding ordLeq_def ordIso_def by auto
   7.492 +  thus ?thesis using assms unfolding ordLeq_def ordIso_def
   7.493 +  using embed_comp_iso by blast
   7.494 +qed
   7.495 +
   7.496 +
   7.497 +lemma ordIso_ordLeq_trans[trans]:
   7.498 +assumes "r =o r'" and " r' \<le>o r''"
   7.499 +shows "r \<le>o r''"
   7.500 +proof-
   7.501 +  have "Well_order r \<and> Well_order r''"
   7.502 +  using assms unfolding ordLeq_def ordIso_def by auto
   7.503 +  thus ?thesis using assms unfolding ordLeq_def ordIso_def
   7.504 +  using iso_comp_embed by blast
   7.505 +qed
   7.506 +
   7.507 +
   7.508 +lemma ordLess_ordIso_trans[trans]:
   7.509 +assumes "r <o r'" and " r' =o r''"
   7.510 +shows "r <o r''"
   7.511 +proof-
   7.512 +  have "Well_order r \<and> Well_order r''"
   7.513 +  using assms unfolding ordLess_def ordIso_def by auto
   7.514 +  thus ?thesis using assms unfolding ordLess_def ordIso_def
   7.515 +  using embedS_comp_iso by blast
   7.516 +qed
   7.517 +
   7.518 +
   7.519 +lemma ordIso_ordLess_trans[trans]:
   7.520 +assumes "r =o r'" and " r' <o r''"
   7.521 +shows "r <o r''"
   7.522 +proof-
   7.523 +  have "Well_order r \<and> Well_order r''"
   7.524 +  using assms unfolding ordLess_def ordIso_def by auto
   7.525 +  thus ?thesis using assms unfolding ordLess_def ordIso_def
   7.526 +  using iso_comp_embedS by blast
   7.527 +qed
   7.528 +
   7.529 +
   7.530 +lemma ordLess_not_embed:
   7.531 +assumes "r <o r'"
   7.532 +shows "\<not>(\<exists>f'. embed r' r f')"
   7.533 +proof-
   7.534 +  obtain f where 1: "Well_order r \<and> Well_order r'" and 2: "embed r r' f" and
   7.535 +                 3: " \<not> bij_betw f (Field r) (Field r')"
   7.536 +  using assms unfolding ordLess_def by (auto simp add: embedS_def)
   7.537 +  {fix f' assume *: "embed r' r f'"
   7.538 +   hence "bij_betw f (Field r) (Field r')" using 1 2
   7.539 +   by (simp add: embed_bothWays_Field_bij_betw)
   7.540 +   with 3 have False by contradiction
   7.541 +  }
   7.542 +  thus ?thesis by blast
   7.543 +qed
   7.544 +
   7.545 +
   7.546 +lemma ordLess_Field:
   7.547 +assumes OL: "r1 <o r2" and EMB: "embed r1 r2 f"
   7.548 +shows "\<not> (f`(Field r1) = Field r2)"
   7.549 +proof-
   7.550 +  let ?A1 = "Field r1"  let ?A2 = "Field r2"
   7.551 +  obtain g where
   7.552 +  0: "Well_order r1 \<and> Well_order r2" and
   7.553 +  1: "embed r1 r2 g \<and> \<not>(bij_betw g ?A1 ?A2)"
   7.554 +  using OL unfolding ordLess_def by (auto simp add: embedS_def)
   7.555 +  hence "\<forall>a \<in> ?A1. f a = g a"
   7.556 +  using 0 EMB embed_unique[of r1] by auto
   7.557 +  hence "\<not>(bij_betw f ?A1 ?A2)"
   7.558 +  using 1 bij_betw_cong[of ?A1] by blast
   7.559 +  moreover
   7.560 +  have "inj_on f ?A1" using EMB 0 by (simp add: embed_inj_on)
   7.561 +  ultimately show ?thesis by (simp add: bij_betw_def)
   7.562 +qed
   7.563 +
   7.564 +
   7.565 +lemma ordLess_iff:
   7.566 +"r <o r' = (Well_order r \<and> Well_order r' \<and> \<not>(\<exists>f'. embed r' r f'))"
   7.567 +proof
   7.568 +  assume *: "r <o r'"
   7.569 +  hence "\<not>(\<exists>f'. embed r' r f')" using ordLess_not_embed[of r r'] by simp
   7.570 +  with * show "Well_order r \<and> Well_order r' \<and> \<not> (\<exists>f'. embed r' r f')"
   7.571 +  unfolding ordLess_def by auto
   7.572 +next
   7.573 +  assume *: "Well_order r \<and> Well_order r' \<and> \<not> (\<exists>f'. embed r' r f')"
   7.574 +  then obtain f where 1: "embed r r' f"
   7.575 +  using wellorders_totally_ordered[of r r'] by blast
   7.576 +  moreover
   7.577 +  {assume "bij_betw f (Field r) (Field r')"
   7.578 +   with * 1 have "embed r' r (inv_into (Field r) f) "
   7.579 +   using inv_into_Field_embed_bij_betw[of r r' f] by auto
   7.580 +   with * have False by blast
   7.581 +  }
   7.582 +  ultimately show "(r,r') \<in> ordLess"
   7.583 +  unfolding ordLess_def using * by (fastforce simp add: embedS_def)
   7.584 +qed
   7.585 +
   7.586 +
   7.587 +lemma ordLess_irreflexive: "\<not> r <o r"
   7.588 +proof
   7.589 +  assume "r <o r"
   7.590 +  hence "Well_order r \<and>  \<not>(\<exists>f. embed r r f)"
   7.591 +  unfolding ordLess_iff ..
   7.592 +  moreover have "embed r r id" using id_embed[of r] .
   7.593 +  ultimately show False by blast
   7.594 +qed
   7.595 +
   7.596 +
   7.597 +lemma ordLeq_iff_ordLess_or_ordIso:
   7.598 +"r \<le>o r' = (r <o r' \<or> r =o r')"
   7.599 +unfolding ordRels_def embedS_defs iso_defs by blast
   7.600 +
   7.601 +
   7.602 +lemma ordIso_iff_ordLeq:
   7.603 +"(r =o r') = (r \<le>o r' \<and> r' \<le>o r)"
   7.604 +proof
   7.605 +  assume "r =o r'"
   7.606 +  then obtain f where 1: "Well_order r \<and> Well_order r' \<and>
   7.607 +                     embed r r' f \<and> bij_betw f (Field r) (Field r')"
   7.608 +  unfolding ordIso_def iso_defs by auto
   7.609 +  hence "embed r r' f \<and> embed r' r (inv_into (Field r) f)"
   7.610 +  by (simp add: inv_into_Field_embed_bij_betw)
   7.611 +  thus  "r \<le>o r' \<and> r' \<le>o r"
   7.612 +  unfolding ordLeq_def using 1 by auto
   7.613 +next
   7.614 +  assume "r \<le>o r' \<and> r' \<le>o r"
   7.615 +  then obtain f and g where 1: "Well_order r \<and> Well_order r' \<and>
   7.616 +                           embed r r' f \<and> embed r' r g"
   7.617 +  unfolding ordLeq_def by auto
   7.618 +  hence "iso r r' f" by (auto simp add: embed_bothWays_iso)
   7.619 +  thus "r =o r'" unfolding ordIso_def using 1 by auto
   7.620 +qed
   7.621 +
   7.622 +
   7.623 +lemma not_ordLess_ordLeq:
   7.624 +"r <o r' \<Longrightarrow> \<not> r' \<le>o r"
   7.625 +using ordLess_ordLeq_trans ordLess_irreflexive by blast
   7.626 +
   7.627 +
   7.628 +lemma ordLess_or_ordLeq:
   7.629 +assumes WELL: "Well_order r" and WELL': "Well_order r'"
   7.630 +shows "r <o r' \<or> r' \<le>o r"
   7.631 +proof-
   7.632 +  have "r \<le>o r' \<or> r' \<le>o r"
   7.633 +  using assms by (simp add: ordLeq_total)
   7.634 +  moreover
   7.635 +  {assume "\<not> r <o r' \<and> r \<le>o r'"
   7.636 +   hence "r =o r'" using ordLeq_iff_ordLess_or_ordIso by blast
   7.637 +   hence "r' \<le>o r" using ordIso_symmetric ordIso_iff_ordLeq by blast
   7.638 +  }
   7.639 +  ultimately show ?thesis by blast
   7.640 +qed
   7.641 +
   7.642 +
   7.643 +lemma not_ordLess_ordIso:
   7.644 +"r <o r' \<Longrightarrow> \<not> r =o r'"
   7.645 +using assms ordLess_ordIso_trans ordIso_symmetric ordLess_irreflexive by blast
   7.646 +
   7.647 +
   7.648 +lemma not_ordLeq_iff_ordLess:
   7.649 +assumes WELL: "Well_order r" and WELL': "Well_order r'"
   7.650 +shows "(\<not> r' \<le>o r) = (r <o r')"
   7.651 +using assms not_ordLess_ordLeq ordLess_or_ordLeq by blast
   7.652 +
   7.653 +
   7.654 +lemma not_ordLess_iff_ordLeq:
   7.655 +assumes WELL: "Well_order r" and WELL': "Well_order r'"
   7.656 +shows "(\<not> r' <o r) = (r \<le>o r')"
   7.657 +using assms not_ordLess_ordLeq ordLess_or_ordLeq by blast
   7.658 +
   7.659 +
   7.660 +lemma ordLess_transitive[trans]:
   7.661 +"\<lbrakk>r <o r'; r' <o r''\<rbrakk> \<Longrightarrow> r <o r''"
   7.662 +using assms ordLess_ordLeq_trans ordLeq_iff_ordLess_or_ordIso by blast
   7.663 +
   7.664 +
   7.665 +corollary ordLess_trans: "trans ordLess"
   7.666 +unfolding trans_def using ordLess_transitive by blast
   7.667 +
   7.668 +
   7.669 +lemmas ordIso_equivalence = ordIso_transitive ordIso_reflexive ordIso_symmetric
   7.670 +
   7.671 +
   7.672 +lemma ordIso_imp_ordLeq:
   7.673 +"r =o r' \<Longrightarrow> r \<le>o r'"
   7.674 +using ordIso_iff_ordLeq by blast
   7.675 +
   7.676 +
   7.677 +lemma ordLess_imp_ordLeq:
   7.678 +"r <o r' \<Longrightarrow> r \<le>o r'"
   7.679 +using ordLeq_iff_ordLess_or_ordIso by blast
   7.680 +
   7.681 +
   7.682 +lemma ofilter_subset_ordLeq:
   7.683 +assumes WELL: "Well_order r" and
   7.684 +        OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
   7.685 +shows "(A \<le> B) = (Restr r A \<le>o Restr r B)"
   7.686 +proof
   7.687 +  assume "A \<le> B"
   7.688 +  thus "Restr r A \<le>o Restr r B"
   7.689 +  unfolding ordLeq_def using assms
   7.690 +  Well_order_Restr Well_order_Restr ofilter_subset_embed by blast
   7.691 +next
   7.692 +  assume *: "Restr r A \<le>o Restr r B"
   7.693 +  then obtain f where "embed (Restr r A) (Restr r B) f"
   7.694 +  unfolding ordLeq_def by blast
   7.695 +  {assume "B < A"
   7.696 +   hence "Restr r B <o Restr r A"
   7.697 +   unfolding ordLess_def using assms
   7.698 +   Well_order_Restr Well_order_Restr ofilter_subset_embedS by blast
   7.699 +   hence False using * not_ordLess_ordLeq by blast
   7.700 +  }
   7.701 +  thus "A \<le> B" using OFA OFB WELL
   7.702 +  wo_rel_def[of r] wo_rel.ofilter_linord[of r A B] by blast
   7.703 +qed
   7.704 +
   7.705 +
   7.706 +lemma ofilter_subset_ordLess:
   7.707 +assumes WELL: "Well_order r" and
   7.708 +        OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
   7.709 +shows "(A < B) = (Restr r A <o Restr r B)"
   7.710 +proof-
   7.711 +  let ?rA = "Restr r A" let ?rB = "Restr r B"
   7.712 +  have 1: "Well_order ?rA \<and> Well_order ?rB"
   7.713 +  using WELL Well_order_Restr by blast
   7.714 +  have "(A < B) = (\<not> B \<le> A)" using assms
   7.715 +  wo_rel_def wo_rel.ofilter_linord[of r A B] by blast
   7.716 +  also have "\<dots> = (\<not> Restr r B \<le>o Restr r A)"
   7.717 +  using assms ofilter_subset_ordLeq by blast
   7.718 +  also have "\<dots> = (Restr r A <o Restr r B)"
   7.719 +  using 1 not_ordLeq_iff_ordLess by blast
   7.720 +  finally show ?thesis .
   7.721 +qed
   7.722 +
   7.723 +
   7.724 +lemma ofilter_ordLess:
   7.725 +"\<lbrakk>Well_order r; wo_rel.ofilter r A\<rbrakk> \<Longrightarrow> (A < Field r) = (Restr r A <o r)"
   7.726 +by (simp add: ofilter_subset_ordLess wo_rel.Field_ofilter
   7.727 +    wo_rel_def Restr_Field)
   7.728 +
   7.729 +
   7.730 +corollary underS_Restr_ordLess:
   7.731 +assumes "Well_order r" and "Field r \<noteq> {}"
   7.732 +shows "Restr r (rel.underS r a) <o r"
   7.733 +proof-
   7.734 +  have "rel.underS r a < Field r" using assms
   7.735 +  by (simp add: rel.underS_Field3)
   7.736 +  thus ?thesis using assms
   7.737 +  by (simp add: ofilter_ordLess wo_rel.underS_ofilter wo_rel_def)
   7.738 +qed
   7.739 +
   7.740 +
   7.741 +lemma embed_ordLess_ofilterIncl:
   7.742 +assumes
   7.743 +  OL12: "r1 <o r2" and OL23: "r2 <o r3" and
   7.744 +  EMB13: "embed r1 r3 f13" and EMB23: "embed r2 r3 f23"
   7.745 +shows "(f13`(Field r1), f23`(Field r2)) \<in> (ofilterIncl r3)"
   7.746 +proof-
   7.747 +  have OL13: "r1 <o r3"
   7.748 +  using OL12 OL23 using ordLess_transitive by auto
   7.749 +  let ?A1 = "Field r1"  let ?A2 ="Field r2" let ?A3 ="Field r3"
   7.750 +  obtain f12 g23 where
   7.751 +  0: "Well_order r1 \<and> Well_order r2 \<and> Well_order r3" and
   7.752 +  1: "embed r1 r2 f12 \<and> \<not>(bij_betw f12 ?A1 ?A2)" and
   7.753 +  2: "embed r2 r3 g23 \<and> \<not>(bij_betw g23 ?A2 ?A3)"
   7.754 +  using OL12 OL23 by (auto simp add: ordLess_def embedS_def)
   7.755 +  hence "\<forall>a \<in> ?A2. f23 a = g23 a"
   7.756 +  using EMB23 embed_unique[of r2 r3] by blast
   7.757 +  hence 3: "\<not>(bij_betw f23 ?A2 ?A3)"
   7.758 +  using 2 bij_betw_cong[of ?A2 f23 g23] by blast
   7.759 +  (*  *)
   7.760 +  have 4: "wo_rel.ofilter r2 (f12 ` ?A1) \<and> f12 ` ?A1 \<noteq> ?A2"
   7.761 +  using 0 1 OL12 by (simp add: embed_Field_ofilter ordLess_Field)
   7.762 +  have 5: "wo_rel.ofilter r3 (f23 ` ?A2) \<and> f23 ` ?A2 \<noteq> ?A3"
   7.763 +  using 0 EMB23 OL23 by (simp add: embed_Field_ofilter ordLess_Field)
   7.764 +  have 6: "wo_rel.ofilter r3 (f13 ` ?A1)  \<and> f13 ` ?A1 \<noteq> ?A3"
   7.765 +  using 0 EMB13 OL13 by (simp add: embed_Field_ofilter ordLess_Field)
   7.766 +  (*  *)
   7.767 +  have "f12 ` ?A1 < ?A2"
   7.768 +  using 0 4 by (auto simp add: wo_rel_def wo_rel.ofilter_def)
   7.769 +  moreover have "inj_on f23 ?A2"
   7.770 +  using EMB23 0 by (simp add: wo_rel_def embed_inj_on)
   7.771 +  ultimately
   7.772 +  have "f23 ` (f12 ` ?A1) < f23 ` ?A2" by (simp add: inj_on_strict_subset)
   7.773 +  moreover
   7.774 +  {have "embed r1 r3 (f23 o f12)"
   7.775 +   using 1 EMB23 0 by (auto simp add: comp_embed)
   7.776 +   hence "\<forall>a \<in> ?A1. f23(f12 a) = f13 a"
   7.777 +   using EMB13 0 embed_unique[of r1 r3 "f23 o f12" f13] by auto
   7.778 +   hence "f23 ` (f12 ` ?A1) = f13 ` ?A1" by force
   7.779 +  }
   7.780 +  ultimately
   7.781 +  have "f13 ` ?A1 < f23 ` ?A2" by simp
   7.782 +  (*  *)
   7.783 +  with 5 6 show ?thesis
   7.784 +  unfolding ofilterIncl_def by auto
   7.785 +qed
   7.786 +
   7.787 +
   7.788 +lemma ordLess_iff_ordIso_Restr:
   7.789 +assumes WELL: "Well_order r" and WELL': "Well_order r'"
   7.790 +shows "(r' <o r) = (\<exists>a \<in> Field r. r' =o Restr r (rel.underS r a))"
   7.791 +proof(auto)
   7.792 +  fix a assume *: "a \<in> Field r" and **: "r' =o Restr r (rel.underS r a)"
   7.793 +  hence "Restr r (rel.underS r a) <o r" using WELL underS_Restr_ordLess[of r] by blast
   7.794 +  thus "r' <o r" using ** ordIso_ordLess_trans by blast
   7.795 +next
   7.796 +  assume "r' <o r"
   7.797 +  then obtain f where 1: "Well_order r \<and> Well_order r'" and
   7.798 +                      2: "embed r' r f \<and> f ` (Field r') \<noteq> Field r"
   7.799 +  unfolding ordLess_def embedS_def[abs_def] bij_betw_def using embed_inj_on by blast
   7.800 +  hence "wo_rel.ofilter r (f ` (Field r'))" using embed_Field_ofilter by blast
   7.801 +  then obtain a where 3: "a \<in> Field r" and 4: "rel.underS r a = f ` (Field r')"
   7.802 +  using 1 2 by (auto simp add: wo_rel.ofilter_underS_Field wo_rel_def)
   7.803 +  have "iso r' (Restr r (f ` (Field r'))) f"
   7.804 +  using embed_implies_iso_Restr 2 assms by blast
   7.805 +  moreover have "Well_order (Restr r (f ` (Field r')))"
   7.806 +  using WELL Well_order_Restr by blast
   7.807 +  ultimately have "r' =o Restr r (f ` (Field r'))"
   7.808 +  using WELL' unfolding ordIso_def by auto
   7.809 +  hence "r' =o Restr r (rel.underS r a)" using 4 by auto
   7.810 +  thus "\<exists>a \<in> Field r. r' =o Restr r (rel.underS r a)" using 3 by auto
   7.811 +qed
   7.812 +
   7.813 +
   7.814 +lemma internalize_ordLess:
   7.815 +"(r' <o r) = (\<exists>p. Field p < Field r \<and> r' =o p \<and> p <o r)"
   7.816 +proof
   7.817 +  assume *: "r' <o r"
   7.818 +  hence 0: "Well_order r \<and> Well_order r'" unfolding ordLess_def by auto
   7.819 +  with * obtain a where 1: "a \<in> Field r" and 2: "r' =o Restr r (rel.underS r a)"
   7.820 +  using ordLess_iff_ordIso_Restr by blast
   7.821 +  let ?p = "Restr r (rel.underS r a)"
   7.822 +  have "wo_rel.ofilter r (rel.underS r a)" using 0
   7.823 +  by (simp add: wo_rel_def wo_rel.underS_ofilter)
   7.824 +  hence "Field ?p = rel.underS r a" using 0 Field_Restr_ofilter by blast
   7.825 +  hence "Field ?p < Field r" using rel.underS_Field2 1 by fastforce
   7.826 +  moreover have "?p <o r" using underS_Restr_ordLess[of r a] 0 1 by blast
   7.827 +  ultimately
   7.828 +  show "\<exists>p. Field p < Field r \<and> r' =o p \<and> p <o r" using 2 by blast
   7.829 +next
   7.830 +  assume "\<exists>p. Field p < Field r \<and> r' =o p \<and> p <o r"
   7.831 +  thus "r' <o r" using ordIso_ordLess_trans by blast
   7.832 +qed
   7.833 +
   7.834 +
   7.835 +lemma internalize_ordLeq:
   7.836 +"(r' \<le>o r) = (\<exists>p. Field p \<le> Field r \<and> r' =o p \<and> p \<le>o r)"
   7.837 +proof
   7.838 +  assume *: "r' \<le>o r"
   7.839 +  moreover
   7.840 +  {assume "r' <o r"
   7.841 +   then obtain p where "Field p < Field r \<and> r' =o p \<and> p <o r"
   7.842 +   using internalize_ordLess[of r' r] by blast
   7.843 +   hence "\<exists>p. Field p \<le> Field r \<and> r' =o p \<and> p \<le>o r"
   7.844 +   using ordLeq_iff_ordLess_or_ordIso by blast
   7.845 +  }
   7.846 +  moreover
   7.847 +  have "r \<le>o r" using * ordLeq_def ordLeq_reflexive by blast
   7.848 +  ultimately show "\<exists>p. Field p \<le> Field r \<and> r' =o p \<and> p \<le>o r"
   7.849 +  using ordLeq_iff_ordLess_or_ordIso by blast
   7.850 +next
   7.851 +  assume "\<exists>p. Field p \<le> Field r \<and> r' =o p \<and> p \<le>o r"
   7.852 +  thus "r' \<le>o r" using ordIso_ordLeq_trans by blast
   7.853 +qed
   7.854 +
   7.855 +
   7.856 +lemma ordLeq_iff_ordLess_Restr:
   7.857 +assumes WELL: "Well_order r" and WELL': "Well_order r'"
   7.858 +shows "(r \<le>o r') = (\<forall>a \<in> Field r. Restr r (rel.underS r a) <o r')"
   7.859 +proof(auto)
   7.860 +  assume *: "r \<le>o r'"
   7.861 +  fix a assume "a \<in> Field r"
   7.862 +  hence "Restr r (rel.underS r a) <o r"
   7.863 +  using WELL underS_Restr_ordLess[of r] by blast
   7.864 +  thus "Restr r (rel.underS r a) <o r'"
   7.865 +  using * ordLess_ordLeq_trans by blast
   7.866 +next
   7.867 +  assume *: "\<forall>a \<in> Field r. Restr r (rel.underS r a) <o r'"
   7.868 +  {assume "r' <o r"
   7.869 +   then obtain a where "a \<in> Field r \<and> r' =o Restr r (rel.underS r a)"
   7.870 +   using assms ordLess_iff_ordIso_Restr by blast
   7.871 +   hence False using * not_ordLess_ordIso ordIso_symmetric by blast
   7.872 +  }
   7.873 +  thus "r \<le>o r'" using ordLess_or_ordLeq assms by blast
   7.874 +qed
   7.875 +
   7.876 +
   7.877 +lemma finite_ordLess_infinite:
   7.878 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and
   7.879 +        FIN: "finite(Field r)" and INF: "infinite(Field r')"
   7.880 +shows "r <o r'"
   7.881 +proof-
   7.882 +  {assume "r' \<le>o r"
   7.883 +   then obtain h where "inj_on h (Field r') \<and> h ` (Field r') \<le> Field r"
   7.884 +   unfolding ordLeq_def using assms embed_inj_on embed_Field by blast
   7.885 +   hence False using finite_imageD finite_subset FIN INF by blast
   7.886 +  }
   7.887 +  thus ?thesis using WELL WELL' ordLess_or_ordLeq by blast
   7.888 +qed
   7.889 +
   7.890 +
   7.891 +lemma finite_well_order_on_ordIso:
   7.892 +assumes FIN: "finite A" and
   7.893 +        WELL: "well_order_on A r" and WELL': "well_order_on A r'"
   7.894 +shows "r =o r'"
   7.895 +proof-
   7.896 +  have 0: "Well_order r \<and> Well_order r' \<and> Field r = A \<and> Field r' = A"
   7.897 +  using assms rel.well_order_on_Well_order by blast
   7.898 +  moreover
   7.899 +  have "\<forall>r r'. well_order_on A r \<and> well_order_on A r' \<and> r \<le>o r'
   7.900 +                  \<longrightarrow> r =o r'"
   7.901 +  proof(clarify)
   7.902 +    fix r r' assume *: "well_order_on A r" and **: "well_order_on A r'"
   7.903 +    have 2: "Well_order r \<and> Well_order r' \<and> Field r = A \<and> Field r' = A"
   7.904 +    using * ** rel.well_order_on_Well_order by blast
   7.905 +    assume "r \<le>o r'"
   7.906 +    then obtain f where 1: "embed r r' f" and
   7.907 +                        "inj_on f A \<and> f ` A \<le> A"
   7.908 +    unfolding ordLeq_def using 2 embed_inj_on embed_Field by blast
   7.909 +    hence "bij_betw f A A" unfolding bij_betw_def using FIN endo_inj_surj by blast
   7.910 +    thus "r =o r'" unfolding ordIso_def iso_def[abs_def] using 1 2 by auto
   7.911 +  qed
   7.912 +  ultimately show ?thesis using assms ordLeq_total ordIso_symmetric by blast
   7.913 +qed
   7.914 +
   7.915 +
   7.916 +subsection{* @{text "<o"} is well-founded *}
   7.917 +
   7.918 +
   7.919 +text {* Of course, it only makes sense to state that the @{text "<o"} is well-founded
   7.920 +on the restricted type @{text "'a rel rel"}.  We prove this by first showing that, for any set
   7.921 +of well-orders all embedded in a fixed well-order, the function mapping each well-order
   7.922 +in the set to an order filter of the fixed well-order is compatible w.r.t. to @{text "<o"} versus
   7.923 +{\em strict inclusion}; and we already know that strict inclusion of order filters is well-founded. *}
   7.924 +
   7.925 +
   7.926 +definition ord_to_filter :: "'a rel \<Rightarrow> 'a rel \<Rightarrow> 'a set"
   7.927 +where "ord_to_filter r0 r \<equiv> (SOME f. embed r r0 f) ` (Field r)"
   7.928 +
   7.929 +
   7.930 +lemma ord_to_filter_compat:
   7.931 +"compat (ordLess Int (ordLess^-1``{r0} \<times> ordLess^-1``{r0}))
   7.932 +        (ofilterIncl r0)
   7.933 +        (ord_to_filter r0)"
   7.934 +proof(unfold compat_def ord_to_filter_def, clarify)
   7.935 +  fix r1::"'a rel" and r2::"'a rel"
   7.936 +  let ?A1 = "Field r1"  let ?A2 ="Field r2" let ?A0 ="Field r0"
   7.937 +  let ?phi10 = "\<lambda> f10. embed r1 r0 f10" let ?f10 = "SOME f. ?phi10 f"
   7.938 +  let ?phi20 = "\<lambda> f20. embed r2 r0 f20" let ?f20 = "SOME f. ?phi20 f"
   7.939 +  assume *: "r1 <o r0" "r2 <o r0" and **: "r1 <o r2"
   7.940 +  hence "(\<exists>f. ?phi10 f) \<and> (\<exists>f. ?phi20 f)"
   7.941 +  by (auto simp add: ordLess_def embedS_def)
   7.942 +  hence "?phi10 ?f10 \<and> ?phi20 ?f20" by (auto simp add: someI_ex)
   7.943 +  thus "(?f10 ` ?A1, ?f20 ` ?A2) \<in> ofilterIncl r0"
   7.944 +  using * ** by (simp add: embed_ordLess_ofilterIncl)
   7.945 +qed
   7.946 +
   7.947 +
   7.948 +theorem wf_ordLess: "wf ordLess"
   7.949 +proof-
   7.950 +  {fix r0 :: "('a \<times> 'a) set"
   7.951 +   (* need to annotate here!*)
   7.952 +   let ?ordLess = "ordLess::('d rel * 'd rel) set"
   7.953 +   let ?R = "?ordLess Int (?ordLess^-1``{r0} \<times> ?ordLess^-1``{r0})"
   7.954 +   {assume Case1: "Well_order r0"
   7.955 +    hence "wf ?R"
   7.956 +    using wf_ofilterIncl[of r0]
   7.957 +          compat_wf[of ?R "ofilterIncl r0" "ord_to_filter r0"]
   7.958 +          ord_to_filter_compat[of r0] by auto
   7.959 +   }
   7.960 +   moreover
   7.961 +   {assume Case2: "\<not> Well_order r0"
   7.962 +    hence "?R = {}" unfolding ordLess_def by auto
   7.963 +    hence "wf ?R" using wf_empty by simp
   7.964 +   }
   7.965 +   ultimately have "wf ?R" by blast
   7.966 +  }
   7.967 +  thus ?thesis by (simp add: trans_wf_iff ordLess_trans)
   7.968 +qed
   7.969 +
   7.970 +corollary exists_minim_Well_order:
   7.971 +assumes NE: "R \<noteq> {}" and WELL: "\<forall>r \<in> R. Well_order r"
   7.972 +shows "\<exists>r \<in> R. \<forall>r' \<in> R. r \<le>o r'"
   7.973 +proof-
   7.974 +  obtain r where "r \<in> R \<and> (\<forall>r' \<in> R. \<not> r' <o r)"
   7.975 +  using NE spec[OF spec[OF subst[OF wf_eq_minimal, of "%x. x", OF wf_ordLess]], of _ R]
   7.976 +    equals0I[of R] by blast
   7.977 +  with not_ordLeq_iff_ordLess WELL show ?thesis by blast
   7.978 +qed
   7.979 +
   7.980 +
   7.981 +
   7.982 +subsection {* Copy via direct images  *}
   7.983 +
   7.984 +
   7.985 +text{* The direct image operator is the dual of the inverse image operator @{text "inv_image"}
   7.986 +from @{text "Relation.thy"}.  It is useful for transporting a well-order between
   7.987 +different types. *}
   7.988 +
   7.989 +
   7.990 +definition dir_image :: "'a rel \<Rightarrow> ('a \<Rightarrow> 'a') \<Rightarrow> 'a' rel"
   7.991 +where
   7.992 +"dir_image r f = {(f a, f b)| a b. (a,b) \<in> r}"
   7.993 +
   7.994 +
   7.995 +lemma dir_image_Field:
   7.996 +"Field(dir_image r f) \<le> f ` (Field r)"
   7.997 +unfolding dir_image_def Field_def by auto
   7.998 +
   7.999 +
  7.1000 +lemma dir_image_minus_Id:
  7.1001 +"inj_on f (Field r) \<Longrightarrow> (dir_image r f) - Id = dir_image (r - Id) f"
  7.1002 +unfolding inj_on_def Field_def dir_image_def by auto
  7.1003 +
  7.1004 +
  7.1005 +lemma Refl_dir_image:
  7.1006 +assumes "Refl r"
  7.1007 +shows "Refl(dir_image r f)"
  7.1008 +proof-
  7.1009 +  {fix a' b'
  7.1010 +   assume "(a',b') \<in> dir_image r f"
  7.1011 +   then obtain a b where 1: "a' = f a \<and> b' = f b \<and> (a,b) \<in> r"
  7.1012 +   unfolding dir_image_def by blast
  7.1013 +   hence "a \<in> Field r \<and> b \<in> Field r" using Field_def by fastforce
  7.1014 +   hence "(a,a) \<in> r \<and> (b,b) \<in> r" using assms by (simp add: refl_on_def)
  7.1015 +   with 1 have "(a',a') \<in> dir_image r f \<and> (b',b') \<in> dir_image r f"
  7.1016 +   unfolding dir_image_def by auto
  7.1017 +  }
  7.1018 +  thus ?thesis
  7.1019 +  by(unfold refl_on_def Field_def Domain_def Range_def, auto)
  7.1020 +qed
  7.1021 +
  7.1022 +
  7.1023 +lemma trans_dir_image:
  7.1024 +assumes TRANS: "trans r" and INJ: "inj_on f (Field r)"
  7.1025 +shows "trans(dir_image r f)"
  7.1026 +proof(unfold trans_def, auto)
  7.1027 +  fix a' b' c'
  7.1028 +  assume "(a',b') \<in> dir_image r f" "(b',c') \<in> dir_image r f"
  7.1029 +  then obtain a b1 b2 c where 1: "a' = f a \<and> b' = f b1 \<and> b' = f b2 \<and> c' = f c" and
  7.1030 +                         2: "(a,b1) \<in> r \<and> (b2,c) \<in> r"
  7.1031 +  unfolding dir_image_def by blast
  7.1032 +  hence "b1 \<in> Field r \<and> b2 \<in> Field r"
  7.1033 +  unfolding Field_def by auto
  7.1034 +  hence "b1 = b2" using 1 INJ unfolding inj_on_def by auto
  7.1035 +  hence "(a,c): r" using 2 TRANS unfolding trans_def by blast
  7.1036 +  thus "(a',c') \<in> dir_image r f"
  7.1037 +  unfolding dir_image_def using 1 by auto
  7.1038 +qed
  7.1039 +
  7.1040 +
  7.1041 +lemma Preorder_dir_image:
  7.1042 +"\<lbrakk>Preorder r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> Preorder (dir_image r f)"
  7.1043 +by (simp add: preorder_on_def Refl_dir_image trans_dir_image)
  7.1044 +
  7.1045 +
  7.1046 +lemma antisym_dir_image:
  7.1047 +assumes AN: "antisym r" and INJ: "inj_on f (Field r)"
  7.1048 +shows "antisym(dir_image r f)"
  7.1049 +proof(unfold antisym_def, auto)
  7.1050 +  fix a' b'
  7.1051 +  assume "(a',b') \<in> dir_image r f" "(b',a') \<in> dir_image r f"
  7.1052 +  then obtain a1 b1 a2 b2 where 1: "a' = f a1 \<and> a' = f a2 \<and> b' = f b1 \<and> b' = f b2" and
  7.1053 +                           2: "(a1,b1) \<in> r \<and> (b2,a2) \<in> r " and
  7.1054 +                           3: "{a1,a2,b1,b2} \<le> Field r"
  7.1055 +  unfolding dir_image_def Field_def by blast
  7.1056 +  hence "a1 = a2 \<and> b1 = b2" using INJ unfolding inj_on_def by auto
  7.1057 +  hence "a1 = b2" using 2 AN unfolding antisym_def by auto
  7.1058 +  thus "a' = b'" using 1 by auto
  7.1059 +qed
  7.1060 +
  7.1061 +
  7.1062 +lemma Partial_order_dir_image:
  7.1063 +"\<lbrakk>Partial_order r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> Partial_order (dir_image r f)"
  7.1064 +by (simp add: partial_order_on_def Preorder_dir_image antisym_dir_image)
  7.1065 +
  7.1066 +
  7.1067 +lemma Total_dir_image:
  7.1068 +assumes TOT: "Total r" and INJ: "inj_on f (Field r)"
  7.1069 +shows "Total(dir_image r f)"
  7.1070 +proof(unfold total_on_def, intro ballI impI)
  7.1071 +  fix a' b'
  7.1072 +  assume "a' \<in> Field (dir_image r f)" "b' \<in> Field (dir_image r f)"
  7.1073 +  then obtain a and b where 1: "a \<in> Field r \<and> b \<in> Field r \<and> f a = a' \<and> f b = b'"
  7.1074 +  using dir_image_Field[of r f] by blast
  7.1075 +  moreover assume "a' \<noteq> b'"
  7.1076 +  ultimately have "a \<noteq> b" using INJ unfolding inj_on_def by auto
  7.1077 +  hence "(a,b) \<in> r \<or> (b,a) \<in> r" using 1 TOT unfolding total_on_def by auto
  7.1078 +  thus "(a',b') \<in> dir_image r f \<or> (b',a') \<in> dir_image r f"
  7.1079 +  using 1 unfolding dir_image_def by auto
  7.1080 +qed
  7.1081 +
  7.1082 +
  7.1083 +lemma Linear_order_dir_image:
  7.1084 +"\<lbrakk>Linear_order r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> Linear_order (dir_image r f)"
  7.1085 +by (simp add: linear_order_on_def Partial_order_dir_image Total_dir_image)
  7.1086 +
  7.1087 +
  7.1088 +lemma wf_dir_image:
  7.1089 +assumes WF: "wf r" and INJ: "inj_on f (Field r)"
  7.1090 +shows "wf(dir_image r f)"
  7.1091 +proof(unfold wf_eq_minimal2, intro allI impI, elim conjE)
  7.1092 +  fix A'::"'b set"
  7.1093 +  assume SUB: "A' \<le> Field(dir_image r f)" and NE: "A' \<noteq> {}"
  7.1094 +  obtain A where A_def: "A = {a \<in> Field r. f a \<in> A'}" by blast
  7.1095 +  have "A \<noteq> {} \<and> A \<le> Field r"
  7.1096 +  using A_def dir_image_Field[of r f] SUB NE by blast
  7.1097 +  then obtain a where 1: "a \<in> A \<and> (\<forall>b \<in> A. (b,a) \<notin> r)"
  7.1098 +  using WF unfolding wf_eq_minimal2 by blast
  7.1099 +  have "\<forall>b' \<in> A'. (b',f a) \<notin> dir_image r f"
  7.1100 +  proof(clarify)
  7.1101 +    fix b' assume *: "b' \<in> A'" and **: "(b',f a) \<in> dir_image r f"
  7.1102 +    obtain b1 a1 where 2: "b' = f b1 \<and> f a = f a1" and
  7.1103 +                       3: "(b1,a1) \<in> r \<and> {a1,b1} \<le> Field r"
  7.1104 +    using ** unfolding dir_image_def Field_def by blast
  7.1105 +    hence "a = a1" using 1 A_def INJ unfolding inj_on_def by auto
  7.1106 +    hence "b1 \<in> A \<and> (b1,a) \<in> r" using 2 3 A_def * by auto
  7.1107 +    with 1 show False by auto
  7.1108 +  qed
  7.1109 +  thus "\<exists>a'\<in>A'. \<forall>b'\<in>A'. (b', a') \<notin> dir_image r f"
  7.1110 +  using A_def 1 by blast
  7.1111 +qed
  7.1112 +
  7.1113 +
  7.1114 +lemma Well_order_dir_image:
  7.1115 +"\<lbrakk>Well_order r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> Well_order (dir_image r f)"
  7.1116 +using assms unfolding well_order_on_def
  7.1117 +using Linear_order_dir_image[of r f] wf_dir_image[of "r - Id" f]
  7.1118 +  dir_image_minus_Id[of f r]
  7.1119 +  subset_inj_on[of f "Field r" "Field(r - Id)"]
  7.1120 +  mono_Field[of "r - Id" r] by auto
  7.1121 +
  7.1122 +
  7.1123 +lemma dir_image_Field2:
  7.1124 +"Refl r \<Longrightarrow> Field(dir_image r f) = f ` (Field r)"
  7.1125 +unfolding Field_def dir_image_def refl_on_def Domain_def Range_def by blast
  7.1126 +
  7.1127 +
  7.1128 +lemma dir_image_bij_betw:
  7.1129 +"\<lbrakk>Well_order r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> bij_betw f (Field r) (Field (dir_image r f))"
  7.1130 +unfolding bij_betw_def
  7.1131 +by (simp add: dir_image_Field2 order_on_defs)
  7.1132 +
  7.1133 +
  7.1134 +lemma dir_image_compat:
  7.1135 +"compat r (dir_image r f) f"
  7.1136 +unfolding compat_def dir_image_def by auto
  7.1137 +
  7.1138 +
  7.1139 +lemma dir_image_iso:
  7.1140 +"\<lbrakk>Well_order r; inj_on f (Field r)\<rbrakk>  \<Longrightarrow> iso r (dir_image r f) f"
  7.1141 +using iso_iff3 dir_image_compat dir_image_bij_betw Well_order_dir_image by blast
  7.1142 +
  7.1143 +
  7.1144 +lemma dir_image_ordIso:
  7.1145 +"\<lbrakk>Well_order r; inj_on f (Field r)\<rbrakk>  \<Longrightarrow> r =o dir_image r f"
  7.1146 +unfolding ordIso_def using dir_image_iso Well_order_dir_image by blast
  7.1147 +
  7.1148 +
  7.1149 +lemma Well_order_iso_copy:
  7.1150 +assumes WELL: "well_order_on A r" and BIJ: "bij_betw f A A'"
  7.1151 +shows "\<exists>r'. well_order_on A' r' \<and> r =o r'"
  7.1152 +proof-
  7.1153 +   let ?r' = "dir_image r f"
  7.1154 +   have 1: "A = Field r \<and> Well_order r"
  7.1155 +   using WELL rel.well_order_on_Well_order by blast
  7.1156 +   hence 2: "iso r ?r' f"
  7.1157 +   using dir_image_iso using BIJ unfolding bij_betw_def by auto
  7.1158 +   hence "f ` (Field r) = Field ?r'" using 1 iso_iff[of r ?r'] by blast
  7.1159 +   hence "Field ?r' = A'"
  7.1160 +   using 1 BIJ unfolding bij_betw_def by auto
  7.1161 +   moreover have "Well_order ?r'"
  7.1162 +   using 1 Well_order_dir_image BIJ unfolding bij_betw_def by blast
  7.1163 +   ultimately show ?thesis unfolding ordIso_def using 1 2 by blast
  7.1164 +qed
  7.1165 +
  7.1166 +
  7.1167 +
  7.1168 +subsection {* Bounded square  *}
  7.1169 +
  7.1170 +
  7.1171 +text{* This construction essentially defines, for an order relation @{text "r"}, a lexicographic
  7.1172 +order @{text "bsqr r"} on @{text "(Field r) \<times> (Field r)"}, applying the
  7.1173 +following criteria (in this order):
  7.1174 +\begin{itemize}
  7.1175 +\item compare the maximums;
  7.1176 +\item compare the first components;
  7.1177 +\item compare the second components.
  7.1178 +\end{itemize}
  7.1179 +%
  7.1180 +The only application of this construction that we are aware of is
  7.1181 +at proving that the square of an infinite set has the same cardinal
  7.1182 +as that set. The essential property required there (and which is ensured by this
  7.1183 +construction) is that any proper order filter of the product order is included in a rectangle, i.e.,
  7.1184 +in a product of proper filters on the original relation (assumed to be a well-order). *}
  7.1185 +
  7.1186 +
  7.1187 +definition bsqr :: "'a rel => ('a * 'a)rel"
  7.1188 +where
  7.1189 +"bsqr r = {((a1,a2),(b1,b2)).
  7.1190 +           {a1,a2,b1,b2} \<le> Field r \<and>
  7.1191 +           (a1 = b1 \<and> a2 = b2 \<or>
  7.1192 +            (wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r - Id \<or>
  7.1193 +            wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> (a1,b1) \<in> r - Id \<or>
  7.1194 +            wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> a1 = b1  \<and> (a2,b2) \<in> r - Id
  7.1195 +           )}"
  7.1196 +
  7.1197 +
  7.1198 +lemma Field_bsqr:
  7.1199 +"Field (bsqr r) = Field r \<times> Field r"
  7.1200 +proof
  7.1201 +  show "Field (bsqr r) \<le> Field r \<times> Field r"
  7.1202 +  proof-
  7.1203 +    {fix a1 a2 assume "(a1,a2) \<in> Field (bsqr r)"
  7.1204 +     moreover
  7.1205 +     have "\<And> b1 b2. ((a1,a2),(b1,b2)) \<in> bsqr r \<or> ((b1,b2),(a1,a2)) \<in> bsqr r \<Longrightarrow>
  7.1206 +                      a1 \<in> Field r \<and> a2 \<in> Field r" unfolding bsqr_def by auto
  7.1207 +     ultimately have "a1 \<in> Field r \<and> a2 \<in> Field r" unfolding Field_def by auto
  7.1208 +    }
  7.1209 +    thus ?thesis unfolding Field_def by force
  7.1210 +  qed
  7.1211 +next
  7.1212 +  show "Field r \<times> Field r \<le> Field (bsqr r)"
  7.1213 +  proof(auto)
  7.1214 +    fix a1 a2 assume "a1 \<in> Field r" and "a2 \<in> Field r"
  7.1215 +    hence "((a1,a2),(a1,a2)) \<in> bsqr r" unfolding bsqr_def by blast
  7.1216 +    thus "(a1,a2) \<in> Field (bsqr r)" unfolding Field_def by auto
  7.1217 +  qed
  7.1218 +qed
  7.1219 +
  7.1220 +
  7.1221 +lemma bsqr_Refl: "Refl(bsqr r)"
  7.1222 +by(unfold refl_on_def Field_bsqr, auto simp add: bsqr_def)
  7.1223 +
  7.1224 +
  7.1225 +lemma bsqr_Trans:
  7.1226 +assumes "Well_order r"
  7.1227 +shows "trans (bsqr r)"
  7.1228 +proof(unfold trans_def, auto)
  7.1229 +  (* Preliminary facts *)
  7.1230 +  have Well: "wo_rel r" using assms wo_rel_def by auto
  7.1231 +  hence Trans: "trans r" using wo_rel.TRANS by auto
  7.1232 +  have Anti: "antisym r" using wo_rel.ANTISYM Well by auto
  7.1233 +  hence TransS: "trans(r - Id)" using Trans by (simp add: trans_diff_Id)
  7.1234 +  (* Main proof *)
  7.1235 +  fix a1 a2 b1 b2 c1 c2
  7.1236 +  assume *: "((a1,a2),(b1,b2)) \<in> bsqr r" and **: "((b1,b2),(c1,c2)) \<in> bsqr r"
  7.1237 +  hence 0: "{a1,a2,b1,b2,c1,c2} \<le> Field r" unfolding bsqr_def by auto
  7.1238 +  have 1: "a1 = b1 \<and> a2 = b2 \<or> (wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r - Id \<or>
  7.1239 +           wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> (a1,b1) \<in> r - Id \<or>
  7.1240 +           wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> a1 = b1 \<and> (a2,b2) \<in> r - Id"
  7.1241 +  using * unfolding bsqr_def by auto
  7.1242 +  have 2: "b1 = c1 \<and> b2 = c2 \<or> (wo_rel.max2 r b1 b2, wo_rel.max2 r c1 c2) \<in> r - Id \<or>
  7.1243 +           wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> (b1,c1) \<in> r - Id \<or>
  7.1244 +           wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> b1 = c1 \<and> (b2,c2) \<in> r - Id"
  7.1245 +  using ** unfolding bsqr_def by auto
  7.1246 +  show "((a1,a2),(c1,c2)) \<in> bsqr r"
  7.1247 +  proof-
  7.1248 +    {assume Case1: "a1 = b1 \<and> a2 = b2"
  7.1249 +     hence ?thesis using ** by simp
  7.1250 +    }
  7.1251 +    moreover
  7.1252 +    {assume Case2: "(wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r - Id"
  7.1253 +     {assume Case21: "b1 = c1 \<and> b2 = c2"
  7.1254 +      hence ?thesis using * by simp
  7.1255 +     }
  7.1256 +     moreover
  7.1257 +     {assume Case22: "(wo_rel.max2 r b1 b2, wo_rel.max2 r c1 c2) \<in> r - Id"
  7.1258 +      hence "(wo_rel.max2 r a1 a2, wo_rel.max2 r c1 c2) \<in> r - Id"
  7.1259 +      using Case2 TransS trans_def[of "r - Id"] by blast
  7.1260 +      hence ?thesis using 0 unfolding bsqr_def by auto
  7.1261 +     }
  7.1262 +     moreover
  7.1263 +     {assume Case23_4: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2"
  7.1264 +      hence ?thesis using Case2 0 unfolding bsqr_def by auto
  7.1265 +     }
  7.1266 +     ultimately have ?thesis using 0 2 by auto
  7.1267 +    }
  7.1268 +    moreover
  7.1269 +    {assume Case3: "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> (a1,b1) \<in> r - Id"
  7.1270 +     {assume Case31: "b1 = c1 \<and> b2 = c2"
  7.1271 +      hence ?thesis using * by simp
  7.1272 +     }
  7.1273 +     moreover
  7.1274 +     {assume Case32: "(wo_rel.max2 r b1 b2, wo_rel.max2 r c1 c2) \<in> r - Id"
  7.1275 +      hence ?thesis using Case3 0 unfolding bsqr_def by auto
  7.1276 +     }
  7.1277 +     moreover
  7.1278 +     {assume Case33: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> (b1,c1) \<in> r - Id"
  7.1279 +      hence "(a1,c1) \<in> r - Id"
  7.1280 +      using Case3 TransS trans_def[of "r - Id"] by blast
  7.1281 +      hence ?thesis using Case3 Case33 0 unfolding bsqr_def by auto
  7.1282 +     }
  7.1283 +     moreover
  7.1284 +     {assume Case33: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> b1 = c1"
  7.1285 +      hence ?thesis using Case3 0 unfolding bsqr_def by auto
  7.1286 +     }
  7.1287 +     ultimately have ?thesis using 0 2 by auto
  7.1288 +    }
  7.1289 +    moreover
  7.1290 +    {assume Case4: "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> a1 = b1 \<and> (a2,b2) \<in> r - Id"
  7.1291 +     {assume Case41: "b1 = c1 \<and> b2 = c2"
  7.1292 +      hence ?thesis using * by simp
  7.1293 +     }
  7.1294 +     moreover
  7.1295 +     {assume Case42: "(wo_rel.max2 r b1 b2, wo_rel.max2 r c1 c2) \<in> r - Id"
  7.1296 +      hence ?thesis using Case4 0 unfolding bsqr_def by auto
  7.1297 +     }
  7.1298 +     moreover
  7.1299 +     {assume Case43: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> (b1,c1) \<in> r - Id"
  7.1300 +      hence ?thesis using Case4 0 unfolding bsqr_def by auto
  7.1301 +     }
  7.1302 +     moreover
  7.1303 +     {assume Case44: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> b1 = c1 \<and> (b2,c2) \<in> r - Id"
  7.1304 +      hence "(a2,c2) \<in> r - Id"
  7.1305 +      using Case4 TransS trans_def[of "r - Id"] by blast
  7.1306 +      hence ?thesis using Case4 Case44 0 unfolding bsqr_def by auto
  7.1307 +     }
  7.1308 +     ultimately have ?thesis using 0 2 by auto
  7.1309 +    }
  7.1310 +    ultimately show ?thesis using 0 1 by auto
  7.1311 +  qed
  7.1312 +qed
  7.1313 +
  7.1314 +
  7.1315 +lemma bsqr_antisym:
  7.1316 +assumes "Well_order r"
  7.1317 +shows "antisym (bsqr r)"
  7.1318 +proof(unfold antisym_def, clarify)
  7.1319 +  (* Preliminary facts *)
  7.1320 +  have Well: "wo_rel r" using assms wo_rel_def by auto
  7.1321 +  hence Trans: "trans r" using wo_rel.TRANS by auto
  7.1322 +  have Anti: "antisym r" using wo_rel.ANTISYM Well by auto
  7.1323 +  hence TransS: "trans(r - Id)" using Trans by (simp add: trans_diff_Id)
  7.1324 +  hence IrrS: "\<forall>a b. \<not>((a,b) \<in> r - Id \<and> (b,a) \<in> r - Id)"
  7.1325 +  using Anti trans_def[of "r - Id"] antisym_def[of "r - Id"] by blast
  7.1326 +  (* Main proof *)
  7.1327 +  fix a1 a2 b1 b2
  7.1328 +  assume *: "((a1,a2),(b1,b2)) \<in> bsqr r" and **: "((b1,b2),(a1,a2)) \<in> bsqr r"
  7.1329 +  hence 0: "{a1,a2,b1,b2} \<le> Field r" unfolding bsqr_def by auto
  7.1330 +  have 1: "a1 = b1 \<and> a2 = b2 \<or> (wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r - Id \<or>
  7.1331 +           wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> (a1,b1) \<in> r - Id \<or>
  7.1332 +           wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> a1 = b1 \<and> (a2,b2) \<in> r - Id"
  7.1333 +  using * unfolding bsqr_def by auto
  7.1334 +  have 2: "b1 = a1 \<and> b2 = a2 \<or> (wo_rel.max2 r b1 b2, wo_rel.max2 r a1 a2) \<in> r - Id \<or>
  7.1335 +           wo_rel.max2 r b1 b2 = wo_rel.max2 r a1 a2 \<and> (b1,a1) \<in> r - Id \<or>
  7.1336 +           wo_rel.max2 r b1 b2 = wo_rel.max2 r a1 a2 \<and> b1 = a1 \<and> (b2,a2) \<in> r - Id"
  7.1337 +  using ** unfolding bsqr_def by auto
  7.1338 +  show "a1 = b1 \<and> a2 = b2"
  7.1339 +  proof-
  7.1340 +    {assume Case1: "(wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r - Id"
  7.1341 +     {assume Case11: "(wo_rel.max2 r b1 b2, wo_rel.max2 r a1 a2) \<in> r - Id"
  7.1342 +      hence False using Case1 IrrS by blast
  7.1343 +     }
  7.1344 +     moreover
  7.1345 +     {assume Case12_3: "wo_rel.max2 r b1 b2 = wo_rel.max2 r a1 a2"
  7.1346 +      hence False using Case1 by auto
  7.1347 +     }
  7.1348 +     ultimately have ?thesis using 0 2 by auto
  7.1349 +    }
  7.1350 +    moreover
  7.1351 +    {assume Case2: "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> (a1,b1) \<in> r - Id"
  7.1352 +     {assume Case21: "(wo_rel.max2 r b1 b2, wo_rel.max2 r a1 a2) \<in> r - Id"
  7.1353 +       hence False using Case2 by auto
  7.1354 +     }
  7.1355 +     moreover
  7.1356 +     {assume Case22: "(b1,a1) \<in> r - Id"
  7.1357 +      hence False using Case2 IrrS by blast
  7.1358 +     }
  7.1359 +     moreover
  7.1360 +     {assume Case23: "b1 = a1"
  7.1361 +      hence False using Case2 by auto
  7.1362 +     }
  7.1363 +     ultimately have ?thesis using 0 2 by auto
  7.1364 +    }
  7.1365 +    moreover
  7.1366 +    {assume Case3: "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> a1 = b1 \<and> (a2,b2) \<in> r - Id"
  7.1367 +     moreover
  7.1368 +     {assume Case31: "(wo_rel.max2 r b1 b2, wo_rel.max2 r a1 a2) \<in> r - Id"
  7.1369 +      hence False using Case3 by auto
  7.1370 +     }
  7.1371 +     moreover
  7.1372 +     {assume Case32: "(b1,a1) \<in> r - Id"
  7.1373 +      hence False using Case3 by auto
  7.1374 +     }
  7.1375 +     moreover
  7.1376 +     {assume Case33: "(b2,a2) \<in> r - Id"
  7.1377 +      hence False using Case3 IrrS by blast
  7.1378 +     }
  7.1379 +     ultimately have ?thesis using 0 2 by auto
  7.1380 +    }
  7.1381 +    ultimately show ?thesis using 0 1 by blast
  7.1382 +  qed
  7.1383 +qed
  7.1384 +
  7.1385 +
  7.1386 +lemma bsqr_Total:
  7.1387 +assumes "Well_order r"
  7.1388 +shows "Total(bsqr r)"
  7.1389 +proof-
  7.1390 +  (* Preliminary facts *)
  7.1391 +  have Well: "wo_rel r" using assms wo_rel_def by auto
  7.1392 +  hence Total: "\<forall>a \<in> Field r. \<forall>b \<in> Field r. (a,b) \<in> r \<or> (b,a) \<in> r"
  7.1393 +  using wo_rel.TOTALS by auto
  7.1394 +  (* Main proof *)
  7.1395 +  {fix a1 a2 b1 b2 assume "{(a1,a2), (b1,b2)} \<le> Field(bsqr r)"
  7.1396 +   hence 0: "a1 \<in> Field r \<and> a2 \<in> Field r \<and> b1 \<in> Field r \<and> b2 \<in> Field r"
  7.1397 +   using Field_bsqr by blast
  7.1398 +   have "((a1,a2) = (b1,b2) \<or> ((a1,a2),(b1,b2)) \<in> bsqr r \<or> ((b1,b2),(a1,a2)) \<in> bsqr r)"
  7.1399 +   proof(rule wo_rel.cases_Total[of r a1 a2], clarsimp simp add: Well, simp add: 0)
  7.1400 +       (* Why didn't clarsimp simp add: Well 0 do the same job? *)
  7.1401 +     assume Case1: "(a1,a2) \<in> r"
  7.1402 +     hence 1: "wo_rel.max2 r a1 a2 = a2"
  7.1403 +     using Well 0 by (simp add: wo_rel.max2_equals2)
  7.1404 +     show ?thesis
  7.1405 +     proof(rule wo_rel.cases_Total[of r b1 b2], clarsimp simp add: Well, simp add: 0)
  7.1406 +       assume Case11: "(b1,b2) \<in> r"
  7.1407 +       hence 2: "wo_rel.max2 r b1 b2 = b2"
  7.1408 +       using Well 0 by (simp add: wo_rel.max2_equals2)
  7.1409 +       show ?thesis
  7.1410 +       proof(rule wo_rel.cases_Total3[of r a2 b2], clarsimp simp add: Well, simp add: 0)
  7.1411 +         assume Case111: "(a2,b2) \<in> r - Id \<or> (b2,a2) \<in> r - Id"
  7.1412 +         thus ?thesis using 0 1 2 unfolding bsqr_def by auto
  7.1413 +       next
  7.1414 +         assume Case112: "a2 = b2"
  7.1415 +         show ?thesis
  7.1416 +         proof(rule wo_rel.cases_Total3[of r a1 b1], clarsimp simp add: Well, simp add: 0)
  7.1417 +           assume Case1121: "(a1,b1) \<in> r - Id \<or> (b1,a1) \<in> r - Id"
  7.1418 +           thus ?thesis using 0 1 2 Case112 unfolding bsqr_def by auto
  7.1419 +         next
  7.1420 +           assume Case1122: "a1 = b1"
  7.1421 +           thus ?thesis using Case112 by auto
  7.1422 +         qed
  7.1423 +       qed
  7.1424 +     next
  7.1425 +       assume Case12: "(b2,b1) \<in> r"
  7.1426 +       hence 3: "wo_rel.max2 r b1 b2 = b1" using Well 0 by (simp add: wo_rel.max2_equals1)
  7.1427 +       show ?thesis
  7.1428 +       proof(rule wo_rel.cases_Total3[of r a2 b1], clarsimp simp add: Well, simp add: 0)
  7.1429 +         assume Case121: "(a2,b1) \<in> r - Id \<or> (b1,a2) \<in> r - Id"
  7.1430 +         thus ?thesis using 0 1 3 unfolding bsqr_def by auto
  7.1431 +       next
  7.1432 +         assume Case122: "a2 = b1"
  7.1433 +         show ?thesis
  7.1434 +         proof(rule wo_rel.cases_Total3[of r a1 b1], clarsimp simp add: Well, simp add: 0)
  7.1435 +           assume Case1221: "(a1,b1) \<in> r - Id \<or> (b1,a1) \<in> r - Id"
  7.1436 +           thus ?thesis using 0 1 3 Case122 unfolding bsqr_def by auto
  7.1437 +         next
  7.1438 +           assume Case1222: "a1 = b1"
  7.1439 +           show ?thesis
  7.1440 +           proof(rule wo_rel.cases_Total3[of r a2 b2], clarsimp simp add: Well, simp add: 0)
  7.1441 +             assume Case12221: "(a2,b2) \<in> r - Id \<or> (b2,a2) \<in> r - Id"
  7.1442 +             thus ?thesis using 0 1 3 Case122 Case1222 unfolding bsqr_def by auto
  7.1443 +           next
  7.1444 +             assume Case12222: "a2 = b2"
  7.1445 +             thus ?thesis using Case122 Case1222 by auto
  7.1446 +           qed
  7.1447 +         qed
  7.1448 +       qed
  7.1449 +     qed
  7.1450 +   next
  7.1451 +     assume Case2: "(a2,a1) \<in> r"
  7.1452 +     hence 1: "wo_rel.max2 r a1 a2 = a1" using Well 0 by (simp add: wo_rel.max2_equals1)
  7.1453 +     show ?thesis
  7.1454 +     proof(rule wo_rel.cases_Total[of r b1 b2], clarsimp simp add: Well, simp add: 0)
  7.1455 +       assume Case21: "(b1,b2) \<in> r"
  7.1456 +       hence 2: "wo_rel.max2 r b1 b2 = b2" using Well 0 by (simp add: wo_rel.max2_equals2)
  7.1457 +       show ?thesis
  7.1458 +       proof(rule wo_rel.cases_Total3[of r a1 b2], clarsimp simp add: Well, simp add: 0)
  7.1459 +         assume Case211: "(a1,b2) \<in> r - Id \<or> (b2,a1) \<in> r - Id"
  7.1460 +         thus ?thesis using 0 1 2 unfolding bsqr_def by auto
  7.1461 +       next
  7.1462 +         assume Case212: "a1 = b2"
  7.1463 +         show ?thesis
  7.1464 +         proof(rule wo_rel.cases_Total3[of r a1 b1], clarsimp simp add: Well, simp add: 0)
  7.1465 +           assume Case2121: "(a1,b1) \<in> r - Id \<or> (b1,a1) \<in> r - Id"
  7.1466 +           thus ?thesis using 0 1 2 Case212 unfolding bsqr_def by auto
  7.1467 +         next
  7.1468 +           assume Case2122: "a1 = b1"
  7.1469 +           show ?thesis
  7.1470 +           proof(rule wo_rel.cases_Total3[of r a2 b2], clarsimp simp add: Well, simp add: 0)
  7.1471 +             assume Case21221: "(a2,b2) \<in> r - Id \<or> (b2,a2) \<in> r - Id"
  7.1472 +             thus ?thesis using 0 1 2 Case212 Case2122 unfolding bsqr_def by auto
  7.1473 +           next
  7.1474 +             assume Case21222: "a2 = b2"
  7.1475 +             thus ?thesis using Case2122 Case212 by auto
  7.1476 +           qed
  7.1477 +         qed
  7.1478 +       qed
  7.1479 +     next
  7.1480 +       assume Case22: "(b2,b1) \<in> r"
  7.1481 +       hence 3: "wo_rel.max2 r b1 b2 = b1"  using Well 0 by (simp add: wo_rel.max2_equals1)
  7.1482 +       show ?thesis
  7.1483 +       proof(rule wo_rel.cases_Total3[of r a1 b1], clarsimp simp add: Well, simp add: 0)
  7.1484 +         assume Case221: "(a1,b1) \<in> r - Id \<or> (b1,a1) \<in> r - Id"
  7.1485 +         thus ?thesis using 0 1 3 unfolding bsqr_def by auto
  7.1486 +       next
  7.1487 +         assume Case222: "a1 = b1"
  7.1488 +         show ?thesis
  7.1489 +         proof(rule wo_rel.cases_Total3[of r a2 b2], clarsimp simp add: Well, simp add: 0)
  7.1490 +           assume Case2221: "(a2,b2) \<in> r - Id \<or> (b2,a2) \<in> r - Id"
  7.1491 +           thus ?thesis using 0 1 3 Case222 unfolding bsqr_def by auto
  7.1492 +         next
  7.1493 +           assume Case2222: "a2 = b2"
  7.1494 +           thus ?thesis using Case222 by auto
  7.1495 +         qed
  7.1496 +       qed
  7.1497 +     qed
  7.1498 +   qed
  7.1499 +  }
  7.1500 +  thus ?thesis unfolding total_on_def by fast
  7.1501 +qed
  7.1502 +
  7.1503 +
  7.1504 +lemma bsqr_Linear_order:
  7.1505 +assumes "Well_order r"
  7.1506 +shows "Linear_order(bsqr r)"
  7.1507 +unfolding order_on_defs
  7.1508 +using assms bsqr_Refl bsqr_Trans bsqr_antisym bsqr_Total by blast
  7.1509 +
  7.1510 +
  7.1511 +lemma bsqr_Well_order:
  7.1512 +assumes "Well_order r"
  7.1513 +shows "Well_order(bsqr r)"
  7.1514 +using assms
  7.1515 +proof(simp add: bsqr_Linear_order Linear_order_Well_order_iff, intro allI impI)
  7.1516 +  have 0: "\<forall>A \<le> Field r. A \<noteq> {} \<longrightarrow> (\<exists>a \<in> A. \<forall>a' \<in> A. (a,a') \<in> r)"
  7.1517 +  using assms well_order_on_def Linear_order_Well_order_iff by blast
  7.1518 +  fix D assume *: "D \<le> Field (bsqr r)" and **: "D \<noteq> {}"
  7.1519 +  hence 1: "D \<le> Field r \<times> Field r" unfolding Field_bsqr by simp
  7.1520 +  (*  *)
  7.1521 +  obtain M where M_def: "M = {wo_rel.max2 r a1 a2| a1 a2. (a1,a2) \<in> D}" by blast
  7.1522 +  have "M \<noteq> {}" using 1 M_def ** by auto
  7.1523 +  moreover
  7.1524 +  have "M \<le> Field r" unfolding M_def
  7.1525 +  using 1 assms wo_rel_def[of r] wo_rel.max2_among[of r] by fastforce
  7.1526 +  ultimately obtain m where m_min: "m \<in> M \<and> (\<forall>a \<in> M. (m,a) \<in> r)"
  7.1527 +  using 0 by blast
  7.1528 +  (*  *)
  7.1529 +  obtain A1 where A1_def: "A1 = {a1. \<exists>a2. (a1,a2) \<in> D \<and> wo_rel.max2 r a1 a2 = m}" by blast
  7.1530 +  have "A1 \<le> Field r" unfolding A1_def using 1 by auto
  7.1531 +  moreover have "A1 \<noteq> {}" unfolding A1_def using m_min unfolding M_def by blast
  7.1532 +  ultimately obtain a1 where a1_min: "a1 \<in> A1 \<and> (\<forall>a \<in> A1. (a1,a) \<in> r)"
  7.1533 +  using 0 by blast
  7.1534 +  (*  *)
  7.1535 +  obtain A2 where A2_def: "A2 = {a2. (a1,a2) \<in> D \<and> wo_rel.max2 r a1 a2 = m}" by blast
  7.1536 +  have "A2 \<le> Field r" unfolding A2_def using 1 by auto
  7.1537 +  moreover have "A2 \<noteq> {}" unfolding A2_def
  7.1538 +  using m_min a1_min unfolding A1_def M_def by blast
  7.1539 +  ultimately obtain a2 where a2_min: "a2 \<in> A2 \<and> (\<forall>a \<in> A2. (a2,a) \<in> r)"
  7.1540 +  using 0 by blast
  7.1541 +  (*   *)
  7.1542 +  have 2: "wo_rel.max2 r a1 a2 = m"
  7.1543 +  using a1_min a2_min unfolding A1_def A2_def by auto
  7.1544 +  have 3: "(a1,a2) \<in> D" using a2_min unfolding A2_def by auto
  7.1545 +  (*  *)
  7.1546 +  moreover
  7.1547 +  {fix b1 b2 assume ***: "(b1,b2) \<in> D"
  7.1548 +   hence 4: "{a1,a2,b1,b2} \<le> Field r" using 1 3 by blast
  7.1549 +   have 5: "(wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r"
  7.1550 +   using *** a1_min a2_min m_min unfolding A1_def A2_def M_def by auto
  7.1551 +   have "((a1,a2),(b1,b2)) \<in> bsqr r"
  7.1552 +   proof(cases "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2")
  7.1553 +     assume Case1: "wo_rel.max2 r a1 a2 \<noteq> wo_rel.max2 r b1 b2"
  7.1554 +     thus ?thesis unfolding bsqr_def using 4 5 by auto
  7.1555 +   next
  7.1556 +     assume Case2: "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2"
  7.1557 +     hence "b1 \<in> A1" unfolding A1_def using 2 *** by auto
  7.1558 +     hence 6: "(a1,b1) \<in> r" using a1_min by auto
  7.1559 +     show ?thesis
  7.1560 +     proof(cases "a1 = b1")
  7.1561 +       assume Case21: "a1 \<noteq> b1"
  7.1562 +       thus ?thesis unfolding bsqr_def using 4 Case2 6 by auto
  7.1563 +     next
  7.1564 +       assume Case22: "a1 = b1"
  7.1565 +       hence "b2 \<in> A2" unfolding A2_def using 2 *** Case2 by auto
  7.1566 +       hence 7: "(a2,b2) \<in> r" using a2_min by auto
  7.1567 +       thus ?thesis unfolding bsqr_def using 4 7 Case2 Case22 by auto
  7.1568 +     qed
  7.1569 +   qed
  7.1570 +  }
  7.1571 +  (*  *)
  7.1572 +  ultimately show "\<exists>d \<in> D. \<forall>d' \<in> D. (d,d') \<in> bsqr r" by fastforce
  7.1573 +qed
  7.1574 +
  7.1575 +
  7.1576 +lemma bsqr_max2:
  7.1577 +assumes WELL: "Well_order r" and LEQ: "((a1,a2),(b1,b2)) \<in> bsqr r"
  7.1578 +shows "(wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r"
  7.1579 +proof-
  7.1580 +  have "{(a1,a2),(b1,b2)} \<le> Field(bsqr r)"
  7.1581 +  using LEQ unfolding Field_def by auto
  7.1582 +  hence "{a1,a2,b1,b2} \<le> Field r" unfolding Field_bsqr by auto
  7.1583 +  hence "{wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2} \<le> Field r"
  7.1584 +  using WELL wo_rel_def[of r] wo_rel.max2_among[of r] by fastforce
  7.1585 +  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"
  7.1586 +  using LEQ unfolding bsqr_def by auto
  7.1587 +  ultimately show ?thesis using WELL unfolding order_on_defs refl_on_def by auto
  7.1588 +qed
  7.1589 +
  7.1590 +
  7.1591 +lemma bsqr_ofilter:
  7.1592 +assumes WELL: "Well_order r" and
  7.1593 +        OF: "wo_rel.ofilter (bsqr r) D" and SUB: "D < Field r \<times> Field r" and
  7.1594 +        NE: "\<not> (\<exists>a. Field r = rel.under r a)"
  7.1595 +shows "\<exists>A. wo_rel.ofilter r A \<and> A < Field r \<and> D \<le> A \<times> A"
  7.1596 +proof-
  7.1597 +  let ?r' = "bsqr r"
  7.1598 +  have Well: "wo_rel r" using WELL wo_rel_def by blast
  7.1599 +  hence Trans: "trans r" using wo_rel.TRANS by blast
  7.1600 +  have Well': "Well_order ?r' \<and> wo_rel ?r'"
  7.1601 +  using WELL bsqr_Well_order wo_rel_def by blast
  7.1602 +  (*  *)
  7.1603 +  have "D < Field ?r'" unfolding Field_bsqr using SUB .
  7.1604 +  with OF obtain a1 and a2 where
  7.1605 +  "(a1,a2) \<in> Field ?r'" and 1: "D = rel.underS ?r' (a1,a2)"
  7.1606 +  using Well' wo_rel.ofilter_underS_Field[of ?r' D] by auto
  7.1607 +  hence 2: "{a1,a2} \<le> Field r" unfolding Field_bsqr by auto
  7.1608 +  let ?m = "wo_rel.max2 r a1 a2"
  7.1609 +  have "D \<le> (rel.under r ?m) \<times> (rel.under r ?m)"
  7.1610 +  proof(unfold 1)
  7.1611 +    {fix b1 b2
  7.1612 +     let ?n = "wo_rel.max2 r b1 b2"
  7.1613 +     assume "(b1,b2) \<in> rel.underS ?r' (a1,a2)"
  7.1614 +     hence 3: "((b1,b2),(a1,a2)) \<in> ?r'"
  7.1615 +     unfolding rel.underS_def by blast
  7.1616 +     hence "(?n,?m) \<in> r" using WELL by (simp add: bsqr_max2)
  7.1617 +     moreover
  7.1618 +     {have "(b1,b2) \<in> Field ?r'" using 3 unfolding Field_def by auto
  7.1619 +      hence "{b1,b2} \<le> Field r" unfolding Field_bsqr by auto
  7.1620 +      hence "(b1,?n) \<in> r \<and> (b2,?n) \<in> r"
  7.1621 +      using Well by (simp add: wo_rel.max2_greater)
  7.1622 +     }
  7.1623 +     ultimately have "(b1,?m) \<in> r \<and> (b2,?m) \<in> r"
  7.1624 +     using Trans trans_def[of r] by blast
  7.1625 +     hence "(b1,b2) \<in> (rel.under r ?m) \<times> (rel.under r ?m)" unfolding rel.under_def by simp}
  7.1626 +     thus "rel.underS ?r' (a1,a2) \<le> (rel.under r ?m) \<times> (rel.under r ?m)" by auto
  7.1627 +  qed
  7.1628 +  moreover have "wo_rel.ofilter r (rel.under r ?m)"
  7.1629 +  using Well by (simp add: wo_rel.under_ofilter)
  7.1630 +  moreover have "rel.under r ?m < Field r"
  7.1631 +  using NE rel.under_Field[of r ?m] by blast
  7.1632 +  ultimately show ?thesis by blast
  7.1633 +qed
  7.1634 +
  7.1635 +
  7.1636 +end
     8.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     8.2 +++ b/src/HOL/Cardinals/Fun_More.thy	Wed Sep 12 05:29:21 2012 +0200
     8.3 @@ -0,0 +1,183 @@
     8.4 +(*  Title:      HOL/Cardinals/Fun_More.thy
     8.5 +    Author:     Andrei Popescu, TU Muenchen
     8.6 +    Copyright   2012
     8.7 +
     8.8 +More on injections, bijections and inverses.
     8.9 +*)
    8.10 +
    8.11 +header {* More on Injections, Bijections and Inverses *}
    8.12 +
    8.13 +theory Fun_More
    8.14 +imports Fun_More_Base
    8.15 +begin
    8.16 +
    8.17 +
    8.18 +subsection {* Purely functional properties  *}
    8.19 +
    8.20 +(* unused *)
    8.21 +(*1*)lemma notIn_Un_bij_betw2:
    8.22 +assumes NIN: "b \<notin> A" and NIN': "b' \<notin> A'" and
    8.23 +        BIJ: "bij_betw f A A'"
    8.24 +shows "bij_betw f (A \<union> {b}) (A' \<union> {b'}) = (f b = b')"
    8.25 +proof
    8.26 +  assume "f b = b'"
    8.27 +  thus "bij_betw f (A \<union> {b}) (A' \<union> {b'})"
    8.28 +  using assms notIn_Un_bij_betw[of b A f A'] by auto
    8.29 +next
    8.30 +  assume *: "bij_betw f (A \<union> {b}) (A' \<union> {b'})"
    8.31 +  hence "f b \<in> A' \<union> {b'}"
    8.32 +  unfolding bij_betw_def by auto
    8.33 +  moreover
    8.34 +  {assume "f b \<in> A'"
    8.35 +   then obtain b1 where 1: "b1 \<in> A" and 2: "f b1 = f b" using BIJ
    8.36 +   by (auto simp add: bij_betw_def)
    8.37 +   hence "b = b1" using *
    8.38 +   by (auto simp add: bij_betw_def inj_on_def)
    8.39 +   with 1 NIN have False by auto
    8.40 +  }
    8.41 +  ultimately show "f b = b'" by blast
    8.42 +qed
    8.43 +
    8.44 +(* unused *)
    8.45 +(*1*)lemma bij_betw_ball:
    8.46 +assumes BIJ: "bij_betw f A B"
    8.47 +shows "(\<forall>b \<in> B. phi b) = (\<forall>a \<in> A. phi(f a))"
    8.48 +using assms unfolding bij_betw_def inj_on_def by blast
    8.49 +
    8.50 +(* unused *)
    8.51 +(*1*)lemma bij_betw_diff_singl:
    8.52 +assumes BIJ: "bij_betw f A A'" and IN: "a \<in> A"
    8.53 +shows "bij_betw f (A - {a}) (A' - {f a})"
    8.54 +proof-
    8.55 +  let ?B = "A - {a}"   let ?B' = "A' - {f a}"
    8.56 +  have "f a \<in> A'" using IN BIJ unfolding bij_betw_def by blast
    8.57 +  hence "a \<notin> ?B \<and> f a \<notin> ?B' \<and> A = ?B \<union> {a} \<and> A' = ?B' \<union> {f a}"
    8.58 +  using IN by blast
    8.59 +  thus ?thesis using notIn_Un_bij_betw3[of a ?B f ?B'] BIJ by simp
    8.60 +qed
    8.61 +
    8.62 +
    8.63 +subsection {* Properties involving finite and infinite sets *}
    8.64 +
    8.65 +(*3*)lemma inj_on_image_Pow:
    8.66 +assumes "inj_on f A"
    8.67 +shows "inj_on (image f) (Pow A)"
    8.68 +unfolding Pow_def inj_on_def proof(clarsimp)
    8.69 +  fix X Y assume *: "X \<le> A" and **: "Y \<le> A" and
    8.70 +                 ***: "f ` X = f ` Y"
    8.71 +  show "X = Y"
    8.72 +  proof(auto)
    8.73 +    fix x assume ****: "x \<in> X"
    8.74 +    with *** obtain y where "y \<in> Y \<and> f x = f y" by blast
    8.75 +    with **** * ** assms show "x \<in> Y"
    8.76 +    unfolding inj_on_def by auto
    8.77 +  next
    8.78 +    fix y assume ****: "y \<in> Y"
    8.79 +    with *** obtain x where "x \<in> X \<and> f x = f y" by force
    8.80 +    with **** * ** assms show "y \<in> X"
    8.81 +    unfolding inj_on_def by auto
    8.82 +  qed
    8.83 +qed
    8.84 +
    8.85 +(*2*)lemma bij_betw_image_Pow:
    8.86 +assumes "bij_betw f A B"
    8.87 +shows "bij_betw (image f) (Pow A) (Pow B)"
    8.88 +using assms unfolding bij_betw_def
    8.89 +by (auto simp add: inj_on_image_Pow image_Pow_surj)
    8.90 +
    8.91 +(* unused *)
    8.92 +(*1*)lemma bij_betw_inv_into_RIGHT:
    8.93 +assumes BIJ: "bij_betw f A A'" and SUB: "B' \<le> A'"
    8.94 +shows "f `((inv_into A f)`B') = B'"
    8.95 +using assms
    8.96 +proof(auto simp add: bij_betw_inv_into_right)
    8.97 +  let ?f' = "(inv_into A f)"
    8.98 +  fix a' assume *: "a' \<in> B'"
    8.99 +  hence "a' \<in> A'" using SUB by auto
   8.100 +  hence "a' = f (?f' a')"
   8.101 +  using BIJ by (auto simp add: bij_betw_inv_into_right)
   8.102 +  thus "a' \<in> f ` (?f' ` B')" using * by blast
   8.103 +qed
   8.104 +
   8.105 +(* unused *)
   8.106 +(*1*)lemma bij_betw_inv_into_RIGHT_LEFT:
   8.107 +assumes BIJ: "bij_betw f A A'" and SUB: "B' \<le> A'" and
   8.108 +        IM: "(inv_into A f) ` B' = B"
   8.109 +shows "f ` B = B'"
   8.110 +proof-
   8.111 +  have "f`((inv_into A f)` B') = B'"
   8.112 +  using assms bij_betw_inv_into_RIGHT[of f A A' B'] by auto
   8.113 +  thus ?thesis using IM by auto
   8.114 +qed
   8.115 +
   8.116 +(* unused *)
   8.117 +(*2*)lemma bij_betw_inv_into_twice:
   8.118 +assumes "bij_betw f A A'"
   8.119 +shows "\<forall>a \<in> A. inv_into A' (inv_into A f) a = f a"
   8.120 +proof
   8.121 +  let ?f' = "inv_into A f"   let ?f'' = "inv_into A' ?f'"
   8.122 +  have 1: "bij_betw ?f' A' A" using assms
   8.123 +  by (auto simp add: bij_betw_inv_into)
   8.124 +  fix a assume *: "a \<in> A"
   8.125 +  then obtain a' where 2: "a' \<in> A'" and 3: "?f' a' = a"
   8.126 +  using 1 unfolding bij_betw_def by force
   8.127 +  hence "?f'' a = a'"
   8.128 +  using * 1 3 by (auto simp add: bij_betw_inv_into_left)
   8.129 +  moreover have "f a = a'" using assms 2 3
   8.130 +  by (auto simp add: bij_betw_inv_into_right)
   8.131 +  ultimately show "?f'' a = f a" by simp
   8.132 +qed
   8.133 +
   8.134 +
   8.135 +subsection {* Properties involving Hilbert choice *}
   8.136 +
   8.137 +
   8.138 +subsection {* Other facts *}
   8.139 +
   8.140 +(*3*)lemma atLeastLessThan_injective:
   8.141 +assumes "{0 ..< m::nat} = {0 ..< n}"
   8.142 +shows "m = n"
   8.143 +proof-
   8.144 +  {assume "m < n"
   8.145 +   hence "m \<in> {0 ..< n}" by auto
   8.146 +   hence "{0 ..< m} < {0 ..< n}" by auto
   8.147 +   hence False using assms by blast
   8.148 +  }
   8.149 +  moreover
   8.150 +  {assume "n < m"
   8.151 +   hence "n \<in> {0 ..< m}" by auto
   8.152 +   hence "{0 ..< n} < {0 ..< m}" by auto
   8.153 +   hence False using assms by blast
   8.154 +  }
   8.155 +  ultimately show ?thesis by force
   8.156 +qed
   8.157 +
   8.158 +(*2*)lemma atLeastLessThan_injective2:
   8.159 +"bij_betw f {0 ..< m::nat} {0 ..< n} \<Longrightarrow> m = n"
   8.160 +using finite_atLeastLessThan[of m] finite_atLeastLessThan[of n]
   8.161 +      card_atLeastLessThan[of m] card_atLeastLessThan[of n]
   8.162 +      bij_betw_iff_card[of "{0 ..< m}" "{0 ..< n}"] by auto
   8.163 +
   8.164 +(* unused *)
   8.165 +(*2*)lemma atLeastLessThan_less_eq3:
   8.166 +"(\<exists>f. inj_on f {0..<(m::nat)} \<and> f ` {0..<m} \<le> {0..<n}) = (m \<le> n)"
   8.167 +using atLeastLessThan_less_eq2
   8.168 +proof(auto)
   8.169 +  assume "m \<le> n"
   8.170 +  hence "inj_on id {0..<m} \<and> id ` {0..<m} \<subseteq> {0..<n}" unfolding inj_on_def by force
   8.171 +  thus "\<exists>f. inj_on f {0..<m} \<and> f ` {0..<m} \<subseteq> {0..<n}" by blast
   8.172 +qed
   8.173 +
   8.174 +(* unused *)
   8.175 +(*3*)lemma atLeastLessThan_less:
   8.176 +"({0..<m} < {0..<n}) = ((m::nat) < n)"
   8.177 +proof-
   8.178 +  have "({0..<m} < {0..<n}) = ({0..<m} \<le> {0..<n} \<and> {0..<m} ~= {0..<n})"
   8.179 +  using subset_iff_psubset_eq by blast
   8.180 +  also have "\<dots> = (m \<le> n \<and> m ~= n)"
   8.181 +  using atLeastLessThan_less_eq atLeastLessThan_injective by blast
   8.182 +  also have "\<dots> = (m < n)" by auto
   8.183 +  finally show ?thesis .
   8.184 +qed
   8.185 +
   8.186 +end
     9.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     9.2 +++ b/src/HOL/Cardinals/Fun_More_Base.thy	Wed Sep 12 05:29:21 2012 +0200
     9.3 @@ -0,0 +1,252 @@
     9.4 +(*  Title:      HOL/Cardinals/Fun_More_Base.thy
     9.5 +    Author:     Andrei Popescu, TU Muenchen
     9.6 +    Copyright   2012
     9.7 +
     9.8 +More on injections, bijections and inverses (base).
     9.9 +*)
    9.10 +
    9.11 +header {* More on Injections, Bijections and Inverses (Base) *}
    9.12 +
    9.13 +theory Fun_More_Base
    9.14 +imports "~~/src/HOL/Library/Infinite_Set"
    9.15 +begin
    9.16 +
    9.17 +
    9.18 +text {* This section proves more facts (additional to those in @{text "Fun.thy"},
    9.19 +@{text "Hilbert_Choice.thy"}, @{text "Finite_Set.thy"} and @{text "Infinite_Set.thy"}),
    9.20 +mainly concerning injections, bijections, inverses and (numeric) cardinals of
    9.21 +finite sets. *}
    9.22 +
    9.23 +
    9.24 +subsection {* Purely functional properties  *}
    9.25 +
    9.26 +
    9.27 +(*2*)lemma bij_betw_id_iff:
    9.28 +"(A = B) = (bij_betw id A B)"
    9.29 +by(simp add: bij_betw_def)
    9.30 +
    9.31 +
    9.32 +(*2*)lemma bij_betw_byWitness:
    9.33 +assumes LEFT: "\<forall>a \<in> A. f'(f a) = a" and
    9.34 +        RIGHT: "\<forall>a' \<in> A'. f(f' a') = a'" and
    9.35 +        IM1: "f ` A \<le> A'" and IM2: "f' ` A' \<le> A"
    9.36 +shows "bij_betw f A A'"
    9.37 +using assms
    9.38 +proof(unfold bij_betw_def inj_on_def, auto)
    9.39 +  fix a b assume *: "a \<in> A" "b \<in> A" and **: "f a = f b"
    9.40 +  have "a = f'(f a) \<and> b = f'(f b)" using * LEFT by simp
    9.41 +  with ** show "a = b" by simp
    9.42 +next
    9.43 +  fix a' assume *: "a' \<in> A'"
    9.44 +  hence "f' a' \<in> A" using IM2 by blast
    9.45 +  moreover
    9.46 +  have "a' = f(f' a')" using * RIGHT by simp
    9.47 +  ultimately show "a' \<in> f ` A" by blast
    9.48 +qed
    9.49 +
    9.50 +
    9.51 +(*3*)corollary notIn_Un_bij_betw:
    9.52 +assumes NIN: "b \<notin> A" and NIN': "f b \<notin> A'" and
    9.53 +       BIJ: "bij_betw f A A'"
    9.54 +shows "bij_betw f (A \<union> {b}) (A' \<union> {f b})"
    9.55 +proof-
    9.56 +  have "bij_betw f {b} {f b}"
    9.57 +  unfolding bij_betw_def inj_on_def by simp
    9.58 +  with assms show ?thesis
    9.59 +  using bij_betw_combine[of f A A' "{b}" "{f b}"] by blast
    9.60 +qed
    9.61 +
    9.62 +
    9.63 +(*1*)lemma notIn_Un_bij_betw3:
    9.64 +assumes NIN: "b \<notin> A" and NIN': "f b \<notin> A'"
    9.65 +shows "bij_betw f A A' = bij_betw f (A \<union> {b}) (A' \<union> {f b})"
    9.66 +proof
    9.67 +  assume "bij_betw f A A'"
    9.68 +  thus "bij_betw f (A \<union> {b}) (A' \<union> {f b})"
    9.69 +  using assms notIn_Un_bij_betw[of b A f A'] by blast
    9.70 +next
    9.71 +  assume *: "bij_betw f (A \<union> {b}) (A' \<union> {f b})"
    9.72 +  have "f ` A = A'"
    9.73 +  proof(auto)
    9.74 +    fix a assume **: "a \<in> A"
    9.75 +    hence "f a \<in> A' \<union> {f b}" using * unfolding bij_betw_def by blast
    9.76 +    moreover
    9.77 +    {assume "f a = f b"
    9.78 +     hence "a = b" using * ** unfolding bij_betw_def inj_on_def by blast
    9.79 +     with NIN ** have False by blast
    9.80 +    }
    9.81 +    ultimately show "f a \<in> A'" by blast
    9.82 +  next
    9.83 +    fix a' assume **: "a' \<in> A'"
    9.84 +    hence "a' \<in> f`(A \<union> {b})"
    9.85 +    using * by (auto simp add: bij_betw_def)
    9.86 +    then obtain a where 1: "a \<in> A \<union> {b} \<and> f a = a'" by blast
    9.87 +    moreover
    9.88 +    {assume "a = b" with 1 ** NIN' have False by blast
    9.89 +    }
    9.90 +    ultimately have "a \<in> A" by blast
    9.91 +    with 1 show "a' \<in> f ` A" by blast
    9.92 +  qed
    9.93 +  thus "bij_betw f A A'" using * bij_betw_subset[of f "A \<union> {b}" _ A] by blast
    9.94 +qed
    9.95 +
    9.96 +
    9.97 +subsection {* Properties involving finite and infinite sets *}
    9.98 +
    9.99 +
   9.100 +(*3*)lemma inj_on_finite:
   9.101 +assumes "inj_on f A" "f ` A \<le> B" "finite B"
   9.102 +shows "finite A"
   9.103 +using assms infinite_super by (fast dest: finite_imageD)
   9.104 +
   9.105 +
   9.106 +(*3*)lemma infinite_imp_bij_betw:
   9.107 +assumes INF: "infinite A"
   9.108 +shows "\<exists>h. bij_betw h A (A - {a})"
   9.109 +proof(cases "a \<in> A")
   9.110 +  assume Case1: "a \<notin> A"  hence "A - {a} = A" by blast
   9.111 +  thus ?thesis using bij_betw_id[of A] by auto
   9.112 +next
   9.113 +  assume Case2: "a \<in> A"
   9.114 +  have "infinite (A - {a})" using INF infinite_remove by auto
   9.115 +  with infinite_iff_countable_subset[of "A - {a}"] obtain f::"nat \<Rightarrow> 'a"
   9.116 +  where 1: "inj f" and 2: "f ` UNIV \<le> A - {a}" by blast
   9.117 +  obtain g where g_def: "g = (\<lambda> n. if n = 0 then a else f (Suc n))" by blast
   9.118 +  obtain A' where A'_def: "A' = g ` UNIV" by blast
   9.119 +  have temp: "\<forall>y. f y \<noteq> a" using 2 by blast
   9.120 +  have 3: "inj_on g UNIV \<and> g ` UNIV \<le> A \<and> a \<in> g ` UNIV"
   9.121 +  proof(auto simp add: Case2 g_def, unfold inj_on_def, intro ballI impI,
   9.122 +        case_tac "x = 0", auto simp add: 2)
   9.123 +    fix y  assume "a = (if y = 0 then a else f (Suc y))"
   9.124 +    thus "y = 0" using temp by (case_tac "y = 0", auto)
   9.125 +  next
   9.126 +    fix x y
   9.127 +    assume "f (Suc x) = (if y = 0 then a else f (Suc y))"
   9.128 +    thus "x = y" using 1 temp unfolding inj_on_def by (case_tac "y = 0", auto)
   9.129 +  next
   9.130 +    fix n show "f (Suc n) \<in> A" using 2 by blast
   9.131 +  qed
   9.132 +  hence 4: "bij_betw g UNIV A' \<and> a \<in> A' \<and> A' \<le> A"
   9.133 +  using inj_on_imp_bij_betw[of g] unfolding A'_def by auto
   9.134 +  hence 5: "bij_betw (inv g) A' UNIV"
   9.135 +  by (auto simp add: bij_betw_inv_into)
   9.136 +  (*  *)
   9.137 +  obtain n where "g n = a" using 3 by auto
   9.138 +  hence 6: "bij_betw g (UNIV - {n}) (A' - {a})"
   9.139 +  using 3 4 unfolding A'_def
   9.140 +  by clarify (rule bij_betw_subset, auto simp: image_set_diff)
   9.141 +  (*  *)
   9.142 +  obtain v where v_def: "v = (\<lambda> m. if m < n then m else Suc m)" by blast
   9.143 +  have 7: "bij_betw v UNIV (UNIV - {n})"
   9.144 +  proof(unfold bij_betw_def inj_on_def, intro conjI, clarify)
   9.145 +    fix m1 m2 assume "v m1 = v m2"
   9.146 +    thus "m1 = m2"
   9.147 +    by(case_tac "m1 < n", case_tac "m2 < n",
   9.148 +       auto simp add: inj_on_def v_def, case_tac "m2 < n", auto)
   9.149 +  next
   9.150 +    show "v ` UNIV = UNIV - {n}"
   9.151 +    proof(auto simp add: v_def)
   9.152 +      fix m assume *: "m \<noteq> n" and **: "m \<notin> Suc ` {m'. \<not> m' < n}"
   9.153 +      {assume "n \<le> m" with * have 71: "Suc n \<le> m" by auto
   9.154 +       then obtain m' where 72: "m = Suc m'" using Suc_le_D by auto
   9.155 +       with 71 have "n \<le> m'" by auto
   9.156 +       with 72 ** have False by auto
   9.157 +      }
   9.158 +      thus "m < n" by force
   9.159 +    qed
   9.160 +  qed
   9.161 +  (*  *)
   9.162 +  obtain h' where h'_def: "h' = g o v o (inv g)" by blast
   9.163 +  hence 8: "bij_betw h' A' (A' - {a})" using 5 7 6
   9.164 +  by (auto simp add: bij_betw_trans)
   9.165 +  (*  *)
   9.166 +  obtain h where h_def: "h = (\<lambda> b. if b \<in> A' then h' b else b)" by blast
   9.167 +  have "\<forall>b \<in> A'. h b = h' b" unfolding h_def by auto
   9.168 +  hence "bij_betw h  A' (A' - {a})" using 8 bij_betw_cong[of A' h] by auto
   9.169 +  moreover
   9.170 +  {have "\<forall>b \<in> A - A'. h b = b" unfolding h_def by auto
   9.171 +   hence "bij_betw h  (A - A') (A - A')"
   9.172 +   using bij_betw_cong[of "A - A'" h id] bij_betw_id[of "A - A'"] by auto
   9.173 +  }
   9.174 +  moreover
   9.175 +  have "(A' Int (A - A') = {} \<and> A' \<union> (A - A') = A) \<and>
   9.176 +        ((A' - {a}) Int (A - A') = {} \<and> (A' - {a}) \<union> (A - A') = A - {a})"
   9.177 +  us