author hoelzl Tue Nov 19 17:07:52 2013 +0100 (2013-11-19) changeset 54498 f7fef6b00bfe parent 54497 c76dec4df4d7 parent 54495 237d5be57277 child 54499 319f8659267d
merged
 src/HOL/BNF/Examples/Stream.thy file | annotate | diff | revisions src/HOL/Cardinals/Cardinal_Order_Relation_Base.thy file | annotate | diff | revisions src/HOL/Cardinals/Constructions_on_Wellorders_Base.thy file | annotate | diff | revisions src/HOL/Cardinals/Fun_More_Base.thy file | annotate | diff | revisions src/HOL/Cardinals/Order_Relation_More_Base.thy file | annotate | diff | revisions src/HOL/Cardinals/Wellfounded_More_Base.thy file | annotate | diff | revisions src/HOL/Cardinals/Wellorder_Embedding_Base.thy file | annotate | diff | revisions src/HOL/Cardinals/Wellorder_Relation_Base.thy file | annotate | diff | revisions src/HOL/List.thy file | annotate | diff | revisions
     1.1 --- a/NEWS	Mon Nov 18 17:15:01 2013 +0100
1.2 +++ b/NEWS	Tue Nov 19 17:07:52 2013 +0100
1.3 @@ -18,6 +18,14 @@
1.4      even_zero_(nat|int) ~> even_zero
1.5  INCOMPATIBILITY.
1.6
1.7 +* Abolished neg_numeral.
1.8 +  * Canonical representation for minus one is "- 1".
1.9 +  * Canonical representation for other negative numbers is "- (numeral _)".
1.10 +  * When devising rules set for number calculation, consider the
1.11 +    following cases: 0, 1, numeral _, - 1, - numeral _.
1.12 +  * Syntax for negative numerals is mere input syntax.
1.13 +INCOMPATBILITY.
1.14 +
1.15  * Elimination of fact duplicates:
1.16      equals_zero_I ~> minus_unique
1.17      diff_eq_0_iff_eq ~> right_minus_eq

     2.1 --- a/src/Doc/Datatypes/Datatypes.thy	Mon Nov 18 17:15:01 2013 +0100
2.2 +++ b/src/Doc/Datatypes/Datatypes.thy	Tue Nov 19 17:07:52 2013 +0100
2.3 @@ -350,7 +350,7 @@
2.4  custom names. In the example below, the familiar names @{text null}, @{text hd},
2.5  @{text tl}, @{text set}, @{text map}, and @{text list_all2}, override the
2.6  default names @{text is_Nil}, @{text un_Cons1}, @{text un_Cons2},
2.7 -@{text list_set}, @{text list_map}, and @{text list_rel}:
2.8 +@{text set_list}, @{text map_list}, and @{text rel_list}:
2.9  *}
2.10
2.11  (*<*)
2.12 @@ -363,7 +363,7 @@
2.13        Cons (infixr "#" 65)
2.14
2.15      hide_type list
2.16 -    hide_const Nil Cons hd tl set map list_all2 list_case list_rec
2.17 +    hide_const Nil Cons hd tl set map list_all2
2.18
2.19      context early begin
2.20  (*>*)
2.21 @@ -501,7 +501,7 @@
2.22  reference manual \cite{isabelle-isar-ref}.
2.23
2.24  The optional names preceding the type variables allow to override the default
2.25 -names of the set functions (@{text t_set1}, \ldots, @{text t_setM}).
2.26 +names of the set functions (@{text set1_t}, \ldots, @{text setM_t}).
2.27  Inside a mutually recursive specification, all defined datatypes must
2.28  mention exactly the same type variables in the same order.
2.29
2.30 @@ -626,7 +626,7 @@
2.31  \begin{itemize}
2.32  \setlength{\itemsep}{0pt}
2.33
2.34 -\item \relax{Case combinator}: @{text t_case} (rendered using the familiar
2.35 +\item \relax{Case combinator}: @{text t.case_t} (rendered using the familiar
2.36  @{text case}--@{text of} syntax)
2.37
2.38  \item \relax{Discriminators}: @{text "t.is_C\<^sub>1"}, \ldots,
2.39 @@ -638,22 +638,22 @@
2.40  \phantom{\relax{Selectors:}} @{text t.un_C\<^sub>n1}$, \ldots, @{text t.un_C\<^sub>nk\<^sub>n}. 2.41 2.42 \item \relax{Set functions} (or \relax{natural transformations}): 2.43 -@{text t_set1}, \ldots, @{text t_setm} 2.44 - 2.45 -\item \relax{Map function} (or \relax{functorial action}): @{text t_map} 2.46 - 2.47 -\item \relax{Relator}: @{text t_rel} 2.48 - 2.49 -\item \relax{Iterator}: @{text t_fold} 2.50 - 2.51 -\item \relax{Recursor}: @{text t_rec} 2.52 +@{text set1_t}, \ldots, @{text t.setm_t} 2.53 + 2.54 +\item \relax{Map function} (or \relax{functorial action}): @{text t.map_t} 2.55 + 2.56 +\item \relax{Relator}: @{text t.rel_t} 2.57 + 2.58 +\item \relax{Iterator}: @{text t.fold_t} 2.59 + 2.60 +\item \relax{Recursor}: @{text t.rec_t} 2.61 2.62 \end{itemize} 2.63 2.64 \noindent 2.65 The case combinator, discriminators, and selectors are collectively called 2.66 \emph{destructors}. The prefix @{text "t."}'' is an optional component of the 2.67 -name and is normally hidden. 2.68 +names and is normally hidden. 2.69 *} 2.70 2.71 2.72 @@ -810,8 +810,8 @@ 2.73 \item[@{text "t."}\hthm{sel\_split\_asm}\rm:] ~ \\ 2.74 @{thm list.sel_split_asm[no_vars]} 2.75 2.76 -\item[@{text "t."}\hthm{case\_if}\rm:] ~ \\ 2.77 -@{thm list.case_if[no_vars]} 2.78 +\item[@{text "t."}\hthm{case\_eq\_if}\rm:] ~ \\ 2.79 +@{thm list.case_eq_if[no_vars]} 2.80 2.81 \end{description} 2.82 \end{indentblock} 2.83 @@ -914,7 +914,10 @@ 2.84 is recommended to use @{command datatype_new_compat} or \keyw{rep\_datatype} 2.85 to register new-style datatypes as old-style datatypes. 2.86 2.87 -\item \emph{The recursor @{text "t_rec"} has a different signature for nested 2.88 +\item \emph{The constants @{text "t_case"} and @{text "t_rec"} are now called 2.89 +@{text "case_t"} and @{text "rec_t"}. 2.90 + 2.91 +\item \emph{The recursor @{text "rec_t"} has a different signature for nested 2.92 recursive datatypes.} In the old package, nested recursion through non-functions 2.93 was internally reduced to mutual recursion. This reduction was visible in the 2.94 type of the recursor, used by \keyw{primrec}. Recursion through functions was 2.95 @@ -1150,13 +1153,13 @@ 2.96 \noindent 2.97 The next example features recursion through the @{text option} type. Although 2.98 @{text option} is not a new-style datatype, it is registered as a BNF with the 2.99 -map function @{const option_map}: 2.100 +map function @{const map_option}: 2.101 *} 2.102 2.103 primrec_new (*<*)(in early) (*>*)sum_btree :: "('a\<Colon>{zero,plus}) btree \<Rightarrow> 'a" where 2.104 "sum_btree (BNode a lt rt) = 2.105 - a + the_default 0 (option_map sum_btree lt) + 2.106 - the_default 0 (option_map sum_btree rt)" 2.107 + a + the_default 0 (map_option sum_btree lt) + 2.108 + the_default 0 (map_option sum_btree rt)" 2.109 2.110 text {* 2.111 \noindent 2.112 @@ -1552,9 +1555,9 @@ 2.113 \begin{itemize} 2.114 \setlength{\itemsep}{0pt} 2.115 2.116 -\item \relax{Coiterator}: @{text t_unfold} 2.117 - 2.118 -\item \relax{Corecursor}: @{text t_corec} 2.119 +\item \relax{Coiterator}: @{text unfold_t} 2.120 + 2.121 +\item \relax{Corecursor}: @{text corec_t} 2.122 2.123 \end{itemize} 2.124 *}   3.1 --- a/src/HOL/Archimedean_Field.thy Mon Nov 18 17:15:01 2013 +0100 3.2 +++ b/src/HOL/Archimedean_Field.thy Tue Nov 19 17:07:52 2013 +0100 3.3 @@ -204,8 +204,8 @@ 3.4 lemma floor_numeral [simp]: "floor (numeral v) = numeral v" 3.5 using floor_of_int [of "numeral v"] by simp 3.6 3.7 -lemma floor_neg_numeral [simp]: "floor (neg_numeral v) = neg_numeral v" 3.8 - using floor_of_int [of "neg_numeral v"] by simp 3.9 +lemma floor_neg_numeral [simp]: "floor (- numeral v) = - numeral v" 3.10 + using floor_of_int [of "- numeral v"] by simp 3.11 3.12 lemma zero_le_floor [simp]: "0 \<le> floor x \<longleftrightarrow> 0 \<le> x" 3.13 by (simp add: le_floor_iff) 3.14 @@ -218,7 +218,7 @@ 3.15 by (simp add: le_floor_iff) 3.16 3.17 lemma neg_numeral_le_floor [simp]: 3.18 - "neg_numeral v \<le> floor x \<longleftrightarrow> neg_numeral v \<le> x" 3.19 + "- numeral v \<le> floor x \<longleftrightarrow> - numeral v \<le> x" 3.20 by (simp add: le_floor_iff) 3.21 3.22 lemma zero_less_floor [simp]: "0 < floor x \<longleftrightarrow> 1 \<le> x" 3.23 @@ -232,7 +232,7 @@ 3.24 by (simp add: less_floor_iff) 3.25 3.26 lemma neg_numeral_less_floor [simp]: 3.27 - "neg_numeral v < floor x \<longleftrightarrow> neg_numeral v + 1 \<le> x" 3.28 + "- numeral v < floor x \<longleftrightarrow> - numeral v + 1 \<le> x" 3.29 by (simp add: less_floor_iff) 3.30 3.31 lemma floor_le_zero [simp]: "floor x \<le> 0 \<longleftrightarrow> x < 1" 3.32 @@ -246,7 +246,7 @@ 3.33 by (simp add: floor_le_iff) 3.34 3.35 lemma floor_le_neg_numeral [simp]: 3.36 - "floor x \<le> neg_numeral v \<longleftrightarrow> x < neg_numeral v + 1" 3.37 + "floor x \<le> - numeral v \<longleftrightarrow> x < - numeral v + 1" 3.38 by (simp add: floor_le_iff) 3.39 3.40 lemma floor_less_zero [simp]: "floor x < 0 \<longleftrightarrow> x < 0" 3.41 @@ -260,7 +260,7 @@ 3.42 by (simp add: floor_less_iff) 3.43 3.44 lemma floor_less_neg_numeral [simp]: 3.45 - "floor x < neg_numeral v \<longleftrightarrow> x < neg_numeral v" 3.46 + "floor x < - numeral v \<longleftrightarrow> x < - numeral v" 3.47 by (simp add: floor_less_iff) 3.48 3.49 text {* Addition and subtraction of integers *} 3.50 @@ -272,10 +272,6 @@ 3.51 "floor (x + numeral v) = floor x + numeral v" 3.52 using floor_add_of_int [of x "numeral v"] by simp 3.53 3.54 -lemma floor_add_neg_numeral [simp]: 3.55 - "floor (x + neg_numeral v) = floor x + neg_numeral v" 3.56 - using floor_add_of_int [of x "neg_numeral v"] by simp 3.57 - 3.58 lemma floor_add_one [simp]: "floor (x + 1) = floor x + 1" 3.59 using floor_add_of_int [of x 1] by simp 3.60 3.61 @@ -286,10 +282,6 @@ 3.62 "floor (x - numeral v) = floor x - numeral v" 3.63 using floor_diff_of_int [of x "numeral v"] by simp 3.64 3.65 -lemma floor_diff_neg_numeral [simp]: 3.66 - "floor (x - neg_numeral v) = floor x - neg_numeral v" 3.67 - using floor_diff_of_int [of x "neg_numeral v"] by simp 3.68 - 3.69 lemma floor_diff_one [simp]: "floor (x - 1) = floor x - 1" 3.70 using floor_diff_of_int [of x 1] by simp 3.71 3.72 @@ -353,8 +345,8 @@ 3.73 lemma ceiling_numeral [simp]: "ceiling (numeral v) = numeral v" 3.74 using ceiling_of_int [of "numeral v"] by simp 3.75 3.76 -lemma ceiling_neg_numeral [simp]: "ceiling (neg_numeral v) = neg_numeral v" 3.77 - using ceiling_of_int [of "neg_numeral v"] by simp 3.78 +lemma ceiling_neg_numeral [simp]: "ceiling (- numeral v) = - numeral v" 3.79 + using ceiling_of_int [of "- numeral v"] by simp 3.80 3.81 lemma ceiling_le_zero [simp]: "ceiling x \<le> 0 \<longleftrightarrow> x \<le> 0" 3.82 by (simp add: ceiling_le_iff) 3.83 @@ -367,7 +359,7 @@ 3.84 by (simp add: ceiling_le_iff) 3.85 3.86 lemma ceiling_le_neg_numeral [simp]: 3.87 - "ceiling x \<le> neg_numeral v \<longleftrightarrow> x \<le> neg_numeral v" 3.88 + "ceiling x \<le> - numeral v \<longleftrightarrow> x \<le> - numeral v" 3.89 by (simp add: ceiling_le_iff) 3.90 3.91 lemma ceiling_less_zero [simp]: "ceiling x < 0 \<longleftrightarrow> x \<le> -1" 3.92 @@ -381,7 +373,7 @@ 3.93 by (simp add: ceiling_less_iff) 3.94 3.95 lemma ceiling_less_neg_numeral [simp]: 3.96 - "ceiling x < neg_numeral v \<longleftrightarrow> x \<le> neg_numeral v - 1" 3.97 + "ceiling x < - numeral v \<longleftrightarrow> x \<le> - numeral v - 1" 3.98 by (simp add: ceiling_less_iff) 3.99 3.100 lemma zero_le_ceiling [simp]: "0 \<le> ceiling x \<longleftrightarrow> -1 < x" 3.101 @@ -395,7 +387,7 @@ 3.102 by (simp add: le_ceiling_iff) 3.103 3.104 lemma neg_numeral_le_ceiling [simp]: 3.105 - "neg_numeral v \<le> ceiling x \<longleftrightarrow> neg_numeral v - 1 < x" 3.106 + "- numeral v \<le> ceiling x \<longleftrightarrow> - numeral v - 1 < x" 3.107 by (simp add: le_ceiling_iff) 3.108 3.109 lemma zero_less_ceiling [simp]: "0 < ceiling x \<longleftrightarrow> 0 < x" 3.110 @@ -409,7 +401,7 @@ 3.111 by (simp add: less_ceiling_iff) 3.112 3.113 lemma neg_numeral_less_ceiling [simp]: 3.114 - "neg_numeral v < ceiling x \<longleftrightarrow> neg_numeral v < x" 3.115 + "- numeral v < ceiling x \<longleftrightarrow> - numeral v < x" 3.116 by (simp add: less_ceiling_iff) 3.117 3.118 text {* Addition and subtraction of integers *} 3.119 @@ -421,10 +413,6 @@ 3.120 "ceiling (x + numeral v) = ceiling x + numeral v" 3.121 using ceiling_add_of_int [of x "numeral v"] by simp 3.122 3.123 -lemma ceiling_add_neg_numeral [simp]: 3.124 - "ceiling (x + neg_numeral v) = ceiling x + neg_numeral v" 3.125 - using ceiling_add_of_int [of x "neg_numeral v"] by simp 3.126 - 3.127 lemma ceiling_add_one [simp]: "ceiling (x + 1) = ceiling x + 1" 3.128 using ceiling_add_of_int [of x 1] by simp 3.129 3.130 @@ -435,10 +423,6 @@ 3.131 "ceiling (x - numeral v) = ceiling x - numeral v" 3.132 using ceiling_diff_of_int [of x "numeral v"] by simp 3.133 3.134 -lemma ceiling_diff_neg_numeral [simp]: 3.135 - "ceiling (x - neg_numeral v) = ceiling x - neg_numeral v" 3.136 - using ceiling_diff_of_int [of x "neg_numeral v"] by simp 3.137 - 3.138 lemma ceiling_diff_one [simp]: "ceiling (x - 1) = ceiling x - 1" 3.139 using ceiling_diff_of_int [of x 1] by simp 3.140   4.1 --- a/src/HOL/BNF/BNF_Comp.thy Mon Nov 18 17:15:01 2013 +0100 4.2 +++ b/src/HOL/BNF/BNF_Comp.thy Tue Nov 19 17:07:52 2013 +0100 4.3 @@ -11,6 +11,9 @@ 4.4 imports Basic_BNFs 4.5 begin 4.6 4.7 +lemma wpull_id: "wpull UNIV B1 B2 id id id id" 4.8 +unfolding wpull_def by simp 4.9 + 4.10 lemma empty_natural: "(\<lambda>_. {}) o f = image g o (\<lambda>_. {})" 4.11 by (rule ext) simp 4.12   5.1 --- a/src/HOL/BNF/BNF_Def.thy Mon Nov 18 17:15:01 2013 +0100 5.2 +++ b/src/HOL/BNF/BNF_Def.thy Tue Nov 19 17:07:52 2013 +0100 5.3 @@ -190,9 +190,6 @@ 5.4 lemma vimage2pI: "R (f x) (g y) \<Longrightarrow> vimage2p f g R x y" 5.5 unfolding vimage2p_def by - 5.6 5.7 -lemma vimage2pD: "vimage2p f g R x y \<Longrightarrow> R (f x) (g y)" 5.8 - unfolding vimage2p_def by - 5.9 - 5.10 lemma fun_rel_iff_leq_vimage2p: "(fun_rel R S) f g = (R \<le> vimage2p f g S)" 5.11 unfolding fun_rel_def vimage2p_def by auto 5.12   6.1 --- a/src/HOL/BNF/BNF_FP_Base.thy Mon Nov 18 17:15:01 2013 +0100 6.2 +++ b/src/HOL/BNF/BNF_FP_Base.thy Tue Nov 19 17:07:52 2013 +0100 6.3 @@ -13,12 +13,6 @@ 6.4 imports BNF_Comp Ctr_Sugar 6.5 begin 6.6 6.7 -lemma not_TrueE: "\<not> True \<Longrightarrow> P" 6.8 -by (erule notE, rule TrueI) 6.9 - 6.10 -lemma neq_eq_eq_contradict: "\<lbrakk>t \<noteq> u; s = t; s = u\<rbrakk> \<Longrightarrow> P" 6.11 -by fast 6.12 - 6.13 lemma mp_conj: "(P \<longrightarrow> Q) \<and> R \<Longrightarrow> P \<Longrightarrow> R \<and> Q" 6.14 by auto 6.15   7.1 --- a/src/HOL/BNF/BNF_GFP.thy Mon Nov 18 17:15:01 2013 +0100 7.2 +++ b/src/HOL/BNF/BNF_GFP.thy Tue Nov 19 17:07:52 2013 +0100 7.3 @@ -15,14 +15,22 @@ 7.4 "primcorec" :: thy_decl 7.5 begin 7.6 7.7 +lemma not_TrueE: "\<not> True \<Longrightarrow> P" 7.8 +by (erule notE, rule TrueI) 7.9 + 7.10 +lemma neq_eq_eq_contradict: "\<lbrakk>t \<noteq> u; s = t; s = u\<rbrakk> \<Longrightarrow> P" 7.11 +by fast 7.12 + 7.13 lemma sum_case_expand_Inr: "f o Inl = g \<Longrightarrow> f x = sum_case g (f o Inr) x" 7.14 by (auto split: sum.splits) 7.15 7.16 lemma sum_case_expand_Inr': "f o Inl = g \<Longrightarrow> h = f o Inr \<longleftrightarrow> sum_case g h = f" 7.17 -by (metis sum_case_o_inj(1,2) surjective_sum) 7.18 +apply rule 7.19 + apply (rule ext, force split: sum.split) 7.20 +by (rule ext, metis sum_case_o_inj(2)) 7.21 7.22 lemma converse_Times: "(A \<times> B) ^-1 = B \<times> A" 7.23 -by auto 7.24 +by fast 7.25 7.26 lemma equiv_proj: 7.27 assumes e: "equiv A R" and "z \<in> R" 7.28 @@ -37,7 +45,6 @@ 7.29 (* Operators: *) 7.30 definition image2 where "image2 A f g = {(f a, g a) | a. a \<in> A}" 7.31 7.32 - 7.33 lemma Id_onD: "(a, b) \<in> Id_on A \<Longrightarrow> a = b" 7.34 unfolding Id_on_def by simp 7.35 7.36 @@ -56,9 +63,6 @@ 7.37 lemma Id_on_Gr: "Id_on A = Gr A id" 7.38 unfolding Id_on_def Gr_def by auto 7.39 7.40 -lemma Id_on_UNIV_I: "x = y \<Longrightarrow> (x, y) \<in> Id_on UNIV" 7.41 -unfolding Id_on_def by auto 7.42 - 7.43 lemma image2_eqI: "\<lbrakk>b = f x; c = g x; x \<in> A\<rbrakk> \<Longrightarrow> (b, c) \<in> image2 A f g" 7.44 unfolding image2_def by auto 7.45 7.46 @@ -77,6 +81,12 @@ 7.47 lemma Gr_incl: "Gr A f \<subseteq> A <*> B \<longleftrightarrow> f  A \<subseteq> B" 7.48 unfolding Gr_def by auto 7.49 7.50 +lemma subset_Collect_iff: "B \<subseteq> A \<Longrightarrow> (B \<subseteq> {x \<in> A. P x}) = (\<forall>x \<in> B. P x)" 7.51 +by blast 7.52 + 7.53 +lemma subset_CollectI: "B \<subseteq> A \<Longrightarrow> (\<And>x. x \<in> B \<Longrightarrow> Q x \<Longrightarrow> P x) \<Longrightarrow> ({x \<in> B. Q x} \<subseteq> {x \<in> A. P x})" 7.54 +by blast 7.55 + 7.56 lemma in_rel_Collect_split_eq: "in_rel (Collect (split X)) = X" 7.57 unfolding fun_eq_iff by auto 7.58 7.59 @@ -130,9 +140,6 @@ 7.60 "R \<subseteq> relInvImage UNIV (relImage R f) f" 7.61 unfolding relInvImage_def relImage_def by auto 7.62 7.63 -lemma equiv_Image: "equiv A R \<Longrightarrow> (\<And>a b. (a, b) \<in> R \<Longrightarrow> a \<in> A \<and> b \<in> A \<and> R  {a} = R  {b})" 7.64 -unfolding equiv_def refl_on_def Image_def by (auto intro: transD symD) 7.65 - 7.66 lemma relImage_proj: 7.67 assumes "equiv A R" 7.68 shows "relImage R (proj R) \<subseteq> Id_on (A//R)" 7.69 @@ -143,7 +150,7 @@ 7.70 lemma relImage_relInvImage: 7.71 assumes "R \<subseteq> f  A <*> f  A" 7.72 shows "relImage (relInvImage A R f) f = R" 7.73 -using assms unfolding relImage_def relInvImage_def by fastforce 7.74 +using assms unfolding relImage_def relInvImage_def by fast 7.75 7.76 lemma subst_Pair: "P x y \<Longrightarrow> a = (x, y) \<Longrightarrow> P (fst a) (snd a)" 7.77 by simp 7.78 @@ -255,13 +262,18 @@ 7.79 shows "\<exists> a. a \<in> A \<and> p1 a = b1 \<and> p2 a = b2" 7.80 using assms unfolding wpull_def by blast 7.81 7.82 -lemma pickWP: 7.83 +lemma pickWP_raw: 7.84 assumes "wpull A B1 B2 f1 f2 p1 p2" and 7.85 "b1 \<in> B1" and "b2 \<in> B2" and "f1 b1 = f2 b2" 7.86 -shows "pickWP A p1 p2 b1 b2 \<in> A" 7.87 - "p1 (pickWP A p1 p2 b1 b2) = b1" 7.88 - "p2 (pickWP A p1 p2 b1 b2) = b2" 7.89 -unfolding pickWP_def using assms someI_ex[OF pickWP_pred] by fastforce+ 7.90 +shows "pickWP A p1 p2 b1 b2 \<in> A 7.91 + \<and> p1 (pickWP A p1 p2 b1 b2) = b1 7.92 + \<and> p2 (pickWP A p1 p2 b1 b2) = b2" 7.93 +unfolding pickWP_def using assms someI_ex[OF pickWP_pred] by fastforce 7.94 + 7.95 +lemmas pickWP = 7.96 + pickWP_raw[THEN conjunct1] 7.97 + pickWP_raw[THEN conjunct2, THEN conjunct1] 7.98 + pickWP_raw[THEN conjunct2, THEN conjunct2] 7.99 7.100 lemma Inl_Field_csum: "a \<in> Field r \<Longrightarrow> Inl a \<in> Field (r +c s)" 7.101 unfolding Field_card_of csum_def by auto 7.102 @@ -293,18 +305,12 @@ 7.103 lemma image2pI: "R x y \<Longrightarrow> (image2p f g R) (f x) (g y)" 7.104 unfolding image2p_def by blast 7.105 7.106 -lemma image2p_eqI: "\<lbrakk>fx = f x; gy = g y; R x y\<rbrakk> \<Longrightarrow> (image2p f g R) fx gy" 7.107 - unfolding image2p_def by blast 7.108 - 7.109 lemma image2pE: "\<lbrakk>(image2p f g R) fx gy; (\<And>x y. fx = f x \<Longrightarrow> gy = g y \<Longrightarrow> R x y \<Longrightarrow> P)\<rbrakk> \<Longrightarrow> P" 7.110 unfolding image2p_def by blast 7.111 7.112 lemma fun_rel_iff_geq_image2p: "(fun_rel R S) f g = (image2p f g R \<le> S)" 7.113 unfolding fun_rel_def image2p_def by auto 7.114 7.115 -lemma convol_image_image2p: "<f o fst, g o snd>  Collect (split R) \<subseteq> Collect (split (image2p f g R))" 7.116 - unfolding convol_def image2p_def by fastforce 7.117 - 7.118 lemma fun_rel_image2p: "(fun_rel R (image2p f g R)) f g" 7.119 unfolding fun_rel_def image2p_def by auto 7.120   8.1 --- a/src/HOL/BNF/BNF_Util.thy Mon Nov 18 17:15:01 2013 +0100 8.2 +++ b/src/HOL/BNF/BNF_Util.thy Tue Nov 19 17:07:52 2013 +0100 8.3 @@ -9,15 +9,9 @@ 8.4 header {* Library for Bounded Natural Functors *} 8.5 8.6 theory BNF_Util 8.7 -imports "../Cardinals/Cardinal_Arithmetic" 8.8 +imports "../Cardinals/Cardinal_Arithmetic_FP" 8.9 begin 8.10 8.11 -lemma subset_Collect_iff: "B \<subseteq> A \<Longrightarrow> (B \<subseteq> {x \<in> A. P x}) = (\<forall>x \<in> B. P x)" 8.12 -by blast 8.13 - 8.14 -lemma subset_CollectI: "B \<subseteq> A \<Longrightarrow> (\<And>x. x \<in> B \<Longrightarrow> Q x \<Longrightarrow> P x) \<Longrightarrow> ({x \<in> B. Q x} \<subseteq> {x \<in> A. P x})" 8.15 -by blast 8.16 - 8.17 definition collect where 8.18 "collect F x = (\<Union>f \<in> F. f x)" 8.19   9.1 --- a/src/HOL/BNF/Basic_BNFs.thy Mon Nov 18 17:15:01 2013 +0100 9.2 +++ b/src/HOL/BNF/Basic_BNFs.thy Tue Nov 19 17:07:52 2013 +0100 9.3 @@ -13,14 +13,8 @@ 9.4 imports BNF_Def 9.5 begin 9.6 9.7 -lemma wpull_id: "wpull UNIV B1 B2 id id id id" 9.8 -unfolding wpull_def by simp 9.9 - 9.10 lemmas natLeq_card_order = natLeq_Card_order[unfolded Field_natLeq] 9.11 9.12 -lemma ctwo_card_order: "card_order ctwo" 9.13 -using Card_order_ctwo by (unfold ctwo_def Field_card_of) 9.14 - 9.15 lemma natLeq_cinfinite: "cinfinite natLeq" 9.16 unfolding cinfinite_def Field_natLeq by (rule nat_infinite) 9.17 9.18 @@ -62,11 +56,11 @@ 9.19 proof - 9.20 show "sum_map id id = id" by (rule sum_map.id) 9.21 next 9.22 - fix f1 f2 g1 g2 9.23 + fix f1 :: "'o \<Rightarrow> 's" and f2 :: "'p \<Rightarrow> 't" and g1 :: "'s \<Rightarrow> 'q" and g2 :: "'t \<Rightarrow> 'r" 9.24 show "sum_map (g1 o f1) (g2 o f2) = sum_map g1 g2 o sum_map f1 f2" 9.25 by (rule sum_map.comp[symmetric]) 9.26 next 9.27 - fix x f1 f2 g1 g2 9.28 + fix x and f1 :: "'o \<Rightarrow> 'q" and f2 :: "'p \<Rightarrow> 'r" and g1 g2 9.29 assume a1: "\<And>z. z \<in> setl x \<Longrightarrow> f1 z = g1 z" and 9.30 a2: "\<And>z. z \<in> setr x \<Longrightarrow> f2 z = g2 z" 9.31 thus "sum_map f1 f2 x = sum_map g1 g2 x" 9.32 @@ -76,11 +70,11 @@ 9.33 case Inr thus ?thesis using a2 by (clarsimp simp: setr_def) 9.34 qed 9.35 next 9.36 - fix f1 f2 9.37 + fix f1 :: "'o \<Rightarrow> 'q" and f2 :: "'p \<Rightarrow> 'r" 9.38 show "setl o sum_map f1 f2 = image f1 o setl" 9.39 by (rule ext, unfold o_apply) (simp add: setl_def split: sum.split) 9.40 next 9.41 - fix f1 f2 9.42 + fix f1 :: "'o \<Rightarrow> 'q" and f2 :: "'p \<Rightarrow> 'r" 9.43 show "setr o sum_map f1 f2 = image f2 o setr" 9.44 by (rule ext, unfold o_apply) (simp add: setr_def split: sum.split) 9.45 next 9.46 @@ -88,13 +82,13 @@ 9.47 next 9.48 show "cinfinite natLeq" by (rule natLeq_cinfinite) 9.49 next 9.50 - fix x 9.51 + fix x :: "'o + 'p" 9.52 show "|setl x| \<le>o natLeq" 9.53 apply (rule ordLess_imp_ordLeq) 9.54 apply (rule finite_iff_ordLess_natLeq[THEN iffD1]) 9.55 by (simp add: setl_def split: sum.split) 9.56 next 9.57 - fix x 9.58 + fix x :: "'o + 'p" 9.59 show "|setr x| \<le>o natLeq" 9.60 apply (rule ordLess_imp_ordLeq) 9.61 apply (rule finite_iff_ordLess_natLeq[THEN iffD1]) 9.62 @@ -229,22 +223,6 @@ 9.63 thus ?thesis using that by fastforce 9.64 qed 9.65 9.66 -lemma card_of_bounded_range: 9.67 - "|{f :: 'd \<Rightarrow> 'a. range f \<subseteq> B}| \<le>o |Func (UNIV :: 'd set) B|" (is "|?LHS| \<le>o |?RHS|") 9.68 -proof - 9.69 - let ?f = "\<lambda>f. %x. if f x \<in> B then f x else undefined" 9.70 - have "inj_on ?f ?LHS" unfolding inj_on_def 9.71 - proof (unfold fun_eq_iff, safe) 9.72 - fix g :: "'d \<Rightarrow> 'a" and f :: "'d \<Rightarrow> 'a" and x 9.73 - assume "range f \<subseteq> B" "range g \<subseteq> B" and eq: "\<forall>x. ?f f x = ?f g x" 9.74 - hence "f x \<in> B" "g x \<in> B" by auto 9.75 - with eq have "Some (f x) = Some (g x)" by metis 9.76 - thus "f x = g x" by simp 9.77 - qed 9.78 - moreover have "?f  ?LHS \<subseteq> ?RHS" unfolding Func_def by fastforce 9.79 - ultimately show ?thesis using card_of_ordLeq by fast 9.80 -qed 9.81 - 9.82 bnf "'a \<Rightarrow> 'b" 9.83 map: "op \<circ>" 9.84 sets: range 9.85 @@ -275,7 +253,7 @@ 9.86 next 9.87 fix f :: "'d => 'a" 9.88 have "|range f| \<le>o | (UNIV::'d set) |" (is "_ \<le>o ?U") by (rule card_of_image) 9.89 - also have "?U \<le>o natLeq +c ?U" by (rule ordLeq_csum2) (rule card_of_Card_order) 9.90 + also have "?U \<le>o natLeq +c ?U" by (rule ordLeq_csum2) (rule card_of_Card_order) 9.91 finally show "|range f| \<le>o natLeq +c ?U" . 9.92 next 9.93 fix A B1 B2 f1 f2 p1 p2 assume p: "wpull A B1 B2 f1 f2 p1 p2" 9.94 @@ -294,7 +272,7 @@ 9.95 (Grp {x. range x \<subseteq> Collect (split R)} (op \<circ> fst))\<inverse>\<inverse> OO 9.96 Grp {x. range x \<subseteq> Collect (split R)} (op \<circ> snd)" 9.97 unfolding fun_rel_def Grp_def fun_eq_iff relcompp.simps conversep.simps subset_iff image_iff 9.98 - by auto (force, metis pair_collapse) 9.99 + by auto (force, metis (no_types) pair_collapse) 9.100 qed 9.101 9.102 end   10.1 --- a/src/HOL/BNF/Equiv_Relations_More.thy Mon Nov 18 17:15:01 2013 +0100 10.2 +++ b/src/HOL/BNF/Equiv_Relations_More.thy Tue Nov 19 17:07:52 2013 +0100 10.3 @@ -59,7 +59,7 @@ 10.4 10.5 lemma in_quotient_imp_in_rel: 10.6 "\<lbrakk>equiv A r; X \<in> A//r; {x,y} \<subseteq> X\<rbrakk> \<Longrightarrow> (x,y) \<in> r" 10.7 -using quotient_eq_iff by fastforce 10.8 +using quotient_eq_iff[THEN iffD1] by fastforce 10.9 10.10 lemma in_quotient_imp_closed: 10.11 "\<lbrakk>equiv A r; X \<in> A//r; x \<in> X; (x,y) \<in> r\<rbrakk> \<Longrightarrow> y \<in> X"   11.1 --- a/src/HOL/BNF/Examples/Koenig.thy Mon Nov 18 17:15:01 2013 +0100 11.2 +++ b/src/HOL/BNF/Examples/Koenig.thy Tue Nov 19 17:07:52 2013 +0100 11.3 @@ -12,44 +12,33 @@ 11.4 imports TreeFI Stream 11.5 begin 11.6 11.7 -(* selectors for streams *) 11.8 -lemma shd_def': "shd as = fst (stream_dtor as)" 11.9 -apply (case_tac as) 11.10 -apply (auto simp add: shd_def) 11.11 -by (simp add: Stream_def stream.dtor_ctor) 11.12 - 11.13 -lemma stl_def': "stl as = snd (stream_dtor as)" 11.14 -apply (case_tac as) 11.15 -apply (auto simp add: stl_def) 11.16 -by (simp add: Stream_def stream.dtor_ctor) 11.17 - 11.18 (* infinite trees: *) 11.19 coinductive infiniteTr where 11.20 -"\<lbrakk>tr' \<in> listF_set (sub tr); infiniteTr tr'\<rbrakk> \<Longrightarrow> infiniteTr tr" 11.21 +"\<lbrakk>tr' \<in> set_listF (sub tr); infiniteTr tr'\<rbrakk> \<Longrightarrow> infiniteTr tr" 11.22 11.23 lemma infiniteTr_strong_coind[consumes 1, case_names sub]: 11.24 assumes *: "phi tr" and 11.25 -**: "\<And> tr. phi tr \<Longrightarrow> \<exists> tr' \<in> listF_set (sub tr). phi tr' \<or> infiniteTr tr'" 11.26 +**: "\<And> tr. phi tr \<Longrightarrow> \<exists> tr' \<in> set_listF (sub tr). phi tr' \<or> infiniteTr tr'" 11.27 shows "infiniteTr tr" 11.28 using assms by (elim infiniteTr.coinduct) blast 11.29 11.30 lemma infiniteTr_coind[consumes 1, case_names sub, induct pred: infiniteTr]: 11.31 assumes *: "phi tr" and 11.32 -**: "\<And> tr. phi tr \<Longrightarrow> \<exists> tr' \<in> listF_set (sub tr). phi tr'" 11.33 +**: "\<And> tr. phi tr \<Longrightarrow> \<exists> tr' \<in> set_listF (sub tr). phi tr'" 11.34 shows "infiniteTr tr" 11.35 using assms by (elim infiniteTr.coinduct) blast 11.36 11.37 lemma infiniteTr_sub[simp]: 11.38 -"infiniteTr tr \<Longrightarrow> (\<exists> tr' \<in> listF_set (sub tr). infiniteTr tr')" 11.39 +"infiniteTr tr \<Longrightarrow> (\<exists> tr' \<in> set_listF (sub tr). infiniteTr tr')" 11.40 by (erule infiniteTr.cases) blast 11.41 11.42 primcorec konigPath where 11.43 "shd (konigPath t) = lab t" 11.44 -| "stl (konigPath t) = konigPath (SOME tr. tr \<in> listF_set (sub t) \<and> infiniteTr tr)" 11.45 +| "stl (konigPath t) = konigPath (SOME tr. tr \<in> set_listF (sub t) \<and> infiniteTr tr)" 11.46 11.47 (* proper paths in trees: *) 11.48 coinductive properPath where 11.49 -"\<lbrakk>shd as = lab tr; tr' \<in> listF_set (sub tr); properPath (stl as) tr'\<rbrakk> \<Longrightarrow> 11.50 +"\<lbrakk>shd as = lab tr; tr' \<in> set_listF (sub tr); properPath (stl as) tr'\<rbrakk> \<Longrightarrow> 11.51 properPath as tr" 11.52 11.53 lemma properPath_strong_coind[consumes 1, case_names shd_lab sub]: 11.54 @@ -57,7 +46,7 @@ 11.55 **: "\<And> as tr. phi as tr \<Longrightarrow> shd as = lab tr" and 11.56 ***: "\<And> as tr. 11.57 phi as tr \<Longrightarrow> 11.58 - \<exists> tr' \<in> listF_set (sub tr). phi (stl as) tr' \<or> properPath (stl as) tr'" 11.59 + \<exists> tr' \<in> set_listF (sub tr). phi (stl as) tr' \<or> properPath (stl as) tr'" 11.60 shows "properPath as tr" 11.61 using assms by (elim properPath.coinduct) blast 11.62 11.63 @@ -66,7 +55,7 @@ 11.64 **: "\<And> as tr. phi as tr \<Longrightarrow> shd as = lab tr" and 11.65 ***: "\<And> as tr. 11.66 phi as tr \<Longrightarrow> 11.67 - \<exists> tr' \<in> listF_set (sub tr). phi (stl as) tr'" 11.68 + \<exists> tr' \<in> set_listF (sub tr). phi (stl as) tr'" 11.69 shows "properPath as tr" 11.70 using properPath_strong_coind[of phi, OF * **] *** by blast 11.71 11.72 @@ -76,7 +65,7 @@ 11.73 11.74 lemma properPath_sub: 11.75 "properPath as tr \<Longrightarrow> 11.76 - \<exists> tr' \<in> listF_set (sub tr). phi (stl as) tr' \<or> properPath (stl as) tr'" 11.77 + \<exists> tr' \<in> set_listF (sub tr). phi (stl as) tr' \<or> properPath (stl as) tr'" 11.78 by (erule properPath.cases) blast 11.79 11.80 (* prove the following by coinduction *) 11.81 @@ -88,10 +77,10 @@ 11.82 assume "infiniteTr tr \<and> as = konigPath tr" hence "properPath as tr" 11.83 proof (coinduction arbitrary: tr as rule: properPath_coind) 11.84 case (sub tr as) 11.85 - let ?t = "SOME t'. t' \<in> listF_set (sub tr) \<and> infiniteTr t'" 11.86 - from sub have "\<exists>t' \<in> listF_set (sub tr). infiniteTr t'" by simp 11.87 - then have "\<exists>t'. t' \<in> listF_set (sub tr) \<and> infiniteTr t'" by blast 11.88 - then have "?t \<in> listF_set (sub tr) \<and> infiniteTr ?t" by (rule someI_ex) 11.89 + let ?t = "SOME t'. t' \<in> set_listF (sub tr) \<and> infiniteTr t'" 11.90 + from sub have "\<exists>t' \<in> set_listF (sub tr). infiniteTr t'" by simp 11.91 + then have "\<exists>t'. t' \<in> set_listF (sub tr) \<and> infiniteTr t'" by blast 11.92 + then have "?t \<in> set_listF (sub tr) \<and> infiniteTr ?t" by (rule someI_ex) 11.93 moreover have "stl (konigPath tr) = konigPath ?t" by simp 11.94 ultimately show ?case using sub by blast 11.95 qed simp   12.1 --- a/src/HOL/BNF/Examples/ListF.thy Mon Nov 18 17:15:01 2013 +0100 12.2 +++ b/src/HOL/BNF/Examples/ListF.thy Tue Nov 19 17:07:52 2013 +0100 12.3 @@ -62,7 +62,7 @@ 12.4 "i < lengthh xs \<Longrightarrow> nthh (mapF f xs) i = f (nthh xs i)" 12.5 by (induct rule: nthh.induct) auto 12.6 12.7 -lemma nthh_listF_set[simp]: "i < lengthh xs \<Longrightarrow> nthh xs i \<in> listF_set xs" 12.8 +lemma nthh_listF_set[simp]: "i < lengthh xs \<Longrightarrow> nthh xs i \<in> set_listF xs" 12.9 by (induct rule: nthh.induct) auto 12.10 12.11 lemma NilF_iff[iff]: "(lengthh xs = 0) = (xs = NilF)" 12.12 @@ -105,7 +105,7 @@ 12.13 qed simp 12.14 12.15 lemma list_set_nthh[simp]: 12.16 - "(x \<in> listF_set xs) \<Longrightarrow> (\<exists>i < lengthh xs. nthh xs i = x)" 12.17 + "(x \<in> set_listF xs) \<Longrightarrow> (\<exists>i < lengthh xs. nthh xs i = x)" 12.18 by (induct xs) (auto, induct rule: nthh.induct, auto) 12.19 12.20 end   13.1 --- a/src/HOL/BNF/Examples/Process.thy Mon Nov 18 17:15:01 2013 +0100 13.2 +++ b/src/HOL/BNF/Examples/Process.thy Tue Nov 19 17:07:52 2013 +0100 13.3 @@ -22,7 +22,7 @@ 13.4 subsection {* Basic properties *} 13.5 13.6 declare 13.7 - pre_process_rel_def[simp] 13.8 + rel_pre_process_def[simp] 13.9 sum_rel_def[simp] 13.10 prod_rel_def[simp] 13.11   14.1 --- a/src/HOL/BNF/Examples/Stream.thy Mon Nov 18 17:15:01 2013 +0100 14.2 +++ b/src/HOL/BNF/Examples/Stream.thy Tue Nov 19 17:07:52 2013 +0100 14.3 @@ -18,7 +18,7 @@ 14.4 code_datatype Stream 14.5 14.6 lemma stream_case_cert: 14.7 - assumes "CASE \<equiv> stream_case c" 14.8 + assumes "CASE \<equiv> case_stream c" 14.9 shows "CASE (a ## s) \<equiv> c a s" 14.10 using assms by simp_all 14.11   15.1 --- a/src/HOL/BNF/More_BNFs.thy Mon Nov 18 17:15:01 2013 +0100 15.2 +++ b/src/HOL/BNF/More_BNFs.thy Tue Nov 19 17:07:52 2013 +0100 15.3 @@ -909,18 +909,18 @@ 15.4 by (auto simp add: mmap_id0 mmap_comp set_of_mmap natLeq_card_order natLeq_cinfinite set_of_bd 15.5 intro: mmap_cong wpull_mmap) 15.6 15.7 -inductive multiset_rel' where 15.8 -Zero: "multiset_rel' R {#} {#}" 15.9 +inductive rel_multiset' where 15.10 +Zero: "rel_multiset' R {#} {#}" 15.11 | 15.12 -Plus: "\<lbrakk>R a b; multiset_rel' R M N\<rbrakk> \<Longrightarrow> multiset_rel' R (M + {#a#}) (N + {#b#})" 15.13 +Plus: "\<lbrakk>R a b; rel_multiset' R M N\<rbrakk> \<Longrightarrow> rel_multiset' R (M + {#a#}) (N + {#b#})" 15.14 15.15 -lemma multiset_map_Zero_iff[simp]: "mmap f M = {#} \<longleftrightarrow> M = {#}" 15.16 +lemma map_multiset_Zero_iff[simp]: "mmap f M = {#} \<longleftrightarrow> M = {#}" 15.17 by (metis image_is_empty multiset.set_map set_of_eq_empty_iff) 15.18 15.19 -lemma multiset_map_Zero[simp]: "mmap f {#} = {#}" by simp 15.20 +lemma map_multiset_Zero[simp]: "mmap f {#} = {#}" by simp 15.21 15.22 -lemma multiset_rel_Zero: "multiset_rel R {#} {#}" 15.23 -unfolding multiset_rel_def Grp_def by auto 15.24 +lemma rel_multiset_Zero: "rel_multiset R {#} {#}" 15.25 +unfolding rel_multiset_def Grp_def by auto 15.26 15.27 declare multiset.count[simp] 15.28 declare Abs_multiset_inverse[simp] 15.29 @@ -928,7 +928,7 @@ 15.30 declare union_preserves_multiset[simp] 15.31 15.32 15.33 -lemma multiset_map_Plus[simp]: "mmap f (M1 + M2) = mmap f M1 + mmap f M2" 15.34 +lemma map_multiset_Plus[simp]: "mmap f (M1 + M2) = mmap f M1 + mmap f M2" 15.35 proof (intro multiset_eqI, transfer fixing: f) 15.36 fix x :: 'a and M1 M2 :: "'b \<Rightarrow> nat" 15.37 assume "M1 \<in> multiset" "M2 \<in> multiset" 15.38 @@ -941,12 +941,12 @@ 15.39 by (auto simp: setsum.distrib[symmetric]) 15.40 qed 15.41 15.42 -lemma multiset_map_singl[simp]: "mmap f {#a#} = {#f a#}" 15.43 +lemma map_multiset_singl[simp]: "mmap f {#a#} = {#f a#}" 15.44 by transfer auto 15.45 15.46 -lemma multiset_rel_Plus: 15.47 -assumes ab: "R a b" and MN: "multiset_rel R M N" 15.48 -shows "multiset_rel R (M + {#a#}) (N + {#b#})" 15.49 +lemma rel_multiset_Plus: 15.50 +assumes ab: "R a b" and MN: "rel_multiset R M N" 15.51 +shows "rel_multiset R (M + {#a#}) (N + {#b#})" 15.52 proof- 15.53 {fix y assume "R a b" and "set_of y \<subseteq> {(x, y). R x y}" 15.54 hence "\<exists>ya. mmap fst y + {#a#} = mmap fst ya \<and> 15.55 @@ -956,13 +956,13 @@ 15.56 } 15.57 thus ?thesis 15.58 using assms 15.59 - unfolding multiset_rel_def Grp_def by force 15.60 + unfolding rel_multiset_def Grp_def by force 15.61 qed 15.62 15.63 -lemma multiset_rel'_imp_multiset_rel: 15.64 -"multiset_rel' R M N \<Longrightarrow> multiset_rel R M N" 15.65 -apply(induct rule: multiset_rel'.induct) 15.66 -using multiset_rel_Zero multiset_rel_Plus by auto 15.67 +lemma rel_multiset'_imp_rel_multiset: 15.68 +"rel_multiset' R M N \<Longrightarrow> rel_multiset R M N" 15.69 +apply(induct rule: rel_multiset'.induct) 15.70 +using rel_multiset_Zero rel_multiset_Plus by auto 15.71 15.72 lemma mcard_mmap[simp]: "mcard (mmap f M) = mcard M" 15.73 proof - 15.74 @@ -973,8 +973,7 @@ 15.75 using finite_Collect_mem . 15.76 ultimately have fin: "finite {b. \<exists>a. f a = b \<and> a \<in># M}" by(rule finite_subset) 15.77 have i: "inj_on A ?B" unfolding inj_on_def A_def apply clarsimp 15.78 - by (metis (lifting, mono_tags) mem_Collect_eq rel_simps(54) 15.79 - setsum_gt_0_iff setsum_infinite) 15.80 + by (metis (lifting, full_types) mem_Collect_eq neq0_conv setsum.neutral) 15.81 have 0: "\<And> b. 0 < setsum (count M) (A b) \<longleftrightarrow> (\<exists> a \<in> A b. count M a > 0)" 15.82 apply safe 15.83 apply (metis less_not_refl setsum_gt_0_iff setsum_infinite) 15.84 @@ -995,10 +994,10 @@ 15.85 then show ?thesis unfolding mcard_unfold_setsum A_def by transfer 15.86 qed 15.87 15.88 -lemma multiset_rel_mcard: 15.89 -assumes "multiset_rel R M N" 15.90 +lemma rel_multiset_mcard: 15.91 +assumes "rel_multiset R M N" 15.92 shows "mcard M = mcard N" 15.93 -using assms unfolding multiset_rel_def Grp_def by auto 15.94 +using assms unfolding rel_multiset_def Grp_def by auto 15.95 15.96 lemma multiset_induct2[case_names empty addL addR]: 15.97 assumes empty: "P {#} {#}" 15.98 @@ -1053,67 +1052,67 @@ 15.99 qed 15.100 15.101 lemma msed_rel_invL: 15.102 -assumes "multiset_rel R (M + {#a#}) N" 15.103 -shows "\<exists> N1 b. N = N1 + {#b#} \<and> R a b \<and> multiset_rel R M N1" 15.104 +assumes "rel_multiset R (M + {#a#}) N" 15.105 +shows "\<exists> N1 b. N = N1 + {#b#} \<and> R a b \<and> rel_multiset R M N1" 15.106 proof- 15.107 obtain K where KM: "mmap fst K = M + {#a#}" 15.108 and KN: "mmap snd K = N" and sK: "set_of K \<subseteq> {(a, b). R a b}" 15.109 using assms 15.110 - unfolding multiset_rel_def Grp_def by auto 15.111 + unfolding rel_multiset_def Grp_def by auto 15.112 obtain K1 ab where K: "K = K1 + {#ab#}" and a: "fst ab = a" 15.113 and K1M: "mmap fst K1 = M" using msed_map_invR[OF KM] by auto 15.114 obtain N1 where N: "N = N1 + {#snd ab#}" and K1N1: "mmap snd K1 = N1" 15.115 using msed_map_invL[OF KN[unfolded K]] by auto 15.116 have Rab: "R a (snd ab)" using sK a unfolding K by auto 15.117 - have "multiset_rel R M N1" using sK K1M K1N1 15.118 - unfolding K multiset_rel_def Grp_def by auto 15.119 + have "rel_multiset R M N1" using sK K1M K1N1 15.120 + unfolding K rel_multiset_def Grp_def by auto 15.121 thus ?thesis using N Rab by auto 15.122 qed 15.123 15.124 lemma msed_rel_invR: 15.125 -assumes "multiset_rel R M (N + {#b#})" 15.126 -shows "\<exists> M1 a. M = M1 + {#a#} \<and> R a b \<and> multiset_rel R M1 N" 15.127 +assumes "rel_multiset R M (N + {#b#})" 15.128 +shows "\<exists> M1 a. M = M1 + {#a#} \<and> R a b \<and> rel_multiset R M1 N" 15.129 proof- 15.130 obtain K where KN: "mmap snd K = N + {#b#}" 15.131 and KM: "mmap fst K = M" and sK: "set_of K \<subseteq> {(a, b). R a b}" 15.132 using assms 15.133 - unfolding multiset_rel_def Grp_def by auto 15.134 + unfolding rel_multiset_def Grp_def by auto 15.135 obtain K1 ab where K: "K = K1 + {#ab#}" and b: "snd ab = b" 15.136 and K1N: "mmap snd K1 = N" using msed_map_invR[OF KN] by auto 15.137 obtain M1 where M: "M = M1 + {#fst ab#}" and K1M1: "mmap fst K1 = M1" 15.138 using msed_map_invL[OF KM[unfolded K]] by auto 15.139 have Rab: "R (fst ab) b" using sK b unfolding K by auto 15.140 - have "multiset_rel R M1 N" using sK K1N K1M1 15.141 - unfolding K multiset_rel_def Grp_def by auto 15.142 + have "rel_multiset R M1 N" using sK K1N K1M1 15.143 + unfolding K rel_multiset_def Grp_def by auto 15.144 thus ?thesis using M Rab by auto 15.145 qed 15.146 15.147 -lemma multiset_rel_imp_multiset_rel': 15.148 -assumes "multiset_rel R M N" 15.149 -shows "multiset_rel' R M N" 15.150 +lemma rel_multiset_imp_rel_multiset': 15.151 +assumes "rel_multiset R M N" 15.152 +shows "rel_multiset' R M N" 15.153 using assms proof(induct M arbitrary: N rule: measure_induct_rule[of mcard]) 15.154 case (less M) 15.155 - have c: "mcard M = mcard N" using multiset_rel_mcard[OF less.prems] . 15.156 + have c: "mcard M = mcard N" using rel_multiset_mcard[OF less.prems] . 15.157 show ?case 15.158 proof(cases "M = {#}") 15.159 case True hence "N = {#}" using c by simp 15.160 - thus ?thesis using True multiset_rel'.Zero by auto 15.161 + thus ?thesis using True rel_multiset'.Zero by auto 15.162 next 15.163 case False then obtain M1 a where M: "M = M1 + {#a#}" by (metis multi_nonempty_split) 15.164 - obtain N1 b where N: "N = N1 + {#b#}" and R: "R a b" and ms: "multiset_rel R M1 N1" 15.165 + obtain N1 b where N: "N = N1 + {#b#}" and R: "R a b" and ms: "rel_multiset R M1 N1" 15.166 using msed_rel_invL[OF less.prems[unfolded M]] by auto 15.167 - have "multiset_rel' R M1 N1" using less.hyps[of M1 N1] ms unfolding M by simp 15.168 - thus ?thesis using multiset_rel'.Plus[of R a b, OF R] unfolding M N by simp 15.169 + have "rel_multiset' R M1 N1" using less.hyps[of M1 N1] ms unfolding M by simp 15.170 + thus ?thesis using rel_multiset'.Plus[of R a b, OF R] unfolding M N by simp 15.171 qed 15.172 qed 15.173 15.174 -lemma multiset_rel_multiset_rel': 15.175 -"multiset_rel R M N = multiset_rel' R M N" 15.176 -using multiset_rel_imp_multiset_rel' multiset_rel'_imp_multiset_rel by auto 15.177 +lemma rel_multiset_rel_multiset': 15.178 +"rel_multiset R M N = rel_multiset' R M N" 15.179 +using rel_multiset_imp_rel_multiset' rel_multiset'_imp_rel_multiset by auto 15.180 15.181 -(* The main end product for multiset_rel: inductive characterization *) 15.182 -theorems multiset_rel_induct[case_names empty add, induct pred: multiset_rel] = 15.183 - multiset_rel'.induct[unfolded multiset_rel_multiset_rel'[symmetric]] 15.184 +(* The main end product for rel_multiset: inductive characterization *) 15.185 +theorems rel_multiset_induct[case_names empty add, induct pred: rel_multiset] = 15.186 + rel_multiset'.induct[unfolded rel_multiset_rel_multiset'[symmetric]] 15.187 15.188 15.189 15.190 @@ -1184,5 +1183,4 @@ 15.191 qed 15.192 qed 15.193 15.194 - 15.195 end   16.1 --- a/src/HOL/BNF/Tools/bnf_def.ML Mon Nov 18 17:15:01 2013 +0100 16.2 +++ b/src/HOL/BNF/Tools/bnf_def.ML Tue Nov 19 17:07:52 2013 +0100 16.3 @@ -678,7 +678,7 @@ 16.4 16.5 val def_qualify = Binding.conceal o Binding.qualify false (Binding.name_of bnf_b); 16.6 16.7 - fun mk_suffix_binding suf = Binding.suffix_name ("_" ^ suf) bnf_b; 16.8 + fun mk_prefix_binding pre = Binding.prefix_name (pre ^ "_") bnf_b; 16.9 16.10 fun maybe_define user_specified (b, rhs) lthy = 16.11 let 16.12 @@ -703,7 +703,7 @@ 16.13 lthy |> not (pointer_eq (lthy_old, lthy)) ? Local_Theory.restore; 16.14 16.15 val map_bind_def = 16.16 - (fn () => def_qualify (if Binding.is_empty map_b then mk_suffix_binding mapN else map_b), 16.17 + (fn () => def_qualify (if Binding.is_empty map_b then mk_prefix_binding mapN else map_b), 16.18 map_rhs); 16.19 val set_binds_defs = 16.20 let 16.21 @@ -711,10 +711,10 @@ 16.22 (case try (nth set_bs) (i - 1) of 16.23 SOME b => if Binding.is_empty b then get_b else K b 16.24 | NONE => get_b) #> def_qualify; 16.25 - val bs = if live = 1 then [set_name 1 (fn () => mk_suffix_binding setN)] 16.26 - else map (fn i => set_name i (fn () => mk_suffix_binding (mk_setN i))) (1 upto live); 16.27 + val bs = if live = 1 then [set_name 1 (fn () => mk_prefix_binding setN)] 16.28 + else map (fn i => set_name i (fn () => mk_prefix_binding (mk_setN i))) (1 upto live); 16.29 in bs ~~ set_rhss end; 16.30 - val bd_bind_def = (fn () => def_qualify (mk_suffix_binding bdN), bd_rhs); 16.31 + val bd_bind_def = (fn () => def_qualify (mk_prefix_binding bdN), bd_rhs); 16.32 16.33 val ((((bnf_map_term, raw_map_def), 16.34 (bnf_set_terms, raw_set_defs)), 16.35 @@ -861,7 +861,7 @@ 16.36 | SOME raw_rel => prep_term no_defs_lthy raw_rel); 16.37 16.38 val rel_bind_def = 16.39 - (fn () => def_qualify (if Binding.is_empty rel_b then mk_suffix_binding relN else rel_b), 16.40 + (fn () => def_qualify (if Binding.is_empty rel_b then mk_prefix_binding relN else rel_b), 16.41 rel_rhs); 16.42 16.43 val wit_rhss = 16.44 @@ -873,8 +873,8 @@ 16.45 val nwits = length wit_rhss; 16.46 val wit_binds_defs = 16.47 let 16.48 - val bs = if nwits = 1 then [fn () => def_qualify (mk_suffix_binding witN)] 16.49 - else map (fn i => fn () => def_qualify (mk_suffix_binding (mk_witN i))) (1 upto nwits); 16.50 + val bs = if nwits = 1 then [fn () => def_qualify (mk_prefix_binding witN)] 16.51 + else map (fn i => fn () => def_qualify (mk_prefix_binding (mk_witN i))) (1 upto nwits); 16.52 in bs ~~ wit_rhss end; 16.53 16.54 val (((bnf_rel_term, raw_rel_def), (bnf_wit_terms, raw_wit_defs)), (lthy, lthy_old)) =   17.1 --- a/src/HOL/BNF/Tools/bnf_fp_def_sugar.ML Mon Nov 18 17:15:01 2013 +0100 17.2 +++ b/src/HOL/BNF/Tools/bnf_fp_def_sugar.ML Tue Nov 19 17:07:52 2013 +0100 17.3 @@ -544,10 +544,10 @@ 17.4 17.5 val fpT_to_C as Type (_, [fpT, _]) = snd (strip_typeN nn (fastype_of (hd ctor_iters))); 17.6 17.7 - fun generate_iter suf (f_Tss, _, fss, xssss) ctor_iter = 17.8 + fun generate_iter pre (f_Tss, _, fss, xssss) ctor_iter = 17.9 let 17.10 val res_T = fold_rev (curry (op --->)) f_Tss fpT_to_C; 17.11 - val b = mk_binding suf; 17.12 + val b = mk_binding pre; 17.13 val spec = 17.14 mk_Trueprop_eq (lists_bmoc fss (Free (Binding.name_of b, res_T)), 17.15 mk_iter_body ctor_iter fss xssss); 17.16 @@ -563,10 +563,10 @@ 17.17 17.18 val C_to_fpT as Type (_, [_, fpT]) = snd (strip_typeN nn (fastype_of (hd dtor_coiters))); 17.19 17.20 - fun generate_coiter suf ((pfss, cqfsss), (f_sum_prod_Ts, pf_Tss)) dtor_coiter = 17.21 + fun generate_coiter pre ((pfss, cqfsss), (f_sum_prod_Ts, pf_Tss)) dtor_coiter = 17.22 let 17.23 val res_T = fold_rev (curry (op --->)) pf_Tss C_to_fpT; 17.24 - val b = mk_binding suf; 17.25 + val b = mk_binding pre; 17.26 val spec = 17.27 mk_Trueprop_eq (lists_bmoc pfss (Free (Binding.name_of b, res_T)), 17.28 mk_coiter_body cs cpss f_sum_prod_Ts cqfsss dtor_coiter); 17.29 @@ -1356,7 +1356,7 @@ 17.30 lthy |> Local_Theory.notes (anonymous_notes @ notes) |> snd) 17.31 end; 17.32 17.33 - fun mk_binding suf = qualify false fp_b_name (Binding.suffix_name ("_" ^ suf) fp_b); 17.34 + fun mk_binding pre = qualify false fp_b_name (Binding.prefix_name (pre ^ "_") fp_b); 17.35 17.36 fun massage_res (((maps_sets_rels, ctr_sugar), co_iter_res), lthy) = 17.37 (((maps_sets_rels, (ctrs, xss, ctr_defs, ctr_sugar)), co_iter_res), lthy);   18.1 --- a/src/HOL/BNF/Tools/bnf_gfp.ML Mon Nov 18 17:15:01 2013 +0100 18.2 +++ b/src/HOL/BNF/Tools/bnf_gfp.ML Tue Nov 19 17:07:52 2013 +0100 18.3 @@ -74,7 +74,7 @@ 18.4 val mk_internal_b = Binding.name #> Binding.prefix true b_name #> Binding.conceal; 18.5 fun mk_internal_bs name = 18.6 map (fn b => 18.7 - Binding.prefix true b_name (Binding.suffix_name ("_" ^ name) b) |> Binding.conceal) bs; 18.8 + Binding.prefix true b_name (Binding.prefix_name (name ^ "_") b) |> Binding.conceal) bs; 18.9 val external_bs = map2 (Binding.prefix false) b_names bs 18.10 |> note_all = false ? map Binding.conceal; 18.11 18.12 @@ -1695,7 +1695,7 @@ 18.13 ||>> mk_Frees "s" corec_sTs 18.14 ||>> mk_Frees "P" (map2 mk_pred2T Ts Ts); 18.15 18.16 - fun dtor_bind i = nth external_bs (i - 1) |> Binding.suffix_name ("_" ^ dtorN); 18.17 + fun dtor_bind i = nth external_bs (i - 1) |> Binding.prefix_name (dtorN ^ "_"); 18.18 val dtor_name = Binding.name_of o dtor_bind; 18.19 val dtor_def_bind = rpair [] o Binding.conceal o Thm.def_binding o dtor_bind; 18.20 18.21 @@ -1747,7 +1747,7 @@ 18.22 18.23 val timer = time (timer "dtor definitions & thms"); 18.24 18.25 - fun unfold_bind i = nth external_bs (i - 1) |> Binding.suffix_name ("_" ^ dtor_unfoldN); 18.26 + fun unfold_bind i = nth external_bs (i - 1) |> Binding.prefix_name (dtor_unfoldN ^ "_"); 18.27 val unfold_name = Binding.name_of o unfold_bind; 18.28 val unfold_def_bind = rpair [] o Binding.conceal o Thm.def_binding o unfold_bind; 18.29 18.30 @@ -1868,7 +1868,7 @@ 18.31 Term.list_comb (mk_map_of_bnf Ds (passiveAs @ Ts) (passiveAs @ FTs) bnf, 18.32 map HOLogic.id_const passiveAs @ dtors)) Dss bnfs; 18.33 18.34 - fun ctor_bind i = nth external_bs (i - 1) |> Binding.suffix_name ("_" ^ ctorN); 18.35 + fun ctor_bind i = nth external_bs (i - 1) |> Binding.prefix_name (ctorN ^ "_"); 18.36 val ctor_name = Binding.name_of o ctor_bind; 18.37 val ctor_def_bind = rpair [] o Binding.conceal o Thm.def_binding o ctor_bind; 18.38 18.39 @@ -1939,7 +1939,7 @@ 18.40 trans OF [mor RS unique, unfold_dtor]) unfold_unique_mor_thms unfold_dtor_thms 18.41 end; 18.42 18.43 - fun corec_bind i = nth external_bs (i - 1) |> Binding.suffix_name ("_" ^ dtor_corecN); 18.44 + fun corec_bind i = nth external_bs (i - 1) |> Binding.prefix_name (dtor_corecN ^ "_"); 18.45 val corec_name = Binding.name_of o corec_bind; 18.46 val corec_def_bind = rpair [] o Binding.conceal o Thm.def_binding o corec_bind; 18.47   19.1 --- a/src/HOL/BNF/Tools/bnf_lfp.ML Mon Nov 18 17:15:01 2013 +0100 19.2 +++ b/src/HOL/BNF/Tools/bnf_lfp.ML Tue Nov 19 17:07:52 2013 +0100 19.3 @@ -44,7 +44,7 @@ 19.4 val mk_internal_b = Binding.name #> Binding.prefix true b_name #> Binding.conceal; 19.5 fun mk_internal_bs name = 19.6 map (fn b => 19.7 - Binding.prefix true b_name (Binding.suffix_name ("_" ^ name) b) |> Binding.conceal) bs; 19.8 + Binding.prefix true b_name (Binding.prefix_name (name ^ "_") b) |> Binding.conceal) bs; 19.9 val external_bs = map2 (Binding.prefix false) b_names bs 19.10 |> note_all = false ? map Binding.conceal; 19.11 19.12 @@ -1021,7 +1021,7 @@ 19.13 val phis = map2 retype_free (map mk_pred1T Ts) init_phis; 19.14 val phi2s = map2 retype_free (map2 mk_pred2T Ts Ts') init_phis; 19.15 19.16 - fun ctor_bind i = nth external_bs (i - 1) |> Binding.suffix_name ("_" ^ ctorN); 19.17 + fun ctor_bind i = nth external_bs (i - 1) |> Binding.prefix_name (ctorN ^ "_"); 19.18 val ctor_name = Binding.name_of o ctor_bind; 19.19 val ctor_def_bind = rpair [] o Binding.conceal o Thm.def_binding o ctor_bind; 19.20 19.21 @@ -1080,7 +1080,7 @@ 19.22 (mk_mor UNIVs ctors active_UNIVs ss (map (mk_nthN n fold_f) ks)); 19.23 val foldx = HOLogic.choice_const foldT$ fold_fun;
19.24
19.25 -    fun fold_bind i = nth external_bs (i - 1) |> Binding.suffix_name ("_" ^ ctor_foldN);
19.26 +    fun fold_bind i = nth external_bs (i - 1) |> Binding.prefix_name (ctor_foldN ^ "_");
19.27      val fold_name = Binding.name_of o fold_bind;
19.28      val fold_def_bind = rpair [] o Binding.conceal o Thm.def_binding o fold_bind;
19.29
19.30 @@ -1170,7 +1170,7 @@
19.31        Term.list_comb (mk_map_of_bnf Ds (passiveAs @ FTs) (passiveAs @ Ts) bnf,
19.32          map HOLogic.id_const passiveAs @ ctors)) Dss bnfs;
19.33
19.34 -    fun dtor_bind i = nth external_bs (i - 1) |> Binding.suffix_name ("_" ^ dtorN);
19.35 +    fun dtor_bind i = nth external_bs (i - 1) |> Binding.prefix_name (dtorN ^ "_");
19.36      val dtor_name = Binding.name_of o dtor_bind;
19.37      val dtor_def_bind = rpair [] o Binding.conceal o Thm.def_binding o dtor_bind;
19.38
19.39 @@ -1243,7 +1243,7 @@
19.40            trans OF [mor RS unique, fold_ctor]) fold_unique_mor_thms fold_ctor_thms
19.41        end;
19.42
19.43 -    fun rec_bind i = nth external_bs (i - 1) |> Binding.suffix_name ("_" ^ ctor_recN);
19.44 +    fun rec_bind i = nth external_bs (i - 1) |> Binding.prefix_name (ctor_recN ^ "_");
19.45      val rec_name = Binding.name_of o rec_bind;
19.46      val rec_def_bind = rpair [] o Binding.conceal o Thm.def_binding o rec_bind;
19.47
19.48 @@ -1354,7 +1354,7 @@
19.49      val cTs = map (SOME o certifyT lthy o TFree) induct_params;
19.50
19.51      val weak_ctor_induct_thms =
19.52 -      let fun insts i = (replicate (i - 1) TrueI) @ (@{thm asm_rl} :: replicate (n - i) TrueI);
19.53 +      let fun insts i = (replicate (i - 1) TrueI) @ (asm_rl :: replicate (n - i) TrueI);
19.54        in map (fn i => (ctor_induct_thm OF insts i) RS mk_conjunctN n i) ks end;
19.55
19.56      val (ctor_induct2_thm, induct2_params) =

    20.1 --- a/src/HOL/Cardinals/Cardinal_Arithmetic.thy	Mon Nov 18 17:15:01 2013 +0100
20.2 +++ b/src/HOL/Cardinals/Cardinal_Arithmetic.thy	Tue Nov 19 17:07:52 2013 +0100
20.3 @@ -8,270 +8,17 @@
20.4  header {* Cardinal Arithmetic  *}
20.5
20.6  theory Cardinal_Arithmetic
20.7 -imports Cardinal_Order_Relation_Base
20.8 +imports Cardinal_Arithmetic_FP Cardinal_Order_Relation
20.9  begin
20.10
20.11 -text {*
20.12 -  The following collection of lemmas should be seen as an user interface to the HOL Theory
20.13 -  of cardinals. It is not expected to be complete in any sense, since its
20.14 -  development was driven by demand arising from the development of the (co)datatype package.
20.15 -*}
20.16 -
20.17 -(*library candidate*)
20.18 -lemma dir_image: "\<lbrakk>\<And>x y. (f x = f y) = (x = y); Card_order r\<rbrakk> \<Longrightarrow> r =o dir_image r f"
20.19 -by (rule dir_image_ordIso) (auto simp add: inj_on_def card_order_on_def)
20.20 -
20.21 -(*should supersede a weaker lemma from the library*)
20.22 -lemma dir_image_Field: "Field (dir_image r f) = f  Field r"
20.23 -unfolding dir_image_def Field_def Range_def Domain_def by fastforce
20.24 -
20.25 -lemma card_order_dir_image:
20.26 -  assumes bij: "bij f" and co: "card_order r"
20.27 -  shows "card_order (dir_image r f)"
20.28 -proof -
20.29 -  from assms have "Field (dir_image r f) = UNIV"
20.30 -    using card_order_on_Card_order[of UNIV r] unfolding bij_def dir_image_Field by auto
20.31 -  moreover from bij have "\<And>x y. (f x = f y) = (x = y)" unfolding bij_def inj_on_def by auto
20.32 -  with co have "Card_order (dir_image r f)"
20.33 -    using card_order_on_Card_order[of UNIV r] Card_order_ordIso2[OF _ dir_image] by blast
20.34 -  ultimately show ?thesis by auto
20.35 -qed
20.36 -
20.37 -(*library candidate*)
20.38 -lemma ordIso_refl: "Card_order r \<Longrightarrow> r =o r"
20.39 -by (rule card_order_on_ordIso)
20.40 -
20.41 -(*library candidate*)
20.42 -lemma ordLeq_refl: "Card_order r \<Longrightarrow> r \<le>o r"
20.43 -by (rule ordIso_imp_ordLeq, rule card_order_on_ordIso)
20.44 -
20.45 -(*library candidate*)
20.46 -lemma card_of_ordIso_subst: "A = B \<Longrightarrow> |A| =o |B|"
20.47 -by (simp only: ordIso_refl card_of_Card_order)
20.48 -
20.49 -(*library candidate*)
20.50 -lemma Field_card_order: "card_order r \<Longrightarrow> Field r = UNIV"
20.51 -using card_order_on_Card_order[of UNIV r] by simp
20.52 -
20.53 -(*library candidate*)
20.54 -lemma card_of_Times_Plus_distrib:
20.55 -  "|A <*> (B <+> C)| =o |A <*> B <+> A <*> C|" (is "|?RHS| =o |?LHS|")
20.56 -proof -
20.57 -  let ?f = "\<lambda>(a, bc). case bc of Inl b \<Rightarrow> Inl (a, b) | Inr c \<Rightarrow> Inr (a, c)"
20.58 -  have "bij_betw ?f ?RHS ?LHS" unfolding bij_betw_def inj_on_def by force
20.59 -  thus ?thesis using card_of_ordIso by blast
20.60 -qed
20.61 -
20.62 -(*library candidate*)
20.63 -lemma Func_Times_Range:
20.64 -  "|Func A (B <*> C)| =o |Func A B <*> Func A C|" (is "|?LHS| =o |?RHS|")
20.65 -proof -
20.66 -  let ?F = "\<lambda>fg. (\<lambda>x. if x \<in> A then fst (fg x) else undefined,
20.67 -                  \<lambda>x. if x \<in> A then snd (fg x) else undefined)"
20.68 -  let ?G = "\<lambda>(f, g) x. if x \<in> A then (f x, g x) else undefined"
20.69 -  have "bij_betw ?F ?LHS ?RHS" unfolding bij_betw_def inj_on_def
20.70 -  proof safe
20.71 -    fix f g assume "f \<in> Func A B" "g \<in> Func A C"
20.72 -    thus "(f, g) \<in> ?F  Func A (B \<times> C)"
20.73 -      by (intro image_eqI[of _ _ "?G (f, g)"]) (auto simp: Func_def)
20.74 -  qed (auto simp: Func_def fun_eq_iff, metis pair_collapse)
20.75 -  thus ?thesis using card_of_ordIso by blast
20.76 -qed
20.77 -
20.78 -
20.79 -subsection {* Zero *}
20.80 -
20.81 -definition czero where
20.82 -  "czero = card_of {}"
20.83 -
20.84 -lemma czero_ordIso:
20.85 -  "czero =o czero"
20.86 -using card_of_empty_ordIso by (simp add: czero_def)
20.87 -
20.88 -lemma card_of_ordIso_czero_iff_empty:
20.89 -  "|A| =o (czero :: 'b rel) \<longleftrightarrow> A = ({} :: 'a set)"
20.90 -unfolding czero_def by (rule iffI[OF card_of_empty2]) (auto simp: card_of_refl card_of_empty_ordIso)
20.91 -
20.92 -(* A "not czero" Cardinal predicate *)
20.93 -abbreviation Cnotzero where
20.94 -  "Cnotzero (r :: 'a rel) \<equiv> \<not>(r =o (czero :: 'a rel)) \<and> Card_order r"
20.95 -
20.96 -(*helper*)
20.97 -lemma Cnotzero_imp_not_empty: "Cnotzero r \<Longrightarrow> Field r \<noteq> {}"
20.98 -by (metis Card_order_iff_ordIso_card_of czero_def)
20.99 -
20.100 -lemma czeroI:
20.101 -  "\<lbrakk>Card_order r; Field r = {}\<rbrakk> \<Longrightarrow> r =o czero"
20.102 -using Cnotzero_imp_not_empty ordIso_transitive[OF _ czero_ordIso] by blast
20.103 -
20.104 -lemma czeroE:
20.105 -  "r =o czero \<Longrightarrow> Field r = {}"
20.106 -unfolding czero_def
20.107 -by (drule card_of_cong) (simp only: Field_card_of card_of_empty2)
20.108 -
20.109 -lemma Cnotzero_mono:
20.110 -  "\<lbrakk>Cnotzero r; Card_order q; r \<le>o q\<rbrakk> \<Longrightarrow> Cnotzero q"
20.111 -apply (rule ccontr)
20.112 -apply auto
20.113 -apply (drule czeroE)
20.114 -apply (erule notE)
20.115 -apply (erule czeroI)
20.116 -apply (drule card_of_mono2)
20.117 -apply (simp only: card_of_empty3)
20.118 -done
20.119 -
20.120 -subsection {* (In)finite cardinals *}
20.121 -
20.122 -definition cinfinite where
20.123 -  "cinfinite r = infinite (Field r)"
20.124 -
20.125 -abbreviation Cinfinite where
20.126 -  "Cinfinite r \<equiv> cinfinite r \<and> Card_order r"
20.127 -
20.128 -definition cfinite where
20.129 -  "cfinite r = finite (Field r)"
20.130 -
20.131 -abbreviation Cfinite where
20.132 -  "Cfinite r \<equiv> cfinite r \<and> Card_order r"
20.133 -
20.134 -lemma Cfinite_ordLess_Cinfinite: "\<lbrakk>Cfinite r; Cinfinite s\<rbrakk> \<Longrightarrow> r <o s"
20.135 -  unfolding cfinite_def cinfinite_def
20.136 -  by (metis card_order_on_well_order_on finite_ordLess_infinite)
20.137 -
20.138 -lemma natLeq_ordLeq_cinfinite:
20.139 -  assumes inf: "Cinfinite r"
20.140 -  shows "natLeq \<le>o r"
20.141 -proof -
20.142 -  from inf have "natLeq \<le>o |Field r|" by (simp add: cinfinite_def infinite_iff_natLeq_ordLeq)
20.143 -  also from inf have "|Field r| =o r" by (simp add: card_of_unique ordIso_symmetric)
20.144 -  finally show ?thesis .
20.145 -qed
20.146 -
20.147 -lemma cinfinite_not_czero: "cinfinite r \<Longrightarrow> \<not> (r =o (czero :: 'a rel))"
20.148 -unfolding cinfinite_def by (metis czeroE finite.emptyI)
20.149 -
20.150 -lemma Cinfinite_Cnotzero: "Cinfinite r \<Longrightarrow> Cnotzero r"
20.151 -by (metis cinfinite_not_czero)
20.152 -
20.153 -lemma Cinfinite_cong: "\<lbrakk>r1 =o r2; Cinfinite r1\<rbrakk> \<Longrightarrow> Cinfinite r2"
20.154 -by (metis Card_order_ordIso2 card_of_mono2 card_of_ordLeq_infinite cinfinite_def ordIso_iff_ordLeq)
20.155 -
20.156 -lemma cinfinite_mono: "\<lbrakk>r1 \<le>o r2; cinfinite r1\<rbrakk> \<Longrightarrow> cinfinite r2"
20.157 -by (metis card_of_mono2 card_of_ordLeq_infinite cinfinite_def)
20.158 -
20.159
20.160  subsection {* Binary sum *}
20.161
20.162 -definition csum (infixr "+c" 65) where
20.163 -  "r1 +c r2 \<equiv> |Field r1 <+> Field r2|"
20.164 -
20.165 -lemma Field_csum: "Field (r +c s) = Inl  Field r \<union> Inr  Field s"
20.166 -  unfolding csum_def Field_card_of by auto
20.167 -
20.168 -lemma Card_order_csum:
20.169 -  "Card_order (r1 +c r2)"
20.170 -unfolding csum_def by (simp add: card_of_Card_order)
20.171 -
20.172 -lemma csum_Cnotzero1:
20.173 -  "Cnotzero r1 \<Longrightarrow> Cnotzero (r1 +c r2)"
20.174 -unfolding csum_def
20.175 -by (metis Cnotzero_imp_not_empty Field_card_of Plus_eq_empty_conv card_of_card_order_on czeroE)
20.176 -
20.177  lemma csum_Cnotzero2:
20.178    "Cnotzero r2 \<Longrightarrow> Cnotzero (r1 +c r2)"
20.179  unfolding csum_def
20.180  by (metis Cnotzero_imp_not_empty Field_card_of Plus_eq_empty_conv card_of_card_order_on czeroE)
20.181
20.182 -lemma card_order_csum:
20.183 -  assumes "card_order r1" "card_order r2"
20.184 -  shows "card_order (r1 +c r2)"
20.185 -proof -
20.186 -  have "Field r1 = UNIV" "Field r2 = UNIV" using assms card_order_on_Card_order by auto
20.187 -  thus ?thesis unfolding csum_def by (auto simp: card_of_card_order_on)
20.188 -qed
20.189 -
20.190 -lemma cinfinite_csum:
20.191 -  "cinfinite r1 \<or> cinfinite r2 \<Longrightarrow> cinfinite (r1 +c r2)"
20.192 -unfolding cinfinite_def csum_def by (auto simp: Field_card_of)
20.193 -
20.194 -lemma Cinfinite_csum:
20.195 -  "Cinfinite r1 \<or> Cinfinite r2 \<Longrightarrow> Cinfinite (r1 +c r2)"
20.196 -unfolding cinfinite_def csum_def by (metis Field_card_of card_of_Card_order finite_Plus_iff)
20.197 -
20.198 -lemma Cinfinite_csum_strong:
20.199 -  "\<lbrakk>Cinfinite r1; Cinfinite r2\<rbrakk> \<Longrightarrow> Cinfinite (r1 +c r2)"
20.200 -by (metis Cinfinite_csum)
20.201 -
20.202 -lemma Cinfinite_csum1:
20.203 -  "Cinfinite r1 \<Longrightarrow> Cinfinite (r1 +c r2)"
20.204 -unfolding cinfinite_def csum_def by (metis Field_card_of card_of_Card_order finite_Plus_iff)
20.205 -
20.206 -lemma csum_cong: "\<lbrakk>p1 =o r1; p2 =o r2\<rbrakk> \<Longrightarrow> p1 +c p2 =o r1 +c r2"
20.207 -by (simp only: csum_def ordIso_Plus_cong)
20.208 -
20.209 -lemma csum_cong1: "p1 =o r1 \<Longrightarrow> p1 +c q =o r1 +c q"
20.210 -by (simp only: csum_def ordIso_Plus_cong1)
20.211 -
20.212 -lemma csum_cong2: "p2 =o r2 \<Longrightarrow> q +c p2 =o q +c r2"
20.213 -by (simp only: csum_def ordIso_Plus_cong2)
20.214 -
20.215 -lemma csum_mono: "\<lbrakk>p1 \<le>o r1; p2 \<le>o r2\<rbrakk> \<Longrightarrow> p1 +c p2 \<le>o r1 +c r2"
20.216 -by (simp only: csum_def ordLeq_Plus_mono)
20.217 -
20.218 -lemma csum_mono1: "p1 \<le>o r1 \<Longrightarrow> p1 +c q \<le>o r1 +c q"
20.219 -by (simp only: csum_def ordLeq_Plus_mono1)
20.220 -
20.221 -lemma csum_mono2: "p2 \<le>o r2 \<Longrightarrow> q +c p2 \<le>o q +c r2"
20.222 -by (simp only: csum_def ordLeq_Plus_mono2)
20.223 -
20.224 -lemma ordLeq_csum1: "Card_order p1 \<Longrightarrow> p1 \<le>o p1 +c p2"
20.225 -by (simp only: csum_def Card_order_Plus1)
20.226 -
20.227 -lemma ordLeq_csum2: "Card_order p2 \<Longrightarrow> p2 \<le>o p1 +c p2"
20.228 -by (simp only: csum_def Card_order_Plus2)
20.229 -
20.230 -lemma csum_com: "p1 +c p2 =o p2 +c p1"
20.231 -by (simp only: csum_def card_of_Plus_commute)
20.232 -
20.233 -lemma csum_assoc: "(p1 +c p2) +c p3 =o p1 +c p2 +c p3"
20.234 -by (simp only: csum_def Field_card_of card_of_Plus_assoc)
20.235 -
20.236 -lemma Cfinite_csum: "\<lbrakk>Cfinite r; Cfinite s\<rbrakk> \<Longrightarrow> Cfinite (r +c s)"
20.237 -  unfolding cfinite_def csum_def Field_card_of using card_of_card_order_on by simp
20.238 -
20.239 -lemma csum_csum: "(r1 +c r2) +c (r3 +c r4) =o (r1 +c r3) +c (r2 +c r4)"
20.240 -proof -
20.241 -  have "(r1 +c r2) +c (r3 +c r4) =o r1 +c r2 +c (r3 +c r4)"
20.242 -    by (metis csum_assoc)
20.243 -  also have "r1 +c r2 +c (r3 +c r4) =o r1 +c (r2 +c r3) +c r4"
20.244 -    by (metis csum_assoc csum_cong2 ordIso_symmetric)
20.245 -  also have "r1 +c (r2 +c r3) +c r4 =o r1 +c (r3 +c r2) +c r4"
20.246 -    by (metis csum_com csum_cong1 csum_cong2)
20.247 -  also have "r1 +c (r3 +c r2) +c r4 =o r1 +c r3 +c r2 +c r4"
20.248 -    by (metis csum_assoc csum_cong2 ordIso_symmetric)
20.249 -  also have "r1 +c r3 +c r2 +c r4 =o (r1 +c r3) +c (r2 +c r4)"
20.250 -    by (metis csum_assoc ordIso_symmetric)
20.251 -  finally show ?thesis .
20.252 -qed
20.253 -
20.254 -lemma Plus_csum: "|A <+> B| =o |A| +c |B|"
20.255 -by (simp only: csum_def Field_card_of card_of_refl)
20.256 -
20.257 -lemma Un_csum: "|A \<union> B| \<le>o |A| +c |B|"
20.258 -using ordLeq_ordIso_trans[OF card_of_Un_Plus_ordLeq Plus_csum] by blast
20.259 -
20.260 -
20.261 -subsection {* One *}
20.262 -
20.263 -definition cone where
20.264 -  "cone = card_of {()}"
20.265 -
20.266 -lemma Card_order_cone: "Card_order cone"
20.267 -unfolding cone_def by (rule card_of_Card_order)
20.268 -
20.269 -lemma Cfinite_cone: "Cfinite cone"
20.270 -  unfolding cfinite_def by (simp add: Card_order_cone)
20.271 -
20.272  lemma single_cone:
20.273    "|{x}| =o cone"
20.274  proof -
20.275 @@ -280,349 +27,37 @@
20.276    thus ?thesis unfolding cone_def using card_of_ordIso by blast
20.277  qed
20.278
20.279 -lemma cone_not_czero: "\<not> (cone =o czero)"
20.280 -unfolding czero_def cone_def by (metis empty_not_insert card_of_empty3[of "{()}"] ordIso_iff_ordLeq)
20.281 -
20.282  lemma cone_Cnotzero: "Cnotzero cone"
20.283  by (simp add: cone_not_czero Card_order_cone)
20.284
20.285 -lemma cone_ordLeq_Cnotzero: "Cnotzero r \<Longrightarrow> cone \<le>o r"
20.286 -unfolding cone_def by (metis Card_order_singl_ordLeq czeroI)
20.287 -
20.288 -
20.289 -subsection{* Two *}
20.290 -
20.291 -definition ctwo where
20.292 -  "ctwo = |UNIV :: bool set|"
20.293 -
20.294 -lemma Card_order_ctwo: "Card_order ctwo"
20.295 -unfolding ctwo_def by (rule card_of_Card_order)
20.296 -
20.297  lemma cone_ordLeq_ctwo: "cone \<le>o ctwo"
20.298  unfolding cone_def ctwo_def card_of_ordLeq[symmetric] by auto
20.299
20.300 -lemma ctwo_not_czero: "\<not> (ctwo =o czero)"
20.301 -using card_of_empty3[of "UNIV :: bool set"] ordIso_iff_ordLeq
20.302 -unfolding czero_def ctwo_def by (metis UNIV_not_empty)
20.303 -
20.304 -lemma ctwo_Cnotzero: "Cnotzero ctwo"
20.305 -by (simp add: ctwo_not_czero Card_order_ctwo)
20.306 -
20.307 -
20.308 -subsection {* Family sum *}
20.309 -
20.310 -definition Csum where
20.311 -  "Csum r rs \<equiv> |SIGMA i : Field r. Field (rs i)|"
20.312 -
20.313 -(* Similar setup to the one for SIGMA from theory Big_Operators: *)
20.314 -syntax "_Csum" ::
20.315 -  "pttrn => ('a * 'a) set => 'b * 'b set => (('a * 'b) * ('a * 'b)) set"
20.316 -  ("(3CSUM _:_. _)" [0, 51, 10] 10)
20.317 -
20.318 -translations
20.319 -  "CSUM i:r. rs" == "CONST Csum r (%i. rs)"
20.320 -
20.321 -lemma SIGMA_CSUM: "|SIGMA i : I. As i| = (CSUM i : |I|. |As i| )"
20.322 -by (auto simp: Csum_def Field_card_of)
20.323 -
20.324 -(* NB: Always, under the cardinal operator,
20.325 -operations on sets are reduced automatically to operations on cardinals.
20.326 -This should make cardinal reasoning more direct and natural.  *)
20.327 -
20.328
20.329  subsection {* Product *}
20.330
20.331 -definition cprod (infixr "*c" 80) where
20.332 -  "r1 *c r2 = |Field r1 <*> Field r2|"
20.333 -
20.334  lemma Times_cprod: "|A \<times> B| =o |A| *c |B|"
20.335  by (simp only: cprod_def Field_card_of card_of_refl)
20.336
20.337 -lemma card_order_cprod:
20.338 -  assumes "card_order r1" "card_order r2"
20.339 -  shows "card_order (r1 *c r2)"
20.340 -proof -
20.341 -  have "Field r1 = UNIV" "Field r2 = UNIV" using assms card_order_on_Card_order by auto
20.342 -  thus ?thesis by (auto simp: cprod_def card_of_card_order_on)
20.343 -qed
20.344 -
20.345 -lemma Card_order_cprod: "Card_order (r1 *c r2)"
20.346 -by (simp only: cprod_def Field_card_of card_of_card_order_on)
20.347 -
20.348  lemma cprod_cong2: "p2 =o r2 \<Longrightarrow> q *c p2 =o q *c r2"
20.349  by (simp only: cprod_def ordIso_Times_cong2)
20.350
20.351 -lemma cprod_mono1: "p1 \<le>o r1 \<Longrightarrow> p1 *c q \<le>o r1 *c q"
20.352 -by (simp only: cprod_def ordLeq_Times_mono1)
20.353 -
20.354 -lemma cprod_mono2: "p2 \<le>o r2 \<Longrightarrow> q *c p2 \<le>o q *c r2"
20.355 -by (simp only: cprod_def ordLeq_Times_mono2)
20.356 -
20.357  lemma ordLeq_cprod1: "\<lbrakk>Card_order p1; Cnotzero p2\<rbrakk> \<Longrightarrow> p1 \<le>o p1 *c p2"
20.358  unfolding cprod_def by (metis Card_order_Times1 czeroI)
20.359
20.360 -lemma ordLeq_cprod2: "\<lbrakk>Cnotzero p1; Card_order p2\<rbrakk> \<Longrightarrow> p2 \<le>o p1 *c p2"
20.361 -unfolding cprod_def by (metis Card_order_Times2 czeroI)
20.362 -
20.363 -lemma cinfinite_cprod: "\<lbrakk>cinfinite r1; cinfinite r2\<rbrakk> \<Longrightarrow> cinfinite (r1 *c r2)"
20.364 -by (simp add: cinfinite_def cprod_def Field_card_of infinite_cartesian_product)
20.365 -
20.366 -lemma cinfinite_cprod2: "\<lbrakk>Cnotzero r1; Cinfinite r2\<rbrakk> \<Longrightarrow> cinfinite (r1 *c r2)"
20.367 -by (metis cinfinite_mono ordLeq_cprod2)
20.368 -
20.369 -lemma Cinfinite_cprod2: "\<lbrakk>Cnotzero r1; Cinfinite r2\<rbrakk> \<Longrightarrow> Cinfinite (r1 *c r2)"
20.370 -by (blast intro: cinfinite_cprod2 Card_order_cprod)
20.371 -
20.372 -lemma cprod_com: "p1 *c p2 =o p2 *c p1"
20.373 -by (simp only: cprod_def card_of_Times_commute)
20.374 -
20.375 -lemma card_of_Csum_Times:
20.376 -  "\<forall>i \<in> I. |A i| \<le>o |B| \<Longrightarrow> (CSUM i : |I|. |A i| ) \<le>o |I| *c |B|"
20.377 -by (simp only: Csum_def cprod_def Field_card_of card_of_Sigma_Times)
20.378 -
20.379 -lemma card_of_Csum_Times':
20.380 -  assumes "Card_order r" "\<forall>i \<in> I. |A i| \<le>o r"
20.381 -  shows "(CSUM i : |I|. |A i| ) \<le>o |I| *c r"
20.382 -proof -
20.383 -  from assms(1) have *: "r =o |Field r|" by (simp add: card_of_unique)
20.384 -  with assms(2) have "\<forall>i \<in> I. |A i| \<le>o |Field r|" by (blast intro: ordLeq_ordIso_trans)
20.385 -  hence "(CSUM i : |I|. |A i| ) \<le>o |I| *c |Field r|" by (simp only: card_of_Csum_Times)
20.386 -  also from * have "|I| *c |Field r| \<le>o |I| *c r"
20.387 -    by (simp only: Field_card_of card_of_refl cprod_def ordIso_imp_ordLeq)
20.388 -  finally show ?thesis .
20.389 -qed
20.390 -
20.391 -lemma cprod_csum_distrib1: "r1 *c r2 +c r1 *c r3 =o r1 *c (r2 +c r3)"
20.392 -unfolding csum_def cprod_def by (simp add: Field_card_of card_of_Times_Plus_distrib ordIso_symmetric)
20.393 -
20.394 -lemma csum_absorb2': "\<lbrakk>Card_order r2; r1 \<le>o r2; cinfinite r1 \<or> cinfinite r2\<rbrakk> \<Longrightarrow> r1 +c r2 =o r2"
20.395 -unfolding csum_def by (metis Card_order_Plus_infinite cinfinite_def cinfinite_mono)
20.396 -
20.397 -lemma csum_absorb1':
20.398 -  assumes card: "Card_order r2"
20.399 -  and r12: "r1 \<le>o r2" and cr12: "cinfinite r1 \<or> cinfinite r2"
20.400 -  shows "r2 +c r1 =o r2"
20.401 -by (rule ordIso_transitive, rule csum_com, rule csum_absorb2', (simp only: assms)+)
20.402 -
20.403 -lemma csum_absorb1: "\<lbrakk>Cinfinite r2; r1 \<le>o r2\<rbrakk> \<Longrightarrow> r2 +c r1 =o r2"
20.404 -by (rule csum_absorb1') auto
20.405 -
20.406 -lemma cprod_infinite1': "\<lbrakk>Cinfinite r; Cnotzero p; p \<le>o r\<rbrakk> \<Longrightarrow> r *c p =o r"
20.407 -unfolding cinfinite_def cprod_def
20.408 -by (rule Card_order_Times_infinite[THEN conjunct1]) (blast intro: czeroI)+
20.409 -
20.410  lemma cprod_infinite: "Cinfinite r \<Longrightarrow> r *c r =o r"
20.411  using cprod_infinite1' Cinfinite_Cnotzero ordLeq_refl by blast
20.412
20.413
20.414  subsection {* Exponentiation *}
20.415
20.416 -definition cexp (infixr "^c" 90) where
20.417 -  "r1 ^c r2 \<equiv> |Func (Field r2) (Field r1)|"
20.418 -
20.419 -lemma card_order_cexp:
20.420 -  assumes "card_order r1" "card_order r2"
20.421 -  shows "card_order (r1 ^c r2)"
20.422 -proof -
20.423 -  have "Field r1 = UNIV" "Field r2 = UNIV" using assms card_order_on_Card_order by auto
20.424 -  thus ?thesis unfolding cexp_def Func_def by (simp add: card_of_card_order_on)
20.425 -qed
20.426 -
20.427 -lemma Card_order_cexp: "Card_order (r1 ^c r2)"
20.428 -unfolding cexp_def by (rule card_of_Card_order)
20.429 -
20.430 -lemma cexp_mono':
20.431 -  assumes 1: "p1 \<le>o r1" and 2: "p2 \<le>o r2"
20.432 -  and n: "Field p2 = {} \<Longrightarrow> Field r2 = {}"
20.433 -  shows "p1 ^c p2 \<le>o r1 ^c r2"
20.434 -proof(cases "Field p1 = {}")
20.435 -  case True
20.436 -  hence "|Field |Func (Field p2) (Field p1)|| \<le>o cone"
20.437 -    unfolding cone_def Field_card_of
20.438 -    by (cases "Field p2 = {}", auto intro: card_of_ordLeqI2 simp: Func_empty)
20.439 -       (metis Func_is_emp card_of_empty ex_in_conv)
20.440 -  hence "|Func (Field p2) (Field p1)| \<le>o cone" by (simp add: Field_card_of cexp_def)
20.441 -  hence "p1 ^c p2 \<le>o cone" unfolding cexp_def .
20.442 -  thus ?thesis
20.443 -  proof (cases "Field p2 = {}")
20.444 -    case True
20.445 -    with n have "Field r2 = {}" .
20.446 -    hence "cone \<le>o r1 ^c r2" unfolding cone_def cexp_def Func_def by (auto intro: card_of_ordLeqI)
20.447 -    thus ?thesis using p1 ^c p2 \<le>o cone ordLeq_transitive by auto
20.448 -  next
20.449 -    case False with True have "|Field (p1 ^c p2)| =o czero"
20.450 -      unfolding card_of_ordIso_czero_iff_empty cexp_def Field_card_of Func_def by auto
20.451 -    thus ?thesis unfolding cexp_def card_of_ordIso_czero_iff_empty Field_card_of
20.452 -      by (simp add: card_of_empty)
20.453 -  qed
20.454 -next
20.455 -  case False
20.456 -  have 1: "|Field p1| \<le>o |Field r1|" and 2: "|Field p2| \<le>o |Field r2|"
20.457 -    using 1 2 by (auto simp: card_of_mono2)
20.458 -  obtain f1 where f1: "f1  Field r1 = Field p1"
20.459 -    using 1 unfolding card_of_ordLeq2[OF False, symmetric] by auto
20.460 -  obtain f2 where f2: "inj_on f2 (Field p2)" "f2  Field p2 \<subseteq> Field r2"
20.461 -    using 2 unfolding card_of_ordLeq[symmetric] by blast
20.462 -  have 0: "Func_map (Field p2) f1 f2  (Field (r1 ^c r2)) = Field (p1 ^c p2)"
20.463 -    unfolding cexp_def Field_card_of using Func_map_surj[OF f1 f2 n, symmetric] .
20.464 -  have 00: "Field (p1 ^c p2) \<noteq> {}" unfolding cexp_def Field_card_of Func_is_emp
20.465 -    using False by simp
20.466 -  show ?thesis
20.467 -    using 0 card_of_ordLeq2[OF 00] unfolding cexp_def Field_card_of by blast
20.468 -qed
20.469 -
20.470 -lemma cexp_mono:
20.471 -  assumes 1: "p1 \<le>o r1" and 2: "p2 \<le>o r2"
20.472 -  and n: "p2 =o czero \<Longrightarrow> r2 =o czero" and card: "Card_order p2"
20.473 -  shows "p1 ^c p2 \<le>o r1 ^c r2"
20.474 -  by (metis (full_types) "1" "2" card cexp_mono' czeroE czeroI n)
20.475 -
20.476 -lemma cexp_mono1:
20.477 -  assumes 1: "p1 \<le>o r1" and q: "Card_order q"
20.478 -  shows "p1 ^c q \<le>o r1 ^c q"
20.479 -using ordLeq_refl[OF q] by (rule cexp_mono[OF 1]) (auto simp: q)
20.480 -
20.481 -lemma cexp_mono2':
20.482 -  assumes 2: "p2 \<le>o r2" and q: "Card_order q"
20.483 -  and n: "Field p2 = {} \<Longrightarrow> Field r2 = {}"
20.484 -  shows "q ^c p2 \<le>o q ^c r2"
20.485 -using ordLeq_refl[OF q] by (rule cexp_mono'[OF _ 2 n]) auto
20.486 -
20.487 -lemma cexp_mono2:
20.488 -  assumes 2: "p2 \<le>o r2" and q: "Card_order q"
20.489 -  and n: "p2 =o czero \<Longrightarrow> r2 =o czero" and card: "Card_order p2"
20.490 -  shows "q ^c p2 \<le>o q ^c r2"
20.491 -using ordLeq_refl[OF q] by (rule cexp_mono[OF _ 2 n card]) auto
20.492 -
20.493 -lemma cexp_mono2_Cnotzero:
20.494 -  assumes "p2 \<le>o r2" "Card_order q" "Cnotzero p2"
20.495 -  shows "q ^c p2 \<le>o q ^c r2"
20.496 -by (metis assms cexp_mono2' czeroI)
20.497 -
20.498 -lemma cexp_cong:
20.499 -  assumes 1: "p1 =o r1" and 2: "p2 =o r2"
20.500 -  and Cr: "Card_order r2"
20.501 -  and Cp: "Card_order p2"
20.502 -  shows "p1 ^c p2 =o r1 ^c r2"
20.503 -proof -
20.504 -  obtain f where "bij_betw f (Field p2) (Field r2)"
20.505 -    using 2 card_of_ordIso[of "Field p2" "Field r2"] card_of_cong by auto
20.506 -  hence 0: "Field p2 = {} \<longleftrightarrow> Field r2 = {}" unfolding bij_betw_def by auto
20.507 -  have r: "p2 =o czero \<Longrightarrow> r2 =o czero"
20.508 -    and p: "r2 =o czero \<Longrightarrow> p2 =o czero"
20.509 -     using 0 Cr Cp czeroE czeroI by auto
20.510 -  show ?thesis using 0 1 2 unfolding ordIso_iff_ordLeq
20.511 -    using r p cexp_mono[OF _ _ _ Cp] cexp_mono[OF _ _ _ Cr] by blast
20.512 -qed
20.513 -
20.514 -lemma cexp_cong1:
20.515 -  assumes 1: "p1 =o r1" and q: "Card_order q"
20.516 -  shows "p1 ^c q =o r1 ^c q"
20.517 -by (rule cexp_cong[OF 1 _ q q]) (rule ordIso_refl[OF q])
20.518 -
20.519 -lemma cexp_cong2:
20.520 -  assumes 2: "p2 =o r2" and q: "Card_order q" and p: "Card_order p2"
20.521 -  shows "q ^c p2 =o q ^c r2"
20.522 -by (rule cexp_cong[OF _ 2]) (auto simp only: ordIso_refl Card_order_ordIso2[OF p 2] q p)
20.523 -
20.524  lemma cexp_czero: "r ^c czero =o cone"
20.525  unfolding cexp_def czero_def Field_card_of Func_empty by (rule single_cone)
20.526
20.527 -lemma cexp_cone:
20.528 -  assumes "Card_order r"
20.529 -  shows "r ^c cone =o r"
20.530 -proof -
20.531 -  have "r ^c cone =o |Field r|"
20.532 -    unfolding cexp_def cone_def Field_card_of Func_empty
20.533 -      card_of_ordIso[symmetric] bij_betw_def Func_def inj_on_def image_def
20.534 -    by (rule exI[of _ "\<lambda>f. f ()"]) auto
20.535 -  also have "|Field r| =o r" by (rule card_of_Field_ordIso[OF assms])
20.536 -  finally show ?thesis .
20.537 -qed
20.538 -
20.539 -lemma cexp_cprod:
20.540 -  assumes r1: "Card_order r1"
20.541 -  shows "(r1 ^c r2) ^c r3 =o r1 ^c (r2 *c r3)" (is "?L =o ?R")
20.542 -proof -
20.543 -  have "?L =o r1 ^c (r3 *c r2)"
20.544 -    unfolding cprod_def cexp_def Field_card_of
20.545 -    using card_of_Func_Times by(rule ordIso_symmetric)
20.546 -  also have "r1 ^c (r3 *c r2) =o ?R"
20.547 -    apply(rule cexp_cong2) using cprod_com r1 by (auto simp: Card_order_cprod)
20.548 -  finally show ?thesis .
20.549 -qed
20.550 -
20.551 -lemma cexp_cprod_ordLeq:
20.552 -  assumes r1: "Card_order r1" and r2: "Cinfinite r2"
20.553 -  and r3: "Cnotzero r3" "r3 \<le>o r2"
20.554 -  shows "(r1 ^c r2) ^c r3 =o r1 ^c r2" (is "?L =o ?R")
20.555 -proof-
20.556 -  have "?L =o r1 ^c (r2 *c r3)" using cexp_cprod[OF r1] .
20.557 -  also have "r1 ^c (r2 *c r3) =o ?R"
20.558 -  apply(rule cexp_cong2)
20.559 -  apply(rule cprod_infinite1'[OF r2 r3]) using r1 r2 by (fastforce simp: Card_order_cprod)+
20.560 -  finally show ?thesis .
20.561 -qed
20.562 -
20.563 -lemma Cnotzero_UNIV: "Cnotzero |UNIV|"
20.564 -by (auto simp: card_of_Card_order card_of_ordIso_czero_iff_empty)
20.565 -
20.566  lemma Pow_cexp_ctwo:
20.567    "|Pow A| =o ctwo ^c |A|"
20.568  unfolding ctwo_def cexp_def Field_card_of by (rule card_of_Pow_Func)
20.569
20.570 -lemma ordLess_ctwo_cexp:
20.571 -  assumes "Card_order r"
20.572 -  shows "r <o ctwo ^c r"
20.573 -proof -
20.574 -  have "r <o |Pow (Field r)|" using assms by (rule Card_order_Pow)
20.575 -  also have "|Pow (Field r)| =o ctwo ^c r"
20.576 -    unfolding ctwo_def cexp_def Field_card_of by (rule card_of_Pow_Func)
20.577 -  finally show ?thesis .
20.578 -qed
20.579 -
20.580 -lemma ordLeq_cexp1:
20.581 -  assumes "Cnotzero r" "Card_order q"
20.582 -  shows "q \<le>o q ^c r"
20.583 -proof (cases "q =o (czero :: 'a rel)")
20.584 -  case True thus ?thesis by (simp only: card_of_empty cexp_def czero_def ordIso_ordLeq_trans)
20.585 -next
20.586 -  case False
20.587 -  thus ?thesis
20.588 -    apply -
20.589 -    apply (rule ordIso_ordLeq_trans)
20.590 -    apply (rule ordIso_symmetric)
20.591 -    apply (rule cexp_cone)
20.592 -    apply (rule assms(2))
20.593 -    apply (rule cexp_mono2)
20.594 -    apply (rule cone_ordLeq_Cnotzero)
20.595 -    apply (rule assms(1))
20.596 -    apply (rule assms(2))
20.597 -    apply (rule notE)
20.598 -    apply (rule cone_not_czero)
20.599 -    apply assumption
20.600 -    apply (rule Card_order_cone)
20.601 -  done
20.602 -qed
20.603 -
20.604 -lemma ordLeq_cexp2:
20.605 -  assumes "ctwo \<le>o q" "Card_order r"
20.606 -  shows "r \<le>o q ^c r"
20.607 -proof (cases "r =o (czero :: 'a rel)")
20.608 -  case True thus ?thesis by (simp only: card_of_empty cexp_def czero_def ordIso_ordLeq_trans)
20.609 -next
20.610 -  case False thus ?thesis
20.611 -    apply -
20.612 -    apply (rule ordLess_imp_ordLeq)
20.613 -    apply (rule ordLess_ordLeq_trans)
20.614 -    apply (rule ordLess_ctwo_cexp)
20.615 -    apply (rule assms(2))
20.616 -    apply (rule cexp_mono1)
20.617 -    apply (rule assms(1))
20.618 -    apply (rule assms(2))
20.619 -  done
20.620 -qed
20.621 -
20.622  lemma Cnotzero_cexp:
20.623    assumes "Cnotzero q" "Card_order r"
20.624    shows "Cnotzero (q ^c r)"
20.625 @@ -664,41 +99,7 @@
20.626  lemma Cinfinite_ctwo_cexp:
20.627    "Cinfinite r \<Longrightarrow> Cinfinite (ctwo ^c r)"
20.628  unfolding ctwo_def cexp_def cinfinite_def Field_card_of
20.629 -by (rule conjI, rule infinite_Func, auto, rule card_of_card_order_on)
20.630 -
20.631 -lemma cinfinite_cexp: "\<lbrakk>ctwo \<le>o q; Cinfinite r\<rbrakk> \<Longrightarrow> cinfinite (q ^c r)"
20.632 -by (metis assms cinfinite_mono ordLeq_cexp2)
20.633 -
20.634 -lemma Cinfinite_cexp:
20.635 -  "\<lbrakk>ctwo \<le>o q; Cinfinite r\<rbrakk> \<Longrightarrow> Cinfinite (q ^c r)"
20.636 -by (simp add: cinfinite_cexp Card_order_cexp)
20.637 -
20.638 -lemma ctwo_ordLess_natLeq:
20.639 -  "ctwo <o natLeq"
20.640 -unfolding ctwo_def using finite_iff_ordLess_natLeq finite_UNIV by fast
20.641 -
20.642 -lemma ctwo_ordLess_Cinfinite: "Cinfinite r \<Longrightarrow> ctwo <o r"
20.643 -by (metis ctwo_ordLess_natLeq natLeq_ordLeq_cinfinite ordLess_ordLeq_trans)
20.644 -
20.645 -lemma ctwo_ordLeq_Cinfinite:
20.646 -  assumes "Cinfinite r"
20.647 -  shows "ctwo \<le>o r"
20.648 -by (rule ordLess_imp_ordLeq[OF ctwo_ordLess_Cinfinite[OF assms]])
20.649 -
20.650 -lemma Cinfinite_ordLess_cexp:
20.651 -  assumes r: "Cinfinite r"
20.652 -  shows "r <o r ^c r"
20.653 -proof -
20.654 -  have "r <o ctwo ^c r" using r by (simp only: ordLess_ctwo_cexp)
20.655 -  also have "ctwo ^c r \<le>o r ^c r"
20.656 -    by (rule cexp_mono1[OF ctwo_ordLeq_Cinfinite]) (auto simp: r ctwo_not_czero Card_order_ctwo)
20.657 -  finally show ?thesis .
20.658 -qed
20.659 -
20.660 -lemma infinite_ordLeq_cexp:
20.661 -  assumes "Cinfinite r"
20.662 -  shows "r \<le>o r ^c r"
20.663 -by (rule ordLess_imp_ordLeq[OF Cinfinite_ordLess_cexp[OF assms]])
20.664 +by (rule conjI, rule infinite_Func, auto)
20.665
20.666  lemma cone_ordLeq_iff_Field:
20.667    assumes "cone \<le>o r"
20.668 @@ -731,22 +132,6 @@
20.669    case False thus ?thesis using assms cexp_mono2' czeroI by metis
20.670  qed
20.671
20.672 -lemma Un_Cinfinite_bound: "\<lbrakk>|A| \<le>o r; |B| \<le>o r; Cinfinite r\<rbrakk> \<Longrightarrow> |A \<union> B| \<le>o r"
20.673 -by (auto simp add: cinfinite_def card_of_Un_ordLeq_infinite_Field)
20.674 -
20.675 -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"
20.676 -by (auto simp add: card_of_UNION_ordLeq_infinite_Field cinfinite_def)
20.677 -
20.678 -lemma csum_cinfinite_bound:
20.679 -  assumes "p \<le>o r" "q \<le>o r" "Card_order p" "Card_order q" "Cinfinite r"
20.680 -  shows "p +c q \<le>o r"
20.681 -proof -
20.682 -  from assms(1-4) have "|Field p| \<le>o r" "|Field q| \<le>o r"
20.683 -    unfolding card_order_on_def using card_of_least ordLeq_transitive by blast+
20.684 -  with assms show ?thesis unfolding cinfinite_def csum_def
20.685 -    by (blast intro: card_of_Plus_ordLeq_infinite_Field)
20.686 -qed
20.687 -
20.688  lemma csum_cexp: "\<lbrakk>Cinfinite r1; Cinfinite r2; Card_order q; ctwo \<le>o q\<rbrakk> \<Longrightarrow>
20.689    q ^c r1 +c q ^c r2 \<le>o q ^c (r1 +c r2)"
20.690  apply (rule csum_cinfinite_bound)
20.691 @@ -782,131 +167,30 @@
20.692    apply blast+
20.693  by (metis Cinfinite_cexp)
20.694
20.695 -lemma cprod_cinfinite_bound:
20.696 -  assumes "p \<le>o r" "q \<le>o r" "Card_order p" "Card_order q" "Cinfinite r"
20.697 -  shows "p *c q \<le>o r"
20.698 -proof -
20.699 -  from assms(1-4) have "|Field p| \<le>o r" "|Field q| \<le>o r"
20.700 -    unfolding card_order_on_def using card_of_least ordLeq_transitive by blast+
20.701 -  with assms show ?thesis unfolding cinfinite_def cprod_def
20.702 -    by (blast intro: card_of_Times_ordLeq_infinite_Field)
20.703 -qed
20.704 -
20.705 -lemma cprod_csum_cexp:
20.706 -  "r1 *c r2 \<le>o (r1 +c r2) ^c ctwo"
20.707 -unfolding cprod_def csum_def cexp_def ctwo_def Field_card_of
20.708 -proof -
20.709 -  let ?f = "\<lambda>(a, b). %x. if x then Inl a else Inr b"
20.710 -  have "inj_on ?f (Field r1 \<times> Field r2)" (is "inj_on _ ?LHS")
20.711 -    by (auto simp: inj_on_def fun_eq_iff split: bool.split)
20.712 -  moreover
20.713 -  have "?f  ?LHS \<subseteq> Func (UNIV :: bool set) (Field r1 <+> Field r2)" (is "_ \<subseteq> ?RHS")
20.714 -    by (auto simp: Func_def)
20.715 -  ultimately show "|?LHS| \<le>o |?RHS|" using card_of_ordLeq by blast
20.716 -qed
20.717 -
20.718 -lemma Cfinite_cprod_Cinfinite: "\<lbrakk>Cfinite r; Cinfinite s\<rbrakk> \<Longrightarrow> r *c s \<le>o s"
20.719 -by (intro cprod_cinfinite_bound)
20.720 -  (auto intro: ordLeq_refl ordLess_imp_ordLeq[OF Cfinite_ordLess_Cinfinite])
20.721 -
20.722 -lemma cprod_cexp: "(r *c s) ^c t =o r ^c t *c s ^c t"
20.723 -  unfolding cprod_def cexp_def Field_card_of by (rule Func_Times_Range)
20.724 -
20.725 -lemma cprod_cexp_csum_cexp_Cinfinite:
20.726 -  assumes t: "Cinfinite t"
20.727 -  shows "(r *c s) ^c t \<le>o (r +c s) ^c t"
20.728 -proof -
20.729 -  have "(r *c s) ^c t \<le>o ((r +c s) ^c ctwo) ^c t"
20.730 -    by (rule cexp_mono1[OF cprod_csum_cexp conjunct2[OF t]])
20.731 -  also have "((r +c s) ^c ctwo) ^c t =o (r +c s) ^c (ctwo *c t)"
20.732 -    by (rule cexp_cprod[OF Card_order_csum])
20.733 -  also have "(r +c s) ^c (ctwo *c t) =o (r +c s) ^c (t *c ctwo)"
20.734 -    by (rule cexp_cong2[OF cprod_com Card_order_csum Card_order_cprod])
20.735 -  also have "(r +c s) ^c (t *c ctwo) =o ((r +c s) ^c t) ^c ctwo"
20.736 -    by (rule ordIso_symmetric[OF cexp_cprod[OF Card_order_csum]])
20.737 -  also have "((r +c s) ^c t) ^c ctwo =o (r +c s) ^c t"
20.738 -    by (rule cexp_cprod_ordLeq[OF Card_order_csum t ctwo_Cnotzero ctwo_ordLeq_Cinfinite[OF t]])
20.739 -  finally show ?thesis .
20.740 -qed
20.741 -
20.742 -lemma Cfinite_cexp_Cinfinite:
20.743 -  assumes s: "Cfinite s" and t: "Cinfinite t"
20.744 -  shows "s ^c t \<le>o ctwo ^c t"
20.745 -proof (cases "s \<le>o ctwo")
20.746 -  case True thus ?thesis using t by (blast intro: cexp_mono1)
20.747 -next
20.748 -  case False
20.749 -  hence "ctwo \<le>o s" by (metis card_order_on_well_order_on ctwo_Cnotzero ordLeq_total s)
20.750 -  hence "Cnotzero s" by (metis Cnotzero_mono ctwo_Cnotzero s)
20.751 -  hence st: "Cnotzero (s *c t)" by (metis Cinfinite_cprod2 cinfinite_not_czero t)
20.752 -  have "s ^c t \<le>o (ctwo ^c s) ^c t"
20.753 -    using assms by (blast intro: cexp_mono1 ordLess_imp_ordLeq[OF ordLess_ctwo_cexp])
20.754 -  also have "(ctwo ^c s) ^c t =o ctwo ^c (s *c t)"
20.755 -    by (blast intro: Card_order_ctwo cexp_cprod)
20.756 -  also have "ctwo ^c (s *c t) \<le>o ctwo ^c t"
20.757 -    using assms st by (intro cexp_mono2_Cnotzero Cfinite_cprod_Cinfinite Card_order_ctwo)
20.758 -  finally show ?thesis .
20.759 -qed
20.760 -
20.761 -lemma csum_Cfinite_cexp_Cinfinite:
20.762 -  assumes r: "Card_order r" and s: "Cfinite s" and t: "Cinfinite t"
20.763 -  shows "(r +c s) ^c t \<le>o (r +c ctwo) ^c t"
20.764 -proof (cases "Cinfinite r")
20.765 -  case True
20.766 -  hence "r +c s =o r" by (intro csum_absorb1 ordLess_imp_ordLeq[OF Cfinite_ordLess_Cinfinite] s)
20.767 -  hence "(r +c s) ^c t =o r ^c t" using t by (blast intro: cexp_cong1)
20.768 -  also have "r ^c t \<le>o (r +c ctwo) ^c t" using t by (blast intro: cexp_mono1 ordLeq_csum1 r)
20.769 -  finally show ?thesis .
20.770 -next
20.771 -  case False
20.772 -  with r have "Cfinite r" unfolding cinfinite_def cfinite_def by auto
20.773 -  hence "Cfinite (r +c s)" by (intro Cfinite_csum s)
20.774 -  hence "(r +c s) ^c t \<le>o ctwo ^c t" by (intro Cfinite_cexp_Cinfinite t)
20.775 -  also have "ctwo ^c t \<le>o (r +c ctwo) ^c t" using t
20.776 -    by (blast intro: cexp_mono1 ordLeq_csum2 Card_order_ctwo)
20.777 -  finally show ?thesis .
20.778 -qed
20.779 -
20.780  lemma card_of_Sigma_ordLeq_Cinfinite:
20.781    "\<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"
20.782  unfolding cinfinite_def by (blast intro: card_of_Sigma_ordLeq_infinite_Field)
20.783
20.784
20.785 -(* cardSuc *)
20.786 -
20.787 -lemma Cinfinite_cardSuc: "Cinfinite r \<Longrightarrow> Cinfinite (cardSuc r)"
20.788 -by (simp add: cinfinite_def cardSuc_Card_order cardSuc_finite)
20.789 -
20.790 -lemma cardSuc_UNION_Cinfinite:
20.791 -  assumes "Cinfinite r" "relChain (cardSuc r) As" "B \<le> (UN i : Field (cardSuc r). As i)" "|B| <=o r"
20.792 -  shows "EX i : Field (cardSuc r). B \<le> As i"
20.793 -using cardSuc_UNION assms unfolding cinfinite_def by blast
20.794 -
20.795  subsection {* Powerset *}
20.796
20.797 -definition cpow where "cpow r = |Pow (Field r)|"
20.798 -
20.799 -lemma card_order_cpow: "card_order r \<Longrightarrow> card_order (cpow r)"
20.800 -by (simp only: cpow_def Field_card_order Pow_UNIV card_of_card_order_on)
20.801 -
20.802 -lemma cpow_greater_eq: "Card_order r \<Longrightarrow> r \<le>o cpow r"
20.803 -by (rule ordLess_imp_ordLeq) (simp only: cpow_def Card_order_Pow)
20.804 -
20.805  lemma Card_order_cpow: "Card_order (cpow r)"
20.806  unfolding cpow_def by (rule card_of_Card_order)
20.807
20.808 -lemma Cinfinite_cpow: "Cinfinite r \<Longrightarrow> Cinfinite (cpow r)"
20.809 -unfolding cpow_def cinfinite_def by (metis Field_card_of card_of_Card_order infinite_Pow)
20.810 -
20.811  lemma cardSuc_ordLeq_cpow: "Card_order r \<Longrightarrow> cardSuc r \<le>o cpow r"
20.812  unfolding cpow_def by (metis Card_order_Pow cardSuc_ordLess_ordLeq card_of_Card_order)
20.813
20.814  lemma cpow_cexp_ctwo: "cpow r =o ctwo ^c r"
20.815  unfolding cpow_def ctwo_def cexp_def Field_card_of by (rule card_of_Pow_Func)
20.816
20.817 +
20.818  subsection {* Lists *}
20.819
20.820 -definition clists where "clists r = |lists (Field r)|"
20.821 +text {*
20.822 +  The following collection of lemmas should be seen as an user interface to the HOL theory
20.823 +  of cardinals. It is not expected to be complete in any sense, since its
20.824 +  development was driven by demand arising from the development of the (co)datatype package.
20.825 +*}
20.826
20.827  lemma clists_Cinfinite: "Cinfinite r \<Longrightarrow> clists r =o r"
20.828  unfolding cinfinite_def clists_def by (blast intro: Card_order_lists_infinite)
20.829 @@ -915,6 +199,6 @@
20.830  unfolding clists_def by (rule card_of_Card_order)
20.831
20.832  lemma Cnotzero_clists: "Cnotzero (clists r)"
20.833 -by (simp add: clists_def card_of_ordIso_czero_iff_empty lists_not_empty) (rule card_of_Card_order)
20.834 +by (simp add: clists_def card_of_ordIso_czero_iff_empty lists_not_empty)
20.835
20.836  end

    21.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
21.2 +++ b/src/HOL/Cardinals/Cardinal_Arithmetic_FP.thy	Tue Nov 19 17:07:52 2013 +0100
21.3 @@ -0,0 +1,747 @@
21.4 +(*  Title:      HOL/Cardinals/Cardinal_Arithmetic_FP.thy
21.5 +    Author:     Dmitriy Traytel, TU Muenchen
21.6 +    Copyright   2012
21.7 +
21.8 +Cardinal arithmetic (FP).
21.9 +*)
21.10 +
21.11 +header {* Cardinal Arithmetic (FP) *}
21.12 +
21.13 +theory Cardinal_Arithmetic_FP
21.14 +imports Cardinal_Order_Relation_FP
21.15 +begin
21.16 +
21.17 +(*library candidate*)
21.18 +lemma dir_image: "\<lbrakk>\<And>x y. (f x = f y) = (x = y); Card_order r\<rbrakk> \<Longrightarrow> r =o dir_image r f"
21.19 +by (rule dir_image_ordIso) (auto simp add: inj_on_def card_order_on_def)
21.20 +
21.21 +(*should supersede a weaker lemma from the library*)
21.22 +lemma dir_image_Field: "Field (dir_image r f) = f  Field r"
21.23 +unfolding dir_image_def Field_def Range_def Domain_def by fast
21.24 +
21.25 +lemma card_order_dir_image:
21.26 +  assumes bij: "bij f" and co: "card_order r"
21.27 +  shows "card_order (dir_image r f)"
21.28 +proof -
21.29 +  from assms have "Field (dir_image r f) = UNIV"
21.30 +    using card_order_on_Card_order[of UNIV r] unfolding bij_def dir_image_Field by auto
21.31 +  moreover from bij have "\<And>x y. (f x = f y) = (x = y)" unfolding bij_def inj_on_def by auto
21.32 +  with co have "Card_order (dir_image r f)"
21.33 +    using card_order_on_Card_order[of UNIV r] Card_order_ordIso2[OF _ dir_image] by blast
21.34 +  ultimately show ?thesis by auto
21.35 +qed
21.36 +
21.37 +(*library candidate*)
21.38 +lemma ordIso_refl: "Card_order r \<Longrightarrow> r =o r"
21.39 +by (rule card_order_on_ordIso)
21.40 +
21.41 +(*library candidate*)
21.42 +lemma ordLeq_refl: "Card_order r \<Longrightarrow> r \<le>o r"
21.43 +by (rule ordIso_imp_ordLeq, rule card_order_on_ordIso)
21.44 +
21.45 +(*library candidate*)
21.46 +lemma card_of_ordIso_subst: "A = B \<Longrightarrow> |A| =o |B|"
21.47 +by (simp only: ordIso_refl card_of_Card_order)
21.48 +
21.49 +(*library candidate*)
21.50 +lemma Field_card_order: "card_order r \<Longrightarrow> Field r = UNIV"
21.51 +using card_order_on_Card_order[of UNIV r] by simp
21.52 +
21.53 +(*library candidate*)
21.54 +lemma card_of_Times_Plus_distrib:
21.55 +  "|A <*> (B <+> C)| =o |A <*> B <+> A <*> C|" (is "|?RHS| =o |?LHS|")
21.56 +proof -
21.57 +  let ?f = "\<lambda>(a, bc). case bc of Inl b \<Rightarrow> Inl (a, b) | Inr c \<Rightarrow> Inr (a, c)"
21.58 +  have "bij_betw ?f ?RHS ?LHS" unfolding bij_betw_def inj_on_def by force
21.59 +  thus ?thesis using card_of_ordIso by blast
21.60 +qed
21.61 +
21.62 +(*library candidate*)
21.63 +lemma Func_Times_Range:
21.64 +  "|Func A (B <*> C)| =o |Func A B <*> Func A C|" (is "|?LHS| =o |?RHS|")
21.65 +proof -
21.66 +  let ?F = "\<lambda>fg. (\<lambda>x. if x \<in> A then fst (fg x) else undefined,
21.67 +                  \<lambda>x. if x \<in> A then snd (fg x) else undefined)"
21.68 +  let ?G = "\<lambda>(f, g) x. if x \<in> A then (f x, g x) else undefined"
21.69 +  have "bij_betw ?F ?LHS ?RHS" unfolding bij_betw_def inj_on_def
21.70 +  apply safe
21.71 +     apply (simp add: Func_def fun_eq_iff)
21.72 +     apply (metis (no_types) pair_collapse)
21.73 +    apply (auto simp: Func_def fun_eq_iff)[2]
21.74 +  proof -
21.75 +    fix f g assume "f \<in> Func A B" "g \<in> Func A C"
21.76 +    thus "(f, g) \<in> ?F  Func A (B \<times> C)"
21.77 +      by (intro image_eqI[of _ _ "?G (f, g)"]) (auto simp: Func_def)
21.78 +  qed
21.79 +  thus ?thesis using card_of_ordIso by blast
21.80 +qed
21.81 +
21.82 +
21.83 +subsection {* Zero *}
21.84 +
21.85 +definition czero where
21.86 +  "czero = card_of {}"
21.87 +
21.88 +lemma czero_ordIso:
21.89 +  "czero =o czero"
21.90 +using card_of_empty_ordIso by (simp add: czero_def)
21.91 +
21.92 +lemma card_of_ordIso_czero_iff_empty:
21.93 +  "|A| =o (czero :: 'b rel) \<longleftrightarrow> A = ({} :: 'a set)"
21.94 +unfolding czero_def by (rule iffI[OF card_of_empty2]) (auto simp: card_of_refl card_of_empty_ordIso)
21.95 +
21.96 +(* A "not czero" Cardinal predicate *)
21.97 +abbreviation Cnotzero where
21.98 +  "Cnotzero (r :: 'a rel) \<equiv> \<not>(r =o (czero :: 'a rel)) \<and> Card_order r"
21.99 +
21.100 +(*helper*)
21.101 +lemma Cnotzero_imp_not_empty: "Cnotzero r \<Longrightarrow> Field r \<noteq> {}"
21.102 +by (metis Card_order_iff_ordIso_card_of czero_def)
21.103 +
21.104 +lemma czeroI:
21.105 +  "\<lbrakk>Card_order r; Field r = {}\<rbrakk> \<Longrightarrow> r =o czero"
21.106 +using Cnotzero_imp_not_empty ordIso_transitive[OF _ czero_ordIso] by blast
21.107 +
21.108 +lemma czeroE:
21.109 +  "r =o czero \<Longrightarrow> Field r = {}"
21.110 +unfolding czero_def
21.111 +by (drule card_of_cong) (simp only: Field_card_of card_of_empty2)
21.112 +
21.113 +lemma Cnotzero_mono:
21.114 +  "\<lbrakk>Cnotzero r; Card_order q; r \<le>o q\<rbrakk> \<Longrightarrow> Cnotzero q"
21.115 +apply (rule ccontr)
21.116 +apply auto
21.117 +apply (drule czeroE)
21.118 +apply (erule notE)
21.119 +apply (erule czeroI)
21.120 +apply (drule card_of_mono2)
21.121 +apply (simp only: card_of_empty3)
21.122 +done
21.123 +
21.124 +subsection {* (In)finite cardinals *}
21.125 +
21.126 +definition cinfinite where
21.127 +  "cinfinite r = infinite (Field r)"
21.128 +
21.129 +abbreviation Cinfinite where
21.130 +  "Cinfinite r \<equiv> cinfinite r \<and> Card_order r"
21.131 +
21.132 +definition cfinite where
21.133 +  "cfinite r = finite (Field r)"
21.134 +
21.135 +abbreviation Cfinite where
21.136 +  "Cfinite r \<equiv> cfinite r \<and> Card_order r"
21.137 +
21.138 +lemma Cfinite_ordLess_Cinfinite: "\<lbrakk>Cfinite r; Cinfinite s\<rbrakk> \<Longrightarrow> r <o s"
21.139 +  unfolding cfinite_def cinfinite_def
21.140 +  by (metis card_order_on_well_order_on finite_ordLess_infinite)
21.141 +
21.142 +lemma natLeq_ordLeq_cinfinite:
21.143 +  assumes inf: "Cinfinite r"
21.144 +  shows "natLeq \<le>o r"
21.145 +proof -
21.146 +  from inf have "natLeq \<le>o |Field r|" by (simp add: cinfinite_def infinite_iff_natLeq_ordLeq)
21.147 +  also from inf have "|Field r| =o r" by (simp add: card_of_unique ordIso_symmetric)
21.148 +  finally show ?thesis .
21.149 +qed
21.150 +
21.151 +lemma cinfinite_not_czero: "cinfinite r \<Longrightarrow> \<not> (r =o (czero :: 'a rel))"
21.152 +unfolding cinfinite_def by (metis czeroE finite.emptyI)
21.153 +
21.154 +lemma Cinfinite_Cnotzero: "Cinfinite r \<Longrightarrow> Cnotzero r"
21.155 +by (metis cinfinite_not_czero)
21.156 +
21.157 +lemma Cinfinite_cong: "\<lbrakk>r1 =o r2; Cinfinite r1\<rbrakk> \<Longrightarrow> Cinfinite r2"
21.158 +by (metis Card_order_ordIso2 card_of_mono2 card_of_ordLeq_infinite cinfinite_def ordIso_iff_ordLeq)
21.159 +
21.160 +lemma cinfinite_mono: "\<lbrakk>r1 \<le>o r2; cinfinite r1\<rbrakk> \<Longrightarrow> cinfinite r2"
21.161 +by (metis card_of_mono2 card_of_ordLeq_infinite cinfinite_def)
21.162 +
21.163 +
21.164 +subsection {* Binary sum *}
21.165 +
21.166 +definition csum (infixr "+c" 65) where
21.167 +  "r1 +c r2 \<equiv> |Field r1 <+> Field r2|"
21.168 +
21.169 +lemma Field_csum: "Field (r +c s) = Inl  Field r \<union> Inr  Field s"
21.170 +  unfolding csum_def Field_card_of by auto
21.171 +
21.172 +lemma Card_order_csum:
21.173 +  "Card_order (r1 +c r2)"
21.174 +unfolding csum_def by (simp add: card_of_Card_order)
21.175 +
21.176 +lemma csum_Cnotzero1:
21.177 +  "Cnotzero r1 \<Longrightarrow> Cnotzero (r1 +c r2)"
21.178 +unfolding csum_def
21.179 +by (metis Cnotzero_imp_not_empty Plus_eq_empty_conv card_of_Card_order card_of_ordIso_czero_iff_empty)
21.180 +
21.181 +lemma card_order_csum:
21.182 +  assumes "card_order r1" "card_order r2"
21.183 +  shows "card_order (r1 +c r2)"
21.184 +proof -
21.185 +  have "Field r1 = UNIV" "Field r2 = UNIV" using assms card_order_on_Card_order by auto
21.186 +  thus ?thesis unfolding csum_def by (auto simp: card_of_card_order_on)
21.187 +qed
21.188 +
21.189 +lemma cinfinite_csum:
21.190 +  "cinfinite r1 \<or> cinfinite r2 \<Longrightarrow> cinfinite (r1 +c r2)"
21.191 +unfolding cinfinite_def csum_def by (auto simp: Field_card_of)
21.192 +
21.193 +lemma Cinfinite_csum1:
21.194 +  "Cinfinite r1 \<Longrightarrow> Cinfinite (r1 +c r2)"
21.195 +unfolding cinfinite_def csum_def by (metis Field_card_of card_of_Card_order finite_Plus_iff)
21.196 +
21.197 +lemma Cinfinite_csum:
21.198 +  "Cinfinite r1 \<or> Cinfinite r2 \<Longrightarrow> Cinfinite (r1 +c r2)"
21.199 +unfolding cinfinite_def csum_def by (metis Field_card_of card_of_Card_order finite_Plus_iff)
21.200 +
21.201 +lemma Cinfinite_csum_strong:
21.202 +  "\<lbrakk>Cinfinite r1; Cinfinite r2\<rbrakk> \<Longrightarrow> Cinfinite (r1 +c r2)"
21.203 +by (metis Cinfinite_csum)
21.204 +
21.205 +lemma csum_cong: "\<lbrakk>p1 =o r1; p2 =o r2\<rbrakk> \<Longrightarrow> p1 +c p2 =o r1 +c r2"
21.206 +by (simp only: csum_def ordIso_Plus_cong)
21.207 +
21.208 +lemma csum_cong1: "p1 =o r1 \<Longrightarrow> p1 +c q =o r1 +c q"
21.209 +by (simp only: csum_def ordIso_Plus_cong1)
21.210 +
21.211 +lemma csum_cong2: "p2 =o r2 \<Longrightarrow> q +c p2 =o q +c r2"
21.212 +by (simp only: csum_def ordIso_Plus_cong2)
21.213 +
21.214 +lemma csum_mono: "\<lbrakk>p1 \<le>o r1; p2 \<le>o r2\<rbrakk> \<Longrightarrow> p1 +c p2 \<le>o r1 +c r2"
21.215 +by (simp only: csum_def ordLeq_Plus_mono)
21.216 +
21.217 +lemma csum_mono1: "p1 \<le>o r1 \<Longrightarrow> p1 +c q \<le>o r1 +c q"
21.218 +by (simp only: csum_def ordLeq_Plus_mono1)
21.219 +
21.220 +lemma csum_mono2: "p2 \<le>o r2 \<Longrightarrow> q +c p2 \<le>o q +c r2"
21.221 +by (simp only: csum_def ordLeq_Plus_mono2)
21.222 +
21.223 +lemma ordLeq_csum1: "Card_order p1 \<Longrightarrow> p1 \<le>o p1 +c p2"
21.224 +by (simp only: csum_def Card_order_Plus1)
21.225 +
21.226 +lemma ordLeq_csum2: "Card_order p2 \<Longrightarrow> p2 \<le>o p1 +c p2"
21.227 +by (simp only: csum_def Card_order_Plus2)
21.228 +
21.229 +lemma csum_com: "p1 +c p2 =o p2 +c p1"
21.230 +by (simp only: csum_def card_of_Plus_commute)
21.231 +
21.232 +lemma csum_assoc: "(p1 +c p2) +c p3 =o p1 +c p2 +c p3"
21.233 +by (simp only: csum_def Field_card_of card_of_Plus_assoc)
21.234 +
21.235 +lemma Cfinite_csum: "\<lbrakk>Cfinite r; Cfinite s\<rbrakk> \<Longrightarrow> Cfinite (r +c s)"
21.236 +  unfolding cfinite_def csum_def Field_card_of using card_of_card_order_on by simp
21.237 +
21.238 +lemma csum_csum: "(r1 +c r2) +c (r3 +c r4) =o (r1 +c r3) +c (r2 +c r4)"
21.239 +proof -
21.240 +  have "(r1 +c r2) +c (r3 +c r4) =o r1 +c r2 +c (r3 +c r4)"
21.241 +    by (metis csum_assoc)
21.242 +  also have "r1 +c r2 +c (r3 +c r4) =o r1 +c (r2 +c r3) +c r4"
21.243 +    by (metis csum_assoc csum_cong2 ordIso_symmetric)
21.244 +  also have "r1 +c (r2 +c r3) +c r4 =o r1 +c (r3 +c r2) +c r4"
21.245 +    by (metis csum_com csum_cong1 csum_cong2)
21.246 +  also have "r1 +c (r3 +c r2) +c r4 =o r1 +c r3 +c r2 +c r4"
21.247 +    by (metis csum_assoc csum_cong2 ordIso_symmetric)
21.248 +  also have "r1 +c r3 +c r2 +c r4 =o (r1 +c r3) +c (r2 +c r4)"
21.249 +    by (metis csum_assoc ordIso_symmetric)
21.250 +  finally show ?thesis .
21.251 +qed
21.252 +
21.253 +lemma Plus_csum: "|A <+> B| =o |A| +c |B|"
21.254 +by (simp only: csum_def Field_card_of card_of_refl)
21.255 +
21.256 +lemma Un_csum: "|A \<union> B| \<le>o |A| +c |B|"
21.257 +using ordLeq_ordIso_trans[OF card_of_Un_Plus_ordLeq Plus_csum] by blast
21.258 +
21.259 +
21.260 +subsection {* One *}
21.261 +
21.262 +definition cone where
21.263 +  "cone = card_of {()}"
21.264 +
21.265 +lemma Card_order_cone: "Card_order cone"
21.266 +unfolding cone_def by (rule card_of_Card_order)
21.267 +
21.268 +lemma Cfinite_cone: "Cfinite cone"
21.269 +  unfolding cfinite_def by (simp add: Card_order_cone)
21.270 +
21.271 +lemma cone_not_czero: "\<not> (cone =o czero)"
21.272 +unfolding czero_def cone_def by (metis empty_not_insert card_of_empty3[of "{()}"] ordIso_iff_ordLeq)
21.273 +
21.274 +lemma cone_ordLeq_Cnotzero: "Cnotzero r \<Longrightarrow> cone \<le>o r"
21.275 +unfolding cone_def by (metis Card_order_singl_ordLeq czeroI)
21.276 +
21.277 +
21.278 +subsection{* Two *}
21.279 +
21.280 +definition ctwo where
21.281 +  "ctwo = |UNIV :: bool set|"
21.282 +
21.283 +lemma Card_order_ctwo: "Card_order ctwo"
21.284 +unfolding ctwo_def by (rule card_of_Card_order)
21.285 +
21.286 +lemma ctwo_not_czero: "\<not> (ctwo =o czero)"
21.287 +using card_of_empty3[of "UNIV :: bool set"] ordIso_iff_ordLeq
21.288 +unfolding czero_def ctwo_def by (metis UNIV_not_empty)
21.289 +
21.290 +lemma ctwo_Cnotzero: "Cnotzero ctwo"
21.291 +by (simp add: ctwo_not_czero Card_order_ctwo)
21.292 +
21.293 +
21.294 +subsection {* Family sum *}
21.295 +
21.296 +definition Csum where
21.297 +  "Csum r rs \<equiv> |SIGMA i : Field r. Field (rs i)|"
21.298 +
21.299 +(* Similar setup to the one for SIGMA from theory Big_Operators: *)
21.300 +syntax "_Csum" ::
21.301 +  "pttrn => ('a * 'a) set => 'b * 'b set => (('a * 'b) * ('a * 'b)) set"
21.302 +  ("(3CSUM _:_. _)" [0, 51, 10] 10)
21.303 +
21.304 +translations
21.305 +  "CSUM i:r. rs" == "CONST Csum r (%i. rs)"
21.306 +
21.307 +lemma SIGMA_CSUM: "|SIGMA i : I. As i| = (CSUM i : |I|. |As i| )"
21.308 +by (auto simp: Csum_def Field_card_of)
21.309 +
21.310 +(* NB: Always, under the cardinal operator,
21.311 +operations on sets are reduced automatically to operations on cardinals.
21.312 +This should make cardinal reasoning more direct and natural.  *)
21.313 +
21.314 +
21.315 +subsection {* Product *}
21.316 +
21.317 +definition cprod (infixr "*c" 80) where
21.318 +  "r1 *c r2 = |Field r1 <*> Field r2|"
21.319 +
21.320 +lemma card_order_cprod:
21.321 +  assumes "card_order r1" "card_order r2"
21.322 +  shows "card_order (r1 *c r2)"
21.323 +proof -
21.324 +  have "Field r1 = UNIV" "Field r2 = UNIV" using assms card_order_on_Card_order by auto
21.325 +  thus ?thesis by (auto simp: cprod_def card_of_card_order_on)
21.326 +qed
21.327 +
21.328 +lemma Card_order_cprod: "Card_order (r1 *c r2)"
21.329 +by (simp only: cprod_def Field_card_of card_of_card_order_on)
21.330 +
21.331 +lemma cprod_mono1: "p1 \<le>o r1 \<Longrightarrow> p1 *c q \<le>o r1 *c q"
21.332 +by (simp only: cprod_def ordLeq_Times_mono1)
21.333 +
21.334 +lemma cprod_mono2: "p2 \<le>o r2 \<Longrightarrow> q *c p2 \<le>o q *c r2"
21.335 +by (simp only: cprod_def ordLeq_Times_mono2)
21.336 +
21.337 +lemma ordLeq_cprod2: "\<lbrakk>Cnotzero p1; Card_order p2\<rbrakk> \<Longrightarrow> p2 \<le>o p1 *c p2"
21.338 +unfolding cprod_def by (metis Card_order_Times2 czeroI)
21.339 +
21.340 +lemma cinfinite_cprod: "\<lbrakk>cinfinite r1; cinfinite r2\<rbrakk> \<Longrightarrow> cinfinite (r1 *c r2)"
21.341 +by (simp add: cinfinite_def cprod_def Field_card_of infinite_cartesian_product)
21.342 +
21.343 +lemma cinfinite_cprod2: "\<lbrakk>Cnotzero r1; Cinfinite r2\<rbrakk> \<Longrightarrow> cinfinite (r1 *c r2)"
21.344 +by (metis cinfinite_mono ordLeq_cprod2)
21.345 +
21.346 +lemma Cinfinite_cprod2: "\<lbrakk>Cnotzero r1; Cinfinite r2\<rbrakk> \<Longrightarrow> Cinfinite (r1 *c r2)"
21.347 +by (blast intro: cinfinite_cprod2 Card_order_cprod)
21.348 +
21.349 +lemma cprod_com: "p1 *c p2 =o p2 *c p1"
21.350 +by (simp only: cprod_def card_of_Times_commute)
21.351 +
21.352 +lemma card_of_Csum_Times:
21.353 +  "\<forall>i \<in> I. |A i| \<le>o |B| \<Longrightarrow> (CSUM i : |I|. |A i| ) \<le>o |I| *c |B|"
21.354 +by (simp only: Csum_def cprod_def Field_card_of card_of_Sigma_Times)
21.355 +
21.356 +lemma card_of_Csum_Times':
21.357 +  assumes "Card_order r" "\<forall>i \<in> I. |A i| \<le>o r"
21.358 +  shows "(CSUM i : |I|. |A i| ) \<le>o |I| *c r"
21.359 +proof -
21.360 +  from assms(1) have *: "r =o |Field r|" by (simp add: card_of_unique)
21.361 +  with assms(2) have "\<forall>i \<in> I. |A i| \<le>o |Field r|" by (blast intro: ordLeq_ordIso_trans)
21.362 +  hence "(CSUM i : |I|. |A i| ) \<le>o |I| *c |Field r|" by (simp only: card_of_Csum_Times)
21.363 +  also from * have "|I| *c |Field r| \<le>o |I| *c r"
21.364 +    by (simp only: Field_card_of card_of_refl cprod_def ordIso_imp_ordLeq)
21.365 +  finally show ?thesis .
21.366 +qed
21.367 +
21.368 +lemma cprod_csum_distrib1: "r1 *c r2 +c r1 *c r3 =o r1 *c (r2 +c r3)"
21.369 +unfolding csum_def cprod_def by (simp add: Field_card_of card_of_Times_Plus_distrib ordIso_symmetric)
21.370 +
21.371 +lemma csum_absorb2': "\<lbrakk>Card_order r2; r1 \<le>o r2; cinfinite r1 \<or> cinfinite r2\<rbrakk> \<Longrightarrow> r1 +c r2 =o r2"
21.372 +unfolding csum_def by (metis Card_order_Plus_infinite cinfinite_def cinfinite_mono)
21.373 +
21.374 +lemma csum_absorb1':
21.375 +  assumes card: "Card_order r2"
21.376 +  and r12: "r1 \<le>o r2" and cr12: "cinfinite r1 \<or> cinfinite r2"
21.377 +  shows "r2 +c r1 =o r2"
21.378 +by (rule ordIso_transitive, rule csum_com, rule csum_absorb2', (simp only: assms)+)
21.379 +
21.380 +lemma csum_absorb1: "\<lbrakk>Cinfinite r2; r1 \<le>o r2\<rbrakk> \<Longrightarrow> r2 +c r1 =o r2"
21.381 +by (rule csum_absorb1') auto
21.382 +
21.383 +
21.384 +subsection {* Exponentiation *}
21.385 +
21.386 +definition cexp (infixr "^c" 90) where
21.387 +  "r1 ^c r2 \<equiv> |Func (Field r2) (Field r1)|"
21.388 +
21.389 +lemma Card_order_cexp: "Card_order (r1 ^c r2)"
21.390 +unfolding cexp_def by (rule card_of_Card_order)
21.391 +
21.392 +lemma cexp_mono':
21.393 +  assumes 1: "p1 \<le>o r1" and 2: "p2 \<le>o r2"
21.394 +  and n: "Field p2 = {} \<Longrightarrow> Field r2 = {}"
21.395 +  shows "p1 ^c p2 \<le>o r1 ^c r2"
21.396 +proof(cases "Field p1 = {}")
21.397 +  case True
21.398 +  hence "|Field |Func (Field p2) (Field p1)|| \<le>o cone"
21.399 +    unfolding cone_def Field_card_of
21.400 +    by (cases "Field p2 = {}", auto intro: card_of_ordLeqI2 simp: Func_empty)
21.401 +       (metis Func_is_emp card_of_empty ex_in_conv)
21.402 +  hence "|Func (Field p2) (Field p1)| \<le>o cone" by (simp add: Field_card_of cexp_def)
21.403 +  hence "p1 ^c p2 \<le>o cone" unfolding cexp_def .
21.404 +  thus ?thesis
21.405 +  proof (cases "Field p2 = {}")
21.406 +    case True
21.407 +    with n have "Field r2 = {}" .
21.408 +    hence "cone \<le>o r1 ^c r2" unfolding cone_def cexp_def Func_def by (auto intro: card_of_ordLeqI)
21.409 +    thus ?thesis using p1 ^c p2 \<le>o cone ordLeq_transitive by auto
21.410 +  next
21.411 +    case False with True have "|Field (p1 ^c p2)| =o czero"
21.412 +      unfolding card_of_ordIso_czero_iff_empty cexp_def Field_card_of Func_def by auto
21.413 +    thus ?thesis unfolding cexp_def card_of_ordIso_czero_iff_empty Field_card_of
21.414 +      by (simp add: card_of_empty)
21.415 +  qed
21.416 +next
21.417 +  case False
21.418 +  have 1: "|Field p1| \<le>o |Field r1|" and 2: "|Field p2| \<le>o |Field r2|"
21.419 +    using 1 2 by (auto simp: card_of_mono2)
21.420 +  obtain f1 where f1: "f1  Field r1 = Field p1"
21.421 +    using 1 unfolding card_of_ordLeq2[OF False, symmetric] by auto
21.422 +  obtain f2 where f2: "inj_on f2 (Field p2)" "f2  Field p2 \<subseteq> Field r2"
21.423 +    using 2 unfolding card_of_ordLeq[symmetric] by blast
21.424 +  have 0: "Func_map (Field p2) f1 f2  (Field (r1 ^c r2)) = Field (p1 ^c p2)"
21.425 +    unfolding cexp_def Field_card_of using Func_map_surj[OF f1 f2 n, symmetric] .
21.426 +  have 00: "Field (p1 ^c p2) \<noteq> {}" unfolding cexp_def Field_card_of Func_is_emp
21.427 +    using False by simp
21.428 +  show ?thesis
21.429 +    using 0 card_of_ordLeq2[OF 00] unfolding cexp_def Field_card_of by blast
21.430 +qed
21.431 +
21.432 +lemma cexp_mono:
21.433 +  assumes 1: "p1 \<le>o r1" and 2: "p2 \<le>o r2"
21.434 +  and n: "p2 =o czero \<Longrightarrow> r2 =o czero" and card: "Card_order p2"
21.435 +  shows "p1 ^c p2 \<le>o r1 ^c r2"
21.436 +  by (metis (full_types) "1" "2" card cexp_mono' czeroE czeroI n)
21.437 +
21.438 +lemma cexp_mono1:
21.439 +  assumes 1: "p1 \<le>o r1" and q: "Card_order q"
21.440 +  shows "p1 ^c q \<le>o r1 ^c q"
21.441 +using ordLeq_refl[OF q] by (rule cexp_mono[OF 1]) (auto simp: q)
21.442 +
21.443 +lemma cexp_mono2':
21.444 +  assumes 2: "p2 \<le>o r2" and q: "Card_order q"
21.445 +  and n: "Field p2 = {} \<Longrightarrow> Field r2 = {}"
21.446 +  shows "q ^c p2 \<le>o q ^c r2"
21.447 +using ordLeq_refl[OF q] by (rule cexp_mono'[OF _ 2 n]) auto
21.448 +
21.449 +lemma cexp_mono2:
21.450 +  assumes 2: "p2 \<le>o r2" and q: "Card_order q"
21.451 +  and n: "p2 =o czero \<Longrightarrow> r2 =o czero" and card: "Card_order p2"
21.452 +  shows "q ^c p2 \<le>o q ^c r2"
21.453 +using ordLeq_refl[OF q] by (rule cexp_mono[OF _ 2 n card]) auto
21.454 +
21.455 +lemma cexp_mono2_Cnotzero:
21.456 +  assumes "p2 \<le>o r2" "Card_order q" "Cnotzero p2"
21.457 +  shows "q ^c p2 \<le>o q ^c r2"
21.458 +by (metis assms cexp_mono2' czeroI)
21.459 +
21.460 +lemma cexp_cong:
21.461 +  assumes 1: "p1 =o r1" and 2: "p2 =o r2"
21.462 +  and Cr: "Card_order r2"
21.463 +  and Cp: "Card_order p2"
21.464 +  shows "p1 ^c p2 =o r1 ^c r2"
21.465 +proof -
21.466 +  obtain f where "bij_betw f (Field p2) (Field r2)"
21.467 +    using 2 card_of_ordIso[of "Field p2" "Field r2"] card_of_cong by auto
21.468 +  hence 0: "Field p2 = {} \<longleftrightarrow> Field r2 = {}" unfolding bij_betw_def by auto
21.469 +  have r: "p2 =o czero \<Longrightarrow> r2 =o czero"
21.470 +    and p: "r2 =o czero \<Longrightarrow> p2 =o czero"
21.471 +     using 0 Cr Cp czeroE czeroI by auto
21.472 +  show ?thesis using 0 1 2 unfolding ordIso_iff_ordLeq
21.473 +    using r p cexp_mono[OF _ _ _ Cp] cexp_mono[OF _ _ _ Cr] by metis
21.474 +qed
21.475 +
21.476 +lemma cexp_cong1:
21.477 +  assumes 1: "p1 =o r1" and q: "Card_order q"
21.478 +  shows "p1 ^c q =o r1 ^c q"
21.479 +by (rule cexp_cong[OF 1 _ q q]) (rule ordIso_refl[OF q])
21.480 +
21.481 +lemma cexp_cong2:
21.482 +  assumes 2: "p2 =o r2" and q: "Card_order q" and p: "Card_order p2"
21.483 +  shows "q ^c p2 =o q ^c r2"
21.484 +by (rule cexp_cong[OF _ 2]) (auto simp only: ordIso_refl Card_order_ordIso2[OF p 2] q p)
21.485 +
21.486 +lemma cexp_cone:
21.487 +  assumes "Card_order r"
21.488 +  shows "r ^c cone =o r"
21.489 +proof -
21.490 +  have "r ^c cone =o |Field r|"
21.491 +    unfolding cexp_def cone_def Field_card_of Func_empty
21.492 +      card_of_ordIso[symmetric] bij_betw_def Func_def inj_on_def image_def
21.493 +    by (rule exI[of _ "\<lambda>f. f ()"]) auto
21.494 +  also have "|Field r| =o r" by (rule card_of_Field_ordIso[OF assms])
21.495 +  finally show ?thesis .
21.496 +qed
21.497 +
21.498 +lemma cexp_cprod:
21.499 +  assumes r1: "Card_order r1"
21.500 +  shows "(r1 ^c r2) ^c r3 =o r1 ^c (r2 *c r3)" (is "?L =o ?R")
21.501 +proof -
21.502 +  have "?L =o r1 ^c (r3 *c r2)"
21.503 +    unfolding cprod_def cexp_def Field_card_of
21.504 +    using card_of_Func_Times by(rule ordIso_symmetric)
21.505 +  also have "r1 ^c (r3 *c r2) =o ?R"
21.506 +    apply(rule cexp_cong2) using cprod_com r1 by (auto simp: Card_order_cprod)
21.507 +  finally show ?thesis .
21.508 +qed
21.509 +
21.510 +lemma cprod_infinite1': "\<lbrakk>Cinfinite r; Cnotzero p; p \<le>o r\<rbrakk> \<Longrightarrow> r *c p =o r"
21.511 +unfolding cinfinite_def cprod_def
21.512 +by (rule Card_order_Times_infinite[THEN conjunct1]) (blast intro: czeroI)+
21.513 +
21.514 +lemma cexp_cprod_ordLeq:
21.515 +  assumes r1: "Card_order r1" and r2: "Cinfinite r2"
21.516 +  and r3: "Cnotzero r3" "r3 \<le>o r2"
21.517 +  shows "(r1 ^c r2) ^c r3 =o r1 ^c r2" (is "?L =o ?R")
21.518 +proof-
21.519 +  have "?L =o r1 ^c (r2 *c r3)" using cexp_cprod[OF r1] .
21.520 +  also have "r1 ^c (r2 *c r3) =o ?R"
21.521 +  apply(rule cexp_cong2)
21.522 +  apply(rule cprod_infinite1'[OF r2 r3]) using r1 r2 by (fastforce simp: Card_order_cprod)+
21.523 +  finally show ?thesis .
21.524 +qed
21.525 +
21.526 +lemma Cnotzero_UNIV: "Cnotzero |UNIV|"
21.527 +by (auto simp: card_of_Card_order card_of_ordIso_czero_iff_empty)
21.528 +
21.529 +lemma ordLess_ctwo_cexp:
21.530 +  assumes "Card_order r"
21.531 +  shows "r <o ctwo ^c r"
21.532 +proof -
21.533 +  have "r <o |Pow (Field r)|" using assms by (rule Card_order_Pow)
21.534 +  also have "|Pow (Field r)| =o ctwo ^c r"
21.535 +    unfolding ctwo_def cexp_def Field_card_of by (rule card_of_Pow_Func)
21.536 +  finally show ?thesis .
21.537 +qed
21.538 +
21.539 +lemma ordLeq_cexp1:
21.540 +  assumes "Cnotzero r" "Card_order q"
21.541 +  shows "q \<le>o q ^c r"
21.542 +proof (cases "q =o (czero :: 'a rel)")
21.543 +  case True thus ?thesis by (simp only: card_of_empty cexp_def czero_def ordIso_ordLeq_trans)
21.544 +next
21.545 +  case False
21.546 +  thus ?thesis
21.547 +    apply -
21.548 +    apply (rule ordIso_ordLeq_trans)
21.549 +    apply (rule ordIso_symmetric)
21.550 +    apply (rule cexp_cone)
21.551 +    apply (rule assms(2))
21.552 +    apply (rule cexp_mono2)
21.553 +    apply (rule cone_ordLeq_Cnotzero)
21.554 +    apply (rule assms(1))
21.555 +    apply (rule assms(2))
21.556 +    apply (rule notE)
21.557 +    apply (rule cone_not_czero)
21.558 +    apply assumption
21.559 +    apply (rule Card_order_cone)
21.560 +  done
21.561 +qed
21.562 +
21.563 +lemma ordLeq_cexp2:
21.564 +  assumes "ctwo \<le>o q" "Card_order r"
21.565 +  shows "r \<le>o q ^c r"
21.566 +proof (cases "r =o (czero :: 'a rel)")
21.567 +  case True thus ?thesis by (simp only: card_of_empty cexp_def czero_def ordIso_ordLeq_trans)
21.568 +next
21.569 +  case False thus ?thesis
21.570 +    apply -
21.571 +    apply (rule ordLess_imp_ordLeq)
21.572 +    apply (rule ordLess_ordLeq_trans)
21.573 +    apply (rule ordLess_ctwo_cexp)
21.574 +    apply (rule assms(2))
21.575 +    apply (rule cexp_mono1)
21.576 +    apply (rule assms(1))
21.577 +    apply (rule assms(2))
21.578 +  done
21.579 +qed
21.580 +
21.581 +lemma cinfinite_cexp: "\<lbrakk>ctwo \<le>o q; Cinfinite r\<rbrakk> \<Longrightarrow> cinfinite (q ^c r)"
21.582 +by (metis assms cinfinite_mono ordLeq_cexp2)
21.583 +
21.584 +lemma Cinfinite_cexp:
21.585 +  "\<lbrakk>ctwo \<le>o q; Cinfinite r\<rbrakk> \<Longrightarrow> Cinfinite (q ^c r)"
21.586 +by (simp add: cinfinite_cexp Card_order_cexp)
21.587 +
21.588 +lemma ctwo_ordLess_natLeq: "ctwo <o natLeq"
21.589 +unfolding ctwo_def using finite_iff_ordLess_natLeq finite_UNIV by fast
21.590 +
21.591 +lemma ctwo_ordLess_Cinfinite: "Cinfinite r \<Longrightarrow> ctwo <o r"
21.592 +by (metis ctwo_ordLess_natLeq natLeq_ordLeq_cinfinite ordLess_ordLeq_trans)
21.593 +
21.594 +lemma ctwo_ordLeq_Cinfinite:
21.595 +  assumes "Cinfinite r"
21.596 +  shows "ctwo \<le>o r"
21.597 +by (rule ordLess_imp_ordLeq[OF ctwo_ordLess_Cinfinite[OF assms]])
21.598 +
21.599 +lemma Un_Cinfinite_bound: "\<lbrakk>|A| \<le>o r; |B| \<le>o r; Cinfinite r\<rbrakk> \<Longrightarrow> |A \<union> B| \<le>o r"
21.600 +by (auto simp add: cinfinite_def card_of_Un_ordLeq_infinite_Field)
21.601 +
21.602 +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"
21.603 +by (auto simp add: card_of_UNION_ordLeq_infinite_Field cinfinite_def)
21.604 +
21.605 +lemma csum_cinfinite_bound:
21.606 +  assumes "p \<le>o r" "q \<le>o r" "Card_order p" "Card_order q" "Cinfinite r"
21.607 +  shows "p +c q \<le>o r"
21.608 +proof -
21.609 +  from assms(1-4) have "|Field p| \<le>o r" "|Field q| \<le>o r"
21.610 +    unfolding card_order_on_def using card_of_least ordLeq_transitive by blast+
21.611 +  with assms show ?thesis unfolding cinfinite_def csum_def
21.612 +    by (blast intro: card_of_Plus_ordLeq_infinite_Field)
21.613 +qed
21.614 +
21.615 +lemma cprod_cinfinite_bound:
21.616 +  assumes "p \<le>o r" "q \<le>o r" "Card_order p" "Card_order q" "Cinfinite r"
21.617 +  shows "p *c q \<le>o r"
21.618 +proof -
21.619 +  from assms(1-4) have "|Field p| \<le>o r" "|Field q| \<le>o r"
21.620 +    unfolding card_order_on_def using card_of_least ordLeq_transitive by blast+
21.621 +  with assms show ?thesis unfolding cinfinite_def cprod_def
21.622 +    by (blast intro: card_of_Times_ordLeq_infinite_Field)
21.623 +qed
21.624 +
21.625 +lemma cprod_csum_cexp:
21.626 +  "r1 *c r2 \<le>o (r1 +c r2) ^c ctwo"
21.627 +unfolding cprod_def csum_def cexp_def ctwo_def Field_card_of
21.628 +proof -
21.629 +  let ?f = "\<lambda>(a, b). %x. if x then Inl a else Inr b"
21.630 +  have "inj_on ?f (Field r1 \<times> Field r2)" (is "inj_on _ ?LHS")
21.631 +    by (auto simp: inj_on_def fun_eq_iff split: bool.split)
21.632 +  moreover
21.633 +  have "?f  ?LHS \<subseteq> Func (UNIV :: bool set) (Field r1 <+> Field r2)" (is "_ \<subseteq> ?RHS")
21.634 +    by (auto simp: Func_def)
21.635 +  ultimately show "|?LHS| \<le>o |?RHS|" using card_of_ordLeq by blast
21.636 +qed
21.637 +
21.638 +lemma Cfinite_cprod_Cinfinite: "\<lbrakk>Cfinite r; Cinfinite s\<rbrakk> \<Longrightarrow> r *c s \<le>o s"
21.639 +by (intro cprod_cinfinite_bound)
21.640 +  (auto intro: ordLeq_refl ordLess_imp_ordLeq[OF Cfinite_ordLess_Cinfinite])
21.641 +
21.642 +lemma cprod_cexp: "(r *c s) ^c t =o r ^c t *c s ^c t"
21.643 +  unfolding cprod_def cexp_def Field_card_of by (rule Func_Times_Range)
21.644 +
21.645 +lemma cprod_cexp_csum_cexp_Cinfinite:
21.646 +  assumes t: "Cinfinite t"
21.647 +  shows "(r *c s) ^c t \<le>o (r +c s) ^c t"
21.648 +proof -
21.649 +  have "(r *c s) ^c t \<le>o ((r +c s) ^c ctwo) ^c t"
21.650 +    by (rule cexp_mono1[OF cprod_csum_cexp conjunct2[OF t]])
21.651 +  also have "((r +c s) ^c ctwo) ^c t =o (r +c s) ^c (ctwo *c t)"
21.652 +    by (rule cexp_cprod[OF Card_order_csum])
21.653 +  also have "(r +c s) ^c (ctwo *c t) =o (r +c s) ^c (t *c ctwo)"
21.654 +    by (rule cexp_cong2[OF cprod_com Card_order_csum Card_order_cprod])
21.655 +  also have "(r +c s) ^c (t *c ctwo) =o ((r +c s) ^c t) ^c ctwo"
21.656 +    by (rule ordIso_symmetric[OF cexp_cprod[OF Card_order_csum]])
21.657 +  also have "((r +c s) ^c t) ^c ctwo =o (r +c s) ^c t"
21.658 +    by (rule cexp_cprod_ordLeq[OF Card_order_csum t ctwo_Cnotzero ctwo_ordLeq_Cinfinite[OF t]])
21.659 +  finally show ?thesis .
21.660 +qed
21.661 +
21.662 +lemma Cfinite_cexp_Cinfinite:
21.663 +  assumes s: "Cfinite s" and t: "Cinfinite t"
21.664 +  shows "s ^c t \<le>o ctwo ^c t"
21.665 +proof (cases "s \<le>o ctwo")
21.666 +  case True thus ?thesis using t by (blast intro: cexp_mono1)
21.667 +next
21.668 +  case False
21.669 +  hence "ctwo \<le>o s" by (metis card_order_on_well_order_on ctwo_Cnotzero ordLeq_total s)
21.670 +  hence "Cnotzero s" by (metis Cnotzero_mono ctwo_Cnotzero s)
21.671 +  hence st: "Cnotzero (s *c t)" by (metis Cinfinite_cprod2 cinfinite_not_czero t)
21.672 +  have "s ^c t \<le>o (ctwo ^c s) ^c t"
21.673 +    using assms by (blast intro: cexp_mono1 ordLess_imp_ordLeq[OF ordLess_ctwo_cexp])
21.674 +  also have "(ctwo ^c s) ^c t =o ctwo ^c (s *c t)"
21.675 +    by (blast intro: Card_order_ctwo cexp_cprod)
21.676 +  also have "ctwo ^c (s *c t) \<le>o ctwo ^c t"
21.677 +    using assms st by (intro cexp_mono2_Cnotzero Cfinite_cprod_Cinfinite Card_order_ctwo)
21.678 +  finally show ?thesis .
21.679 +qed
21.680 +
21.681 +lemma csum_Cfinite_cexp_Cinfinite:
21.682 +  assumes r: "Card_order r" and s: "Cfinite s" and t: "Cinfinite t"
21.683 +  shows "(r +c s) ^c t \<le>o (r +c ctwo) ^c t"
21.684 +proof (cases "Cinfinite r")
21.685 +  case True
21.686 +  hence "r +c s =o r" by (intro csum_absorb1 ordLess_imp_ordLeq[OF Cfinite_ordLess_Cinfinite] s)
21.687 +  hence "(r +c s) ^c t =o r ^c t" using t by (blast intro: cexp_cong1)
21.688 +  also have "r ^c t \<le>o (r +c ctwo) ^c t" using t by (blast intro: cexp_mono1 ordLeq_csum1 r)
21.689 +  finally show ?thesis .
21.690 +next
21.691 +  case False
21.692 +  with r have "Cfinite r" unfolding cinfinite_def cfinite_def by auto
21.693 +  hence "Cfinite (r +c s)" by (intro Cfinite_csum s)
21.694 +  hence "(r +c s) ^c t \<le>o ctwo ^c t" by (intro Cfinite_cexp_Cinfinite t)
21.695 +  also have "ctwo ^c t \<le>o (r +c ctwo) ^c t" using t
21.696 +    by (blast intro: cexp_mono1 ordLeq_csum2 Card_order_ctwo)
21.697 +  finally show ?thesis .
21.698 +qed
21.699 +
21.700 +lemma card_order_cexp:
21.701 +  assumes "card_order r1" "card_order r2"
21.702 +  shows "card_order (r1 ^c r2)"
21.703 +proof -
21.704 +  have "Field r1 = UNIV" "Field r2 = UNIV" using assms card_order_on_Card_order by auto
21.705 +  thus ?thesis unfolding cexp_def Func_def by (simp add: card_of_card_order_on)
21.706 +qed
21.707 +
21.708 +lemma Cinfinite_ordLess_cexp:
21.709 +  assumes r: "Cinfinite r"
21.710 +  shows "r <o r ^c r"
21.711 +proof -
21.712 +  have "r <o ctwo ^c r" using r by (simp only: ordLess_ctwo_cexp)
21.713 +  also have "ctwo ^c r \<le>o r ^c r"
21.714 +    by (rule cexp_mono1[OF ctwo_ordLeq_Cinfinite]) (auto simp: r ctwo_not_czero Card_order_ctwo)
21.715 +  finally show ?thesis .
21.716 +qed
21.717 +
21.718 +lemma infinite_ordLeq_cexp:
21.719 +  assumes "Cinfinite r"
21.720 +  shows "r \<le>o r ^c r"
21.721 +by (rule ordLess_imp_ordLeq[OF Cinfinite_ordLess_cexp[OF assms]])
21.722 +
21.723 +(* cardSuc *)
21.724 +
21.725 +lemma Cinfinite_cardSuc: "Cinfinite r \<Longrightarrow> Cinfinite (cardSuc r)"
21.726 +by (simp add: cinfinite_def cardSuc_Card_order cardSuc_finite)
21.727 +
21.728 +lemma cardSuc_UNION_Cinfinite:
21.729 +  assumes "Cinfinite r" "relChain (cardSuc r) As" "B \<le> (UN i : Field (cardSuc r). As i)" "|B| <=o r"
21.730 +  shows "EX i : Field (cardSuc r). B \<le> As i"
21.731 +using cardSuc_UNION assms unfolding cinfinite_def by blast
21.732 +
21.733 +subsection {* Powerset *}
21.734 +
21.735 +definition cpow where "cpow r = |Pow (Field r)|"
21.736 +
21.737 +lemma card_order_cpow: "card_order r \<Longrightarrow> card_order (cpow r)"
21.738 +by (simp only: cpow_def Field_card_order Pow_UNIV card_of_card_order_on)
21.739 +
21.740 +lemma cpow_greater_eq: "Card_order r \<Longrightarrow> r \<le>o cpow r"
21.741 +by (rule ordLess_imp_ordLeq) (simp only: cpow_def Card_order_Pow)
21.742 +
21.743 +lemma Cinfinite_cpow: "Cinfinite r \<Longrightarrow> Cinfinite (cpow r)"
21.744 +unfolding cpow_def cinfinite_def by (metis Field_card_of card_of_Card_order infinite_Pow)
21.745 +
21.746 +subsection {* Lists *}
21.747 +
21.748 +definition clists where "clists r = |lists (Field r)|"
21.749 +
21.750 +end

    22.1 --- a/src/HOL/Cardinals/Cardinal_Order_Relation.thy	Mon Nov 18 17:15:01 2013 +0100
22.2 +++ b/src/HOL/Cardinals/Cardinal_Order_Relation.thy	Tue Nov 19 17:07:52 2013 +0100
22.3 @@ -8,7 +8,7 @@
22.4  header {* Cardinal-Order Relations *}
22.5
22.6  theory Cardinal_Order_Relation
22.7 -imports Cardinal_Order_Relation_Base Constructions_on_Wellorders
22.8 +imports Cardinal_Order_Relation_FP Constructions_on_Wellorders
22.9  begin
22.10
22.11  declare
22.12 @@ -34,7 +34,6 @@
22.13    Card_order_singl_ordLeq[simp]
22.14    card_of_Pow[simp]
22.15    Card_order_Pow[simp]
22.16 -  card_of_set_type[simp]
22.17    card_of_Plus1[simp]
22.18    Card_order_Plus1[simp]
22.19    card_of_Plus2[simp]
22.20 @@ -44,25 +43,19 @@
22.21    card_of_Plus_mono[simp]
22.22    card_of_Plus_cong2[simp]
22.23    card_of_Plus_cong[simp]
22.24 -  card_of_Un1[simp]
22.25 -  card_of_diff[simp]
22.26    card_of_Un_Plus_ordLeq[simp]
22.27    card_of_Times1[simp]
22.28    card_of_Times2[simp]
22.29    card_of_Times3[simp]
22.30    card_of_Times_mono1[simp]
22.31    card_of_Times_mono2[simp]
22.32 -  card_of_Times_cong1[simp]
22.33 -  card_of_Times_cong2[simp]
22.34    card_of_ordIso_finite[simp]
22.35 -  finite_ordLess_infinite2[simp]
22.36    card_of_Times_same_infinite[simp]
22.37    card_of_Times_infinite_simps[simp]
22.38    card_of_Plus_infinite1[simp]
22.39    card_of_Plus_infinite2[simp]
22.40    card_of_Plus_ordLess_infinite[simp]
22.41    card_of_Plus_ordLess_infinite_Field[simp]
22.42 -  card_of_lists_infinite[simp]
22.43    infinite_cartesian_product[simp]
22.44    cardSuc_Card_order[simp]
22.45    cardSuc_greater[simp]
22.46 @@ -143,6 +136,17 @@
22.47
22.48  subsection {* Cardinals versus set operations on arbitrary sets *}
22.49
22.50 +lemma card_of_set_type[simp]: "|UNIV::'a set| <o |UNIV::'a set set|"
22.51 +using card_of_Pow[of "UNIV::'a set"] by simp
22.52 +
22.53 +lemma card_of_Un1[simp]:
22.54 +shows "|A| \<le>o |A \<union> B| "
22.55 +using inj_on_id[of A] card_of_ordLeq[of A _] by fastforce
22.56 +
22.57 +lemma card_of_diff[simp]:
22.58 +shows "|A - B| \<le>o |A|"
22.59 +using inj_on_id[of "A - B"] card_of_ordLeq[of "A - B" _] by fastforce
22.60 +
22.61  lemma subset_ordLeq_strict:
22.62  assumes "A \<le> B" and "|A| <o |B|"
22.63  shows "A < B"
22.64 @@ -307,6 +311,16 @@
22.65  using card_of_Times3 card_of_Field_ordIso
22.66        ordIso_ordLeq_trans ordIso_symmetric by blast
22.67
22.68 +lemma card_of_Times_cong1[simp]:
22.69 +assumes "|A| =o |B|"
22.70 +shows "|A \<times> C| =o |B \<times> C|"
22.71 +using assms by (simp add: ordIso_iff_ordLeq card_of_Times_mono1)
22.72 +
22.73 +lemma card_of_Times_cong2[simp]:
22.74 +assumes "|A| =o |B|"
22.75 +shows "|C \<times> A| =o |C \<times> B|"
22.76 +using assms by (simp add: ordIso_iff_ordLeq card_of_Times_mono2)
22.77 +
22.78  lemma card_of_Times_mono[simp]:
22.79  assumes "|A| \<le>o |B|" and "|C| \<le>o |D|"
22.80  shows "|A \<times> C| \<le>o |B \<times> D|"
22.81 @@ -323,6 +337,11 @@
22.82  shows "|(Field r) \<times> C| =o |(Field r') \<times> C|"
22.83  using assms card_of_cong card_of_Times_cong1 by blast
22.84
22.85 +corollary ordIso_Times_cong2:
22.86 +assumes "r =o r'"
22.87 +shows "|A \<times> (Field r)| =o |A \<times> (Field r')|"
22.88 +using assms card_of_cong card_of_Times_cong2 by blast
22.89 +
22.90  lemma card_of_Times_cong[simp]:
22.91  assumes "|A| =o |B|" and "|C| =o |D|"
22.92  shows "|A \<times> C| =o |B \<times> D|"
22.93 @@ -501,11 +520,55 @@
22.94  using assms Plus_infinite_bij_betw[of "UNIV::'a set" g "UNIV::'b set"]
22.95  by auto
22.96
22.97 +lemma card_of_Un_infinite:
22.98 +assumes INF: "infinite A" and LEQ: "|B| \<le>o |A|"
22.99 +shows "|A \<union> B| =o |A| \<and> |B \<union> A| =o |A|"
22.100 +proof-
22.101 +  have "|A \<union> B| \<le>o |A <+> B|" by (rule card_of_Un_Plus_ordLeq)
22.102 +  moreover have "|A <+> B| =o |A|"
22.103 +  using assms by (metis card_of_Plus_infinite)
22.104 +  ultimately have "|A \<union> B| \<le>o |A|" using ordLeq_ordIso_trans by blast
22.105 +  hence "|A \<union> B| =o |A|" using card_of_Un1 ordIso_iff_ordLeq by blast
22.106 +  thus ?thesis using Un_commute[of B A] by auto
22.107 +qed
22.108 +
22.109  lemma card_of_Un_infinite_simps[simp]:
22.110  "\<lbrakk>infinite A; |B| \<le>o |A| \<rbrakk> \<Longrightarrow> |A \<union> B| =o |A|"
22.111  "\<lbrakk>infinite A; |B| \<le>o |A| \<rbrakk> \<Longrightarrow> |B \<union> A| =o |A|"
22.112  using card_of_Un_infinite by auto
22.113
22.114 +lemma card_of_Un_diff_infinite:
22.115 +assumes INF: "infinite A" and LESS: "|B| <o |A|"
22.116 +shows "|A - B| =o |A|"
22.117 +proof-
22.118 +  obtain C where C_def: "C = A - B" by blast
22.119 +  have "|A \<union> B| =o |A|"
22.120 +  using assms ordLeq_iff_ordLess_or_ordIso card_of_Un_infinite by blast
22.121 +  moreover have "C \<union> B = A \<union> B" unfolding C_def by auto
22.122 +  ultimately have 1: "|C \<union> B| =o |A|" by auto
22.123 +  (*  *)
22.124 +  {assume *: "|C| \<le>o |B|"
22.125 +   moreover
22.126 +   {assume **: "finite B"
22.127 +    hence "finite C"
22.128 +    using card_of_ordLeq_finite * by blast
22.129 +    hence False using ** INF card_of_ordIso_finite 1 by blast
22.130 +   }
22.131 +   hence "infinite B" by auto
22.132 +   ultimately have False
22.133 +   using card_of_Un_infinite 1 ordIso_equivalence(1,3) LESS not_ordLess_ordIso by metis
22.134 +  }
22.135 +  hence 2: "|B| \<le>o |C|" using card_of_Well_order ordLeq_total by blast
22.136 +  {assume *: "finite C"
22.137 +    hence "finite B" using card_of_ordLeq_finite 2 by blast
22.138 +    hence False using * INF card_of_ordIso_finite 1 by blast
22.139 +  }
22.140 +  hence "infinite C" by auto
22.141 +  hence "|C| =o |A|"
22.142 +  using  card_of_Un_infinite 1 2 ordIso_equivalence(1,3) by metis
22.143 +  thus ?thesis unfolding C_def .
22.144 +qed
22.145 +
22.146  corollary Card_order_Un_infinite:
22.147  assumes INF: "infinite(Field r)" and CARD: "Card_order r" and
22.148          LEQ: "p \<le>o r"
22.149 @@ -597,6 +660,33 @@
22.150    thus ?thesis using 1 ordLess_ordIso_trans by blast
22.151  qed
22.152
22.153 +
22.154 +subsection {* Cardinals versus set operations involving infinite sets *}
22.155 +
22.156 +lemma finite_iff_cardOf_nat:
22.157 +"finite A = ( |A| <o |UNIV :: nat set| )"
22.158 +using infinite_iff_card_of_nat[of A]
22.159 +not_ordLeq_iff_ordLess[of "|A|" "|UNIV :: nat set|"]
22.160 +by (fastforce simp: card_of_Well_order)
22.161 +
22.162 +lemma finite_ordLess_infinite2[simp]:
22.163 +assumes "finite A" and "infinite B"
22.164 +shows "|A| <o |B|"
22.165 +using assms
22.166 +finite_ordLess_infinite[of "|A|" "|B|"]
22.167 +card_of_Well_order[of A] card_of_Well_order[of B]
22.168 +Field_card_of[of A] Field_card_of[of B] by auto
22.169 +
22.170 +lemma infinite_card_of_insert:
22.171 +assumes "infinite A"
22.172 +shows "|insert a A| =o |A|"
22.173 +proof-
22.174 +  have iA: "insert a A = A \<union> {a}" by simp
22.175 +  show ?thesis
22.176 +  using infinite_imp_bij_betw2[OF assms] unfolding iA
22.177 +  by (metis bij_betw_inv card_of_ordIso)
22.178 +qed
22.179 +
22.180  lemma card_of_Un_singl_ordLess_infinite1:
22.181  assumes "infinite B" and "|A| <o |B|"
22.182  shows "|{a} Un A| <o |B|"
22.183 @@ -616,7 +706,83 @@
22.184  qed
22.185
22.186
22.187 -subsection {* Cardinals versus lists  *}
22.188 +subsection {* Cardinals versus lists *}
22.189 +
22.190 +text{* The next is an auxiliary operator, which shall be used for inductive
22.191 +proofs of facts concerning the cardinality of @{text "List"} : *}
22.192 +
22.193 +definition nlists :: "'a set \<Rightarrow> nat \<Rightarrow> 'a list set"
22.194 +where "nlists A n \<equiv> {l. set l \<le> A \<and> length l = n}"
22.195 +
22.196 +lemma lists_def2: "lists A = {l. set l \<le> A}"
22.197 +using in_listsI by blast
22.198 +
22.199 +lemma lists_UNION_nlists: "lists A = (\<Union> n. nlists A n)"
22.200 +unfolding lists_def2 nlists_def by blast
22.201 +
22.202 +lemma card_of_lists: "|A| \<le>o |lists A|"
22.203 +proof-
22.204 +  let ?h = "\<lambda> a. [a]"
22.205 +  have "inj_on ?h A \<and> ?h  A \<le> lists A"
22.206 +  unfolding inj_on_def lists_def2 by auto
22.207 +  thus ?thesis by (metis card_of_ordLeq)
22.208 +qed
22.209 +
22.210 +lemma nlists_0: "nlists A 0 = {[]}"
22.211 +unfolding nlists_def by auto
22.212 +
22.213 +lemma nlists_not_empty:
22.214 +assumes "A \<noteq> {}"
22.215 +shows "nlists A n \<noteq> {}"
22.216 +proof(induct n, simp add: nlists_0)
22.217 +  fix n assume "nlists A n \<noteq> {}"
22.218 +  then obtain a and l where "a \<in> A \<and> l \<in> nlists A n" using assms by auto
22.219 +  hence "a # l \<in> nlists A (Suc n)" unfolding nlists_def by auto
22.220 +  thus "nlists A (Suc n) \<noteq> {}" by auto
22.221 +qed
22.222 +
22.223 +lemma Nil_in_lists: "[] \<in> lists A"
22.224 +unfolding lists_def2 by auto
22.225 +
22.226 +lemma lists_not_empty: "lists A \<noteq> {}"
22.227 +using Nil_in_lists by blast
22.228 +
22.229 +lemma card_of_nlists_Succ: "|nlists A (Suc n)| =o |A \<times> (nlists A n)|"
22.230 +proof-
22.231 +  let ?B = "A \<times> (nlists A n)"   let ?h = "\<lambda>(a,l). a # l"
22.232 +  have "inj_on ?h ?B \<and> ?h  ?B \<le> nlists A (Suc n)"
22.233 +  unfolding inj_on_def nlists_def by auto
22.234 +  moreover have "nlists A (Suc n) \<le> ?h  ?B"
22.235 +  proof(auto)
22.236 +    fix l assume "l \<in> nlists A (Suc n)"
22.237 +    hence 1: "length l = Suc n \<and> set l \<le> A" unfolding nlists_def by auto
22.238 +    then obtain a and l' where 2: "l = a # l'" by (auto simp: length_Suc_conv)
22.239 +    hence "a \<in> A \<and> set l' \<le> A \<and> length l' = n" using 1 by auto
22.240 +    thus "l \<in> ?h  ?B"  using 2 unfolding nlists_def by auto
22.241 +  qed
22.242 +  ultimately have "bij_betw ?h ?B (nlists A (Suc n))"
22.243 +  unfolding bij_betw_def by auto
22.244 +  thus ?thesis using card_of_ordIso ordIso_symmetric by blast
22.245 +qed
22.246 +
22.247 +lemma card_of_nlists_infinite:
22.248 +assumes "infinite A"
22.249 +shows "|nlists A n| \<le>o |A|"
22.250 +proof(induct n)
22.251 +  have "A \<noteq> {}" using assms by auto
22.252 +  thus "|nlists A 0| \<le>o |A|" by (simp add: nlists_0 card_of_singl_ordLeq)
22.253 +next
22.254 +  fix n assume IH: "|nlists A n| \<le>o |A|"
22.255 +  have "|nlists A (Suc n)| =o |A \<times> (nlists A n)|"
22.256 +  using card_of_nlists_Succ by blast
22.257 +  moreover
22.258 +  {have "nlists A n \<noteq> {}" using assms nlists_not_empty[of A] by blast
22.259 +   hence "|A \<times> (nlists A n)| =o |A|"
22.260 +   using assms IH by (auto simp add: card_of_Times_infinite)
22.261 +  }
22.262 +  ultimately show "|nlists A (Suc n)| \<le>o |A|"
22.263 +  using ordIso_transitive ordIso_iff_ordLeq by blast
22.264 +qed
22.265
22.266  lemma Card_order_lists: "Card_order r \<Longrightarrow> r \<le>o |lists(Field r) |"
22.267  using card_of_lists card_of_Field_ordIso ordIso_ordLeq_trans ordIso_symmetric by blast
22.268 @@ -690,6 +856,22 @@
22.269    thus ?thesis using card_of_ordIso[of "lists A"] by auto
22.270  qed
22.271
22.272 +lemma card_of_lists_infinite[simp]:
22.273 +assumes "infinite A"
22.274 +shows "|lists A| =o |A|"
22.275 +proof-
22.276 +  have "|lists A| \<le>o |A|"
22.277 +  using assms
22.278 +  by (auto simp add: lists_UNION_nlists card_of_UNION_ordLeq_infinite
22.279 +                     infinite_iff_card_of_nat card_of_nlists_infinite)
22.280 +  thus ?thesis using card_of_lists ordIso_iff_ordLeq by blast
22.281 +qed
22.282 +
22.283 +lemma Card_order_lists_infinite:
22.284 +assumes "Card_order r" and "infinite(Field r)"
22.285 +shows "|lists(Field r)| =o r"
22.286 +using assms card_of_lists_infinite card_of_Field_ordIso ordIso_transitive by blast
22.287 +
22.288  lemma ordIso_lists_cong:
22.289  assumes "r =o r'"
22.290  shows "|lists(Field r)| =o |lists(Field r')|"
22.291 @@ -827,13 +1009,22 @@
22.292  lemma Field_natLess: "Field natLess = (UNIV::nat set)"
22.293  by(unfold Field_def, auto)
22.294
22.295 +lemma natLeq_well_order_on: "well_order_on UNIV natLeq"
22.296 +using natLeq_Well_order Field_natLeq by auto
22.297 +
22.298 +lemma natLeq_wo_rel: "wo_rel natLeq"
22.299 +unfolding wo_rel_def using natLeq_Well_order .
22.300 +
22.301  lemma natLeq_ofilter_less: "ofilter natLeq {0 ..< n}"
22.302  by(auto simp add: natLeq_wo_rel wo_rel.ofilter_def,
22.303 -   simp add:  Field_natLeq, unfold rel.under_def, auto)
22.304 +   simp add: Field_natLeq, unfold rel.under_def, auto)
22.305
22.306  lemma natLeq_ofilter_leq: "ofilter natLeq {0 .. n}"
22.307  by(auto simp add: natLeq_wo_rel wo_rel.ofilter_def,
22.308 -   simp add:  Field_natLeq, unfold rel.under_def, auto)
22.309 +   simp add: Field_natLeq, unfold rel.under_def, auto)
22.310 +
22.311 +lemma natLeq_UNIV_ofilter: "wo_rel.ofilter natLeq UNIV"
22.312 +using natLeq_wo_rel Field_natLeq wo_rel.Field_ofilter[of natLeq] by auto
22.313
22.314  lemma natLeq_ofilter_iff:
22.315  "ofilter natLeq A = (A = UNIV \<or> (\<exists>n. A = {0 ..< n}))"
22.316 @@ -900,7 +1091,7 @@
22.317  qed
22.318
22.319
22.320 -subsubsection {* "Backwards compatibility" with the numeric cardinal operator for finite sets *}
22.321 +subsubsection {* "Backward compatibility" with the numeric cardinal operator for finite sets *}
22.322
22.323  lemma finite_card_of_iff_card:
22.324  assumes FIN: "finite A" and FIN': "finite B"
22.325 @@ -993,6 +1184,11 @@
22.326  shows "relChain r (\<lambda> i. under r i)"
22.327  using assms unfolding relChain_def by auto
22.328
22.329 +lemma card_of_infinite_diff_finite:
22.330 +assumes "infinite A" and "finite B"
22.331 +shows "|A - B| =o |A|"
22.332 +by (metis assms card_of_Un_diff_infinite finite_ordLess_infinite2)
22.333 +
22.334  lemma infinite_card_of_diff_singl:
22.335  assumes "infinite A"
22.336  shows "|A - {a}| =o |A|"
22.337 @@ -1110,6 +1306,30 @@
22.338    thus "f \<in> Pfunc A B" unfolding Func_option_def Pfunc_def by auto
22.339  qed
22.340
22.341 +lemma card_of_Func_mono:
22.342 +fixes A1 A2 :: "'a set" and B :: "'b set"
22.343 +assumes A12: "A1 \<subseteq> A2" and B: "B \<noteq> {}"
22.344 +shows "|Func A1 B| \<le>o |Func A2 B|"
22.345 +proof-
22.346 +  obtain bb where bb: "bb \<in> B" using B by auto
22.347 +  def F \<equiv> "\<lambda> (f1::'a \<Rightarrow> 'b) a. if a \<in> A2 then (if a \<in> A1 then f1 a else bb)
22.348 +                                                else undefined"
22.349 +  show ?thesis unfolding card_of_ordLeq[symmetric] proof(intro exI[of _ F] conjI)
22.350 +    show "inj_on F (Func A1 B)" unfolding inj_on_def proof safe
22.351 +      fix f g assume f: "f \<in> Func A1 B" and g: "g \<in> Func A1 B" and eq: "F f = F g"
22.352 +      show "f = g"
22.353 +      proof(rule ext)
22.354 +        fix a show "f a = g a"
22.355 +        proof(cases "a \<in> A1")
22.356 +          case True
22.357 +          thus ?thesis using eq A12 unfolding F_def fun_eq_iff
22.358 +          by (elim allE[of _ a]) auto
22.359 +        qed(insert f g, unfold Func_def, fastforce)
22.360 +      qed
22.361 +    qed
22.362 +  qed(insert bb, unfold Func_def F_def, force)
22.363 +qed
22.364 +
22.365  lemma card_of_Func_option_mono:
22.366  fixes A1 A2 :: "'a set" and B :: "'b set"
22.367  assumes A12: "A1 \<subseteq> A2" and B: "B \<noteq> {}"
22.368 @@ -1178,4 +1398,18 @@
22.369  "|Func (UNIV::'a set) (UNIV::'b set)| =o |UNIV::('a \<Rightarrow> 'b) set|"
22.370  using card_of_Func_UNIV[of "UNIV::'b set"] by auto
22.371
22.372 +lemma ordLeq_Func:
22.373 +assumes "{b1,b2} \<subseteq> B" "b1 \<noteq> b2"
22.374 +shows "|A| \<le>o |Func A B|"
22.375 +unfolding card_of_ordLeq[symmetric] proof(intro exI conjI)
22.376 +  let ?F = "\<lambda> aa a. if a \<in> A then (if a = aa then b1 else b2) else undefined"
22.377 +  show "inj_on ?F A" using assms unfolding inj_on_def fun_eq_iff by auto
22.378 +  show "?F  A \<subseteq> Func A B" using assms unfolding Func_def by auto
22.379 +qed
22.380 +
22.381 +lemma infinite_Func:
22.382 +assumes A: "infinite A" and B: "{b1,b2} \<subseteq> B" "b1 \<noteq> b2"
22.383 +shows "infinite (Func A B)"
22.384 +using ordLeq_Func[OF B] by (metis A card_of_ordLeq_finite)
22.385 +
22.386  end

    23.1 --- a/src/HOL/Cardinals/Cardinal_Order_Relation_Base.thy	Mon Nov 18 17:15:01 2013 +0100
23.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
23.3 @@ -1,2438 +0,0 @@
23.4 -(*  Title:      HOL/Cardinals/Cardinal_Order_Relation_Base.thy
23.5 -    Author:     Andrei Popescu, TU Muenchen
23.6 -    Copyright   2012
23.7 -
23.8 -Cardinal-order relations (base).
23.9 -*)
23.10 -
23.11 -header {* Cardinal-Order Relations (Base)  *}
23.12 -
23.13 -theory Cardinal_Order_Relation_Base
23.14 -imports Constructions_on_Wellorders_Base
23.15 -begin
23.16 -
23.17 -
23.18 -text{* In this section, we define cardinal-order relations to be minim well-orders
23.19 -on their field.  Then we define the cardinal of a set to be {\em some} cardinal-order
23.20 -relation on that set, which will be unique up to order isomorphism.  Then we study
23.21 -the connection between cardinals and:
23.22 -\begin{itemize}
23.23 -\item standard set-theoretic constructions: products,
23.24 -sums, unions, lists, powersets, set-of finite sets operator;
23.25 -\item finiteness and infiniteness (in particular, with the numeric cardinal operator
23.26 -for finite sets, @{text "card"}, from the theory @{text "Finite_Sets.thy"}).
23.27 -\end{itemize}
23.28 -%
23.29 -On the way, we define the canonical $\omega$ cardinal and finite cardinals.  We also
23.30 -define (again, up to order isomorphism) the successor of a cardinal, and show that
23.31 -any cardinal admits a successor.
23.32 -
23.33 -Main results of this section are the existence of cardinal relations and the
23.34 -facts that, in the presence of infiniteness,
23.35 -most of the standard set-theoretic constructions (except for the powerset)
23.36 -{\em do not increase cardinality}.  In particular, e.g., the set of words/lists over
23.37 -any infinite set has the same cardinality (hence, is in bijection) with that set.
23.38 -*}
23.39 -
23.40 -
23.41 -subsection {* Cardinal orders *}
23.42 -
23.43 -
23.44 -text{* A cardinal order in our setting shall be a well-order {\em minim} w.r.t. the
23.45 -order-embedding relation, @{text "\<le>o"} (which is the same as being {\em minimal} w.r.t. the
23.46 -strict order-embedding relation, @{text "<o"}), among all the well-orders on its field.  *}
23.47 -
23.48 -definition card_order_on :: "'a set \<Rightarrow> 'a rel \<Rightarrow> bool"
23.49 -where
23.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')"
23.51 -
23.52 -
23.53 -abbreviation "Card_order r \<equiv> card_order_on (Field r) r"
23.54 -abbreviation "card_order r \<equiv> card_order_on UNIV r"
23.55 -
23.56 -
23.57 -lemma card_order_on_well_order_on:
23.58 -assumes "card_order_on A r"
23.59 -shows "well_order_on A r"
23.60 -using assms unfolding card_order_on_def by simp
23.61 -
23.62 -
23.63 -lemma card_order_on_Card_order:
23.64 -"card_order_on A r \<Longrightarrow> A = Field r \<and> Card_order r"
23.65 -unfolding card_order_on_def using rel.well_order_on_Field by blast
23.66 -
23.67 -
23.68 -text{* The existence of a cardinal relation on any given set (which will mean
23.69 -that any set has a cardinal) follows from two facts:
23.70 -\begin{itemize}
23.71 -\item Zermelo's theorem (proved in @{text "Zorn.thy"} as theorem @{text "well_order_on"}),
23.72 -which states that on any given set there exists a well-order;
23.73 -\item The well-founded-ness of @{text "<o"}, ensuring that then there exists a minimal
23.74 -such well-order, i.e., a cardinal order.
23.75 -\end{itemize}
23.76 -*}
23.77 -
23.78 -
23.79 -theorem card_order_on: "\<exists>r. card_order_on A r"
23.80 -proof-
23.81 -  obtain R where R_def: "R = {r. well_order_on A r}" by blast
23.82 -  have 1: "R \<noteq> {} \<and> (\<forall>r \<in> R. Well_order r)"
23.83 -  using well_order_on[of A] R_def rel.well_order_on_Well_order by blast
23.84 -  hence "\<exists>r \<in> R. \<forall>r' \<in> R. r \<le>o r'"
23.85 -  using  exists_minim_Well_order[of R] by auto
23.86 -  thus ?thesis using R_def unfolding card_order_on_def by auto
23.87 -qed
23.88 -
23.89 -
23.90 -lemma card_order_on_ordIso:
23.91 -assumes CO: "card_order_on A r" and CO': "card_order_on A r'"
23.92 -shows "r =o r'"
23.93 -using assms unfolding card_order_on_def
23.94 -using ordIso_iff_ordLeq by blast
23.95 -
23.96 -
23.97 -lemma Card_order_ordIso:
23.98 -assumes CO: "Card_order r" and ISO: "r' =o r"
23.99 -shows "Card_order r'"
23.100 -using ISO unfolding ordIso_def
23.101 -proof(unfold card_order_on_def, auto)
23.102 -  fix p' assume "well_order_on (Field r') p'"
23.103 -  hence 0: "Well_order p' \<and> Field p' = Field r'"
23.104 -  using rel.well_order_on_Well_order by blast
23.105 -  obtain f where 1: "iso r' r f" and 2: "Well_order r \<and> Well_order r'"
23.106 -  using ISO unfolding ordIso_def by auto
23.107 -  hence 3: "inj_on f (Field r') \<and> f  (Field r') = Field r"
23.108 -  by (auto simp add: iso_iff embed_inj_on)
23.109 -  let ?p = "dir_image p' f"
23.110 -  have 4: "p' =o ?p \<and> Well_order ?p"
23.111 -  using 0 2 3 by (auto simp add: dir_image_ordIso Well_order_dir_image)
23.112 -  moreover have "Field ?p =  Field r"
23.113 -  using 0 3 by (auto simp add: dir_image_Field2 order_on_defs)
23.114 -  ultimately have "well_order_on (Field r) ?p" by auto
23.115 -  hence "r \<le>o ?p" using CO unfolding card_order_on_def by auto
23.116 -  thus "r' \<le>o p'"
23.117 -  using ISO 4 ordLeq_ordIso_trans ordIso_ordLeq_trans ordIso_symmetric by blast
23.118 -qed
23.119 -
23.120 -
23.121 -lemma Card_order_ordIso2:
23.122 -assumes CO: "Card_order r" and ISO: "r =o r'"
23.123 -shows "Card_order r'"
23.124 -using assms Card_order_ordIso ordIso_symmetric by blast
23.125 -
23.126 -
23.127 -subsection {* Cardinal of a set *}
23.128 -
23.129 -
23.130 -text{* We define the cardinal of set to be {\em some} cardinal order on that set.
23.131 -We shall prove that this notion is unique up to order isomorphism, meaning
23.132 -that order isomorphism shall be the true identity of cardinals.  *}
23.133 -
23.134 -
23.135 -definition card_of :: "'a set \<Rightarrow> 'a rel" ("|_|" )
23.136 -where "card_of A = (SOME r. card_order_on A r)"
23.137 -
23.138 -
23.139 -lemma card_of_card_order_on: "card_order_on A |A|"
23.140 -unfolding card_of_def by (auto simp add: card_order_on someI_ex)
23.141 -
23.142 -
23.143 -lemma card_of_well_order_on: "well_order_on A |A|"
23.144 -using card_of_card_order_on card_order_on_def by blast
23.145 -
23.146 -
23.147 -lemma Field_card_of: "Field |A| = A"
23.148 -using card_of_card_order_on[of A] unfolding card_order_on_def
23.149 -using rel.well_order_on_Field by blast
23.150 -
23.151 -
23.152 -lemma card_of_Card_order: "Card_order |A|"
23.153 -by (simp only: card_of_card_order_on Field_card_of)
23.154 -
23.155 -
23.156 -corollary ordIso_card_of_imp_Card_order:
23.157 -"r =o |A| \<Longrightarrow> Card_order r"
23.158 -using card_of_Card_order Card_order_ordIso by blast
23.159 -
23.160 -
23.161 -lemma card_of_Well_order: "Well_order |A|"
23.162 -using card_of_Card_order unfolding  card_order_on_def by auto
23.163 -
23.164 -
23.165 -lemma card_of_refl: "|A| =o |A|"
23.166 -using card_of_Well_order ordIso_reflexive by blast
23.167 -
23.168 -
23.169 -lemma card_of_least: "well_order_on A r \<Longrightarrow> |A| \<le>o r"
23.170 -using card_of_card_order_on unfolding card_order_on_def by blast
23.171 -
23.172 -
23.173 -lemma card_of_ordIso:
23.174 -"(\<exists>f. bij_betw f A B) = ( |A| =o |B| )"
23.175 -proof(auto)
23.176 -  fix f assume *: "bij_betw f A B"
23.177 -  then obtain r where "well_order_on B r \<and> |A| =o r"
23.178 -  using Well_order_iso_copy card_of_well_order_on by blast
23.179 -  hence "|B| \<le>o |A|" using card_of_least
23.180 -  ordLeq_ordIso_trans ordIso_symmetric by blast
23.181 -  moreover
23.182 -  {let ?g = "inv_into A f"
23.183 -   have "bij_betw ?g B A" using * bij_betw_inv_into by blast
23.184 -   then obtain r where "well_order_on A r \<and> |B| =o r"
23.185 -   using Well_order_iso_copy card_of_well_order_on by blast
23.186 -   hence "|A| \<le>o |B|" using card_of_least
23.187 -   ordLeq_ordIso_trans ordIso_symmetric by blast
23.188 -  }
23.189 -  ultimately show "|A| =o |B|" using ordIso_iff_ordLeq by blast
23.190 -next
23.191 -  assume "|A| =o |B|"
23.192 -  then obtain f where "iso ( |A| ) ( |B| ) f"
23.193 -  unfolding ordIso_def by auto
23.194 -  hence "bij_betw f A B" unfolding iso_def Field_card_of by simp
23.195 -  thus "\<exists>f. bij_betw f A B" by auto
23.196 -qed
23.197 -
23.198 -
23.199 -lemma card_of_ordLeq:
23.200 -"(\<exists>f. inj_on f A \<and> f  A \<le> B) = ( |A| \<le>o |B| )"
23.201 -proof(auto)
23.202 -  fix f assume *: "inj_on f A" and **: "f  A \<le> B"
23.203 -  {assume "|B| <o |A|"
23.204 -   hence "|B| \<le>o |A|" using ordLeq_iff_ordLess_or_ordIso by blast
23.205 -   then obtain g where "embed ( |B| ) ( |A| ) g"
23.206 -   unfolding ordLeq_def by auto
23.207 -   hence 1: "inj_on g B \<and> g  B \<le> A" using embed_inj_on[of "|B|" "|A|" "g"]
23.208 -   card_of_Well_order[of "B"] Field_card_of[of "B"] Field_card_of[of "A"]
23.209 -   embed_Field[of "|B|" "|A|" g] by auto
23.210 -   obtain h where "bij_betw h A B"
23.211 -   using * ** 1 Cantor_Bernstein[of f] by fastforce
23.212 -   hence "|A| =o |B|" using card_of_ordIso by blast
23.213 -   hence "|A| \<le>o |B|" using ordIso_iff_ordLeq by auto
23.214 -  }
23.215 -  thus "|A| \<le>o |B|" using ordLess_or_ordLeq[of "|B|" "|A|"]
23.216 -  by (auto simp: card_of_Well_order)
23.217 -next
23.218 -  assume *: "|A| \<le>o |B|"
23.219 -  obtain f where "embed ( |A| ) ( |B| ) f"
23.220 -  using * unfolding ordLeq_def by auto
23.221 -  hence "inj_on f A \<and> f  A \<le> B" using embed_inj_on[of "|A|" "|B|" f]
23.222 -  card_of_Well_order[of "A"] Field_card_of[of "A"] Field_card_of[of "B"]
23.223 -  embed_Field[of "|A|" "|B|" f] by auto
23.224 -  thus "\<exists>f. inj_on f A \<and> f  A \<le> B" by auto
23.225 -qed
23.226 -
23.227 -
23.228 -lemma card_of_ordLeq2:
23.229 -"A \<noteq> {} \<Longrightarrow> (\<exists>g. g  B = A) = ( |A| \<le>o |B| )"
23.230 -using card_of_ordLeq[of A B] inj_on_iff_surj[of A B] by auto
23.231 -
23.232 -
23.233 -lemma card_of_ordLess:
23.234 -"(\<not>(\<exists>f. inj_on f A \<and> f  A \<le> B)) = ( |B| <o |A| )"
23.235 -proof-
23.236 -  have "(\<not>(\<exists>f. inj_on f A \<and> f  A \<le> B)) = (\<not> |A| \<le>o |B| )"
23.237 -  using card_of_ordLeq by blast
23.238 -  also have "\<dots> = ( |B| <o |A| )"
23.239 -  using card_of_Well_order[of A] card_of_Well_order[of B]
23.240 -        not_ordLeq_iff_ordLess by blast
23.241 -  finally show ?thesis .
23.242 -qed
23.243 -
23.244 -
23.245 -lemma card_of_ordLess2:
23.246 -"B \<noteq> {} \<Longrightarrow> (\<not>(\<exists>f. f  A = B)) = ( |A| <o |B| )"
23.247 -using card_of_ordLess[of B A] inj_on_iff_surj[of B A] by auto
23.248 -
23.249 -
23.250 -lemma card_of_ordIsoI:
23.251 -assumes "bij_betw f A B"
23.252 -shows "|A| =o |B|"
23.253 -using assms unfolding card_of_ordIso[symmetric] by auto
23.254 -
23.255 -
23.256 -lemma card_of_ordLeqI:
23.257 -assumes "inj_on f A" and "\<And> a. a \<in> A \<Longrightarrow> f a \<in> B"
23.258 -shows "|A| \<le>o |B|"
23.259 -using assms unfolding card_of_ordLeq[symmetric] by auto
23.260 -
23.261 -
23.262 -lemma card_of_unique:
23.263 -"card_order_on A r \<Longrightarrow> r =o |A|"
23.264 -by (simp only: card_order_on_ordIso card_of_card_order_on)
23.265 -
23.266 -
23.267 -lemma card_of_mono1:
23.268 -"A \<le> B \<Longrightarrow> |A| \<le>o |B|"
23.269 -using inj_on_id[of A] card_of_ordLeq[of A B] by fastforce
23.270 -
23.271 -
23.272 -lemma card_of_mono2:
23.273 -assumes "r \<le>o r'"
23.274 -shows "|Field r| \<le>o |Field r'|"
23.275 -proof-
23.276 -  obtain f where
23.277 -  1: "well_order_on (Field r) r \<and> well_order_on (Field r) r \<and> embed r r' f"
23.278 -  using assms unfolding ordLeq_def
23.279 -  by (auto simp add: rel.well_order_on_Well_order)
23.280 -  hence "inj_on f (Field r) \<and> f  (Field r) \<le> Field r'"
23.281 -  by (auto simp add: embed_inj_on embed_Field)
23.282 -  thus "|Field r| \<le>o |Field r'|" using card_of_ordLeq by blast
23.283 -qed
23.284 -
23.285 -
23.286 -lemma card_of_cong: "r =o r' \<Longrightarrow> |Field r| =o |Field r'|"
23.287 -by (simp add: ordIso_iff_ordLeq card_of_mono2)
23.288 -
23.289 -
23.290 -lemma card_of_Field_ordLess: "Well_order r \<Longrightarrow> |Field r| \<le>o r"
23.291 -using card_of_least card_of_well_order_on rel.well_order_on_Well_order by blast
23.292 -
23.293 -
23.294 -lemma card_of_Field_ordIso:
23.295 -assumes "Card_order r"
23.296 -shows "|Field r| =o r"
23.297 -proof-
23.298 -  have "card_order_on (Field r) r"
23.299 -  using assms card_order_on_Card_order by blast
23.300 -  moreover have "card_order_on (Field r) |Field r|"
23.301 -  using card_of_card_order_on by blast
23.302 -  ultimately show ?thesis using card_order_on_ordIso by blast
23.303 -qed
23.304 -
23.305 -
23.306 -lemma Card_order_iff_ordIso_card_of:
23.307 -"Card_order r = (r =o |Field r| )"
23.308 -using ordIso_card_of_imp_Card_order card_of_Field_ordIso ordIso_symmetric by blast
23.309 -
23.310 -
23.311 -lemma Card_order_iff_ordLeq_card_of:
23.312 -"Card_order r = (r \<le>o |Field r| )"
23.313 -proof-
23.314 -  have "Card_order r = (r =o |Field r| )"
23.315 -  unfolding Card_order_iff_ordIso_card_of by simp
23.316 -  also have "... = (r \<le>o |Field r| \<and> |Field r| \<le>o r)"
23.317 -  unfolding ordIso_iff_ordLeq by simp
23.318 -  also have "... = (r \<le>o |Field r| )"
23.319 -  using card_of_Field_ordLess
23.320 -  by (auto simp: card_of_Field_ordLess ordLeq_Well_order_simp)
23.321 -  finally show ?thesis .
23.322 -qed
23.323 -
23.324 -
23.325 -lemma Card_order_iff_Restr_underS:
23.326 -assumes "Well_order r"
23.327 -shows "Card_order r = (\<forall>a \<in> Field r. Restr r (rel.underS r a) <o |Field r| )"
23.328 -using assms unfolding Card_order_iff_ordLeq_card_of
23.329 -using ordLeq_iff_ordLess_Restr card_of_Well_order by blast
23.330 -
23.331 -
23.332 -lemma card_of_underS:
23.333 -assumes r: "Card_order r" and a: "a : Field r"
23.334 -shows "|rel.underS r a| <o r"
23.335 -proof-
23.336 -  let ?A = "rel.underS r a"  let ?r' = "Restr r ?A"
23.337 -  have 1: "Well_order r"
23.338 -  using r unfolding card_order_on_def by simp
23.339 -  have "Well_order ?r'" using 1 Well_order_Restr by auto
23.340 -  moreover have "card_order_on (Field ?r') |Field ?r'|"
23.341 -  using card_of_card_order_on .
23.342 -  ultimately have "|Field ?r'| \<le>o ?r'"
23.343 -  unfolding card_order_on_def by simp
23.344 -  moreover have "Field ?r' = ?A"
23.345 -  using 1 wo_rel.underS_ofilter Field_Restr_ofilter
23.346 -  unfolding wo_rel_def by fastforce
23.347 -  ultimately have "|?A| \<le>o ?r'" by simp
23.348 -  also have "?r' <o |Field r|"
23.349 -  using 1 a r Card_order_iff_Restr_underS by blast
23.350 -  also have "|Field r| =o r"
23.351 -  using r ordIso_symmetric unfolding Card_order_iff_ordIso_card_of by auto
23.352 -  finally show ?thesis .
23.353 -qed
23.354 -
23.355 -
23.356 -lemma ordLess_Field:
23.357 -assumes "r <o r'"
23.358 -shows "|Field r| <o r'"
23.359 -proof-
23.360 -  have "well_order_on (Field r) r" using assms unfolding ordLess_def
23.361 -  by (auto simp add: rel.well_order_on_Well_order)
23.362 -  hence "|Field r| \<le>o r" using card_of_least by blast
23.363 -  thus ?thesis using assms ordLeq_ordLess_trans by blast
23.364 -qed
23.365 -
23.366 -
23.367 -lemma internalize_card_of_ordLeq:
23.368 -"( |A| \<le>o r) = (\<exists>B \<le> Field r. |A| =o |B| \<and> |B| \<le>o r)"
23.369 -proof
23.370 -  assume "|A| \<le>o r"
23.371 -  then obtain p where 1: "Field p \<le> Field r \<and> |A| =o p \<and> p \<le>o r"
23.372 -  using internalize_ordLeq[of "|A|" r] by blast
23.373 -  hence "Card_order p" using card_of_Card_order Card_order_ordIso2 by blast
23.374 -  hence "|Field p| =o p" using card_of_Field_ordIso by blast
23.375 -  hence "|A| =o |Field p| \<and> |Field p| \<le>o r"
23.376 -  using 1 ordIso_equivalence ordIso_ordLeq_trans by blast
23.377 -  thus "\<exists>B \<le> Field r. |A| =o |B| \<and> |B| \<le>o r" using 1 by blast
23.378 -next
23.379 -  assume "\<exists>B \<le> Field r. |A| =o |B| \<and> |B| \<le>o r"
23.380 -  thus "|A| \<le>o r" using ordIso_ordLeq_trans by blast
23.381 -qed
23.382 -
23.383 -
23.384 -lemma internalize_card_of_ordLeq2:
23.385 -"( |A| \<le>o |C| ) = (\<exists>B \<le> C. |A| =o |B| \<and> |B| \<le>o |C| )"
23.386 -using internalize_card_of_ordLeq[of "A" "|C|"] Field_card_of[of C] by auto
23.387 -
23.388 -
23.389 -
23.390 -subsection {* Cardinals versus set operations on arbitrary sets *}
23.391 -
23.392 -
23.393 -text{* Here we embark in a long journey of simple results showing
23.394 -that the standard set-theoretic operations are well-behaved w.r.t. the notion of
23.395 -cardinal -- essentially, this means that they preserve the cardinal identity"
23.396 -@{text "=o"} and are monotonic w.r.t. @{text "\<le>o"}.
23.397 -*}
23.398 -
23.399 -
23.400 -lemma card_of_empty: "|{}| \<le>o |A|"
23.401 -using card_of_ordLeq inj_on_id by blast
23.402 -
23.403 -
23.404 -lemma card_of_empty1:
23.405 -assumes "Well_order r \<or> Card_order r"
23.406 -shows "|{}| \<le>o r"
23.407 -proof-
23.408 -  have "Well_order r" using assms unfolding card_order_on_def by auto
23.409 -  hence "|Field r| <=o r"
23.410 -  using assms card_of_Field_ordLess by blast
23.411 -  moreover have "|{}| \<le>o |Field r|" by (simp add: card_of_empty)
23.412 -  ultimately show ?thesis using ordLeq_transitive by blast
23.413 -qed
23.414 -
23.415 -
23.416 -corollary Card_order_empty:
23.417 -"Card_order r \<Longrightarrow> |{}| \<le>o r" by (simp add: card_of_empty1)
23.418 -
23.419 -
23.420 -lemma card_of_empty2:
23.421 -assumes LEQ: "|A| =o |{}|"
23.422 -shows "A = {}"
23.423 -using assms card_of_ordIso[of A] bij_betw_empty2 by blast
23.424 -
23.425 -
23.426 -lemma card_of_empty3:
23.427 -assumes LEQ: "|A| \<le>o |{}|"
23.428 -shows "A = {}"
23.429 -using assms
23.430 -by (simp add: ordIso_iff_ordLeq card_of_empty1 card_of_empty2
23.431 -              ordLeq_Well_order_simp)
23.432 -
23.433 -
23.434 -lemma card_of_empty_ordIso:
23.435 -"|{}::'a set| =o |{}::'b set|"
23.436 -using card_of_ordIso unfolding bij_betw_def inj_on_def by blast
23.437 -
23.438 -
23.439 -lemma card_of_image:
23.440 -"|f  A| <=o |A|"
23.441 -proof(cases "A = {}", simp add: card_of_empty)
23.442 -  assume "A ~= {}"
23.443 -  hence "f  A ~= {}" by auto
23.444 -  thus "|f  A| \<le>o |A|"
23.445 -  using card_of_ordLeq2[of "f  A" A] by auto
23.446 -qed
23.447 -
23.448 -
23.449 -lemma surj_imp_ordLeq:
23.450 -assumes "B <= f  A"
23.451 -shows "|B| <=o |A|"
23.452 -proof-
23.453 -  have "|B| <=o |f  A|" using assms card_of_mono1 by auto
23.454 -  thus ?thesis using card_of_image ordLeq_transitive by blast
23.455 -qed
23.456 -
23.457 -
23.458 -lemma card_of_ordLeqI2:
23.459 -assumes "B \<subseteq> f  A"
23.460 -shows "|B| \<le>o |A|"
23.461 -using assms by (metis surj_imp_ordLeq)
23.462 -
23.463 -
23.464 -lemma card_of_singl_ordLeq:
23.465 -assumes "A \<noteq> {}"
23.466 -shows "|{b}| \<le>o |A|"
23.467 -proof-
23.468 -  obtain a where *: "a \<in> A" using assms by auto
23.469 -  let ?h = "\<lambda> b'::'b. if b' = b then a else undefined"
23.470 -  have "inj_on ?h {b} \<and> ?h  {b} \<le> A"
23.471 -  using * unfolding inj_on_def by auto
23.472 -  thus ?thesis using card_of_ordLeq by blast
23.473 -qed
23.474 -
23.475 -
23.476 -corollary Card_order_singl_ordLeq:
23.477 -"\<lbrakk>Card_order r; Field r \<noteq> {}\<rbrakk> \<Longrightarrow> |{b}| \<le>o r"
23.478 -using card_of_singl_ordLeq[of "Field r" b]
23.479 -      card_of_Field_ordIso[of r] ordLeq_ordIso_trans by blast
23.480 -
23.481 -
23.482 -lemma card_of_Pow: "|A| <o |Pow A|"
23.483 -using card_of_ordLess2[of "Pow A" A]  Cantors_paradox[of A]
23.484 -      Pow_not_empty[of A] by auto
23.485 -
23.486 -
23.487 -lemma infinite_Pow:
23.488 -assumes "infinite A"
23.489 -shows "infinite (Pow A)"
23.490 -proof-
23.491 -  have "|A| \<le>o |Pow A|" by (metis card_of_Pow ordLess_imp_ordLeq)
23.492 -  thus ?thesis by (metis assms finite_Pow_iff)
23.493 -qed
23.494 -
23.495 -
23.496 -corollary Card_order_Pow:
23.497 -"Card_order r \<Longrightarrow> r <o |Pow(Field r)|"
23.498 -using card_of_Pow card_of_Field_ordIso ordIso_ordLess_trans ordIso_symmetric by blast
23.499 -
23.500 -
23.501 -corollary card_of_set_type: "|UNIV::'a set| <o |UNIV::'a set set|"
23.502 -using card_of_Pow[of "UNIV::'a set"] by simp
23.503 -
23.504 -
23.505 -lemma card_of_Plus1: "|A| \<le>o |A <+> B|"
23.506 -proof-
23.507 -  have "Inl  A \<le> A <+> B" by auto
23.508 -  thus ?thesis using inj_Inl[of A] card_of_ordLeq by blast
23.509 -qed
23.510 -
23.511 -
23.512 -corollary Card_order_Plus1:
23.513 -"Card_order r \<Longrightarrow> r \<le>o |(Field r) <+> B|"
23.514 -using card_of_Plus1 card_of_Field_ordIso ordIso_ordLeq_trans ordIso_symmetric by blast
23.515 -
23.516 -
23.517 -lemma card_of_Plus2: "|B| \<le>o |A <+> B|"
23.518 -proof-
23.519 -  have "Inr  B \<le> A <+> B" by auto
23.520 -  thus ?thesis using inj_Inr[of B] card_of_ordLeq by blast
23.521 -qed
23.522 -
23.523 -
23.524 -corollary Card_order_Plus2:
23.525 -"Card_order r \<Longrightarrow> r \<le>o |A <+> (Field r)|"
23.526 -using card_of_Plus2 card_of_Field_ordIso ordIso_ordLeq_trans ordIso_symmetric by blast
23.527 -
23.528 -
23.529 -lemma card_of_Plus_empty1: "|A| =o |A <+> {}|"
23.530 -proof-
23.531 -  have "bij_betw Inl A (A <+> {})" unfolding bij_betw_def inj_on_def by auto
23.532 -  thus ?thesis using card_of_ordIso by auto
23.533 -qed
23.534 -
23.535 -
23.536 -lemma card_of_Plus_empty2: "|A| =o |{} <+> A|"
23.537 -proof-
23.538 -  have "bij_betw Inr A ({} <+> A)" unfolding bij_betw_def inj_on_def by auto
23.539 -  thus ?thesis using card_of_ordIso by auto
23.540 -qed
23.541 -
23.542 -
23.543 -lemma card_of_Plus_commute: "|A <+> B| =o |B <+> A|"
23.544 -proof-
23.545 -  let ?f = "\<lambda>(c::'a + 'b). case c of Inl a \<Rightarrow> Inr a
23.546 -                                   | Inr b \<Rightarrow> Inl b"
23.547 -  have "bij_betw ?f (A <+> B) (B <+> A)"
23.548 -  unfolding bij_betw_def inj_on_def by force
23.549 -  thus ?thesis using card_of_ordIso by blast
23.550 -qed
23.551 -
23.552 -
23.553 -lemma card_of_Plus_assoc:
23.554 -fixes A :: "'a set" and B :: "'b set" and C :: "'c set"
23.555 -shows "|(A <+> B) <+> C| =o |A <+> B <+> C|"
23.556 -proof -
23.557 -  def f \<equiv> "\<lambda>(k::('a + 'b) + 'c).
23.558 -  case k of Inl ab \<Rightarrow> (case ab of Inl a \<Rightarrow> Inl a
23.559 -                                 |Inr b \<Rightarrow> Inr (Inl b))
23.560 -           |Inr c \<Rightarrow> Inr (Inr c)"
23.561 -  have "A <+> B <+> C \<subseteq> f  ((A <+> B) <+> C)"
23.562 -  proof
23.563 -    fix x assume x: "x \<in> A <+> B <+> C"
23.564 -    show "x \<in> f  ((A <+> B) <+> C)"
23.565 -    proof(cases x)
23.566 -      case (Inl a)
23.567 -      hence "a \<in> A" "x = f (Inl (Inl a))"
23.568 -      using x unfolding f_def by auto
23.569 -      thus ?thesis by auto
23.570 -    next
23.571 -      case (Inr bc) note 1 = Inr show ?thesis
23.572 -      proof(cases bc)
23.573 -        case (Inl b)
23.574 -        hence "b \<in> B" "x = f (Inl (Inr b))"
23.575 -        using x 1 unfolding f_def by auto
23.576 -        thus ?thesis by auto
23.577 -      next
23.578 -        case (Inr c)
23.579 -        hence "c \<in> C" "x = f (Inr c)"
23.580 -        using x 1 unfolding f_def by auto
23.581 -        thus ?thesis by auto
23.582 -      qed
23.583 -    qed
23.584 -  qed
23.585 -  hence "bij_betw f ((A <+> B) <+> C) (A <+> B <+> C)"
23.586 -  unfolding bij_betw_def inj_on_def f_def by force
23.587 -  thus ?thesis using card_of_ordIso by blast
23.588 -qed
23.589 -
23.590 -
23.591 -lemma card_of_Plus_mono1:
23.592 -assumes "|A| \<le>o |B|"
23.593 -shows "|A <+> C| \<le>o |B <+> C|"
23.594 -proof-
23.595 -  obtain f where 1: "inj_on f A \<and> f  A \<le> B"
23.596 -  using assms card_of_ordLeq[of A] by fastforce
23.597 -  obtain g where g_def:
23.598 -  "g = (\<lambda>d. case d of Inl a \<Rightarrow> Inl(f a) | Inr (c::'c) \<Rightarrow> Inr c)" by blast
23.599 -  have "inj_on g (A <+> C) \<and> g  (A <+> C) \<le> (B <+> C)"
23.600 -  proof-
23.601 -    {fix d1 and d2 assume "d1 \<in> A <+> C \<and> d2 \<in> A <+> C" and
23.602 -                          "g d1 = g d2"
23.603 -     hence "d1 = d2" using 1 unfolding inj_on_def
23.604 -     by(case_tac d1, case_tac d2, auto simp add: g_def)
23.605 -    }
23.606 -    moreover
23.607 -    {fix d assume "d \<in> A <+> C"
23.608 -     hence "g d \<in> B <+> C"  using 1
23.609 -     by(case_tac d, auto simp add: g_def)
23.610 -    }
23.611 -    ultimately show ?thesis unfolding inj_on_def by auto
23.612 -  qed
23.613 -  thus ?thesis using card_of_ordLeq by metis
23.614 -qed
23.615 -
23.616 -
23.617 -corollary ordLeq_Plus_mono1:
23.618 -assumes "r \<le>o r'"
23.619 -shows "|(Field r) <+> C| \<le>o |(Field r') <+> C|"
23.620 -using assms card_of_mono2 card_of_Plus_mono1 by blast
23.621 -
23.622 -
23.623 -lemma card_of_Plus_mono2:
23.624 -assumes "|A| \<le>o |B|"
23.625 -shows "|C <+> A| \<le>o |C <+> B|"
23.626 -using assms card_of_Plus_mono1[of A B C]
23.627 -      card_of_Plus_commute[of C A]  card_of_Plus_commute[of B C]
23.628 -      ordIso_ordLeq_trans[of "|C <+> A|"] ordLeq_ordIso_trans[of "|C <+> A|"]
23.629 -by blast
23.630 -
23.631 -
23.632 -corollary ordLeq_Plus_mono2:
23.633 -assumes "r \<le>o r'"
23.634 -shows "|A <+> (Field r)| \<le>o |A <+> (Field r')|"
23.635 -using assms card_of_mono2 card_of_Plus_mono2 by blast
23.636 -
23.637 -
23.638 -lemma card_of_Plus_mono:
23.639 -assumes "|A| \<le>o |B|" and "|C| \<le>o |D|"
23.640 -shows "|A <+> C| \<le>o |B <+> D|"
23.641 -using assms card_of_Plus_mono1[of A B C] card_of_Plus_mono2[of C D B]
23.642 -      ordLeq_transitive[of "|A <+> C|"] by blast
23.643 -
23.644 -
23.645 -corollary ordLeq_Plus_mono:
23.646 -assumes "r \<le>o r'" and "p \<le>o p'"
23.647 -shows "|(Field r) <+> (Field p)| \<le>o |(Field r') <+> (Field p')|"
23.648 -using assms card_of_mono2[of r r'] card_of_mono2[of p p'] card_of_Plus_mono by blast
23.649 -
23.650 -
23.651 -lemma card_of_Plus_cong1:
23.652 -assumes "|A| =o |B|"
23.653 -shows "|A <+> C| =o |B <+> C|"
23.654 -using assms by (simp add: ordIso_iff_ordLeq card_of_Plus_mono1)
23.655 -
23.656 -
23.657 -corollary ordIso_Plus_cong1:
23.658 -assumes "r =o r'"
23.659 -shows "|(Field r) <+> C| =o |(Field r') <+> C|"
23.660 -using assms card_of_cong card_of_Plus_cong1 by blast
23.661 -
23.662 -
23.663 -lemma card_of_Plus_cong2:
23.664 -assumes "|A| =o |B|"
23.665 -shows "|C <+> A| =o |C <+> B|"
23.666 -using assms by (simp add: ordIso_iff_ordLeq card_of_Plus_mono2)
23.667 -
23.668 -
23.669 -corollary ordIso_Plus_cong2:
23.670 -assumes "r =o r'"
23.671 -shows "|A <+> (Field r)| =o |A <+> (Field r')|"
23.672 -using assms card_of_cong card_of_Plus_cong2 by blast
23.673 -
23.674 -
23.675 -lemma card_of_Plus_cong:
23.676 -assumes "|A| =o |B|" and "|C| =o |D|"
23.677 -shows "|A <+> C| =o |B <+> D|"
23.678 -using assms by (simp add: ordIso_iff_ordLeq card_of_Plus_mono)
23.679 -
23.680 -
23.681 -corollary ordIso_Plus_cong:
23.682 -assumes "r =o r'" and "p =o p'"
23.683 -shows "|(Field r) <+> (Field p)| =o |(Field r') <+> (Field p')|"
23.684 -using assms card_of_cong[of r r'] card_of_cong[of p p'] card_of_Plus_cong by blast
23.685 -
23.686 -
23.687 -lemma card_of_Un1:
23.688 -shows "|A| \<le>o |A \<union> B| "
23.689 -using inj_on_id[of A] card_of_ordLeq[of A _] by fastforce
23.690 -
23.691 -
23.692 -lemma card_of_diff:
23.693 -shows "|A - B| \<le>o |A|"
23.694 -using inj_on_id[of "A - B"] card_of_ordLeq[of "A - B" _] by fastforce
23.695 -
23.696 -
23.697 -lemma card_of_Un_Plus_ordLeq:
23.698 -"|A \<union> B| \<le>o |A <+> B|"
23.699 -proof-
23.700 -   let ?f = "\<lambda> c. if c \<in> A then Inl c else Inr c"
23.701 -   have "inj_on ?f (A \<union> B) \<and> ?f  (A \<union> B) \<le> A <+> B"
23.702 -   unfolding inj_on_def by auto
23.703 -   thus ?thesis using card_of_ordLeq by blast
23.704 -qed
23.705 -
23.706 -
23.707 -lemma card_of_Times1:
23.708 -assumes "A \<noteq> {}"
23.709 -shows "|B| \<le>o |B \<times> A|"
23.710 -proof(cases "B = {}", simp add: card_of_empty)
23.711 -  assume *: "B \<noteq> {}"
23.712 -  have "fst (B \<times> A) = B" unfolding image_def using assms by auto
23.713 -  thus ?thesis using inj_on_iff_surj[of B "B \<times> A"]
23.714 -                     card_of_ordLeq[of B "B \<times> A"] * by blast
23.715 -qed
23.716 -
23.717 -
23.718 -corollary Card_order_Times1:
23.719 -"\<lbrakk>Card_order r; B \<noteq> {}\<rbrakk> \<Longrightarrow> r \<le>o |(Field r) \<times> B|"
23.720 -using card_of_Times1[of B] card_of_Field_ordIso
23.721 -      ordIso_ordLeq_trans ordIso_symmetric by blast
23.722 -
23.723 -
23.724 -lemma card_of_Times_commute: "|A \<times> B| =o |B \<times> A|"
23.725 -proof-
23.726 -  let ?f = "\<lambda>(a::'a,b::'b). (b,a)"
23.727 -  have "bij_betw ?f (A \<times> B) (B \<times> A)"
23.728 -  unfolding bij_betw_def inj_on_def by auto
23.729 -  thus ?thesis using card_of_ordIso by blast
23.730 -qed
23.731 -
23.732 -
23.733 -lemma card_of_Times2:
23.734 -assumes "A \<noteq> {}"   shows "|B| \<le>o |A \<times> B|"
23.735 -using assms card_of_Times1[of A B] card_of_Times_commute[of B A]
23.736 -      ordLeq_ordIso_trans by blast
23.737 -
23.738 -
23.739 -corollary Card_order_Times2:
23.740 -"\<lbrakk>Card_order r; A \<noteq> {}\<rbrakk> \<Longrightarrow> r \<le>o |A \<times> (Field r)|"
23.741 -using card_of_Times2[of A] card_of_Field_ordIso
23.742 -      ordIso_ordLeq_trans ordIso_symmetric by blast
23.743 -
23.744 -
23.745 -lemma card_of_Times3: "|A| \<le>o |A \<times> A|"
23.746 -using card_of_Times1[of A]
23.747 -by(cases "A = {}", simp add: card_of_empty, blast)
23.748 -
23.749 -
23.750 -lemma card_of_Plus_Times_bool: "|A <+> A| =o |A \<times> (UNIV::bool set)|"
23.751 -proof-
23.752 -  let ?f = "\<lambda>c::'a + 'a. case c of Inl a \<Rightarrow> (a,True)
23.753 -                                  |Inr a \<Rightarrow> (a,False)"
23.754 -  have "bij_betw ?f (A <+> A) (A \<times> (UNIV::bool set))"
23.755 -  proof-
23.756 -    {fix  c1 and c2 assume "?f c1 = ?f c2"
23.757 -     hence "c1 = c2"
23.758 -     by(case_tac "c1", case_tac "c2", auto, case_tac "c2", auto)
23.759 -    }
23.760 -    moreover
23.761 -    {fix c assume "c \<in> A <+> A"
23.762 -     hence "?f c \<in> A \<times> (UNIV::bool set)"
23.763 -     by(case_tac c, auto)
23.764 -    }
23.765 -    moreover
23.766 -    {fix a bl assume *: "(a,bl) \<in> A \<times> (UNIV::bool set)"
23.767 -     have "(a,bl) \<in> ?f  ( A <+> A)"
23.768 -     proof(cases bl)
23.769 -       assume bl hence "?f(Inl a) = (a,bl)" by auto
23.770 -       thus ?thesis using * by force
23.771 -     next
23.772 -       assume "\<not> bl" hence "?f(Inr a) = (a,bl)" by auto
23.773 -       thus ?thesis using * by force
23.774 -     qed
23.775 -    }
23.776 -    ultimately show ?thesis unfolding bij_betw_def inj_on_def by auto
23.777 -  qed
23.778 -  thus ?thesis using card_of_ordIso by blast
23.779 -qed
23.780 -
23.781 -
23.782 -lemma card_of_Times_mono1:
23.783 -assumes "|A| \<le>o |B|"
23.784 -shows "|A \<times> C| \<le>o |B \<times> C|"
23.785 -proof-
23.786 -  obtain f where 1: "inj_on f A \<and> f  A \<le> B"
23.787 -  using assms card_of_ordLeq[of A] by fastforce
23.788 -  obtain g where g_def:
23.789 -  "g = (\<lambda>(a,c::'c). (f a,c))" by blast
23.790 -  have "inj_on g (A \<times> C) \<and> g  (A \<times> C) \<le> (B \<times> C)"
23.791 -  using 1 unfolding inj_on_def using g_def by auto
23.792 -  thus ?thesis using card_of_ordLeq by metis
23.793 -qed
23.794 -
23.795 -
23.796 -corollary ordLeq_Times_mono1:
23.797 -assumes "r \<le>o r'"
23.798 -shows "|(Field r) \<times> C| \<le>o |(Field r') \<times> C|"
23.799 -using assms card_of_mono2 card_of_Times_mono1 by blast
23.800 -
23.801 -
23.802 -lemma card_of_Times_mono2:
23.803 -assumes "|A| \<le>o |B|"
23.804 -shows "|C \<times> A| \<le>o |C \<times> B|"
23.805 -using assms card_of_Times_mono1[of A B C]
23.806 -      card_of_Times_commute[of C A]  card_of_Times_commute[of B C]
23.807 -      ordIso_ordLeq_trans[of "|C \<times> A|"] ordLeq_ordIso_trans[of "|C \<times> A|"]
23.808 -by blast
23.809 -
23.810 -
23.811 -corollary ordLeq_Times_mono2:
23.812 -assumes "r \<le>o r'"
23.813 -shows "|A \<times> (Field r)| \<le>o |A \<times> (Field r')|"
23.814 -using assms card_of_mono2 card_of_Times_mono2 by blast
23.815 -
23.816 -
23.817 -lemma card_of_Times_cong1:
23.818 -assumes "|A| =o |B|"
23.819 -shows "|A \<times> C| =o |B \<times> C|"
23.820 -using assms by (simp add: ordIso_iff_ordLeq card_of_Times_mono1)
23.821 -
23.822 -
23.823 -lemma card_of_Times_cong2:
23.824 -assumes "|A| =o |B|"
23.825 -shows "|C \<times> A| =o |C \<times> B|"
23.826 -using assms by (simp add: ordIso_iff_ordLeq card_of_Times_mono2)
23.827 -
23.828 -
23.829 -corollary ordIso_Times_cong2:
23.830 -assumes "r =o r'"
23.831 -shows "|A \<times> (Field r)| =o |A \<times> (Field r')|"
23.832 -using assms card_of_cong card_of_Times_cong2 by blast
23.833 -
23.834 -
23.835 -lemma card_of_Sigma_mono1:
23.836 -assumes "\<forall>i \<in> I. |A i| \<le>o |B i|"
23.837 -shows "|SIGMA i : I. A i| \<le>o |SIGMA i : I. B i|"
23.838 -proof-
23.839 -  have "\<forall>i. i \<in> I \<longrightarrow> (\<exists>f. inj_on f (A i) \<and> f  (A i) \<le> B i)"
23.840 -  using assms by (auto simp add: card_of_ordLeq)
23.841 -  with choice[of "\<lambda> i f. i \<in> I \<longrightarrow> inj_on f (A i) \<and> f  (A i) \<le> B i"]
23.842 -  obtain F where 1: "\<forall>i \<in> I. inj_on (F i) (A i) \<and> (F i)  (A i) \<le> B i" by metis
23.843 -  obtain g where g_def: "g = (\<lambda>(i,a::'b). (i,F i a))" by blast
23.844 -  have "inj_on g (Sigma I A) \<and> g  (Sigma I A) \<le> (Sigma I B)"
23.845 -  using 1 unfolding inj_on_def using g_def by force
23.846 -  thus ?thesis using card_of_ordLeq by metis
23.847 -qed
23.848 -
23.849 -
23.850 -corollary card_of_Sigma_Times:
23.851 -"\<forall>i \<in> I. |A i| \<le>o |B| \<Longrightarrow> |SIGMA i : I. A i| \<le>o |I \<times> B|"
23.852 -using card_of_Sigma_mono1[of I A "\<lambda>i. B"] .
23.853 -
23.854 -
23.855 -lemma card_of_UNION_Sigma:
23.856 -"|\<Union>i \<in> I. A i| \<le>o |SIGMA i : I. A i|"
23.857 -using Ex_inj_on_UNION_Sigma[of I A] card_of_ordLeq by metis
23.858 -
23.859 -
23.860 -lemma card_of_bool:
23.861 -assumes "a1 \<noteq> a2"
23.862 -shows "|UNIV::bool set| =o |{a1,a2}|"
23.863 -proof-
23.864 -  let ?f = "\<lambda> bl. case bl of True \<Rightarrow> a1 | False \<Rightarrow> a2"
23.865 -  have "bij_betw ?f UNIV {a1,a2}"
23.866 -  proof-
23.867 -    {fix bl1 and bl2 assume "?f  bl1 = ?f bl2"
23.868 -     hence "bl1 = bl2" using assms by (case_tac bl1, case_tac bl2, auto)
23.869 -    }
23.870 -    moreover
23.871 -    {fix bl have "?f bl \<in> {a1,a2}" by (case_tac bl, auto)
23.872 -    }
23.873 -    moreover
23.874 -    {fix a assume *: "a \<in> {a1,a2}"
23.875 -     have "a \<in> ?f  UNIV"
23.876 -     proof(cases "a = a1")
23.877 -       assume "a = a1"
23.878 -       hence "?f True = a" by auto  thus ?thesis by blast
23.879 -     next
23.880 -       assume "a \<noteq> a1" hence "a = a2" using * by auto
23.881 -       hence "?f False = a" by auto  thus ?thesis by blast
23.882 -     qed
23.883 -    }
23.884 -    ultimately show ?thesis unfolding bij_betw_def inj_on_def
23.885 -    by (metis image_subsetI order_eq_iff subsetI)
23.886 -  qed
23.887 -  thus ?thesis using card_of_ordIso by blast
23.888 -qed
23.889 -
23.890 -
23.891 -lemma card_of_Plus_Times_aux:
23.892 -assumes A2: "a1 \<noteq> a2 \<and> {a1,a2} \<le> A" and
23.893 -        LEQ: "|A| \<le>o |B|"
23.894 -shows "|A <+> B| \<le>o |A \<times> B|"
23.895 -proof-
23.896 -  have 1: "|UNIV::bool set| \<le>o |A|"
23.897 -  using A2 card_of_mono1[of "{a1,a2}"] card_of_bool[of a1 a2]
23.898 -        ordIso_ordLeq_trans[of "|UNIV::bool set|"] by metis
23.899 -  (*  *)
23.900 -  have "|A <+> B| \<le>o |B <+> B|"
23.901 -  using LEQ card_of_Plus_mono1 by blast
23.902 -  moreover have "|B <+> B| =o |B \<times> (UNIV::bool set)|"
23.903 -  using card_of_Plus_Times_bool by blast
23.904 -  moreover have "|B \<times> (UNIV::bool set)| \<le>o |B \<times> A|"
23.905 -  using 1 by (simp add: card_of_Times_mono2)
23.906 -  moreover have " |B \<times> A| =o |A \<times> B|"
23.907 -  using card_of_Times_commute by blast
23.908 -  ultimately show "|A <+> B| \<le>o |A \<times> B|"
23.909 -  using ordLeq_ordIso_trans[of "|A <+> B|" "|B <+> B|" "|B \<times> (UNIV::bool set)|"]
23.910 -        ordLeq_transitive[of "|A <+> B|" "|B \<times> (UNIV::bool set)|" "|B \<times> A|"]
23.911 -        ordLeq_ordIso_trans[of "|A <+> B|" "|B \<times> A|" "|A \<times> B|"]
23.912 -  by blast
23.913 -qed
23.914 -
23.915 -
23.916 -lemma card_of_Plus_Times:
23.917 -assumes A2: "a1 \<noteq> a2 \<and> {a1,a2} \<le> A" and
23.918 -        B2: "b1 \<noteq> b2 \<and> {b1,b2} \<le> B"
23.919 -shows "|A <+> B| \<le>o |A \<times> B|"
23.920 -proof-
23.921 -  {assume "|A| \<le>o |B|"
23.922 -   hence ?thesis using assms by (auto simp add: card_of_Plus_Times_aux)
23.923 -  }
23.924 -  moreover
23.925 -  {assume "|B| \<le>o |A|"
23.926 -   hence "|B <+> A| \<le>o |B \<times> A|"
23.927 -   using assms by (auto simp add: card_of_Plus_Times_aux)
23.928 -   hence ?thesis
23.929 -   using card_of_Plus_commute card_of_Times_commute
23.930 -         ordIso_ordLeq_trans ordLeq_ordIso_trans by metis
23.931 -  }
23.932 -  ultimately show ?thesis
23.933 -  using card_of_Well_order[of A] card_of_Well_order[of B]
23.934 -        ordLeq_total[of "|A|"] by metis
23.935 -qed
23.936 -
23.937 -
23.938 -lemma card_of_ordLeq_finite:
23.939 -assumes "|A| \<le>o |B|" and "finite B"
23.940 -shows "finite A"
23.941 -using assms unfolding ordLeq_def
23.942 -using embed_inj_on[of "|A|" "|B|"]  embed_Field[of "|A|" "|B|"]
23.943 -      Field_card_of[of "A"] Field_card_of[of "B"] inj_on_finite[of _ "A" "B"] by fastforce
23.944 -
23.945 -
23.946 -lemma card_of_ordLeq_infinite:
23.947 -assumes "|A| \<le>o |B|" and "infinite A"
23.948 -shows "infinite B"
23.949 -using assms card_of_ordLeq_finite by auto
23.950 -
23.951 -
23.952 -lemma card_of_ordIso_finite:
23.953 -assumes "|A| =o |B|"
23.954 -shows "finite A = finite B"
23.955 -using assms unfolding ordIso_def iso_def[abs_def]
23.956 -by (auto simp: bij_betw_finite Field_card_of)
23.957 -
23.958 -
23.959 -lemma card_of_ordIso_finite_Field:
23.960 -assumes "Card_order r" and "r =o |A|"
23.961 -shows "finite(Field r) = finite A"
23.962 -using assms card_of_Field_ordIso card_of_ordIso_finite ordIso_equivalence by blast
23.963 -
23.964 -
23.965 -subsection {* Cardinals versus set operations involving infinite sets *}
23.966 -
23.967 -
23.968 -text{* Here we show that, for infinite sets, most set-theoretic constructions
23.969 -do not increase the cardinality.  The cornerstone for this is
23.970 -theorem @{text "Card_order_Times_same_infinite"}, which states that self-product
23.971 -does not increase cardinality -- the proof of this fact adapts a standard
23.972 -set-theoretic argument, as presented, e.g., in the proof of theorem 1.5.11
23.973 -at page 47 in \cite{card-book}. Then everything else follows fairly easily.  *}
23.974 -
23.975 -
23.976 -lemma infinite_iff_card_of_nat:
23.977 -"infinite A = ( |UNIV::nat set| \<le>o |A| )"
23.978 -by (auto simp add: infinite_iff_countable_subset card_of_ordLeq)
23.979 -
23.980 -
23.981 -lemma finite_iff_cardOf_nat:
23.982 -"finite A = ( |A| <o |UNIV :: nat set| )"
23.983 -using infinite_iff_card_of_nat[of A]
23.984 -not_ordLeq_iff_ordLess[of "|A|" "|UNIV :: nat set|"]
23.985 -by (fastforce simp: card_of_Well_order)
23.986 -
23.987 -lemma finite_ordLess_infinite2:
23.988 -assumes "finite A" and "infinite B"
23.989 -shows "|A| <o |B|"
23.990 -using assms
23.991 -finite_ordLess_infinite[of "|A|" "|B|"]
23.992 -card_of_Well_order[of A] card_of_Well_order[of B]
23.993 -Field_card_of[of A] Field_card_of[of B] by auto
23.994 -
23.995 -
23.996 -text{* The next two results correspond to the ZF fact that all infinite cardinals are
23.997 -limit ordinals: *}
23.998 -
23.999 -lemma Card_order_infinite_not_under:
23.1000 -assumes CARD: "Card_order r" and INF: "infinite (Field r)"
23.1001 -shows "\<not> (\<exists>a. Field r = rel.under r a)"
23.1002 -proof(auto)
23.1003 -  have 0: "Well_order r \<and> wo_rel r \<and> Refl r"
23.1004 -  using CARD unfolding wo_rel_def card_order_on_def order_on_defs by auto
23.1005 -  fix a assume *: "Field r = rel.under r a"
23.1006 -  show False
23.1007 -  proof(cases "a \<in> Field r")
23.1008 -    assume Case1: "a \<notin> Field r"
23.1009 -    hence "rel.under r a = {}" unfolding Field_def rel.under_def by auto
23.1010 -    thus False using INF *  by auto
23.1011 -  next
23.1012 -    let ?r' = "Restr r (rel.underS r a)"
23.1013 -    assume Case2: "a \<in> Field r"
23.1014 -    hence 1: "rel.under r a = rel.underS r a \<union> {a} \<and> a \<notin> rel.underS r a"
23.1015 -    using 0 rel.Refl_under_underS rel.underS_notIn by fastforce
23.1016 -    have 2: "wo_rel.ofilter r (rel.underS r a) \<and> rel.underS r a < Field r"
23.1017 -    using 0 wo_rel.underS_ofilter * 1 Case2 by auto
23.1018 -    hence "?r' <o r" using 0 using ofilter_ordLess by blast
23.1019 -    moreover
23.1020 -    have "Field ?r' = rel.underS r a \<and> Well_order ?r'"
23.1021 -    using  2 0 Field_Restr_ofilter[of r] Well_order_Restr[of r] by blast
23.1022 -    ultimately have "|rel.underS r a| <o r" using ordLess_Field[of ?r'] by auto
23.1023 -    moreover have "|rel.under r a| =o r" using * CARD card_of_Field_ordIso[of r] by auto
23.1024 -    ultimately have "|rel.underS r a| <o |rel.under r a|"
23.1025 -    using ordIso_symmetric ordLess_ordIso_trans by blast
23.1026 -    moreover
23.1027 -    {have "\<exists>f. bij_betw f (rel.under r a) (rel.underS r a)"
23.1028 -     using infinite_imp_bij_betw[of "Field r" a] INF * 1 by auto
23.1029 -     hence "|rel.under r a| =o |rel.underS r a|" using card_of_ordIso by blast
23.1030 -    }
23.1031 -    ultimately show False using not_ordLess_ordIso ordIso_symmetric by blast
23.1032 -  qed
23.1033 -qed
23.1034 -
23.1035 -
23.1036 -lemma infinite_Card_order_limit:
23.1037 -assumes r: "Card_order r" and "infinite (Field r)"
23.1038 -and a: "a : Field r"
23.1039 -shows "EX b : Field r. a \<noteq> b \<and> (a,b) : r"
23.1040 -proof-
23.1041 -  have "Field r \<noteq> rel.under r a"
23.1042 -  using assms Card_order_infinite_not_under by blast
23.1043 -  moreover have "rel.under r a \<le> Field r"
23.1044 -  using rel.under_Field .
23.1045 -  ultimately have "rel.under r a < Field r" by blast
23.1046 -  then obtain b where 1: "b : Field r \<and> ~ (b,a) : r"
23.1047 -  unfolding rel.under_def by blast
23.1048 -  moreover have ba: "b \<noteq> a"
23.1049 -  using 1 r unfolding card_order_on_def well_order_on_def
23.1050 -  linear_order_on_def partial_order_on_def preorder_on_def refl_on_def by auto
23.1051 -  ultimately have "(a,b) : r"
23.1052 -  using a r unfolding card_order_on_def well_order_on_def linear_order_on_def
23.1053 -  total_on_def by blast
23.1054 -  thus ?thesis using 1 ba by auto
23.1055 -qed
23.1056 -
23.1057 -
23.1058 -theorem Card_order_Times_same_infinite:
23.1059 -assumes CO: "Card_order r" and INF: "infinite(Field r)"
23.1060 -shows "|Field r \<times> Field r| \<le>o r"
23.1061 -proof-
23.1062 -  obtain phi where phi_def:
23.1063 -  "phi = (\<lambda>r::'a rel. Card_order r \<and> infinite(Field r) \<and>
23.1064 -                      \<not> |Field r \<times> Field r| \<le>o r )" by blast
23.1065 -  have temp1: "\<forall>r. phi r \<longrightarrow> Well_order r"
23.1066 -  unfolding phi_def card_order_on_def by auto
23.1067 -  have Ft: "\<not>(\<exists>r. phi r)"
23.1068 -  proof
23.1069 -    assume "\<exists>r. phi r"
23.1070 -    hence "{r. phi r} \<noteq> {} \<and> {r. phi r} \<le> {r. Well_order r}"
23.1071 -    using temp1 by auto
23.1072 -    then obtain r where 1: "phi r" and 2: "\<forall>r'. phi r' \<longrightarrow> r \<le>o r'" and
23.1073 -                   3: "Card_order r \<and> Well_order r"
23.1074 -    using exists_minim_Well_order[of "{r. phi r}"] temp1 phi_def by blast
23.1075 -    let ?A = "Field r"  let ?r' = "bsqr r"
23.1076 -    have 4: "Well_order ?r' \<and> Field ?r' = ?A \<times> ?A \<and> |?A| =o r"
23.1077 -    using 3 bsqr_Well_order Field_bsqr card_of_Field_ordIso by blast
23.1078 -    have 5: "Card_order |?A \<times> ?A| \<and> Well_order |?A \<times> ?A|"
23.1079 -    using card_of_Card_order card_of_Well_order by blast
23.1080 -    (*  *)
23.1081 -    have "r <o |?A \<times> ?A|"
23.1082 -    using 1 3 5 ordLess_or_ordLeq unfolding phi_def by blast
23.1083 -    moreover have "|?A \<times> ?A| \<le>o ?r'"
23.1084 -    using card_of_least[of "?A \<times> ?A"] 4 by auto
23.1085 -    ultimately have "r <o ?r'" using ordLess_ordLeq_trans by auto
23.1086 -    then obtain f where 6: "embed r ?r' f" and 7: "\<not> bij_betw f ?A (?A \<times> ?A)"
23.1087 -    unfolding ordLess_def embedS_def[abs_def]
23.1088 -    by (auto simp add: Field_bsqr)
23.1089 -    let ?B = "f  ?A"
23.1090 -    have "|?A| =o |?B|"
23.1091 -    using 3 6 embed_inj_on inj_on_imp_bij_betw card_of_ordIso by blast
23.1092 -    hence 8: "r =o |?B|" using 4 ordIso_transitive ordIso_symmetric by blast
23.1093 -    (*  *)
23.1094 -    have "wo_rel.ofilter ?r' ?B"
23.1095 -    using 6 embed_Field_ofilter 3 4 by blast
23.1096 -    hence "wo_rel.ofilter ?r' ?B \<and> ?B \<noteq> ?A \<times> ?A \<and> ?B \<noteq> Field ?r'"
23.1097 -    using 7 unfolding bij_betw_def using 6 3 embed_inj_on 4 by auto
23.1098 -    hence temp2: "wo_rel.ofilter ?r' ?B \<and> ?B < ?A \<times> ?A"
23.1099 -    using 4 wo_rel_def[of ?r'] wo_rel.ofilter_def[of ?r' ?B] by blast
23.1100 -    have "\<not> (\<exists>a. Field r = rel.under r a)"
23.1101 -    using 1 unfolding phi_def using Card_order_infinite_not_under[of r] by auto
23.1102 -    then obtain A1 where temp3: "wo_rel.ofilter r A1 \<and> A1 < ?A" and 9: "?B \<le> A1 \<times> A1"
23.1103 -    using temp2 3 bsqr_ofilter[of r ?B] by blast
23.1104 -    hence "|?B| \<le>o |A1 \<times> A1|" using card_of_mono1 by blast
23.1105 -    hence 10: "r \<le>o |A1 \<times> A1|" using 8 ordIso_ordLeq_trans by blast
23.1106 -    let ?r1 = "Restr r A1"
23.1107 -    have "?r1 <o r" using temp3 ofilter_ordLess 3 by blast
23.1108 -    moreover
23.1109 -    {have "well_order_on A1 ?r1" using 3 temp3 well_order_on_Restr by blast
23.1110 -     hence "|A1| \<le>o ?r1" using 3 Well_order_Restr card_of_least by blast
23.1111 -    }
23.1112 -    ultimately have 11: "|A1| <o r" using ordLeq_ordLess_trans by blast
23.1113 -    (*  *)
23.1114 -    have "infinite (Field r)" using 1 unfolding phi_def by simp
23.1115 -    hence "infinite ?B" using 8 3 card_of_ordIso_finite_Field[of r ?B] by blast
23.1116 -    hence "infinite A1" using 9 infinite_super finite_cartesian_product by blast
23.1117 -    moreover have temp4: "Field |A1| = A1 \<and> Well_order |A1| \<and> Card_order |A1|"
23.1118 -    using card_of_Card_order[of A1] card_of_Well_order[of A1]
23.1119 -    by (simp add: Field_card_of)
23.1120 -    moreover have "\<not> r \<le>o | A1 |"
23.1121 -    using temp4 11 3 using not_ordLeq_iff_ordLess by blast
23.1122 -    ultimately have "infinite(Field |A1| ) \<and> Card_order |A1| \<and> \<not> r \<le>o | A1 |"
23.1123 -    by (simp add: card_of_card_order_on)
23.1124 -    hence "|Field |A1| \<times> Field |A1| | \<le>o |A1|"
23.1125 -    using 2 unfolding phi_def by blast
23.1126 -    hence "|A1 \<times> A1 | \<le>o |A1|" using temp4 by auto
23.1127 -    hence "r \<le>o |A1|" using 10 ordLeq_transitive by blast
23.1128 -    thus False using 11 not_ordLess_ordLeq by auto
23.1129 -  qed
23.1130 -  thus ?thesis using assms unfolding phi_def by blast
23.1131 -qed
23.1132 -
23.1133 -
23.1134 -corollary card_of_Times_same_infinite:
23.1135 -assumes "infinite A"
23.1136 -shows "|A \<times> A| =o |A|"
23.1137 -proof-
23.1138 -  let ?r = "|A|"
23.1139 -  have "Field ?r = A \<and> Card_order ?r"
23.1140 -  using Field_card_of card_of_Card_order[of A] by fastforce
23.1141 -  hence "|A \<times> A| \<le>o |A|"
23.1142 -  using Card_order_Times_same_infinite[of ?r] assms by auto
23.1143 -  thus ?thesis using card_of_Times3 ordIso_iff_ordLeq by blast
23.1144 -qed
23.1145 -
23.1146 -
23.1147 -lemma card_of_Times_infinite:
23.1148 -assumes INF: "infinite A" and NE: "B \<noteq> {}" and LEQ: "|B| \<le>o |A|"
23.1149 -shows "|A \<times> B| =o |A| \<and> |B \<times> A| =o |A|"
23.1150 -proof-
23.1151 -  have "|A| \<le>o |A \<times> B| \<and> |A| \<le>o |B \<times> A|"
23.1152 -  using assms by (simp add: card_of_Times1 card_of_Times2)
23.1153 -  moreover
23.1154 -  {have "|A \<times> B| \<le>o |A \<times> A| \<and> |B \<times> A| \<le>o |A \<times> A|"
23.1155 -   using LEQ card_of_Times_mono1 card_of_Times_mono2 by blast
23.1156 -   moreover have "|A \<times> A| =o |A|" using INF card_of_Times_same_infinite by blast
23.1157 -   ultimately have "|A \<times> B| \<le>o |A| \<and> |B \<times> A| \<le>o |A|"
23.1158 -   using ordLeq_ordIso_trans[of "|A \<times> B|"] ordLeq_ordIso_trans[of "|B \<times> A|"] by auto
23.1159 -  }
23.1160 -  ultimately show ?thesis by (simp add: ordIso_iff_ordLeq)
23.1161 -qed
23.1162 -
23.1163 -
23.1164 -corollary card_of_Times_infinite_simps:
23.1165 -"\<lbrakk>infinite A; B \<noteq> {}; |B| \<le>o |A|\<rbrakk> \<Longrightarrow> |A \<times> B| =o |A|"
23.1166 -"\<lbrakk>infinite A; B \<noteq> {}; |B| \<le>o |A|\<rbrakk> \<Longrightarrow> |A| =o |A \<times> B|"
23.1167 -"\<lbrakk>infinite A; B \<noteq> {}; |B| \<le>o |A|\<rbrakk> \<Longrightarrow> |B \<times> A| =o |A|"
23.1168 -"\<lbrakk>infinite A; B \<noteq> {}; |B| \<le>o |A|\<rbrakk> \<Longrightarrow> |A| =o |B \<times> A|"
23.1169 -by (auto simp add: card_of_Times_infinite ordIso_symmetric)
23.1170 -
23.1171 -
23.1172 -corollary Card_order_Times_infinite:
23.1173 -assumes INF: "infinite(Field r)" and CARD: "Card_order r" and
23.1174 -        NE: "Field p \<noteq> {}" and LEQ: "p \<le>o r"
23.1175 -shows "| (Field r) \<times> (Field p) | =o r \<and> | (Field p) \<times> (Field r) | =o r"
23.1176 -proof-
23.1177 -  have "|Field r \<times> Field p| =o |Field r| \<and> |Field p \<times> Field r| =o |Field r|"
23.1178 -  using assms by (simp add: card_of_Times_infinite card_of_mono2)
23.1179 -  thus ?thesis
23.1180 -  using assms card_of_Field_ordIso[of r]
23.1181 -        ordIso_transitive[of "|Field r \<times> Field p|"]
23.1182 -        ordIso_transitive[of _ "|Field r|"] by blast
23.1183 -qed
23.1184 -
23.1185 -
23.1186 -lemma card_of_Sigma_ordLeq_infinite:
23.1187 -assumes INF: "infinite B" and
23.1188 -        LEQ_I: "|I| \<le>o |B|" and LEQ: "\<forall>i \<in> I. |A i| \<le>o |B|"
23.1189 -shows "|SIGMA i : I. A i| \<le>o |B|"
23.1190 -proof(cases "I = {}", simp add: card_of_empty)
23.1191 -  assume *: "I \<noteq> {}"
23.1192 -  have "|SIGMA i : I. A i| \<le>o |I \<times> B|"
23.1193 -  using LEQ card_of_Sigma_Times by blast
23.1194 -  moreover have "|I \<times> B| =o |B|"
23.1195 -  using INF * LEQ_I by (auto simp add: card_of_Times_infinite)
23.1196 -  ultimately show ?thesis using ordLeq_ordIso_trans by blast
23.1197 -qed
23.1198 -
23.1199 -
23.1200 -lemma card_of_Sigma_ordLeq_infinite_Field:
23.1201 -assumes INF: "infinite (Field r)" and r: "Card_order r" and
23.1202 -        LEQ_I: "|I| \<le>o r" and LEQ: "\<forall>i \<in> I. |A i| \<le>o r"
23.1203 -shows "|SIGMA i : I. A i| \<le>o r"
23.1204 -proof-
23.1205 -  let ?B  = "Field r"
23.1206 -  have 1: "r =o |?B| \<and> |?B| =o r" using r card_of_Field_ordIso
23.1207 -  ordIso_symmetric by blast
23.1208 -  hence "|I| \<le>o |?B|"  "\<forall>i \<in> I. |A i| \<le>o |?B|"
23.1209 -  using LEQ_I LEQ ordLeq_ordIso_trans by blast+
23.1210 -  hence  "|SIGMA i : I. A i| \<le>o |?B|" using INF LEQ
23.1211 -  card_of_Sigma_ordLeq_infinite by blast
23.1212 -  thus ?thesis using 1 ordLeq_ordIso_trans by blast
23.1213 -qed
23.1214 -
23.1215 -
23.1216 -lemma card_of_Times_ordLeq_infinite_Field:
23.1217 -"\<lbrakk>infinite (Field r); |A| \<le>o r; |B| \<le>o r; Card_order r\<rbrakk>
23.1218 - \<Longrightarrow> |A <*> B| \<le>o r"
23.1219 -by(simp add: card_of_Sigma_ordLeq_infinite_Field)
23.1220 -
23.1221 -
23.1222 -lemma card_of_UNION_ordLeq_infinite:
23.1223 -assumes INF: "infinite B" and
23.1224 -        LEQ_I: "|I| \<le>o |B|" and LEQ: "\<forall>i \<in> I. |A i| \<le>o |B|"
23.1225 -shows "|\<Union> i \<in> I. A i| \<le>o |B|"
23.1226 -proof(cases "I = {}", simp add: card_of_empty)
23.1227 -  assume *: "I \<noteq> {}"
23.1228 -  have "|\<Union> i \<in> I. A i| \<le>o |SIGMA i : I. A i|"
23.1229 -  using card_of_UNION_Sigma by blast
23.1230 -  moreover have "|SIGMA i : I. A i| \<le>o |B|"
23.1231 -  using assms card_of_Sigma_ordLeq_infinite by blast
23.1232 -  ultimately show ?thesis using ordLeq_transitive by blast
23.1233 -qed
23.1234 -
23.1235 -
23.1236 -corollary card_of_UNION_ordLeq_infinite_Field:
23.1237 -assumes INF: "infinite (Field r)" and r: "Card_order r" and
23.1238 -        LEQ_I: "|I| \<le>o r" and LEQ: "\<forall>i \<in> I. |A i| \<le>o r"
23.1239 -shows "|\<Union> i \<in> I. A i| \<le>o r"
23.1240 -proof-
23.1241 -  let ?B  = "Field r"
23.1242 -  have 1: "r =o |?B| \<and> |?B| =o r" using r card_of_Field_ordIso
23.1243 -  ordIso_symmetric by blast
23.1244 -  hence "|I| \<le>o |?B|"  "\<forall>i \<in> I. |A i| \<le>o |?B|"
23.1245 -  using LEQ_I LEQ ordLeq_ordIso_trans by blast+
23.1246 -  hence  "|\<Union> i \<in> I. A i| \<le>o |?B|" using INF LEQ
23.1247 -  card_of_UNION_ordLeq_infinite by blast
23.1248 -  thus ?thesis using 1 ordLeq_ordIso_trans by blast
23.1249 -qed
23.1250 -
23.1251 -
23.1252 -lemma card_of_Plus_infinite1:
23.1253 -assumes INF: "infinite A" and LEQ: "|B| \<le>o |A|"
23.1254 -shows "|A <+> B| =o |A|"
23.1255 -proof(cases "B = {}", simp add: card_of_Plus_empty1 card_of_Plus_empty2 ordIso_symmetric)
23.1256 -  let ?Inl = "Inl::'a \<Rightarrow> 'a + 'b"  let ?Inr = "Inr::'b \<Rightarrow> 'a + 'b"
23.1257 -  assume *: "B \<noteq> {}"
23.1258 -  then obtain b1 where 1: "b1 \<in> B" by blast
23.1259 -  show ?thesis
23.1260 -  proof(cases "B = {b1}")
23.1261 -    assume Case1: "B = {b1}"
23.1262 -    have 2: "bij_betw ?Inl A ((?Inl  A))"
23.1263 -    unfolding bij_betw_def inj_on_def by auto
23.1264 -    hence 3: "infinite (?Inl  A)"
23.1265 -    using INF bij_betw_finite[of ?Inl A] by blast
23.1266 -    let ?A' = "?Inl  A \<union> {?Inr b1}"
23.1267 -    obtain g where "bij_betw g (?Inl  A) ?A'"
23.1268 -    using 3 infinite_imp_bij_betw2[of "?Inl  A"] by auto
23.1269 -    moreover have "?A' = A <+> B" using Case1 by blast
23.1270 -    ultimately have "bij_betw g (?Inl  A) (A <+> B)" by simp
23.1271 -    hence "bij_betw (g o ?Inl) A (A <+> B)"
23.1272 -    using 2 by (auto simp add: bij_betw_trans)
23.1273 -    thus ?thesis using card_of_ordIso ordIso_symmetric by blast
23.1274 -  next
23.1275 -    assume Case2: "B \<noteq> {b1}"
23.1276 -    with * 1 obtain b2 where 3: "b1 \<noteq> b2 \<and> {b1,b2} \<le> B" by fastforce
23.1277 -    obtain f where "inj_on f B \<and> f  B \<le> A"
23.1278 -    using LEQ card_of_ordLeq[of B] by fastforce
23.1279 -    with 3 have "f b1 \<noteq> f b2 \<and> {f b1, f b2} \<le> A"
23.1280 -    unfolding inj_on_def by auto
23.1281 -    with 3 have "|A <+> B| \<le>o |A \<times> B|"
23.1282 -    by (auto simp add: card_of_Plus_Times)
23.1283 -    moreover have "|A \<times> B| =o |A|"
23.1284 -    using assms * by (simp add: card_of_Times_infinite_simps)
23.1285 -    ultimately have "|A <+> B| \<le>o |A|" using ordLeq_ordIso_trans by metis
23.1286 -    thus ?thesis using card_of_Plus1 ordIso_iff_ordLeq by blast
23.1287 -  qed
23.1288 -qed
23.1289 -
23.1290 -
23.1291 -lemma card_of_Plus_infinite2:
23.1292 -assumes INF: "infinite A" and LEQ: "|B| \<le>o |A|"
23.1293 -shows "|B <+> A| =o |A|"
23.1294 -using assms card_of_Plus_commute card_of_Plus_infinite1
23.1295 -ordIso_equivalence by blast
23.1296 -
23.1297 -
23.1298 -lemma card_of_Plus_infinite:
23.1299 -assumes INF: "infinite A" and LEQ: "|B| \<le>o |A|"
23.1300 -shows "|A <+> B| =o |A| \<and> |B <+> A| =o |A|"
23.1301 -using assms by (auto simp: card_of_Plus_infinite1 card_of_Plus_infinite2)
23.1302 -
23.1303 -
23.1304 -corollary Card_order_Plus_infinite:
23.1305 -assumes INF: "infinite(Field r)" and CARD: "Card_order r" and
23.1306 -        LEQ: "p \<le>o r"
23.1307 -shows "| (Field r) <+> (Field p) | =o r \<and> | (Field p) <+> (Field r) | =o r"
23.1308 -proof-
23.1309 -  have "| Field r <+> Field p | =o | Field r | \<and>
23.1310 -        | Field p <+> Field r | =o | Field r |"
23.1311 -  using assms by (simp add: card_of_Plus_infinite card_of_mono2)
23.1312 -  thus ?thesis
23.1313 -  using assms card_of_Field_ordIso[of r]
23.1314 -        ordIso_transitive[of "|Field r <+> Field p|"]
23.1315 -        ordIso_transitive[of _ "|Field r|"] by blast
23.1316 -qed
23.1317 -
23.1318 -
23.1319 -lemma card_of_Un_infinite:
23.1320 -assumes INF: "infinite A" and LEQ: "|B| \<le>o |A|"
23.1321 -shows "|A \<union> B| =o |A| \<and> |B \<union> A| =o |A|"
23.1322 -proof-
23.1323 -  have "|A \<union> B| \<le>o |A <+> B|" by (rule card_of_Un_Plus_ordLeq)
23.1324 -  moreover have "|A <+> B| =o |A|"
23.1325 -  using assms by (metis card_of_Plus_infinite)
23.1326 -  ultimately have "|A \<union> B| \<le>o |A|" using ordLeq_ordIso_trans by blast
23.1327 -  hence "|A \<union> B| =o |A|" using card_of_Un1 ordIso_iff_ordLeq by blast
23.1328 -  thus ?thesis using Un_commute[of B A] by auto
23.1329 -qed
23.1330 -
23.1331 -
23.1332 -lemma card_of_Un_diff_infinite:
23.1333 -assumes INF: "infinite A" and LESS: "|B| <o |A|"
23.1334 -shows "|A - B| =o |A|"
23.1335 -proof-
23.1336 -  obtain C where C_def: "C = A - B" by blast
23.1337 -  have "|A \<union> B| =o |A|"
23.1338 -  using assms ordLeq_iff_ordLess_or_ordIso card_of_Un_infinite by blast
23.1339 -  moreover have "C \<union> B = A \<union> B" unfolding C_def by auto
23.1340 -  ultimately have 1: "|C \<union> B| =o |A|" by auto
23.1341 -  (*  *)
23.1342 -  {assume *: "|C| \<le>o |B|"
23.1343 -   moreover
23.1344 -   {assume **: "finite B"
23.1345 -    hence "finite C"
23.1346 -    using card_of_ordLeq_finite * by blast
23.1347 -    hence False using ** INF card_of_ordIso_finite 1 by blast
23.1348 -   }
23.1349 -   hence "infinite B" by auto
23.1350 -   ultimately have False
23.1351 -   using card_of_Un_infinite 1 ordIso_equivalence(1,3) LESS not_ordLess_ordIso by metis
23.1352 -  }
23.1353 -  hence 2: "|B| \<le>o |C|" using card_of_Well_order ordLeq_total by blast
23.1354 -  {assume *: "finite C"
23.1355 -    hence "finite B" using card_of_ordLeq_finite 2 by blast
23.1356 -    hence False using * INF card_of_ordIso_finite 1 by blast
23.1357 -  }
23.1358 -  hence "infinite C" by auto
23.1359 -  hence "|C| =o |A|"
23.1360 -  using  card_of_Un_infinite 1 2 ordIso_equivalence(1,3) by metis
23.1361 -  thus ?thesis unfolding C_def .
23.1362 -qed
23.1363 -
23.1364 -
23.1365 -lemma card_of_Plus_ordLess_infinite:
23.1366 -assumes INF: "infinite C" and
23.1367 -        LESS1: "|A| <o |C|" and LESS2: "|B| <o |C|"
23.1368 -shows "|A <+> B| <o |C|"
23.1369 -proof(cases "A = {} \<or> B = {}")
23.1370 -  assume Case1: "A = {} \<or> B = {}"
23.1371 -  hence "|A| =o |A <+> B| \<or> |B| =o |A <+> B|"
23.1372 -  using card_of_Plus_empty1 card_of_Plus_empty2 by blast
23.1373 -  hence "|A <+> B| =o |A| \<or> |A <+> B| =o |B|"
23.1374 -  using ordIso_symmetric[of "|A|"] ordIso_symmetric[of "|B|"] by blast
23.1375 -  thus ?thesis using LESS1 LESS2
23.1376 -       ordIso_ordLess_trans[of "|A <+> B|" "|A|"]
23.1377 -       ordIso_ordLess_trans[of "|A <+> B|" "|B|"] by blast
23.1378 -next
23.1379 -  assume Case2: "\<not>(A = {} \<or> B = {})"
23.1380 -  {assume *: "|C| \<le>o |A <+> B|"
23.1381 -   hence "infinite (A <+> B)" using INF card_of_ordLeq_finite by blast
23.1382 -   hence 1: "infinite A \<or> infinite B" using finite_Plus by blast
23.1383 -   {assume Case21: "|A| \<le>o |B|"
23.1384 -    hence "infinite B" using 1 card_of_ordLeq_finite by blast
23.1385 -    hence "|A <+> B| =o |B|" using Case2 Case21
23.1386 -    by (auto simp add: card_of_Plus_infinite)
23.1387 -    hence False using LESS2 not_ordLess_ordLeq * ordLeq_ordIso_trans by blast
23.1388 -   }
23.1389 -   moreover
23.1390 -   {assume Case22: "|B| \<le>o |A|"
23.1391 -    hence "infinite A" using 1 card_of_ordLeq_finite by blast
23.1392 -    hence "|A <+> B| =o |A|" using Case2 Case22
23.1393 -    by (auto simp add: card_of_Plus_infinite)
23.1394 -    hence False using LESS1 not_ordLess_ordLeq * ordLeq_ordIso_trans by blast
23.1395 -   }
23.1396 -   ultimately have False using ordLeq_total card_of_Well_order[of A]
23.1397 -   card_of_Well_order[of B] by blast
23.1398 -  }
23.1399 -  thus ?thesis using ordLess_or_ordLeq[of "|A <+> B|" "|C|"]
23.1400 -  card_of_Well_order[of "A <+> B"] card_of_Well_order[of "C"] by auto
23.1401 -qed
23.1402 -
23.1403 -
23.1404 -lemma card_of_Plus_ordLess_infinite_Field:
23.1405 -assumes INF: "infinite (Field r)" and r: "Card_order r" and
23.1406 -        LESS1: "|A| <o r" and LESS2: "|B| <o r"
23.1407 -shows "|A <+> B| <o r"
23.1408 -proof-
23.1409 -  let ?C  = "Field r"
23.1410 -  have 1: "r =o |?C| \<and> |?C| =o r" using r card_of_Field_ordIso
23.1411 -  ordIso_symmetric by blast
23.1412 -  hence "|A| <o |?C|"  "|B| <o |?C|"
23.1413 -  using LESS1 LESS2 ordLess_ordIso_trans by blast+
23.1414 -  hence  "|A <+> B| <o |?C|" using INF
23.1415 -  card_of_Plus_ordLess_infinite by blast
23.1416 -  thus ?thesis using 1 ordLess_ordIso_trans by blast
23.1417 -qed
23.1418 -
23.1419 -
23.1420 -lemma infinite_card_of_insert:
23.1421 -assumes "infinite A"
23.1422 -shows "|insert a A| =o |A|"
23.1423 -proof-
23.1424 -  have iA: "insert a A = A \<union> {a}" by simp
23.1425 -  show ?thesis
23.1426 -  using infinite_imp_bij_betw2[OF assms] unfolding iA
23.1427 -  by (metis bij_betw_inv card_of_ordIso)
23.1428 -qed
23.1429 -
23.1430 -
23.1431 -subsection {* Cardinals versus lists  *}
23.1432 -
23.1433 -
23.1434 -text{* The next is an auxiliary operator, which shall be used for inductive
23.1435 -proofs of facts concerning the cardinality of @{text "List"} : *}
23.1436 -
23.1437 -definition nlists :: "'a set \<Rightarrow> nat \<Rightarrow> 'a list set"
23.1438 -where "nlists A n \<equiv> {l. set l \<le> A \<and> length l = n}"
23.1439 -
23.1440 -
23.1441 -lemma lists_def2: "lists A = {l. set l \<le> A}"
23.1442 -using in_listsI by blast
23.1443 -
23.1444 -
23.1445 -lemma lists_UNION_nlists: "lists A = (\<Union> n. nlists A n)"
23.1446 -unfolding lists_def2 nlists_def by blast
23.1447 -
23.1448 -
23.1449 -lemma card_of_lists: "|A| \<le>o |lists A|"
23.1450 -proof-
23.1451 -  let ?h = "\<lambda> a. [a]"
23.1452 -  have "inj_on ?h A \<and> ?h  A \<le> lists A"
23.1453 -  unfolding inj_on_def lists_def2 by auto
23.1454 -  thus ?thesis by (metis card_of_ordLeq)
23.1455 -qed
23.1456 -
23.1457 -
23.1458 -lemma nlists_0: "nlists A 0 = {[]}"
23.1459 -unfolding nlists_def by auto
23.1460 -
23.1461 -
23.1462 -lemma nlists_not_empty:
23.1463 -assumes "A \<noteq> {}"
23.1464 -shows "nlists A n \<noteq> {}"
23.1465 -proof(induct n, simp add: nlists_0)
23.1466 -  fix n assume "nlists A n \<noteq> {}"
23.1467 -  then obtain a and l where "a \<in> A \<and> l \<in> nlists A n" using assms by auto
23.1468 -  hence "a # l \<in> nlists A (Suc n)" unfolding nlists_def by auto
23.1469 -  thus "nlists A (Suc n) \<noteq> {}" by auto
23.1470 -qed
23.1471 -
23.1472 -
23.1473 -lemma Nil_in_lists: "[] \<in> lists A"
23.1474 -unfolding lists_def2 by auto
23.1475 -
23.1476 -
23.1477 -lemma lists_not_empty: "lists A \<noteq> {}"
23.1478 -using Nil_in_lists by blast
23.1479 -
23.1480 -
23.1481 -lemma card_of_nlists_Succ: "|nlists A (Suc n)| =o |A \<times> (nlists A n)|"
23.1482 -proof-
23.1483 -  let ?B = "A \<times> (nlists A n)"   let ?h = "\<lambda>(a,l). a # l"
23.1484 -  have "inj_on ?h ?B \<and> ?h  ?B \<le> nlists A (Suc n)"
23.1485 -  unfolding inj_on_def nlists_def by auto
23.1486 -  moreover have "nlists A (Suc n) \<le> ?h  ?B"
23.1487 -  proof(auto)
23.1488 -    fix l assume "l \<in> nlists A (Suc n)"
23.1489 -    hence 1: "length l = Suc n \<and> set l \<le> A" unfolding nlists_def by auto
23.1490 -    then obtain a and l' where 2: "l = a # l'" by (auto simp: length_Suc_conv)
23.1491 -    hence "a \<in> A \<and> set l' \<le> A \<and> length l' = n" using 1 by auto
23.1492 -    thus "l \<in> ?h  ?B"  using 2 unfolding nlists_def by auto
23.1493 -  qed
23.1494 -  ultimately have "bij_betw ?h ?B (nlists A (Suc n))"
23.1495 -  unfolding bij_betw_def by auto
23.1496 -  thus ?thesis using card_of_ordIso ordIso_symmetric by blast
23.1497 -qed
23.1498 -
23.1499 -
23.1500 -lemma card_of_nlists_infinite:
23.1501 -assumes "infinite A"
23.1502 -shows "|nlists A n| \<le>o |A|"
23.1503 -proof(induct n)
23.1504 -  have "A \<noteq> {}" using assms by auto
23.1505 -  thus "|nlists A 0| \<le>o |A|" by (simp add: nlists_0 card_of_singl_ordLeq)
23.1506 -next
23.1507 -  fix n assume IH: "|nlists A n| \<le>o |A|"
23.1508 -  have "|nlists A (Suc n)| =o |A \<times> (nlists A n)|"
23.1509 -  using card_of_nlists_Succ by blast
23.1510 -  moreover
23.1511 -  {have "nlists A n \<noteq> {}" using assms nlists_not_empty[of A] by blast
23.1512 -   hence "|A \<times> (nlists A n)| =o |A|"
23.1513 -   using assms IH by (auto simp add: card_of_Times_infinite)
23.1514 -  }
23.1515 -  ultimately show "|nlists A (Suc n)| \<le>o |A|"
23.1516 -  using ordIso_transitive ordIso_iff_ordLeq by blast
23.1517 -qed
23.1518 -
23.1519 -
23.1520 -lemma card_of_lists_infinite:
23.1521 -assumes "infinite A"
23.1522 -shows "|lists A| =o |A|"
23.1523 -proof-
23.1524 -  have "|lists A| \<le>o |A|"
23.1525 -  using assms
23.1526 -  by (auto simp add: lists_UNION_nlists card_of_UNION_ordLeq_infinite
23.1527 -                     infinite_iff_card_of_nat card_of_nlists_infinite)
23.1528 -  thus ?thesis using card_of_lists ordIso_iff_ordLeq by blast
23.1529 -qed
23.1530 -
23.1531 -
23.1532 -lemma Card_order_lists_infinite:
23.1533 -assumes "Card_order r" and "infinite(Field r)"
23.1534 -shows "|lists(Field r)| =o r"
23.1535 -using assms card_of_lists_infinite card_of_Field_ordIso ordIso_transitive by blast
23.1536 -
23.1537 -
23.1538 -
23.1539 -subsection {* The cardinal $\omega$ and the finite cardinals  *}
23.1540 -
23.1541 -
23.1542 -text{* The cardinal $\omega$, of natural numbers, shall be the standard non-strict
23.1543 -order relation on
23.1544 -@{text "nat"}, that we abbreviate by @{text "natLeq"}.  The finite cardinals
23.1545 -shall be the restrictions of these relations to the numbers smaller than
23.1546 -fixed numbers @{text "n"}, that we abbreviate by @{text "natLeq_on n"}.  *}
23.1547 -
23.1548 -abbreviation "(natLeq::(nat * nat) set) \<equiv> {(x,y). x \<le> y}"
23.1549 -abbreviation "(natLess::(nat * nat) set) \<equiv> {(x,y). x < y}"
23.1550 -
23.1551 -abbreviation natLeq_on :: "nat \<Rightarrow> (nat * nat) set"
23.1552 -where "natLeq_on n \<equiv> {(x,y). x < n \<and> y < n \<and> x \<le> y}"
23.1553 -
23.1554 -lemma infinite_cartesian_product:
23.1555 -assumes "infinite A" "infinite B"
23.1556 -shows "infinite (A \<times> B)"
23.1557 -proof
23.1558 -  assume "finite (A \<times> B)"
23.1559 -  from assms(1) have "A \<noteq> {}" by auto
23.1560 -  with finite (A \<times> B) have "finite B" using finite_cartesian_productD2 by auto
23.1561 -  with assms(2) show False by simp
23.1562 -qed
23.1563 -
23.1564 -
23.1565 -
23.1566 -subsubsection {* First as well-orders *}
23.1567 -
23.1568 -
23.1569 -lemma Field_natLeq: "Field natLeq = (UNIV::nat set)"
23.1570 -by(unfold Field_def, auto)
23.1571 -
23.1572 -
23.1573 -lemma natLeq_Refl: "Refl natLeq"
23.1574 -unfolding refl_on_def Field_def by auto
23.1575 -
23.1576 -
23.1577 -lemma natLeq_trans: "trans natLeq"
23.1578 -unfolding trans_def by auto
23.1579 -
23.1580 -
23.1581 -lemma natLeq_Preorder: "Preorder natLeq"
23.1582 -unfolding preorder_on_def
23.1583 -by (auto simp add: natLeq_Refl natLeq_trans)
23.1584 -
23.1585 -
23.1586 -lemma natLeq_antisym: "antisym natLeq"
23.1587 -unfolding antisym_def by auto
23.1588 -
23.1589 -
23.1590 -lemma natLeq_Partial_order: "Partial_order natLeq"
23.1591 -unfolding partial_order_on_def
23.1592 -by (auto simp add: natLeq_Preorder natLeq_antisym)
23.1593 -
23.1594 -
23.1595 -lemma natLeq_Total: "Total natLeq"
23.1596 -unfolding total_on_def by auto
23.1597 -
23.1598 -
23.1599 -lemma natLeq_Linear_order: "Linear_order natLeq"
23.1600 -unfolding linear_order_on_def
23.1601 -by (auto simp add: natLeq_Partial_order natLeq_Total)
23.1602 -
23.1603 -
23.1604 -lemma natLeq_natLess_Id: "natLess = natLeq - Id"
23.1605 -by auto
23.1606 -
23.1607 -
23.1608 -lemma natLeq_Well_order: "Well_order natLeq"
23.1609 -unfolding well_order_on_def
23.1610 -using natLeq_Linear_order wf_less natLeq_natLess_Id by auto
23.1611 -
23.1612 -
23.1613 -corollary natLeq_well_order_on: "well_order_on UNIV natLeq"
23.1614 -using natLeq_Well_order Field_natLeq by auto
23.1615 -
23.1616 -
23.1617 -lemma natLeq_wo_rel: "wo_rel natLeq"
23.1618 -unfolding wo_rel_def using natLeq_Well_order .
23.1619 -
23.1620 -
23.1621 -lemma natLeq_UNIV_ofilter: "wo_rel.ofilter natLeq UNIV"
23.1622 -using natLeq_wo_rel Field_natLeq wo_rel.Field_ofilter[of natLeq] by auto
23.1623 -
23.1624 -
23.1625 -lemma closed_nat_set_iff:
23.1626 -assumes "\<forall>(m::nat) n. n \<in> A \<and> m \<le> n \<longrightarrow> m \<in> A"
23.1627 -shows "A = UNIV \<or> (\<exists>n. A = {0 ..< n})"
23.1628 -proof-
23.1629 -  {assume "A \<noteq> UNIV" hence "\<exists>n. n \<notin> A" by blast
23.1630 -   moreover obtain n where n_def: "n = (LEAST n. n \<notin> A)" by blast
23.1631 -   ultimately have 1: "n \<notin> A \<and> (\<forall>m. m < n \<longrightarrow> m \<in> A)"
23.1632 -   using LeastI_ex[of "\<lambda> n. n \<notin> A"] n_def Least_le[of "\<lambda> n. n \<notin> A"] by fastforce
23.1633 -   have "A = {0 ..< n}"
23.1634 -   proof(auto simp add: 1)
23.1635 -     fix m assume *: "m \<in> A"
23.1636 -     {assume "n \<le> m" with assms * have "n \<in> A" by blast
23.1637 -      hence False using 1 by auto
23.1638 -     }
23.1639 -     thus "m < n" by fastforce
23.1640 -   qed
23.1641 -   hence "\<exists>n. A = {0 ..< n}" by blast
23.1642 -  }
23.1643 -  thus ?thesis by blast
23.1644 -qed
23.1645 -
23.1646 -
23.1647 -lemma Field_natLeq_on: "Field (natLeq_on n) = {0 ..< n}"
23.1648 -unfolding Field_def by auto
23.1649 -
23.1650 -
23.1651 -lemma natLeq_underS_less: "rel.underS natLeq n = {0 ..< n}"
23.1652 -unfolding rel.underS_def by auto
23.1653 -
23.1654 -
23.1655 -lemma Restr_natLeq: "Restr natLeq {0 ..< n} = natLeq_on n"
23.1656 -by auto
23.1657 -
23.1658 -
23.1659 -lemma Restr_natLeq2:
23.1660 -"Restr natLeq (rel.underS natLeq n) = natLeq_on n"
23.1661 -by (auto simp add: Restr_natLeq natLeq_underS_less)
23.1662 -
23.1663 -
23.1664 -lemma natLeq_on_Well_order: "Well_order(natLeq_on n)"
23.1665 -using Restr_natLeq[of n] natLeq_Well_order
23.1666 -      Well_order_Restr[of natLeq "{0..<n}"] by auto
23.1667 -
23.1668 -
23.1669 -corollary natLeq_on_well_order_on: "well_order_on {0 ..< n} (natLeq_on n)"
23.1670 -using natLeq_on_Well_order Field_natLeq_on by auto
23.1671 -
23.1672 -
23.1673 -lemma natLeq_on_wo_rel: "wo_rel(natLeq_on n)"
23.1674 -unfolding wo_rel_def using natLeq_on_Well_order .
23.1675 -
23.1676 -
23.1677 -lemma natLeq_on_ofilter_less_eq:
23.1678 -"n \<le> m \<Longrightarrow> wo_rel.ofilter (natLeq_on m) {0 ..< n}"
23.1679 -by (auto simp add: natLeq_on_wo_rel wo_rel.ofilter_def,
23.1680 -    simp add: Field_natLeq_on, unfold rel.under_def, auto)
23.1681 -
23.1682 -
23.1683 -lemma natLeq_on_ofilter_iff:
23.1684 -"wo_rel.ofilter (natLeq_on m) A = (\<exists>n \<le> m. A = {0 ..< n})"
23.1685 -proof(rule iffI)
23.1686 -  assume *: "wo_rel.ofilter (natLeq_on m) A"
23.1687 -  hence 1: "A \<le> {0..<m}"
23.1688 -  by (auto simp add: natLeq_on_wo_rel wo_rel.ofilter_def rel.under_def Field_natLeq_on)
23.1689 -  hence "\<forall>n1 n2. n2 \<in> A \<and> n1 \<le> n2 \<longrightarrow> n1 \<in> A"
23.1690 -  using * by(fastforce simp add: natLeq_on_wo_rel wo_rel.ofilter_def rel.under_def)
23.1691 -  hence "A = UNIV \<or> (\<exists>n. A = {0 ..< n})" using closed_nat_set_iff by blast
23.1692 -  thus "\<exists>n \<le> m. A = {0 ..< n}" using 1 atLeastLessThan_less_eq by blast
23.1693 -next
23.1694 -  assume "(\<exists>n\<le>m. A = {0 ..< n})"
23.1695 -  thus "wo_rel.ofilter (natLeq_on m) A" by (auto simp add: natLeq_on_ofilter_less_eq)
23.1696 -qed
23.1697 -
23.1698 -
23.1699 -
23.1700 -subsubsection {* Then as cardinals *}
23.1701 -
23.1702 -
23.1703 -lemma natLeq_Card_order: "Card_order natLeq"
23.1704 -proof(auto simp add: natLeq_Well_order
23.1705 -      Card_order_iff_Restr_underS Restr_natLeq2, simp add:  Field_natLeq)
23.1706 -  fix n have "finite(Field (natLeq_on n))"
23.1707 -  unfolding Field_natLeq_on by auto
23.1708 -  moreover have "infinite(UNIV::nat set)" by auto
23.1709 -  ultimately show "natLeq_on n <o |UNIV::nat set|"
23.1710 -  using finite_ordLess_infinite[of "natLeq_on n" "|UNIV::nat set|"]
23.1711 -        Field_card_of[of "UNIV::nat set"]
23.1712 -        card_of_Well_order[of "UNIV::nat set"] natLeq_on_Well_order[of n] by auto
23.1713 -qed
23.1714 -
23.1715 -
23.1716 -corollary card_of_Field_natLeq:
23.1717 -"|Field natLeq| =o natLeq"
23.1718 -using Field_natLeq natLeq_Card_order Card_order_iff_ordIso_card_of[of natLeq]
23.1719 -      ordIso_symmetric[of natLeq] by blast
23.1720 -
23.1721 -
23.1722 -corollary card_of_nat:
23.1723 -"|UNIV::nat set| =o natLeq"
23.1724 -using Field_natLeq card_of_Field_natLeq by auto
23.1725 -
23.1726 -
23.1727 -corollary infinite_iff_natLeq_ordLeq:
23.1728 -"infinite A = ( natLeq \<le>o |A| )"
23.1729 -using infinite_iff_card_of_nat[of A] card_of_nat
23.1730 -      ordIso_ordLeq_trans ordLeq_ordIso_trans ordIso_symmetric by blast
23.1731 -
23.1732 -
23.1733 -corollary finite_iff_ordLess_natLeq:
23.1734 -"finite A = ( |A| <o natLeq)"
23.1735 -using infinite_iff_natLeq_ordLeq not_ordLeq_iff_ordLess
23.1736 -      card_of_Well_order natLeq_Well_order by blast
23.1737 -
23.1738 -
23.1739 -lemma ordIso_natLeq_on_imp_finite:
23.1740 -"|A| =o natLeq_on n \<Longrightarrow> finite A"
23.1741 -unfolding ordIso_def iso_def[abs_def]
23.1742 -by (auto simp: Field_natLeq_on bij_betw_finite Field_card_of)
23.1743 -
23.1744 -
23.1745 -lemma natLeq_on_Card_order: "Card_order (natLeq_on n)"
23.1746 -proof(unfold card_order_on_def,
23.1747 -      auto simp add: natLeq_on_Well_order, simp add: Field_natLeq_on)
23.1748 -  fix r assume "well_order_on {0..<n} r"
23.1749 -  thus "natLeq_on n \<le>o r"
23.1750 -  using finite_atLeastLessThan natLeq_on_well_order_on
23.1751 -        finite_well_order_on_ordIso ordIso_iff_ordLeq by blast
23.1752 -qed
23.1753 -
23.1754 -
23.1755 -corollary card_of_Field_natLeq_on:
23.1756 -"|Field (natLeq_on n)| =o natLeq_on n"
23.1757 -using Field_natLeq_on natLeq_on_Card_order
23.1758 -      Card_order_iff_ordIso_card_of[of "natLeq_on n"]
23.1759 -      ordIso_symmetric[of "natLeq_on n"] by blast
23.1760 -
23.1761 -
23.1762 -corollary card_of_less:
23.1763 -"|{0 ..< n}| =o natLeq_on n"
23.1764 -using Field_natLeq_on card_of_Field_natLeq_on by auto
23.1765 -
23.1766 -
23.1767 -lemma natLeq_on_ordLeq_less_eq:
23.1768 -"((natLeq_on m) \<le>o (natLeq_on n)) = (m \<le> n)"
23.1769 -proof
23.1770 -  assume "natLeq_on m \<le>o natLeq_on n"
23.1771 -  then obtain f where "inj_on f {0..<m} \<and> f  {0..<m} \<le> {0..<n}"
23.1772 -  unfolding ordLeq_def using
23.1773 -    embed_inj_on[OF natLeq_on_Well_order[of m], of "natLeq_on n", unfolded Field_natLeq_on]
23.1774 -     embed_Field[OF natLeq_on_Well_order[of m], of "natLeq_on n", unfolded Field_natLeq_on] by blast
23.1775 -  thus "m \<le> n" using atLeastLessThan_less_eq2 by blast
23.1776 -next
23.1777 -  assume "m \<le> n"
23.1778 -  hence "inj_on id {0..<m} \<and> id  {0..<m} \<le> {0..<n}" unfolding inj_on_def by auto
23.1779 -  hence "|{0..<m}| \<le>o |{0..<n}|" using card_of_ordLeq by blast
23.1780 -  thus "natLeq_on m \<le>o natLeq_on n"
23.1781 -  using card_of_less ordIso_ordLeq_trans ordLeq_ordIso_trans ordIso_symmetric by blast
23.1782 -qed
23.1783 -
23.1784 -
23.1785 -lemma natLeq_on_ordLeq_less:
23.1786 -"((natLeq_on m) <o (natLeq_on n)) = (m < n)"
23.1787 -using not_ordLeq_iff_ordLess[of "natLeq_on m" "natLeq_on n"]
23.1788 -natLeq_on_Well_order natLeq_on_ordLeq_less_eq by auto
23.1789 -
23.1790 -
23.1791 -
23.1792 -subsubsection {* "Backwards compatibility" with the numeric cardinal operator for finite sets *}
23.1793 -
23.1794 -
23.1795 -lemma finite_card_of_iff_card2:
23.1796 -assumes FIN: "finite A" and FIN': "finite B"
23.1797 -shows "( |A| \<le>o |B| ) = (card A \<le> card B)"
23.1798 -using assms card_of_ordLeq[of A B] inj_on_iff_card_le[of A B] by blast
23.1799 -
23.1800 -
23.1801 -lemma finite_imp_card_of_natLeq_on:
23.1802 -assumes "finite A"
23.1803 -shows "|A| =o natLeq_on (card A)"
23.1804 -proof-
23.1805 -  obtain h where "bij_betw h A {0 ..< card A}"
23.1806 -  using assms ex_bij_betw_finite_nat by blast
23.1807 -  thus ?thesis using card_of_ordIso card_of_less ordIso_equivalence by blast
23.1808 -qed
23.1809 -
23.1810 -
23.1811 -lemma finite_iff_card_of_natLeq_on:
23.1812 -"finite A = (\<exists>n. |A| =o natLeq_on n)"
23.1813 -using finite_imp_card_of_natLeq_on[of A]
23.1814 -by(auto simp add: ordIso_natLeq_on_imp_finite)
23.1815 -
23.1816 -
23.1817 -
23.1818 -subsection {* The successor of a cardinal *}
23.1819 -
23.1820 -
23.1821 -text{* First we define @{text "isCardSuc r r'"}, the notion of @{text "r'"}
23.1822 -being a successor cardinal of @{text "r"}. Although the definition does
23.1823 -not require @{text "r"} to be a cardinal, only this case will be meaningful.  *}
23.1824 -
23.1825 -
23.1826 -definition isCardSuc :: "'a rel \<Rightarrow> 'a set rel \<Rightarrow> bool"
23.1827 -where
23.1828 -"isCardSuc r r' \<equiv>
23.1829 - Card_order r' \<and> r <o r' \<and>
23.1830 - (\<forall>(r''::'a set rel). Card_order r'' \<and> r <o r'' \<longrightarrow> r' \<le>o r'')"
23.1831 -
23.1832 -
23.1833 -text{* Now we introduce the cardinal-successor operator @{text "cardSuc"},
23.1834 -by picking {\em some} cardinal-order relation fulfilling @{text "isCardSuc"}.
23.1835 -Again, the picked item shall be proved unique up to order-isomorphism. *}
23.1836 -
23.1837 -
23.1838 -definition cardSuc :: "'a rel \<Rightarrow> 'a set rel"
23.1839 -where
23.1840 -"cardSuc r \<equiv> SOME r'. isCardSuc r r'"
23.1841 -
23.1842 -
23.1843 -lemma exists_minim_Card_order:
23.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'"
23.1845 -unfolding card_order_on_def using exists_minim_Well_order by blast
23.1846 -
23.1847 -
23.1848 -lemma exists_isCardSuc:
23.1849 -assumes "Card_order r"
23.1850 -shows "\<exists>r'. isCardSuc r r'"
23.1851 -proof-
23.1852 -  let ?R = "{(r'::'a set rel). Card_order r' \<and> r <o r'}"
23.1853 -  have "|Pow(Field r)| \<in> ?R \<and> (\<forall>r \<in> ?R. Card_order r)" using assms
23.1854 -  by (simp add: card_of_Card_order Card_order_Pow)
23.1855 -  then obtain r where "r \<in> ?R \<and> (\<forall>r' \<in> ?R. r \<le>o r')"
23.1856 -  using exists_minim_Card_order[of ?R] by blast
23.1857 -  thus ?thesis unfolding isCardSuc_def by auto
23.1858 -qed
23.1859 -
23.1860 -
23.1861 -lemma cardSuc_isCardSuc:
23.1862 -assumes "Card_order r"
23.1863 -shows "isCardSuc r (cardSuc r)"
23.1864 -unfolding cardSuc_def using assms
23.1865 -by (simp add: exists_isCardSuc someI_ex)
23.1866 -
23.1867 -
23.1868 -lemma cardSuc_Card_order:
23.1869 -"Card_order r \<Longrightarrow> Card_order(cardSuc r)"
23.1870 -using cardSuc_isCardSuc unfolding isCardSuc_def by blast
23.1871 -
23.1872 -
23.1873 -lemma cardSuc_greater:
23.1874 -"Card_order r \<Longrightarrow> r <o cardSuc r"
23.1875 -using cardSuc_isCardSuc unfolding isCardSuc_def by blast
23.1876 -
23.1877 -
23.1878 -lemma cardSuc_ordLeq:
23.1879 -"Card_order r \<Longrightarrow> r \<le>o cardSuc r"
23.1880 -using cardSuc_greater ordLeq_iff_ordLess_or_ordIso by blast
23.1881 -
23.1882 -
23.1883 -text{* The minimality property of @{text "cardSuc"} originally present in its definition
23.1884 -is local to the type @{text "'a set rel"}, i.e., that of @{text "cardSuc r"}:  *}
23.1885 -
23.1886 -lemma cardSuc_least_aux:
23.1887 -"\<lbrakk>Card_order (r::'a rel); Card_order (r'::'a set rel); r <o r'\<rbrakk> \<Longrightarrow> cardSuc r \<le>o r'"
23.1888 -using cardSuc_isCardSuc unfolding isCardSuc_def by blast
23.1889 -
23.1890 -
23.1891 -text{* But from this we can infer general minimality: *}
23.1892 -
23.1893 -lemma cardSuc_least:
23.1894 -assumes CARD: "Card_order r" and CARD': "Card_order r'" and LESS: "r <o r'"
23.1895 -shows "cardSuc r \<le>o r'"
23.1896 -proof-
23.1897 -  let ?p = "cardSuc r"
23.1898 -  have 0: "Well_order ?p \<and> Well_order r'"
23.1899 -  using assms cardSuc_Card_order unfolding card_order_on_def by blast
23.1900 -  {assume "r' <o ?p"
23.1901 -   then obtain r'' where 1: "Field r'' < Field ?p" and 2: "r' =o r'' \<and> r'' <o ?p"
23.1902 -   using internalize_ordLess[of r' ?p] by blast
23.1903 -   (*  *)
23.1904 -   have "Card_order r''" using CARD' Card_order_ordIso2 2 by blast
23.1905 -   moreover have "r <o r''" using LESS 2 ordLess_ordIso_trans by blast
23.1906 -   ultimately have "?p \<le>o r''" using cardSuc_least_aux CARD by blast
23.1907 -   hence False using 2 not_ordLess_ordLeq by blast
23.1908 -  }
23.1909 -  thus ?thesis using 0 ordLess_or_ordLeq by blast
23.1910 -qed
23.1911 -
23.1912 -
23.1913 -lemma cardSuc_ordLess_ordLeq:
23.1914 -assumes CARD: "Card_order r" and CARD': "Card_order r'"
23.1915 -shows "(r <o r') = (cardSuc r \<le>o r')"
23.1916 -proof(auto simp add: assms cardSuc_least)
23.1917 -  assume "cardSuc r \<le>o r'"
23.1918 -  thus "r <o r'" using assms cardSuc_greater ordLess_ordLeq_trans by blast
23.1919 -qed
23.1920 -
23.1921 -
23.1922 -lemma cardSuc_ordLeq_ordLess:
23.1923 -assumes CARD: "Card_order r" and CARD': "Card_order r'"
23.1924 -shows "(r' <o cardSuc r) = (r' \<le>o r)"
23.1925 -proof-
23.1926 -  have "Well_order r \<and> Well_order r'"
23.1927 -  using assms unfolding card_order_on_def by auto
23.1928 -  moreover have "Well_order(cardSuc r)"
23.1929 -  using assms cardSuc_Card_order card_order_on_def by blast
23.1930 -  ultimately show ?thesis
23.1931 -  using assms cardSuc_ordLess_ordLeq[of r r']
23.1932 -  not_ordLeq_iff_ordLess[of r r'] not_ordLeq_iff_ordLess[of r' "cardSuc r"] by blast
23.1933 -qed
23.1934 -
23.1935 -
23.1936 -lemma cardSuc_mono_ordLeq:
23.1937 -assumes CARD: "Card_order r" and CARD': "Card_order r'"
23.1938 -shows "(cardSuc r \<le>o cardSuc r') = (r \<le>o r')"
23.1939 -using assms cardSuc_ordLeq_ordLess cardSuc_ordLess_ordLeq cardSuc_Card_order by blast
23.1940 -
23.1941 -
23.1942 -lemma cardSuc_invar_ordIso:
23.1943 -assumes CARD: "Card_order r" and CARD': "Card_order r'"
23.1944 -shows "(cardSuc r =o cardSuc r') = (r =o r')"
23.1945 -proof-
23.1946 -  have 0: "Well_order r \<and> Well_order r' \<and> Well_order(cardSuc r) \<and> Well_order(cardSuc r')"
23.1947 -  using assms by (simp add: card_order_on_well_order_on cardSuc_Card_order)
23.1948 -  thus ?thesis
23.1949 -  using ordIso_iff_ordLeq[of r r'] ordIso_iff_ordLeq
23.1950 -  using cardSuc_mono_ordLeq[of r r'] cardSuc_mono_ordLeq[of r' r] assms by blast
23.1951 -qed
23.1952 -
23.1953 -
23.1954 -lemma cardSuc_natLeq_on_Suc:
23.1955 -"cardSuc(natLeq_on n) =o natLeq_on(Suc n)"
23.1956 -proof-
23.1957 -  obtain r r' p where r_def: "r = natLeq_on n" and
23.1958 -                      r'_def: "r' = cardSuc(natLeq_on n)"  and
23.1959 -                      p_def: "p = natLeq_on(Suc n)" by blast
23.1960 -  (* Preliminary facts:  *)
23.1961 -  have CARD: "Card_order r \<and> Card_order r' \<and> Card_order p" unfolding r_def r'_def p_def
23.1962 -  using cardSuc_ordLess_ordLeq natLeq_on_Card_order cardSuc_Card_order by blast
23.1963 -  hence WELL: "Well_order r \<and> Well_order r' \<and>  Well_order p"
23.1964 -  unfolding card_order_on_def by force
23.1965 -  have FIELD: "Field r = {0..<n} \<and> Field p = {0..<(Suc n)}"
23.1966 -  unfolding r_def p_def Field_natLeq_on by simp
23.1967 -  hence FIN: "finite (Field r)" by force
23.1968 -  have "r <o r'" using CARD unfolding r_def r'_def using cardSuc_greater by blast
23.1969 -  hence "|Field r| <o r'" using CARD card_of_Field_ordIso ordIso_ordLess_trans by blast
23.1970 -  hence LESS: "|Field r| <o |Field r'|"
23.1971 -  using CARD card_of_Field_ordIso ordLess_ordIso_trans ordIso_symmetric by blast
23.1972 -  (* Main proof: *)
23.1973 -  have "r' \<le>o p" using CARD unfolding r_def r'_def p_def
23.1974 -  using natLeq_on_ordLeq_less cardSuc_ordLess_ordLeq by blast
23.1975 -  moreover have "p \<le>o r'"
23.1976 -  proof-
23.1977 -    {assume "r' <o p"
23.1978 -     then obtain f where 0: "embedS r' p f" unfolding ordLess_def by force
23.1979 -     let ?q = "Restr p (f  Field r')"
23.1980 -     have 1: "embed r' p f" using 0 unfolding embedS_def by force
23.1981 -     hence 2: "f  Field r' < {0..<(Suc n)}"
23.1982 -     using WELL FIELD 0 by (auto simp add: embedS_iff)
23.1983 -     have "wo_rel.ofilter p (f  Field r')" using embed_Field_ofilter 1 WELL by blast
23.1984 -     then obtain m where "m \<le> Suc n" and 3: "f  (Field r') = {0..<m}"
23.1985 -     unfolding p_def by (auto simp add: natLeq_on_ofilter_iff)
23.1986 -     hence 4: "m \<le> n" using 2 by force
23.1987 -     (*  *)
23.1988 -     have "bij_betw f (Field r') (f  (Field r'))"
23.1989 -     using 1 WELL embed_inj_on unfolding bij_betw_def by force
23.1990 -     moreover have "finite(f  (Field r'))" using 3 finite_atLeastLessThan[of 0 m] by force
23.1991 -     ultimately have 5: "finite (Field r') \<and> card(Field r') = card (f  (Field r'))"
23.1992 -     using bij_betw_same_card bij_betw_finite by metis
23.1993 -     hence "card(Field r') \<le> card(Field r)" using 3 4 FIELD by force
23.1994 -     hence "|Field r'| \<le>o |Field r|" using FIN 5 finite_card_of_iff_card2 by blast
23.1995 -     hence False using LESS not_ordLess_ordLeq by auto
23.1996 -    }
23.1997 -    thus ?thesis using WELL CARD by (fastforce simp: not_ordLess_iff_ordLeq)
23.1998 -  qed
23.1999 -  ultimately show ?thesis using ordIso_iff_ordLeq unfolding r'_def p_def by blast
23.2000 -qed
23.2001 -
23.2002 -
23.2003 -lemma card_of_cardSuc_finite:
23.2004 -"finite(Field(cardSuc |A| )) = finite A"
23.2005 -proof
23.2006 -  assume *: "finite (Field (cardSuc |A| ))"
23.2007 -  have 0: "|Field(cardSuc |A| )| =o cardSuc |A|"
23.2008 -  using card_of_Card_order cardSuc_Card_order card_of_Field_ordIso by blast
23.2009 -  hence "|A| \<le>o |Field(cardSuc |A| )|"
23.2010 -  using card_of_Card_order[of A] cardSuc_ordLeq[of "|A|"] ordIso_symmetric
23.2011 -  ordLeq_ordIso_trans by blast
23.2012 -  thus "finite A" using * card_of_ordLeq_finite by blast
23.2013 -next
23.2014 -  assume "finite A"
23.2015 -  then obtain n where "|A| =o natLeq_on n" using finite_iff_card_of_natLeq_on by blast
23.2016 -  hence "cardSuc |A| =o cardSuc(natLeq_on n)"
23.2017 -  using card_of_Card_order cardSuc_invar_ordIso natLeq_on_Card_order by blast
23.2018 -  hence "cardSuc |A| =o natLeq_on(Suc n)"
23.2019 -  using cardSuc_natLeq_on_Suc ordIso_transitive by blast
23.2020 -  hence "cardSuc |A| =o |{0..<(Suc n)}|" using card_of_less ordIso_equivalence by blast
23.2021 -  moreover have "|Field (cardSuc |A| ) | =o cardSuc |A|"
23.2022 -  using card_of_Field_ordIso cardSuc_Card_order card_of_Card_order by blast
23.2023 -  ultimately have "|Field (cardSuc |A| ) | =o |{0..<(Suc n)}|"
23.2024 -  using ordIso_equivalence by blast
23.2025 -  thus "finite (Field (cardSuc |A| ))"
23.2026 -  using card_of_ordIso_finite finite_atLeastLessThan by blast
23.2027 -qed
23.2028 -
23.2029 -
23.2030 -lemma cardSuc_finite:
23.2031 -assumes "Card_order r"
23.2032 -shows "finite (Field (cardSuc r)) = finite (Field r)"
23.2033 -proof-
23.2034 -  let ?A = "Field r"
23.2035 -  have "|?A| =o r" using assms by (simp add: card_of_Field_ordIso)
23.2036 -  hence "cardSuc |?A| =o cardSuc r" using assms
23.2037 -  by (simp add: card_of_Card_order cardSuc_invar_ordIso)
23.2038 -  moreover have "|Field (cardSuc |?A| ) | =o cardSuc |?A|"
23.2039 -  by (simp add: card_of_card_order_on Field_card_of card_of_Field_ordIso cardSuc_Card_order)
23.2040 -  moreover
23.2041 -  {have "|Field (cardSuc r) | =o cardSuc r"
23.2042 -   using assms by (simp add: card_of_Field_ordIso cardSuc_Card_order)
23.2043 -   hence "cardSuc r =o |Field (cardSuc r) |"
23.2044 -   using ordIso_symmetric by blast
23.2045 -  }
23.2046 -  ultimately have "|Field (cardSuc |?A| ) | =o |Field (cardSuc r) |"
23.2047 -  using ordIso_transitive by blast
23.2048 -  hence "finite (Field (cardSuc |?A| )) = finite (Field (cardSuc r))"
23.2049 -  using card_of_ordIso_finite by blast
23.2050 -  thus ?thesis by (simp only: card_of_cardSuc_finite)
23.2051 -qed
23.2052 -
23.2053 -
23.2054 -lemma card_of_Plus_ordLeq_infinite_Field:
23.2055 -assumes r: "infinite (Field r)" and A: "|A| \<le>o r" and B: "|B| \<le>o r"
23.2056 -and c: "Card_order r"
23.2057 -shows "|A <+> B| \<le>o r"
23.2058 -proof-
23.2059 -  let ?r' = "cardSuc r"
23.2060 -  have "Card_order ?r' \<and> infinite (Field ?r')" using assms
23.2061 -  by (simp add: cardSuc_Card_order cardSuc_finite)
23.2062 -  moreover have "|A| <o ?r'" and "|B| <o ?r'" using A B c
23.2063 -  by (auto simp: card_of_card_order_on Field_card_of cardSuc_ordLeq_ordLess)
23.2064 -  ultimately have "|A <+> B| <o ?r'"
23.2065 -  using card_of_Plus_ordLess_infinite_Field by blast
23.2066 -  thus ?thesis using c r
23.2067 -  by (simp add: card_of_card_order_on Field_card_of cardSuc_ordLeq_ordLess)
23.2068 -qed
23.2069 -
23.2070 -
23.2071 -lemma card_of_Un_ordLeq_infinite_Field:
23.2072 -assumes C: "infinite (Field r)" and A: "|A| \<le>o r" and B: "|B| \<le>o r"
23.2073 -and "Card_order r"
23.2074 -shows "|A Un B| \<le>o r"
23.2075 -using assms card_of_Plus_ordLeq_infinite_Field card_of_Un_Plus_ordLeq
23.2076 -ordLeq_transitive by blast
23.2077 -
23.2078 -
23.2079 -
23.2080 -subsection {* Regular cardinals *}
23.2081 -
23.2082 -
23.2083 -definition cofinal where
23.2084 -"cofinal A r \<equiv>
23.2085 - ALL a : Field r. EX b : A. a \<noteq> b \<and> (a,b) : r"
23.2086 -
23.2087 -
23.2088 -definition regular where
23.2089 -"regular r \<equiv>
23.2090 - ALL K. K \<le> Field r \<and> cofinal K r \<longrightarrow> |K| =o r"
23.2091 -
23.2092 -
23.2093 -definition relChain where
23.2094 -"relChain r As \<equiv>
23.2095 - ALL i j. (i,j) \<in> r \<longrightarrow> As i \<le> As j"
23.2096 -
23.2097 -lemma regular_UNION:
23.2098 -assumes r: "Card_order r"   "regular r"
23.2099 -and As: "relChain r As"
23.2100 -and Bsub: "B \<le> (UN i : Field r. As i)"
23.2101 -and cardB: "|B| <o r"
23.2102 -shows "EX i : Field r. B \<le> As i"
23.2103 -proof-
23.2104 -  let ?phi = "%b j. j : Field r \<and> b : As j"
23.2105 -  have "ALL b : B. EX j. ?phi b j" using Bsub by blast
23.2106 -  then obtain f where f: "!! b. b : B \<Longrightarrow> ?phi b (f b)"
23.2107 -  using bchoice[of B ?phi] by blast
23.2108 -  let ?K = "f  B"
23.2109 -  {assume 1: "!! i. i : Field r \<Longrightarrow> ~ B \<le> As i"
23.2110 -   have 2: "cofinal ?K r"
23.2111 -   unfolding cofinal_def proof auto
23.2112 -     fix i assume i: "i : Field r"
23.2113 -     with 1 obtain b where b: "b : B \<and> b \<notin> As i" by blast
23.2114 -     hence "i \<noteq> f b \<and> ~ (f b,i) : r"
23.2115 -     using As f unfolding relChain_def by auto
23.2116 -     hence "i \<noteq> f b \<and> (i, f b) : r" using r
23.2117 -     unfolding card_order_on_def well_order_on_def linear_order_on_def
23.2118 -     total_on_def using i f b by auto
23.2119 -     with b show "\<exists>b\<in>B. i \<noteq> f b \<and> (i, f b) \<in> r" by blast
23.2120 -   qed
23.2121 -   moreover have "?K \<le> Field r" using f by blast
23.2122 -   ultimately have "|?K| =o r" using 2 r unfolding regular_def by blast
23.2123 -   moreover
23.2124 -   {
23.2125 -    have "|?K| <=o |B|" using card_of_image .
23.2126 -    hence "|?K| <o r" using cardB ordLeq_ordLess_trans by blast
23.2127 -   }
23.2128 -   ultimately have False using not_ordLess_ordIso by blast
23.2129 -  }
23.2130 -  thus ?thesis by blast
23.2131 -qed
23.2132 -
23.2133 -
23.2134 -lemma infinite_cardSuc_regular:
23.2135 -assumes r_inf: "infinite (Field r)" and r_card: "Card_order r"
23.2136 -shows "regular (cardSuc r)"
23.2137 -proof-
23.2138 -  let ?r' = "cardSuc r"
23.2139 -  have r': "Card_order ?r'"
23.2140 -  "!! p. Card_order p \<longrightarrow> (p \<le>o r) = (p <o ?r')"
23.2141 -  using r_card by (auto simp: cardSuc_Card_order cardSuc_ordLeq_ordLess)
23.2142 -  show ?thesis
23.2143 -  unfolding regular_def proof auto
23.2144 -    fix K assume 1: "K \<le> Field ?r'" and 2: "cofinal K ?r'"
23.2145 -    hence "|K| \<le>o |Field ?r'|" by (simp only: card_of_mono1)
23.2146 -    also have 22: "|Field ?r'| =o ?r'"
23.2147 -    using r' by (simp add: card_of_Field_ordIso[of ?r'])
23.2148 -    finally have "|K| \<le>o ?r'" .
23.2149 -    moreover
23.2150 -    {let ?L = "UN j : K. rel.underS ?r' j"
23.2151 -     let ?J = "Field r"
23.2152 -     have rJ: "r =o |?J|"
23.2153 -     using r_card card_of_Field_ordIso ordIso_symmetric by blast
23.2154 -     assume "|K| <o ?r'"
23.2155 -     hence "|K| <=o r" using r' card_of_Card_order[of K] by blast
23.2156 -     hence "|K| \<le>o |?J|" using rJ ordLeq_ordIso_trans by blast
23.2157 -     moreover
23.2158 -     {have "ALL j : K. |rel.underS ?r' j| <o ?r'"
23.2159 -      using r' 1 by (auto simp: card_of_underS)
23.2160 -      hence "ALL j : K. |rel.underS ?r' j| \<le>o r"
23.2161 -      using r' card_of_Card_order by blast
23.2162 -      hence "ALL j : K. |rel.underS ?r' j| \<le>o |?J|"
23.2163 -      using rJ ordLeq_ordIso_trans by blast
23.2164 -     }
23.2165 -     ultimately have "|?L| \<le>o |?J|"
23.2166 -     using r_inf card_of_UNION_ordLeq_infinite by blast
23.2167 -     hence "|?L| \<le>o r" using rJ ordIso_symmetric ordLeq_ordIso_trans by blast
23.2168 -     hence "|?L| <o ?r'" using r' card_of_Card_order by blast
23.2169 -     moreover
23.2170 -     {
23.2171 -      have "Field ?r' \<le> ?L"
23.2172 -      using 2 unfolding rel.underS_def cofinal_def by auto
23.2173 -      hence "|Field ?r'| \<le>o |?L|" by (simp add: card_of_mono1)
23.2174 -      hence "?r' \<le>o |?L|"
23.2175 -      using 22 ordIso_ordLeq_trans ordIso_symmetric by blast
23.2176 -     }
23.2177 -     ultimately have "|?L| <o |?L|" using ordLess_ordLeq_trans by blast
23.2178 -     hence False using ordLess_irreflexive by blast
23.2179 -    }
23.2180 -    ultimately show "|K| =o ?r'"
23.2181 -    unfolding ordLeq_iff_ordLess_or_ordIso by blast
23.2182 -  qed
23.2183 -qed
23.2184 -
23.2185 -lemma cardSuc_UNION:
23.2186 -assumes r: "Card_order r" and "infinite (Field r)"
23.2187 -and As: "relChain (cardSuc r) As"
23.2188 -and Bsub: "B \<le> (UN i : Field (cardSuc r). As i)"
23.2189 -and cardB: "|B| <=o r"
23.2190 -shows "EX i : Field (cardSuc r). B \<le> As i"
23.2191 -proof-
23.2192 -  let ?r' = "cardSuc r"
23.2193 -  have "Card_order ?r' \<and> |B| <o ?r'"
23.2194 -  using r cardB cardSuc_ordLeq_ordLess cardSuc_Card_order
23.2195 -  card_of_Card_order by blast
23.2196 -  moreover have "regular ?r'"
23.2197 -  using assms by(simp add: infinite_cardSuc_regular)
23.2198 -  ultimately show ?thesis
23.2199 -  using As Bsub cardB regular_UNION by blast
23.2200 -qed
23.2201 -
23.2202 -
23.2203 -subsection {* Others *}
23.2204 -
23.2205 -lemma card_of_infinite_diff_finite:
23.2206 -assumes "infinite A" and "finite B"
23.2207 -shows "|A - B| =o |A|"
23.2208 -by (metis assms card_of_Un_diff_infinite finite_ordLess_infinite2)
23.2209 -
23.2210 -(* function space *)
23.2211 -definition Func where
23.2212 -"Func A B = {f . (\<forall> a \<in> A. f a \<in> B) \<and> (\<forall> a. a \<notin> A \<longrightarrow> f a = undefined)}"
23.2213 -
23.2214 -lemma Func_empty:
23.2215 -"Func {} B = {\<lambda>x. undefined}"
23.2216 -unfolding Func_def by auto
23.2217 -
23.2218 -lemma Func_elim:
23.2219 -assumes "g \<in> Func A B" and "a \<in> A"
23.2220 -shows "\<exists> b. b \<in> B \<and> g a = b"
23.2221 -using assms unfolding Func_def by (cases "g a = undefined") auto
23.2222 -
23.2223 -definition curr where
23.2224 -"curr A f \<equiv> \<lambda> a. if a \<in> A then \<lambda>b. f (a,b) else undefined"
23.2225 -
23.2226 -lemma curr_in:
23.2227 -assumes f: "f \<in> Func (A <*> B) C"
23.2228 -shows "curr A f \<in> Func A (Func B C)"
23.2229 -using assms unfolding curr_def Func_def by auto
23.2230 -
23.2231 -lemma curr_inj:
23.2232 -assumes "f1 \<in> Func (A <*> B) C" and "f2 \<in> Func (A <*> B) C"
23.2233 -shows "curr A f1 = curr A f2 \<longleftrightarrow> f1 = f2"
23.2234 -proof safe
23.2235 -  assume c: "curr A f1 = curr A f2"
23.2236 -  show "f1 = f2"
23.2237 -  proof (rule ext, clarify)
23.2238 -    fix a b show "f1 (a, b) = f2 (a, b)"
23.2239 -    proof (cases "(a,b) \<in> A <*> B")
23.2240 -      case False
23.2241 -      thus ?thesis using assms unfolding Func_def by auto
23.2242 -    next
23.2243 -      case True hence a: "a \<in> A" and b: "b \<in> B" by auto
23.2244 -      thus ?thesis
23.2245 -      using c unfolding curr_def fun_eq_iff by(elim allE[of _ a]) simp
23.2246 -    qed
23.2247 -  qed
23.2248 -qed
23.2249 -
23.2250 -lemma curr_surj:
23.2251 -assumes "g \<in> Func A (Func B C)"
23.2252 -shows "\<exists> f \<in> Func (A <*> B) C. curr A f = g"
23.2253 -proof
23.2254 -  let ?f = "\<lambda> ab. if fst ab \<in> A \<and> snd ab \<in> B then g (fst ab) (snd ab) else undefined"
23.2255 -  show "curr A ?f = g"
23.2256 -  proof (rule ext)
23.2257 -    fix a show "curr A ?f a = g a"
23.2258 -    proof (cases "a \<in> A")
23.2259 -      case False
23.2260 -      hence "g a = undefined" using assms unfolding Func_def by auto
23.2261 -      thus ?thesis unfolding curr_def using False by simp
23.2262 -    next
23.2263 -      case True
23.2264 -      obtain g1 where "g1 \<in> Func B C" and "g a = g1"
23.2265 -      using assms using Func_elim[OF assms True] by blast
23.2266 -      thus ?thesis using True unfolding Func_def curr_def by auto
23.2267 -    qed
23.2268 -  qed
23.2269 -  show "?f \<in> Func (A <*> B) C" using assms unfolding Func_def mem_Collect_eq by auto
23.2270 -qed
23.2271 -
23.2272 -lemma bij_betw_curr:
23.2273 -"bij_betw (curr A) (Func (A <*> B) C) (Func A (Func B C))"
23.2274 -unfolding bij_betw_def inj_on_def image_def
23.2275 -using curr_in curr_inj curr_surj by blast
23.2276 -
23.2277 -lemma card_of_Func_Times:
23.2278 -"|Func (A <*> B) C| =o |Func A (Func B C)|"
23.2279 -unfolding card_of_ordIso[symmetric]
23.2280 -using bij_betw_curr by blast
23.2281 -
23.2282 -definition Func_map where
23.2283 -"Func_map B2 f1 f2 g b2 \<equiv> if b2 \<in> B2 then f1 (g (f2 b2)) else undefined"
23.2284 -
23.2285 -lemma Func_map:
23.2286 -assumes g: "g \<in> Func A2 A1" and f1: "f1  A1 \<subseteq> B1" and f2: "f2  B2 \<subseteq> A2"
23.2287 -shows "Func_map B2 f1 f2 g \<in> Func B2 B1"
23.2288 -using assms unfolding Func_def Func_map_def mem_Collect_eq by auto
23.2289 -
23.2290 -lemma Func_non_emp:
23.2291 -assumes "B \<noteq> {}"
23.2292 -shows "Func A B \<noteq> {}"
23.2293 -proof-
23.2294 -  obtain b where b: "b \<in> B" using assms by auto
23.2295 -  hence "(\<lambda> a. if a \<in> A then b else undefined) \<in> Func A B" unfolding Func_def by auto
23.2296 -  thus ?thesis by blast
23.2297 -qed
23.2298 -
23.2299 -lemma Func_is_emp:
23.2300 -"Func A B = {} \<longleftrightarrow> A \<noteq> {} \<and> B = {}" (is "?L \<longleftrightarrow> ?R")
23.2301 -proof
23.2302 -  assume L: ?L
23.2303 -  moreover {assume "A = {}" hence False using L Func_empty by auto}
23.2304 -  moreover {assume "B \<noteq> {}" hence False using L Func_non_emp by metis}
23.2305 -  ultimately show ?R by blast
23.2306 -next
23.2307 -  assume R: ?R
23.2308 -  moreover
23.2309 -  {fix f assume "f \<in> Func A B"
23.2310 -   moreover obtain a where "a \<in> A" using R by blast
23.2311 -   ultimately obtain b where "b \<in> B" unfolding Func_def by(cases "f a = undefined", force+)
23.2312 -   with R have False by auto
23.2313 -  }
23.2314 -  thus ?L by blast
23.2315 -qed
23.2316 -
23.2317 -lemma Func_map_surj:
23.2318 -assumes B1: "f1  A1 = B1" and A2: "inj_on f2 B2" "f2  B2 \<subseteq> A2"
23.2319 -and B2A2: "B2 = {} \<Longrightarrow> A2 = {}"
23.2320 -shows "Func B2 B1 = Func_map B2 f1 f2  Func A2 A1"
23.2321 -proof(cases "B2 = {}")
23.2322 -  case True
23.2323 -  thus ?thesis using B2A2 by (auto simp: Func_empty Func_map_def)
23.2324 -next
23.2325 -  case False note B2 = False
23.2326 -  show ?thesis
23.2327 -  proof safe
23.2328 -    fix h assume h: "h \<in> Func B2 B1"
23.2329 -    def j1 \<equiv> "inv_into A1 f1"
23.2330 -    have "\<forall> a2 \<in> f2  B2. \<exists> b2. b2 \<in> B2 \<and> f2 b2 = a2" by blast
23.2331 -    then obtain k where k: "\<forall> a2 \<in> f2  B2. k a2 \<in> B2 \<and> f2 (k a2) = a2" by metis
23.2332 -    {fix b2 assume b2: "b2 \<in> B2"
23.2333 -     hence "f2 (k (f2 b2)) = f2 b2" using k A2(2) by auto
23.2334 -     moreover have "k (f2 b2) \<in> B2" using b2 A2(2) k by auto
23.2335 -     ultimately have "k (f2 b2) = b2" using b2 A2(1) unfolding inj_on_def by blast
23.2336 -    } note kk = this
23.2337 -    obtain b22 where b22: "b22 \<in> B2" using B2 by auto
23.2338 -    def j2 \<equiv> "\<lambda> a2. if a2 \<in> f2  B2 then k a2 else b22"
23.2339 -    have j2A2: "j2  A2 \<subseteq> B2" unfolding j2_def using k b22 by auto
23.2340 -    have j2: "\<And> b2. b2 \<in> B2 \<Longrightarrow> j2 (f2 b2) = b2"
23.2341 -    using kk unfolding j2_def by auto
23.2342 -    def g \<equiv> "Func_map A2 j1 j2 h"
23.2343 -    have "Func_map B2 f1 f2 g = h"
23.2344 -    proof (rule ext)
23.2345 -      fix b2 show "Func_map B2 f1 f2 g b2 = h b2"
23.2346 -      proof(cases "b2 \<in> B2")
23.2347 -        case True
23.2348 -        show ?thesis
23.2349 -        proof (cases "h b2 = undefined")
23.2350 -          case True
23.2351 -          hence b1: "h b2 \<in> f1  A1" using h b2 \<in> B2 unfolding B1 Func_def by auto
23.2352 -          show ?thesis using A2 f_inv_into_f[OF b1]
23.2353 -            unfolding True g_def Func_map_def j1_def j2[OF b2 \<in> B2] by auto
23.2354 -        qed(insert A2 True j2[OF True] h B1, unfold j1_def g_def Func_def Func_map_def,
23.2355 -          auto intro: f_inv_into_f)
23.2356 -      qed(insert h, unfold Func_def Func_map_def, auto)
23.2357 -    qed
23.2358 -    moreover have "g \<in> Func A2 A1" unfolding g_def apply(rule Func_map[OF h])
23.2359 -    using inv_into_into j2A2 B1 A2 inv_into_into
23.2360 -    unfolding j1_def image_def by fast+
23.2361 -    ultimately show "h \<in> Func_map B2 f1 f2  Func A2 A1"
23.2362 -    unfolding Func_map_def[abs_def] unfolding image_def by auto
23.2363 -  qed(insert B1 Func_map[OF _ _ A2(2)], auto)
23.2364 -qed
23.2365 -
23.2366 -lemma card_of_Pow_Func:
23.2367 -"|Pow A| =o |Func A (UNIV::bool set)|"
23.2368 -proof-
23.2369 -  def F \<equiv> "\<lambda> A' a. if a \<in> A then (if a \<in> A' then True else False)
23.2370 -                            else undefined"
23.2371 -  have "bij_betw F (Pow A) (Func A (UNIV::bool set))"
23.2372 -  unfolding bij_betw_def inj_on_def proof (intro ballI impI conjI)
23.2373 -    fix A1 A2 assume "A1 \<in> Pow A" "A2 \<in> Pow A" "F A1 = F A2"
23.2374 -    thus "A1 = A2" unfolding F_def Pow_def fun_eq_iff by (auto split: split_if_asm)
23.2375 -  next
23.2376 -    show "F  Pow A = Func A UNIV"
23.2377 -    proof safe
23.2378 -      fix f assume f: "f \<in> Func A (UNIV::bool set)"
23.2379 -      show "f \<in> F  Pow A" unfolding image_def mem_Collect_eq proof(intro bexI)
23.2380 -        let ?A1 = "{a \<in> A. f a = True}"
23.2381 -        show "f = F ?A1" unfolding F_def apply(rule ext)
23.2382 -        using f unfolding Func_def mem_Collect_eq by auto
23.2383 -      qed auto
23.2384 -    qed(unfold Func_def mem_Collect_eq F_def, auto)
23.2385 -  qed
23.2386 -  thus ?thesis unfolding card_of_ordIso[symmetric] by blast
23.2387 -qed
23.2388 -
23.2389 -lemma card_of_Func_mono:
23.2390 -fixes A1 A2 :: "'a set" and B :: "'b set"
23.2391 -assumes A12: "A1 \<subseteq> A2" and B: "B \<noteq> {}"
23.2392 -shows "|Func A1 B| \<le>o |Func A2 B|"
23.2393 -proof-
23.2394 -  obtain bb where bb: "bb \<in> B" using B by auto
23.2395 -  def F \<equiv> "\<lambda> (f1::'a \<Rightarrow> 'b) a. if a \<in> A2 then (if a \<in> A1 then f1 a else bb)
23.2396 -                                                else undefined"
23.2397 -  show ?thesis unfolding card_of_ordLeq[symmetric] proof(intro exI[of _ F] conjI)
23.2398 -    show "inj_on F (Func A1 B)" unfolding inj_on_def proof safe
23.2399 -      fix f g assume f: "f \<in> Func A1 B" and g: "g \<in> Func A1 B" and eq: "F f = F g"
23.2400 -      show "f = g"
23.2401 -      proof(rule ext)
23.2402 -        fix a show "f a = g a"
23.2403 -        proof(cases "a \<in> A1")
23.2404 -          case True
23.2405 -          thus ?thesis using eq A12 unfolding F_def fun_eq_iff
23.2406 -          by (elim allE[of _ a]) auto
23.2407 -        qed(insert f g, unfold Func_def, fastforce)
23.2408 -      qed
23.2409 -    qed
23.2410 -  qed(insert bb, unfold Func_def F_def, force)
23.2411 -qed
23.2412 -
23.2413 -lemma ordLeq_Func:
23.2414 -assumes "{b1,b2} \<subseteq> B" "b1 \<noteq> b2"
23.2415 -shows "|A| \<le>o |Func A B|"
23.2416 -unfolding card_of_ordLeq[symmetric] proof(intro exI conjI)
23.2417 -  let ?F = "\<lambda> aa a. if a \<in> A then (if a = aa then b1 else b2) else undefined"
23.2418 -  show "inj_on ?F A" using assms unfolding inj_on_def fun_eq_iff by auto
23.2419 -  show "?F  A \<subseteq> Func A B" using assms unfolding Func_def by auto
23.2420 -qed
23.2421 -
23.2422 -lemma infinite_Func:
23.2423 -assumes A: "infinite A" and B: "{b1,b2} \<subseteq> B" "b1 \<noteq> b2"
23.2424 -shows "infinite (Func A B)"
23.2425 -using ordLeq_Func[OF B] by (metis A card_of_ordLeq_finite)
23.2426 -
23.2427 -lemma card_of_Func_UNIV:
23.2428 -"|Func (UNIV::'a set) (B::'b set)| =o |{f::'a \<Rightarrow> 'b. range f \<subseteq> B}|"
23.2429 -apply(rule ordIso_symmetric) proof(intro card_of_ordIsoI)
23.2430 -  let ?F = "\<lambda> f (a::'a). ((f a)::'b)"
23.2431 -  show "bij_betw ?F {f. range f \<subseteq> B} (Func UNIV B)"
23.2432 -  unfolding bij_betw_def inj_on_def proof safe
23.2433 -    fix h :: "'a \<Rightarrow> 'b" assume h: "h \<in> Func UNIV B"
23.2434 -    hence "\<forall> a. \<exists> b. h a = b" unfolding Func_def by auto
23.2435 -    then obtain f where f: "\<forall> a. h a = f a" by metis
23.2436 -    hence "range f \<subseteq> B" using h unfolding Func_def by auto
23.2437 -    thus "h \<in> (\<lambda>f a. f a)  {f. range f \<subseteq> B}" using f unfolding image_def by auto
23.2438 -  qed(unfold Func_def fun_eq_iff, auto)
23.2439 -qed
23.2440 -
23.2441 -end

    24.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
24.2 +++ b/src/HOL/Cardinals/Cardinal_Order_Relation_FP.thy	Tue Nov 19 17:07:52 2013 +0100
24.3 @@ -0,0 +1,2174 @@
24.4 +(*  Title:      HOL/Cardinals/Cardinal_Order_Relation_FP.thy
24.5 +    Author:     Andrei Popescu, TU Muenchen
24.6 +    Copyright   2012
24.7 +
24.8 +Cardinal-order relations (FP).
24.9 +*)
24.10 +
24.11 +header {* Cardinal-Order Relations (FP) *}
24.12 +
24.13 +theory Cardinal_Order_Relation_FP
24.14 +imports Constructions_on_Wellorders_FP
24.15 +begin
24.16 +
24.17 +
24.18 +text{* In this section, we define cardinal-order relations to be minim well-orders
24.19 +on their field.  Then we define the cardinal of a set to be {\em some} cardinal-order
24.20 +relation on that set, which will be unique up to order isomorphism.  Then we study
24.21 +the connection between cardinals and:
24.22 +\begin{itemize}
24.23 +\item standard set-theoretic constructions: products,
24.24 +sums, unions, lists, powersets, set-of finite sets operator;
24.25 +\item finiteness and infiniteness (in particular, with the numeric cardinal operator
24.26 +for finite sets, @{text "card"}, from the theory @{text "Finite_Sets.thy"}).
24.27 +\end{itemize}
24.28 +%
24.29 +On the way, we define the canonical $\omega$ cardinal and finite cardinals.  We also
24.30 +define (again, up to order isomorphism) the successor of a cardinal, and show that
24.31 +any cardinal admits a successor.
24.32 +
24.33 +Main results of this section are the existence of cardinal relations and the
24.34 +facts that, in the presence of infiniteness,
24.35 +most of the standard set-theoretic constructions (except for the powerset)
24.36 +{\em do not increase cardinality}.  In particular, e.g., the set of words/lists over
24.37 +any infinite set has the same cardinality (hence, is in bijection) with that set.
24.38 +*}
24.39 +
24.40 +
24.41 +subsection {* Cardinal orders *}
24.42 +
24.43 +
24.44 +text{* A cardinal order in our setting shall be a well-order {\em minim} w.r.t. the
24.45 +order-embedding relation, @{text "\<le>o"} (which is the same as being {\em minimal} w.r.t. the
24.46 +strict order-embedding relation, @{text "<o"}), among all the well-orders on its field.  *}
24.47 +
24.48 +definition card_order_on :: "'a set \<Rightarrow> 'a rel \<Rightarrow> bool"
24.49 +where
24.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')"
24.51 +
24.52 +
24.53 +abbreviation "Card_order r \<equiv> card_order_on (Field r) r"
24.54 +abbreviation "card_order r \<equiv> card_order_on UNIV r"
24.55 +
24.56 +
24.57 +lemma card_order_on_well_order_on:
24.58 +assumes "card_order_on A r"
24.59 +shows "well_order_on A r"
24.60 +using assms unfolding card_order_on_def by simp
24.61 +
24.62 +
24.63 +lemma card_order_on_Card_order:
24.64 +"card_order_on A r \<Longrightarrow> A = Field r \<and> Card_order r"
24.65 +unfolding card_order_on_def using rel.well_order_on_Field by blast
24.66 +
24.67 +
24.68 +text{* The existence of a cardinal relation on any given set (which will mean
24.69 +that any set has a cardinal) follows from two facts:
24.70 +\begin{itemize}
24.71 +\item Zermelo's theorem (proved in @{text "Zorn.thy"} as theorem @{text "well_order_on"}),
24.72 +which states that on any given set there exists a well-order;
24.73 +\item The well-founded-ness of @{text "<o"}, ensuring that then there exists a minimal
24.74 +such well-order, i.e., a cardinal order.
24.75 +\end{itemize}
24.76 +*}
24.77 +
24.78 +
24.79 +theorem card_order_on: "\<exists>r. card_order_on A r"
24.80 +proof-
24.81 +  obtain R where R_def: "R = {r. well_order_on A r}" by blast
24.82 +  have 1: "R \<noteq> {} \<and> (\<forall>r \<in> R. Well_order r)"
24.83 +  using well_order_on[of A] R_def rel.well_order_on_Well_order by blast
24.84 +  hence "\<exists>r \<in> R. \<forall>r' \<in> R. r \<le>o r'"
24.85 +  using  exists_minim_Well_order[of R] by auto
24.86 +  thus ?thesis using R_def unfolding card_order_on_def by auto
24.87 +qed
24.88 +
24.89 +
24.90 +lemma card_order_on_ordIso:
24.91 +assumes CO: "card_order_on A r" and CO': "card_order_on A r'"
24.92 +shows "r =o r'"
24.93 +using assms unfolding card_order_on_def
24.94 +using ordIso_iff_ordLeq by blast
24.95 +
24.96 +
24.97 +lemma Card_order_ordIso:
24.98 +assumes CO: "Card_order r" and ISO: "r' =o r"
24.99 +shows "Card_order r'"
24.100 +using ISO unfolding ordIso_def
24.101 +proof(unfold card_order_on_def, auto)
24.102 +  fix p' assume "well_order_on (Field r') p'"
24.103 +  hence 0: "Well_order p' \<and> Field p' = Field r'"
24.104 +  using rel.well_order_on_Well_order by blast
24.105 +  obtain f where 1: "iso r' r f" and 2: "Well_order r \<and> Well_order r'"
24.106 +  using ISO unfolding ordIso_def by auto
24.107 +  hence 3: "inj_on f (Field r') \<and> f  (Field r') = Field r"
24.108 +  by (auto simp add: iso_iff embed_inj_on)
24.109 +  let ?p = "dir_image p' f"
24.110 +  have 4: "p' =o ?p \<and> Well_order ?p"
24.111 +  using 0 2 3 by (auto simp add: dir_image_ordIso Well_order_dir_image)
24.112 +  moreover have "Field ?p =  Field r"
24.113 +  using 0 3 by (auto simp add: dir_image_Field2 order_on_defs)
24.114 +  ultimately have "well_order_on (Field r) ?p" by auto
24.115 +  hence "r \<le>o ?p" using CO unfolding card_order_on_def by auto
24.116 +  thus "r' \<le>o p'"
24.117 +  using ISO 4 ordLeq_ordIso_trans ordIso_ordLeq_trans ordIso_symmetric by blast
24.118 +qed
24.119 +
24.120 +
24.121 +lemma Card_order_ordIso2:
24.122 +assumes CO: "Card_order r" and ISO: "r =o r'"
24.123 +shows "Card_order r'"
24.124 +using assms Card_order_ordIso ordIso_symmetric by blast
24.125 +
24.126 +
24.127 +subsection {* Cardinal of a set *}
24.128 +
24.129 +
24.130 +text{* We define the cardinal of set to be {\em some} cardinal order on that set.
24.131 +We shall prove that this notion is unique up to order isomorphism, meaning
24.132 +that order isomorphism shall be the true identity of cardinals.  *}
24.133 +
24.134 +
24.135 +definition card_of :: "'a set \<Rightarrow> 'a rel" ("|_|" )
24.136 +where "card_of A = (SOME r. card_order_on A r)"
24.137 +
24.138 +
24.139 +lemma card_of_card_order_on: "card_order_on A |A|"
24.140 +unfolding card_of_def by (auto simp add: card_order_on someI_ex)
24.141 +
24.142 +
24.143 +lemma card_of_well_order_on: "well_order_on A |A|"
24.144 +using card_of_card_order_on card_order_on_def by blast
24.145 +
24.146 +
24.147 +lemma Field_card_of: "Field |A| = A"
24.148 +using card_of_card_order_on[of A] unfolding card_order_on_def
24.149 +using rel.well_order_on_Field by blast
24.150 +
24.151 +
24.152 +lemma card_of_Card_order: "Card_order |A|"
24.153 +by (simp only: card_of_card_order_on Field_card_of)
24.154 +
24.155 +
24.156 +corollary ordIso_card_of_imp_Card_order:
24.157 +"r =o |A| \<Longrightarrow> Card_order r"
24.158 +using card_of_Card_order Card_order_ordIso by blast
24.159 +
24.160 +
24.161 +lemma card_of_Well_order: "Well_order |A|"
24.162 +using card_of_Card_order unfolding card_order_on_def by auto
24.163 +
24.164 +
24.165 +lemma card_of_refl: "|A| =o |A|"
24.166 +using card_of_Well_order ordIso_reflexive by blast
24.167 +
24.168 +
24.169 +lemma card_of_least: "well_order_on A r \<Longrightarrow> |A| \<le>o r"
24.170 +using card_of_card_order_on unfolding card_order_on_def by blast
24.171 +
24.172 +
24.173 +lemma card_of_ordIso:
24.174 +"(\<exists>f. bij_betw f A B) = ( |A| =o |B| )"
24.175 +proof(auto)
24.176 +  fix f assume *: "bij_betw f A B"
24.177 +  then obtain r where "well_order_on B r \<and> |A| =o r"
24.178 +  using Well_order_iso_copy card_of_well_order_on by blast
24.179 +  hence "|B| \<le>o |A|" using card_of_least
24.180 +  ordLeq_ordIso_trans ordIso_symmetric by blast
24.181 +  moreover
24.182 +  {let ?g = "inv_into A f"
24.183 +   have "bij_betw ?g B A" using * bij_betw_inv_into by blast
24.184 +   then obtain r where "well_order_on A r \<and> |B| =o r"
24.185 +   using Well_order_iso_copy card_of_well_order_on by blast
24.186 +   hence "|A| \<le>o |B|" using card_of_least
24.187 +   ordLeq_ordIso_trans ordIso_symmetric by blast
24.188 +  }
24.189 +  ultimately show "|A| =o |B|" using ordIso_iff_ordLeq by blast
24.190 +next
24.191 +  assume "|A| =o |B|"
24.192 +  then obtain f where "iso ( |A| ) ( |B| ) f"
24.193 +  unfolding ordIso_def by auto
24.194 +  hence "bij_betw f A B" unfolding iso_def Field_card_of by simp
24.195 +  thus "\<exists>f. bij_betw f A B" by auto
24.196 +qed
24.197 +
24.198 +
24.199 +lemma card_of_ordLeq:
24.200 +"(\<exists>f. inj_on f A \<and> f  A \<le> B) = ( |A| \<le>o |B| )"
24.201 +proof(auto)
24.202 +  fix f assume *: "inj_on f A" and **: "f  A \<le> B"
24.203 +  {assume "|B| <o |A|"
24.204 +   hence "|B| \<le>o |A|" using ordLeq_iff_ordLess_or_ordIso by blast
24.205 +   then obtain g where "embed ( |B| ) ( |A| ) g"
24.206 +   unfolding ordLeq_def by auto
24.207 +   hence 1: "inj_on g B \<and> g  B \<le> A" using embed_inj_on[of "|B|" "|A|" "g"]
24.208 +   card_of_Well_order[of "B"] Field_card_of[of "B"] Field_card_of[of "A"]
24.209 +   embed_Field[of "|B|" "|A|" g] by auto
24.210 +   obtain h where "bij_betw h A B"
24.211 +   using * ** 1 Cantor_Bernstein[of f] by fastforce
24.212 +   hence "|A| =o |B|" using card_of_ordIso by blast
24.213 +   hence "|A| \<le>o |B|" using ordIso_iff_ordLeq by auto
24.214 +  }
24.215 +  thus "|A| \<le>o |B|" using ordLess_or_ordLeq[of "|B|" "|A|"]
24.216 +  by (auto simp: card_of_Well_order)
24.217 +next
24.218 +  assume *: "|A| \<le>o |B|"
24.219 +  obtain f where "embed ( |A| ) ( |B| ) f"
24.220 +  using * unfolding ordLeq_def by auto
24.221 +  hence "inj_on f A \<and> f  A \<le> B" using embed_inj_on[of "|A|" "|B|" f]
24.222 +  card_of_Well_order[of "A"] Field_card_of[of "A"] Field_card_of[of "B"]
24.223 +  embed_Field[of "|A|" "|B|" f] by auto
24.224 +  thus "\<exists>f. inj_on f A \<and> f  A \<le> B" by auto
24.225 +qed
24.226 +
24.227 +
24.228 +lemma card_of_ordLeq2:
24.229 +"A \<noteq> {} \<Longrightarrow> (\<exists>g. g  B = A) = ( |A| \<le>o |B| )"
24.230 +using card_of_ordLeq[of A B] inj_on_iff_surj[of A B] by auto
24.231 +
24.232 +
24.233 +lemma card_of_ordLess:
24.234 +"(\<not>(\<exists>f. inj_on f A \<and> f  A \<le> B)) = ( |B| <o |A| )"
24.235 +proof-
24.236 +  have "(\<not>(\<exists>f. inj_on f A \<and> f  A \<le> B)) = (\<not> |A| \<le>o |B| )"
24.237 +  using card_of_ordLeq by blast
24.238 +  also have "\<dots> = ( |B| <o |A| )"
24.239 +  using card_of_Well_order[of A] card_of_Well_order[of B]
24.240 +        not_ordLeq_iff_ordLess by blast
24.241 +  finally show ?thesis .
24.242 +qed
24.243 +
24.244 +
24.245 +lemma card_of_ordLess2:
24.246 +"B \<noteq> {} \<Longrightarrow> (\<not>(\<exists>f. f  A = B)) = ( |A| <o |B| )"
24.247 +using card_of_ordLess[of B A] inj_on_iff_surj[of B A] by auto
24.248 +
24.249 +
24.250 +lemma card_of_ordIsoI:
24.251 +assumes "bij_betw f A B"
24.252 +shows "|A| =o |B|"
24.253 +using assms unfolding card_of_ordIso[symmetric] by auto
24.254 +
24.255 +
24.256 +lemma card_of_ordLeqI:
24.257 +assumes "inj_on f A" and "\<And> a. a \<in> A \<Longrightarrow> f a \<in> B"
24.258 +shows "|A| \<le>o |B|"
24.259 +using assms unfolding card_of_ordLeq[symmetric] by auto
24.260 +
24.261 +
24.262 +lemma card_of_unique:
24.263 +"card_order_on A r \<Longrightarrow> r =o |A|"
24.264 +by (simp only: card_order_on_ordIso card_of_card_order_on)
24.265 +
24.266 +
24.267 +lemma card_of_mono1:
24.268 +"A \<le> B \<Longrightarrow> |A| \<le>o |B|"
24.269 +using inj_on_id[of A] card_of_ordLeq[of A B] by fastforce
24.270 +
24.271 +
24.272 +lemma card_of_mono2:
24.273 +assumes "r \<le>o r'"
24.274 +shows "|Field r| \<le>o |Field r'|"
24.275 +proof-
24.276 +  obtain f where
24.277 +  1: "well_order_on (Field r) r \<and> well_order_on (Field r) r \<and> embed r r' f"
24.278 +  using assms unfolding ordLeq_def
24.279 +  by (auto simp add: rel.well_order_on_Well_order)
24.280 +  hence "inj_on f (Field r) \<and> f  (Field r) \<le> Field r'"
24.281 +  by (auto simp add: embed_inj_on embed_Field)
24.282 +  thus "|Field r| \<le>o |Field r'|" using card_of_ordLeq by blast
24.283 +qed
24.284 +
24.285 +
24.286 +lemma card_of_cong: "r =o r' \<Longrightarrow> |Field r| =o |Field r'|"
24.287 +by (simp add: ordIso_iff_ordLeq card_of_mono2)
24.288 +
24.289 +
24.290 +lemma card_of_Field_ordLess: "Well_order r \<Longrightarrow> |Field r| \<le>o r"
24.291 +using card_of_least card_of_well_order_on rel.well_order_on_Well_order by blast
24.292 +
24.293 +
24.294 +lemma card_of_Field_ordIso:
24.295 +assumes "Card_order r"
24.296 +shows "|Field r| =o r"
24.297 +proof-
24.298 +  have "card_order_on (Field r) r"
24.299 +  using assms card_order_on_Card_order by blast
24.300 +  moreover have "card_order_on (Field r) |Field r|"
24.301 +  using card_of_card_order_on by blast
24.302 +  ultimately show ?thesis using card_order_on_ordIso by blast
24.303 +qed
24.304 +
24.305 +
24.306 +lemma Card_order_iff_ordIso_card_of:
24.307 +"Card_order r = (r =o |Field r| )"
24.308 +using ordIso_card_of_imp_Card_order card_of_Field_ordIso ordIso_symmetric by blast
24.309 +
24.310 +
24.311 +lemma Card_order_iff_ordLeq_card_of:
24.312 +"Card_order r = (r \<le>o |Field r| )"
24.313 +proof-
24.314 +  have "Card_order r = (r =o |Field r| )"
24.315 +  unfolding Card_order_iff_ordIso_card_of by simp
24.316 +  also have "... = (r \<le>o |Field r| \<and> |Field r| \<le>o r)"
24.317 +  unfolding ordIso_iff_ordLeq by simp
24.318 +  also have "... = (r \<le>o |Field r| )"
24.319 +  using card_of_Field_ordLess
24.320 +  by (auto simp: card_of_Field_ordLess ordLeq_Well_order_simp)
24.321 +  finally show ?thesis .
24.322 +qed
24.323 +
24.324 +
24.325 +lemma Card_order_iff_Restr_underS:
24.326 +assumes "Well_order r"
24.327 +shows "Card_order r = (\<forall>a \<in> Field r. Restr r (rel.underS r a) <o |Field r| )"
24.328 +using assms unfolding Card_order_iff_ordLeq_card_of
24.329 +using ordLeq_iff_ordLess_Restr card_of_Well_order by blast
24.330 +
24.331 +
24.332 +lemma card_of_underS:
24.333 +assumes r: "Card_order r" and a: "a : Field r"
24.334 +shows "|rel.underS r a| <o r"
24.335 +proof-
24.336 +  let ?A = "rel.underS r a"  let ?r' = "Restr r ?A"
24.337 +  have 1: "Well_order r"
24.338 +  using r unfolding card_order_on_def by simp
24.339 +  have "Well_order ?r'" using 1 Well_order_Restr by auto
24.340 +  moreover have "card_order_on (Field ?r') |Field ?r'|"
24.341 +  using card_of_card_order_on .
24.342 +  ultimately have "|Field ?r'| \<le>o ?r'"
24.343 +  unfolding card_order_on_def by simp
24.344 +  moreover have "Field ?r' = ?A"
24.345 +  using 1 wo_rel.underS_ofilter Field_Restr_ofilter
24.346 +  unfolding wo_rel_def by fastforce
24.347 +  ultimately have "|?A| \<le>o ?r'" by simp
24.348 +  also have "?r' <o |Field r|"
24.349 +  using 1 a r Card_order_iff_Restr_underS by blast
24.350 +  also have "|Field r| =o r"
24.351 +  using r ordIso_symmetric unfolding Card_order_iff_ordIso_card_of by auto
24.352 +  finally show ?thesis .
24.353 +qed
24.354 +
24.355 +
24.356 +lemma ordLess_Field:
24.357 +assumes "r <o r'"
24.358 +shows "|Field r| <o r'"
24.359 +proof-
24.360 +  have "well_order_on (Field r) r" using assms unfolding ordLess_def
24.361 +  by (auto simp add: rel.well_order_on_Well_order)
24.362 +  hence "|Field r| \<le>o r" using card_of_least by blast
24.363 +  thus ?thesis using assms ordLeq_ordLess_trans by blast
24.364 +qed
24.365 +
24.366 +
24.367 +lemma internalize_card_of_ordLeq:
24.368 +"( |A| \<le>o r) = (\<exists>B \<le> Field r. |A| =o |B| \<and> |B| \<le>o r)"
24.369 +proof
24.370 +  assume "|A| \<le>o r"
24.371 +  then obtain p where 1: "Field p \<le> Field r \<and> |A| =o p \<and> p \<le>o r"
24.372 +  using internalize_ordLeq[of "|A|" r] by blast
24.373 +  hence "Card_order p" using card_of_Card_order Card_order_ordIso2 by blast
24.374 +  hence "|Field p| =o p" using card_of_Field_ordIso by blast
24.375 +  hence "|A| =o |Field p| \<and> |Field p| \<le>o r"
24.376 +  using 1 ordIso_equivalence ordIso_ordLeq_trans by blast
24.377 +  thus "\<exists>B \<le> Field r. |A| =o |B| \<and> |B| \<le>o r" using 1 by blast
24.378 +next
24.379 +  assume "\<exists>B \<le> Field r. |A| =o |B| \<and> |B| \<le>o r"
24.380 +  thus "|A| \<le>o r" using ordIso_ordLeq_trans by blast
24.381 +qed
24.382 +
24.383 +
24.384 +lemma internalize_card_of_ordLeq2:
24.385 +"( |A| \<le>o |C| ) = (\<exists>B \<le> C. |A| =o |B| \<and> |B| \<le>o |C| )"
24.386 +using internalize_card_of_ordLeq[of "A" "|C|"] Field_card_of[of C] by auto
24.387 +
24.388 +
24.389 +
24.390 +subsection {* Cardinals versus set operations on arbitrary sets *}
24.391 +
24.392 +
24.393 +text{* Here we embark in a long journey of simple results showing
24.394 +that the standard set-theoretic operations are well-behaved w.r.t. the notion of
24.395 +cardinal -- essentially, this means that they preserve the cardinal identity"
24.396 +@{text "=o"} and are monotonic w.r.t. @{text "\<le>o"}.
24.397 +*}
24.398 +
24.399 +
24.400 +lemma card_of_empty: "|{}| \<le>o |A|"
24.401 +using card_of_ordLeq inj_on_id by blast
24.402 +
24.403 +
24.404 +lemma card_of_empty1:
24.405 +assumes "Well_order r \<or> Card_order r"
24.406 +shows "|{}| \<le>o r"
24.407 +proof-
24.408 +  have "Well_order r" using assms unfolding card_order_on_def by auto
24.409 +  hence "|Field r| <=o r"
24.410 +  using assms card_of_Field_ordLess by blast
24.411 +  moreover have "|{}| \<le>o |Field r|" by (simp add: card_of_empty)
24.412 +  ultimately show ?thesis using ordLeq_transitive by blast
24.413 +qed
24.414 +
24.415 +
24.416 +corollary Card_order_empty:
24.417 +"Card_order r \<Longrightarrow> |{}| \<le>o r" by (simp add: card_of_empty1)
24.418 +
24.419 +
24.420 +lemma card_of_empty2:
24.421 +assumes LEQ: "|A| =o |{}|"
24.422 +shows "A = {}"
24.423 +using assms card_of_ordIso[of A] bij_betw_empty2 by blast
24.424 +
24.425 +
24.426 +lemma card_of_empty3:
24.427 +assumes LEQ: "|A| \<le>o |{}|"
24.428 +shows "A = {}"
24.429 +using assms
24.430 +by (simp add: ordIso_iff_ordLeq card_of_empty1 card_of_empty2
24.431 +              ordLeq_Well_order_simp)
24.432 +
24.433 +
24.434 +lemma card_of_empty_ordIso:
24.435 +"|{}::'a set| =o |{}::'b set|"
24.436 +using card_of_ordIso unfolding bij_betw_def inj_on_def by blast
24.437 +
24.438 +
24.439 +lemma card_of_image:
24.440 +"|f  A| <=o |A|"
24.441 +proof(cases "A = {}", simp add: card_of_empty)
24.442 +  assume "A ~= {}"
24.443 +  hence "f  A ~= {}" by auto
24.444 +  thus "|f  A| \<le>o |A|"
24.445 +  using card_of_ordLeq2[of "f  A" A] by auto
24.446 +qed
24.447 +
24.448 +
24.449 +lemma surj_imp_ordLeq:
24.450 +assumes "B <= f  A"
24.451 +shows "|B| <=o |A|"
24.452 +proof-
24.453 +  have "|B| <=o |f  A|" using assms card_of_mono1 by auto
24.454 +  thus ?thesis using card_of_image ordLeq_transitive by blast
24.455 +qed
24.456 +
24.457 +
24.458 +lemma card_of_ordLeqI2:
24.459 +assumes "B \<subseteq> f  A"
24.460 +shows "|B| \<le>o |A|"
24.461 +using assms by (metis surj_imp_ordLeq)
24.462 +
24.463 +
24.464 +lemma card_of_singl_ordLeq:
24.465 +assumes "A \<noteq> {}"
24.466 +shows "|{b}| \<le>o |A|"
24.467 +proof-
24.468 +  obtain a where *: "a \<in> A" using assms by auto
24.469 +  let ?h = "\<lambda> b'::'b. if b' = b then a else undefined"
24.470 +  have "inj_on ?h {b} \<and> ?h  {b} \<le> A"
24.471 +  using * unfolding inj_on_def by auto
24.472 +  thus ?thesis using card_of_ordLeq by fast
24.473 +qed
24.474 +
24.475 +
24.476 +corollary Card_order_singl_ordLeq:
24.477 +"\<lbrakk>Card_order r; Field r \<noteq> {}\<rbrakk> \<Longrightarrow> |{b}| \<le>o r"
24.478 +using card_of_singl_ordLeq[of "Field r" b]
24.479 +      card_of_Field_ordIso[of r] ordLeq_ordIso_trans by blast
24.480 +
24.481 +
24.482 +lemma card_of_Pow: "|A| <o |Pow A|"
24.483 +using card_of_ordLess2[of "Pow A" A]  Cantors_paradox[of A]
24.484 +      Pow_not_empty[of A] by auto
24.485 +
24.486 +
24.487 +corollary Card_order_Pow:
24.488 +"Card_order r \<Longrightarrow> r <o |Pow(Field r)|"
24.489 +using card_of_Pow card_of_Field_ordIso ordIso_ordLess_trans ordIso_symmetric by blast
24.490 +
24.491 +
24.492 +lemma infinite_Pow:
24.493 +assumes "infinite A"
24.494 +shows "infinite (Pow A)"
24.495 +proof-
24.496 +  have "|A| \<le>o |Pow A|" by (metis card_of_Pow ordLess_imp_ordLeq)
24.497 +  thus ?thesis by (metis assms finite_Pow_iff)
24.498 +qed
24.499 +
24.500 +
24.501 +lemma card_of_Plus1: "|A| \<le>o |A <+> B|"
24.502 +proof-
24.503 +  have "Inl  A \<le> A <+> B" by auto
24.504 +  thus ?thesis using inj_Inl[of A] card_of_ordLeq by blast
24.505 +qed
24.506 +
24.507 +
24.508 +corollary Card_order_Plus1:
24.509 +"Card_order r \<Longrightarrow> r \<le>o |(Field r) <+> B|"
24.510 +using card_of_Plus1 card_of_Field_ordIso ordIso_ordLeq_trans ordIso_symmetric by blast
24.511 +
24.512 +
24.513 +lemma card_of_Plus2: "|B| \<le>o |A <+> B|"
24.514 +proof-
24.515 +  have "Inr  B \<le> A <+> B" by auto
24.516 +  thus ?thesis using inj_Inr[of B] card_of_ordLeq by blast
24.517 +qed
24.518 +
24.519 +
24.520 +corollary Card_order_Plus2:
24.521 +"Card_order r \<Longrightarrow> r \<le>o |A <+> (Field r)|"
24.522 +using card_of_Plus2 card_of_Field_ordIso ordIso_ordLeq_trans ordIso_symmetric by blast
24.523 +
24.524 +
24.525 +lemma card_of_Plus_empty1: "|A| =o |A <+> {}|"
24.526 +proof-
24.527 +  have "bij_betw Inl A (A <+> {})" unfolding bij_betw_def inj_on_def by auto
24.528 +  thus ?thesis using card_of_ordIso by auto
24.529 +qed
24.530 +
24.531 +
24.532 +lemma card_of_Plus_empty2: "|A| =o |{} <+> A|"
24.533 +proof-
24.534 +  have "bij_betw Inr A ({} <+> A)" unfolding bij_betw_def inj_on_def by auto
24.535 +  thus ?thesis using card_of_ordIso by auto
24.536 +qed
24.537 +
24.538 +
24.539 +lemma card_of_Plus_commute: "|A <+> B| =o |B <+> A|"
24.540 +proof-
24.541 +  let ?f = "\<lambda>(c::'a + 'b). case c of Inl a \<Rightarrow> Inr a
24.542 +                                   | Inr b \<Rightarrow> Inl b"
24.543 +  have "bij_betw ?f (A <+> B) (B <+> A)"
24.544 +  unfolding bij_betw_def inj_on_def by force
24.545 +  thus ?thesis using card_of_ordIso by blast
24.546 +qed
24.547 +
24.548 +
24.549 +lemma card_of_Plus_assoc:
24.550 +fixes A :: "'a set" and B :: "'b set" and C :: "'c set"
24.551 +shows "|(A <+> B) <+> C| =o |A <+> B <+> C|"
24.552 +proof -
24.553 +  def f \<equiv> "\<lambda>(k::('a + 'b) + 'c).
24.554 +  case k of Inl ab \<Rightarrow> (case ab of Inl a \<Rightarrow> Inl a
24.555 +                                 |Inr b \<Rightarrow> Inr (Inl b))
24.556 +           |Inr c \<Rightarrow> Inr (Inr c)"
24.557 +  have "A <+> B <+> C \<subseteq> f  ((A <+> B) <+> C)"
24.558 +  proof
24.559 +    fix x assume x: "x \<in> A <+> B <+> C"
24.560 +    show "x \<in> f  ((A <+> B) <+> C)"
24.561 +    proof(cases x)
24.562 +      case (Inl a)
24.563 +      hence "a \<in> A" "x = f (Inl (Inl a))"
24.564 +      using x unfolding f_def by auto
24.565 +      thus ?thesis by auto
24.566 +    next
24.567 +      case (Inr bc) note 1 = Inr show ?thesis
24.568 +      proof(cases bc)
24.569 +        case (Inl b)
24.570 +        hence "b \<in> B" "x = f (Inl (Inr b))"
24.571 +        using x 1 unfolding f_def by auto
24.572 +        thus ?thesis by auto
24.573 +      next
24.574 +        case (Inr c)
24.575 +        hence "c \<in> C" "x = f (Inr c)"
24.576 +        using x 1 unfolding f_def by auto
24.577 +        thus ?thesis by auto
24.578 +      qed
24.579 +    qed
24.580 +  qed
24.581 +  hence "bij_betw f ((A <+> B) <+> C) (A <+> B <+> C)"
24.582 +  unfolding bij_betw_def inj_on_def f_def by fastforce
24.583 +  thus ?thesis using card_of_ordIso by blast
24.584 +qed
24.585 +
24.586 +
24.587 +lemma card_of_Plus_mono1:
24.588 +assumes "|A| \<le>o |B|"
24.589 +shows "|A <+> C| \<le>o |B <+> C|"
24.590 +proof-
24.591 +  obtain f where 1: "inj_on f A \<and> f  A \<le> B"
24.592 +  using assms card_of_ordLeq[of A] by fastforce
24.593 +  obtain g where g_def:
24.594 +  "g = (\<lambda>d. case d of Inl a \<Rightarrow> Inl(f a) | Inr (c::'c) \<Rightarrow> Inr c)" by blast
24.595 +  have "inj_on g (A <+> C) \<and> g  (A <+> C) \<le> (B <+> C)"
24.596 +  proof-
24.597 +    {fix d1 and d2 assume "d1 \<in> A <+> C \<and> d2 \<in> A <+> C" and
24.598 +                          "g d1 = g d2"
24.599 +     hence "d1 = d2" using 1 unfolding inj_on_def g_def by force
24.600 +    }
24.601 +    moreover
24.602 +    {fix d assume "d \<in> A <+> C"
24.603 +     hence "g d \<in> B <+> C"  using 1
24.604 +     by(case_tac d, auto simp add: g_def)
24.605 +    }
24.606 +    ultimately show ?thesis unfolding inj_on_def by auto
24.607 +  qed
24.608 +  thus ?thesis using card_of_ordLeq by metis
24.609 +qed
24.610 +
24.611 +
24.612 +corollary ordLeq_Plus_mono1:
24.613 +assumes "r \<le>o r'"
24.614 +shows "|(Field r) <+> C| \<le>o |(Field r') <+> C|"
24.615 +using assms card_of_mono2 card_of_Plus_mono1 by blast
24.616 +
24.617 +
24.618 +lemma card_of_Plus_mono2:
24.619 +assumes "|A| \<le>o |B|"
24.620 +shows "|C <+> A| \<le>o |C <+> B|"
24.621 +using assms card_of_Plus_mono1[of A B C]
24.622 +      card_of_Plus_commute[of C A]  card_of_Plus_commute[of B C]
24.623 +      ordIso_ordLeq_trans[of "|C <+> A|"] ordLeq_ordIso_trans[of "|C <+> A|"]
24.624 +by blast
24.625 +
24.626 +
24.627 +corollary ordLeq_Plus_mono2:
24.628 +assumes "r \<le>o r'"
24.629 +shows "|A <+> (Field r)| \<le>o |A <+> (Field r')|"
24.630 +using assms card_of_mono2 card_of_Plus_mono2 by blast
24.631 +
24.632 +
24.633 +lemma card_of_Plus_mono:
24.634 +assumes "|A| \<le>o |B|" and "|C| \<le>o |D|"
24.635 +shows "|A <+> C| \<le>o |B <+> D|"
24.636 +using assms card_of_Plus_mono1[of A B C] card_of_Plus_mono2[of C D B]
24.637 +      ordLeq_transitive[of "|A <+> C|"] by blast
24.638 +
24.639 +
24.640 +corollary ordLeq_Plus_mono:
24.641 +assumes "r \<le>o r'" and "p \<le>o p'"
24.642 +shows "|(Field r) <+> (Field p)| \<le>o |(Field r') <+> (Field p')|"
24.643 +using assms card_of_mono2[of r r'] card_of_mono2[of p p'] card_of_Plus_mono by blast
24.644 +
24.645 +
24.646 +lemma card_of_Plus_cong1:
24.647 +assumes "|A| =o |B|"
24.648 +shows "|A <+> C| =o |B <+> C|"
24.649 +using assms by (simp add: ordIso_iff_ordLeq card_of_Plus_mono1)
24.650 +
24.651 +
24.652 +corollary ordIso_Plus_cong1:
24.653 +assumes "r =o r'"
24.654 +shows "|(Field r) <+> C| =o |(Field r') <+> C|"
24.655 +using assms card_of_cong card_of_Plus_cong1 by blast
24.656 +
24.657 +
24.658 +lemma card_of_Plus_cong2:
24.659 +assumes "|A| =o |B|"
24.660 +shows "|C <+> A| =o |C <+> B|"
24.661 +using assms by (simp add: ordIso_iff_ordLeq card_of_Plus_mono2)
24.662 +
24.663 +
24.664 +corollary ordIso_Plus_cong2:
24.665 +assumes "r =o r'"
24.666 +shows "|A <+> (Field r)| =o |A <+> (Field r')|"
24.667 +using assms card_of_cong card_of_Plus_cong2 by blast
24.668 +
24.669 +
24.670 +lemma card_of_Plus_cong:
24.671 +assumes "|A| =o |B|" and "|C| =o |D|"
24.672 +shows "|A <+> C| =o |B <+> D|"
24.673 +using assms by (simp add: ordIso_iff_ordLeq card_of_Plus_mono)
24.674 +
24.675 +
24.676 +corollary ordIso_Plus_cong:
24.677 +assumes "r =o r'" and "p =o p'"
24.678 +shows "|(Field r) <+> (Field p)| =o |(Field r') <+> (Field p')|"
24.679 +using assms card_of_cong[of r r'] card_of_cong[of p p'] card_of_Plus_cong by blast
24.680 +
24.681 +
24.682 +lemma card_of_Un_Plus_ordLeq:
24.683 +"|A \<union> B| \<le>o |A <+> B|"
24.684 +proof-
24.685 +   let ?f = "\<lambda> c. if c \<in> A then Inl c else Inr c"
24.686 +   have "inj_on ?f (A \<union> B) \<and> ?f  (A \<union> B) \<le> A <+> B"
24.687 +   unfolding inj_on_def by auto
24.688 +   thus ?thesis using card_of_ordLeq by blast
24.689 +qed
24.690 +
24.691 +
24.692 +lemma card_of_Times1:
24.693 +assumes "A \<noteq> {}"
24.694 +shows "|B| \<le>o |B \<times> A|"
24.695 +proof(cases "B = {}", simp add: card_of_empty)
24.696 +  assume *: "B \<noteq> {}"
24.697 +  have "fst (B \<times> A) = B" unfolding image_def using assms by auto
24.698 +  thus ?thesis using inj_on_iff_surj[of B "B \<times> A"]
24.699 +                     card_of_ordLeq[of B "B \<times> A"] * by blast
24.700 +qed
24.701 +
24.702 +
24.703 +lemma card_of_Times_commute: "|A \<times> B| =o |B \<times> A|"
24.704 +proof-
24.705 +  let ?f = "\<lambda>(a::'a,b::'b). (b,a)"
24.706 +  have "bij_betw ?f (A \<times> B) (B \<times> A)"
24.707 +  unfolding bij_betw_def inj_on_def by auto
24.708 +  thus ?thesis using card_of_ordIso by blast
24.709 +qed
24.710 +
24.711 +
24.712 +lemma card_of_Times2:
24.713 +assumes "A \<noteq> {}"   shows "|B| \<le>o |A \<times> B|"
24.714 +using assms card_of_Times1[of A B] card_of_Times_commute[of B A]
24.715 +      ordLeq_ordIso_trans by blast
24.716 +
24.717 +
24.718 +corollary Card_order_Times1:
24.719 +"\<lbrakk>Card_order r; B \<noteq> {}\<rbrakk> \<Longrightarrow> r \<le>o |(Field r) \<times> B|"
24.720 +using card_of_Times1[of B] card_of_Field_ordIso
24.721 +      ordIso_ordLeq_trans ordIso_symmetric by blast
24.722 +
24.723 +
24.724 +corollary Card_order_Times2:
24.725 +"\<lbrakk>Card_order r; A \<noteq> {}\<rbrakk> \<Longrightarrow> r \<le>o |A \<times> (Field r)|"
24.726 +using card_of_Times2[of A] card_of_Field_ordIso
24.727 +      ordIso_ordLeq_trans ordIso_symmetric by blast
24.728 +
24.729 +
24.730 +lemma card_of_Times3: "|A| \<le>o |A \<times> A|"
24.731 +using card_of_Times1[of A]
24.732 +by(cases "A = {}", simp add: card_of_empty, blast)
24.733 +
24.734 +
24.735 +lemma card_of_Plus_Times_bool: "|A <+> A| =o |A \<times> (UNIV::bool set)|"
24.736 +proof-
24.737 +  let ?f = "\<lambda>c::'a + 'a. case c of Inl a \<Rightarrow> (a,True)
24.738 +                                  |Inr a \<Rightarrow> (a,False)"
24.739 +  have "bij_betw ?f (A <+> A) (A \<times> (UNIV::bool set))"
24.740 +  proof-
24.741 +    {fix  c1 and c2 assume "?f c1 = ?f c2"
24.742 +     hence "c1 = c2"
24.743 +     by(case_tac "c1", case_tac "c2", auto, case_tac "c2", auto)
24.744 +    }
24.745 +    moreover
24.746 +    {fix c assume "c \<in> A <+> A"
24.747 +     hence "?f c \<in> A \<times> (UNIV::bool set)"
24.748 +     by(case_tac c, auto)
24.749 +    }
24.750 +    moreover
24.751 +    {fix a bl assume *: "(a,bl) \<in> A \<times> (UNIV::bool set)"
24.752 +     have "(a,bl) \<in> ?f  ( A <+> A)"
24.753 +     proof(cases bl)
24.754 +       assume bl hence "?f(Inl a) = (a,bl)" by auto
24.755 +       thus ?thesis using * by force
24.756 +     next
24.757 +       assume "\<not> bl" hence "?f(Inr a) = (a,bl)" by auto
24.758 +       thus ?thesis using * by force
24.759 +     qed
24.760 +    }
24.761 +    ultimately show ?thesis unfolding bij_betw_def inj_on_def by auto
24.762 +  qed
24.763 +  thus ?thesis using card_of_ordIso by blast
24.764 +qed
24.765 +
24.766 +
24.767 +lemma card_of_Times_mono1:
24.768 +assumes "|A| \<le>o |B|"
24.769 +shows "|A \<times> C| \<le>o |B \<times> C|"
24.770 +proof-
24.771 +  obtain f where 1: "inj_on f A \<and> f  A \<le> B"
24.772 +  using assms card_of_ordLeq[of A] by fastforce
24.773 +  obtain g where g_def:
24.774 +  "g = (\<lambda>(a,c::'c). (f a,c))" by blast
24.775 +  have "inj_on g (A \<times> C) \<and> g  (A \<times> C) \<le> (B \<times> C)"
24.776 +  using 1 unfolding inj_on_def using g_def by auto
24.777 +  thus ?thesis using card_of_ordLeq by metis
24.778 +qed
24.779 +
24.780 +
24.781 +corollary ordLeq_Times_mono1:
24.782 +assumes "r \<le>o r'"
24.783 +shows "|(Field r) \<times> C| \<le>o |(Field r') \<times> C|"
24.784 +using assms card_of_mono2 card_of_Times_mono1 by blast
24.785 +
24.786 +
24.787 +lemma card_of_Times_mono2:
24.788 +assumes "|A| \<le>o |B|"
24.789 +shows "|C \<times> A| \<le>o |C \<times> B|"
24.790 +using assms card_of_Times_mono1[of A B C]
24.791 +      card_of_Times_commute[of C A]  card_of_Times_commute[of B C]
24.792 +      ordIso_ordLeq_trans[of "|C \<times> A|"] ordLeq_ordIso_trans[of "|C \<times> A|"]
24.793 +by blast
24.794 +
24.795 +
24.796 +corollary ordLeq_Times_mono2:
24.797 +assumes "r \<le>o r'"
24.798 +shows "|A \<times> (Field r)| \<le>o |A \<times> (Field r')|"
24.799 +using assms card_of_mono2 card_of_Times_mono2 by blast
24.800 +
24.801 +
24.802 +lemma card_of_Sigma_mono1:
24.803 +assumes "\<forall>i \<in> I. |A i| \<le>o |B i|"
24.804 +shows "|SIGMA i : I. A i| \<le>o |SIGMA i : I. B i|"
24.805 +proof-
24.806 +  have "\<forall>i. i \<in> I \<longrightarrow> (\<exists>f. inj_on f (A i) \<and> f  (A i) \<le> B i)"
24.807 +  using assms by (auto simp add: card_of_ordLeq)
24.808 +  with choice[of "\<lambda> i f. i \<in> I \<longrightarrow> inj_on f (A i) \<and> f  (A i) \<le> B i"]
24.809 +  obtain F where 1: "\<forall>i \<in> I. inj_on (F i) (A i) \<and> (F i)  (A i) \<le> B i" by metis
24.810 +  obtain g where g_def: "g = (\<lambda>(i,a::'b). (i,F i a))" by blast
24.811 +  have "inj_on g (Sigma I A) \<and> g  (Sigma I A) \<le> (Sigma I B)"
24.812 +  using 1 unfolding inj_on_def using g_def by force
24.813 +  thus ?thesis using card_of_ordLeq by metis
24.814 +qed
24.815 +
24.816 +
24.817 +corollary card_of_Sigma_Times:
24.818 +"\<forall>i \<in> I. |A i| \<le>o |B| \<Longrightarrow> |SIGMA i : I. A i| \<le>o |I \<times> B|"
24.819 +using card_of_Sigma_mono1[of I A "\<lambda>i. B"] .
24.820 +
24.821 +
24.822 +lemma card_of_UNION_Sigma:
24.823 +"|\<Union>i \<in> I. A i| \<le>o |SIGMA i : I. A i|"
24.824 +using Ex_inj_on_UNION_Sigma[of I A] card_of_ordLeq by metis
24.825 +
24.826 +
24.827 +lemma card_of_bool:
24.828 +assumes "a1 \<noteq> a2"
24.829 +shows "|UNIV::bool set| =o |{a1,a2}|"
24.830 +proof-
24.831 +  let ?f = "\<lambda> bl. case bl of True \<Rightarrow> a1 | False \<Rightarrow> a2"
24.832 +  have "bij_betw ?f UNIV {a1,a2}"
24.833 +  proof-
24.834 +    {fix bl1 and bl2 assume "?f  bl1 = ?f bl2"
24.835 +     hence "bl1 = bl2" using assms by (case_tac bl1, case_tac bl2, auto)
24.836 +    }
24.837 +    moreover
24.838 +    {fix bl have "?f bl \<in> {a1,a2}" by (case_tac bl, auto)
24.839 +    }
24.840 +    moreover
24.841 +    {fix a assume *: "a \<in> {a1,a2}"
24.842 +     have "a \<in> ?f  UNIV"
24.843 +     proof(cases "a = a1")
24.844 +       assume "a = a1"
24.845 +       hence "?f True = a" by auto  thus ?thesis by blast
24.846 +     next
24.847 +       assume "a \<noteq> a1" hence "a = a2" using * by auto
24.848 +       hence "?f False = a" by auto  thus ?thesis by blast
24.849 +     qed
24.850 +    }
24.851 +    ultimately show ?thesis unfolding bij_betw_def inj_on_def
24.852 +    by (metis image_subsetI order_eq_iff subsetI)
24.853 +  qed
24.854 +  thus ?thesis using card_of_ordIso by blast
24.855 +qed
24.856 +
24.857 +
24.858 +lemma card_of_Plus_Times_aux:
24.859 +assumes A2: "a1 \<noteq> a2 \<and> {a1,a2} \<le> A" and
24.860 +        LEQ: "|A| \<le>o |B|"
24.861 +shows "|A <+> B| \<le>o |A \<times> B|"
24.862 +proof-
24.863 +  have 1: "|UNIV::bool set| \<le>o |A|"
24.864 +  using A2 card_of_mono1[of "{a1,a2}"] card_of_bool[of a1 a2]
24.865 +        ordIso_ordLeq_trans[of "|UNIV::bool set|"] by metis
24.866 +  (*  *)
24.867 +  have "|A <+> B| \<le>o |B <+> B|"
24.868 +  using LEQ card_of_Plus_mono1 by blast
24.869 +  moreover have "|B <+> B| =o |B \<times> (UNIV::bool set)|"
24.870 +  using card_of_Plus_Times_bool by blast
24.871 +  moreover have "|B \<times> (UNIV::bool set)| \<le>o |B \<times> A|"
24.872 +  using 1 by (simp add: card_of_Times_mono2)
24.873 +  moreover have " |B \<times> A| =o |A \<times> B|"
24.874 +  using card_of_Times_commute by blast
24.875 +  ultimately show "|A <+> B| \<le>o |A \<times> B|"
24.876 +  using ordLeq_ordIso_trans[of "|A <+> B|" "|B <+> B|" "|B \<times> (UNIV::bool set)|"]
24.877 +        ordLeq_transitive[of "|A <+> B|" "|B \<times> (UNIV::bool set)|" "|B \<times> A|"]
24.878 +        ordLeq_ordIso_trans[of "|A <+> B|" "|B \<times> A|" "|A \<times> B|"]
24.879 +  by blast
24.880 +qed
24.881 +
24.882 +
24.883 +lemma card_of_Plus_Times:
24.884 +assumes A2: "a1 \<noteq> a2 \<and> {a1,a2} \<le> A" and
24.885 +        B2: "b1 \<noteq> b2 \<and> {b1,b2} \<le> B"
24.886 +shows "|A <+> B| \<le>o |A \<times> B|"
24.887 +proof-
24.888 +  {assume "|A| \<le>o |B|"
24.889 +   hence ?thesis using assms by (auto simp add: card_of_Plus_Times_aux)
24.890 +  }
24.891 +  moreover
24.892 +  {assume "|B| \<le>o |A|"
24.893 +   hence "|B <+> A| \<le>o |B \<times> A|"
24.894 +   using assms by (auto simp add: card_of_Plus_Times_aux)
24.895 +   hence ?thesis
24.896 +   using card_of_Plus_commute card_of_Times_commute
24.897 +         ordIso_ordLeq_trans ordLeq_ordIso_trans by metis
24.898 +  }
24.899 +  ultimately show ?thesis
24.900 +  using card_of_Well_order[of A] card_of_Well_order[of B]
24.901 +        ordLeq_total[of "|A|"] by metis
24.902 +qed
24.903 +
24.904 +
24.905 +lemma card_of_ordLeq_finite:
24.906 +assumes "|A| \<le>o |B|" and "finite B"
24.907 +shows "finite A"
24.908 +using assms unfolding ordLeq_def
24.909 +using embed_inj_on[of "|A|" "|B|"]  embed_Field[of "|A|" "|B|"]
24.910 +      Field_card_of[of "A"] Field_card_of[of "B"] inj_on_finite[of _ "A" "B"] by fastforce
24.911 +
24.912 +
24.913 +lemma card_of_ordLeq_infinite:
24.914 +assumes "|A| \<le>o |B|" and "infinite A"
24.915 +shows "infinite B"
24.916 +using assms card_of_ordLeq_finite by auto
24.917 +
24.918 +
24.919 +lemma card_of_ordIso_finite:
24.920 +assumes "|A| =o |B|"
24.921 +shows "finite A = finite B"
24.922 +using assms unfolding ordIso_def iso_def[abs_def]
24.923 +by (auto simp: bij_betw_finite Field_card_of)
24.924 +
24.925 +
24.926 +lemma card_of_ordIso_finite_Field:
24.927 +assumes "Card_order r" and "r =o |A|"
24.928 +shows "finite(Field r) = finite A"
24.929 +using assms card_of_Field_ordIso card_of_ordIso_finite ordIso_equivalence by blast
24.930 +
24.931 +
24.932 +subsection {* Cardinals versus set operations involving infinite sets *}
24.933 +
24.934 +
24.935 +text{* Here we show that, for infinite sets, most set-theoretic constructions
24.936 +do not increase the cardinality.  The cornerstone for this is
24.937 +theorem @{text "Card_order_Times_same_infinite"}, which states that self-product
24.938 +does not increase cardinality -- the proof of this fact adapts a standard
24.939 +set-theoretic argument, as presented, e.g., in the proof of theorem 1.5.11
24.940 +at page 47 in \cite{card-book}. Then everything else follows fairly easily.  *}
24.941 +
24.942 +
24.943 +lemma infinite_iff_card_of_nat:
24.944 +"infinite A = ( |UNIV::nat set| \<le>o |A| )"
24.945 +by (auto simp add: infinite_iff_countable_subset card_of_ordLeq)
24.946 +
24.947 +
24.948 +text{* The next two results correspond to the ZF fact that all infinite cardinals are
24.949 +limit ordinals: *}
24.950 +
24.951 +lemma Card_order_infinite_not_under:
24.952 +assumes CARD: "Card_order r" and INF: "infinite (Field r)"
24.953 +shows "\<not> (\<exists>a. Field r = rel.under r a)"
24.954 +proof(auto)
24.955 +  have 0: "Well_order r \<and> wo_rel r \<and> Refl r"
24.956 +  using CARD unfolding wo_rel_def card_order_on_def order_on_defs by auto
24.957 +  fix a assume *: "Field r = rel.under r a"
24.958 +  show False
24.959 +  proof(cases "a \<in> Field r")
24.960 +    assume Case1: "a \<notin> Field r"
24.961 +    hence "rel.under r a = {}" unfolding Field_def rel.under_def by auto
24.962 +    thus False using INF *  by auto
24.963 +  next
24.964 +    let ?r' = "Restr r (rel.underS r a)"
24.965 +    assume Case2: "a \<in> Field r"
24.966 +    hence 1: "rel.under r a = rel.underS r a \<union> {a} \<and> a \<notin> rel.underS r a"
24.967 +    using 0 rel.Refl_under_underS rel.underS_notIn by metis
24.968 +    have 2: "wo_rel.ofilter r (rel.underS r a) \<and> rel.underS r a < Field r"
24.969 +    using 0 wo_rel.underS_ofilter * 1 Case2 by fast
24.970 +    hence "?r' <o r" using 0 using ofilter_ordLess by blast
24.971 +    moreover
24.972 +    have "Field ?r' = rel.underS r a \<and> Well_order ?r'"
24.973 +    using  2 0 Field_Restr_ofilter[of r] Well_order_Restr[of r] by blast
24.974 +    ultimately have "|rel.underS r a| <o r" using ordLess_Field[of ?r'] by auto
24.975 +    moreover have "|rel.under r a| =o r" using * CARD card_of_Field_ordIso[of r] by auto
24.976 +    ultimately have "|rel.underS r a| <o |rel.under r a|"
24.977 +    using ordIso_symmetric ordLess_ordIso_trans by blast
24.978 +    moreover
24.979 +    {have "\<exists>f. bij_betw f (rel.under r a) (rel.underS r a)"
24.980 +     using infinite_imp_bij_betw[of "Field r" a] INF * 1 by auto
24.981 +     hence "|rel.under r a| =o |rel.underS r a|" using card_of_ordIso by blast
24.982 +    }
24.983 +    ultimately show False using not_ordLess_ordIso ordIso_symmetric by blast
24.984 +  qed
24.985 +qed
24.986 +
24.987 +
24.988 +lemma infinite_Card_order_limit:
24.989 +assumes r: "Card_order r" and "infinite (Field r)"
24.990 +and a: "a : Field r"
24.991 +shows "EX b : Field r. a \<noteq> b \<and> (a,b) : r"
24.992 +proof-
24.993 +  have "Field r \<noteq> rel.under r a"
24.994 +  using assms Card_order_infinite_not_under by blast
24.995 +  moreover have "rel.under r a \<le> Field r"
24.996 +  using rel.under_Field .
24.997 +  ultimately have "rel.under r a < Field r" by blast
24.998 +  then obtain b where 1: "b : Field r \<and> ~ (b,a) : r"
24.999 +  unfolding rel.under_def by blast
24.1000 +  moreover have ba: "b \<noteq> a"
24.1001 +  using 1 r unfolding card_order_on_def well_order_on_def
24.1002 +  linear_order_on_def partial_order_on_def preorder_on_def refl_on_def by auto
24.1003 +  ultimately have "(a,b) : r"
24.1004 +  using a r unfolding card_order_on_def well_order_on_def linear_order_on_def
24.1005 +  total_on_def by blast
24.1006 +  thus ?thesis using 1 ba by auto
24.1007 +qed
24.1008 +
24.1009 +
24.1010 +theorem Card_order_Times_same_infinite:
24.1011 +assumes CO: "Card_order r" and INF: "infinite(Field r)"
24.1012 +shows "|Field r \<times> Field r| \<le>o r"
24.1013 +proof-
24.1014 +  obtain phi where phi_def:
24.1015 +  "phi = (\<lambda>r::'a rel. Card_order r \<and> infinite(Field r) \<and>
24.1016 +                      \<not> |Field r \<times> Field r| \<le>o r )" by blast
24.1017 +  have temp1: "\<forall>r. phi r \<longrightarrow> Well_order r"
24.1018 +  unfolding phi_def card_order_on_def by auto
24.1019 +  have Ft: "\<not>(\<exists>r. phi r)"
24.1020 +  proof
24.1021 +    assume "\<exists>r. phi r"
24.1022 +    hence "{r. phi r} \<noteq> {} \<and> {r. phi r} \<le> {r. Well_order r}"
24.1023 +    using temp1 by auto
24.1024 +    then obtain r where 1: "phi r" and 2: "\<forall>r'. phi r' \<longrightarrow> r \<le>o r'" and
24.1025 +                   3: "Card_order r \<and> Well_order r"
24.1026 +    using exists_minim_Well_order[of "{r. phi r}"] temp1 phi_def by blast
24.1027 +    let ?A = "Field r"  let ?r' = "bsqr r"
24.1028 +    have 4: "Well_order ?r' \<and> Field ?r' = ?A \<times> ?A \<and> |?A| =o r"
24.1029 +    using 3 bsqr_Well_order Field_bsqr card_of_Field_ordIso by blast
24.1030 +    have 5: "Card_order |?A \<times> ?A| \<and> Well_order |?A \<times> ?A|"
24.1031 +    using card_of_Card_order card_of_Well_order by blast
24.1032 +    (*  *)
24.1033 +    have "r <o |?A \<times> ?A|"
24.1034 +    using 1 3 5 ordLess_or_ordLeq unfolding phi_def by blast
24.1035 +    moreover have "|?A \<times> ?A| \<le>o ?r'"
24.1036 +    using card_of_least[of "?A \<times> ?A"] 4 by auto
24.1037 +    ultimately have "r <o ?r'" using ordLess_ordLeq_trans by auto
24.1038 +    then obtain f where 6: "embed r ?r' f" and 7: "\<not> bij_betw f ?A (?A \<times> ?A)"
24.1039 +    unfolding ordLess_def embedS_def[abs_def]
24.1040 +    by (auto simp add: Field_bsqr)
24.1041 +    let ?B = "f  ?A"
24.1042 +    have "|?A| =o |?B|"
24.1043 +    using 3 6 embed_inj_on inj_on_imp_bij_betw card_of_ordIso by blast
24.1044 +    hence 8: "r =o |?B|" using 4 ordIso_transitive ordIso_symmetric by blast
24.1045 +    (*  *)
24.1046 +    have "wo_rel.ofilter ?r' ?B"
24.1047 +    using 6 embed_Field_ofilter 3 4 by blast
24.1048 +    hence "wo_rel.ofilter ?r' ?B \<and> ?B \<noteq> ?A \<times> ?A \<and> ?B \<noteq> Field ?r'"
24.1049 +    using 7 unfolding bij_betw_def using 6 3 embed_inj_on 4 by auto
24.1050 +    hence temp2: "wo_rel.ofilter ?r' ?B \<and> ?B < ?A \<times> ?A"
24.1051 +    using 4 wo_rel_def[of ?r'] wo_rel.ofilter_def[of ?r' ?B] by blast
24.1052 +    have "\<not> (\<exists>a. Field r = rel.under r a)"
24.1053 +    using 1 unfolding phi_def using Card_order_infinite_not_under[of r] by auto
24.1054 +    then obtain A1 where temp3: "wo_rel.ofilter r A1 \<and> A1 < ?A" and 9: "?B \<le> A1 \<times> A1"
24.1055 +    using temp2 3 bsqr_ofilter[of r ?B] by blast
24.1056 +    hence "|?B| \<le>o |A1 \<times> A1|" using card_of_mono1 by blast
24.1057 +    hence 10: "r \<le>o |A1 \<times> A1|" using 8 ordIso_ordLeq_trans by blast
24.1058 +    let ?r1 = "Restr r A1"
24.1059 +    have "?r1 <o r" using temp3 ofilter_ordLess 3 by blast
24.1060 +    moreover
24.1061 +    {have "well_order_on A1 ?r1" using 3 temp3 well_order_on_Restr by blast
24.1062 +     hence "|A1| \<le>o ?r1" using 3 Well_order_Restr card_of_least by blast
24.1063 +    }
24.1064 +    ultimately have 11: "|A1| <o r" using ordLeq_ordLess_trans by blast
24.1065 +    (*  *)
24.1066 +    have "infinite (Field r)" using 1 unfolding phi_def by simp
24.1067 +    hence "infinite ?B" using 8 3 card_of_ordIso_finite_Field[of r ?B] by blast
24.1068 +    hence "infinite A1" using 9 infinite_super finite_cartesian_product by blast
24.1069 +    moreover have temp4: "Field |A1| = A1 \<and> Well_order |A1| \<and> Card_order |A1|"
24.1070 +    using card_of_Card_order[of A1] card_of_Well_order[of A1]
24.1071 +    by (simp add: Field_card_of)
24.1072 +    moreover have "\<not> r \<le>o | A1 |"
24.1073 +    using temp4 11 3 using not_ordLeq_iff_ordLess by blast
24.1074 +    ultimately have "infinite(Field |A1| ) \<and> Card_order |A1| \<and> \<not> r \<le>o | A1 |"
24.1075 +    by (simp add: card_of_card_order_on)
24.1076 +    hence "|Field |A1| \<times> Field |A1| | \<le>o |A1|"
24.1077 +    using 2 unfolding phi_def by blast
24.1078 +    hence "|A1 \<times> A1 | \<le>o |A1|" using temp4 by auto
24.1079 +    hence "r \<le>o |A1|" using 10 ordLeq_transitive by blast
24.1080 +    thus False using 11 not_ordLess_ordLeq by auto
24.1081 +  qed
24.1082 +  thus ?thesis using assms unfolding phi_def by blast
24.1083 +qed
24.1084 +
24.1085 +
24.1086 +corollary card_of_Times_same_infinite:
24.1087 +assumes "infinite A"
24.1088 +shows "|A \<times> A| =o |A|"
24.1089 +proof-
24.1090 +  let ?r = "|A|"
24.1091 +  have "Field ?r = A \<and> Card_order ?r"
24.1092 +  using Field_card_of card_of_Card_order[of A] by fastforce
24.1093 +  hence "|A \<times> A| \<le>o |A|"
24.1094 +  using Card_order_Times_same_infinite[of ?r] assms by auto
24.1095 +  thus ?thesis using card_of_Times3 ordIso_iff_ordLeq by blast
24.1096 +qed
24.1097 +
24.1098 +
24.1099 +lemma card_of_Times_infinite:
24.1100 +assumes INF: "infinite A" and NE: "B \<noteq> {}" and LEQ: "|B| \<le>o |A|"
24.1101 +shows "|A \<times> B| =o |A| \<and> |B \<times> A| =o |A|"
24.1102 +proof-
24.1103 +  have "|A| \<le>o |A \<times> B| \<and> |A| \<le>o |B \<times> A|"
24.1104 +  using assms by (simp add: card_of_Times1 card_of_Times2)
24.1105 +  moreover
24.1106 +  {have "|A \<times> B| \<le>o |A \<times> A| \<and> |B \<times> A| \<le>o |A \<times> A|"
24.1107 +   using LEQ card_of_Times_mono1 card_of_Times_mono2 by blast
24.1108 +   moreover have "|A \<times> A| =o |A|" using INF card_of_Times_same_infinite by blast
24.1109 +   ultimately have "|A \<times> B| \<le>o |A| \<and> |B \<times> A| \<le>o |A|"
24.1110 +   using ordLeq_ordIso_trans[of "|A \<times> B|"] ordLeq_ordIso_trans[of "|B \<times> A|"] by auto
24.1111 +  }
24.1112 +  ultimately show ?thesis by (simp add: ordIso_iff_ordLeq)
24.1113 +qed
24.1114 +
24.1115 +
24.1116 +corollary Card_order_Times_infinite:
24.1117 +assumes INF: "infinite(Field r)" and CARD: "Card_order r" and
24.1118 +        NE: "Field p \<noteq> {}" and LEQ: "p \<le>o r"
24.1119 +shows "| (Field r) \<times> (Field p) | =o r \<and> | (Field p) \<times> (Field r) | =o r"
24.1120 +proof-
24.1121 +  have "|Field r \<times> Field p| =o |Field r| \<and> |Field p \<times> Field r| =o |Field r|"
24.1122 +  using assms by (simp add: card_of_Times_infinite card_of_mono2)
24.1123 +  thus ?thesis
24.1124 +  using assms card_of_Field_ordIso[of r]
24.1125 +        ordIso_transitive[of "|Field r \<times> Field p|"]
24.1126 +        ordIso_transitive[of _ "|Field r|"] by blast
24.1127 +qed
24.1128 +
24.1129 +
24.1130 +lemma card_of_Sigma_ordLeq_infinite:
24.1131 +assumes INF: "infinite B" and
24.1132 +        LEQ_I: "|I| \<le>o |B|" and LEQ: "\<forall>i \<in> I. |A i| \<le>o |B|"
24.1133 +shows "|SIGMA i : I. A i| \<le>o |B|"
24.1134 +proof(cases "I = {}", simp add: card_of_empty)
24.1135 +  assume *: "I \<noteq> {}"
24.1136 +  have "|SIGMA i : I. A i| \<le>o |I \<times> B|"
24.1137 +  using LEQ card_of_Sigma_Times by blast
24.1138 +  moreover have "|I \<times> B| =o |B|"
24.1139 +  using INF * LEQ_I by (auto simp add: card_of_Times_infinite)
24.1140 +  ultimately show ?thesis using ordLeq_ordIso_trans by blast
24.1141 +qed
24.1142 +
24.1143 +
24.1144 +lemma card_of_Sigma_ordLeq_infinite_Field:
24.1145 +assumes INF: "infinite (Field r)" and r: "Card_order r" and
24.1146 +        LEQ_I: "|I| \<le>o r" and LEQ: "\<forall>i \<in> I. |A i| \<le>o r"
24.1147 +shows "|SIGMA i : I. A i| \<le>o r"
24.1148 +proof-
24.1149 +  let ?B  = "Field r"
24.1150 +  have 1: "r =o |?B| \<and> |?B| =o r" using r card_of_Field_ordIso
24.1151 +  ordIso_symmetric by blast
24.1152 +  hence "|I| \<le>o |?B|"  "\<forall>i \<in> I. |A i| \<le>o |?B|"
24.1153 +  using LEQ_I LEQ ordLeq_ordIso_trans by blast+
24.1154 +  hence  "|SIGMA i : I. A i| \<le>o |?B|" using INF LEQ
24.1155 +  card_of_Sigma_ordLeq_infinite by blast
24.1156 +  thus ?thesis using 1 ordLeq_ordIso_trans by blast
24.1157 +qed
24.1158 +
24.1159 +
24.1160 +lemma card_of_Times_ordLeq_infinite_Field:
24.1161 +"\<lbrakk>infinite (Field r); |A| \<le>o r; |B| \<le>o r; Card_order r\<rbrakk>
24.1162 + \<Longrightarrow> |A <*> B| \<le>o r"
24.1163 +by(simp add: card_of_Sigma_ordLeq_infinite_Field)
24.1164 +
24.1165 +
24.1166 +lemma card_of_Times_infinite_simps:
24.1167 +"\<lbrakk>infinite A; B \<noteq> {}; |B| \<le>o |A|\<rbrakk> \<Longrightarrow> |A \<times> B| =o |A|"
24.1168 +"\<lbrakk>infinite A; B \<noteq> {}; |B| \<le>o |A|\<rbrakk> \<Longrightarrow> |A| =o |A \<times> B|"
24.1169 +"\<lbrakk>infinite A; B \<noteq> {}; |B| \<le>o |A|\<rbrakk> \<Longrightarrow> |B \<times> A| =o |A|"
24.1170 +"\<lbrakk>infinite A; B \<noteq> {}; |B| \<le>o |A|\<rbrakk> \<Longrightarrow> |A| =o |B \<times> A|"
24.1171 +by (auto simp add: card_of_Times_infinite ordIso_symmetric)
24.1172 +
24.1173 +
24.1174 +lemma card_of_UNION_ordLeq_infinite:
24.1175 +assumes INF: "infinite B" and
24.1176 +        LEQ_I: "|I| \<le>o |B|" and LEQ: "\<forall>i \<in> I. |A i| \<le>o |B|"
24.1177 +shows "|\<Union> i \<in> I. A i| \<le>o |B|"
24.1178 +proof(cases "I = {}", simp add: card_of_empty)
24.1179 +  assume *: "I \<noteq> {}"
24.1180 +  have "|\<Union> i \<in> I. A i| \<le>o |SIGMA i : I. A i|"
24.1181 +  using card_of_UNION_Sigma by blast
24.1182 +  moreover have "|SIGMA i : I. A i| \<le>o |B|"
24.1183 +  using assms card_of_Sigma_ordLeq_infinite by blast
24.1184 +  ultimately show ?thesis using ordLeq_transitive by blast
24.1185 +qed
24.1186 +
24.1187 +
24.1188 +corollary card_of_UNION_ordLeq_infinite_Field:
24.1189 +assumes INF: "infinite (Field r)" and r: "Card_order r" and
24.1190 +        LEQ_I: "|I| \<le>o r" and LEQ: "\<forall>i \<in> I. |A i| \<le>o r"
24.1191 +shows "|\<Union> i \<in> I. A i| \<le>o r"
24.1192 +proof-
24.1193 +  let ?B  = "Field r"
24.1194 +  have 1: "r =o |?B| \<and> |?B| =o r" using r card_of_Field_ordIso
24.1195 +  ordIso_symmetric by blast
24.1196 +  hence "|I| \<le>o |?B|"  "\<forall>i \<in> I. |A i| \<le>o |?B|"
24.1197 +  using LEQ_I LEQ ordLeq_ordIso_trans by blast+
24.1198 +  hence  "|\<Union> i \<in> I. A i| \<le>o |?B|" using INF LEQ
24.1199 +  card_of_UNION_ordLeq_infinite by blast
24.1200 +  thus ?thesis using 1 ordLeq_ordIso_trans by blast
24.1201 +qed
24.1202 +
24.1203 +
24.1204 +lemma card_of_Plus_infinite1:
24.1205 +assumes INF: "infinite A" and LEQ: "|B| \<le>o |A|"
24.1206 +shows "|A <+> B| =o |A|"
24.1207 +proof(cases "B = {}", simp add: card_of_Plus_empty1 card_of_Plus_empty2 ordIso_symmetric)
24.1208 +  let ?Inl = "Inl::'a \<Rightarrow> 'a + 'b"  let ?Inr = "Inr::'b \<Rightarrow> 'a + 'b"
24.1209 +  assume *: "B \<noteq> {}"
24.1210 +  then obtain b1 where 1: "b1 \<in> B" by blast
24.1211 +  show ?thesis
24.1212 +  proof(cases "B = {b1}")
24.1213 +    assume Case1: "B = {b1}"
24.1214 +    have 2: "bij_betw ?Inl A ((?Inl  A))"
24.1215 +    unfolding bij_betw_def inj_on_def by auto
24.1216 +    hence 3: "infinite (?Inl  A)"
24.1217 +    using INF bij_betw_finite[of ?Inl A] by blast
24.1218 +    let ?A' = "?Inl  A \<union> {?Inr b1}"
24.1219 +    obtain g where "bij_betw g (?Inl  A) ?A'"
24.1220 +    using 3 infinite_imp_bij_betw2[of "?Inl  A"] by auto
24.1221 +    moreover have "?A' = A <+> B" using Case1 by blast
24.1222 +    ultimately have "bij_betw g (?Inl  A) (A <+> B)" by simp
24.1223 +    hence "bij_betw (g o ?Inl) A (A <+> B)"
24.1224 +    using 2 by (auto simp add: bij_betw_trans)
24.1225 +    thus ?thesis using card_of_ordIso ordIso_symmetric by blast
24.1226 +  next
24.1227 +    assume Case2: "B \<noteq> {b1}"
24.1228 +    with * 1 obtain b2 where 3: "b1 \<noteq> b2 \<and> {b1,b2} \<le> B" by fastforce
24.1229 +    obtain f where "inj_on f B \<and> f  B \<le> A"
24.1230 +    using LEQ card_of_ordLeq[of B] by fastforce
24.1231 +    with 3 have "f b1 \<noteq> f b2 \<and> {f b1, f b2} \<le> A"
24.1232 +    unfolding inj_on_def by auto
24.1233 +    with 3 have "|A <+> B| \<le>o |A \<times> B|"
24.1234 +    by (auto simp add: card_of_Plus_Times)
24.1235 +    moreover have "|A \<times> B| =o |A|"
24.1236 +    using assms * by (simp add: card_of_Times_infinite_simps)
24.1237 +    ultimately have "|A <+> B| \<le>o |A|" using ordLeq_ordIso_trans by metis
24.1238 +    thus ?thesis using card_of_Plus1 ordIso_iff_ordLeq by blast
24.1239 +  qed
24.1240 +qed
24.1241 +
24.1242 +
24.1243 +lemma card_of_Plus_infinite2:
24.1244 +assumes INF: "infinite A" and LEQ: "|B| \<le>o |A|"
24.1245 +shows "|B <+> A| =o |A|"
24.1246 +using assms card_of_Plus_commute card_of_Plus_infinite1
24.1247 +ordIso_equivalence by blast
24.1248 +
24.1249 +
24.1250 +lemma card_of_Plus_infinite:
24.1251 +assumes INF: "infinite A" and LEQ: "|B| \<le>o |A|"
24.1252 +shows "|A <+> B| =o |A| \<and> |B <+> A| =o |A|"
24.1253 +using assms by (auto simp: card_of_Plus_infinite1 card_of_Plus_infinite2)
24.1254 +
24.1255 +
24.1256 +corollary Card_order_Plus_infinite:
24.1257 +assumes INF: "infinite(Field r)" and CARD: "Card_order r" and
24.1258 +        LEQ: "p \<le>o r"
24.1259 +shows "| (Field r) <+> (Field p) | =o r \<and> | (Field p) <+> (Field r) | =o r"
24.1260 +proof-
24.1261 +  have "| Field r <+> Field p | =o | Field r | \<and>
24.1262 +        | Field p <+> Field r | =o | Field r |"
24.1263 +  using assms by (simp add: card_of_Plus_infinite card_of_mono2)
24.1264 +  thus ?thesis
24.1265 +  using assms card_of_Field_ordIso[of r]
24.1266 +        ordIso_transitive[of "|Field r <+> Field p|"]
24.1267 +        ordIso_transitive[of _ "|Field r|"] by blast
24.1268 +qed
24.1269 +
24.1270 +
24.1271 +subsection {* The cardinal $\omega$ and the finite cardinals  *}
24.1272 +
24.1273 +
24.1274 +text{* The cardinal $\omega$, of natural numbers, shall be the standard non-strict
24.1275 +order relation on
24.1276 +@{text "nat"}, that we abbreviate by @{text "natLeq"}.  The finite cardinals
24.1277 +shall be the restrictions of these relations to the numbers smaller than
24.1278 +fixed numbers @{text "n"}, that we abbreviate by @{text "natLeq_on n"}.  *}
24.1279 +
24.1280 +abbreviation "(natLeq::(nat * nat) set) \<equiv> {(x,y). x \<le> y}"
24.1281 +abbreviation "(natLess::(nat * nat) set) \<equiv> {(x,y). x < y}"
24.1282 +
24.1283 +abbreviation natLeq_on :: "nat \<Rightarrow> (nat * nat) set"
24.1284 +where "natLeq_on n \<equiv> {(x,y). x < n \<and> y < n \<and> x \<le> y}"
24.1285 +
24.1286 +lemma infinite_cartesian_product:
24.1287 +assumes "infinite A" "infinite B"
24.1288 +shows "infinite (A \<times> B)"
24.1289 +proof
24.1290 +  assume "finite (A \<times> B)"
24.1291 +  from assms(1) have "A \<noteq> {}" by auto
24.1292 +  with finite (A \<times> B) have "finite B" using finite_cartesian_productD2 by auto
24.1293 +  with assms(2) show False by simp
24.1294 +qed
24.1295 +
24.1296 +
24.1297 +subsubsection {* First as well-orders *}
24.1298 +
24.1299 +
24.1300 +lemma Field_natLeq: "Field natLeq = (UNIV::nat set)"
24.1301 +by(unfold Field_def, auto)
24.1302 +
24.1303 +
24.1304 +lemma natLeq_Refl: "Refl natLeq"
24.1305 +unfolding refl_on_def Field_def by auto
24.1306 +
24.1307 +
24.1308 +lemma natLeq_trans: "trans natLeq"
24.1309 +unfolding trans_def by auto
24.1310 +
24.1311 +
24.1312 +lemma natLeq_Preorder: "Preorder natLeq"
24.1313 +unfolding preorder_on_def
24.1314 +by (auto simp add: natLeq_Refl natLeq_trans)
24.1315 +
24.1316 +
24.1317 +lemma natLeq_antisym: "antisym natLeq"
24.1318 +unfolding antisym_def by auto
24.1319 +
24.1320 +
24.1321 +lemma natLeq_Partial_order: "Partial_order natLeq"
24.1322 +unfolding partial_order_on_def
24.1323 +by (auto simp add: natLeq_Preorder natLeq_antisym)
24.1324 +
24.1325 +
24.1326 +lemma natLeq_Total: "Total natLeq"
24.1327 +unfolding total_on_def by auto
24.1328 +
24.1329 +
24.1330 +lemma natLeq_Linear_order: "Linear_order natLeq"
24.1331 +unfolding linear_order_on_def
24.1332 +by (auto simp add: natLeq_Partial_order natLeq_Total)
24.1333 +
24.1334 +
24.1335 +lemma natLeq_natLess_Id: "natLess = natLeq - Id"
24.1336 +by auto
24.1337 +
24.1338 +
24.1339 +lemma natLeq_Well_order: "Well_order natLeq"
24.1340 +unfolding well_order_on_def
24.1341 +using natLeq_Linear_order wf_less natLeq_natLess_Id by auto
24.1342 +
24.1343 +
24.1344 +lemma closed_nat_set_iff:
24.1345 +assumes "\<forall>(m::nat) n. n \<in> A \<and> m \<le> n \<longrightarrow> m \<in> A"
24.1346 +shows "A = UNIV \<or> (\<exists>n. A = {0 ..< n})"
24.1347 +proof-
24.1348 +  {assume "A \<noteq> UNIV" hence "\<exists>n. n \<notin> A" by blast
24.1349 +   moreover obtain n where n_def: "n = (LEAST n. n \<notin> A)" by blast
24.1350 +   ultimately have 1: "n \<notin> A \<and> (\<forall>m. m < n \<longrightarrow> m \<in> A)"
24.1351 +   using LeastI_ex[of "\<lambda> n. n \<notin> A"] n_def Least_le[of "\<lambda> n. n \<notin> A"] by fastforce
24.1352 +   have "A = {0 ..< n}"
24.1353 +   proof(auto simp add: 1)
24.1354 +     fix m assume *: "m \<in> A"
24.1355 +     {assume "n \<le> m" with assms * have "n \<in> A" by blast
24.1356 +      hence False using 1 by auto
24.1357 +     }
24.1358 +     thus "m < n" by fastforce
24.1359 +   qed
24.1360 +   hence "\<exists>n. A = {0 ..< n}" by blast
24.1361 +  }
24.1362 +  thus ?thesis by blast
24.1363 +qed
24.1364 +
24.1365 +
24.1366 +lemma Field_natLeq_on: "Field (natLeq_on n) = {0 ..< n}"
24.1367 +unfolding Field_def by auto
24.1368 +
24.1369 +
24.1370 +lemma natLeq_underS_less: "rel.underS natLeq n = {0 ..< n}"
24.1371 +unfolding rel.underS_def by auto
24.1372 +
24.1373 +
24.1374 +lemma Restr_natLeq: "Restr natLeq {0 ..< n} = natLeq_on n"
24.1375 +by force
24.1376 +
24.1377 +
24.1378 +lemma Restr_natLeq2:
24.1379 +"Restr natLeq (rel.underS natLeq n) = natLeq_on n"
24.1380 +by (auto simp add: Restr_natLeq natLeq_underS_less)
24.1381 +
24.1382 +
24.1383 +lemma natLeq_on_Well_order: "Well_order(natLeq_on n)"
24.1384 +using Restr_natLeq[of n] natLeq_Well_order
24.1385 +      Well_order_Restr[of natLeq "{0..<n}"] by auto
24.1386 +
24.1387 +
24.1388 +corollary natLeq_on_well_order_on: "well_order_on {0 ..< n} (natLeq_on n)"
24.1389 +using natLeq_on_Well_order Field_natLeq_on by auto
24.1390 +
24.1391 +
24.1392 +lemma natLeq_on_wo_rel: "wo_rel(natLeq_on n)"
24.1393 +unfolding wo_rel_def using natLeq_on_Well_order .
24.1394 +
24.1395 +
24.1396 +lemma natLeq_on_ofilter_less_eq:
24.1397 +"n \<le> m \<Longrightarrow> wo_rel.ofilter (natLeq_on m) {0 ..< n}"
24.1398 +apply (auto simp add: natLeq_on_wo_rel wo_rel.ofilter_def)
24.1399 +apply (simp add: Field_natLeq_on)
24.1400 +by (auto simp add: rel.under_def)
24.1401 +
24.1402 +lemma natLeq_on_ofilter_iff:
24.1403 +"wo_rel.ofilter (natLeq_on m) A = (\<exists>n \<le> m. A = {0 ..< n})"
24.1404 +proof(rule iffI)
24.1405 +  assume *: "wo_rel.ofilter (natLeq_on m) A"
24.1406 +  hence 1: "A \<le> {0..<m}"
24.1407 +  by (auto simp add: natLeq_on_wo_rel wo_rel.ofilter_def rel.under_def Field_natLeq_on)
24.1408 +  hence "\<forall>n1 n2. n2 \<in> A \<and> n1 \<le> n2 \<longrightarrow> n1 \<in> A"
24.1409 +  using * by(fastforce simp add: natLeq_on_wo_rel wo_rel.ofilter_def rel.under_def)
24.1410 +  hence "A = UNIV \<or> (\<exists>n. A = {0 ..< n})" using closed_nat_set_iff by blast
24.1411 +  thus "\<exists>n \<le> m. A = {0 ..< n}" using 1 atLeastLessThan_less_eq by blast
24.1412 +next
24.1413 +  assume "(\<exists>n\<le>m. A = {0 ..< n})"
24.1414 +  thus "wo_rel.ofilter (natLeq_on m) A" by (auto simp add: natLeq_on_ofilter_less_eq)
24.1415 +qed
24.1416 +
24.1417 +
24.1418 +
24.1419 +subsubsection {* Then as cardinals *}
24.1420 +
24.1421 +
24.1422 +lemma natLeq_Card_order: "Card_order natLeq"
24.1423 +proof(auto simp add: natLeq_Well_order
24.1424 +      Card_order_iff_Restr_underS Restr_natLeq2, simp add:  Field_natLeq)
24.1425 +  fix n have "finite(Field (natLeq_on n))"
24.1426 +  unfolding Field_natLeq_on by auto
24.1427 +  moreover have "infinite(UNIV::nat set)" by auto
24.1428 +  ultimately show "natLeq_on n <o |UNIV::nat set|"
24.1429 +  using finite_ordLess_infinite[of "natLeq_on n" "|UNIV::nat set|"]
24.1430 +        Field_card_of[of "UNIV::nat set"]
24.1431 +        card_of_Well_order[of "UNIV::nat set"] natLeq_on_Well_order[of n] by auto
24.1432 +qed
24.1433 +
24.1434 +
24.1435 +corollary card_of_Field_natLeq:
24.1436 +"|Field natLeq| =o natLeq"
24.1437 +using Field_natLeq natLeq_Card_order Card_order_iff_ordIso_card_of[of natLeq]
24.1438 +      ordIso_symmetric[of natLeq] by blast
24.1439 +
24.1440 +
24.1441 +corollary card_of_nat:
24.1442 +"|UNIV::nat set| =o natLeq"
24.1443 +using Field_natLeq card_of_Field_natLeq by auto
24.1444 +
24.1445 +
24.1446 +corollary infinite_iff_natLeq_ordLeq:
24.1447 +"infinite A = ( natLeq \<le>o |A| )"
24.1448 +using infinite_iff_card_of_nat[of A] card_of_nat
24.1449 +      ordIso_ordLeq_trans ordLeq_ordIso_trans ordIso_symmetric by blast
24.1450 +
24.1451 +
24.1452 +corollary finite_iff_ordLess_natLeq:
24.1453 +"finite A = ( |A| <o natLeq)"
24.1454 +using infinite_iff_natLeq_ordLeq not_ordLeq_iff_ordLess
24.1455 +      card_of_Well_order natLeq_Well_order
24.1456 +by auto
24.1457 +
24.1458 +lemma ordIso_natLeq_on_imp_finite:
24.1459 +"|A| =o natLeq_on n \<Longrightarrow> finite A"
24.1460 +unfolding ordIso_def iso_def[abs_def]
24.1461 +by (auto simp: Field_natLeq_on bij_betw_finite Field_card_of)
24.1462 +
24.1463 +
24.1464 +lemma natLeq_on_Card_order: "Card_order (natLeq_on n)"
24.1465 +proof(unfold card_order_on_def,
24.1466 +      auto simp add: natLeq_on_Well_order, simp add: Field_natLeq_on)
24.1467 +  fix r assume "well_order_on {0..<n} r"
24.1468 +  thus "natLeq_on n \<le>o r"
24.1469 +  using finite_atLeastLessThan natLeq_on_well_order_on
24.1470 +        finite_well_order_on_ordIso ordIso_iff_ordLeq by blast
24.1471 +qed
24.1472 +
24.1473 +
24.1474 +corollary card_of_Field_natLeq_on:
24.1475 +"|Field (natLeq_on n)| =o natLeq_on n"
24.1476 +using Field_natLeq_on natLeq_on_Card_order
24.1477 +      Card_order_iff_ordIso_card_of[of "natLeq_on n"]
24.1478 +      ordIso_symmetric[of "natLeq_on n"] by blast
24.1479 +
24.1480 +
24.1481 +corollary card_of_less:
24.1482 +"|{0 ..< n}| =o natLeq_on n"
24.1483 +using Field_natLeq_on card_of_Field_natLeq_on by auto
24.1484 +
24.1485 +
24.1486 +lemma natLeq_on_ordLeq_less_eq:
24.1487 +"((natLeq_on m) \<le>o (natLeq_on n)) = (m \<le> n)"
24.1488 +proof
24.1489 +  assume "natLeq_on m \<le>o natLeq_on n"
24.1490 +  then obtain f where "inj_on f {0..<m} \<and> f  {0..<m} \<le> {0..<n}"
24.1491 +  unfolding ordLeq_def using
24.1492 +    embed_inj_on[OF natLeq_on_Well_order[of m], of "natLeq_on n", unfolded Field_natLeq_on]
24.1493 +     embed_Field[OF natLeq_on_Well_order[of m], of "natLeq_on n", unfolded Field_natLeq_on] by blast
24.1494 +  thus "m \<le> n" using atLeastLessThan_less_eq2 by blast
24.1495 +next
24.1496 +  assume "m \<le> n"
24.1497 +  hence "inj_on id {0..<m} \<and> id  {0..<m} \<le> {0..<n}" unfolding inj_on_def by auto
24.1498 +  hence "|{0..<m}| \<le>o |{0..<n}|" using card_of_ordLeq by blast
24.1499 +  thus "natLeq_on m \<le>o natLeq_on n"
24.1500 +  using card_of_less ordIso_ordLeq_trans ordLeq_ordIso_trans ordIso_symmetric by blast
24.1501 +qed
24.1502 +
24.1503 +
24.1504 +lemma natLeq_on_ordLeq_less:
24.1505 +"((natLeq_on m) <o (natLeq_on n)) = (m < n)"
24.1506 +using not_ordLeq_iff_ordLess[of "natLeq_on m" "natLeq_on n"]
24.1507 +  natLeq_on_Well_order natLeq_on_ordLeq_less_eq
24.1508 +by fastforce
24.1509 +
24.1510 +
24.1511 +
24.1512 +subsubsection {* "Backward compatibility" with the numeric cardinal operator for finite sets *}
24.1513 +
24.1514 +
24.1515 +lemma finite_card_of_iff_card2:
24.1516 +assumes FIN: "finite A" and FIN': "finite B"
24.1517 +shows "( |A| \<le>o |B| ) = (card A \<le> card B)"
24.1518 +using assms card_of_ordLeq[of A B] inj_on_iff_card_le[of A B] by blast
24.1519 +
24.1520 +
24.1521 +lemma finite_imp_card_of_natLeq_on:
24.1522 +assumes "finite A"
24.1523 +shows "|A| =o natLeq_on (card A)"
24.1524 +proof-
24.1525 +  obtain h where "bij_betw h A {0 ..< card A}"
24.1526 +  using assms ex_bij_betw_finite_nat by blast
24.1527 +  thus ?thesis using card_of_ordIso card_of_less ordIso_equivalence by blast
24.1528 +qed
24.1529 +
24.1530 +
24.1531 +lemma finite_iff_card_of_natLeq_on:
24.1532 +"finite A = (\<exists>n. |A| =o natLeq_on n)"
24.1533 +using finite_imp_card_of_natLeq_on[of A]
24.1534 +by(auto simp add: ordIso_natLeq_on_imp_finite)
24.1535 +
24.1536 +
24.1537 +
24.1538 +subsection {* The successor of a cardinal *}
24.1539 +
24.1540 +
24.1541 +text{* First we define @{text "isCardSuc r r'"}, the notion of @{text "r'"}
24.1542 +being a successor cardinal of @{text "r"}. Although the definition does
24.1543 +not require @{text "r"} to be a cardinal, only this case will be meaningful.  *}
24.1544 +
24.1545 +
24.1546 +definition isCardSuc :: "'a rel \<Rightarrow> 'a set rel \<Rightarrow> bool"
24.1547 +where
24.1548 +"isCardSuc r r' \<equiv>
24.1549 + Card_order r' \<and> r <o r' \<and>
24.1550 + (\<forall>(r''::'a set rel). Card_order r'' \<and> r <o r'' \<longrightarrow> r' \<le>o r'')"
24.1551 +
24.1552 +
24.1553 +text{* Now we introduce the cardinal-successor operator @{text "cardSuc"},
24.1554 +by picking {\em some} cardinal-order relation fulfilling @{text "isCardSuc"}.
24.1555 +Again, the picked item shall be proved unique up to order-isomorphism. *}
24.1556 +
24.1557 +
24.1558 +definition cardSuc :: "'a rel \<Rightarrow> 'a set rel"
24.1559 +where
24.1560 +"cardSuc r \<equiv> SOME r'. isCardSuc r r'"
24.1561 +
24.1562 +
24.1563 +lemma exists_minim_Card_order:
24.1564 +"\<lbrakk>R \<noteq> {}; \<forall>r \<in> R. Card_order r\<rbrakk> \<Longrightarrow> \<exists>r \<in> R. \<forall>r' \<in> R. r \<le>o r'"
24.1565 +unfolding card_order_on_def using exists_minim_Well_order by blast
24.1566 +
24.1567 +
24.1568 +lemma exists_isCardSuc:
24.1569 +assumes "Card_order r"
24.1570 +shows "\<exists>r'. isCardSuc r r'"
24.1571 +proof-
24.1572 +  let ?R = "{(r'::'a set rel). Card_order r' \<and> r <o r'}"
24.1573 +  have "|Pow(Field r)| \<in> ?R \<and> (\<forall>r \<in> ?R. Card_order r)" using assms
24.1574 +  by (simp add: card_of_Card_order Card_order_Pow)
24.1575 +  then obtain r where "r \<in> ?R \<and> (\<forall>r' \<in> ?R. r \<le>o r')"
24.1576 +  using exists_minim_Card_order[of ?R] by blast
24.1577 +  thus ?thesis unfolding isCardSuc_def by auto
24.1578 +qed
24.1579 +
24.1580 +
24.1581 +lemma cardSuc_isCardSuc:
24.1582 +assumes "Card_order r"
24.1583 +shows "isCardSuc r (cardSuc r)"
24.1584 +unfolding cardSuc_def using assms
24.1585 +by (simp add: exists_isCardSuc someI_ex)
24.1586 +
24.1587 +
24.1588 +lemma cardSuc_Card_order:
24.1589 +"Card_order r \<Longrightarrow> Card_order(cardSuc r)"
24.1590 +using cardSuc_isCardSuc unfolding isCardSuc_def by blast
24.1591 +
24.1592 +
24.1593 +lemma cardSuc_greater:
24.1594 +"Card_order r \<Longrightarrow> r <o cardSuc r"
24.1595 +using cardSuc_isCardSuc unfolding isCardSuc_def by blast
24.1596 +
24.1597 +
24.1598 +lemma cardSuc_ordLeq:
24.1599 +"Card_order r \<Longrightarrow> r \<le>o cardSuc r"
24.1600 +using cardSuc_greater ordLeq_iff_ordLess_or_ordIso by blast
24.1601 +
24.1602 +
24.1603 +text{* The minimality property of @{text "cardSuc"} originally present in its definition
24.1604 +is local to the type @{text "'a set rel"}, i.e., that of @{text "cardSuc r"}:  *}
24.1605 +
24.1606 +lemma cardSuc_least_aux:
24.1607 +"\<lbrakk>Card_order (r::'a rel); Card_order (r'::'a set rel); r <o r'\<rbrakk> \<Longrightarrow> cardSuc r \<le>o r'"
24.1608 +using cardSuc_isCardSuc unfolding isCardSuc_def by blast
24.1609 +
24.1610 +
24.1611 +text{* But from this we can infer general minimality: *}
24.1612 +
24.1613 +lemma cardSuc_least:
24.1614 +assumes CARD: "Card_order r" and CARD': "Card_order r'" and LESS: "r <o r'"
24.1615 +shows "cardSuc r \<le>o r'"
24.1616 +proof-
24.1617 +  let ?p = "cardSuc r"
24.1618 +  have 0: "Well_order ?p \<and> Well_order r'"
24.1619 +  using assms cardSuc_Card_order unfolding card_order_on_def by blast
24.1620 +  {assume "r' <o ?p"
24.1621 +   then obtain r'' where 1: "Field r'' < Field ?p" and 2: "r' =o r'' \<and> r'' <o ?p"
24.1622 +   using internalize_ordLess[of r' ?p] by blast
24.1623 +   (*  *)
24.1624 +   have "Card_order r''" using CARD' Card_order_ordIso2 2 by blast
24.1625 +   moreover have "r <o r''" using LESS 2 ordLess_ordIso_trans by blast
24.1626 +   ultimately have "?p \<le>o r''" using cardSuc_least_aux CARD by blast
24.1627 +   hence False using 2 not_ordLess_ordLeq by blast
24.1628 +  }
24.1629 +  thus ?thesis using 0 ordLess_or_ordLeq by blast
24.1630 +qed
24.1631 +
24.1632 +
24.1633 +lemma cardSuc_ordLess_ordLeq:
24.1634 +assumes CARD: "Card_order r" and CARD': "Card_order r'"
24.1635 +shows "(r <o r') = (cardSuc r \<le>o r')"
24.1636 +proof(auto simp add: assms cardSuc_least)
24.1637 +  assume "cardSuc r \<le>o r'"
24.1638 +  thus "r <o r'" using assms cardSuc_greater ordLess_ordLeq_trans by blast
24.1639 +qed
24.1640 +
24.1641 +
24.1642 +lemma cardSuc_ordLeq_ordLess:
24.1643 +assumes CARD: "Card_order r" and CARD': "Card_order r'"
24.1644 +shows "(r' <o cardSuc r) = (r' \<le>o r)"
24.1645 +proof-
24.1646 +  have "Well_order r \<and> Well_order r'"
24.1647 +  using assms unfolding card_order_on_def by auto
24.1648 +  moreover have "Well_order(cardSuc r)"
24.1649 +  using assms cardSuc_Card_order card_order_on_def by blast
24.1650 +  ultimately show ?thesis
24.1651 +  using assms cardSuc_ordLess_ordLeq[of r r']
24.1652 +  not_ordLeq_iff_ordLess[of r r'] not_ordLeq_iff_ordLess[of r' "cardSuc r"] by blast
24.1653 +qed
24.1654 +
24.1655 +
24.1656 +lemma cardSuc_mono_ordLeq:
24.1657 +assumes CARD: "Card_order r" and CARD': "Card_order r'"
24.1658 +shows "(cardSuc r \<le>o cardSuc r') = (r \<le>o r')"
24.1659 +using assms cardSuc_ordLeq_ordLess cardSuc_ordLess_ordLeq cardSuc_Card_order by blast
24.1660 +
24.1661 +
24.1662 +lemma cardSuc_invar_ordIso:
24.1663 +assumes CARD: "Card_order r" and CARD': "Card_order r'"
24.1664 +shows "(cardSuc r =o cardSuc r') = (r =o r')"
24.1665 +proof-
24.1666 +  have 0: "Well_order r \<and> Well_order r' \<and> Well_order(cardSuc r) \<and> Well_order(cardSuc r')"
24.1667 +  using assms by (simp add: card_order_on_well_order_on cardSuc_Card_order)
24.1668 +  thus ?thesis
24.1669 +  using ordIso_iff_ordLeq[of r r'] ordIso_iff_ordLeq
24.1670 +  using cardSuc_mono_ordLeq[of r r'] cardSuc_mono_ordLeq[of r' r] assms by blast
24.1671 +qed
24.1672 +
24.1673 +
24.1674 +lemma cardSuc_natLeq_on_Suc:
24.1675 +"cardSuc(natLeq_on n) =o natLeq_on(Suc n)"
24.1676 +proof-
24.1677 +  obtain r r' p where r_def: "r = natLeq_on n" and
24.1678 +                      r'_def: "r' = cardSuc(natLeq_on n)"  and
24.1679 +                      p_def: "p = natLeq_on(Suc n)" by blast
24.1680 +  (* Preliminary facts:  *)
24.1681 +  have CARD: "Card_order r \<and> Card_order r' \<and> Card_order p" unfolding r_def r'_def p_def
24.1682 +  using cardSuc_ordLess_ordLeq natLeq_on_Card_order cardSuc_Card_order by blast
24.1683 +  hence WELL: "Well_order r \<and> Well_order r' \<and>  Well_order p"
24.1684 +  unfolding card_order_on_def by force
24.1685 +  have FIELD: "Field r = {0..<n} \<and> Field p = {0..<(Suc n)}"
24.1686 +  unfolding r_def p_def Field_natLeq_on by simp
24.1687 +  hence FIN: "finite (Field r)" by force
24.1688 +  have "r <o r'" using CARD unfolding r_def r'_def using cardSuc_greater by blast
24.1689 +  hence "|Field r| <o r'" using CARD card_of_Field_ordIso ordIso_ordLess_trans by blast
24.1690 +  hence LESS: "|Field r| <o |Field r'|"
24.1691 +  using CARD card_of_Field_ordIso ordLess_ordIso_trans ordIso_symmetric by blast
24.1692 +  (* Main proof: *)
24.1693 +  have "r' \<le>o p" using CARD unfolding r_def r'_def p_def
24.1694 +  using natLeq_on_ordLeq_less cardSuc_ordLess_ordLeq by blast
24.1695 +  moreover have "p \<le>o r'"
24.1696 +  proof-
24.1697 +    {assume "r' <o p"
24.1698 +     then obtain f where 0: "embedS r' p f" unfolding ordLess_def by force
24.1699 +     let ?q = "Restr p (f  Field r')"
24.1700 +     have 1: "embed r' p f" using 0 unfolding embedS_def by force
24.1701 +     hence 2: "f  Field r' < {0..<(Suc n)}"
24.1702 +     using WELL FIELD 0 by (auto simp add: embedS_iff)
24.1703 +     have "wo_rel.ofilter p (f  Field r')" using embed_Field_ofilter 1 WELL by blast
24.1704 +     then obtain m where "m \<le> Suc n" and 3: "f  (Field r') = {0..<m}"
24.1705 +     unfolding p_def by (auto simp add: natLeq_on_ofilter_iff)
24.1706 +     hence 4: "m \<le> n" using 2 by force
24.1707 +     (*  *)
24.1708 +     have "bij_betw f (Field r') (f  (Field r'))"
24.1709 +     using 1 WELL embed_inj_on unfolding bij_betw_def by force
24.1710 +     moreover have "finite(f  (Field r'))" using 3 finite_atLeastLessThan[of 0 m] by force
24.1711 +     ultimately have 5: "finite (Field r') \<and> card(Field r') = card (f  (Field r'))"
24.1712 +     using bij_betw_same_card bij_betw_finite by metis
24.1713 +     hence "card(Field r') \<le> card(Field r)" using 3 4 FIELD by force
24.1714 +     hence "|Field r'| \<le>o |Field r|" using FIN 5 finite_card_of_iff_card2 by blast
24.1715 +     hence False using LESS not_ordLess_ordLeq by auto
24.1716 +    }
24.1717 +    thus ?thesis using WELL CARD by (fastforce simp: not_ordLess_iff_ordLeq)
24.1718 +  qed
24.1719 +  ultimately show ?thesis using ordIso_iff_ordLeq unfolding r'_def p_def by blast
24.1720 +qed
24.1721 +
24.1722 +
24.1723 +lemma card_of_cardSuc_finite:
24.1724 +"finite(Field(cardSuc |A| )) = finite A"
24.1725 +proof
24.1726 +  assume *: "finite (Field (cardSuc |A| ))"
24.1727 +  have 0: "|Field(cardSuc |A| )| =o cardSuc |A|"
24.1728 +  using card_of_Card_order cardSuc_Card_order card_of_Field_ordIso by blast
24.1729 +  hence "|A| \<le>o |Field(cardSuc |A| )|"
24.1730 +  using card_of_Card_order[of A] cardSuc_ordLeq[of "|A|"] ordIso_symmetric
24.1731 +  ordLeq_ordIso_trans by blast
24.1732 +  thus "finite A" using * card_of_ordLeq_finite by blast
24.1733 +next
24.1734 +  assume "finite A"
24.1735 +  then obtain n where "|A| =o natLeq_on n" using finite_iff_card_of_natLeq_on by blast
24.1736 +  hence "cardSuc |A| =o cardSuc(natLeq_on n)"
24.1737 +  using card_of_Card_order cardSuc_invar_ordIso natLeq_on_Card_order by blast
24.1738 +  hence "cardSuc |A| =o natLeq_on(Suc n)"
24.1739 +  using cardSuc_natLeq_on_Suc ordIso_transitive by blast
24.1740 +  hence "cardSuc |A| =o |{0..<(Suc n)}|" using card_of_less ordIso_equivalence by blast
24.1741 +  moreover have "|Field (cardSuc |A| ) | =o cardSuc |A|"
24.1742 +  using card_of_Field_ordIso cardSuc_Card_order card_of_Card_order by blast
24.1743 +  ultimately have "|Field (cardSuc |A| ) | =o |{0..<(Suc n)}|"
24.1744 +  using ordIso_equivalence by blast
24.1745 +  thus "finite (Field (cardSuc |A| ))"
24.1746 +  using card_of_ordIso_finite finite_atLeastLessThan by blast
24.1747 +qed
24.1748 +
24.1749 +
24.1750 +lemma cardSuc_finite:
24.1751 +assumes "Card_order r"
24.1752 +shows "finite (Field (cardSuc r)) = finite (Field r)"
24.1753 +proof-
24.1754 +  let ?A = "Field r"
24.1755 +  have "|?A| =o r" using assms by (simp add: card_of_Field_ordIso)
24.1756 +  hence "cardSuc |?A| =o cardSuc r" using assms
24.1757 +  by (simp add: card_of_Card_order cardSuc_invar_ordIso)
24.1758 +  moreover have "|Field (cardSuc |?A| ) | =o cardSuc |?A|"
24.1759 +  by (simp add: card_of_card_order_on Field_card_of card_of_Field_ordIso cardSuc_Card_order)
24.1760 +  moreover
24.1761 +  {have "|Field (cardSuc r) | =o cardSuc r"
24.1762 +   using assms by (simp add: card_of_Field_ordIso cardSuc_Card_order)
24.1763 +   hence "cardSuc r =o |Field (cardSuc r) |"
24.1764 +   using ordIso_symmetric by blast
24.1765 +  }
24.1766 +  ultimately have "|Field (cardSuc |?A| ) | =o |Field (cardSuc r) |"
24.1767 +  using ordIso_transitive by blast
24.1768 +  hence "finite (Field (cardSuc |?A| )) = finite (Field (cardSuc r))"
24.1769 +  using card_of_ordIso_finite by blast
24.1770 +  thus ?thesis by (simp only: card_of_cardSuc_finite)
24.1771 +qed
24.1772 +
24.1773 +
24.1774 +lemma card_of_Plus_ordLess_infinite:
24.1775 +assumes INF: "infinite C" and
24.1776 +        LESS1: "|A| <o |C|" and LESS2: "|B| <o |C|"
24.1777 +shows "|A <+> B| <o |C|"
24.1778 +proof(cases "A = {} \<or> B = {}")
24.1779 +  assume Case1: "A = {} \<or> B = {}"
24.1780 +  hence "|A| =o |A <+> B| \<or> |B| =o |A <+> B|"
24.1781 +  using card_of_Plus_empty1 card_of_Plus_empty2 by blast
24.1782 +  hence "|A <+> B| =o |A| \<or> |A <+> B| =o |B|"
24.1783 +  using ordIso_symmetric[of "|A|"] ordIso_symmetric[of "|B|"] by blast
24.1784 +  thus ?thesis using LESS1 LESS2
24.1785 +       ordIso_ordLess_trans[of "|A <+> B|" "|A|"]
24.1786 +       ordIso_ordLess_trans[of "|A <+> B|" "|B|"] by blast
24.1787 +next
24.1788 +  assume Case2: "\<not>(A = {} \<or> B = {})"
24.1789 +  {assume *: "|C| \<le>o |A <+> B|"
24.1790 +   hence "infinite (A <+> B)" using INF card_of_ordLeq_finite by blast
24.1791 +   hence 1: "infinite A \<or> infinite B" using finite_Plus by blast
24.1792 +   {assume Case21: "|A| \<le>o |B|"
24.1793 +    hence "infinite B" using 1 card_of_ordLeq_finite by blast
24.1794 +    hence "|A <+> B| =o |B|" using Case2 Case21
24.1795 +    by (auto simp add: card_of_Plus_infinite)
24.1796 +    hence False using LESS2 not_ordLess_ordLeq * ordLeq_ordIso_trans by blast
24.1797 +   }
24.1798 +   moreover
24.1799 +   {assume Case22: "|B| \<le>o |A|"
24.1800 +    hence "infinite A" using 1 card_of_ordLeq_finite by blast
24.1801 +    hence "|A <+> B| =o |A|" using Case2 Case22
24.1802 +    by (auto simp add: card_of_Plus_infinite)
24.1803 +    hence False using LESS1 not_ordLess_ordLeq * ordLeq_ordIso_trans by blast
24.1804 +   }
24.1805 +   ultimately have False using ordLeq_total card_of_Well_order[of A]
24.1806 +   card_of_Well_order[of B] by blast
24.1807 +  }
24.1808 +  thus ?thesis using ordLess_or_ordLeq[of "|A <+> B|" "|C|"]
24.1809 +  card_of_Well_order[of "A <+> B"] card_of_Well_order[of "C"] by auto
24.1810 +qed
24.1811 +
24.1812 +
24.1813 +lemma card_of_Plus_ordLess_infinite_Field:
24.1814 +assumes INF: "infinite (Field r)" and r: "Card_order r" and
24.1815 +        LESS1: "|A| <o r" and LESS2: "|B| <o r"
24.1816 +shows "|A <+> B| <o r"
24.1817 +proof-
24.1818 +  let ?C  = "Field r"
24.1819 +  have 1: "r =o |?C| \<and> |?C| =o r" using r card_of_Field_ordIso
24.1820 +  ordIso_symmetric by blast
24.1821 +  hence "|A| <o |?C|"  "|B| <o |?C|"
24.1822 +  using LESS1 LESS2 ordLess_ordIso_trans by blast+
24.1823 +  hence  "|A <+> B| <o |?C|" using INF
24.1824 +  card_of_Plus_ordLess_infinite by blast
24.1825 +  thus ?thesis using 1 ordLess_ordIso_trans by blast
24.1826 +qed
24.1827 +
24.1828 +
24.1829 +lemma card_of_Plus_ordLeq_infinite_Field:
24.1830 +assumes r: "infinite (Field r)" and A: "|A| \<le>o r" and B: "|B| \<le>o r"
24.1831 +and c: "Card_order r"
24.1832 +shows "|A <+> B| \<le>o r"
24.1833 +proof-
24.1834 +  let ?r' = "cardSuc r"
24.1835 +  have "Card_order ?r' \<and> infinite (Field ?r')" using assms
24.1836 +  by (simp add: cardSuc_Card_order cardSuc_finite)
24.1837 +  moreover have "|A| <o ?r'" and "|B| <o ?r'" using A B c
24.1838 +  by (auto simp: card_of_card_order_on Field_card_of cardSuc_ordLeq_ordLess)
24.1839 +  ultimately have "|A <+> B| <o ?r'"
24.1840 +  using card_of_Plus_ordLess_infinite_Field by blast
24.1841 +  thus ?thesis using c r
24.1842 +  by (simp add: card_of_card_order_on Field_card_of cardSuc_ordLeq_ordLess)
24.1843 +qed
24.1844 +
24.1845 +
24.1846 +lemma card_of_Un_ordLeq_infinite_Field:
24.1847 +assumes C: "infinite (Field r)" and A: "|A| \<le>o r" and B: "|B| \<le>o r"
24.1848 +and "Card_order r"
24.1849 +shows "|A Un B| \<le>o r"
24.1850 +using assms card_of_Plus_ordLeq_infinite_Field card_of_Un_Plus_ordLeq
24.1851 +ordLeq_transitive by fast
24.1852 +
24.1853 +
24.1854 +
24.1855 +subsection {* Regular cardinals *}
24.1856 +
24.1857 +
24.1858 +definition cofinal where
24.1859 +"cofinal A r \<equiv>
24.1860 + ALL a : Field r. EX b : A. a \<noteq> b \<and> (a,b) : r"
24.1861 +
24.1862 +
24.1863 +definition regular where
24.1864 +"regular r \<equiv>
24.1865 + ALL K. K \<le> Field r \<and> cofinal K r \<longrightarrow> |K| =o r"
24.1866 +
24.1867 +
24.1868 +definition relChain where
24.1869 +"relChain r As \<equiv>
24.1870 + ALL i j. (i,j) \<in> r \<longrightarrow> As i \<le> As j"
24.1871 +
24.1872 +lemma regular_UNION:
24.1873 +assumes r: "Card_order r"   "regular r"
24.1874 +and As: "relChain r As"
24.1875 +and Bsub: "B \<le> (UN i : Field r. As i)"
24.1876 +and cardB: "|B| <o r"
24.1877 +shows "EX i : Field r. B \<le> As i"
24.1878 +proof-
24.1879 +  let ?phi = "%b j. j : Field r \<and> b : As j"
24.1880 +  have "ALL b : B. EX j. ?phi b j" using Bsub by blast
24.1881 +  then obtain f where f: "!! b. b : B \<Longrightarrow> ?phi b (f b)"
24.1882 +  using bchoice[of B ?phi] by blast
24.1883 +  let ?K = "f  B"
24.1884 +  {assume 1: "!! i. i : Field r \<Longrightarrow> ~ B \<le> As i"
24.1885 +   have 2: "cofinal ?K r"
24.1886 +   unfolding cofinal_def proof auto
24.1887 +     fix i assume i: "i : Field r"
24.1888 +     with 1 obtain b where b: "b : B \<and> b \<notin> As i" by blast
24.1889 +     hence "i \<noteq> f b \<and> ~ (f b,i) : r"
24.1890 +     using As f unfolding relChain_def by auto
24.1891 +     hence "i \<noteq> f b \<and> (i, f b) : r" using r
24.1892 +     unfolding card_order_on_def well_order_on_def linear_order_on_def
24.1893 +     total_on_def using i f b by auto
24.1894 +     with b show "\<exists>b\<in>B. i \<noteq> f b \<and> (i, f b) \<in> r" by blast
24.1895 +   qed
24.1896 +   moreover have "?K \<le> Field r" using f by blast
24.1897 +   ultimately have "|?K| =o r" using 2 r unfolding regular_def by blast
24.1898 +   moreover
24.1899 +   {
24.1900 +    have "|?K| <=o |B|" using card_of_image .
24.1901 +    hence "|?K| <o r" using cardB ordLeq_ordLess_trans by blast
24.1902 +   }
24.1903 +   ultimately have False using not_ordLess_ordIso by blast
24.1904 +  }
24.1905 +  thus ?thesis by blast
24.1906 +qed
24.1907 +
24.1908 +
24.1909 +lemma infinite_cardSuc_regular:
24.1910 +assumes r_inf: "infinite (Field r)" and r_card: "Card_order r"
24.1911 +shows "regular (cardSuc r)"
24.1912 +proof-
24.1913 +  let ?r' = "cardSuc r"
24.1914 +  have r': "Card_order ?r'"
24.1915 +  "!! p. Card_order p \<longrightarrow> (p \<le>o r) = (p <o ?r')"
24.1916 +  using r_card by (auto simp: cardSuc_Card_order cardSuc_ordLeq_ordLess)
24.1917 +  show ?thesis
24.1918 +  unfolding regular_def proof auto
24.1919 +    fix K assume 1: "K \<le> Field ?r'" and 2: "cofinal K ?r'"
24.1920 +    hence "|K| \<le>o |Field ?r'|" by (simp only: card_of_mono1)
24.1921 +    also have 22: "|Field ?r'| =o ?r'"
24.1922 +    using r' by (simp add: card_of_Field_ordIso[of ?r'])
24.1923 +    finally have "|K| \<le>o ?r'" .
24.1924 +    moreover
24.1925 +    {let ?L = "UN j : K. rel.underS ?r' j"
24.1926 +     let ?J = "Field r"
24.1927 +     have rJ: "r =o |?J|"
24.1928 +     using r_card card_of_Field_ordIso ordIso_symmetric by blast
24.1929 +     assume "|K| <o ?r'"
24.1930 +     hence "|K| <=o r" using r' card_of_Card_order[of K] by blast
24.1931 +     hence "|K| \<le>o |?J|" using rJ ordLeq_ordIso_trans by blast
24.1932 +     moreover
24.1933 +     {have "ALL j : K. |rel.underS ?r' j| <o ?r'"
24.1934 +      using r' 1 by (auto simp: card_of_underS)
24.1935 +      hence "ALL j : K. |rel.underS ?r' j| \<le>o r"
24.1936 +      using r' card_of_Card_order by blast
24.1937 +      hence "ALL j : K. |rel.underS ?r' j| \<le>o |?J|"
24.1938 +      using rJ ordLeq_ordIso_trans by blast
24.1939 +     }
24.1940 +     ultimately have "|?L| \<le>o |?J|"
24.1941 +     using r_inf card_of_UNION_ordLeq_infinite by blast
24.1942 +     hence "|?L| \<le>o r" using rJ ordIso_symmetric ordLeq_ordIso_trans by blast
24.1943 +     hence "|?L| <o ?r'" using r' card_of_Card_order by blast
24.1944 +     moreover
24.1945 +     {
24.1946 +      have "Field ?r' \<le> ?L"
24.1947 +      using 2 unfolding rel.underS_def cofinal_def by auto
24.1948 +      hence "|Field ?r'| \<le>o |?L|" by (simp add: card_of_mono1)
24.1949 +      hence "?r' \<le>o |?L|"
24.1950 +      using 22 ordIso_ordLeq_trans ordIso_symmetric by blast
24.1951 +     }
24.1952 +     ultimately have "|?L| <o |?L|" using ordLess_ordLeq_trans by blast
24.1953 +     hence False using ordLess_irreflexive by blast
24.1954 +    }
24.1955 +    ultimately show "|K| =o ?r'"
24.1956 +    unfolding ordLeq_iff_ordLess_or_ordIso by blast
24.1957 +  qed
24.1958 +qed
24.1959 +
24.1960 +lemma cardSuc_UNION:
24.1961 +assumes r: "Card_order r" and "infinite (Field r)"
24.1962 +and As: "relChain (cardSuc r) As"
24.1963 +and Bsub: "B \<le> (UN i : Field (cardSuc r). As i)"
24.1964 +and cardB: "|B| <=o r"
24.1965 +shows "EX i : Field (cardSuc r). B \<le> As i"
24.1966 +proof-
24.1967 +  let ?r' = "cardSuc r"
24.1968 +  have "Card_order ?r' \<and> |B| <o ?r'"
24.1969 +  using r cardB cardSuc_ordLeq_ordLess cardSuc_Card_order
24.1970 +  card_of_Card_order by blast
24.1971 +  moreover have "regular ?r'"
24.1972 +  using assms by(simp add: infinite_cardSuc_regular)
24.1973 +  ultimately show ?thesis
24.1974 +  using As Bsub cardB regular_UNION by blast
24.1975 +qed
24.1976 +
24.1977 +
24.1978 +subsection {* Others *}
24.1979 +
24.1980 +(* function space *)
24.1981 +definition Func where
24.1982 +"Func A B = {f . (\<forall> a \<in> A. f a \<in> B) \<and> (\<forall> a. a \<notin> A \<longrightarrow> f a = undefined)}"
24.1983 +
24.1984 +lemma Func_empty:
24.1985 +"Func {} B = {\<lambda>x. undefined}"
24.1986 +unfolding Func_def by auto
24.1987 +
24.1988 +lemma Func_elim:
24.1989 +assumes "g \<in> Func A B" and "a \<in> A"
24.1990 +shows "\<exists> b. b \<in> B \<and> g a = b"
24.1991 +using assms unfolding Func_def by (cases "g a = undefined") auto
24.1992 +
24.1993 +definition curr where
24.1994 +"curr A f \<equiv> \<lambda> a. if a \<in> A then \<lambda>b. f (a,b) else undefined"
24.1995 +
24.1996 +lemma curr_in:
24.1997 +assumes f: "f \<in> Func (A <*> B) C"
24.1998 +shows "curr A f \<in> Func A (Func B C)"
24.1999 +using assms unfolding curr_def Func_def by auto
24.2000 +
24.2001 +lemma curr_inj:
24.2002 +assumes "f1 \<in> Func (A <*> B) C" and "f2 \<in> Func (A <*> B) C"
24.2003 +shows "curr A f1 = curr A f2 \<longleftrightarrow> f1 = f2"
24.2004 +proof safe
24.2005 +  assume c: "curr A f1 = curr A f2"
24.2006 +  show "f1 = f2"
24.2007 +  proof (rule ext, clarify)
24.2008 +    fix a b show "f1 (a, b) = f2 (a, b)"
24.2009 +    proof (cases "(a,b) \<in> A <*> B")
24.2010 +      case False
24.2011 +      thus ?thesis using assms unfolding Func_def by auto
24.2012 +    next
24.2013 +      case True hence a: "a \<in> A" and b: "b \<in> B" by auto
24.2014 +      thus ?thesis
24.2015 +      using c unfolding curr_def fun_eq_iff by(elim allE[of _ a]) simp
24.2016 +    qed
24.2017 +  qed
24.2018 +qed
24.2019 +
24.2020 +lemma curr_surj:
24.2021 +assumes "g \<in> Func A (Func B C)"
24.2022 +shows "\<exists> f \<in> Func (A <*> B) C. curr A f = g"
24.2023 +proof
24.2024 +  let ?f = "\<lambda> ab. if fst ab \<in> A \<and> snd ab \<in> B then g (fst ab) (snd ab) else undefined"
24.2025 +  show "curr A ?f = g"
24.2026 +  proof (rule ext)
24.2027 +    fix a show "curr A ?f a = g a"
24.2028 +    proof (cases "a \<in> A")
24.2029 +      case False
24.2030 +      hence "g a = undefined" using assms unfolding Func_def by auto
24.2031 +      thus ?thesis unfolding curr_def using False by simp
24.2032 +    next
24.2033 +      case True
24.2034 +      obtain g1 where "g1 \<in> Func B C" and "g a = g1"
24.2035 +      using assms using Func_elim[OF assms True] by blast
24.2036 +      thus ?thesis using True unfolding Func_def curr_def by auto
24.2037 +    qed
24.2038 +  qed
24.2039 +  show "?f \<in> Func (A <*> B) C" using assms unfolding Func_def mem_Collect_eq by auto
24.2040 +qed
24.2041 +
24.2042 +lemma bij_betw_curr:
24.2043 +"bij_betw (curr A) (Func (A <*> B) C) (Func A (Func B C))"
24.2044 +unfolding bij_betw_def inj_on_def image_def
24.2045 +apply (intro impI conjI ballI)
24.2046 +apply (erule curr_inj[THEN iffD1], assumption+)
24.2047`