merged
authorhoelzl
Tue Nov 19 17:07:52 2013 +0100 (2013-11-19)
changeset 54498f7fef6b00bfe
parent 54497 c76dec4df4d7
parent 54495 237d5be57277
child 54499 319f8659267d
merged
src/HOL/BNF/Examples/Stream.thy
src/HOL/Cardinals/Cardinal_Order_Relation_Base.thy
src/HOL/Cardinals/Constructions_on_Wellorders_Base.thy
src/HOL/Cardinals/Fun_More_Base.thy
src/HOL/Cardinals/Order_Relation_More_Base.thy
src/HOL/Cardinals/Wellfounded_More_Base.thy
src/HOL/Cardinals/Wellorder_Embedding_Base.thy
src/HOL/Cardinals/Wellorder_Relation_Base.thy
src/HOL/List.thy
     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