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 +apply auto
24.2048 +apply (erule curr_in)
24.2049 +using curr_surj by blast
24.2050 +
24.2051 +lemma card_of_Func_Times:
24.2052 +"|Func (A <*> B) C| =o |Func A (Func B C)|"
24.2053 +unfolding card_of_ordIso[symmetric]
24.2054 +using bij_betw_curr by blast
24.2055 +
24.2056 +definition Func_map where
24.2057 +"Func_map B2 f1 f2 g b2 \<equiv> if b2 \<in> B2 then f1 (g (f2 b2)) else undefined"
24.2058 +
24.2059 +lemma Func_map:
24.2060 +assumes g: "g \<in> Func A2 A1" and f1: "f1 ` A1 \<subseteq> B1" and f2: "f2 ` B2 \<subseteq> A2"
24.2061 +shows "Func_map B2 f1 f2 g \<in> Func B2 B1"
24.2062 +using assms unfolding Func_def Func_map_def mem_Collect_eq by auto
24.2063 +
24.2064 +lemma Func_non_emp:
24.2065 +assumes "B \<noteq> {}"
24.2066 +shows "Func A B \<noteq> {}"
24.2067 +proof-
24.2068 + obtain b where b: "b \<in> B" using assms by auto
24.2069 + hence "(\<lambda> a. if a \<in> A then b else undefined) \<in> Func A B" unfolding Func_def by auto
24.2070 + thus ?thesis by blast
24.2071 +qed
24.2072 +
24.2073 +lemma Func_is_emp:
24.2074 +"Func A B = {} \<longleftrightarrow> A \<noteq> {} \<and> B = {}" (is "?L \<longleftrightarrow> ?R")
24.2075 +proof
24.2076 + assume L: ?L
24.2077 + moreover {assume "A = {}" hence False using L Func_empty by auto}
24.2078 + moreover {assume "B \<noteq> {}" hence False using L Func_non_emp by metis}
24.2079 + ultimately show ?R by blast
24.2080 +next
24.2081 + assume R: ?R
24.2082 + moreover
24.2083 + {fix f assume "f \<in> Func A B"
24.2084 + moreover obtain a where "a \<in> A" using R by blast
24.2085 + ultimately obtain b where "b \<in> B" unfolding Func_def by blast
24.2086 + with R have False by blast
24.2087 + }
24.2088 + thus ?L by blast
24.2089 +qed
24.2090 +
24.2091 +lemma Func_map_surj:
24.2092 +assumes B1: "f1 ` A1 = B1" and A2: "inj_on f2 B2" "f2 ` B2 \<subseteq> A2"
24.2093 +and B2A2: "B2 = {} \<Longrightarrow> A2 = {}"
24.2094 +shows "Func B2 B1 = Func_map B2 f1 f2 ` Func A2 A1"
24.2095 +proof(cases "B2 = {}")
24.2096 + case True
24.2097 + thus ?thesis using B2A2 by (auto simp: Func_empty Func_map_def)
24.2098 +next
24.2099 + case False note B2 = False
24.2100 + show ?thesis
24.2101 + proof safe
24.2102 + fix h assume h: "h \<in> Func B2 B1"
24.2103 + def j1 \<equiv> "inv_into A1 f1"
24.2104 + have "\<forall> a2 \<in> f2 ` B2. \<exists> b2. b2 \<in> B2 \<and> f2 b2 = a2" by blast
24.2105 + then obtain k where k: "\<forall> a2 \<in> f2 ` B2. k a2 \<in> B2 \<and> f2 (k a2) = a2" by metis
24.2106 + {fix b2 assume b2: "b2 \<in> B2"
24.2107 + hence "f2 (k (f2 b2)) = f2 b2" using k A2(2) by auto
24.2108 + moreover have "k (f2 b2) \<in> B2" using b2 A2(2) k by auto
24.2109 + ultimately have "k (f2 b2) = b2" using b2 A2(1) unfolding inj_on_def by blast
24.2110 + } note kk = this
24.2111 + obtain b22 where b22: "b22 \<in> B2" using B2 by auto
24.2112 + def j2 \<equiv> "\<lambda> a2. if a2 \<in> f2 ` B2 then k a2 else b22"
24.2113 + have j2A2: "j2 ` A2 \<subseteq> B2" unfolding j2_def using k b22 by auto
24.2114 + have j2: "\<And> b2. b2 \<in> B2 \<Longrightarrow> j2 (f2 b2) = b2"
24.2115 + using kk unfolding j2_def by auto
24.2116 + def g \<equiv> "Func_map A2 j1 j2 h"
24.2117 + have "Func_map B2 f1 f2 g = h"
24.2118 + proof (rule ext)
24.2119 + fix b2 show "Func_map B2 f1 f2 g b2 = h b2"
24.2120 + proof(cases "b2 \<in> B2")
24.2121 + case True
24.2122 + show ?thesis
24.2123 + proof (cases "h b2 = undefined")
24.2124 + case True
24.2125 + hence b1: "h b2 \<in> f1 ` A1" using h `b2 \<in> B2` unfolding B1 Func_def by auto
24.2126 + show ?thesis using A2 f_inv_into_f[OF b1]
24.2127 + unfolding True g_def Func_map_def j1_def j2[OF `b2 \<in> B2`] by auto
24.2128 + qed(insert A2 True j2[OF True] h B1, unfold j1_def g_def Func_def Func_map_def,
24.2129 + auto intro: f_inv_into_f)
24.2130 + qed(insert h, unfold Func_def Func_map_def, auto)
24.2131 + qed
24.2132 + moreover have "g \<in> Func A2 A1" unfolding g_def apply(rule Func_map[OF h])
24.2133 + using inv_into_into j2A2 B1 A2 inv_into_into
24.2134 + unfolding j1_def image_def by fast+
24.2135 + ultimately show "h \<in> Func_map B2 f1 f2 ` Func A2 A1"
24.2136 + unfolding Func_map_def[abs_def] unfolding image_def by auto
24.2137 + qed(insert B1 Func_map[OF _ _ A2(2)], auto)
24.2138 +qed
24.2139 +
24.2140 +lemma card_of_Pow_Func:
24.2141 +"|Pow A| =o |Func A (UNIV::bool set)|"
24.2142 +proof-
24.2143 + def F \<equiv> "\<lambda> A' a. if a \<in> A then (if a \<in> A' then True else False)
24.2144 + else undefined"
24.2145 + have "bij_betw F (Pow A) (Func A (UNIV::bool set))"
24.2146 + unfolding bij_betw_def inj_on_def proof (intro ballI impI conjI)
24.2147 + fix A1 A2 assume "A1 \<in> Pow A" "A2 \<in> Pow A" "F A1 = F A2"
24.2148 + thus "A1 = A2" unfolding F_def Pow_def fun_eq_iff by (auto split: split_if_asm)
24.2149 + next
24.2150 + show "F ` Pow A = Func A UNIV"
24.2151 + proof safe
24.2152 + fix f assume f: "f \<in> Func A (UNIV::bool set)"
24.2153 + show "f \<in> F ` Pow A" unfolding image_def mem_Collect_eq proof(intro bexI)
24.2154 + let ?A1 = "{a \<in> A. f a = True}"
24.2155 + show "f = F ?A1" unfolding F_def apply(rule ext)
24.2156 + using f unfolding Func_def mem_Collect_eq by auto
24.2157 + qed auto
24.2158 + qed(unfold Func_def mem_Collect_eq F_def, auto)
24.2159 + qed
24.2160 + thus ?thesis unfolding card_of_ordIso[symmetric] by blast
24.2161 +qed
24.2162 +
24.2163 +lemma card_of_Func_UNIV:
24.2164 +"|Func (UNIV::'a set) (B::'b set)| =o |{f::'a \<Rightarrow> 'b. range f \<subseteq> B}|"
24.2165 +apply(rule ordIso_symmetric) proof(intro card_of_ordIsoI)
24.2166 + let ?F = "\<lambda> f (a::'a). ((f a)::'b)"
24.2167 + show "bij_betw ?F {f. range f \<subseteq> B} (Func UNIV B)"
24.2168 + unfolding bij_betw_def inj_on_def proof safe
24.2169 + fix h :: "'a \<Rightarrow> 'b" assume h: "h \<in> Func UNIV B"
24.2170 + hence "\<forall> a. \<exists> b. h a = b" unfolding Func_def by auto
24.2171 + then obtain f where f: "\<forall> a. h a = f a" by metis
24.2172 + hence "range f \<subseteq> B" using h unfolding Func_def by auto
24.2173 + thus "h \<in> (\<lambda>f a. f a) ` {f. range f \<subseteq> B}" using f unfolding image_def by auto
24.2174 + qed(unfold Func_def fun_eq_iff, auto)
24.2175 +qed
24.2176 +
24.2177 +end
25.1 --- a/src/HOL/Cardinals/Constructions_on_Wellorders.thy Mon Nov 18 17:15:01 2013 +0100
25.2 +++ b/src/HOL/Cardinals/Constructions_on_Wellorders.thy Tue Nov 19 17:07:52 2013 +0100
25.3 @@ -8,13 +8,11 @@
25.4 header {* Constructions on Wellorders *}
25.5
25.6 theory Constructions_on_Wellorders
25.7 -imports Constructions_on_Wellorders_Base Wellorder_Embedding
25.8 +imports Constructions_on_Wellorders_FP Wellorder_Embedding
25.9 begin
25.10
25.11 declare
25.12 ordLeq_Well_order_simp[simp]
25.13 - ordLess_Well_order_simp[simp]
25.14 - ordIso_Well_order_simp[simp]
25.15 not_ordLeq_iff_ordLess[simp]
25.16 not_ordLess_iff_ordLeq[simp]
25.17
25.18 @@ -88,7 +86,7 @@
25.19 by (auto simp add: ofilter_subset_embedS_iso)
25.20
25.21
25.22 -subsection {* Ordering the well-orders by existence of embeddings *}
25.23 +subsection {* Ordering the well-orders by existence of embeddings *}
25.24
25.25 corollary ordLeq_refl_on: "refl_on {r. Well_order r} ordLeq"
25.26 using ordLeq_reflexive unfolding ordLeq_def refl_on_def
25.27 @@ -113,6 +111,16 @@
25.28 corollary ordIso_equiv: "equiv {r. Well_order r} ordIso"
25.29 by (auto simp add: equiv_def ordIso_sym ordIso_refl_on ordIso_trans)
25.30
25.31 +lemma ordLess_Well_order_simp[simp]:
25.32 +assumes "r <o r'"
25.33 +shows "Well_order r \<and> Well_order r'"
25.34 +using assms unfolding ordLess_def by simp
25.35 +
25.36 +lemma ordIso_Well_order_simp[simp]:
25.37 +assumes "r =o r'"
25.38 +shows "Well_order r \<and> Well_order r'"
25.39 +using assms unfolding ordIso_def by simp
25.40 +
25.41 lemma ordLess_irrefl: "irrefl ordLess"
25.42 by(unfold irrefl_def, auto simp add: ordLess_irreflexive)
25.43
26.1 --- a/src/HOL/Cardinals/Constructions_on_Wellorders_Base.thy Mon Nov 18 17:15:01 2013 +0100
26.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
26.3 @@ -1,1633 +0,0 @@
26.4 -(* Title: HOL/Cardinals/Constructions_on_Wellorders_Base.thy
26.5 - Author: Andrei Popescu, TU Muenchen
26.6 - Copyright 2012
26.7 -
26.8 -Constructions on wellorders (base).
26.9 -*)
26.10 -
26.11 -header {* Constructions on Wellorders (Base) *}
26.12 -
26.13 -theory Constructions_on_Wellorders_Base
26.14 -imports Wellorder_Embedding_Base
26.15 -begin
26.16 -
26.17 -
26.18 -text {* In this section, we study basic constructions on well-orders, such as restriction to
26.19 -a set/order filter, copy via direct images, ordinal-like sum of disjoint well-orders,
26.20 -and bounded square. We also define between well-orders
26.21 -the relations @{text "ordLeq"}, of being embedded (abbreviated @{text "\<le>o"}),
26.22 -@{text "ordLess"}, of being strictly embedded (abbreviated @{text "<o"}), and
26.23 -@{text "ordIso"}, of being isomorphic (abbreviated @{text "=o"}). We study the
26.24 -connections between these relations, order filters, and the aforementioned constructions.
26.25 -A main result of this section is that @{text "<o"} is well-founded. *}
26.26 -
26.27 -
26.28 -subsection {* Restriction to a set *}
26.29 -
26.30 -
26.31 -abbreviation Restr :: "'a rel \<Rightarrow> 'a set \<Rightarrow> 'a rel"
26.32 -where "Restr r A \<equiv> r Int (A \<times> A)"
26.33 -
26.34 -
26.35 -lemma Restr_subset:
26.36 -"A \<le> B \<Longrightarrow> Restr (Restr r B) A = Restr r A"
26.37 -by blast
26.38 -
26.39 -
26.40 -lemma Restr_Field: "Restr r (Field r) = r"
26.41 -unfolding Field_def by auto
26.42 -
26.43 -
26.44 -lemma Refl_Restr: "Refl r \<Longrightarrow> Refl(Restr r A)"
26.45 -unfolding refl_on_def Field_def by auto
26.46 -
26.47 -
26.48 -lemma antisym_Restr:
26.49 -"antisym r \<Longrightarrow> antisym(Restr r A)"
26.50 -unfolding antisym_def Field_def by auto
26.51 -
26.52 -
26.53 -lemma Total_Restr:
26.54 -"Total r \<Longrightarrow> Total(Restr r A)"
26.55 -unfolding total_on_def Field_def by auto
26.56 -
26.57 -
26.58 -lemma trans_Restr:
26.59 -"trans r \<Longrightarrow> trans(Restr r A)"
26.60 -unfolding trans_def Field_def by blast
26.61 -
26.62 -
26.63 -lemma Preorder_Restr:
26.64 -"Preorder r \<Longrightarrow> Preorder(Restr r A)"
26.65 -unfolding preorder_on_def by (simp add: Refl_Restr trans_Restr)
26.66 -
26.67 -
26.68 -lemma Partial_order_Restr:
26.69 -"Partial_order r \<Longrightarrow> Partial_order(Restr r A)"
26.70 -unfolding partial_order_on_def by (simp add: Preorder_Restr antisym_Restr)
26.71 -
26.72 -
26.73 -lemma Linear_order_Restr:
26.74 -"Linear_order r \<Longrightarrow> Linear_order(Restr r A)"
26.75 -unfolding linear_order_on_def by (simp add: Partial_order_Restr Total_Restr)
26.76 -
26.77 -
26.78 -lemma Well_order_Restr:
26.79 -assumes "Well_order r"
26.80 -shows "Well_order(Restr r A)"
26.81 -proof-
26.82 - have "Restr r A - Id \<le> r - Id" using Restr_subset by blast
26.83 - hence "wf(Restr r A - Id)" using assms
26.84 - using well_order_on_def wf_subset by blast
26.85 - thus ?thesis using assms unfolding well_order_on_def
26.86 - by (simp add: Linear_order_Restr)
26.87 -qed
26.88 -
26.89 -
26.90 -lemma Field_Restr_subset: "Field(Restr r A) \<le> A"
26.91 -by (auto simp add: Field_def)
26.92 -
26.93 -
26.94 -lemma Refl_Field_Restr:
26.95 -"Refl r \<Longrightarrow> Field(Restr r A) = (Field r) Int A"
26.96 -by (auto simp add: refl_on_def Field_def)
26.97 -
26.98 -
26.99 -lemma Refl_Field_Restr2:
26.100 -"\<lbrakk>Refl r; A \<le> Field r\<rbrakk> \<Longrightarrow> Field(Restr r A) = A"
26.101 -by (auto simp add: Refl_Field_Restr)
26.102 -
26.103 -
26.104 -lemma well_order_on_Restr:
26.105 -assumes WELL: "Well_order r" and SUB: "A \<le> Field r"
26.106 -shows "well_order_on A (Restr r A)"
26.107 -using assms
26.108 -using Well_order_Restr[of r A] Refl_Field_Restr2[of r A]
26.109 - order_on_defs[of "Field r" r] by auto
26.110 -
26.111 -
26.112 -subsection {* Order filters versus restrictions and embeddings *}
26.113 -
26.114 -
26.115 -lemma Field_Restr_ofilter:
26.116 -"\<lbrakk>Well_order r; wo_rel.ofilter r A\<rbrakk> \<Longrightarrow> Field(Restr r A) = A"
26.117 -by (auto simp add: wo_rel_def wo_rel.ofilter_def wo_rel.REFL Refl_Field_Restr2)
26.118 -
26.119 -
26.120 -lemma ofilter_Restr_under:
26.121 -assumes WELL: "Well_order r" and OF: "wo_rel.ofilter r A" and IN: "a \<in> A"
26.122 -shows "rel.under (Restr r A) a = rel.under r a"
26.123 -using assms wo_rel_def
26.124 -proof(auto simp add: wo_rel.ofilter_def rel.under_def)
26.125 - fix b assume *: "a \<in> A" and "(b,a) \<in> r"
26.126 - hence "b \<in> rel.under r a \<and> a \<in> Field r"
26.127 - unfolding rel.under_def using Field_def by fastforce
26.128 - thus "b \<in> A" using * assms by (auto simp add: wo_rel_def wo_rel.ofilter_def)
26.129 -qed
26.130 -
26.131 -
26.132 -lemma ofilter_embed:
26.133 -assumes "Well_order r"
26.134 -shows "wo_rel.ofilter r A = (A \<le> Field r \<and> embed (Restr r A) r id)"
26.135 -proof
26.136 - assume *: "wo_rel.ofilter r A"
26.137 - show "A \<le> Field r \<and> embed (Restr r A) r id"
26.138 - proof(unfold embed_def, auto)
26.139 - fix a assume "a \<in> A" thus "a \<in> Field r" using assms *
26.140 - by (auto simp add: wo_rel_def wo_rel.ofilter_def)
26.141 - next
26.142 - fix a assume "a \<in> Field (Restr r A)"
26.143 - thus "bij_betw id (rel.under (Restr r A) a) (rel.under r a)" using assms *
26.144 - by (simp add: ofilter_Restr_under Field_Restr_ofilter)
26.145 - qed
26.146 -next
26.147 - assume *: "A \<le> Field r \<and> embed (Restr r A) r id"
26.148 - hence "Field(Restr r A) \<le> Field r"
26.149 - using assms embed_Field[of "Restr r A" r id] id_def
26.150 - Well_order_Restr[of r] by auto
26.151 - {fix a assume "a \<in> A"
26.152 - hence "a \<in> Field(Restr r A)" using * assms
26.153 - by (simp add: order_on_defs Refl_Field_Restr2)
26.154 - hence "bij_betw id (rel.under (Restr r A) a) (rel.under r a)"
26.155 - using * unfolding embed_def by auto
26.156 - hence "rel.under r a \<le> rel.under (Restr r A) a"
26.157 - unfolding bij_betw_def by auto
26.158 - also have "\<dots> \<le> Field(Restr r A)" by (simp add: rel.under_Field)
26.159 - also have "\<dots> \<le> A" by (simp add: Field_Restr_subset)
26.160 - finally have "rel.under r a \<le> A" .
26.161 - }
26.162 - thus "wo_rel.ofilter r A" using assms * by (simp add: wo_rel_def wo_rel.ofilter_def)
26.163 -qed
26.164 -
26.165 -
26.166 -lemma ofilter_Restr_Int:
26.167 -assumes WELL: "Well_order r" and OFA: "wo_rel.ofilter r A"
26.168 -shows "wo_rel.ofilter (Restr r B) (A Int B)"
26.169 -proof-
26.170 - let ?rB = "Restr r B"
26.171 - have Well: "wo_rel r" unfolding wo_rel_def using WELL .
26.172 - hence Refl: "Refl r" by (simp add: wo_rel.REFL)
26.173 - hence Field: "Field ?rB = Field r Int B"
26.174 - using Refl_Field_Restr by blast
26.175 - have WellB: "wo_rel ?rB \<and> Well_order ?rB" using WELL
26.176 - by (simp add: Well_order_Restr wo_rel_def)
26.177 - (* Main proof *)
26.178 - show ?thesis using WellB assms
26.179 - proof(auto simp add: wo_rel.ofilter_def rel.under_def)
26.180 - fix a assume "a \<in> A" and *: "a \<in> B"
26.181 - hence "a \<in> Field r" using OFA Well by (auto simp add: wo_rel.ofilter_def)
26.182 - with * show "a \<in> Field ?rB" using Field by auto
26.183 - next
26.184 - fix a b assume "a \<in> A" and "(b,a) \<in> r"
26.185 - thus "b \<in> A" using Well OFA by (auto simp add: wo_rel.ofilter_def rel.under_def)
26.186 - qed
26.187 -qed
26.188 -
26.189 -
26.190 -lemma ofilter_Restr_subset:
26.191 -assumes WELL: "Well_order r" and OFA: "wo_rel.ofilter r A" and SUB: "A \<le> B"
26.192 -shows "wo_rel.ofilter (Restr r B) A"
26.193 -proof-
26.194 - have "A Int B = A" using SUB by blast
26.195 - thus ?thesis using assms ofilter_Restr_Int[of r A B] by auto
26.196 -qed
26.197 -
26.198 -
26.199 -lemma ofilter_subset_embed:
26.200 -assumes WELL: "Well_order r" and
26.201 - OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
26.202 -shows "(A \<le> B) = (embed (Restr r A) (Restr r B) id)"
26.203 -proof-
26.204 - let ?rA = "Restr r A" let ?rB = "Restr r B"
26.205 - have Well: "wo_rel r" unfolding wo_rel_def using WELL .
26.206 - hence Refl: "Refl r" by (simp add: wo_rel.REFL)
26.207 - hence FieldA: "Field ?rA = Field r Int A"
26.208 - using Refl_Field_Restr by blast
26.209 - have FieldB: "Field ?rB = Field r Int B"
26.210 - using Refl Refl_Field_Restr by blast
26.211 - have WellA: "wo_rel ?rA \<and> Well_order ?rA" using WELL
26.212 - by (simp add: Well_order_Restr wo_rel_def)
26.213 - have WellB: "wo_rel ?rB \<and> Well_order ?rB" using WELL
26.214 - by (simp add: Well_order_Restr wo_rel_def)
26.215 - (* Main proof *)
26.216 - show ?thesis
26.217 - proof
26.218 - assume *: "A \<le> B"
26.219 - hence "wo_rel.ofilter (Restr r B) A" using assms
26.220 - by (simp add: ofilter_Restr_subset)
26.221 - hence "embed (Restr ?rB A) (Restr r B) id"
26.222 - using WellB ofilter_embed[of "?rB" A] by auto
26.223 - thus "embed (Restr r A) (Restr r B) id"
26.224 - using * by (simp add: Restr_subset)
26.225 - next
26.226 - assume *: "embed (Restr r A) (Restr r B) id"
26.227 - {fix a assume **: "a \<in> A"
26.228 - hence "a \<in> Field r" using Well OFA by (auto simp add: wo_rel.ofilter_def)
26.229 - with ** FieldA have "a \<in> Field ?rA" by auto
26.230 - hence "a \<in> Field ?rB" using * WellA embed_Field[of ?rA ?rB id] by auto
26.231 - hence "a \<in> B" using FieldB by auto
26.232 - }
26.233 - thus "A \<le> B" by blast
26.234 - qed
26.235 -qed
26.236 -
26.237 -
26.238 -lemma ofilter_subset_embedS_iso:
26.239 -assumes WELL: "Well_order r" and
26.240 - OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
26.241 -shows "((A < B) = (embedS (Restr r A) (Restr r B) id)) \<and>
26.242 - ((A = B) = (iso (Restr r A) (Restr r B) id))"
26.243 -proof-
26.244 - let ?rA = "Restr r A" let ?rB = "Restr r B"
26.245 - have Well: "wo_rel r" unfolding wo_rel_def using WELL .
26.246 - hence Refl: "Refl r" by (simp add: wo_rel.REFL)
26.247 - hence "Field ?rA = Field r Int A"
26.248 - using Refl_Field_Restr by blast
26.249 - hence FieldA: "Field ?rA = A" using OFA Well
26.250 - by (auto simp add: wo_rel.ofilter_def)
26.251 - have "Field ?rB = Field r Int B"
26.252 - using Refl Refl_Field_Restr by blast
26.253 - hence FieldB: "Field ?rB = B" using OFB Well
26.254 - by (auto simp add: wo_rel.ofilter_def)
26.255 - (* Main proof *)
26.256 - show ?thesis unfolding embedS_def iso_def
26.257 - using assms ofilter_subset_embed[of r A B]
26.258 - FieldA FieldB bij_betw_id_iff[of A B] by auto
26.259 -qed
26.260 -
26.261 -
26.262 -lemma ofilter_subset_embedS:
26.263 -assumes WELL: "Well_order r" and
26.264 - OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
26.265 -shows "(A < B) = embedS (Restr r A) (Restr r B) id"
26.266 -using assms by (simp add: ofilter_subset_embedS_iso)
26.267 -
26.268 -
26.269 -lemma embed_implies_iso_Restr:
26.270 -assumes WELL: "Well_order r" and WELL': "Well_order r'" and
26.271 - EMB: "embed r' r f"
26.272 -shows "iso r' (Restr r (f ` (Field r'))) f"
26.273 -proof-
26.274 - let ?A' = "Field r'"
26.275 - let ?r'' = "Restr r (f ` ?A')"
26.276 - have 0: "Well_order ?r''" using WELL Well_order_Restr by blast
26.277 - have 1: "wo_rel.ofilter r (f ` ?A')" using assms embed_Field_ofilter by blast
26.278 - hence "Field ?r'' = f ` (Field r')" using WELL Field_Restr_ofilter by blast
26.279 - hence "bij_betw f ?A' (Field ?r'')"
26.280 - using EMB embed_inj_on WELL' unfolding bij_betw_def by blast
26.281 - moreover
26.282 - {have "\<forall>a b. (a,b) \<in> r' \<longrightarrow> a \<in> Field r' \<and> b \<in> Field r'"
26.283 - unfolding Field_def by auto
26.284 - hence "compat r' ?r'' f"
26.285 - using assms embed_iff_compat_inj_on_ofilter
26.286 - unfolding compat_def by blast
26.287 - }
26.288 - ultimately show ?thesis using WELL' 0 iso_iff3 by blast
26.289 -qed
26.290 -
26.291 -
26.292 -subsection {* The strict inclusion on proper ofilters is well-founded *}
26.293 -
26.294 -
26.295 -definition ofilterIncl :: "'a rel \<Rightarrow> 'a set rel"
26.296 -where
26.297 -"ofilterIncl r \<equiv> {(A,B). wo_rel.ofilter r A \<and> A \<noteq> Field r \<and>
26.298 - wo_rel.ofilter r B \<and> B \<noteq> Field r \<and> A < B}"
26.299 -
26.300 -
26.301 -lemma wf_ofilterIncl:
26.302 -assumes WELL: "Well_order r"
26.303 -shows "wf(ofilterIncl r)"
26.304 -proof-
26.305 - have Well: "wo_rel r" using WELL by (simp add: wo_rel_def)
26.306 - hence Lo: "Linear_order r" by (simp add: wo_rel.LIN)
26.307 - let ?h = "(\<lambda> A. wo_rel.suc r A)"
26.308 - let ?rS = "r - Id"
26.309 - have "wf ?rS" using WELL by (simp add: order_on_defs)
26.310 - moreover
26.311 - have "compat (ofilterIncl r) ?rS ?h"
26.312 - proof(unfold compat_def ofilterIncl_def,
26.313 - intro allI impI, simp, elim conjE)
26.314 - fix A B
26.315 - assume *: "wo_rel.ofilter r A" "A \<noteq> Field r" and
26.316 - **: "wo_rel.ofilter r B" "B \<noteq> Field r" and ***: "A < B"
26.317 - then obtain a and b where 0: "a \<in> Field r \<and> b \<in> Field r" and
26.318 - 1: "A = rel.underS r a \<and> B = rel.underS r b"
26.319 - using Well by (auto simp add: wo_rel.ofilter_underS_Field)
26.320 - hence "a \<noteq> b" using *** by auto
26.321 - moreover
26.322 - have "(a,b) \<in> r" using 0 1 Lo ***
26.323 - by (auto simp add: rel.underS_incl_iff)
26.324 - moreover
26.325 - have "a = wo_rel.suc r A \<and> b = wo_rel.suc r B"
26.326 - using Well 0 1 by (simp add: wo_rel.suc_underS)
26.327 - ultimately
26.328 - show "(wo_rel.suc r A, wo_rel.suc r B) \<in> r \<and> wo_rel.suc r A \<noteq> wo_rel.suc r B"
26.329 - by simp
26.330 - qed
26.331 - ultimately show "wf (ofilterIncl r)" by (simp add: compat_wf)
26.332 -qed
26.333 -
26.334 -
26.335 -
26.336 -subsection {* Ordering the well-orders by existence of embeddings *}
26.337 -
26.338 -
26.339 -text {* We define three relations between well-orders:
26.340 -\begin{itemize}
26.341 -\item @{text "ordLeq"}, of being embedded (abbreviated @{text "\<le>o"});
26.342 -\item @{text "ordLess"}, of being strictly embedded (abbreviated @{text "<o"});
26.343 -\item @{text "ordIso"}, of being isomorphic (abbreviated @{text "=o"}).
26.344 -\end{itemize}
26.345 -%
26.346 -The prefix "ord" and the index "o" in these names stand for "ordinal-like".
26.347 -These relations shall be proved to be inter-connected in a similar fashion as the trio
26.348 -@{text "\<le>"}, @{text "<"}, @{text "="} associated to a total order on a set.
26.349 -*}
26.350 -
26.351 -
26.352 -definition ordLeq :: "('a rel * 'a' rel) set"
26.353 -where
26.354 -"ordLeq = {(r,r'). Well_order r \<and> Well_order r' \<and> (\<exists>f. embed r r' f)}"
26.355 -
26.356 -
26.357 -abbreviation ordLeq2 :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> bool" (infix "<=o" 50)
26.358 -where "r <=o r' \<equiv> (r,r') \<in> ordLeq"
26.359 -
26.360 -
26.361 -abbreviation ordLeq3 :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> bool" (infix "\<le>o" 50)
26.362 -where "r \<le>o r' \<equiv> r <=o r'"
26.363 -
26.364 -
26.365 -definition ordLess :: "('a rel * 'a' rel) set"
26.366 -where
26.367 -"ordLess = {(r,r'). Well_order r \<and> Well_order r' \<and> (\<exists>f. embedS r r' f)}"
26.368 -
26.369 -abbreviation ordLess2 :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> bool" (infix "<o" 50)
26.370 -where "r <o r' \<equiv> (r,r') \<in> ordLess"
26.371 -
26.372 -
26.373 -definition ordIso :: "('a rel * 'a' rel) set"
26.374 -where
26.375 -"ordIso = {(r,r'). Well_order r \<and> Well_order r' \<and> (\<exists>f. iso r r' f)}"
26.376 -
26.377 -abbreviation ordIso2 :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> bool" (infix "=o" 50)
26.378 -where "r =o r' \<equiv> (r,r') \<in> ordIso"
26.379 -
26.380 -
26.381 -lemmas ordRels_def = ordLeq_def ordLess_def ordIso_def
26.382 -
26.383 -lemma ordLeq_Well_order_simp:
26.384 -assumes "r \<le>o r'"
26.385 -shows "Well_order r \<and> Well_order r'"
26.386 -using assms unfolding ordLeq_def by simp
26.387 -
26.388 -
26.389 -lemma ordLess_Well_order_simp:
26.390 -assumes "r <o r'"
26.391 -shows "Well_order r \<and> Well_order r'"
26.392 -using assms unfolding ordLess_def by simp
26.393 -
26.394 -
26.395 -lemma ordIso_Well_order_simp:
26.396 -assumes "r =o r'"
26.397 -shows "Well_order r \<and> Well_order r'"
26.398 -using assms unfolding ordIso_def by simp
26.399 -
26.400 -
26.401 -text{* Notice that the relations @{text "\<le>o"}, @{text "<o"}, @{text "=o"} connect well-orders
26.402 -on potentially {\em distinct} types. However, some of the lemmas below, including the next one,
26.403 -restrict implicitly the type of these relations to @{text "(('a rel) * ('a rel)) set"} , i.e.,
26.404 -to @{text "'a rel rel"}. *}
26.405 -
26.406 -
26.407 -lemma ordLeq_reflexive:
26.408 -"Well_order r \<Longrightarrow> r \<le>o r"
26.409 -unfolding ordLeq_def using id_embed[of r] by blast
26.410 -
26.411 -
26.412 -lemma ordLeq_transitive[trans]:
26.413 -assumes *: "r \<le>o r'" and **: "r' \<le>o r''"
26.414 -shows "r \<le>o r''"
26.415 -proof-
26.416 - obtain f and f'
26.417 - where 1: "Well_order r \<and> Well_order r' \<and> Well_order r''" and
26.418 - "embed r r' f" and "embed r' r'' f'"
26.419 - using * ** unfolding ordLeq_def by blast
26.420 - hence "embed r r'' (f' o f)"
26.421 - using comp_embed[of r r' f r'' f'] by auto
26.422 - thus "r \<le>o r''" unfolding ordLeq_def using 1 by auto
26.423 -qed
26.424 -
26.425 -
26.426 -lemma ordLeq_total:
26.427 -"\<lbrakk>Well_order r; Well_order r'\<rbrakk> \<Longrightarrow> r \<le>o r' \<or> r' \<le>o r"
26.428 -unfolding ordLeq_def using wellorders_totally_ordered by blast
26.429 -
26.430 -
26.431 -lemma ordIso_reflexive:
26.432 -"Well_order r \<Longrightarrow> r =o r"
26.433 -unfolding ordIso_def using id_iso[of r] by blast
26.434 -
26.435 -
26.436 -lemma ordIso_transitive[trans]:
26.437 -assumes *: "r =o r'" and **: "r' =o r''"
26.438 -shows "r =o r''"
26.439 -proof-
26.440 - obtain f and f'
26.441 - where 1: "Well_order r \<and> Well_order r' \<and> Well_order r''" and
26.442 - "iso r r' f" and 3: "iso r' r'' f'"
26.443 - using * ** unfolding ordIso_def by auto
26.444 - hence "iso r r'' (f' o f)"
26.445 - using comp_iso[of r r' f r'' f'] by auto
26.446 - thus "r =o r''" unfolding ordIso_def using 1 by auto
26.447 -qed
26.448 -
26.449 -
26.450 -lemma ordIso_symmetric:
26.451 -assumes *: "r =o r'"
26.452 -shows "r' =o r"
26.453 -proof-
26.454 - obtain f where 1: "Well_order r \<and> Well_order r'" and
26.455 - 2: "embed r r' f \<and> bij_betw f (Field r) (Field r')"
26.456 - using * by (auto simp add: ordIso_def iso_def)
26.457 - let ?f' = "inv_into (Field r) f"
26.458 - have "embed r' r ?f' \<and> bij_betw ?f' (Field r') (Field r)"
26.459 - using 1 2 by (simp add: bij_betw_inv_into inv_into_Field_embed_bij_betw)
26.460 - thus "r' =o r" unfolding ordIso_def using 1 by (auto simp add: iso_def)
26.461 -qed
26.462 -
26.463 -
26.464 -lemma ordLeq_ordLess_trans[trans]:
26.465 -assumes "r \<le>o r'" and " r' <o r''"
26.466 -shows "r <o r''"
26.467 -proof-
26.468 - have "Well_order r \<and> Well_order r''"
26.469 - using assms unfolding ordLeq_def ordLess_def by auto
26.470 - thus ?thesis using assms unfolding ordLeq_def ordLess_def
26.471 - using embed_comp_embedS by blast
26.472 -qed
26.473 -
26.474 -
26.475 -lemma ordLess_ordLeq_trans[trans]:
26.476 -assumes "r <o r'" and " r' \<le>o r''"
26.477 -shows "r <o r''"
26.478 -proof-
26.479 - have "Well_order r \<and> Well_order r''"
26.480 - using assms unfolding ordLeq_def ordLess_def by auto
26.481 - thus ?thesis using assms unfolding ordLeq_def ordLess_def
26.482 - using embedS_comp_embed by blast
26.483 -qed
26.484 -
26.485 -
26.486 -lemma ordLeq_ordIso_trans[trans]:
26.487 -assumes "r \<le>o r'" and " r' =o r''"
26.488 -shows "r \<le>o r''"
26.489 -proof-
26.490 - have "Well_order r \<and> Well_order r''"
26.491 - using assms unfolding ordLeq_def ordIso_def by auto
26.492 - thus ?thesis using assms unfolding ordLeq_def ordIso_def
26.493 - using embed_comp_iso by blast
26.494 -qed
26.495 -
26.496 -
26.497 -lemma ordIso_ordLeq_trans[trans]:
26.498 -assumes "r =o r'" and " r' \<le>o r''"
26.499 -shows "r \<le>o r''"
26.500 -proof-
26.501 - have "Well_order r \<and> Well_order r''"
26.502 - using assms unfolding ordLeq_def ordIso_def by auto
26.503 - thus ?thesis using assms unfolding ordLeq_def ordIso_def
26.504 - using iso_comp_embed by blast
26.505 -qed
26.506 -
26.507 -
26.508 -lemma ordLess_ordIso_trans[trans]:
26.509 -assumes "r <o r'" and " r' =o r''"
26.510 -shows "r <o r''"
26.511 -proof-
26.512 - have "Well_order r \<and> Well_order r''"
26.513 - using assms unfolding ordLess_def ordIso_def by auto
26.514 - thus ?thesis using assms unfolding ordLess_def ordIso_def
26.515 - using embedS_comp_iso by blast
26.516 -qed
26.517 -
26.518 -
26.519 -lemma ordIso_ordLess_trans[trans]:
26.520 -assumes "r =o r'" and " r' <o r''"
26.521 -shows "r <o r''"
26.522 -proof-
26.523 - have "Well_order r \<and> Well_order r''"
26.524 - using assms unfolding ordLess_def ordIso_def by auto
26.525 - thus ?thesis using assms unfolding ordLess_def ordIso_def
26.526 - using iso_comp_embedS by blast
26.527 -qed
26.528 -
26.529 -
26.530 -lemma ordLess_not_embed:
26.531 -assumes "r <o r'"
26.532 -shows "\<not>(\<exists>f'. embed r' r f')"
26.533 -proof-
26.534 - obtain f where 1: "Well_order r \<and> Well_order r'" and 2: "embed r r' f" and
26.535 - 3: " \<not> bij_betw f (Field r) (Field r')"
26.536 - using assms unfolding ordLess_def by (auto simp add: embedS_def)
26.537 - {fix f' assume *: "embed r' r f'"
26.538 - hence "bij_betw f (Field r) (Field r')" using 1 2
26.539 - by (simp add: embed_bothWays_Field_bij_betw)
26.540 - with 3 have False by contradiction
26.541 - }
26.542 - thus ?thesis by blast
26.543 -qed
26.544 -
26.545 -
26.546 -lemma ordLess_Field:
26.547 -assumes OL: "r1 <o r2" and EMB: "embed r1 r2 f"
26.548 -shows "\<not> (f`(Field r1) = Field r2)"
26.549 -proof-
26.550 - let ?A1 = "Field r1" let ?A2 = "Field r2"
26.551 - obtain g where
26.552 - 0: "Well_order r1 \<and> Well_order r2" and
26.553 - 1: "embed r1 r2 g \<and> \<not>(bij_betw g ?A1 ?A2)"
26.554 - using OL unfolding ordLess_def by (auto simp add: embedS_def)
26.555 - hence "\<forall>a \<in> ?A1. f a = g a"
26.556 - using 0 EMB embed_unique[of r1] by auto
26.557 - hence "\<not>(bij_betw f ?A1 ?A2)"
26.558 - using 1 bij_betw_cong[of ?A1] by blast
26.559 - moreover
26.560 - have "inj_on f ?A1" using EMB 0 by (simp add: embed_inj_on)
26.561 - ultimately show ?thesis by (simp add: bij_betw_def)
26.562 -qed
26.563 -
26.564 -
26.565 -lemma ordLess_iff:
26.566 -"r <o r' = (Well_order r \<and> Well_order r' \<and> \<not>(\<exists>f'. embed r' r f'))"
26.567 -proof
26.568 - assume *: "r <o r'"
26.569 - hence "\<not>(\<exists>f'. embed r' r f')" using ordLess_not_embed[of r r'] by simp
26.570 - with * show "Well_order r \<and> Well_order r' \<and> \<not> (\<exists>f'. embed r' r f')"
26.571 - unfolding ordLess_def by auto
26.572 -next
26.573 - assume *: "Well_order r \<and> Well_order r' \<and> \<not> (\<exists>f'. embed r' r f')"
26.574 - then obtain f where 1: "embed r r' f"
26.575 - using wellorders_totally_ordered[of r r'] by blast
26.576 - moreover
26.577 - {assume "bij_betw f (Field r) (Field r')"
26.578 - with * 1 have "embed r' r (inv_into (Field r) f) "
26.579 - using inv_into_Field_embed_bij_betw[of r r' f] by auto
26.580 - with * have False by blast
26.581 - }
26.582 - ultimately show "(r,r') \<in> ordLess"
26.583 - unfolding ordLess_def using * by (fastforce simp add: embedS_def)
26.584 -qed
26.585 -
26.586 -
26.587 -lemma ordLess_irreflexive: "\<not> r <o r"
26.588 -proof
26.589 - assume "r <o r"
26.590 - hence "Well_order r \<and> \<not>(\<exists>f. embed r r f)"
26.591 - unfolding ordLess_iff ..
26.592 - moreover have "embed r r id" using id_embed[of r] .
26.593 - ultimately show False by blast
26.594 -qed
26.595 -
26.596 -
26.597 -lemma ordLeq_iff_ordLess_or_ordIso:
26.598 -"r \<le>o r' = (r <o r' \<or> r =o r')"
26.599 -unfolding ordRels_def embedS_defs iso_defs by blast
26.600 -
26.601 -
26.602 -lemma ordIso_iff_ordLeq:
26.603 -"(r =o r') = (r \<le>o r' \<and> r' \<le>o r)"
26.604 -proof
26.605 - assume "r =o r'"
26.606 - then obtain f where 1: "Well_order r \<and> Well_order r' \<and>
26.607 - embed r r' f \<and> bij_betw f (Field r) (Field r')"
26.608 - unfolding ordIso_def iso_defs by auto
26.609 - hence "embed r r' f \<and> embed r' r (inv_into (Field r) f)"
26.610 - by (simp add: inv_into_Field_embed_bij_betw)
26.611 - thus "r \<le>o r' \<and> r' \<le>o r"
26.612 - unfolding ordLeq_def using 1 by auto
26.613 -next
26.614 - assume "r \<le>o r' \<and> r' \<le>o r"
26.615 - then obtain f and g where 1: "Well_order r \<and> Well_order r' \<and>
26.616 - embed r r' f \<and> embed r' r g"
26.617 - unfolding ordLeq_def by auto
26.618 - hence "iso r r' f" by (auto simp add: embed_bothWays_iso)
26.619 - thus "r =o r'" unfolding ordIso_def using 1 by auto
26.620 -qed
26.621 -
26.622 -
26.623 -lemma not_ordLess_ordLeq:
26.624 -"r <o r' \<Longrightarrow> \<not> r' \<le>o r"
26.625 -using ordLess_ordLeq_trans ordLess_irreflexive by blast
26.626 -
26.627 -
26.628 -lemma ordLess_or_ordLeq:
26.629 -assumes WELL: "Well_order r" and WELL': "Well_order r'"
26.630 -shows "r <o r' \<or> r' \<le>o r"
26.631 -proof-
26.632 - have "r \<le>o r' \<or> r' \<le>o r"
26.633 - using assms by (simp add: ordLeq_total)
26.634 - moreover
26.635 - {assume "\<not> r <o r' \<and> r \<le>o r'"
26.636 - hence "r =o r'" using ordLeq_iff_ordLess_or_ordIso by blast
26.637 - hence "r' \<le>o r" using ordIso_symmetric ordIso_iff_ordLeq by blast
26.638 - }
26.639 - ultimately show ?thesis by blast
26.640 -qed
26.641 -
26.642 -
26.643 -lemma not_ordLess_ordIso:
26.644 -"r <o r' \<Longrightarrow> \<not> r =o r'"
26.645 -using assms ordLess_ordIso_trans ordIso_symmetric ordLess_irreflexive by blast
26.646 -
26.647 -
26.648 -lemma not_ordLeq_iff_ordLess:
26.649 -assumes WELL: "Well_order r" and WELL': "Well_order r'"
26.650 -shows "(\<not> r' \<le>o r) = (r <o r')"
26.651 -using assms not_ordLess_ordLeq ordLess_or_ordLeq by blast
26.652 -
26.653 -
26.654 -lemma not_ordLess_iff_ordLeq:
26.655 -assumes WELL: "Well_order r" and WELL': "Well_order r'"
26.656 -shows "(\<not> r' <o r) = (r \<le>o r')"
26.657 -using assms not_ordLess_ordLeq ordLess_or_ordLeq by blast
26.658 -
26.659 -
26.660 -lemma ordLess_transitive[trans]:
26.661 -"\<lbrakk>r <o r'; r' <o r''\<rbrakk> \<Longrightarrow> r <o r''"
26.662 -using assms ordLess_ordLeq_trans ordLeq_iff_ordLess_or_ordIso by blast
26.663 -
26.664 -
26.665 -corollary ordLess_trans: "trans ordLess"
26.666 -unfolding trans_def using ordLess_transitive by blast
26.667 -
26.668 -
26.669 -lemmas ordIso_equivalence = ordIso_transitive ordIso_reflexive ordIso_symmetric
26.670 -
26.671 -
26.672 -lemma ordIso_imp_ordLeq:
26.673 -"r =o r' \<Longrightarrow> r \<le>o r'"
26.674 -using ordIso_iff_ordLeq by blast
26.675 -
26.676 -
26.677 -lemma ordLess_imp_ordLeq:
26.678 -"r <o r' \<Longrightarrow> r \<le>o r'"
26.679 -using ordLeq_iff_ordLess_or_ordIso by blast
26.680 -
26.681 -
26.682 -lemma ofilter_subset_ordLeq:
26.683 -assumes WELL: "Well_order r" and
26.684 - OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
26.685 -shows "(A \<le> B) = (Restr r A \<le>o Restr r B)"
26.686 -proof
26.687 - assume "A \<le> B"
26.688 - thus "Restr r A \<le>o Restr r B"
26.689 - unfolding ordLeq_def using assms
26.690 - Well_order_Restr Well_order_Restr ofilter_subset_embed by blast
26.691 -next
26.692 - assume *: "Restr r A \<le>o Restr r B"
26.693 - then obtain f where "embed (Restr r A) (Restr r B) f"
26.694 - unfolding ordLeq_def by blast
26.695 - {assume "B < A"
26.696 - hence "Restr r B <o Restr r A"
26.697 - unfolding ordLess_def using assms
26.698 - Well_order_Restr Well_order_Restr ofilter_subset_embedS by blast
26.699 - hence False using * not_ordLess_ordLeq by blast
26.700 - }
26.701 - thus "A \<le> B" using OFA OFB WELL
26.702 - wo_rel_def[of r] wo_rel.ofilter_linord[of r A B] by blast
26.703 -qed
26.704 -
26.705 -
26.706 -lemma ofilter_subset_ordLess:
26.707 -assumes WELL: "Well_order r" and
26.708 - OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
26.709 -shows "(A < B) = (Restr r A <o Restr r B)"
26.710 -proof-
26.711 - let ?rA = "Restr r A" let ?rB = "Restr r B"
26.712 - have 1: "Well_order ?rA \<and> Well_order ?rB"
26.713 - using WELL Well_order_Restr by blast
26.714 - have "(A < B) = (\<not> B \<le> A)" using assms
26.715 - wo_rel_def wo_rel.ofilter_linord[of r A B] by blast
26.716 - also have "\<dots> = (\<not> Restr r B \<le>o Restr r A)"
26.717 - using assms ofilter_subset_ordLeq by blast
26.718 - also have "\<dots> = (Restr r A <o Restr r B)"
26.719 - using 1 not_ordLeq_iff_ordLess by blast
26.720 - finally show ?thesis .
26.721 -qed
26.722 -
26.723 -
26.724 -lemma ofilter_ordLess:
26.725 -"\<lbrakk>Well_order r; wo_rel.ofilter r A\<rbrakk> \<Longrightarrow> (A < Field r) = (Restr r A <o r)"
26.726 -by (simp add: ofilter_subset_ordLess wo_rel.Field_ofilter
26.727 - wo_rel_def Restr_Field)
26.728 -
26.729 -
26.730 -corollary underS_Restr_ordLess:
26.731 -assumes "Well_order r" and "Field r \<noteq> {}"
26.732 -shows "Restr r (rel.underS r a) <o r"
26.733 -proof-
26.734 - have "rel.underS r a < Field r" using assms
26.735 - by (simp add: rel.underS_Field3)
26.736 - thus ?thesis using assms
26.737 - by (simp add: ofilter_ordLess wo_rel.underS_ofilter wo_rel_def)
26.738 -qed
26.739 -
26.740 -
26.741 -lemma embed_ordLess_ofilterIncl:
26.742 -assumes
26.743 - OL12: "r1 <o r2" and OL23: "r2 <o r3" and
26.744 - EMB13: "embed r1 r3 f13" and EMB23: "embed r2 r3 f23"
26.745 -shows "(f13`(Field r1), f23`(Field r2)) \<in> (ofilterIncl r3)"
26.746 -proof-
26.747 - have OL13: "r1 <o r3"
26.748 - using OL12 OL23 using ordLess_transitive by auto
26.749 - let ?A1 = "Field r1" let ?A2 ="Field r2" let ?A3 ="Field r3"
26.750 - obtain f12 g23 where
26.751 - 0: "Well_order r1 \<and> Well_order r2 \<and> Well_order r3" and
26.752 - 1: "embed r1 r2 f12 \<and> \<not>(bij_betw f12 ?A1 ?A2)" and
26.753 - 2: "embed r2 r3 g23 \<and> \<not>(bij_betw g23 ?A2 ?A3)"
26.754 - using OL12 OL23 by (auto simp add: ordLess_def embedS_def)
26.755 - hence "\<forall>a \<in> ?A2. f23 a = g23 a"
26.756 - using EMB23 embed_unique[of r2 r3] by blast
26.757 - hence 3: "\<not>(bij_betw f23 ?A2 ?A3)"
26.758 - using 2 bij_betw_cong[of ?A2 f23 g23] by blast
26.759 - (* *)
26.760 - have 4: "wo_rel.ofilter r2 (f12 ` ?A1) \<and> f12 ` ?A1 \<noteq> ?A2"
26.761 - using 0 1 OL12 by (simp add: embed_Field_ofilter ordLess_Field)
26.762 - have 5: "wo_rel.ofilter r3 (f23 ` ?A2) \<and> f23 ` ?A2 \<noteq> ?A3"
26.763 - using 0 EMB23 OL23 by (simp add: embed_Field_ofilter ordLess_Field)
26.764 - have 6: "wo_rel.ofilter r3 (f13 ` ?A1) \<and> f13 ` ?A1 \<noteq> ?A3"
26.765 - using 0 EMB13 OL13 by (simp add: embed_Field_ofilter ordLess_Field)
26.766 - (* *)
26.767 - have "f12 ` ?A1 < ?A2"
26.768 - using 0 4 by (auto simp add: wo_rel_def wo_rel.ofilter_def)
26.769 - moreover have "inj_on f23 ?A2"
26.770 - using EMB23 0 by (simp add: wo_rel_def embed_inj_on)
26.771 - ultimately
26.772 - have "f23 ` (f12 ` ?A1) < f23 ` ?A2" by (simp add: inj_on_strict_subset)
26.773 - moreover
26.774 - {have "embed r1 r3 (f23 o f12)"
26.775 - using 1 EMB23 0 by (auto simp add: comp_embed)
26.776 - hence "\<forall>a \<in> ?A1. f23(f12 a) = f13 a"
26.777 - using EMB13 0 embed_unique[of r1 r3 "f23 o f12" f13] by auto
26.778 - hence "f23 ` (f12 ` ?A1) = f13 ` ?A1" by force
26.779 - }
26.780 - ultimately
26.781 - have "f13 ` ?A1 < f23 ` ?A2" by simp
26.782 - (* *)
26.783 - with 5 6 show ?thesis
26.784 - unfolding ofilterIncl_def by auto
26.785 -qed
26.786 -
26.787 -
26.788 -lemma ordLess_iff_ordIso_Restr:
26.789 -assumes WELL: "Well_order r" and WELL': "Well_order r'"
26.790 -shows "(r' <o r) = (\<exists>a \<in> Field r. r' =o Restr r (rel.underS r a))"
26.791 -proof(auto)
26.792 - fix a assume *: "a \<in> Field r" and **: "r' =o Restr r (rel.underS r a)"
26.793 - hence "Restr r (rel.underS r a) <o r" using WELL underS_Restr_ordLess[of r] by blast
26.794 - thus "r' <o r" using ** ordIso_ordLess_trans by blast
26.795 -next
26.796 - assume "r' <o r"
26.797 - then obtain f where 1: "Well_order r \<and> Well_order r'" and
26.798 - 2: "embed r' r f \<and> f ` (Field r') \<noteq> Field r"
26.799 - unfolding ordLess_def embedS_def[abs_def] bij_betw_def using embed_inj_on by blast
26.800 - hence "wo_rel.ofilter r (f ` (Field r'))" using embed_Field_ofilter by blast
26.801 - then obtain a where 3: "a \<in> Field r" and 4: "rel.underS r a = f ` (Field r')"
26.802 - using 1 2 by (auto simp add: wo_rel.ofilter_underS_Field wo_rel_def)
26.803 - have "iso r' (Restr r (f ` (Field r'))) f"
26.804 - using embed_implies_iso_Restr 2 assms by blast
26.805 - moreover have "Well_order (Restr r (f ` (Field r')))"
26.806 - using WELL Well_order_Restr by blast
26.807 - ultimately have "r' =o Restr r (f ` (Field r'))"
26.808 - using WELL' unfolding ordIso_def by auto
26.809 - hence "r' =o Restr r (rel.underS r a)" using 4 by auto
26.810 - thus "\<exists>a \<in> Field r. r' =o Restr r (rel.underS r a)" using 3 by auto
26.811 -qed
26.812 -
26.813 -
26.814 -lemma internalize_ordLess:
26.815 -"(r' <o r) = (\<exists>p. Field p < Field r \<and> r' =o p \<and> p <o r)"
26.816 -proof
26.817 - assume *: "r' <o r"
26.818 - hence 0: "Well_order r \<and> Well_order r'" unfolding ordLess_def by auto
26.819 - with * obtain a where 1: "a \<in> Field r" and 2: "r' =o Restr r (rel.underS r a)"
26.820 - using ordLess_iff_ordIso_Restr by blast
26.821 - let ?p = "Restr r (rel.underS r a)"
26.822 - have "wo_rel.ofilter r (rel.underS r a)" using 0
26.823 - by (simp add: wo_rel_def wo_rel.underS_ofilter)
26.824 - hence "Field ?p = rel.underS r a" using 0 Field_Restr_ofilter by blast
26.825 - hence "Field ?p < Field r" using rel.underS_Field2 1 by fastforce
26.826 - moreover have "?p <o r" using underS_Restr_ordLess[of r a] 0 1 by blast
26.827 - ultimately
26.828 - show "\<exists>p. Field p < Field r \<and> r' =o p \<and> p <o r" using 2 by blast
26.829 -next
26.830 - assume "\<exists>p. Field p < Field r \<and> r' =o p \<and> p <o r"
26.831 - thus "r' <o r" using ordIso_ordLess_trans by blast
26.832 -qed
26.833 -
26.834 -
26.835 -lemma internalize_ordLeq:
26.836 -"(r' \<le>o r) = (\<exists>p. Field p \<le> Field r \<and> r' =o p \<and> p \<le>o r)"
26.837 -proof
26.838 - assume *: "r' \<le>o r"
26.839 - moreover
26.840 - {assume "r' <o r"
26.841 - then obtain p where "Field p < Field r \<and> r' =o p \<and> p <o r"
26.842 - using internalize_ordLess[of r' r] by blast
26.843 - hence "\<exists>p. Field p \<le> Field r \<and> r' =o p \<and> p \<le>o r"
26.844 - using ordLeq_iff_ordLess_or_ordIso by blast
26.845 - }
26.846 - moreover
26.847 - have "r \<le>o r" using * ordLeq_def ordLeq_reflexive by blast
26.848 - ultimately show "\<exists>p. Field p \<le> Field r \<and> r' =o p \<and> p \<le>o r"
26.849 - using ordLeq_iff_ordLess_or_ordIso by blast
26.850 -next
26.851 - assume "\<exists>p. Field p \<le> Field r \<and> r' =o p \<and> p \<le>o r"
26.852 - thus "r' \<le>o r" using ordIso_ordLeq_trans by blast
26.853 -qed
26.854 -
26.855 -
26.856 -lemma ordLeq_iff_ordLess_Restr:
26.857 -assumes WELL: "Well_order r" and WELL': "Well_order r'"
26.858 -shows "(r \<le>o r') = (\<forall>a \<in> Field r. Restr r (rel.underS r a) <o r')"
26.859 -proof(auto)
26.860 - assume *: "r \<le>o r'"
26.861 - fix a assume "a \<in> Field r"
26.862 - hence "Restr r (rel.underS r a) <o r"
26.863 - using WELL underS_Restr_ordLess[of r] by blast
26.864 - thus "Restr r (rel.underS r a) <o r'"
26.865 - using * ordLess_ordLeq_trans by blast
26.866 -next
26.867 - assume *: "\<forall>a \<in> Field r. Restr r (rel.underS r a) <o r'"
26.868 - {assume "r' <o r"
26.869 - then obtain a where "a \<in> Field r \<and> r' =o Restr r (rel.underS r a)"
26.870 - using assms ordLess_iff_ordIso_Restr by blast
26.871 - hence False using * not_ordLess_ordIso ordIso_symmetric by blast
26.872 - }
26.873 - thus "r \<le>o r'" using ordLess_or_ordLeq assms by blast
26.874 -qed
26.875 -
26.876 -
26.877 -lemma finite_ordLess_infinite:
26.878 -assumes WELL: "Well_order r" and WELL': "Well_order r'" and
26.879 - FIN: "finite(Field r)" and INF: "infinite(Field r')"
26.880 -shows "r <o r'"
26.881 -proof-
26.882 - {assume "r' \<le>o r"
26.883 - then obtain h where "inj_on h (Field r') \<and> h ` (Field r') \<le> Field r"
26.884 - unfolding ordLeq_def using assms embed_inj_on embed_Field by blast
26.885 - hence False using finite_imageD finite_subset FIN INF by metis
26.886 - }
26.887 - thus ?thesis using WELL WELL' ordLess_or_ordLeq by blast
26.888 -qed
26.889 -
26.890 -
26.891 -lemma finite_well_order_on_ordIso:
26.892 -assumes FIN: "finite A" and
26.893 - WELL: "well_order_on A r" and WELL': "well_order_on A r'"
26.894 -shows "r =o r'"
26.895 -proof-
26.896 - have 0: "Well_order r \<and> Well_order r' \<and> Field r = A \<and> Field r' = A"
26.897 - using assms rel.well_order_on_Well_order by blast
26.898 - moreover
26.899 - have "\<forall>r r'. well_order_on A r \<and> well_order_on A r' \<and> r \<le>o r'
26.900 - \<longrightarrow> r =o r'"
26.901 - proof(clarify)
26.902 - fix r r' assume *: "well_order_on A r" and **: "well_order_on A r'"
26.903 - have 2: "Well_order r \<and> Well_order r' \<and> Field r = A \<and> Field r' = A"
26.904 - using * ** rel.well_order_on_Well_order by blast
26.905 - assume "r \<le>o r'"
26.906 - then obtain f where 1: "embed r r' f" and
26.907 - "inj_on f A \<and> f ` A \<le> A"
26.908 - unfolding ordLeq_def using 2 embed_inj_on embed_Field by blast
26.909 - hence "bij_betw f A A" unfolding bij_betw_def using FIN endo_inj_surj by blast
26.910 - thus "r =o r'" unfolding ordIso_def iso_def[abs_def] using 1 2 by auto
26.911 - qed
26.912 - ultimately show ?thesis using assms ordLeq_total ordIso_symmetric by blast
26.913 -qed
26.914 -
26.915 -
26.916 -subsection{* @{text "<o"} is well-founded *}
26.917 -
26.918 -
26.919 -text {* Of course, it only makes sense to state that the @{text "<o"} is well-founded
26.920 -on the restricted type @{text "'a rel rel"}. We prove this by first showing that, for any set
26.921 -of well-orders all embedded in a fixed well-order, the function mapping each well-order
26.922 -in the set to an order filter of the fixed well-order is compatible w.r.t. to @{text "<o"} versus
26.923 -{\em strict inclusion}; and we already know that strict inclusion of order filters is well-founded. *}
26.924 -
26.925 -
26.926 -definition ord_to_filter :: "'a rel \<Rightarrow> 'a rel \<Rightarrow> 'a set"
26.927 -where "ord_to_filter r0 r \<equiv> (SOME f. embed r r0 f) ` (Field r)"
26.928 -
26.929 -
26.930 -lemma ord_to_filter_compat:
26.931 -"compat (ordLess Int (ordLess^-1``{r0} \<times> ordLess^-1``{r0}))
26.932 - (ofilterIncl r0)
26.933 - (ord_to_filter r0)"
26.934 -proof(unfold compat_def ord_to_filter_def, clarify)
26.935 - fix r1::"'a rel" and r2::"'a rel"
26.936 - let ?A1 = "Field r1" let ?A2 ="Field r2" let ?A0 ="Field r0"
26.937 - let ?phi10 = "\<lambda> f10. embed r1 r0 f10" let ?f10 = "SOME f. ?phi10 f"
26.938 - let ?phi20 = "\<lambda> f20. embed r2 r0 f20" let ?f20 = "SOME f. ?phi20 f"
26.939 - assume *: "r1 <o r0" "r2 <o r0" and **: "r1 <o r2"
26.940 - hence "(\<exists>f. ?phi10 f) \<and> (\<exists>f. ?phi20 f)"
26.941 - by (auto simp add: ordLess_def embedS_def)
26.942 - hence "?phi10 ?f10 \<and> ?phi20 ?f20" by (auto simp add: someI_ex)
26.943 - thus "(?f10 ` ?A1, ?f20 ` ?A2) \<in> ofilterIncl r0"
26.944 - using * ** by (simp add: embed_ordLess_ofilterIncl)
26.945 -qed
26.946 -
26.947 -
26.948 -theorem wf_ordLess: "wf ordLess"
26.949 -proof-
26.950 - {fix r0 :: "('a \<times> 'a) set"
26.951 - (* need to annotate here!*)
26.952 - let ?ordLess = "ordLess::('d rel * 'd rel) set"
26.953 - let ?R = "?ordLess Int (?ordLess^-1``{r0} \<times> ?ordLess^-1``{r0})"
26.954 - {assume Case1: "Well_order r0"
26.955 - hence "wf ?R"
26.956 - using wf_ofilterIncl[of r0]
26.957 - compat_wf[of ?R "ofilterIncl r0" "ord_to_filter r0"]
26.958 - ord_to_filter_compat[of r0] by auto
26.959 - }
26.960 - moreover
26.961 - {assume Case2: "\<not> Well_order r0"
26.962 - hence "?R = {}" unfolding ordLess_def by auto
26.963 - hence "wf ?R" using wf_empty by simp
26.964 - }
26.965 - ultimately have "wf ?R" by blast
26.966 - }
26.967 - thus ?thesis by (simp add: trans_wf_iff ordLess_trans)
26.968 -qed
26.969 -
26.970 -corollary exists_minim_Well_order:
26.971 -assumes NE: "R \<noteq> {}" and WELL: "\<forall>r \<in> R. Well_order r"
26.972 -shows "\<exists>r \<in> R. \<forall>r' \<in> R. r \<le>o r'"
26.973 -proof-
26.974 - obtain r where "r \<in> R \<and> (\<forall>r' \<in> R. \<not> r' <o r)"
26.975 - using NE spec[OF spec[OF subst[OF wf_eq_minimal, of "%x. x", OF wf_ordLess]], of _ R]
26.976 - equals0I[of R] by blast
26.977 - with not_ordLeq_iff_ordLess WELL show ?thesis by blast
26.978 -qed
26.979 -
26.980 -
26.981 -
26.982 -subsection {* Copy via direct images *}
26.983 -
26.984 -
26.985 -text{* The direct image operator is the dual of the inverse image operator @{text "inv_image"}
26.986 -from @{text "Relation.thy"}. It is useful for transporting a well-order between
26.987 -different types. *}
26.988 -
26.989 -
26.990 -definition dir_image :: "'a rel \<Rightarrow> ('a \<Rightarrow> 'a') \<Rightarrow> 'a' rel"
26.991 -where
26.992 -"dir_image r f = {(f a, f b)| a b. (a,b) \<in> r}"
26.993 -
26.994 -
26.995 -lemma dir_image_Field:
26.996 -"Field(dir_image r f) \<le> f ` (Field r)"
26.997 -unfolding dir_image_def Field_def by auto
26.998 -
26.999 -
26.1000 -lemma dir_image_minus_Id:
26.1001 -"inj_on f (Field r) \<Longrightarrow> (dir_image r f) - Id = dir_image (r - Id) f"
26.1002 -unfolding inj_on_def Field_def dir_image_def by auto
26.1003 -
26.1004 -
26.1005 -lemma Refl_dir_image:
26.1006 -assumes "Refl r"
26.1007 -shows "Refl(dir_image r f)"
26.1008 -proof-
26.1009 - {fix a' b'
26.1010 - assume "(a',b') \<in> dir_image r f"
26.1011 - then obtain a b where 1: "a' = f a \<and> b' = f b \<and> (a,b) \<in> r"
26.1012 - unfolding dir_image_def by blast
26.1013 - hence "a \<in> Field r \<and> b \<in> Field r" using Field_def by fastforce
26.1014 - hence "(a,a) \<in> r \<and> (b,b) \<in> r" using assms by (simp add: refl_on_def)
26.1015 - with 1 have "(a',a') \<in> dir_image r f \<and> (b',b') \<in> dir_image r f"
26.1016 - unfolding dir_image_def by auto
26.1017 - }
26.1018 - thus ?thesis
26.1019 - by(unfold refl_on_def Field_def Domain_def Range_def, auto)
26.1020 -qed
26.1021 -
26.1022 -
26.1023 -lemma trans_dir_image:
26.1024 -assumes TRANS: "trans r" and INJ: "inj_on f (Field r)"
26.1025 -shows "trans(dir_image r f)"
26.1026 -proof(unfold trans_def, auto)
26.1027 - fix a' b' c'
26.1028 - assume "(a',b') \<in> dir_image r f" "(b',c') \<in> dir_image r f"
26.1029 - then obtain a b1 b2 c where 1: "a' = f a \<and> b' = f b1 \<and> b' = f b2 \<and> c' = f c" and
26.1030 - 2: "(a,b1) \<in> r \<and> (b2,c) \<in> r"
26.1031 - unfolding dir_image_def by blast
26.1032 - hence "b1 \<in> Field r \<and> b2 \<in> Field r"
26.1033 - unfolding Field_def by auto
26.1034 - hence "b1 = b2" using 1 INJ unfolding inj_on_def by auto
26.1035 - hence "(a,c): r" using 2 TRANS unfolding trans_def by blast
26.1036 - thus "(a',c') \<in> dir_image r f"
26.1037 - unfolding dir_image_def using 1 by auto
26.1038 -qed
26.1039 -
26.1040 -
26.1041 -lemma Preorder_dir_image:
26.1042 -"\<lbrakk>Preorder r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> Preorder (dir_image r f)"
26.1043 -by (simp add: preorder_on_def Refl_dir_image trans_dir_image)
26.1044 -
26.1045 -
26.1046 -lemma antisym_dir_image:
26.1047 -assumes AN: "antisym r" and INJ: "inj_on f (Field r)"
26.1048 -shows "antisym(dir_image r f)"
26.1049 -proof(unfold antisym_def, auto)
26.1050 - fix a' b'
26.1051 - assume "(a',b') \<in> dir_image r f" "(b',a') \<in> dir_image r f"
26.1052 - then obtain a1 b1 a2 b2 where 1: "a' = f a1 \<and> a' = f a2 \<and> b' = f b1 \<and> b' = f b2" and
26.1053 - 2: "(a1,b1) \<in> r \<and> (b2,a2) \<in> r " and
26.1054 - 3: "{a1,a2,b1,b2} \<le> Field r"
26.1055 - unfolding dir_image_def Field_def by blast
26.1056 - hence "a1 = a2 \<and> b1 = b2" using INJ unfolding inj_on_def by auto
26.1057 - hence "a1 = b2" using 2 AN unfolding antisym_def by auto
26.1058 - thus "a' = b'" using 1 by auto
26.1059 -qed
26.1060 -
26.1061 -
26.1062 -lemma Partial_order_dir_image:
26.1063 -"\<lbrakk>Partial_order r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> Partial_order (dir_image r f)"
26.1064 -by (simp add: partial_order_on_def Preorder_dir_image antisym_dir_image)
26.1065 -
26.1066 -
26.1067 -lemma Total_dir_image:
26.1068 -assumes TOT: "Total r" and INJ: "inj_on f (Field r)"
26.1069 -shows "Total(dir_image r f)"
26.1070 -proof(unfold total_on_def, intro ballI impI)
26.1071 - fix a' b'
26.1072 - assume "a' \<in> Field (dir_image r f)" "b' \<in> Field (dir_image r f)"
26.1073 - then obtain a and b where 1: "a \<in> Field r \<and> b \<in> Field r \<and> f a = a' \<and> f b = b'"
26.1074 - using dir_image_Field[of r f] by blast
26.1075 - moreover assume "a' \<noteq> b'"
26.1076 - ultimately have "a \<noteq> b" using INJ unfolding inj_on_def by auto
26.1077 - hence "(a,b) \<in> r \<or> (b,a) \<in> r" using 1 TOT unfolding total_on_def by auto
26.1078 - thus "(a',b') \<in> dir_image r f \<or> (b',a') \<in> dir_image r f"
26.1079 - using 1 unfolding dir_image_def by auto
26.1080 -qed
26.1081 -
26.1082 -
26.1083 -lemma Linear_order_dir_image:
26.1084 -"\<lbrakk>Linear_order r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> Linear_order (dir_image r f)"
26.1085 -by (simp add: linear_order_on_def Partial_order_dir_image Total_dir_image)
26.1086 -
26.1087 -
26.1088 -lemma wf_dir_image:
26.1089 -assumes WF: "wf r" and INJ: "inj_on f (Field r)"
26.1090 -shows "wf(dir_image r f)"
26.1091 -proof(unfold wf_eq_minimal2, intro allI impI, elim conjE)
26.1092 - fix A'::"'b set"
26.1093 - assume SUB: "A' \<le> Field(dir_image r f)" and NE: "A' \<noteq> {}"
26.1094 - obtain A where A_def: "A = {a \<in> Field r. f a \<in> A'}" by blast
26.1095 - have "A \<noteq> {} \<and> A \<le> Field r"
26.1096 - using A_def dir_image_Field[of r f] SUB NE by blast
26.1097 - then obtain a where 1: "a \<in> A \<and> (\<forall>b \<in> A. (b,a) \<notin> r)"
26.1098 - using WF unfolding wf_eq_minimal2 by metis
26.1099 - have "\<forall>b' \<in> A'. (b',f a) \<notin> dir_image r f"
26.1100 - proof(clarify)
26.1101 - fix b' assume *: "b' \<in> A'" and **: "(b',f a) \<in> dir_image r f"
26.1102 - obtain b1 a1 where 2: "b' = f b1 \<and> f a = f a1" and
26.1103 - 3: "(b1,a1) \<in> r \<and> {a1,b1} \<le> Field r"
26.1104 - using ** unfolding dir_image_def Field_def by blast
26.1105 - hence "a = a1" using 1 A_def INJ unfolding inj_on_def by auto
26.1106 - hence "b1 \<in> A \<and> (b1,a) \<in> r" using 2 3 A_def * by auto
26.1107 - with 1 show False by auto
26.1108 - qed
26.1109 - thus "\<exists>a'\<in>A'. \<forall>b'\<in>A'. (b', a') \<notin> dir_image r f"
26.1110 - using A_def 1 by blast
26.1111 -qed
26.1112 -
26.1113 -
26.1114 -lemma Well_order_dir_image:
26.1115 -"\<lbrakk>Well_order r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> Well_order (dir_image r f)"
26.1116 -using assms unfolding well_order_on_def
26.1117 -using Linear_order_dir_image[of r f] wf_dir_image[of "r - Id" f]
26.1118 - dir_image_minus_Id[of f r]
26.1119 - subset_inj_on[of f "Field r" "Field(r - Id)"]
26.1120 - mono_Field[of "r - Id" r] by auto
26.1121 -
26.1122 -
26.1123 -lemma dir_image_Field2:
26.1124 -"Refl r \<Longrightarrow> Field(dir_image r f) = f ` (Field r)"
26.1125 -unfolding Field_def dir_image_def refl_on_def Domain_def Range_def by blast
26.1126 -
26.1127 -
26.1128 -lemma dir_image_bij_betw:
26.1129 -"\<lbrakk>Well_order r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> bij_betw f (Field r) (Field (dir_image r f))"
26.1130 -unfolding bij_betw_def
26.1131 -by (simp add: dir_image_Field2 order_on_defs)
26.1132 -
26.1133 -
26.1134 -lemma dir_image_compat:
26.1135 -"compat r (dir_image r f) f"
26.1136 -unfolding compat_def dir_image_def by auto
26.1137 -
26.1138 -
26.1139 -lemma dir_image_iso:
26.1140 -"\<lbrakk>Well_order r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> iso r (dir_image r f) f"
26.1141 -using iso_iff3 dir_image_compat dir_image_bij_betw Well_order_dir_image by blast
26.1142 -
26.1143 -
26.1144 -lemma dir_image_ordIso:
26.1145 -"\<lbrakk>Well_order r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> r =o dir_image r f"
26.1146 -unfolding ordIso_def using dir_image_iso Well_order_dir_image by blast
26.1147 -
26.1148 -
26.1149 -lemma Well_order_iso_copy:
26.1150 -assumes WELL: "well_order_on A r" and BIJ: "bij_betw f A A'"
26.1151 -shows "\<exists>r'. well_order_on A' r' \<and> r =o r'"
26.1152 -proof-
26.1153 - let ?r' = "dir_image r f"
26.1154 - have 1: "A = Field r \<and> Well_order r"
26.1155 - using WELL rel.well_order_on_Well_order by blast
26.1156 - hence 2: "iso r ?r' f"
26.1157 - using dir_image_iso using BIJ unfolding bij_betw_def by auto
26.1158 - hence "f ` (Field r) = Field ?r'" using 1 iso_iff[of r ?r'] by blast
26.1159 - hence "Field ?r' = A'"
26.1160 - using 1 BIJ unfolding bij_betw_def by auto
26.1161 - moreover have "Well_order ?r'"
26.1162 - using 1 Well_order_dir_image BIJ unfolding bij_betw_def by blast
26.1163 - ultimately show ?thesis unfolding ordIso_def using 1 2 by blast
26.1164 -qed
26.1165 -
26.1166 -
26.1167 -
26.1168 -subsection {* Bounded square *}
26.1169 -
26.1170 -
26.1171 -text{* This construction essentially defines, for an order relation @{text "r"}, a lexicographic
26.1172 -order @{text "bsqr r"} on @{text "(Field r) \<times> (Field r)"}, applying the
26.1173 -following criteria (in this order):
26.1174 -\begin{itemize}
26.1175 -\item compare the maximums;
26.1176 -\item compare the first components;
26.1177 -\item compare the second components.
26.1178 -\end{itemize}
26.1179 -%
26.1180 -The only application of this construction that we are aware of is
26.1181 -at proving that the square of an infinite set has the same cardinal
26.1182 -as that set. The essential property required there (and which is ensured by this
26.1183 -construction) is that any proper order filter of the product order is included in a rectangle, i.e.,
26.1184 -in a product of proper filters on the original relation (assumed to be a well-order). *}
26.1185 -
26.1186 -
26.1187 -definition bsqr :: "'a rel => ('a * 'a)rel"
26.1188 -where
26.1189 -"bsqr r = {((a1,a2),(b1,b2)).
26.1190 - {a1,a2,b1,b2} \<le> Field r \<and>
26.1191 - (a1 = b1 \<and> a2 = b2 \<or>
26.1192 - (wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r - Id \<or>
26.1193 - wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> (a1,b1) \<in> r - Id \<or>
26.1194 - wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> a1 = b1 \<and> (a2,b2) \<in> r - Id
26.1195 - )}"
26.1196 -
26.1197 -
26.1198 -lemma Field_bsqr:
26.1199 -"Field (bsqr r) = Field r \<times> Field r"
26.1200 -proof
26.1201 - show "Field (bsqr r) \<le> Field r \<times> Field r"
26.1202 - proof-
26.1203 - {fix a1 a2 assume "(a1,a2) \<in> Field (bsqr r)"
26.1204 - moreover
26.1205 - have "\<And> b1 b2. ((a1,a2),(b1,b2)) \<in> bsqr r \<or> ((b1,b2),(a1,a2)) \<in> bsqr r \<Longrightarrow>
26.1206 - a1 \<in> Field r \<and> a2 \<in> Field r" unfolding bsqr_def by auto
26.1207 - ultimately have "a1 \<in> Field r \<and> a2 \<in> Field r" unfolding Field_def by auto
26.1208 - }
26.1209 - thus ?thesis unfolding Field_def by force
26.1210 - qed
26.1211 -next
26.1212 - show "Field r \<times> Field r \<le> Field (bsqr r)"
26.1213 - proof(auto)
26.1214 - fix a1 a2 assume "a1 \<in> Field r" and "a2 \<in> Field r"
26.1215 - hence "((a1,a2),(a1,a2)) \<in> bsqr r" unfolding bsqr_def by blast
26.1216 - thus "(a1,a2) \<in> Field (bsqr r)" unfolding Field_def by auto
26.1217 - qed
26.1218 -qed
26.1219 -
26.1220 -
26.1221 -lemma bsqr_Refl: "Refl(bsqr r)"
26.1222 -by(unfold refl_on_def Field_bsqr, auto simp add: bsqr_def)
26.1223 -
26.1224 -
26.1225 -lemma bsqr_Trans:
26.1226 -assumes "Well_order r"
26.1227 -shows "trans (bsqr r)"
26.1228 -proof(unfold trans_def, auto)
26.1229 - (* Preliminary facts *)
26.1230 - have Well: "wo_rel r" using assms wo_rel_def by auto
26.1231 - hence Trans: "trans r" using wo_rel.TRANS by auto
26.1232 - have Anti: "antisym r" using wo_rel.ANTISYM Well by auto
26.1233 - hence TransS: "trans(r - Id)" using Trans by (simp add: trans_diff_Id)
26.1234 - (* Main proof *)
26.1235 - fix a1 a2 b1 b2 c1 c2
26.1236 - assume *: "((a1,a2),(b1,b2)) \<in> bsqr r" and **: "((b1,b2),(c1,c2)) \<in> bsqr r"
26.1237 - hence 0: "{a1,a2,b1,b2,c1,c2} \<le> Field r" unfolding bsqr_def by auto
26.1238 - have 1: "a1 = b1 \<and> a2 = b2 \<or> (wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r - Id \<or>
26.1239 - wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> (a1,b1) \<in> r - Id \<or>
26.1240 - wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> a1 = b1 \<and> (a2,b2) \<in> r - Id"
26.1241 - using * unfolding bsqr_def by auto
26.1242 - have 2: "b1 = c1 \<and> b2 = c2 \<or> (wo_rel.max2 r b1 b2, wo_rel.max2 r c1 c2) \<in> r - Id \<or>
26.1243 - wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> (b1,c1) \<in> r - Id \<or>
26.1244 - wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> b1 = c1 \<and> (b2,c2) \<in> r - Id"
26.1245 - using ** unfolding bsqr_def by auto
26.1246 - show "((a1,a2),(c1,c2)) \<in> bsqr r"
26.1247 - proof-
26.1248 - {assume Case1: "a1 = b1 \<and> a2 = b2"
26.1249 - hence ?thesis using ** by simp
26.1250 - }
26.1251 - moreover
26.1252 - {assume Case2: "(wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r - Id"
26.1253 - {assume Case21: "b1 = c1 \<and> b2 = c2"
26.1254 - hence ?thesis using * by simp
26.1255 - }
26.1256 - moreover
26.1257 - {assume Case22: "(wo_rel.max2 r b1 b2, wo_rel.max2 r c1 c2) \<in> r - Id"
26.1258 - hence "(wo_rel.max2 r a1 a2, wo_rel.max2 r c1 c2) \<in> r - Id"
26.1259 - using Case2 TransS trans_def[of "r - Id"] by blast
26.1260 - hence ?thesis using 0 unfolding bsqr_def by auto
26.1261 - }
26.1262 - moreover
26.1263 - {assume Case23_4: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2"
26.1264 - hence ?thesis using Case2 0 unfolding bsqr_def by auto
26.1265 - }
26.1266 - ultimately have ?thesis using 0 2 by auto
26.1267 - }
26.1268 - moreover
26.1269 - {assume Case3: "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> (a1,b1) \<in> r - Id"
26.1270 - {assume Case31: "b1 = c1 \<and> b2 = c2"
26.1271 - hence ?thesis using * by simp
26.1272 - }
26.1273 - moreover
26.1274 - {assume Case32: "(wo_rel.max2 r b1 b2, wo_rel.max2 r c1 c2) \<in> r - Id"
26.1275 - hence ?thesis using Case3 0 unfolding bsqr_def by auto
26.1276 - }
26.1277 - moreover
26.1278 - {assume Case33: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> (b1,c1) \<in> r - Id"
26.1279 - hence "(a1,c1) \<in> r - Id"
26.1280 - using Case3 TransS trans_def[of "r - Id"] by blast
26.1281 - hence ?thesis using Case3 Case33 0 unfolding bsqr_def by auto
26.1282 - }
26.1283 - moreover
26.1284 - {assume Case33: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> b1 = c1"
26.1285 - hence ?thesis using Case3 0 unfolding bsqr_def by auto
26.1286 - }
26.1287 - ultimately have ?thesis using 0 2 by auto
26.1288 - }
26.1289 - moreover
26.1290 - {assume Case4: "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> a1 = b1 \<and> (a2,b2) \<in> r - Id"
26.1291 - {assume Case41: "b1 = c1 \<and> b2 = c2"
26.1292 - hence ?thesis using * by simp
26.1293 - }
26.1294 - moreover
26.1295 - {assume Case42: "(wo_rel.max2 r b1 b2, wo_rel.max2 r c1 c2) \<in> r - Id"
26.1296 - hence ?thesis using Case4 0 unfolding bsqr_def by force
26.1297 - }
26.1298 - moreover
26.1299 - {assume Case43: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> (b1,c1) \<in> r - Id"
26.1300 - hence ?thesis using Case4 0 unfolding bsqr_def by auto
26.1301 - }
26.1302 - moreover
26.1303 - {assume Case44: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> b1 = c1 \<and> (b2,c2) \<in> r - Id"
26.1304 - hence "(a2,c2) \<in> r - Id"
26.1305 - using Case4 TransS trans_def[of "r - Id"] by blast
26.1306 - hence ?thesis using Case4 Case44 0 unfolding bsqr_def by auto
26.1307 - }
26.1308 - ultimately have ?thesis using 0 2 by auto
26.1309 - }
26.1310 - ultimately show ?thesis using 0 1 by auto
26.1311 - qed
26.1312 -qed
26.1313 -
26.1314 -
26.1315 -lemma bsqr_antisym:
26.1316 -assumes "Well_order r"
26.1317 -shows "antisym (bsqr r)"
26.1318 -proof(unfold antisym_def, clarify)
26.1319 - (* Preliminary facts *)
26.1320 - have Well: "wo_rel r" using assms wo_rel_def by auto
26.1321 - hence Trans: "trans r" using wo_rel.TRANS by auto
26.1322 - have Anti: "antisym r" using wo_rel.ANTISYM Well by auto
26.1323 - hence TransS: "trans(r - Id)" using Trans by (simp add: trans_diff_Id)
26.1324 - hence IrrS: "\<forall>a b. \<not>((a,b) \<in> r - Id \<and> (b,a) \<in> r - Id)"
26.1325 - using Anti trans_def[of "r - Id"] antisym_def[of "r - Id"] by blast
26.1326 - (* Main proof *)
26.1327 - fix a1 a2 b1 b2
26.1328 - assume *: "((a1,a2),(b1,b2)) \<in> bsqr r" and **: "((b1,b2),(a1,a2)) \<in> bsqr r"
26.1329 - hence 0: "{a1,a2,b1,b2} \<le> Field r" unfolding bsqr_def by auto
26.1330 - have 1: "a1 = b1 \<and> a2 = b2 \<or> (wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r - Id \<or>
26.1331 - wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> (a1,b1) \<in> r - Id \<or>
26.1332 - wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> a1 = b1 \<and> (a2,b2) \<in> r - Id"
26.1333 - using * unfolding bsqr_def by auto
26.1334 - have 2: "b1 = a1 \<and> b2 = a2 \<or> (wo_rel.max2 r b1 b2, wo_rel.max2 r a1 a2) \<in> r - Id \<or>
26.1335 - wo_rel.max2 r b1 b2 = wo_rel.max2 r a1 a2 \<and> (b1,a1) \<in> r - Id \<or>
26.1336 - wo_rel.max2 r b1 b2 = wo_rel.max2 r a1 a2 \<and> b1 = a1 \<and> (b2,a2) \<in> r - Id"
26.1337 - using ** unfolding bsqr_def by auto
26.1338 - show "a1 = b1 \<and> a2 = b2"
26.1339 - proof-
26.1340 - {assume Case1: "(wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r - Id"
26.1341 - {assume Case11: "(wo_rel.max2 r b1 b2, wo_rel.max2 r a1 a2) \<in> r - Id"
26.1342 - hence False using Case1 IrrS by blast
26.1343 - }
26.1344 - moreover
26.1345 - {assume Case12_3: "wo_rel.max2 r b1 b2 = wo_rel.max2 r a1 a2"
26.1346 - hence False using Case1 by auto
26.1347 - }
26.1348 - ultimately have ?thesis using 0 2 by auto
26.1349 - }
26.1350 - moreover
26.1351 - {assume Case2: "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> (a1,b1) \<in> r - Id"
26.1352 - {assume Case21: "(wo_rel.max2 r b1 b2, wo_rel.max2 r a1 a2) \<in> r - Id"
26.1353 - hence False using Case2 by auto
26.1354 - }
26.1355 - moreover
26.1356 - {assume Case22: "(b1,a1) \<in> r - Id"
26.1357 - hence False using Case2 IrrS by blast
26.1358 - }
26.1359 - moreover
26.1360 - {assume Case23: "b1 = a1"
26.1361 - hence False using Case2 by auto
26.1362 - }
26.1363 - ultimately have ?thesis using 0 2 by auto
26.1364 - }
26.1365 - moreover
26.1366 - {assume Case3: "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> a1 = b1 \<and> (a2,b2) \<in> r - Id"
26.1367 - moreover
26.1368 - {assume Case31: "(wo_rel.max2 r b1 b2, wo_rel.max2 r a1 a2) \<in> r - Id"
26.1369 - hence False using Case3 by auto
26.1370 - }
26.1371 - moreover
26.1372 - {assume Case32: "(b1,a1) \<in> r - Id"
26.1373 - hence False using Case3 by auto
26.1374 - }
26.1375 - moreover
26.1376 - {assume Case33: "(b2,a2) \<in> r - Id"
26.1377 - hence False using Case3 IrrS by blast
26.1378 - }
26.1379 - ultimately have ?thesis using 0 2 by auto
26.1380 - }
26.1381 - ultimately show ?thesis using 0 1 by blast
26.1382 - qed
26.1383 -qed
26.1384 -
26.1385 -
26.1386 -lemma bsqr_Total:
26.1387 -assumes "Well_order r"
26.1388 -shows "Total(bsqr r)"
26.1389 -proof-
26.1390 - (* Preliminary facts *)
26.1391 - have Well: "wo_rel r" using assms wo_rel_def by auto
26.1392 - hence Total: "\<forall>a \<in> Field r. \<forall>b \<in> Field r. (a,b) \<in> r \<or> (b,a) \<in> r"
26.1393 - using wo_rel.TOTALS by auto
26.1394 - (* Main proof *)
26.1395 - {fix a1 a2 b1 b2 assume "{(a1,a2), (b1,b2)} \<le> Field(bsqr r)"
26.1396 - hence 0: "a1 \<in> Field r \<and> a2 \<in> Field r \<and> b1 \<in> Field r \<and> b2 \<in> Field r"
26.1397 - using Field_bsqr by blast
26.1398 - have "((a1,a2) = (b1,b2) \<or> ((a1,a2),(b1,b2)) \<in> bsqr r \<or> ((b1,b2),(a1,a2)) \<in> bsqr r)"
26.1399 - proof(rule wo_rel.cases_Total[of r a1 a2], clarsimp simp add: Well, simp add: 0)
26.1400 - (* Why didn't clarsimp simp add: Well 0 do the same job? *)
26.1401 - assume Case1: "(a1,a2) \<in> r"
26.1402 - hence 1: "wo_rel.max2 r a1 a2 = a2"
26.1403 - using Well 0 by (simp add: wo_rel.max2_equals2)
26.1404 - show ?thesis
26.1405 - proof(rule wo_rel.cases_Total[of r b1 b2], clarsimp simp add: Well, simp add: 0)
26.1406 - assume Case11: "(b1,b2) \<in> r"
26.1407 - hence 2: "wo_rel.max2 r b1 b2 = b2"
26.1408 - using Well 0 by (simp add: wo_rel.max2_equals2)
26.1409 - show ?thesis
26.1410 - proof(rule wo_rel.cases_Total3[of r a2 b2], clarsimp simp add: Well, simp add: 0)
26.1411 - assume Case111: "(a2,b2) \<in> r - Id \<or> (b2,a2) \<in> r - Id"
26.1412 - thus ?thesis using 0 1 2 unfolding bsqr_def by auto
26.1413 - next
26.1414 - assume Case112: "a2 = b2"
26.1415 - show ?thesis
26.1416 - proof(rule wo_rel.cases_Total3[of r a1 b1], clarsimp simp add: Well, simp add: 0)
26.1417 - assume Case1121: "(a1,b1) \<in> r - Id \<or> (b1,a1) \<in> r - Id"
26.1418 - thus ?thesis using 0 1 2 Case112 unfolding bsqr_def by auto
26.1419 - next
26.1420 - assume Case1122: "a1 = b1"
26.1421 - thus ?thesis using Case112 by auto
26.1422 - qed
26.1423 - qed
26.1424 - next
26.1425 - assume Case12: "(b2,b1) \<in> r"
26.1426 - hence 3: "wo_rel.max2 r b1 b2 = b1" using Well 0 by (simp add: wo_rel.max2_equals1)
26.1427 - show ?thesis
26.1428 - proof(rule wo_rel.cases_Total3[of r a2 b1], clarsimp simp add: Well, simp add: 0)
26.1429 - assume Case121: "(a2,b1) \<in> r - Id \<or> (b1,a2) \<in> r - Id"
26.1430 - thus ?thesis using 0 1 3 unfolding bsqr_def by auto
26.1431 - next
26.1432 - assume Case122: "a2 = b1"
26.1433 - show ?thesis
26.1434 - proof(rule wo_rel.cases_Total3[of r a1 b1], clarsimp simp add: Well, simp add: 0)
26.1435 - assume Case1221: "(a1,b1) \<in> r - Id \<or> (b1,a1) \<in> r - Id"
26.1436 - thus ?thesis using 0 1 3 Case122 unfolding bsqr_def by auto
26.1437 - next
26.1438 - assume Case1222: "a1 = b1"
26.1439 - show ?thesis
26.1440 - proof(rule wo_rel.cases_Total3[of r a2 b2], clarsimp simp add: Well, simp add: 0)
26.1441 - assume Case12221: "(a2,b2) \<in> r - Id \<or> (b2,a2) \<in> r - Id"
26.1442 - thus ?thesis using 0 1 3 Case122 Case1222 unfolding bsqr_def by auto
26.1443 - next
26.1444 - assume Case12222: "a2 = b2"
26.1445 - thus ?thesis using Case122 Case1222 by auto
26.1446 - qed
26.1447 - qed
26.1448 - qed
26.1449 - qed
26.1450 - next
26.1451 - assume Case2: "(a2,a1) \<in> r"
26.1452 - hence 1: "wo_rel.max2 r a1 a2 = a1" using Well 0 by (simp add: wo_rel.max2_equals1)
26.1453 - show ?thesis
26.1454 - proof(rule wo_rel.cases_Total[of r b1 b2], clarsimp simp add: Well, simp add: 0)
26.1455 - assume Case21: "(b1,b2) \<in> r"
26.1456 - hence 2: "wo_rel.max2 r b1 b2 = b2" using Well 0 by (simp add: wo_rel.max2_equals2)
26.1457 - show ?thesis
26.1458 - proof(rule wo_rel.cases_Total3[of r a1 b2], clarsimp simp add: Well, simp add: 0)
26.1459 - assume Case211: "(a1,b2) \<in> r - Id \<or> (b2,a1) \<in> r - Id"
26.1460 - thus ?thesis using 0 1 2 unfolding bsqr_def by auto
26.1461 - next
26.1462 - assume Case212: "a1 = b2"
26.1463 - show ?thesis
26.1464 - proof(rule wo_rel.cases_Total3[of r a1 b1], clarsimp simp add: Well, simp add: 0)
26.1465 - assume Case2121: "(a1,b1) \<in> r - Id \<or> (b1,a1) \<in> r - Id"
26.1466 - thus ?thesis using 0 1 2 Case212 unfolding bsqr_def by auto
26.1467 - next
26.1468 - assume Case2122: "a1 = b1"
26.1469 - show ?thesis
26.1470 - proof(rule wo_rel.cases_Total3[of r a2 b2], clarsimp simp add: Well, simp add: 0)
26.1471 - assume Case21221: "(a2,b2) \<in> r - Id \<or> (b2,a2) \<in> r - Id"
26.1472 - thus ?thesis using 0 1 2 Case212 Case2122 unfolding bsqr_def by auto
26.1473 - next
26.1474 - assume Case21222: "a2 = b2"
26.1475 - thus ?thesis using Case2122 Case212 by auto
26.1476 - qed
26.1477 - qed
26.1478 - qed
26.1479 - next
26.1480 - assume Case22: "(b2,b1) \<in> r"
26.1481 - hence 3: "wo_rel.max2 r b1 b2 = b1" using Well 0 by (simp add: wo_rel.max2_equals1)
26.1482 - show ?thesis
26.1483 - proof(rule wo_rel.cases_Total3[of r a1 b1], clarsimp simp add: Well, simp add: 0)
26.1484 - assume Case221: "(a1,b1) \<in> r - Id \<or> (b1,a1) \<in> r - Id"
26.1485 - thus ?thesis using 0 1 3 unfolding bsqr_def by auto
26.1486 - next
26.1487 - assume Case222: "a1 = b1"
26.1488 - show ?thesis
26.1489 - proof(rule wo_rel.cases_Total3[of r a2 b2], clarsimp simp add: Well, simp add: 0)
26.1490 - assume Case2221: "(a2,b2) \<in> r - Id \<or> (b2,a2) \<in> r - Id"
26.1491 - thus ?thesis using 0 1 3 Case222 unfolding bsqr_def by auto
26.1492 - next
26.1493 - assume Case2222: "a2 = b2"
26.1494 - thus ?thesis using Case222 by auto
26.1495 - qed
26.1496 - qed
26.1497 - qed
26.1498 - qed
26.1499 - }
26.1500 - thus ?thesis unfolding total_on_def by fast
26.1501 -qed
26.1502 -
26.1503 -
26.1504 -lemma bsqr_Linear_order:
26.1505 -assumes "Well_order r"
26.1506 -shows "Linear_order(bsqr r)"
26.1507 -unfolding order_on_defs
26.1508 -using assms bsqr_Refl bsqr_Trans bsqr_antisym bsqr_Total by blast
26.1509 -
26.1510 -
26.1511 -lemma bsqr_Well_order:
26.1512 -assumes "Well_order r"
26.1513 -shows "Well_order(bsqr r)"
26.1514 -using assms
26.1515 -proof(simp add: bsqr_Linear_order Linear_order_Well_order_iff, intro allI impI)
26.1516 - have 0: "\<forall>A \<le> Field r. A \<noteq> {} \<longrightarrow> (\<exists>a \<in> A. \<forall>a' \<in> A. (a,a') \<in> r)"
26.1517 - using assms well_order_on_def Linear_order_Well_order_iff by blast
26.1518 - fix D assume *: "D \<le> Field (bsqr r)" and **: "D \<noteq> {}"
26.1519 - hence 1: "D \<le> Field r \<times> Field r" unfolding Field_bsqr by simp
26.1520 - (* *)
26.1521 - obtain M where M_def: "M = {wo_rel.max2 r a1 a2| a1 a2. (a1,a2) \<in> D}" by blast
26.1522 - have "M \<noteq> {}" using 1 M_def ** by auto
26.1523 - moreover
26.1524 - have "M \<le> Field r" unfolding M_def
26.1525 - using 1 assms wo_rel_def[of r] wo_rel.max2_among[of r] by fastforce
26.1526 - ultimately obtain m where m_min: "m \<in> M \<and> (\<forall>a \<in> M. (m,a) \<in> r)"
26.1527 - using 0 by blast
26.1528 - (* *)
26.1529 - obtain A1 where A1_def: "A1 = {a1. \<exists>a2. (a1,a2) \<in> D \<and> wo_rel.max2 r a1 a2 = m}" by blast
26.1530 - have "A1 \<le> Field r" unfolding A1_def using 1 by auto
26.1531 - moreover have "A1 \<noteq> {}" unfolding A1_def using m_min unfolding M_def by blast
26.1532 - ultimately obtain a1 where a1_min: "a1 \<in> A1 \<and> (\<forall>a \<in> A1. (a1,a) \<in> r)"
26.1533 - using 0 by blast
26.1534 - (* *)
26.1535 - obtain A2 where A2_def: "A2 = {a2. (a1,a2) \<in> D \<and> wo_rel.max2 r a1 a2 = m}" by blast
26.1536 - have "A2 \<le> Field r" unfolding A2_def using 1 by auto
26.1537 - moreover have "A2 \<noteq> {}" unfolding A2_def
26.1538 - using m_min a1_min unfolding A1_def M_def by blast
26.1539 - ultimately obtain a2 where a2_min: "a2 \<in> A2 \<and> (\<forall>a \<in> A2. (a2,a) \<in> r)"
26.1540 - using 0 by blast
26.1541 - (* *)
26.1542 - have 2: "wo_rel.max2 r a1 a2 = m"
26.1543 - using a1_min a2_min unfolding A1_def A2_def by auto
26.1544 - have 3: "(a1,a2) \<in> D" using a2_min unfolding A2_def by auto
26.1545 - (* *)
26.1546 - moreover
26.1547 - {fix b1 b2 assume ***: "(b1,b2) \<in> D"
26.1548 - hence 4: "{a1,a2,b1,b2} \<le> Field r" using 1 3 by blast
26.1549 - have 5: "(wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r"
26.1550 - using *** a1_min a2_min m_min unfolding A1_def A2_def M_def by auto
26.1551 - have "((a1,a2),(b1,b2)) \<in> bsqr r"
26.1552 - proof(cases "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2")
26.1553 - assume Case1: "wo_rel.max2 r a1 a2 \<noteq> wo_rel.max2 r b1 b2"
26.1554 - thus ?thesis unfolding bsqr_def using 4 5 by auto
26.1555 - next
26.1556 - assume Case2: "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2"
26.1557 - hence "b1 \<in> A1" unfolding A1_def using 2 *** by auto
26.1558 - hence 6: "(a1,b1) \<in> r" using a1_min by auto
26.1559 - show ?thesis
26.1560 - proof(cases "a1 = b1")
26.1561 - assume Case21: "a1 \<noteq> b1"
26.1562 - thus ?thesis unfolding bsqr_def using 4 Case2 6 by auto
26.1563 - next
26.1564 - assume Case22: "a1 = b1"
26.1565 - hence "b2 \<in> A2" unfolding A2_def using 2 *** Case2 by auto
26.1566 - hence 7: "(a2,b2) \<in> r" using a2_min by auto
26.1567 - thus ?thesis unfolding bsqr_def using 4 7 Case2 Case22 by auto
26.1568 - qed
26.1569 - qed
26.1570 - }
26.1571 - (* *)
26.1572 - ultimately show "\<exists>d \<in> D. \<forall>d' \<in> D. (d,d') \<in> bsqr r" by fastforce
26.1573 -qed
26.1574 -
26.1575 -
26.1576 -lemma bsqr_max2:
26.1577 -assumes WELL: "Well_order r" and LEQ: "((a1,a2),(b1,b2)) \<in> bsqr r"
26.1578 -shows "(wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r"
26.1579 -proof-
26.1580 - have "{(a1,a2),(b1,b2)} \<le> Field(bsqr r)"
26.1581 - using LEQ unfolding Field_def by auto
26.1582 - hence "{a1,a2,b1,b2} \<le> Field r" unfolding Field_bsqr by auto
26.1583 - hence "{wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2} \<le> Field r"
26.1584 - using WELL wo_rel_def[of r] wo_rel.max2_among[of r] by fastforce
26.1585 - moreover have "(wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r \<or> wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2"
26.1586 - using LEQ unfolding bsqr_def by auto
26.1587 - ultimately show ?thesis using WELL unfolding order_on_defs refl_on_def by auto
26.1588 -qed
26.1589 -
26.1590 -
26.1591 -lemma bsqr_ofilter:
26.1592 -assumes WELL: "Well_order r" and
26.1593 - OF: "wo_rel.ofilter (bsqr r) D" and SUB: "D < Field r \<times> Field r" and
26.1594 - NE: "\<not> (\<exists>a. Field r = rel.under r a)"
26.1595 -shows "\<exists>A. wo_rel.ofilter r A \<and> A < Field r \<and> D \<le> A \<times> A"
26.1596 -proof-
26.1597 - let ?r' = "bsqr r"
26.1598 - have Well: "wo_rel r" using WELL wo_rel_def by blast
26.1599 - hence Trans: "trans r" using wo_rel.TRANS by blast
26.1600 - have Well': "Well_order ?r' \<and> wo_rel ?r'"
26.1601 - using WELL bsqr_Well_order wo_rel_def by blast
26.1602 - (* *)
26.1603 - have "D < Field ?r'" unfolding Field_bsqr using SUB .
26.1604 - with OF obtain a1 and a2 where
26.1605 - "(a1,a2) \<in> Field ?r'" and 1: "D = rel.underS ?r' (a1,a2)"
26.1606 - using Well' wo_rel.ofilter_underS_Field[of ?r' D] by auto
26.1607 - hence 2: "{a1,a2} \<le> Field r" unfolding Field_bsqr by auto
26.1608 - let ?m = "wo_rel.max2 r a1 a2"
26.1609 - have "D \<le> (rel.under r ?m) \<times> (rel.under r ?m)"
26.1610 - proof(unfold 1)
26.1611 - {fix b1 b2
26.1612 - let ?n = "wo_rel.max2 r b1 b2"
26.1613 - assume "(b1,b2) \<in> rel.underS ?r' (a1,a2)"
26.1614 - hence 3: "((b1,b2),(a1,a2)) \<in> ?r'"
26.1615 - unfolding rel.underS_def by blast
26.1616 - hence "(?n,?m) \<in> r" using WELL by (simp add: bsqr_max2)
26.1617 - moreover
26.1618 - {have "(b1,b2) \<in> Field ?r'" using 3 unfolding Field_def by auto
26.1619 - hence "{b1,b2} \<le> Field r" unfolding Field_bsqr by auto
26.1620 - hence "(b1,?n) \<in> r \<and> (b2,?n) \<in> r"
26.1621 - using Well by (simp add: wo_rel.max2_greater)
26.1622 - }
26.1623 - ultimately have "(b1,?m) \<in> r \<and> (b2,?m) \<in> r"
26.1624 - using Trans trans_def[of r] by blast
26.1625 - hence "(b1,b2) \<in> (rel.under r ?m) \<times> (rel.under r ?m)" unfolding rel.under_def by simp}
26.1626 - thus "rel.underS ?r' (a1,a2) \<le> (rel.under r ?m) \<times> (rel.under r ?m)" by auto
26.1627 - qed
26.1628 - moreover have "wo_rel.ofilter r (rel.under r ?m)"
26.1629 - using Well by (simp add: wo_rel.under_ofilter)
26.1630 - moreover have "rel.under r ?m < Field r"
26.1631 - using NE rel.under_Field[of r ?m] by blast
26.1632 - ultimately show ?thesis by blast
26.1633 -qed
26.1634 -
26.1635 -
26.1636 -end
27.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
27.2 +++ b/src/HOL/Cardinals/Constructions_on_Wellorders_FP.thy Tue Nov 19 17:07:52 2013 +0100
27.3 @@ -0,0 +1,1621 @@
27.4 +(* Title: HOL/Cardinals/Constructions_on_Wellorders_FP.thy
27.5 + Author: Andrei Popescu, TU Muenchen
27.6 + Copyright 2012
27.7 +
27.8 +Constructions on wellorders (FP).
27.9 +*)
27.10 +
27.11 +header {* Constructions on Wellorders (FP) *}
27.12 +
27.13 +theory Constructions_on_Wellorders_FP
27.14 +imports Wellorder_Embedding_FP
27.15 +begin
27.16 +
27.17 +
27.18 +text {* In this section, we study basic constructions on well-orders, such as restriction to
27.19 +a set/order filter, copy via direct images, ordinal-like sum of disjoint well-orders,
27.20 +and bounded square. We also define between well-orders
27.21 +the relations @{text "ordLeq"}, of being embedded (abbreviated @{text "\<le>o"}),
27.22 +@{text "ordLess"}, of being strictly embedded (abbreviated @{text "<o"}), and
27.23 +@{text "ordIso"}, of being isomorphic (abbreviated @{text "=o"}). We study the
27.24 +connections between these relations, order filters, and the aforementioned constructions.
27.25 +A main result of this section is that @{text "<o"} is well-founded. *}
27.26 +
27.27 +
27.28 +subsection {* Restriction to a set *}
27.29 +
27.30 +
27.31 +abbreviation Restr :: "'a rel \<Rightarrow> 'a set \<Rightarrow> 'a rel"
27.32 +where "Restr r A \<equiv> r Int (A \<times> A)"
27.33 +
27.34 +
27.35 +lemma Restr_subset:
27.36 +"A \<le> B \<Longrightarrow> Restr (Restr r B) A = Restr r A"
27.37 +by blast
27.38 +
27.39 +
27.40 +lemma Restr_Field: "Restr r (Field r) = r"
27.41 +unfolding Field_def by auto
27.42 +
27.43 +
27.44 +lemma Refl_Restr: "Refl r \<Longrightarrow> Refl(Restr r A)"
27.45 +unfolding refl_on_def Field_def by auto
27.46 +
27.47 +
27.48 +lemma antisym_Restr:
27.49 +"antisym r \<Longrightarrow> antisym(Restr r A)"
27.50 +unfolding antisym_def Field_def by auto
27.51 +
27.52 +
27.53 +lemma Total_Restr:
27.54 +"Total r \<Longrightarrow> Total(Restr r A)"
27.55 +unfolding total_on_def Field_def by auto
27.56 +
27.57 +
27.58 +lemma trans_Restr:
27.59 +"trans r \<Longrightarrow> trans(Restr r A)"
27.60 +unfolding trans_def Field_def by blast
27.61 +
27.62 +
27.63 +lemma Preorder_Restr:
27.64 +"Preorder r \<Longrightarrow> Preorder(Restr r A)"
27.65 +unfolding preorder_on_def by (simp add: Refl_Restr trans_Restr)
27.66 +
27.67 +
27.68 +lemma Partial_order_Restr:
27.69 +"Partial_order r \<Longrightarrow> Partial_order(Restr r A)"
27.70 +unfolding partial_order_on_def by (simp add: Preorder_Restr antisym_Restr)
27.71 +
27.72 +
27.73 +lemma Linear_order_Restr:
27.74 +"Linear_order r \<Longrightarrow> Linear_order(Restr r A)"
27.75 +unfolding linear_order_on_def by (simp add: Partial_order_Restr Total_Restr)
27.76 +
27.77 +
27.78 +lemma Well_order_Restr:
27.79 +assumes "Well_order r"
27.80 +shows "Well_order(Restr r A)"
27.81 +proof-
27.82 + have "Restr r A - Id \<le> r - Id" using Restr_subset by blast
27.83 + hence "wf(Restr r A - Id)" using assms
27.84 + using well_order_on_def wf_subset by blast
27.85 + thus ?thesis using assms unfolding well_order_on_def
27.86 + by (simp add: Linear_order_Restr)
27.87 +qed
27.88 +
27.89 +
27.90 +lemma Field_Restr_subset: "Field(Restr r A) \<le> A"
27.91 +by (auto simp add: Field_def)
27.92 +
27.93 +
27.94 +lemma Refl_Field_Restr:
27.95 +"Refl r \<Longrightarrow> Field(Restr r A) = (Field r) Int A"
27.96 +unfolding refl_on_def Field_def by blast
27.97 +
27.98 +
27.99 +lemma Refl_Field_Restr2:
27.100 +"\<lbrakk>Refl r; A \<le> Field r\<rbrakk> \<Longrightarrow> Field(Restr r A) = A"
27.101 +by (auto simp add: Refl_Field_Restr)
27.102 +
27.103 +
27.104 +lemma well_order_on_Restr:
27.105 +assumes WELL: "Well_order r" and SUB: "A \<le> Field r"
27.106 +shows "well_order_on A (Restr r A)"
27.107 +using assms
27.108 +using Well_order_Restr[of r A] Refl_Field_Restr2[of r A]
27.109 + order_on_defs[of "Field r" r] by auto
27.110 +
27.111 +
27.112 +subsection {* Order filters versus restrictions and embeddings *}
27.113 +
27.114 +
27.115 +lemma Field_Restr_ofilter:
27.116 +"\<lbrakk>Well_order r; wo_rel.ofilter r A\<rbrakk> \<Longrightarrow> Field(Restr r A) = A"
27.117 +by (auto simp add: wo_rel_def wo_rel.ofilter_def wo_rel.REFL Refl_Field_Restr2)
27.118 +
27.119 +
27.120 +lemma ofilter_Restr_under:
27.121 +assumes WELL: "Well_order r" and OF: "wo_rel.ofilter r A" and IN: "a \<in> A"
27.122 +shows "rel.under (Restr r A) a = rel.under r a"
27.123 +using assms wo_rel_def
27.124 +proof(auto simp add: wo_rel.ofilter_def rel.under_def)
27.125 + fix b assume *: "a \<in> A" and "(b,a) \<in> r"
27.126 + hence "b \<in> rel.under r a \<and> a \<in> Field r"
27.127 + unfolding rel.under_def using Field_def by fastforce
27.128 + thus "b \<in> A" using * assms by (auto simp add: wo_rel_def wo_rel.ofilter_def)
27.129 +qed
27.130 +
27.131 +
27.132 +lemma ofilter_embed:
27.133 +assumes "Well_order r"
27.134 +shows "wo_rel.ofilter r A = (A \<le> Field r \<and> embed (Restr r A) r id)"
27.135 +proof
27.136 + assume *: "wo_rel.ofilter r A"
27.137 + show "A \<le> Field r \<and> embed (Restr r A) r id"
27.138 + proof(unfold embed_def, auto)
27.139 + fix a assume "a \<in> A" thus "a \<in> Field r" using assms *
27.140 + by (auto simp add: wo_rel_def wo_rel.ofilter_def)
27.141 + next
27.142 + fix a assume "a \<in> Field (Restr r A)"
27.143 + thus "bij_betw id (rel.under (Restr r A) a) (rel.under r a)" using assms *
27.144 + by (simp add: ofilter_Restr_under Field_Restr_ofilter)
27.145 + qed
27.146 +next
27.147 + assume *: "A \<le> Field r \<and> embed (Restr r A) r id"
27.148 + hence "Field(Restr r A) \<le> Field r"
27.149 + using assms embed_Field[of "Restr r A" r id] id_def
27.150 + Well_order_Restr[of r] by auto
27.151 + {fix a assume "a \<in> A"
27.152 + hence "a \<in> Field(Restr r A)" using * assms
27.153 + by (simp add: order_on_defs Refl_Field_Restr2)
27.154 + hence "bij_betw id (rel.under (Restr r A) a) (rel.under r a)"
27.155 + using * unfolding embed_def by auto
27.156 + hence "rel.under r a \<le> rel.under (Restr r A) a"
27.157 + unfolding bij_betw_def by auto
27.158 + also have "\<dots> \<le> Field(Restr r A)" by (simp add: rel.under_Field)
27.159 + also have "\<dots> \<le> A" by (simp add: Field_Restr_subset)
27.160 + finally have "rel.under r a \<le> A" .
27.161 + }
27.162 + thus "wo_rel.ofilter r A" using assms * by (simp add: wo_rel_def wo_rel.ofilter_def)
27.163 +qed
27.164 +
27.165 +
27.166 +lemma ofilter_Restr_Int:
27.167 +assumes WELL: "Well_order r" and OFA: "wo_rel.ofilter r A"
27.168 +shows "wo_rel.ofilter (Restr r B) (A Int B)"
27.169 +proof-
27.170 + let ?rB = "Restr r B"
27.171 + have Well: "wo_rel r" unfolding wo_rel_def using WELL .
27.172 + hence Refl: "Refl r" by (simp add: wo_rel.REFL)
27.173 + hence Field: "Field ?rB = Field r Int B"
27.174 + using Refl_Field_Restr by blast
27.175 + have WellB: "wo_rel ?rB \<and> Well_order ?rB" using WELL
27.176 + by (simp add: Well_order_Restr wo_rel_def)
27.177 + (* Main proof *)
27.178 + show ?thesis using WellB assms
27.179 + proof(auto simp add: wo_rel.ofilter_def rel.under_def)
27.180 + fix a assume "a \<in> A" and *: "a \<in> B"
27.181 + hence "a \<in> Field r" using OFA Well by (auto simp add: wo_rel.ofilter_def)
27.182 + with * show "a \<in> Field ?rB" using Field by auto
27.183 + next
27.184 + fix a b assume "a \<in> A" and "(b,a) \<in> r"
27.185 + thus "b \<in> A" using Well OFA by (auto simp add: wo_rel.ofilter_def rel.under_def)
27.186 + qed
27.187 +qed
27.188 +
27.189 +
27.190 +lemma ofilter_Restr_subset:
27.191 +assumes WELL: "Well_order r" and OFA: "wo_rel.ofilter r A" and SUB: "A \<le> B"
27.192 +shows "wo_rel.ofilter (Restr r B) A"
27.193 +proof-
27.194 + have "A Int B = A" using SUB by blast
27.195 + thus ?thesis using assms ofilter_Restr_Int[of r A B] by auto
27.196 +qed
27.197 +
27.198 +
27.199 +lemma ofilter_subset_embed:
27.200 +assumes WELL: "Well_order r" and
27.201 + OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
27.202 +shows "(A \<le> B) = (embed (Restr r A) (Restr r B) id)"
27.203 +proof-
27.204 + let ?rA = "Restr r A" let ?rB = "Restr r B"
27.205 + have Well: "wo_rel r" unfolding wo_rel_def using WELL .
27.206 + hence Refl: "Refl r" by (simp add: wo_rel.REFL)
27.207 + hence FieldA: "Field ?rA = Field r Int A"
27.208 + using Refl_Field_Restr by blast
27.209 + have FieldB: "Field ?rB = Field r Int B"
27.210 + using Refl Refl_Field_Restr by blast
27.211 + have WellA: "wo_rel ?rA \<and> Well_order ?rA" using WELL
27.212 + by (simp add: Well_order_Restr wo_rel_def)
27.213 + have WellB: "wo_rel ?rB \<and> Well_order ?rB" using WELL
27.214 + by (simp add: Well_order_Restr wo_rel_def)
27.215 + (* Main proof *)
27.216 + show ?thesis
27.217 + proof
27.218 + assume *: "A \<le> B"
27.219 + hence "wo_rel.ofilter (Restr r B) A" using assms
27.220 + by (simp add: ofilter_Restr_subset)
27.221 + hence "embed (Restr ?rB A) (Restr r B) id"
27.222 + using WellB ofilter_embed[of "?rB" A] by auto
27.223 + thus "embed (Restr r A) (Restr r B) id"
27.224 + using * by (simp add: Restr_subset)
27.225 + next
27.226 + assume *: "embed (Restr r A) (Restr r B) id"
27.227 + {fix a assume **: "a \<in> A"
27.228 + hence "a \<in> Field r" using Well OFA by (auto simp add: wo_rel.ofilter_def)
27.229 + with ** FieldA have "a \<in> Field ?rA" by auto
27.230 + hence "a \<in> Field ?rB" using * WellA embed_Field[of ?rA ?rB id] by auto
27.231 + hence "a \<in> B" using FieldB by auto
27.232 + }
27.233 + thus "A \<le> B" by blast
27.234 + qed
27.235 +qed
27.236 +
27.237 +
27.238 +lemma ofilter_subset_embedS_iso:
27.239 +assumes WELL: "Well_order r" and
27.240 + OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
27.241 +shows "((A < B) = (embedS (Restr r A) (Restr r B) id)) \<and>
27.242 + ((A = B) = (iso (Restr r A) (Restr r B) id))"
27.243 +proof-
27.244 + let ?rA = "Restr r A" let ?rB = "Restr r B"
27.245 + have Well: "wo_rel r" unfolding wo_rel_def using WELL .
27.246 + hence Refl: "Refl r" by (simp add: wo_rel.REFL)
27.247 + hence "Field ?rA = Field r Int A"
27.248 + using Refl_Field_Restr by blast
27.249 + hence FieldA: "Field ?rA = A" using OFA Well
27.250 + by (auto simp add: wo_rel.ofilter_def)
27.251 + have "Field ?rB = Field r Int B"
27.252 + using Refl Refl_Field_Restr by blast
27.253 + hence FieldB: "Field ?rB = B" using OFB Well
27.254 + by (auto simp add: wo_rel.ofilter_def)
27.255 + (* Main proof *)
27.256 + show ?thesis unfolding embedS_def iso_def
27.257 + using assms ofilter_subset_embed[of r A B]
27.258 + FieldA FieldB bij_betw_id_iff[of A B] by auto
27.259 +qed
27.260 +
27.261 +
27.262 +lemma ofilter_subset_embedS:
27.263 +assumes WELL: "Well_order r" and
27.264 + OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
27.265 +shows "(A < B) = embedS (Restr r A) (Restr r B) id"
27.266 +using assms by (simp add: ofilter_subset_embedS_iso)
27.267 +
27.268 +
27.269 +lemma embed_implies_iso_Restr:
27.270 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and
27.271 + EMB: "embed r' r f"
27.272 +shows "iso r' (Restr r (f ` (Field r'))) f"
27.273 +proof-
27.274 + let ?A' = "Field r'"
27.275 + let ?r'' = "Restr r (f ` ?A')"
27.276 + have 0: "Well_order ?r''" using WELL Well_order_Restr by blast
27.277 + have 1: "wo_rel.ofilter r (f ` ?A')" using assms embed_Field_ofilter by blast
27.278 + hence "Field ?r'' = f ` (Field r')" using WELL Field_Restr_ofilter by blast
27.279 + hence "bij_betw f ?A' (Field ?r'')"
27.280 + using EMB embed_inj_on WELL' unfolding bij_betw_def by blast
27.281 + moreover
27.282 + {have "\<forall>a b. (a,b) \<in> r' \<longrightarrow> a \<in> Field r' \<and> b \<in> Field r'"
27.283 + unfolding Field_def by auto
27.284 + hence "compat r' ?r'' f"
27.285 + using assms embed_iff_compat_inj_on_ofilter
27.286 + unfolding compat_def by blast
27.287 + }
27.288 + ultimately show ?thesis using WELL' 0 iso_iff3 by blast
27.289 +qed
27.290 +
27.291 +
27.292 +subsection {* The strict inclusion on proper ofilters is well-founded *}
27.293 +
27.294 +
27.295 +definition ofilterIncl :: "'a rel \<Rightarrow> 'a set rel"
27.296 +where
27.297 +"ofilterIncl r \<equiv> {(A,B). wo_rel.ofilter r A \<and> A \<noteq> Field r \<and>
27.298 + wo_rel.ofilter r B \<and> B \<noteq> Field r \<and> A < B}"
27.299 +
27.300 +
27.301 +lemma wf_ofilterIncl:
27.302 +assumes WELL: "Well_order r"
27.303 +shows "wf(ofilterIncl r)"
27.304 +proof-
27.305 + have Well: "wo_rel r" using WELL by (simp add: wo_rel_def)
27.306 + hence Lo: "Linear_order r" by (simp add: wo_rel.LIN)
27.307 + let ?h = "(\<lambda> A. wo_rel.suc r A)"
27.308 + let ?rS = "r - Id"
27.309 + have "wf ?rS" using WELL by (simp add: order_on_defs)
27.310 + moreover
27.311 + have "compat (ofilterIncl r) ?rS ?h"
27.312 + proof(unfold compat_def ofilterIncl_def,
27.313 + intro allI impI, simp, elim conjE)
27.314 + fix A B
27.315 + assume *: "wo_rel.ofilter r A" "A \<noteq> Field r" and
27.316 + **: "wo_rel.ofilter r B" "B \<noteq> Field r" and ***: "A < B"
27.317 + then obtain a and b where 0: "a \<in> Field r \<and> b \<in> Field r" and
27.318 + 1: "A = rel.underS r a \<and> B = rel.underS r b"
27.319 + using Well by (auto simp add: wo_rel.ofilter_underS_Field)
27.320 + hence "a \<noteq> b" using *** by auto
27.321 + moreover
27.322 + have "(a,b) \<in> r" using 0 1 Lo ***
27.323 + by (auto simp add: rel.underS_incl_iff)
27.324 + moreover
27.325 + have "a = wo_rel.suc r A \<and> b = wo_rel.suc r B"
27.326 + using Well 0 1 by (simp add: wo_rel.suc_underS)
27.327 + ultimately
27.328 + show "(wo_rel.suc r A, wo_rel.suc r B) \<in> r \<and> wo_rel.suc r A \<noteq> wo_rel.suc r B"
27.329 + by simp
27.330 + qed
27.331 + ultimately show "wf (ofilterIncl r)" by (simp add: compat_wf)
27.332 +qed
27.333 +
27.334 +
27.335 +
27.336 +subsection {* Ordering the well-orders by existence of embeddings *}
27.337 +
27.338 +
27.339 +text {* We define three relations between well-orders:
27.340 +\begin{itemize}
27.341 +\item @{text "ordLeq"}, of being embedded (abbreviated @{text "\<le>o"});
27.342 +\item @{text "ordLess"}, of being strictly embedded (abbreviated @{text "<o"});
27.343 +\item @{text "ordIso"}, of being isomorphic (abbreviated @{text "=o"}).
27.344 +\end{itemize}
27.345 +%
27.346 +The prefix "ord" and the index "o" in these names stand for "ordinal-like".
27.347 +These relations shall be proved to be inter-connected in a similar fashion as the trio
27.348 +@{text "\<le>"}, @{text "<"}, @{text "="} associated to a total order on a set.
27.349 +*}
27.350 +
27.351 +
27.352 +definition ordLeq :: "('a rel * 'a' rel) set"
27.353 +where
27.354 +"ordLeq = {(r,r'). Well_order r \<and> Well_order r' \<and> (\<exists>f. embed r r' f)}"
27.355 +
27.356 +
27.357 +abbreviation ordLeq2 :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> bool" (infix "<=o" 50)
27.358 +where "r <=o r' \<equiv> (r,r') \<in> ordLeq"
27.359 +
27.360 +
27.361 +abbreviation ordLeq3 :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> bool" (infix "\<le>o" 50)
27.362 +where "r \<le>o r' \<equiv> r <=o r'"
27.363 +
27.364 +
27.365 +definition ordLess :: "('a rel * 'a' rel) set"
27.366 +where
27.367 +"ordLess = {(r,r'). Well_order r \<and> Well_order r' \<and> (\<exists>f. embedS r r' f)}"
27.368 +
27.369 +abbreviation ordLess2 :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> bool" (infix "<o" 50)
27.370 +where "r <o r' \<equiv> (r,r') \<in> ordLess"
27.371 +
27.372 +
27.373 +definition ordIso :: "('a rel * 'a' rel) set"
27.374 +where
27.375 +"ordIso = {(r,r'). Well_order r \<and> Well_order r' \<and> (\<exists>f. iso r r' f)}"
27.376 +
27.377 +abbreviation ordIso2 :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> bool" (infix "=o" 50)
27.378 +where "r =o r' \<equiv> (r,r') \<in> ordIso"
27.379 +
27.380 +
27.381 +lemmas ordRels_def = ordLeq_def ordLess_def ordIso_def
27.382 +
27.383 +lemma ordLeq_Well_order_simp:
27.384 +assumes "r \<le>o r'"
27.385 +shows "Well_order r \<and> Well_order r'"
27.386 +using assms unfolding ordLeq_def by simp
27.387 +
27.388 +
27.389 +text{* Notice that the relations @{text "\<le>o"}, @{text "<o"}, @{text "=o"} connect well-orders
27.390 +on potentially {\em distinct} types. However, some of the lemmas below, including the next one,
27.391 +restrict implicitly the type of these relations to @{text "(('a rel) * ('a rel)) set"} , i.e.,
27.392 +to @{text "'a rel rel"}. *}
27.393 +
27.394 +
27.395 +lemma ordLeq_reflexive:
27.396 +"Well_order r \<Longrightarrow> r \<le>o r"
27.397 +unfolding ordLeq_def using id_embed[of r] by blast
27.398 +
27.399 +
27.400 +lemma ordLeq_transitive[trans]:
27.401 +assumes *: "r \<le>o r'" and **: "r' \<le>o r''"
27.402 +shows "r \<le>o r''"
27.403 +proof-
27.404 + obtain f and f'
27.405 + where 1: "Well_order r \<and> Well_order r' \<and> Well_order r''" and
27.406 + "embed r r' f" and "embed r' r'' f'"
27.407 + using * ** unfolding ordLeq_def by blast
27.408 + hence "embed r r'' (f' o f)"
27.409 + using comp_embed[of r r' f r'' f'] by auto
27.410 + thus "r \<le>o r''" unfolding ordLeq_def using 1 by auto
27.411 +qed
27.412 +
27.413 +
27.414 +lemma ordLeq_total:
27.415 +"\<lbrakk>Well_order r; Well_order r'\<rbrakk> \<Longrightarrow> r \<le>o r' \<or> r' \<le>o r"
27.416 +unfolding ordLeq_def using wellorders_totally_ordered by blast
27.417 +
27.418 +
27.419 +lemma ordIso_reflexive:
27.420 +"Well_order r \<Longrightarrow> r =o r"
27.421 +unfolding ordIso_def using id_iso[of r] by blast
27.422 +
27.423 +
27.424 +lemma ordIso_transitive[trans]:
27.425 +assumes *: "r =o r'" and **: "r' =o r''"
27.426 +shows "r =o r''"
27.427 +proof-
27.428 + obtain f and f'
27.429 + where 1: "Well_order r \<and> Well_order r' \<and> Well_order r''" and
27.430 + "iso r r' f" and 3: "iso r' r'' f'"
27.431 + using * ** unfolding ordIso_def by auto
27.432 + hence "iso r r'' (f' o f)"
27.433 + using comp_iso[of r r' f r'' f'] by auto
27.434 + thus "r =o r''" unfolding ordIso_def using 1 by auto
27.435 +qed
27.436 +
27.437 +
27.438 +lemma ordIso_symmetric:
27.439 +assumes *: "r =o r'"
27.440 +shows "r' =o r"
27.441 +proof-
27.442 + obtain f where 1: "Well_order r \<and> Well_order r'" and
27.443 + 2: "embed r r' f \<and> bij_betw f (Field r) (Field r')"
27.444 + using * by (auto simp add: ordIso_def iso_def)
27.445 + let ?f' = "inv_into (Field r) f"
27.446 + have "embed r' r ?f' \<and> bij_betw ?f' (Field r') (Field r)"
27.447 + using 1 2 by (simp add: bij_betw_inv_into inv_into_Field_embed_bij_betw)
27.448 + thus "r' =o r" unfolding ordIso_def using 1 by (auto simp add: iso_def)
27.449 +qed
27.450 +
27.451 +
27.452 +lemma ordLeq_ordLess_trans[trans]:
27.453 +assumes "r \<le>o r'" and " r' <o r''"
27.454 +shows "r <o r''"
27.455 +proof-
27.456 + have "Well_order r \<and> Well_order r''"
27.457 + using assms unfolding ordLeq_def ordLess_def by auto
27.458 + thus ?thesis using assms unfolding ordLeq_def ordLess_def
27.459 + using embed_comp_embedS by blast
27.460 +qed
27.461 +
27.462 +
27.463 +lemma ordLess_ordLeq_trans[trans]:
27.464 +assumes "r <o r'" and " r' \<le>o r''"
27.465 +shows "r <o r''"
27.466 +proof-
27.467 + have "Well_order r \<and> Well_order r''"
27.468 + using assms unfolding ordLeq_def ordLess_def by auto
27.469 + thus ?thesis using assms unfolding ordLeq_def ordLess_def
27.470 + using embedS_comp_embed by blast
27.471 +qed
27.472 +
27.473 +
27.474 +lemma ordLeq_ordIso_trans[trans]:
27.475 +assumes "r \<le>o r'" and " r' =o r''"
27.476 +shows "r \<le>o r''"
27.477 +proof-
27.478 + have "Well_order r \<and> Well_order r''"
27.479 + using assms unfolding ordLeq_def ordIso_def by auto
27.480 + thus ?thesis using assms unfolding ordLeq_def ordIso_def
27.481 + using embed_comp_iso by blast
27.482 +qed
27.483 +
27.484 +
27.485 +lemma ordIso_ordLeq_trans[trans]:
27.486 +assumes "r =o r'" and " r' \<le>o r''"
27.487 +shows "r \<le>o r''"
27.488 +proof-
27.489 + have "Well_order r \<and> Well_order r''"
27.490 + using assms unfolding ordLeq_def ordIso_def by auto
27.491 + thus ?thesis using assms unfolding ordLeq_def ordIso_def
27.492 + using iso_comp_embed by blast
27.493 +qed
27.494 +
27.495 +
27.496 +lemma ordLess_ordIso_trans[trans]:
27.497 +assumes "r <o r'" and " r' =o r''"
27.498 +shows "r <o r''"
27.499 +proof-
27.500 + have "Well_order r \<and> Well_order r''"
27.501 + using assms unfolding ordLess_def ordIso_def by auto
27.502 + thus ?thesis using assms unfolding ordLess_def ordIso_def
27.503 + using embedS_comp_iso by blast
27.504 +qed
27.505 +
27.506 +
27.507 +lemma ordIso_ordLess_trans[trans]:
27.508 +assumes "r =o r'" and " r' <o r''"
27.509 +shows "r <o r''"
27.510 +proof-
27.511 + have "Well_order r \<and> Well_order r''"
27.512 + using assms unfolding ordLess_def ordIso_def by auto
27.513 + thus ?thesis using assms unfolding ordLess_def ordIso_def
27.514 + using iso_comp_embedS by blast
27.515 +qed
27.516 +
27.517 +
27.518 +lemma ordLess_not_embed:
27.519 +assumes "r <o r'"
27.520 +shows "\<not>(\<exists>f'. embed r' r f')"
27.521 +proof-
27.522 + obtain f where 1: "Well_order r \<and> Well_order r'" and 2: "embed r r' f" and
27.523 + 3: " \<not> bij_betw f (Field r) (Field r')"
27.524 + using assms unfolding ordLess_def by (auto simp add: embedS_def)
27.525 + {fix f' assume *: "embed r' r f'"
27.526 + hence "bij_betw f (Field r) (Field r')" using 1 2
27.527 + by (simp add: embed_bothWays_Field_bij_betw)
27.528 + with 3 have False by contradiction
27.529 + }
27.530 + thus ?thesis by blast
27.531 +qed
27.532 +
27.533 +
27.534 +lemma ordLess_Field:
27.535 +assumes OL: "r1 <o r2" and EMB: "embed r1 r2 f"
27.536 +shows "\<not> (f`(Field r1) = Field r2)"
27.537 +proof-
27.538 + let ?A1 = "Field r1" let ?A2 = "Field r2"
27.539 + obtain g where
27.540 + 0: "Well_order r1 \<and> Well_order r2" and
27.541 + 1: "embed r1 r2 g \<and> \<not>(bij_betw g ?A1 ?A2)"
27.542 + using OL unfolding ordLess_def by (auto simp add: embedS_def)
27.543 + hence "\<forall>a \<in> ?A1. f a = g a"
27.544 + using 0 EMB embed_unique[of r1] by auto
27.545 + hence "\<not>(bij_betw f ?A1 ?A2)"
27.546 + using 1 bij_betw_cong[of ?A1] by blast
27.547 + moreover
27.548 + have "inj_on f ?A1" using EMB 0 by (simp add: embed_inj_on)
27.549 + ultimately show ?thesis by (simp add: bij_betw_def)
27.550 +qed
27.551 +
27.552 +
27.553 +lemma ordLess_iff:
27.554 +"r <o r' = (Well_order r \<and> Well_order r' \<and> \<not>(\<exists>f'. embed r' r f'))"
27.555 +proof
27.556 + assume *: "r <o r'"
27.557 + hence "\<not>(\<exists>f'. embed r' r f')" using ordLess_not_embed[of r r'] by simp
27.558 + with * show "Well_order r \<and> Well_order r' \<and> \<not> (\<exists>f'. embed r' r f')"
27.559 + unfolding ordLess_def by auto
27.560 +next
27.561 + assume *: "Well_order r \<and> Well_order r' \<and> \<not> (\<exists>f'. embed r' r f')"
27.562 + then obtain f where 1: "embed r r' f"
27.563 + using wellorders_totally_ordered[of r r'] by blast
27.564 + moreover
27.565 + {assume "bij_betw f (Field r) (Field r')"
27.566 + with * 1 have "embed r' r (inv_into (Field r) f) "
27.567 + using inv_into_Field_embed_bij_betw[of r r' f] by auto
27.568 + with * have False by blast
27.569 + }
27.570 + ultimately show "(r,r') \<in> ordLess"
27.571 + unfolding ordLess_def using * by (fastforce simp add: embedS_def)
27.572 +qed
27.573 +
27.574 +
27.575 +lemma ordLess_irreflexive: "\<not> r <o r"
27.576 +proof
27.577 + assume "r <o r"
27.578 + hence "Well_order r \<and> \<not>(\<exists>f. embed r r f)"
27.579 + unfolding ordLess_iff ..
27.580 + moreover have "embed r r id" using id_embed[of r] .
27.581 + ultimately show False by blast
27.582 +qed
27.583 +
27.584 +
27.585 +lemma ordLeq_iff_ordLess_or_ordIso:
27.586 +"r \<le>o r' = (r <o r' \<or> r =o r')"
27.587 +unfolding ordRels_def embedS_defs iso_defs by blast
27.588 +
27.589 +
27.590 +lemma ordIso_iff_ordLeq:
27.591 +"(r =o r') = (r \<le>o r' \<and> r' \<le>o r)"
27.592 +proof
27.593 + assume "r =o r'"
27.594 + then obtain f where 1: "Well_order r \<and> Well_order r' \<and>
27.595 + embed r r' f \<and> bij_betw f (Field r) (Field r')"
27.596 + unfolding ordIso_def iso_defs by auto
27.597 + hence "embed r r' f \<and> embed r' r (inv_into (Field r) f)"
27.598 + by (simp add: inv_into_Field_embed_bij_betw)
27.599 + thus "r \<le>o r' \<and> r' \<le>o r"
27.600 + unfolding ordLeq_def using 1 by auto
27.601 +next
27.602 + assume "r \<le>o r' \<and> r' \<le>o r"
27.603 + then obtain f and g where 1: "Well_order r \<and> Well_order r' \<and>
27.604 + embed r r' f \<and> embed r' r g"
27.605 + unfolding ordLeq_def by auto
27.606 + hence "iso r r' f" by (auto simp add: embed_bothWays_iso)
27.607 + thus "r =o r'" unfolding ordIso_def using 1 by auto
27.608 +qed
27.609 +
27.610 +
27.611 +lemma not_ordLess_ordLeq:
27.612 +"r <o r' \<Longrightarrow> \<not> r' \<le>o r"
27.613 +using ordLess_ordLeq_trans ordLess_irreflexive by blast
27.614 +
27.615 +
27.616 +lemma ordLess_or_ordLeq:
27.617 +assumes WELL: "Well_order r" and WELL': "Well_order r'"
27.618 +shows "r <o r' \<or> r' \<le>o r"
27.619 +proof-
27.620 + have "r \<le>o r' \<or> r' \<le>o r"
27.621 + using assms by (simp add: ordLeq_total)
27.622 + moreover
27.623 + {assume "\<not> r <o r' \<and> r \<le>o r'"
27.624 + hence "r =o r'" using ordLeq_iff_ordLess_or_ordIso by blast
27.625 + hence "r' \<le>o r" using ordIso_symmetric ordIso_iff_ordLeq by blast
27.626 + }
27.627 + ultimately show ?thesis by blast
27.628 +qed
27.629 +
27.630 +
27.631 +lemma not_ordLess_ordIso:
27.632 +"r <o r' \<Longrightarrow> \<not> r =o r'"
27.633 +using assms ordLess_ordIso_trans ordIso_symmetric ordLess_irreflexive by blast
27.634 +
27.635 +
27.636 +lemma not_ordLeq_iff_ordLess:
27.637 +assumes WELL: "Well_order r" and WELL': "Well_order r'"
27.638 +shows "(\<not> r' \<le>o r) = (r <o r')"
27.639 +using assms not_ordLess_ordLeq ordLess_or_ordLeq by blast
27.640 +
27.641 +
27.642 +lemma not_ordLess_iff_ordLeq:
27.643 +assumes WELL: "Well_order r" and WELL': "Well_order r'"
27.644 +shows "(\<not> r' <o r) = (r \<le>o r')"
27.645 +using assms not_ordLess_ordLeq ordLess_or_ordLeq by blast
27.646 +
27.647 +
27.648 +lemma ordLess_transitive[trans]:
27.649 +"\<lbrakk>r <o r'; r' <o r''\<rbrakk> \<Longrightarrow> r <o r''"
27.650 +using assms ordLess_ordLeq_trans ordLeq_iff_ordLess_or_ordIso by blast
27.651 +
27.652 +
27.653 +corollary ordLess_trans: "trans ordLess"
27.654 +unfolding trans_def using ordLess_transitive by blast
27.655 +
27.656 +
27.657 +lemmas ordIso_equivalence = ordIso_transitive ordIso_reflexive ordIso_symmetric
27.658 +
27.659 +
27.660 +lemma ordIso_imp_ordLeq:
27.661 +"r =o r' \<Longrightarrow> r \<le>o r'"
27.662 +using ordIso_iff_ordLeq by blast
27.663 +
27.664 +
27.665 +lemma ordLess_imp_ordLeq:
27.666 +"r <o r' \<Longrightarrow> r \<le>o r'"
27.667 +using ordLeq_iff_ordLess_or_ordIso by blast
27.668 +
27.669 +
27.670 +lemma ofilter_subset_ordLeq:
27.671 +assumes WELL: "Well_order r" and
27.672 + OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
27.673 +shows "(A \<le> B) = (Restr r A \<le>o Restr r B)"
27.674 +proof
27.675 + assume "A \<le> B"
27.676 + thus "Restr r A \<le>o Restr r B"
27.677 + unfolding ordLeq_def using assms
27.678 + Well_order_Restr Well_order_Restr ofilter_subset_embed by blast
27.679 +next
27.680 + assume *: "Restr r A \<le>o Restr r B"
27.681 + then obtain f where "embed (Restr r A) (Restr r B) f"
27.682 + unfolding ordLeq_def by blast
27.683 + {assume "B < A"
27.684 + hence "Restr r B <o Restr r A"
27.685 + unfolding ordLess_def using assms
27.686 + Well_order_Restr Well_order_Restr ofilter_subset_embedS by blast
27.687 + hence False using * not_ordLess_ordLeq by blast
27.688 + }
27.689 + thus "A \<le> B" using OFA OFB WELL
27.690 + wo_rel_def[of r] wo_rel.ofilter_linord[of r A B] by blast
27.691 +qed
27.692 +
27.693 +
27.694 +lemma ofilter_subset_ordLess:
27.695 +assumes WELL: "Well_order r" and
27.696 + OFA: "wo_rel.ofilter r A" and OFB: "wo_rel.ofilter r B"
27.697 +shows "(A < B) = (Restr r A <o Restr r B)"
27.698 +proof-
27.699 + let ?rA = "Restr r A" let ?rB = "Restr r B"
27.700 + have 1: "Well_order ?rA \<and> Well_order ?rB"
27.701 + using WELL Well_order_Restr by blast
27.702 + have "(A < B) = (\<not> B \<le> A)" using assms
27.703 + wo_rel_def wo_rel.ofilter_linord[of r A B] by blast
27.704 + also have "\<dots> = (\<not> Restr r B \<le>o Restr r A)"
27.705 + using assms ofilter_subset_ordLeq by blast
27.706 + also have "\<dots> = (Restr r A <o Restr r B)"
27.707 + using 1 not_ordLeq_iff_ordLess by blast
27.708 + finally show ?thesis .
27.709 +qed
27.710 +
27.711 +
27.712 +lemma ofilter_ordLess:
27.713 +"\<lbrakk>Well_order r; wo_rel.ofilter r A\<rbrakk> \<Longrightarrow> (A < Field r) = (Restr r A <o r)"
27.714 +by (simp add: ofilter_subset_ordLess wo_rel.Field_ofilter
27.715 + wo_rel_def Restr_Field)
27.716 +
27.717 +
27.718 +corollary underS_Restr_ordLess:
27.719 +assumes "Well_order r" and "Field r \<noteq> {}"
27.720 +shows "Restr r (rel.underS r a) <o r"
27.721 +proof-
27.722 + have "rel.underS r a < Field r" using assms
27.723 + by (simp add: rel.underS_Field3)
27.724 + thus ?thesis using assms
27.725 + by (simp add: ofilter_ordLess wo_rel.underS_ofilter wo_rel_def)
27.726 +qed
27.727 +
27.728 +
27.729 +lemma embed_ordLess_ofilterIncl:
27.730 +assumes
27.731 + OL12: "r1 <o r2" and OL23: "r2 <o r3" and
27.732 + EMB13: "embed r1 r3 f13" and EMB23: "embed r2 r3 f23"
27.733 +shows "(f13`(Field r1), f23`(Field r2)) \<in> (ofilterIncl r3)"
27.734 +proof-
27.735 + have OL13: "r1 <o r3"
27.736 + using OL12 OL23 using ordLess_transitive by auto
27.737 + let ?A1 = "Field r1" let ?A2 ="Field r2" let ?A3 ="Field r3"
27.738 + obtain f12 g23 where
27.739 + 0: "Well_order r1 \<and> Well_order r2 \<and> Well_order r3" and
27.740 + 1: "embed r1 r2 f12 \<and> \<not>(bij_betw f12 ?A1 ?A2)" and
27.741 + 2: "embed r2 r3 g23 \<and> \<not>(bij_betw g23 ?A2 ?A3)"
27.742 + using OL12 OL23 by (auto simp add: ordLess_def embedS_def)
27.743 + hence "\<forall>a \<in> ?A2. f23 a = g23 a"
27.744 + using EMB23 embed_unique[of r2 r3] by blast
27.745 + hence 3: "\<not>(bij_betw f23 ?A2 ?A3)"
27.746 + using 2 bij_betw_cong[of ?A2 f23 g23] by blast
27.747 + (* *)
27.748 + have 4: "wo_rel.ofilter r2 (f12 ` ?A1) \<and> f12 ` ?A1 \<noteq> ?A2"
27.749 + using 0 1 OL12 by (simp add: embed_Field_ofilter ordLess_Field)
27.750 + have 5: "wo_rel.ofilter r3 (f23 ` ?A2) \<and> f23 ` ?A2 \<noteq> ?A3"
27.751 + using 0 EMB23 OL23 by (simp add: embed_Field_ofilter ordLess_Field)
27.752 + have 6: "wo_rel.ofilter r3 (f13 ` ?A1) \<and> f13 ` ?A1 \<noteq> ?A3"
27.753 + using 0 EMB13 OL13 by (simp add: embed_Field_ofilter ordLess_Field)
27.754 + (* *)
27.755 + have "f12 ` ?A1 < ?A2"
27.756 + using 0 4 by (auto simp add: wo_rel_def wo_rel.ofilter_def)
27.757 + moreover have "inj_on f23 ?A2"
27.758 + using EMB23 0 by (simp add: wo_rel_def embed_inj_on)
27.759 + ultimately
27.760 + have "f23 ` (f12 ` ?A1) < f23 ` ?A2" by (simp add: inj_on_strict_subset)
27.761 + moreover
27.762 + {have "embed r1 r3 (f23 o f12)"
27.763 + using 1 EMB23 0 by (auto simp add: comp_embed)
27.764 + hence "\<forall>a \<in> ?A1. f23(f12 a) = f13 a"
27.765 + using EMB13 0 embed_unique[of r1 r3 "f23 o f12" f13] by auto
27.766 + hence "f23 ` (f12 ` ?A1) = f13 ` ?A1" by force
27.767 + }
27.768 + ultimately
27.769 + have "f13 ` ?A1 < f23 ` ?A2" by simp
27.770 + (* *)
27.771 + with 5 6 show ?thesis
27.772 + unfolding ofilterIncl_def by auto
27.773 +qed
27.774 +
27.775 +
27.776 +lemma ordLess_iff_ordIso_Restr:
27.777 +assumes WELL: "Well_order r" and WELL': "Well_order r'"
27.778 +shows "(r' <o r) = (\<exists>a \<in> Field r. r' =o Restr r (rel.underS r a))"
27.779 +proof(auto)
27.780 + fix a assume *: "a \<in> Field r" and **: "r' =o Restr r (rel.underS r a)"
27.781 + hence "Restr r (rel.underS r a) <o r" using WELL underS_Restr_ordLess[of r] by blast
27.782 + thus "r' <o r" using ** ordIso_ordLess_trans by blast
27.783 +next
27.784 + assume "r' <o r"
27.785 + then obtain f where 1: "Well_order r \<and> Well_order r'" and
27.786 + 2: "embed r' r f \<and> f ` (Field r') \<noteq> Field r"
27.787 + unfolding ordLess_def embedS_def[abs_def] bij_betw_def using embed_inj_on by blast
27.788 + hence "wo_rel.ofilter r (f ` (Field r'))" using embed_Field_ofilter by blast
27.789 + then obtain a where 3: "a \<in> Field r" and 4: "rel.underS r a = f ` (Field r')"
27.790 + using 1 2 by (auto simp add: wo_rel.ofilter_underS_Field wo_rel_def)
27.791 + have "iso r' (Restr r (f ` (Field r'))) f"
27.792 + using embed_implies_iso_Restr 2 assms by blast
27.793 + moreover have "Well_order (Restr r (f ` (Field r')))"
27.794 + using WELL Well_order_Restr by blast
27.795 + ultimately have "r' =o Restr r (f ` (Field r'))"
27.796 + using WELL' unfolding ordIso_def by auto
27.797 + hence "r' =o Restr r (rel.underS r a)" using 4 by auto
27.798 + thus "\<exists>a \<in> Field r. r' =o Restr r (rel.underS r a)" using 3 by auto
27.799 +qed
27.800 +
27.801 +
27.802 +lemma internalize_ordLess:
27.803 +"(r' <o r) = (\<exists>p. Field p < Field r \<and> r' =o p \<and> p <o r)"
27.804 +proof
27.805 + assume *: "r' <o r"
27.806 + hence 0: "Well_order r \<and> Well_order r'" unfolding ordLess_def by auto
27.807 + with * obtain a where 1: "a \<in> Field r" and 2: "r' =o Restr r (rel.underS r a)"
27.808 + using ordLess_iff_ordIso_Restr by blast
27.809 + let ?p = "Restr r (rel.underS r a)"
27.810 + have "wo_rel.ofilter r (rel.underS r a)" using 0
27.811 + by (simp add: wo_rel_def wo_rel.underS_ofilter)
27.812 + hence "Field ?p = rel.underS r a" using 0 Field_Restr_ofilter by blast
27.813 + hence "Field ?p < Field r" using rel.underS_Field2 1 by fast
27.814 + moreover have "?p <o r" using underS_Restr_ordLess[of r a] 0 1 by blast
27.815 + ultimately
27.816 + show "\<exists>p. Field p < Field r \<and> r' =o p \<and> p <o r" using 2 by blast
27.817 +next
27.818 + assume "\<exists>p. Field p < Field r \<and> r' =o p \<and> p <o r"
27.819 + thus "r' <o r" using ordIso_ordLess_trans by blast
27.820 +qed
27.821 +
27.822 +
27.823 +lemma internalize_ordLeq:
27.824 +"(r' \<le>o r) = (\<exists>p. Field p \<le> Field r \<and> r' =o p \<and> p \<le>o r)"
27.825 +proof
27.826 + assume *: "r' \<le>o r"
27.827 + moreover
27.828 + {assume "r' <o r"
27.829 + then obtain p where "Field p < Field r \<and> r' =o p \<and> p <o r"
27.830 + using internalize_ordLess[of r' r] by blast
27.831 + hence "\<exists>p. Field p \<le> Field r \<and> r' =o p \<and> p \<le>o r"
27.832 + using ordLeq_iff_ordLess_or_ordIso by blast
27.833 + }
27.834 + moreover
27.835 + have "r \<le>o r" using * ordLeq_def ordLeq_reflexive by blast
27.836 + ultimately show "\<exists>p. Field p \<le> Field r \<and> r' =o p \<and> p \<le>o r"
27.837 + using ordLeq_iff_ordLess_or_ordIso by blast
27.838 +next
27.839 + assume "\<exists>p. Field p \<le> Field r \<and> r' =o p \<and> p \<le>o r"
27.840 + thus "r' \<le>o r" using ordIso_ordLeq_trans by blast
27.841 +qed
27.842 +
27.843 +
27.844 +lemma ordLeq_iff_ordLess_Restr:
27.845 +assumes WELL: "Well_order r" and WELL': "Well_order r'"
27.846 +shows "(r \<le>o r') = (\<forall>a \<in> Field r. Restr r (rel.underS r a) <o r')"
27.847 +proof(auto)
27.848 + assume *: "r \<le>o r'"
27.849 + fix a assume "a \<in> Field r"
27.850 + hence "Restr r (rel.underS r a) <o r"
27.851 + using WELL underS_Restr_ordLess[of r] by blast
27.852 + thus "Restr r (rel.underS r a) <o r'"
27.853 + using * ordLess_ordLeq_trans by blast
27.854 +next
27.855 + assume *: "\<forall>a \<in> Field r. Restr r (rel.underS r a) <o r'"
27.856 + {assume "r' <o r"
27.857 + then obtain a where "a \<in> Field r \<and> r' =o Restr r (rel.underS r a)"
27.858 + using assms ordLess_iff_ordIso_Restr by blast
27.859 + hence False using * not_ordLess_ordIso ordIso_symmetric by blast
27.860 + }
27.861 + thus "r \<le>o r'" using ordLess_or_ordLeq assms by blast
27.862 +qed
27.863 +
27.864 +
27.865 +lemma finite_ordLess_infinite:
27.866 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and
27.867 + FIN: "finite(Field r)" and INF: "infinite(Field r')"
27.868 +shows "r <o r'"
27.869 +proof-
27.870 + {assume "r' \<le>o r"
27.871 + then obtain h where "inj_on h (Field r') \<and> h ` (Field r') \<le> Field r"
27.872 + unfolding ordLeq_def using assms embed_inj_on embed_Field by blast
27.873 + hence False using finite_imageD finite_subset FIN INF by metis
27.874 + }
27.875 + thus ?thesis using WELL WELL' ordLess_or_ordLeq by blast
27.876 +qed
27.877 +
27.878 +
27.879 +lemma finite_well_order_on_ordIso:
27.880 +assumes FIN: "finite A" and
27.881 + WELL: "well_order_on A r" and WELL': "well_order_on A r'"
27.882 +shows "r =o r'"
27.883 +proof-
27.884 + have 0: "Well_order r \<and> Well_order r' \<and> Field r = A \<and> Field r' = A"
27.885 + using assms rel.well_order_on_Well_order by blast
27.886 + moreover
27.887 + have "\<forall>r r'. well_order_on A r \<and> well_order_on A r' \<and> r \<le>o r'
27.888 + \<longrightarrow> r =o r'"
27.889 + proof(clarify)
27.890 + fix r r' assume *: "well_order_on A r" and **: "well_order_on A r'"
27.891 + have 2: "Well_order r \<and> Well_order r' \<and> Field r = A \<and> Field r' = A"
27.892 + using * ** rel.well_order_on_Well_order by blast
27.893 + assume "r \<le>o r'"
27.894 + then obtain f where 1: "embed r r' f" and
27.895 + "inj_on f A \<and> f ` A \<le> A"
27.896 + unfolding ordLeq_def using 2 embed_inj_on embed_Field by blast
27.897 + hence "bij_betw f A A" unfolding bij_betw_def using FIN endo_inj_surj by blast
27.898 + thus "r =o r'" unfolding ordIso_def iso_def[abs_def] using 1 2 by auto
27.899 + qed
27.900 + ultimately show ?thesis using assms ordLeq_total ordIso_symmetric by metis
27.901 +qed
27.902 +
27.903 +
27.904 +subsection{* @{text "<o"} is well-founded *}
27.905 +
27.906 +
27.907 +text {* Of course, it only makes sense to state that the @{text "<o"} is well-founded
27.908 +on the restricted type @{text "'a rel rel"}. We prove this by first showing that, for any set
27.909 +of well-orders all embedded in a fixed well-order, the function mapping each well-order
27.910 +in the set to an order filter of the fixed well-order is compatible w.r.t. to @{text "<o"} versus
27.911 +{\em strict inclusion}; and we already know that strict inclusion of order filters is well-founded. *}
27.912 +
27.913 +
27.914 +definition ord_to_filter :: "'a rel \<Rightarrow> 'a rel \<Rightarrow> 'a set"
27.915 +where "ord_to_filter r0 r \<equiv> (SOME f. embed r r0 f) ` (Field r)"
27.916 +
27.917 +
27.918 +lemma ord_to_filter_compat:
27.919 +"compat (ordLess Int (ordLess^-1``{r0} \<times> ordLess^-1``{r0}))
27.920 + (ofilterIncl r0)
27.921 + (ord_to_filter r0)"
27.922 +proof(unfold compat_def ord_to_filter_def, clarify)
27.923 + fix r1::"'a rel" and r2::"'a rel"
27.924 + let ?A1 = "Field r1" let ?A2 ="Field r2" let ?A0 ="Field r0"
27.925 + let ?phi10 = "\<lambda> f10. embed r1 r0 f10" let ?f10 = "SOME f. ?phi10 f"
27.926 + let ?phi20 = "\<lambda> f20. embed r2 r0 f20" let ?f20 = "SOME f. ?phi20 f"
27.927 + assume *: "r1 <o r0" "r2 <o r0" and **: "r1 <o r2"
27.928 + hence "(\<exists>f. ?phi10 f) \<and> (\<exists>f. ?phi20 f)"
27.929 + by (auto simp add: ordLess_def embedS_def)
27.930 + hence "?phi10 ?f10 \<and> ?phi20 ?f20" by (auto simp add: someI_ex)
27.931 + thus "(?f10 ` ?A1, ?f20 ` ?A2) \<in> ofilterIncl r0"
27.932 + using * ** by (simp add: embed_ordLess_ofilterIncl)
27.933 +qed
27.934 +
27.935 +
27.936 +theorem wf_ordLess: "wf ordLess"
27.937 +proof-
27.938 + {fix r0 :: "('a \<times> 'a) set"
27.939 + (* need to annotate here!*)
27.940 + let ?ordLess = "ordLess::('d rel * 'd rel) set"
27.941 + let ?R = "?ordLess Int (?ordLess^-1``{r0} \<times> ?ordLess^-1``{r0})"
27.942 + {assume Case1: "Well_order r0"
27.943 + hence "wf ?R"
27.944 + using wf_ofilterIncl[of r0]
27.945 + compat_wf[of ?R "ofilterIncl r0" "ord_to_filter r0"]
27.946 + ord_to_filter_compat[of r0] by auto
27.947 + }
27.948 + moreover
27.949 + {assume Case2: "\<not> Well_order r0"
27.950 + hence "?R = {}" unfolding ordLess_def by auto
27.951 + hence "wf ?R" using wf_empty by simp
27.952 + }
27.953 + ultimately have "wf ?R" by blast
27.954 + }
27.955 + thus ?thesis by (simp add: trans_wf_iff ordLess_trans)
27.956 +qed
27.957 +
27.958 +corollary exists_minim_Well_order:
27.959 +assumes NE: "R \<noteq> {}" and WELL: "\<forall>r \<in> R. Well_order r"
27.960 +shows "\<exists>r \<in> R. \<forall>r' \<in> R. r \<le>o r'"
27.961 +proof-
27.962 + obtain r where "r \<in> R \<and> (\<forall>r' \<in> R. \<not> r' <o r)"
27.963 + using NE spec[OF spec[OF subst[OF wf_eq_minimal, of "%x. x", OF wf_ordLess]], of _ R]
27.964 + equals0I[of R] by blast
27.965 + with not_ordLeq_iff_ordLess WELL show ?thesis by blast
27.966 +qed
27.967 +
27.968 +
27.969 +
27.970 +subsection {* Copy via direct images *}
27.971 +
27.972 +
27.973 +text{* The direct image operator is the dual of the inverse image operator @{text "inv_image"}
27.974 +from @{text "Relation.thy"}. It is useful for transporting a well-order between
27.975 +different types. *}
27.976 +
27.977 +
27.978 +definition dir_image :: "'a rel \<Rightarrow> ('a \<Rightarrow> 'a') \<Rightarrow> 'a' rel"
27.979 +where
27.980 +"dir_image r f = {(f a, f b)| a b. (a,b) \<in> r}"
27.981 +
27.982 +
27.983 +lemma dir_image_Field:
27.984 +"Field(dir_image r f) \<le> f ` (Field r)"
27.985 +unfolding dir_image_def Field_def by auto
27.986 +
27.987 +
27.988 +lemma dir_image_minus_Id:
27.989 +"inj_on f (Field r) \<Longrightarrow> (dir_image r f) - Id = dir_image (r - Id) f"
27.990 +unfolding inj_on_def Field_def dir_image_def by auto
27.991 +
27.992 +
27.993 +lemma Refl_dir_image:
27.994 +assumes "Refl r"
27.995 +shows "Refl(dir_image r f)"
27.996 +proof-
27.997 + {fix a' b'
27.998 + assume "(a',b') \<in> dir_image r f"
27.999 + then obtain a b where 1: "a' = f a \<and> b' = f b \<and> (a,b) \<in> r"
27.1000 + unfolding dir_image_def by blast
27.1001 + hence "a \<in> Field r \<and> b \<in> Field r" using Field_def by fastforce
27.1002 + hence "(a,a) \<in> r \<and> (b,b) \<in> r" using assms by (simp add: refl_on_def)
27.1003 + with 1 have "(a',a') \<in> dir_image r f \<and> (b',b') \<in> dir_image r f"
27.1004 + unfolding dir_image_def by auto
27.1005 + }
27.1006 + thus ?thesis
27.1007 + by(unfold refl_on_def Field_def Domain_def Range_def, auto)
27.1008 +qed
27.1009 +
27.1010 +
27.1011 +lemma trans_dir_image:
27.1012 +assumes TRANS: "trans r" and INJ: "inj_on f (Field r)"
27.1013 +shows "trans(dir_image r f)"
27.1014 +proof(unfold trans_def, auto)
27.1015 + fix a' b' c'
27.1016 + assume "(a',b') \<in> dir_image r f" "(b',c') \<in> dir_image r f"
27.1017 + then obtain a b1 b2 c where 1: "a' = f a \<and> b' = f b1 \<and> b' = f b2 \<and> c' = f c" and
27.1018 + 2: "(a,b1) \<in> r \<and> (b2,c) \<in> r"
27.1019 + unfolding dir_image_def by blast
27.1020 + hence "b1 \<in> Field r \<and> b2 \<in> Field r"
27.1021 + unfolding Field_def by auto
27.1022 + hence "b1 = b2" using 1 INJ unfolding inj_on_def by auto
27.1023 + hence "(a,c): r" using 2 TRANS unfolding trans_def by blast
27.1024 + thus "(a',c') \<in> dir_image r f"
27.1025 + unfolding dir_image_def using 1 by auto
27.1026 +qed
27.1027 +
27.1028 +
27.1029 +lemma Preorder_dir_image:
27.1030 +"\<lbrakk>Preorder r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> Preorder (dir_image r f)"
27.1031 +by (simp add: preorder_on_def Refl_dir_image trans_dir_image)
27.1032 +
27.1033 +
27.1034 +lemma antisym_dir_image:
27.1035 +assumes AN: "antisym r" and INJ: "inj_on f (Field r)"
27.1036 +shows "antisym(dir_image r f)"
27.1037 +proof(unfold antisym_def, auto)
27.1038 + fix a' b'
27.1039 + assume "(a',b') \<in> dir_image r f" "(b',a') \<in> dir_image r f"
27.1040 + then obtain a1 b1 a2 b2 where 1: "a' = f a1 \<and> a' = f a2 \<and> b' = f b1 \<and> b' = f b2" and
27.1041 + 2: "(a1,b1) \<in> r \<and> (b2,a2) \<in> r " and
27.1042 + 3: "{a1,a2,b1,b2} \<le> Field r"
27.1043 + unfolding dir_image_def Field_def by blast
27.1044 + hence "a1 = a2 \<and> b1 = b2" using INJ unfolding inj_on_def by auto
27.1045 + hence "a1 = b2" using 2 AN unfolding antisym_def by auto
27.1046 + thus "a' = b'" using 1 by auto
27.1047 +qed
27.1048 +
27.1049 +
27.1050 +lemma Partial_order_dir_image:
27.1051 +"\<lbrakk>Partial_order r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> Partial_order (dir_image r f)"
27.1052 +by (simp add: partial_order_on_def Preorder_dir_image antisym_dir_image)
27.1053 +
27.1054 +
27.1055 +lemma Total_dir_image:
27.1056 +assumes TOT: "Total r" and INJ: "inj_on f (Field r)"
27.1057 +shows "Total(dir_image r f)"
27.1058 +proof(unfold total_on_def, intro ballI impI)
27.1059 + fix a' b'
27.1060 + assume "a' \<in> Field (dir_image r f)" "b' \<in> Field (dir_image r f)"
27.1061 + then obtain a and b where 1: "a \<in> Field r \<and> b \<in> Field r \<and> f a = a' \<and> f b = b'"
27.1062 + using dir_image_Field[of r f] by blast
27.1063 + moreover assume "a' \<noteq> b'"
27.1064 + ultimately have "a \<noteq> b" using INJ unfolding inj_on_def by auto
27.1065 + hence "(a,b) \<in> r \<or> (b,a) \<in> r" using 1 TOT unfolding total_on_def by auto
27.1066 + thus "(a',b') \<in> dir_image r f \<or> (b',a') \<in> dir_image r f"
27.1067 + using 1 unfolding dir_image_def by auto
27.1068 +qed
27.1069 +
27.1070 +
27.1071 +lemma Linear_order_dir_image:
27.1072 +"\<lbrakk>Linear_order r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> Linear_order (dir_image r f)"
27.1073 +by (simp add: linear_order_on_def Partial_order_dir_image Total_dir_image)
27.1074 +
27.1075 +
27.1076 +lemma wf_dir_image:
27.1077 +assumes WF: "wf r" and INJ: "inj_on f (Field r)"
27.1078 +shows "wf(dir_image r f)"
27.1079 +proof(unfold wf_eq_minimal2, intro allI impI, elim conjE)
27.1080 + fix A'::"'b set"
27.1081 + assume SUB: "A' \<le> Field(dir_image r f)" and NE: "A' \<noteq> {}"
27.1082 + obtain A where A_def: "A = {a \<in> Field r. f a \<in> A'}" by blast
27.1083 + have "A \<noteq> {} \<and> A \<le> Field r"
27.1084 + using A_def dir_image_Field[of r f] SUB NE by blast
27.1085 + then obtain a where 1: "a \<in> A \<and> (\<forall>b \<in> A. (b,a) \<notin> r)"
27.1086 + using WF unfolding wf_eq_minimal2 by metis
27.1087 + have "\<forall>b' \<in> A'. (b',f a) \<notin> dir_image r f"
27.1088 + proof(clarify)
27.1089 + fix b' assume *: "b' \<in> A'" and **: "(b',f a) \<in> dir_image r f"
27.1090 + obtain b1 a1 where 2: "b' = f b1 \<and> f a = f a1" and
27.1091 + 3: "(b1,a1) \<in> r \<and> {a1,b1} \<le> Field r"
27.1092 + using ** unfolding dir_image_def Field_def by blast
27.1093 + hence "a = a1" using 1 A_def INJ unfolding inj_on_def by auto
27.1094 + hence "b1 \<in> A \<and> (b1,a) \<in> r" using 2 3 A_def * by auto
27.1095 + with 1 show False by auto
27.1096 + qed
27.1097 + thus "\<exists>a'\<in>A'. \<forall>b'\<in>A'. (b', a') \<notin> dir_image r f"
27.1098 + using A_def 1 by blast
27.1099 +qed
27.1100 +
27.1101 +
27.1102 +lemma Well_order_dir_image:
27.1103 +"\<lbrakk>Well_order r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> Well_order (dir_image r f)"
27.1104 +using assms unfolding well_order_on_def
27.1105 +using Linear_order_dir_image[of r f] wf_dir_image[of "r - Id" f]
27.1106 + dir_image_minus_Id[of f r]
27.1107 + subset_inj_on[of f "Field r" "Field(r - Id)"]
27.1108 + mono_Field[of "r - Id" r] by auto
27.1109 +
27.1110 +
27.1111 +lemma dir_image_Field2:
27.1112 +"Refl r \<Longrightarrow> Field(dir_image r f) = f ` (Field r)"
27.1113 +unfolding Field_def dir_image_def refl_on_def Domain_def Range_def by blast
27.1114 +
27.1115 +
27.1116 +lemma dir_image_bij_betw:
27.1117 +"\<lbrakk>Well_order r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> bij_betw f (Field r) (Field (dir_image r f))"
27.1118 +unfolding bij_betw_def
27.1119 +by (simp add: dir_image_Field2 order_on_defs)
27.1120 +
27.1121 +
27.1122 +lemma dir_image_compat:
27.1123 +"compat r (dir_image r f) f"
27.1124 +unfolding compat_def dir_image_def by auto
27.1125 +
27.1126 +
27.1127 +lemma dir_image_iso:
27.1128 +"\<lbrakk>Well_order r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> iso r (dir_image r f) f"
27.1129 +using iso_iff3 dir_image_compat dir_image_bij_betw Well_order_dir_image by blast
27.1130 +
27.1131 +
27.1132 +lemma dir_image_ordIso:
27.1133 +"\<lbrakk>Well_order r; inj_on f (Field r)\<rbrakk> \<Longrightarrow> r =o dir_image r f"
27.1134 +unfolding ordIso_def using dir_image_iso Well_order_dir_image by blast
27.1135 +
27.1136 +
27.1137 +lemma Well_order_iso_copy:
27.1138 +assumes WELL: "well_order_on A r" and BIJ: "bij_betw f A A'"
27.1139 +shows "\<exists>r'. well_order_on A' r' \<and> r =o r'"
27.1140 +proof-
27.1141 + let ?r' = "dir_image r f"
27.1142 + have 1: "A = Field r \<and> Well_order r"
27.1143 + using WELL rel.well_order_on_Well_order by blast
27.1144 + hence 2: "iso r ?r' f"
27.1145 + using dir_image_iso using BIJ unfolding bij_betw_def by auto
27.1146 + hence "f ` (Field r) = Field ?r'" using 1 iso_iff[of r ?r'] by blast
27.1147 + hence "Field ?r' = A'"
27.1148 + using 1 BIJ unfolding bij_betw_def by auto
27.1149 + moreover have "Well_order ?r'"
27.1150 + using 1 Well_order_dir_image BIJ unfolding bij_betw_def by blast
27.1151 + ultimately show ?thesis unfolding ordIso_def using 1 2 by blast
27.1152 +qed
27.1153 +
27.1154 +
27.1155 +
27.1156 +subsection {* Bounded square *}
27.1157 +
27.1158 +
27.1159 +text{* This construction essentially defines, for an order relation @{text "r"}, a lexicographic
27.1160 +order @{text "bsqr r"} on @{text "(Field r) \<times> (Field r)"}, applying the
27.1161 +following criteria (in this order):
27.1162 +\begin{itemize}
27.1163 +\item compare the maximums;
27.1164 +\item compare the first components;
27.1165 +\item compare the second components.
27.1166 +\end{itemize}
27.1167 +%
27.1168 +The only application of this construction that we are aware of is
27.1169 +at proving that the square of an infinite set has the same cardinal
27.1170 +as that set. The essential property required there (and which is ensured by this
27.1171 +construction) is that any proper order filter of the product order is included in a rectangle, i.e.,
27.1172 +in a product of proper filters on the original relation (assumed to be a well-order). *}
27.1173 +
27.1174 +
27.1175 +definition bsqr :: "'a rel => ('a * 'a)rel"
27.1176 +where
27.1177 +"bsqr r = {((a1,a2),(b1,b2)).
27.1178 + {a1,a2,b1,b2} \<le> Field r \<and>
27.1179 + (a1 = b1 \<and> a2 = b2 \<or>
27.1180 + (wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r - Id \<or>
27.1181 + wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> (a1,b1) \<in> r - Id \<or>
27.1182 + wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> a1 = b1 \<and> (a2,b2) \<in> r - Id
27.1183 + )}"
27.1184 +
27.1185 +
27.1186 +lemma Field_bsqr:
27.1187 +"Field (bsqr r) = Field r \<times> Field r"
27.1188 +proof
27.1189 + show "Field (bsqr r) \<le> Field r \<times> Field r"
27.1190 + proof-
27.1191 + {fix a1 a2 assume "(a1,a2) \<in> Field (bsqr r)"
27.1192 + moreover
27.1193 + have "\<And> b1 b2. ((a1,a2),(b1,b2)) \<in> bsqr r \<or> ((b1,b2),(a1,a2)) \<in> bsqr r \<Longrightarrow>
27.1194 + a1 \<in> Field r \<and> a2 \<in> Field r" unfolding bsqr_def by auto
27.1195 + ultimately have "a1 \<in> Field r \<and> a2 \<in> Field r" unfolding Field_def by auto
27.1196 + }
27.1197 + thus ?thesis unfolding Field_def by force
27.1198 + qed
27.1199 +next
27.1200 + show "Field r \<times> Field r \<le> Field (bsqr r)"
27.1201 + proof(auto)
27.1202 + fix a1 a2 assume "a1 \<in> Field r" and "a2 \<in> Field r"
27.1203 + hence "((a1,a2),(a1,a2)) \<in> bsqr r" unfolding bsqr_def by blast
27.1204 + thus "(a1,a2) \<in> Field (bsqr r)" unfolding Field_def by auto
27.1205 + qed
27.1206 +qed
27.1207 +
27.1208 +
27.1209 +lemma bsqr_Refl: "Refl(bsqr r)"
27.1210 +by(unfold refl_on_def Field_bsqr, auto simp add: bsqr_def)
27.1211 +
27.1212 +
27.1213 +lemma bsqr_Trans:
27.1214 +assumes "Well_order r"
27.1215 +shows "trans (bsqr r)"
27.1216 +proof(unfold trans_def, auto)
27.1217 + (* Preliminary facts *)
27.1218 + have Well: "wo_rel r" using assms wo_rel_def by auto
27.1219 + hence Trans: "trans r" using wo_rel.TRANS by auto
27.1220 + have Anti: "antisym r" using wo_rel.ANTISYM Well by auto
27.1221 + hence TransS: "trans(r - Id)" using Trans by (simp add: trans_diff_Id)
27.1222 + (* Main proof *)
27.1223 + fix a1 a2 b1 b2 c1 c2
27.1224 + assume *: "((a1,a2),(b1,b2)) \<in> bsqr r" and **: "((b1,b2),(c1,c2)) \<in> bsqr r"
27.1225 + hence 0: "{a1,a2,b1,b2,c1,c2} \<le> Field r" unfolding bsqr_def by auto
27.1226 + have 1: "a1 = b1 \<and> a2 = b2 \<or> (wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r - Id \<or>
27.1227 + wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> (a1,b1) \<in> r - Id \<or>
27.1228 + wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> a1 = b1 \<and> (a2,b2) \<in> r - Id"
27.1229 + using * unfolding bsqr_def by auto
27.1230 + have 2: "b1 = c1 \<and> b2 = c2 \<or> (wo_rel.max2 r b1 b2, wo_rel.max2 r c1 c2) \<in> r - Id \<or>
27.1231 + wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> (b1,c1) \<in> r - Id \<or>
27.1232 + wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> b1 = c1 \<and> (b2,c2) \<in> r - Id"
27.1233 + using ** unfolding bsqr_def by auto
27.1234 + show "((a1,a2),(c1,c2)) \<in> bsqr r"
27.1235 + proof-
27.1236 + {assume Case1: "a1 = b1 \<and> a2 = b2"
27.1237 + hence ?thesis using ** by simp
27.1238 + }
27.1239 + moreover
27.1240 + {assume Case2: "(wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r - Id"
27.1241 + {assume Case21: "b1 = c1 \<and> b2 = c2"
27.1242 + hence ?thesis using * by simp
27.1243 + }
27.1244 + moreover
27.1245 + {assume Case22: "(wo_rel.max2 r b1 b2, wo_rel.max2 r c1 c2) \<in> r - Id"
27.1246 + hence "(wo_rel.max2 r a1 a2, wo_rel.max2 r c1 c2) \<in> r - Id"
27.1247 + using Case2 TransS trans_def[of "r - Id"] by blast
27.1248 + hence ?thesis using 0 unfolding bsqr_def by auto
27.1249 + }
27.1250 + moreover
27.1251 + {assume Case23_4: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2"
27.1252 + hence ?thesis using Case2 0 unfolding bsqr_def by auto
27.1253 + }
27.1254 + ultimately have ?thesis using 0 2 by auto
27.1255 + }
27.1256 + moreover
27.1257 + {assume Case3: "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> (a1,b1) \<in> r - Id"
27.1258 + {assume Case31: "b1 = c1 \<and> b2 = c2"
27.1259 + hence ?thesis using * by simp
27.1260 + }
27.1261 + moreover
27.1262 + {assume Case32: "(wo_rel.max2 r b1 b2, wo_rel.max2 r c1 c2) \<in> r - Id"
27.1263 + hence ?thesis using Case3 0 unfolding bsqr_def by auto
27.1264 + }
27.1265 + moreover
27.1266 + {assume Case33: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> (b1,c1) \<in> r - Id"
27.1267 + hence "(a1,c1) \<in> r - Id"
27.1268 + using Case3 TransS trans_def[of "r - Id"] by blast
27.1269 + hence ?thesis using Case3 Case33 0 unfolding bsqr_def by auto
27.1270 + }
27.1271 + moreover
27.1272 + {assume Case33: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> b1 = c1"
27.1273 + hence ?thesis using Case3 0 unfolding bsqr_def by auto
27.1274 + }
27.1275 + ultimately have ?thesis using 0 2 by auto
27.1276 + }
27.1277 + moreover
27.1278 + {assume Case4: "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> a1 = b1 \<and> (a2,b2) \<in> r - Id"
27.1279 + {assume Case41: "b1 = c1 \<and> b2 = c2"
27.1280 + hence ?thesis using * by simp
27.1281 + }
27.1282 + moreover
27.1283 + {assume Case42: "(wo_rel.max2 r b1 b2, wo_rel.max2 r c1 c2) \<in> r - Id"
27.1284 + hence ?thesis using Case4 0 unfolding bsqr_def by force
27.1285 + }
27.1286 + moreover
27.1287 + {assume Case43: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> (b1,c1) \<in> r - Id"
27.1288 + hence ?thesis using Case4 0 unfolding bsqr_def by auto
27.1289 + }
27.1290 + moreover
27.1291 + {assume Case44: "wo_rel.max2 r b1 b2 = wo_rel.max2 r c1 c2 \<and> b1 = c1 \<and> (b2,c2) \<in> r - Id"
27.1292 + hence "(a2,c2) \<in> r - Id"
27.1293 + using Case4 TransS trans_def[of "r - Id"] by blast
27.1294 + hence ?thesis using Case4 Case44 0 unfolding bsqr_def by auto
27.1295 + }
27.1296 + ultimately have ?thesis using 0 2 by auto
27.1297 + }
27.1298 + ultimately show ?thesis using 0 1 by auto
27.1299 + qed
27.1300 +qed
27.1301 +
27.1302 +
27.1303 +lemma bsqr_antisym:
27.1304 +assumes "Well_order r"
27.1305 +shows "antisym (bsqr r)"
27.1306 +proof(unfold antisym_def, clarify)
27.1307 + (* Preliminary facts *)
27.1308 + have Well: "wo_rel r" using assms wo_rel_def by auto
27.1309 + hence Trans: "trans r" using wo_rel.TRANS by auto
27.1310 + have Anti: "antisym r" using wo_rel.ANTISYM Well by auto
27.1311 + hence TransS: "trans(r - Id)" using Trans by (simp add: trans_diff_Id)
27.1312 + hence IrrS: "\<forall>a b. \<not>((a,b) \<in> r - Id \<and> (b,a) \<in> r - Id)"
27.1313 + using Anti trans_def[of "r - Id"] antisym_def[of "r - Id"] by blast
27.1314 + (* Main proof *)
27.1315 + fix a1 a2 b1 b2
27.1316 + assume *: "((a1,a2),(b1,b2)) \<in> bsqr r" and **: "((b1,b2),(a1,a2)) \<in> bsqr r"
27.1317 + hence 0: "{a1,a2,b1,b2} \<le> Field r" unfolding bsqr_def by auto
27.1318 + have 1: "a1 = b1 \<and> a2 = b2 \<or> (wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r - Id \<or>
27.1319 + wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> (a1,b1) \<in> r - Id \<or>
27.1320 + wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> a1 = b1 \<and> (a2,b2) \<in> r - Id"
27.1321 + using * unfolding bsqr_def by auto
27.1322 + have 2: "b1 = a1 \<and> b2 = a2 \<or> (wo_rel.max2 r b1 b2, wo_rel.max2 r a1 a2) \<in> r - Id \<or>
27.1323 + wo_rel.max2 r b1 b2 = wo_rel.max2 r a1 a2 \<and> (b1,a1) \<in> r - Id \<or>
27.1324 + wo_rel.max2 r b1 b2 = wo_rel.max2 r a1 a2 \<and> b1 = a1 \<and> (b2,a2) \<in> r - Id"
27.1325 + using ** unfolding bsqr_def by auto
27.1326 + show "a1 = b1 \<and> a2 = b2"
27.1327 + proof-
27.1328 + {assume Case1: "(wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r - Id"
27.1329 + {assume Case11: "(wo_rel.max2 r b1 b2, wo_rel.max2 r a1 a2) \<in> r - Id"
27.1330 + hence False using Case1 IrrS by blast
27.1331 + }
27.1332 + moreover
27.1333 + {assume Case12_3: "wo_rel.max2 r b1 b2 = wo_rel.max2 r a1 a2"
27.1334 + hence False using Case1 by auto
27.1335 + }
27.1336 + ultimately have ?thesis using 0 2 by auto
27.1337 + }
27.1338 + moreover
27.1339 + {assume Case2: "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> (a1,b1) \<in> r - Id"
27.1340 + {assume Case21: "(wo_rel.max2 r b1 b2, wo_rel.max2 r a1 a2) \<in> r - Id"
27.1341 + hence False using Case2 by auto
27.1342 + }
27.1343 + moreover
27.1344 + {assume Case22: "(b1,a1) \<in> r - Id"
27.1345 + hence False using Case2 IrrS by blast
27.1346 + }
27.1347 + moreover
27.1348 + {assume Case23: "b1 = a1"
27.1349 + hence False using Case2 by auto
27.1350 + }
27.1351 + ultimately have ?thesis using 0 2 by auto
27.1352 + }
27.1353 + moreover
27.1354 + {assume Case3: "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2 \<and> a1 = b1 \<and> (a2,b2) \<in> r - Id"
27.1355 + moreover
27.1356 + {assume Case31: "(wo_rel.max2 r b1 b2, wo_rel.max2 r a1 a2) \<in> r - Id"
27.1357 + hence False using Case3 by auto
27.1358 + }
27.1359 + moreover
27.1360 + {assume Case32: "(b1,a1) \<in> r - Id"
27.1361 + hence False using Case3 by auto
27.1362 + }
27.1363 + moreover
27.1364 + {assume Case33: "(b2,a2) \<in> r - Id"
27.1365 + hence False using Case3 IrrS by blast
27.1366 + }
27.1367 + ultimately have ?thesis using 0 2 by auto
27.1368 + }
27.1369 + ultimately show ?thesis using 0 1 by blast
27.1370 + qed
27.1371 +qed
27.1372 +
27.1373 +
27.1374 +lemma bsqr_Total:
27.1375 +assumes "Well_order r"
27.1376 +shows "Total(bsqr r)"
27.1377 +proof-
27.1378 + (* Preliminary facts *)
27.1379 + have Well: "wo_rel r" using assms wo_rel_def by auto
27.1380 + hence Total: "\<forall>a \<in> Field r. \<forall>b \<in> Field r. (a,b) \<in> r \<or> (b,a) \<in> r"
27.1381 + using wo_rel.TOTALS by auto
27.1382 + (* Main proof *)
27.1383 + {fix a1 a2 b1 b2 assume "{(a1,a2), (b1,b2)} \<le> Field(bsqr r)"
27.1384 + hence 0: "a1 \<in> Field r \<and> a2 \<in> Field r \<and> b1 \<in> Field r \<and> b2 \<in> Field r"
27.1385 + using Field_bsqr by blast
27.1386 + have "((a1,a2) = (b1,b2) \<or> ((a1,a2),(b1,b2)) \<in> bsqr r \<or> ((b1,b2),(a1,a2)) \<in> bsqr r)"
27.1387 + proof(rule wo_rel.cases_Total[of r a1 a2], clarsimp simp add: Well, simp add: 0)
27.1388 + (* Why didn't clarsimp simp add: Well 0 do the same job? *)
27.1389 + assume Case1: "(a1,a2) \<in> r"
27.1390 + hence 1: "wo_rel.max2 r a1 a2 = a2"
27.1391 + using Well 0 by (simp add: wo_rel.max2_equals2)
27.1392 + show ?thesis
27.1393 + proof(rule wo_rel.cases_Total[of r b1 b2], clarsimp simp add: Well, simp add: 0)
27.1394 + assume Case11: "(b1,b2) \<in> r"
27.1395 + hence 2: "wo_rel.max2 r b1 b2 = b2"
27.1396 + using Well 0 by (simp add: wo_rel.max2_equals2)
27.1397 + show ?thesis
27.1398 + proof(rule wo_rel.cases_Total3[of r a2 b2], clarsimp simp add: Well, simp add: 0)
27.1399 + assume Case111: "(a2,b2) \<in> r - Id \<or> (b2,a2) \<in> r - Id"
27.1400 + thus ?thesis using 0 1 2 unfolding bsqr_def by auto
27.1401 + next
27.1402 + assume Case112: "a2 = b2"
27.1403 + show ?thesis
27.1404 + proof(rule wo_rel.cases_Total3[of r a1 b1], clarsimp simp add: Well, simp add: 0)
27.1405 + assume Case1121: "(a1,b1) \<in> r - Id \<or> (b1,a1) \<in> r - Id"
27.1406 + thus ?thesis using 0 1 2 Case112 unfolding bsqr_def by auto
27.1407 + next
27.1408 + assume Case1122: "a1 = b1"
27.1409 + thus ?thesis using Case112 by auto
27.1410 + qed
27.1411 + qed
27.1412 + next
27.1413 + assume Case12: "(b2,b1) \<in> r"
27.1414 + hence 3: "wo_rel.max2 r b1 b2 = b1" using Well 0 by (simp add: wo_rel.max2_equals1)
27.1415 + show ?thesis
27.1416 + proof(rule wo_rel.cases_Total3[of r a2 b1], clarsimp simp add: Well, simp add: 0)
27.1417 + assume Case121: "(a2,b1) \<in> r - Id \<or> (b1,a2) \<in> r - Id"
27.1418 + thus ?thesis using 0 1 3 unfolding bsqr_def by auto
27.1419 + next
27.1420 + assume Case122: "a2 = b1"
27.1421 + show ?thesis
27.1422 + proof(rule wo_rel.cases_Total3[of r a1 b1], clarsimp simp add: Well, simp add: 0)
27.1423 + assume Case1221: "(a1,b1) \<in> r - Id \<or> (b1,a1) \<in> r - Id"
27.1424 + thus ?thesis using 0 1 3 Case122 unfolding bsqr_def by auto
27.1425 + next
27.1426 + assume Case1222: "a1 = b1"
27.1427 + show ?thesis
27.1428 + proof(rule wo_rel.cases_Total3[of r a2 b2], clarsimp simp add: Well, simp add: 0)
27.1429 + assume Case12221: "(a2,b2) \<in> r - Id \<or> (b2,a2) \<in> r - Id"
27.1430 + thus ?thesis using 0 1 3 Case122 Case1222 unfolding bsqr_def by auto
27.1431 + next
27.1432 + assume Case12222: "a2 = b2"
27.1433 + thus ?thesis using Case122 Case1222 by auto
27.1434 + qed
27.1435 + qed
27.1436 + qed
27.1437 + qed
27.1438 + next
27.1439 + assume Case2: "(a2,a1) \<in> r"
27.1440 + hence 1: "wo_rel.max2 r a1 a2 = a1" using Well 0 by (simp add: wo_rel.max2_equals1)
27.1441 + show ?thesis
27.1442 + proof(rule wo_rel.cases_Total[of r b1 b2], clarsimp simp add: Well, simp add: 0)
27.1443 + assume Case21: "(b1,b2) \<in> r"
27.1444 + hence 2: "wo_rel.max2 r b1 b2 = b2" using Well 0 by (simp add: wo_rel.max2_equals2)
27.1445 + show ?thesis
27.1446 + proof(rule wo_rel.cases_Total3[of r a1 b2], clarsimp simp add: Well, simp add: 0)
27.1447 + assume Case211: "(a1,b2) \<in> r - Id \<or> (b2,a1) \<in> r - Id"
27.1448 + thus ?thesis using 0 1 2 unfolding bsqr_def by auto
27.1449 + next
27.1450 + assume Case212: "a1 = b2"
27.1451 + show ?thesis
27.1452 + proof(rule wo_rel.cases_Total3[of r a1 b1], clarsimp simp add: Well, simp add: 0)
27.1453 + assume Case2121: "(a1,b1) \<in> r - Id \<or> (b1,a1) \<in> r - Id"
27.1454 + thus ?thesis using 0 1 2 Case212 unfolding bsqr_def by auto
27.1455 + next
27.1456 + assume Case2122: "a1 = b1"
27.1457 + show ?thesis
27.1458 + proof(rule wo_rel.cases_Total3[of r a2 b2], clarsimp simp add: Well, simp add: 0)
27.1459 + assume Case21221: "(a2,b2) \<in> r - Id \<or> (b2,a2) \<in> r - Id"
27.1460 + thus ?thesis using 0 1 2 Case212 Case2122 unfolding bsqr_def by auto
27.1461 + next
27.1462 + assume Case21222: "a2 = b2"
27.1463 + thus ?thesis using Case2122 Case212 by auto
27.1464 + qed
27.1465 + qed
27.1466 + qed
27.1467 + next
27.1468 + assume Case22: "(b2,b1) \<in> r"
27.1469 + hence 3: "wo_rel.max2 r b1 b2 = b1" using Well 0 by (simp add: wo_rel.max2_equals1)
27.1470 + show ?thesis
27.1471 + proof(rule wo_rel.cases_Total3[of r a1 b1], clarsimp simp add: Well, simp add: 0)
27.1472 + assume Case221: "(a1,b1) \<in> r - Id \<or> (b1,a1) \<in> r - Id"
27.1473 + thus ?thesis using 0 1 3 unfolding bsqr_def by auto
27.1474 + next
27.1475 + assume Case222: "a1 = b1"
27.1476 + show ?thesis
27.1477 + proof(rule wo_rel.cases_Total3[of r a2 b2], clarsimp simp add: Well, simp add: 0)
27.1478 + assume Case2221: "(a2,b2) \<in> r - Id \<or> (b2,a2) \<in> r - Id"
27.1479 + thus ?thesis using 0 1 3 Case222 unfolding bsqr_def by auto
27.1480 + next
27.1481 + assume Case2222: "a2 = b2"
27.1482 + thus ?thesis using Case222 by auto
27.1483 + qed
27.1484 + qed
27.1485 + qed
27.1486 + qed
27.1487 + }
27.1488 + thus ?thesis unfolding total_on_def by fast
27.1489 +qed
27.1490 +
27.1491 +
27.1492 +lemma bsqr_Linear_order:
27.1493 +assumes "Well_order r"
27.1494 +shows "Linear_order(bsqr r)"
27.1495 +unfolding order_on_defs
27.1496 +using assms bsqr_Refl bsqr_Trans bsqr_antisym bsqr_Total by blast
27.1497 +
27.1498 +
27.1499 +lemma bsqr_Well_order:
27.1500 +assumes "Well_order r"
27.1501 +shows "Well_order(bsqr r)"
27.1502 +using assms
27.1503 +proof(simp add: bsqr_Linear_order Linear_order_Well_order_iff, intro allI impI)
27.1504 + have 0: "\<forall>A \<le> Field r. A \<noteq> {} \<longrightarrow> (\<exists>a \<in> A. \<forall>a' \<in> A. (a,a') \<in> r)"
27.1505 + using assms well_order_on_def Linear_order_Well_order_iff by blast
27.1506 + fix D assume *: "D \<le> Field (bsqr r)" and **: "D \<noteq> {}"
27.1507 + hence 1: "D \<le> Field r \<times> Field r" unfolding Field_bsqr by simp
27.1508 + (* *)
27.1509 + obtain M where M_def: "M = {wo_rel.max2 r a1 a2| a1 a2. (a1,a2) \<in> D}" by blast
27.1510 + have "M \<noteq> {}" using 1 M_def ** by auto
27.1511 + moreover
27.1512 + have "M \<le> Field r" unfolding M_def
27.1513 + using 1 assms wo_rel_def[of r] wo_rel.max2_among[of r] by fastforce
27.1514 + ultimately obtain m where m_min: "m \<in> M \<and> (\<forall>a \<in> M. (m,a) \<in> r)"
27.1515 + using 0 by blast
27.1516 + (* *)
27.1517 + obtain A1 where A1_def: "A1 = {a1. \<exists>a2. (a1,a2) \<in> D \<and> wo_rel.max2 r a1 a2 = m}" by blast
27.1518 + have "A1 \<le> Field r" unfolding A1_def using 1 by auto
27.1519 + moreover have "A1 \<noteq> {}" unfolding A1_def using m_min unfolding M_def by blast
27.1520 + ultimately obtain a1 where a1_min: "a1 \<in> A1 \<and> (\<forall>a \<in> A1. (a1,a) \<in> r)"
27.1521 + using 0 by blast
27.1522 + (* *)
27.1523 + obtain A2 where A2_def: "A2 = {a2. (a1,a2) \<in> D \<and> wo_rel.max2 r a1 a2 = m}" by blast
27.1524 + have "A2 \<le> Field r" unfolding A2_def using 1 by auto
27.1525 + moreover have "A2 \<noteq> {}" unfolding A2_def
27.1526 + using m_min a1_min unfolding A1_def M_def by blast
27.1527 + ultimately obtain a2 where a2_min: "a2 \<in> A2 \<and> (\<forall>a \<in> A2. (a2,a) \<in> r)"
27.1528 + using 0 by blast
27.1529 + (* *)
27.1530 + have 2: "wo_rel.max2 r a1 a2 = m"
27.1531 + using a1_min a2_min unfolding A1_def A2_def by auto
27.1532 + have 3: "(a1,a2) \<in> D" using a2_min unfolding A2_def by auto
27.1533 + (* *)
27.1534 + moreover
27.1535 + {fix b1 b2 assume ***: "(b1,b2) \<in> D"
27.1536 + hence 4: "{a1,a2,b1,b2} \<le> Field r" using 1 3 by blast
27.1537 + have 5: "(wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r"
27.1538 + using *** a1_min a2_min m_min unfolding A1_def A2_def M_def by auto
27.1539 + have "((a1,a2),(b1,b2)) \<in> bsqr r"
27.1540 + proof(cases "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2")
27.1541 + assume Case1: "wo_rel.max2 r a1 a2 \<noteq> wo_rel.max2 r b1 b2"
27.1542 + thus ?thesis unfolding bsqr_def using 4 5 by auto
27.1543 + next
27.1544 + assume Case2: "wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2"
27.1545 + hence "b1 \<in> A1" unfolding A1_def using 2 *** by auto
27.1546 + hence 6: "(a1,b1) \<in> r" using a1_min by auto
27.1547 + show ?thesis
27.1548 + proof(cases "a1 = b1")
27.1549 + assume Case21: "a1 \<noteq> b1"
27.1550 + thus ?thesis unfolding bsqr_def using 4 Case2 6 by auto
27.1551 + next
27.1552 + assume Case22: "a1 = b1"
27.1553 + hence "b2 \<in> A2" unfolding A2_def using 2 *** Case2 by auto
27.1554 + hence 7: "(a2,b2) \<in> r" using a2_min by auto
27.1555 + thus ?thesis unfolding bsqr_def using 4 7 Case2 Case22 by auto
27.1556 + qed
27.1557 + qed
27.1558 + }
27.1559 + (* *)
27.1560 + ultimately show "\<exists>d \<in> D. \<forall>d' \<in> D. (d,d') \<in> bsqr r" by fastforce
27.1561 +qed
27.1562 +
27.1563 +
27.1564 +lemma bsqr_max2:
27.1565 +assumes WELL: "Well_order r" and LEQ: "((a1,a2),(b1,b2)) \<in> bsqr r"
27.1566 +shows "(wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r"
27.1567 +proof-
27.1568 + have "{(a1,a2),(b1,b2)} \<le> Field(bsqr r)"
27.1569 + using LEQ unfolding Field_def by auto
27.1570 + hence "{a1,a2,b1,b2} \<le> Field r" unfolding Field_bsqr by auto
27.1571 + hence "{wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2} \<le> Field r"
27.1572 + using WELL wo_rel_def[of r] wo_rel.max2_among[of r] by fastforce
27.1573 + moreover have "(wo_rel.max2 r a1 a2, wo_rel.max2 r b1 b2) \<in> r \<or> wo_rel.max2 r a1 a2 = wo_rel.max2 r b1 b2"
27.1574 + using LEQ unfolding bsqr_def by auto
27.1575 + ultimately show ?thesis using WELL unfolding order_on_defs refl_on_def by auto
27.1576 +qed
27.1577 +
27.1578 +
27.1579 +lemma bsqr_ofilter:
27.1580 +assumes WELL: "Well_order r" and
27.1581 + OF: "wo_rel.ofilter (bsqr r) D" and SUB: "D < Field r \<times> Field r" and
27.1582 + NE: "\<not> (\<exists>a. Field r = rel.under r a)"
27.1583 +shows "\<exists>A. wo_rel.ofilter r A \<and> A < Field r \<and> D \<le> A \<times> A"
27.1584 +proof-
27.1585 + let ?r' = "bsqr r"
27.1586 + have Well: "wo_rel r" using WELL wo_rel_def by blast
27.1587 + hence Trans: "trans r" using wo_rel.TRANS by blast
27.1588 + have Well': "Well_order ?r' \<and> wo_rel ?r'"
27.1589 + using WELL bsqr_Well_order wo_rel_def by blast
27.1590 + (* *)
27.1591 + have "D < Field ?r'" unfolding Field_bsqr using SUB .
27.1592 + with OF obtain a1 and a2 where
27.1593 + "(a1,a2) \<in> Field ?r'" and 1: "D = rel.underS ?r' (a1,a2)"
27.1594 + using Well' wo_rel.ofilter_underS_Field[of ?r' D] by auto
27.1595 + hence 2: "{a1,a2} \<le> Field r" unfolding Field_bsqr by auto
27.1596 + let ?m = "wo_rel.max2 r a1 a2"
27.1597 + have "D \<le> (rel.under r ?m) \<times> (rel.under r ?m)"
27.1598 + proof(unfold 1)
27.1599 + {fix b1 b2
27.1600 + let ?n = "wo_rel.max2 r b1 b2"
27.1601 + assume "(b1,b2) \<in> rel.underS ?r' (a1,a2)"
27.1602 + hence 3: "((b1,b2),(a1,a2)) \<in> ?r'"
27.1603 + unfolding rel.underS_def by blast
27.1604 + hence "(?n,?m) \<in> r" using WELL by (simp add: bsqr_max2)
27.1605 + moreover
27.1606 + {have "(b1,b2) \<in> Field ?r'" using 3 unfolding Field_def by auto
27.1607 + hence "{b1,b2} \<le> Field r" unfolding Field_bsqr by auto
27.1608 + hence "(b1,?n) \<in> r \<and> (b2,?n) \<in> r"
27.1609 + using Well by (simp add: wo_rel.max2_greater)
27.1610 + }
27.1611 + ultimately have "(b1,?m) \<in> r \<and> (b2,?m) \<in> r"
27.1612 + using Trans trans_def[of r] by blast
27.1613 + hence "(b1,b2) \<in> (rel.under r ?m) \<times> (rel.under r ?m)" unfolding rel.under_def by simp}
27.1614 + thus "rel.underS ?r' (a1,a2) \<le> (rel.under r ?m) \<times> (rel.under r ?m)" by auto
27.1615 + qed
27.1616 + moreover have "wo_rel.ofilter r (rel.under r ?m)"
27.1617 + using Well by (simp add: wo_rel.under_ofilter)
27.1618 + moreover have "rel.under r ?m < Field r"
27.1619 + using NE rel.under_Field[of r ?m] by blast
27.1620 + ultimately show ?thesis by blast
27.1621 +qed
27.1622 +
27.1623 +
27.1624 +end
28.1 --- a/src/HOL/Cardinals/Fun_More.thy Mon Nov 18 17:15:01 2013 +0100
28.2 +++ b/src/HOL/Cardinals/Fun_More.thy Tue Nov 19 17:07:52 2013 +0100
28.3 @@ -8,7 +8,7 @@
28.4 header {* More on Injections, Bijections and Inverses *}
28.5
28.6 theory Fun_More
28.7 -imports Fun_More_Base
28.8 +imports Fun_More_FP
28.9 begin
28.10
28.11
28.12 @@ -132,6 +132,18 @@
28.13 subsection {* Properties involving Hilbert choice *}
28.14
28.15
28.16 +(*1*)lemma bij_betw_inv_into_LEFT:
28.17 +assumes BIJ: "bij_betw f A A'" and SUB: "B \<le> A"
28.18 +shows "(inv_into A f)`(f ` B) = B"
28.19 +using assms unfolding bij_betw_def using inv_into_image_cancel by force
28.20 +
28.21 +(*1*)lemma bij_betw_inv_into_LEFT_RIGHT:
28.22 +assumes BIJ: "bij_betw f A A'" and SUB: "B \<le> A" and
28.23 + IM: "f ` B = B'"
28.24 +shows "(inv_into A f) ` B' = B"
28.25 +using assms bij_betw_inv_into_LEFT[of f A A' B] by fast
28.26 +
28.27 +
28.28 subsection {* Other facts *}
28.29
28.30 (*3*)lemma atLeastLessThan_injective:
29.1 --- a/src/HOL/Cardinals/Fun_More_Base.thy Mon Nov 18 17:15:01 2013 +0100
29.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
29.3 @@ -1,252 +0,0 @@
29.4 -(* Title: HOL/Cardinals/Fun_More_Base.thy
29.5 - Author: Andrei Popescu, TU Muenchen
29.6 - Copyright 2012
29.7 -
29.8 -More on injections, bijections and inverses (base).
29.9 -*)
29.10 -
29.11 -header {* More on Injections, Bijections and Inverses (Base) *}
29.12 -
29.13 -theory Fun_More_Base
29.14 -imports "~~/src/HOL/Library/Infinite_Set"
29.15 -begin
29.16 -
29.17 -
29.18 -text {* This section proves more facts (additional to those in @{text "Fun.thy"},
29.19 -@{text "Hilbert_Choice.thy"}, @{text "Finite_Set.thy"} and @{text "Infinite_Set.thy"}),
29.20 -mainly concerning injections, bijections, inverses and (numeric) cardinals of
29.21 -finite sets. *}
29.22 -
29.23 -
29.24 -subsection {* Purely functional properties *}
29.25 -
29.26 -
29.27 -(*2*)lemma bij_betw_id_iff:
29.28 -"(A = B) = (bij_betw id A B)"
29.29 -by(simp add: bij_betw_def)
29.30 -
29.31 -
29.32 -(*2*)lemma bij_betw_byWitness:
29.33 -assumes LEFT: "\<forall>a \<in> A. f'(f a) = a" and
29.34 - RIGHT: "\<forall>a' \<in> A'. f(f' a') = a'" and
29.35 - IM1: "f ` A \<le> A'" and IM2: "f' ` A' \<le> A"
29.36 -shows "bij_betw f A A'"
29.37 -using assms
29.38 -proof(unfold bij_betw_def inj_on_def, safe)
29.39 - fix a b assume *: "a \<in> A" "b \<in> A" and **: "f a = f b"
29.40 - have "a = f'(f a) \<and> b = f'(f b)" using * LEFT by simp
29.41 - with ** show "a = b" by simp
29.42 -next
29.43 - fix a' assume *: "a' \<in> A'"
29.44 - hence "f' a' \<in> A" using IM2 by blast
29.45 - moreover
29.46 - have "a' = f(f' a')" using * RIGHT by simp
29.47 - ultimately show "a' \<in> f ` A" by blast
29.48 -qed
29.49 -
29.50 -
29.51 -(*3*)corollary notIn_Un_bij_betw:
29.52 -assumes NIN: "b \<notin> A" and NIN': "f b \<notin> A'" and
29.53 - BIJ: "bij_betw f A A'"
29.54 -shows "bij_betw f (A \<union> {b}) (A' \<union> {f b})"
29.55 -proof-
29.56 - have "bij_betw f {b} {f b}"
29.57 - unfolding bij_betw_def inj_on_def by simp
29.58 - with assms show ?thesis
29.59 - using bij_betw_combine[of f A A' "{b}" "{f b}"] by blast
29.60 -qed
29.61 -
29.62 -
29.63 -(*1*)lemma notIn_Un_bij_betw3:
29.64 -assumes NIN: "b \<notin> A" and NIN': "f b \<notin> A'"
29.65 -shows "bij_betw f A A' = bij_betw f (A \<union> {b}) (A' \<union> {f b})"
29.66 -proof
29.67 - assume "bij_betw f A A'"
29.68 - thus "bij_betw f (A \<union> {b}) (A' \<union> {f b})"
29.69 - using assms notIn_Un_bij_betw[of b A f A'] by blast
29.70 -next
29.71 - assume *: "bij_betw f (A \<union> {b}) (A' \<union> {f b})"
29.72 - have "f ` A = A'"
29.73 - proof(auto)
29.74 - fix a assume **: "a \<in> A"
29.75 - hence "f a \<in> A' \<union> {f b}" using * unfolding bij_betw_def by blast
29.76 - moreover
29.77 - {assume "f a = f b"
29.78 - hence "a = b" using * ** unfolding bij_betw_def inj_on_def by blast
29.79 - with NIN ** have False by blast
29.80 - }
29.81 - ultimately show "f a \<in> A'" by blast
29.82 - next
29.83 - fix a' assume **: "a' \<in> A'"
29.84 - hence "a' \<in> f`(A \<union> {b})"
29.85 - using * by (auto simp add: bij_betw_def)
29.86 - then obtain a where 1: "a \<in> A \<union> {b} \<and> f a = a'" by blast
29.87 - moreover
29.88 - {assume "a = b" with 1 ** NIN' have False by blast
29.89 - }
29.90 - ultimately have "a \<in> A" by blast
29.91 - with 1 show "a' \<in> f ` A" by blast
29.92 - qed
29.93 - thus "bij_betw f A A'" using * bij_betw_subset[of f "A \<union> {b}" _ A] by blast
29.94 -qed
29.95 -
29.96 -
29.97 -subsection {* Properties involving finite and infinite sets *}
29.98 -
29.99 -
29.100 -(*3*)lemma inj_on_finite:
29.101 -assumes "inj_on f A" "f ` A \<le> B" "finite B"
29.102 -shows "finite A"
29.103 -using assms infinite_super by (fast dest: finite_imageD)
29.104 -
29.105 -
29.106 -(*3*)lemma infinite_imp_bij_betw:
29.107 -assumes INF: "infinite A"
29.108 -shows "\<exists>h. bij_betw h A (A - {a})"
29.109 -proof(cases "a \<in> A")
29.110 - assume Case1: "a \<notin> A" hence "A - {a} = A" by blast
29.111 - thus ?thesis using bij_betw_id[of A] by auto
29.112 -next
29.113 - assume Case2: "a \<in> A"
29.114 - have "infinite (A - {a})" using INF infinite_remove by auto
29.115 - with infinite_iff_countable_subset[of "A - {a}"] obtain f::"nat \<Rightarrow> 'a"
29.116 - where 1: "inj f" and 2: "f ` UNIV \<le> A - {a}" by blast
29.117 - obtain g where g_def: "g = (\<lambda> n. if n = 0 then a else f (Suc n))" by blast
29.118 - obtain A' where A'_def: "A' = g ` UNIV" by blast
29.119 - have temp: "\<forall>y. f y \<noteq> a" using 2 by blast
29.120 - have 3: "inj_on g UNIV \<and> g ` UNIV \<le> A \<and> a \<in> g ` UNIV"
29.121 - proof(auto simp add: Case2 g_def, unfold inj_on_def, intro ballI impI,
29.122 - case_tac "x = 0", auto simp add: 2)
29.123 - fix y assume "a = (if y = 0 then a else f (Suc y))"
29.124 - thus "y = 0" using temp by (case_tac "y = 0", auto)
29.125 - next
29.126 - fix x y
29.127 - assume "f (Suc x) = (if y = 0 then a else f (Suc y))"
29.128 - thus "x = y" using 1 temp unfolding inj_on_def by (case_tac "y = 0", auto)
29.129 - next
29.130 - fix n show "f (Suc n) \<in> A" using 2 by blast
29.131 - qed
29.132 - hence 4: "bij_betw g UNIV A' \<and> a \<in> A' \<and> A' \<le> A"
29.133 - using inj_on_imp_bij_betw[of g] unfolding A'_def by auto
29.134 - hence 5: "bij_betw (inv g) A' UNIV"
29.135 - by (auto simp add: bij_betw_inv_into)
29.136 - (* *)
29.137 - obtain n where "g n = a" using 3 by auto
29.138 - hence 6: "bij_betw g (UNIV - {n}) (A' - {a})"
29.139 - using 3 4 unfolding A'_def
29.140 - by clarify (rule bij_betw_subset, auto simp: image_set_diff)
29.141 - (* *)
29.142 - obtain v where v_def: "v = (\<lambda> m. if m < n then m else Suc m)" by blast
29.143 - have 7: "bij_betw v UNIV (UNIV - {n})"
29.144 - proof(unfold bij_betw_def inj_on_def, intro conjI, clarify)
29.145 - fix m1 m2 assume "v m1 = v m2"
29.146 - thus "m1 = m2"
29.147 - by(case_tac "m1 < n", case_tac "m2 < n",
29.148 - auto simp add: inj_on_def v_def, case_tac "m2 < n", auto)
29.149 - next
29.150 - show "v ` UNIV = UNIV - {n}"
29.151 - proof(auto simp add: v_def)
29.152 - fix m assume *: "m \<noteq> n" and **: "m \<notin> Suc ` {m'. \<not> m' < n}"
29.153 - {assume "n \<le> m" with * have 71: "Suc n \<le> m" by auto
29.154 - then obtain m' where 72: "m = Suc m'" using Suc_le_D by auto
29.155 - with 71 have "n \<le> m'" by auto
29.156 - with 72 ** have False by auto
29.157 - }
29.158 - thus "m < n" by force
29.159 - qed
29.160 - qed
29.161 - (* *)
29.162 - obtain h' where h'_def: "h' = g o v o (inv g)" by blast
29.163 - hence 8: "bij_betw h' A' (A' - {a})" using 5 7 6
29.164 - by (auto simp add: bij_betw_trans)
29.165 - (* *)
29.166 - obtain h where h_def: "h = (\<lambda> b. if b \<in> A' then h' b else b)" by blast
29.167 - have "\<forall>b \<in> A'. h b = h' b" unfolding h_def by auto
29.168 - hence "bij_betw h A' (A' - {a})" using 8 bij_betw_cong[of A' h] by auto
29.169 - moreover
29.170 - {have "\<forall>b \<in> A - A'. h b = b" unfolding h_def by auto
29.171 - hence "bij_betw h (A - A') (A - A')"
29.172 - using bij_betw_cong[of "A - A'" h id] bij_betw_id[of "A - A'"] by auto
29.173 - }
29.174 - moreover
29.175 - have "(A' Int (A - A') = {} \<and> A' \<union> (A - A') = A) \<and>
29.176 - ((A' - {a}) Int (A - A') = {} \<and> (A' - {a}) \<union> (A - A') = A - {a})"
29.177 - using 4 by blast
29.178 - ultimately have "bij_betw h A (A - {a})"
29.179 - using bij_betw_combine[of h A' "A' - {a}" "A - A'" "A - A'"] by simp
29.180 - thus ?thesis by blast
29.181 -qed
29.182 -
29.183 -
29.184 -(*3*)lemma infinite_imp_bij_betw2:
29.185 -assumes INF: "infinite A"
29.186 -shows "\<exists>h. bij_betw h A (A \<union> {a})"
29.187 -proof(cases "a \<in> A")
29.188 - assume Case1: "a \<in> A" hence "A \<union> {a} = A" by blast
29.189 - thus ?thesis using bij_betw_id[of A] by auto
29.190 -next
29.191 - let ?A' = "A \<union> {a}"
29.192 - assume Case2: "a \<notin> A" hence "A = ?A' - {a}" by blast
29.193 - moreover have "infinite ?A'" using INF by auto
29.194 - ultimately obtain f where "bij_betw f ?A' A"
29.195 - using infinite_imp_bij_betw[of ?A' a] by auto
29.196 - hence "bij_betw(inv_into ?A' f) A ?A'" using bij_betw_inv_into by blast
29.197 - thus ?thesis by auto
29.198 -qed
29.199 -
29.200 -
29.201 -subsection {* Properties involving Hilbert choice *}
29.202 -
29.203 -
29.204 -(*2*)lemma bij_betw_inv_into_left:
29.205 -assumes BIJ: "bij_betw f A A'" and IN: "a \<in> A"
29.206 -shows "(inv_into A f) (f a) = a"
29.207 -using assms unfolding bij_betw_def
29.208 -by clarify (rule inv_into_f_f)
29.209 -
29.210 -(*2*)lemma bij_betw_inv_into_right:
29.211 -assumes "bij_betw f A A'" "a' \<in> A'"
29.212 -shows "f(inv_into A f a') = a'"
29.213 -using assms unfolding bij_betw_def using f_inv_into_f by force
29.214 -
29.215 -
29.216 -(*1*)lemma bij_betw_inv_into_LEFT:
29.217 -assumes BIJ: "bij_betw f A A'" and SUB: "B \<le> A"
29.218 -shows "(inv_into A f)`(f ` B) = B"
29.219 -using assms unfolding bij_betw_def using inv_into_image_cancel by force
29.220 -
29.221 -
29.222 -(*1*)lemma bij_betw_inv_into_LEFT_RIGHT:
29.223 -assumes BIJ: "bij_betw f A A'" and SUB: "B \<le> A" and
29.224 - IM: "f ` B = B'"
29.225 -shows "(inv_into A f) ` B' = B"
29.226 -using assms bij_betw_inv_into_LEFT[of f A A' B] by fast
29.227 -
29.228 -
29.229 -(*1*)lemma bij_betw_inv_into_subset:
29.230 -assumes BIJ: "bij_betw f A A'" and
29.231 - SUB: "B \<le> A" and IM: "f ` B = B'"
29.232 -shows "bij_betw (inv_into A f) B' B"
29.233 -using assms unfolding bij_betw_def
29.234 -by (auto intro: inj_on_inv_into)
29.235 -
29.236 -
29.237 -subsection {* Other facts *}
29.238 -
29.239 -
29.240 -(*2*)lemma atLeastLessThan_less_eq:
29.241 -"({0..<m} \<le> {0..<n}) = ((m::nat) \<le> n)"
29.242 -unfolding ivl_subset by arith
29.243 -
29.244 -
29.245 -(*2*)lemma atLeastLessThan_less_eq2:
29.246 -assumes "inj_on f {0..<(m::nat)} \<and> f ` {0..<m} \<le> {0..<n}"
29.247 -shows "m \<le> n"
29.248 -using assms
29.249 -using finite_atLeastLessThan[of m] finite_atLeastLessThan[of n]
29.250 - card_atLeastLessThan[of m] card_atLeastLessThan[of n]
29.251 - card_inj_on_le[of f "{0 ..< m}" "{0 ..< n}"] by auto
29.252 -
29.253 -
29.254 -
29.255 -end
30.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
30.2 +++ b/src/HOL/Cardinals/Fun_More_FP.thy Tue Nov 19 17:07:52 2013 +0100
30.3 @@ -0,0 +1,239 @@
30.4 +(* Title: HOL/Cardinals/Fun_More_FP.thy
30.5 + Author: Andrei Popescu, TU Muenchen
30.6 + Copyright 2012
30.7 +
30.8 +More on injections, bijections and inverses (FP).
30.9 +*)
30.10 +
30.11 +header {* More on Injections, Bijections and Inverses (FP) *}
30.12 +
30.13 +theory Fun_More_FP
30.14 +imports "~~/src/HOL/Library/Infinite_Set"
30.15 +begin
30.16 +
30.17 +
30.18 +text {* This section proves more facts (additional to those in @{text "Fun.thy"},
30.19 +@{text "Hilbert_Choice.thy"}, @{text "Finite_Set.thy"} and @{text "Infinite_Set.thy"}),
30.20 +mainly concerning injections, bijections, inverses and (numeric) cardinals of
30.21 +finite sets. *}
30.22 +
30.23 +
30.24 +subsection {* Purely functional properties *}
30.25 +
30.26 +
30.27 +(*2*)lemma bij_betw_id_iff:
30.28 +"(A = B) = (bij_betw id A B)"
30.29 +by(simp add: bij_betw_def)
30.30 +
30.31 +
30.32 +(*2*)lemma bij_betw_byWitness:
30.33 +assumes LEFT: "\<forall>a \<in> A. f'(f a) = a" and
30.34 + RIGHT: "\<forall>a' \<in> A'. f(f' a') = a'" and
30.35 + IM1: "f ` A \<le> A'" and IM2: "f' ` A' \<le> A"
30.36 +shows "bij_betw f A A'"
30.37 +using assms
30.38 +proof(unfold bij_betw_def inj_on_def, safe)
30.39 + fix a b assume *: "a \<in> A" "b \<in> A" and **: "f a = f b"
30.40 + have "a = f'(f a) \<and> b = f'(f b)" using * LEFT by simp
30.41 + with ** show "a = b" by simp
30.42 +next
30.43 + fix a' assume *: "a' \<in> A'"
30.44 + hence "f' a' \<in> A" using IM2 by blast
30.45 + moreover
30.46 + have "a' = f(f' a')" using * RIGHT by simp
30.47 + ultimately show "a' \<in> f ` A" by blast
30.48 +qed
30.49 +
30.50 +
30.51 +(*3*)corollary notIn_Un_bij_betw:
30.52 +assumes NIN: "b \<notin> A" and NIN': "f b \<notin> A'" and
30.53 + BIJ: "bij_betw f A A'"
30.54 +shows "bij_betw f (A \<union> {b}) (A' \<union> {f b})"
30.55 +proof-
30.56 + have "bij_betw f {b} {f b}"
30.57 + unfolding bij_betw_def inj_on_def by simp
30.58 + with assms show ?thesis
30.59 + using bij_betw_combine[of f A A' "{b}" "{f b}"] by blast
30.60 +qed
30.61 +
30.62 +
30.63 +(*1*)lemma notIn_Un_bij_betw3:
30.64 +assumes NIN: "b \<notin> A" and NIN': "f b \<notin> A'"
30.65 +shows "bij_betw f A A' = bij_betw f (A \<union> {b}) (A' \<union> {f b})"
30.66 +proof
30.67 + assume "bij_betw f A A'"
30.68 + thus "bij_betw f (A \<union> {b}) (A' \<union> {f b})"
30.69 + using assms notIn_Un_bij_betw[of b A f A'] by blast
30.70 +next
30.71 + assume *: "bij_betw f (A \<union> {b}) (A' \<union> {f b})"
30.72 + have "f ` A = A'"
30.73 + proof(auto)
30.74 + fix a assume **: "a \<in> A"
30.75 + hence "f a \<in> A' \<union> {f b}" using * unfolding bij_betw_def by blast
30.76 + moreover
30.77 + {assume "f a = f b"
30.78 + hence "a = b" using * ** unfolding bij_betw_def inj_on_def by blast
30.79 + with NIN ** have False by blast
30.80 + }
30.81 + ultimately show "f a \<in> A'" by blast
30.82 + next
30.83 + fix a' assume **: "a' \<in> A'"
30.84 + hence "a' \<in> f`(A \<union> {b})"
30.85 + using * by (auto simp add: bij_betw_def)
30.86 + then obtain a where 1: "a \<in> A \<union> {b} \<and> f a = a'" by blast
30.87 + moreover
30.88 + {assume "a = b" with 1 ** NIN' have False by blast
30.89 + }
30.90 + ultimately have "a \<in> A" by blast
30.91 + with 1 show "a' \<in> f ` A" by blast
30.92 + qed
30.93 + thus "bij_betw f A A'" using * bij_betw_subset[of f "A \<union> {b}" _ A] by blast
30.94 +qed
30.95 +
30.96 +
30.97 +subsection {* Properties involving finite and infinite sets *}
30.98 +
30.99 +
30.100 +(*3*)lemma inj_on_finite:
30.101 +assumes "inj_on f A" "f ` A \<le> B" "finite B"
30.102 +shows "finite A"
30.103 +using assms infinite_super by (fast dest: finite_imageD)
30.104 +
30.105 +
30.106 +(*3*)lemma infinite_imp_bij_betw:
30.107 +assumes INF: "infinite A"
30.108 +shows "\<exists>h. bij_betw h A (A - {a})"
30.109 +proof(cases "a \<in> A")
30.110 + assume Case1: "a \<notin> A" hence "A - {a} = A" by blast
30.111 + thus ?thesis using bij_betw_id[of A] by auto
30.112 +next
30.113 + assume Case2: "a \<in> A"
30.114 + have "infinite (A - {a})" using INF infinite_remove by auto
30.115 + with infinite_iff_countable_subset[of "A - {a}"] obtain f::"nat \<Rightarrow> 'a"
30.116 + where 1: "inj f" and 2: "f ` UNIV \<le> A - {a}" by blast
30.117 + obtain g where g_def: "g = (\<lambda> n. if n = 0 then a else f (Suc n))" by blast
30.118 + obtain A' where A'_def: "A' = g ` UNIV" by blast
30.119 + have temp: "\<forall>y. f y \<noteq> a" using 2 by blast
30.120 + have 3: "inj_on g UNIV \<and> g ` UNIV \<le> A \<and> a \<in> g ` UNIV"
30.121 + proof(auto simp add: Case2 g_def, unfold inj_on_def, intro ballI impI,
30.122 + case_tac "x = 0", auto simp add: 2)
30.123 + fix y assume "a = (if y = 0 then a else f (Suc y))"
30.124 + thus "y = 0" using temp by (case_tac "y = 0", auto)
30.125 + next
30.126 + fix x y
30.127 + assume "f (Suc x) = (if y = 0 then a else f (Suc y))"
30.128 + thus "x = y" using 1 temp unfolding inj_on_def by (case_tac "y = 0", auto)
30.129 + next
30.130 + fix n show "f (Suc n) \<in> A" using 2 by blast
30.131 + qed
30.132 + hence 4: "bij_betw g UNIV A' \<and> a \<in> A' \<and> A' \<le> A"
30.133 + using inj_on_imp_bij_betw[of g] unfolding A'_def by auto
30.134 + hence 5: "bij_betw (inv g) A' UNIV"
30.135 + by (auto simp add: bij_betw_inv_into)
30.136 + (* *)
30.137 + obtain n where "g n = a" using 3 by auto
30.138 + hence 6: "bij_betw g (UNIV - {n}) (A' - {a})"
30.139 + using 3 4 unfolding A'_def
30.140 + by clarify (rule bij_betw_subset, auto simp: image_set_diff)
30.141 + (* *)
30.142 + obtain v where v_def: "v = (\<lambda> m. if m < n then m else Suc m)" by blast
30.143 + have 7: "bij_betw v UNIV (UNIV - {n})"
30.144 + proof(unfold bij_betw_def inj_on_def, intro conjI, clarify)
30.145 + fix m1 m2 assume "v m1 = v m2"
30.146 + thus "m1 = m2"
30.147 + by(case_tac "m1 < n", case_tac "m2 < n",
30.148 + auto simp add: inj_on_def v_def, case_tac "m2 < n", auto)
30.149 + next
30.150 + show "v ` UNIV = UNIV - {n}"
30.151 + proof(auto simp add: v_def)
30.152 + fix m assume *: "m \<noteq> n" and **: "m \<notin> Suc ` {m'. \<not> m' < n}"
30.153 + {assume "n \<le> m" with * have 71: "Suc n \<le> m" by auto
30.154 + then obtain m' where 72: "m = Suc m'" using Suc_le_D by auto
30.155 + with 71 have "n \<le> m'" by auto
30.156 + with 72 ** have False by auto
30.157 + }
30.158 + thus "m < n" by force
30.159 + qed
30.160 + qed
30.161 + (* *)
30.162 + obtain h' where h'_def: "h' = g o v o (inv g)" by blast
30.163 + hence 8: "bij_betw h' A' (A' - {a})" using 5 7 6
30.164 + by (auto simp add: bij_betw_trans)
30.165 + (* *)
30.166 + obtain h where h_def: "h = (\<lambda> b. if b \<in> A' then h' b else b)" by blast
30.167 + have "\<forall>b \<in> A'. h b = h' b" unfolding h_def by auto
30.168 + hence "bij_betw h A' (A' - {a})" using 8 bij_betw_cong[of A' h] by auto
30.169 + moreover
30.170 + {have "\<forall>b \<in> A - A'. h b = b" unfolding h_def by auto
30.171 + hence "bij_betw h (A - A') (A - A')"
30.172 + using bij_betw_cong[of "A - A'" h id] bij_betw_id[of "A - A'"] by auto
30.173 + }
30.174 + moreover
30.175 + have "(A' Int (A - A') = {} \<and> A' \<union> (A - A') = A) \<and>
30.176 + ((A' - {a}) Int (A - A') = {} \<and> (A' - {a}) \<union> (A - A') = A - {a})"
30.177 + using 4 by blast
30.178 + ultimately have "bij_betw h A (A - {a})"
30.179 + using bij_betw_combine[of h A' "A' - {a}" "A - A'" "A - A'"] by simp
30.180 + thus ?thesis by blast
30.181 +qed
30.182 +
30.183 +
30.184 +(*3*)lemma infinite_imp_bij_betw2:
30.185 +assumes INF: "infinite A"
30.186 +shows "\<exists>h. bij_betw h A (A \<union> {a})"
30.187 +proof(cases "a \<in> A")
30.188 + assume Case1: "a \<in> A" hence "A \<union> {a} = A" by blast
30.189 + thus ?thesis using bij_betw_id[of A] by auto
30.190 +next
30.191 + let ?A' = "A \<union> {a}"
30.192 + assume Case2: "a \<notin> A" hence "A = ?A' - {a}" by blast
30.193 + moreover have "infinite ?A'" using INF by auto
30.194 + ultimately obtain f where "bij_betw f ?A' A"
30.195 + using infinite_imp_bij_betw[of ?A' a] by auto
30.196 + hence "bij_betw(inv_into ?A' f) A ?A'" using bij_betw_inv_into by blast
30.197 + thus ?thesis by auto
30.198 +qed
30.199 +
30.200 +
30.201 +subsection {* Properties involving Hilbert choice *}
30.202 +
30.203 +
30.204 +(*2*)lemma bij_betw_inv_into_left:
30.205 +assumes BIJ: "bij_betw f A A'" and IN: "a \<in> A"
30.206 +shows "(inv_into A f) (f a) = a"
30.207 +using assms unfolding bij_betw_def
30.208 +by clarify (rule inv_into_f_f)
30.209 +
30.210 +(*2*)lemma bij_betw_inv_into_right:
30.211 +assumes "bij_betw f A A'" "a' \<in> A'"
30.212 +shows "f(inv_into A f a') = a'"
30.213 +using assms unfolding bij_betw_def using f_inv_into_f by force
30.214 +
30.215 +
30.216 +(*1*)lemma bij_betw_inv_into_subset:
30.217 +assumes BIJ: "bij_betw f A A'" and
30.218 + SUB: "B \<le> A" and IM: "f ` B = B'"
30.219 +shows "bij_betw (inv_into A f) B' B"
30.220 +using assms unfolding bij_betw_def
30.221 +by (auto intro: inj_on_inv_into)
30.222 +
30.223 +
30.224 +subsection {* Other facts *}
30.225 +
30.226 +
30.227 +(*2*)lemma atLeastLessThan_less_eq:
30.228 +"({0..<m} \<le> {0..<n}) = ((m::nat) \<le> n)"
30.229 +unfolding ivl_subset by arith
30.230 +
30.231 +
30.232 +(*2*)lemma atLeastLessThan_less_eq2:
30.233 +assumes "inj_on f {0..<(m::nat)} \<and> f ` {0..<m} \<le> {0..<n}"
30.234 +shows "m \<le> n"
30.235 +using assms
30.236 +using finite_atLeastLessThan[of m] finite_atLeastLessThan[of n]
30.237 + card_atLeastLessThan[of m] card_atLeastLessThan[of n]
30.238 + card_inj_on_le[of f "{0 ..< m}" "{0 ..< n}"] by fastforce
30.239 +
30.240 +
30.241 +
30.242 +end
31.1 --- a/src/HOL/Cardinals/Order_Relation_More.thy Mon Nov 18 17:15:01 2013 +0100
31.2 +++ b/src/HOL/Cardinals/Order_Relation_More.thy Tue Nov 19 17:07:52 2013 +0100
31.3 @@ -8,64 +8,70 @@
31.4 header {* Basics on Order-Like Relations *}
31.5
31.6 theory Order_Relation_More
31.7 -imports Order_Relation_More_Base
31.8 +imports Order_Relation_More_FP
31.9 begin
31.10
31.11
31.12 subsection {* The upper and lower bounds operators *}
31.13
31.14 -lemma (in rel) aboveS_subset_above: "aboveS a \<le> above a"
31.15 +context rel
31.16 +begin
31.17 +
31.18 +lemma aboveS_subset_above: "aboveS a \<le> above a"
31.19 by(auto simp add: aboveS_def above_def)
31.20
31.21 -lemma (in rel) AboveS_subset_Above: "AboveS A \<le> Above A"
31.22 +lemma AboveS_subset_Above: "AboveS A \<le> Above A"
31.23 by(auto simp add: AboveS_def Above_def)
31.24
31.25 -lemma (in rel) UnderS_disjoint: "A Int (UnderS A) = {}"
31.26 +lemma UnderS_disjoint: "A Int (UnderS A) = {}"
31.27 by(auto simp add: UnderS_def)
31.28
31.29 -lemma (in rel) aboveS_notIn: "a \<notin> aboveS a"
31.30 +lemma aboveS_notIn: "a \<notin> aboveS a"
31.31 by(auto simp add: aboveS_def)
31.32
31.33 -lemma (in rel) Refl_above_in: "\<lbrakk>Refl r; a \<in> Field r\<rbrakk> \<Longrightarrow> a \<in> above a"
31.34 +lemma Refl_above_in: "\<lbrakk>Refl r; a \<in> Field r\<rbrakk> \<Longrightarrow> a \<in> above a"
31.35 by(auto simp add: refl_on_def above_def)
31.36
31.37 -lemma (in rel) in_Above_under: "a \<in> Field r \<Longrightarrow> a \<in> Above (under a)"
31.38 +lemma in_Above_under: "a \<in> Field r \<Longrightarrow> a \<in> Above (under a)"
31.39 by(auto simp add: Above_def under_def)
31.40
31.41 -lemma (in rel) in_Under_above: "a \<in> Field r \<Longrightarrow> a \<in> Under (above a)"
31.42 +lemma in_Under_above: "a \<in> Field r \<Longrightarrow> a \<in> Under (above a)"
31.43 by(auto simp add: Under_def above_def)
31.44
31.45 -lemma (in rel) in_UnderS_aboveS: "a \<in> Field r \<Longrightarrow> a \<in> UnderS (aboveS a)"
31.46 +lemma in_UnderS_aboveS: "a \<in> Field r \<Longrightarrow> a \<in> UnderS (aboveS a)"
31.47 by(auto simp add: UnderS_def aboveS_def)
31.48
31.49 -lemma (in rel) subset_Above_Under: "B \<le> Field r \<Longrightarrow> B \<le> Above (Under B)"
31.50 +lemma UnderS_subset_Under: "UnderS A \<le> Under A"
31.51 +by(auto simp add: UnderS_def Under_def)
31.52 +
31.53 +lemma subset_Above_Under: "B \<le> Field r \<Longrightarrow> B \<le> Above (Under B)"
31.54 by(auto simp add: Above_def Under_def)
31.55
31.56 -lemma (in rel) subset_Under_Above: "B \<le> Field r \<Longrightarrow> B \<le> Under (Above B)"
31.57 +lemma subset_Under_Above: "B \<le> Field r \<Longrightarrow> B \<le> Under (Above B)"
31.58 by(auto simp add: Under_def Above_def)
31.59
31.60 -lemma (in rel) subset_AboveS_UnderS: "B \<le> Field r \<Longrightarrow> B \<le> AboveS (UnderS B)"
31.61 +lemma subset_AboveS_UnderS: "B \<le> Field r \<Longrightarrow> B \<le> AboveS (UnderS B)"
31.62 by(auto simp add: AboveS_def UnderS_def)
31.63
31.64 -lemma (in rel) subset_UnderS_AboveS: "B \<le> Field r \<Longrightarrow> B \<le> UnderS (AboveS B)"
31.65 +lemma subset_UnderS_AboveS: "B \<le> Field r \<Longrightarrow> B \<le> UnderS (AboveS B)"
31.66 by(auto simp add: UnderS_def AboveS_def)
31.67
31.68 -lemma (in rel) Under_Above_Galois:
31.69 +lemma Under_Above_Galois:
31.70 "\<lbrakk>B \<le> Field r; C \<le> Field r\<rbrakk> \<Longrightarrow> (B \<le> Above C) = (C \<le> Under B)"
31.71 by(unfold Above_def Under_def, blast)
31.72
31.73 -lemma (in rel) UnderS_AboveS_Galois:
31.74 +lemma UnderS_AboveS_Galois:
31.75 "\<lbrakk>B \<le> Field r; C \<le> Field r\<rbrakk> \<Longrightarrow> (B \<le> AboveS C) = (C \<le> UnderS B)"
31.76 by(unfold AboveS_def UnderS_def, blast)
31.77
31.78 -lemma (in rel) Refl_above_aboveS:
31.79 +lemma Refl_above_aboveS:
31.80 assumes REFL: "Refl r" and IN: "a \<in> Field r"
31.81 shows "above a = aboveS a \<union> {a}"
31.82 proof(unfold above_def aboveS_def, auto)
31.83 show "(a,a) \<in> r" using REFL IN refl_on_def[of _ r] by blast
31.84 qed
31.85
31.86 -lemma (in rel) Linear_order_under_aboveS_Field:
31.87 +lemma Linear_order_under_aboveS_Field:
31.88 assumes LIN: "Linear_order r" and IN: "a \<in> Field r"
31.89 shows "Field r = under a \<union> aboveS a"
31.90 proof(unfold under_def aboveS_def, auto)
31.91 @@ -88,7 +94,7 @@
31.92 using LIN order_on_defs[of "Field r" r] refl_on_def[of "Field r" r] by blast
31.93 qed
31.94
31.95 -lemma (in rel) Linear_order_underS_above_Field:
31.96 +lemma Linear_order_underS_above_Field:
31.97 assumes LIN: "Linear_order r" and IN: "a \<in> Field r"
31.98 shows "Field r = underS a \<union> above a"
31.99 proof(unfold underS_def above_def, auto)
31.100 @@ -111,19 +117,25 @@
31.101 using LIN order_on_defs[of "Field r" r] refl_on_def[of "Field r" r] by blast
31.102 qed
31.103
31.104 -lemma (in rel) under_empty: "a \<notin> Field r \<Longrightarrow> under a = {}"
31.105 +lemma under_empty: "a \<notin> Field r \<Longrightarrow> under a = {}"
31.106 unfolding Field_def under_def by auto
31.107
31.108 -lemma (in rel) above_Field: "above a \<le> Field r"
31.109 +lemma Under_Field: "Under A \<le> Field r"
31.110 +by(unfold Under_def Field_def, auto)
31.111 +
31.112 +lemma UnderS_Field: "UnderS A \<le> Field r"
31.113 +by(unfold UnderS_def Field_def, auto)
31.114 +
31.115 +lemma above_Field: "above a \<le> Field r"
31.116 by(unfold above_def Field_def, auto)
31.117
31.118 -lemma (in rel) aboveS_Field: "aboveS a \<le> Field r"
31.119 +lemma aboveS_Field: "aboveS a \<le> Field r"
31.120 by(unfold aboveS_def Field_def, auto)
31.121
31.122 -lemma (in rel) Above_Field: "Above A \<le> Field r"
31.123 +lemma Above_Field: "Above A \<le> Field r"
31.124 by(unfold Above_def Field_def, auto)
31.125
31.126 -lemma (in rel) Refl_under_Under:
31.127 +lemma Refl_under_Under:
31.128 assumes REFL: "Refl r" and NE: "A \<noteq> {}"
31.129 shows "Under A = (\<Inter> a \<in> A. under a)"
31.130 proof
31.131 @@ -147,7 +159,7 @@
31.132 qed
31.133 qed
31.134
31.135 -lemma (in rel) Refl_underS_UnderS:
31.136 +lemma Refl_underS_UnderS:
31.137 assumes REFL: "Refl r" and NE: "A \<noteq> {}"
31.138 shows "UnderS A = (\<Inter> a \<in> A. underS a)"
31.139 proof
31.140 @@ -171,7 +183,7 @@
31.141 qed
31.142 qed
31.143
31.144 -lemma (in rel) Refl_above_Above:
31.145 +lemma Refl_above_Above:
31.146 assumes REFL: "Refl r" and NE: "A \<noteq> {}"
31.147 shows "Above A = (\<Inter> a \<in> A. above a)"
31.148 proof
31.149 @@ -195,7 +207,7 @@
31.150 qed
31.151 qed
31.152
31.153 -lemma (in rel) Refl_aboveS_AboveS:
31.154 +lemma Refl_aboveS_AboveS:
31.155 assumes REFL: "Refl r" and NE: "A \<noteq> {}"
31.156 shows "AboveS A = (\<Inter> a \<in> A. aboveS a)"
31.157 proof
31.158 @@ -219,31 +231,31 @@
31.159 qed
31.160 qed
31.161
31.162 -lemma (in rel) under_Under_singl: "under a = Under {a}"
31.163 +lemma under_Under_singl: "under a = Under {a}"
31.164 by(unfold Under_def under_def, auto simp add: Field_def)
31.165
31.166 -lemma (in rel) underS_UnderS_singl: "underS a = UnderS {a}"
31.167 +lemma underS_UnderS_singl: "underS a = UnderS {a}"
31.168 by(unfold UnderS_def underS_def, auto simp add: Field_def)
31.169
31.170 -lemma (in rel) above_Above_singl: "above a = Above {a}"
31.171 +lemma above_Above_singl: "above a = Above {a}"
31.172 by(unfold Above_def above_def, auto simp add: Field_def)
31.173
31.174 -lemma (in rel) aboveS_AboveS_singl: "aboveS a = AboveS {a}"
31.175 +lemma aboveS_AboveS_singl: "aboveS a = AboveS {a}"
31.176 by(unfold AboveS_def aboveS_def, auto simp add: Field_def)
31.177
31.178 -lemma (in rel) Under_decr: "A \<le> B \<Longrightarrow> Under B \<le> Under A"
31.179 +lemma Under_decr: "A \<le> B \<Longrightarrow> Under B \<le> Under A"
31.180 by(unfold Under_def, auto)
31.181
31.182 -lemma (in rel) UnderS_decr: "A \<le> B \<Longrightarrow> UnderS B \<le> UnderS A"
31.183 +lemma UnderS_decr: "A \<le> B \<Longrightarrow> UnderS B \<le> UnderS A"
31.184 by(unfold UnderS_def, auto)
31.185
31.186 -lemma (in rel) Above_decr: "A \<le> B \<Longrightarrow> Above B \<le> Above A"
31.187 +lemma Above_decr: "A \<le> B \<Longrightarrow> Above B \<le> Above A"
31.188 by(unfold Above_def, auto)
31.189
31.190 -lemma (in rel) AboveS_decr: "A \<le> B \<Longrightarrow> AboveS B \<le> AboveS A"
31.191 +lemma AboveS_decr: "A \<le> B \<Longrightarrow> AboveS B \<le> AboveS A"
31.192 by(unfold AboveS_def, auto)
31.193
31.194 -lemma (in rel) under_incl_iff:
31.195 +lemma under_incl_iff:
31.196 assumes TRANS: "trans r" and REFL: "Refl r" and IN: "a \<in> Field r"
31.197 shows "(under a \<le> under b) = ((a,b) \<in> r)"
31.198 proof
31.199 @@ -259,7 +271,7 @@
31.200 by (auto simp add: under_def)
31.201 qed
31.202
31.203 -lemma (in rel) above_decr:
31.204 +lemma above_decr:
31.205 assumes TRANS: "trans r" and REL: "(a,b) \<in> r"
31.206 shows "above b \<le> above a"
31.207 proof(unfold above_def, auto)
31.208 @@ -268,7 +280,7 @@
31.209 show "(a,x) \<in> r" by blast
31.210 qed
31.211
31.212 -lemma (in rel) aboveS_decr:
31.213 +lemma aboveS_decr:
31.214 assumes TRANS: "trans r" and ANTISYM: "antisym r" and
31.215 REL: "(a,b) \<in> r"
31.216 shows "aboveS b \<le> aboveS a"
31.217 @@ -282,7 +294,7 @@
31.218 show "(a,x) \<in> r" by blast
31.219 qed
31.220
31.221 -lemma (in rel) under_trans:
31.222 +lemma under_trans:
31.223 assumes TRANS: "trans r" and
31.224 IN1: "a \<in> under b" and IN2: "b \<in> under c"
31.225 shows "a \<in> under c"
31.226 @@ -294,7 +306,7 @@
31.227 thus ?thesis unfolding under_def by simp
31.228 qed
31.229
31.230 -lemma (in rel) under_underS_trans:
31.231 +lemma under_underS_trans:
31.232 assumes TRANS: "trans r" and ANTISYM: "antisym r" and
31.233 IN1: "a \<in> under b" and IN2: "b \<in> underS c"
31.234 shows "a \<in> underS c"
31.235 @@ -312,7 +324,7 @@
31.236 from 1 3 show ?thesis unfolding underS_def by simp
31.237 qed
31.238
31.239 -lemma (in rel) underS_under_trans:
31.240 +lemma underS_under_trans:
31.241 assumes TRANS: "trans r" and ANTISYM: "antisym r" and
31.242 IN1: "a \<in> underS b" and IN2: "b \<in> under c"
31.243 shows "a \<in> underS c"
31.244 @@ -330,7 +342,7 @@
31.245 from 1 3 show ?thesis unfolding underS_def by simp
31.246 qed
31.247
31.248 -lemma (in rel) underS_underS_trans:
31.249 +lemma underS_underS_trans:
31.250 assumes TRANS: "trans r" and ANTISYM: "antisym r" and
31.251 IN1: "a \<in> underS b" and IN2: "b \<in> underS c"
31.252 shows "a \<in> underS c"
31.253 @@ -340,7 +352,7 @@
31.254 with assms under_underS_trans show ?thesis by auto
31.255 qed
31.256
31.257 -lemma (in rel) above_trans:
31.258 +lemma above_trans:
31.259 assumes TRANS: "trans r" and
31.260 IN1: "b \<in> above a" and IN2: "c \<in> above b"
31.261 shows "c \<in> above a"
31.262 @@ -352,7 +364,7 @@
31.263 thus ?thesis unfolding above_def by simp
31.264 qed
31.265
31.266 -lemma (in rel) above_aboveS_trans:
31.267 +lemma above_aboveS_trans:
31.268 assumes TRANS: "trans r" and ANTISYM: "antisym r" and
31.269 IN1: "b \<in> above a" and IN2: "c \<in> aboveS b"
31.270 shows "c \<in> aboveS a"
31.271 @@ -370,7 +382,7 @@
31.272 from 1 3 show ?thesis unfolding aboveS_def by simp
31.273 qed
31.274
31.275 -lemma (in rel) aboveS_above_trans:
31.276 +lemma aboveS_above_trans:
31.277 assumes TRANS: "trans r" and ANTISYM: "antisym r" and
31.278 IN1: "b \<in> aboveS a" and IN2: "c \<in> above b"
31.279 shows "c \<in> aboveS a"
31.280 @@ -388,7 +400,7 @@
31.281 from 1 3 show ?thesis unfolding aboveS_def by simp
31.282 qed
31.283
31.284 -lemma (in rel) aboveS_aboveS_trans:
31.285 +lemma aboveS_aboveS_trans:
31.286 assumes TRANS: "trans r" and ANTISYM: "antisym r" and
31.287 IN1: "b \<in> aboveS a" and IN2: "c \<in> aboveS b"
31.288 shows "c \<in> aboveS a"
31.289 @@ -398,7 +410,22 @@
31.290 with assms above_aboveS_trans show ?thesis by auto
31.291 qed
31.292
31.293 -lemma (in rel) underS_Under_trans:
31.294 +lemma under_Under_trans:
31.295 +assumes TRANS: "trans r" and
31.296 + IN1: "a \<in> under b" and IN2: "b \<in> Under C"
31.297 +shows "a \<in> Under C"
31.298 +proof-
31.299 + have "(a,b) \<in> r \<and> (\<forall>c \<in> C. (b,c) \<in> r)"
31.300 + using IN1 IN2 under_def Under_def by blast
31.301 + hence "\<forall>c \<in> C. (a,c) \<in> r"
31.302 + using TRANS trans_def[of r] by blast
31.303 + moreover
31.304 + have "a \<in> Field r" using IN1 unfolding Field_def under_def by blast
31.305 + ultimately
31.306 + show ?thesis unfolding Under_def by blast
31.307 +qed
31.308 +
31.309 +lemma underS_Under_trans:
31.310 assumes TRANS: "trans r" and ANTISYM: "antisym r" and
31.311 IN1: "a \<in> underS b" and IN2: "b \<in> Under C"
31.312 shows "a \<in> UnderS C"
31.313 @@ -426,7 +453,7 @@
31.314 using Under_def by auto
31.315 qed
31.316
31.317 -lemma (in rel) underS_UnderS_trans:
31.318 +lemma underS_UnderS_trans:
31.319 assumes TRANS: "trans r" and ANTISYM: "antisym r" and
31.320 IN1: "a \<in> underS b" and IN2: "b \<in> UnderS C"
31.321 shows "a \<in> UnderS C"
31.322 @@ -437,7 +464,7 @@
31.323 show ?thesis by auto
31.324 qed
31.325
31.326 -lemma (in rel) above_Above_trans:
31.327 +lemma above_Above_trans:
31.328 assumes TRANS: "trans r" and
31.329 IN1: "a \<in> above b" and IN2: "b \<in> Above C"
31.330 shows "a \<in> Above C"
31.331 @@ -452,7 +479,7 @@
31.332 show ?thesis unfolding Above_def by auto
31.333 qed
31.334
31.335 -lemma (in rel) aboveS_Above_trans:
31.336 +lemma aboveS_Above_trans:
31.337 assumes TRANS: "trans r" and ANTISYM: "antisym r" and
31.338 IN1: "a \<in> aboveS b" and IN2: "b \<in> Above C"
31.339 shows "a \<in> AboveS C"
31.340 @@ -480,7 +507,7 @@
31.341 using Above_def by auto
31.342 qed
31.343
31.344 -lemma (in rel) above_AboveS_trans:
31.345 +lemma above_AboveS_trans:
31.346 assumes TRANS: "trans r" and ANTISYM: "antisym r" and
31.347 IN1: "a \<in> above b" and IN2: "b \<in> AboveS C"
31.348 shows "a \<in> AboveS C"
31.349 @@ -508,7 +535,7 @@
31.350 using Above_def by auto
31.351 qed
31.352
31.353 -lemma (in rel) aboveS_AboveS_trans:
31.354 +lemma aboveS_AboveS_trans:
31.355 assumes TRANS: "trans r" and ANTISYM: "antisym r" and
31.356 IN1: "a \<in> aboveS b" and IN2: "b \<in> AboveS C"
31.357 shows "a \<in> AboveS C"
31.358 @@ -519,6 +546,35 @@
31.359 show ?thesis by auto
31.360 qed
31.361
31.362 +lemma under_UnderS_trans:
31.363 +assumes TRANS: "trans r" and ANTISYM: "antisym r" and
31.364 + IN1: "a \<in> under b" and IN2: "b \<in> UnderS C"
31.365 +shows "a \<in> UnderS C"
31.366 +proof-
31.367 + from IN2 have "b \<in> Under C"
31.368 + using UnderS_subset_Under[of C] by blast
31.369 + with assms under_Under_trans
31.370 + have "a \<in> Under C" by blast
31.371 + (* *)
31.372 + moreover
31.373 + have "a \<notin> C"
31.374 + proof
31.375 + assume *: "a \<in> C"
31.376 + have 1: "(a,b) \<in> r"
31.377 + using IN1 under_def[of b] by auto
31.378 + have "\<forall>c \<in> C. b \<noteq> c \<and> (b,c) \<in> r"
31.379 + using IN2 UnderS_def[of C] by blast
31.380 + with * have "b \<noteq> a \<and> (b,a) \<in> r" by blast
31.381 + with 1 ANTISYM antisym_def[of r]
31.382 + show False by blast
31.383 + qed
31.384 + (* *)
31.385 + ultimately
31.386 + show ?thesis unfolding UnderS_def Under_def by fast
31.387 +qed
31.388 +
31.389 +end (* context rel *)
31.390 +
31.391
31.392 subsection {* Properties depending on more than one relation *}
31.393
32.1 --- a/src/HOL/Cardinals/Order_Relation_More_Base.thy Mon Nov 18 17:15:01 2013 +0100
32.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
32.3 @@ -1,286 +0,0 @@
32.4 -(* Title: HOL/Cardinals/Order_Relation_More_Base.thy
32.5 - Author: Andrei Popescu, TU Muenchen
32.6 - Copyright 2012
32.7 -
32.8 -Basics on order-like relations (base).
32.9 -*)
32.10 -
32.11 -header {* Basics on Order-Like Relations (Base) *}
32.12 -
32.13 -theory Order_Relation_More_Base
32.14 -imports "~~/src/HOL/Library/Order_Relation"
32.15 -begin
32.16 -
32.17 -
32.18 -text{* In this section, we develop basic concepts and results pertaining
32.19 -to order-like relations, i.e., to reflexive and/or transitive and/or symmetric and/or
32.20 -total relations. The development is placed on top of the definitions
32.21 -from the theory @{text "Order_Relation"}. We also
32.22 -further define upper and lower bounds operators. *}
32.23 -
32.24 -
32.25 -locale rel = fixes r :: "'a rel"
32.26 -
32.27 -text{* The following context encompasses all this section, except
32.28 -for its last subsection. In other words, for the rest of this section except its last
32.29 -subsection, we consider a fixed relation @{text "r"}. *}
32.30 -
32.31 -context rel
32.32 -begin
32.33 -
32.34 -
32.35 -subsection {* Auxiliaries *}
32.36 -
32.37 -
32.38 -lemma refl_on_domain:
32.39 -"\<lbrakk>refl_on A r; (a,b) : r\<rbrakk> \<Longrightarrow> a \<in> A \<and> b \<in> A"
32.40 -by(auto simp add: refl_on_def)
32.41 -
32.42 -
32.43 -corollary well_order_on_domain:
32.44 -"\<lbrakk>well_order_on A r; (a,b) \<in> r\<rbrakk> \<Longrightarrow> a \<in> A \<and> b \<in> A"
32.45 -by(simp add: refl_on_domain order_on_defs)
32.46 -
32.47 -
32.48 -lemma well_order_on_Field:
32.49 -"well_order_on A r \<Longrightarrow> A = Field r"
32.50 -by(auto simp add: refl_on_def Field_def order_on_defs)
32.51 -
32.52 -
32.53 -lemma well_order_on_Well_order:
32.54 -"well_order_on A r \<Longrightarrow> A = Field r \<and> Well_order r"
32.55 -using well_order_on_Field by simp
32.56 -
32.57 -
32.58 -lemma Total_subset_Id:
32.59 -assumes TOT: "Total r" and SUB: "r \<le> Id"
32.60 -shows "r = {} \<or> (\<exists>a. r = {(a,a)})"
32.61 -proof-
32.62 - {assume "r \<noteq> {}"
32.63 - then obtain a b where 1: "(a,b) \<in> r" by fast
32.64 - hence "a = b" using SUB by blast
32.65 - hence 2: "(a,a) \<in> r" using 1 by simp
32.66 - {fix c d assume "(c,d) \<in> r"
32.67 - hence "{a,c,d} \<le> Field r" using 1 unfolding Field_def by blast
32.68 - hence "((a,c) \<in> r \<or> (c,a) \<in> r \<or> a = c) \<and>
32.69 - ((a,d) \<in> r \<or> (d,a) \<in> r \<or> a = d)"
32.70 - using TOT unfolding total_on_def by blast
32.71 - hence "a = c \<and> a = d" using SUB by blast
32.72 - }
32.73 - hence "r \<le> {(a,a)}" by auto
32.74 - with 2 have "\<exists>a. r = {(a,a)}" by blast
32.75 - }
32.76 - thus ?thesis by blast
32.77 -qed
32.78 -
32.79 -
32.80 -lemma Linear_order_in_diff_Id:
32.81 -assumes LI: "Linear_order r" and
32.82 - IN1: "a \<in> Field r" and IN2: "b \<in> Field r"
32.83 -shows "((a,b) \<in> r) = ((b,a) \<notin> r - Id)"
32.84 -using assms unfolding order_on_defs total_on_def antisym_def Id_def refl_on_def by force
32.85 -
32.86 -
32.87 -subsection {* The upper and lower bounds operators *}
32.88 -
32.89 -
32.90 -text{* Here we define upper (``above") and lower (``below") bounds operators.
32.91 -We think of @{text "r"} as a {\em non-strict} relation. The suffix ``S"
32.92 -at the names of some operators indicates that the bounds are strict -- e.g.,
32.93 -@{text "underS a"} is the set of all strict lower bounds of @{text "a"} (w.r.t. @{text "r"}).
32.94 -Capitalization of the first letter in the name reminds that the operator acts on sets, rather
32.95 -than on individual elements. *}
32.96 -
32.97 -definition under::"'a \<Rightarrow> 'a set"
32.98 -where "under a \<equiv> {b. (b,a) \<in> r}"
32.99 -
32.100 -definition underS::"'a \<Rightarrow> 'a set"
32.101 -where "underS a \<equiv> {b. b \<noteq> a \<and> (b,a) \<in> r}"
32.102 -
32.103 -definition Under::"'a set \<Rightarrow> 'a set"
32.104 -where "Under A \<equiv> {b \<in> Field r. \<forall>a \<in> A. (b,a) \<in> r}"
32.105 -
32.106 -definition UnderS::"'a set \<Rightarrow> 'a set"
32.107 -where "UnderS A \<equiv> {b \<in> Field r. \<forall>a \<in> A. b \<noteq> a \<and> (b,a) \<in> r}"
32.108 -
32.109 -definition above::"'a \<Rightarrow> 'a set"
32.110 -where "above a \<equiv> {b. (a,b) \<in> r}"
32.111 -
32.112 -definition aboveS::"'a \<Rightarrow> 'a set"
32.113 -where "aboveS a \<equiv> {b. b \<noteq> a \<and> (a,b) \<in> r}"
32.114 -
32.115 -definition Above::"'a set \<Rightarrow> 'a set"
32.116 -where "Above A \<equiv> {b \<in> Field r. \<forall>a \<in> A. (a,b) \<in> r}"
32.117 -
32.118 -definition AboveS::"'a set \<Rightarrow> 'a set"
32.119 -where "AboveS A \<equiv> {b \<in> Field r. \<forall>a \<in> A. b \<noteq> a \<and> (a,b) \<in> r}"
32.120 -(* *)
32.121 -
32.122 -text{* Note: In the definitions of @{text "Above[S]"} and @{text "Under[S]"},
32.123 - we bounded comprehension by @{text "Field r"} in order to properly cover
32.124 - the case of @{text "A"} being empty. *}
32.125 -
32.126 -
32.127 -lemma UnderS_subset_Under: "UnderS A \<le> Under A"
32.128 -by(auto simp add: UnderS_def Under_def)
32.129 -
32.130 -
32.131 -lemma underS_subset_under: "underS a \<le> under a"
32.132 -by(auto simp add: underS_def under_def)
32.133 -
32.134 -
32.135 -lemma underS_notIn: "a \<notin> underS a"
32.136 -by(simp add: underS_def)
32.137 -
32.138 -
32.139 -lemma Refl_under_in: "\<lbrakk>Refl r; a \<in> Field r\<rbrakk> \<Longrightarrow> a \<in> under a"
32.140 -by(simp add: refl_on_def under_def)
32.141 -
32.142 -
32.143 -lemma AboveS_disjoint: "A Int (AboveS A) = {}"
32.144 -by(auto simp add: AboveS_def)
32.145 -
32.146 -
32.147 -lemma in_AboveS_underS: "a \<in> Field r \<Longrightarrow> a \<in> AboveS (underS a)"
32.148 -by(auto simp add: AboveS_def underS_def)
32.149 -
32.150 -
32.151 -lemma Refl_under_underS:
32.152 -assumes "Refl r" "a \<in> Field r"
32.153 -shows "under a = underS a \<union> {a}"
32.154 -unfolding under_def underS_def
32.155 -using assms refl_on_def[of _ r] by fastforce
32.156 -
32.157 -
32.158 -lemma underS_empty: "a \<notin> Field r \<Longrightarrow> underS a = {}"
32.159 -by (auto simp: Field_def underS_def)
32.160 -
32.161 -
32.162 -lemma under_Field: "under a \<le> Field r"
32.163 -by(unfold under_def Field_def, auto)
32.164 -
32.165 -
32.166 -lemma underS_Field: "underS a \<le> Field r"
32.167 -by(unfold underS_def Field_def, auto)
32.168 -
32.169 -
32.170 -lemma underS_Field2:
32.171 -"a \<in> Field r \<Longrightarrow> underS a < Field r"
32.172 -using assms underS_notIn underS_Field by blast
32.173 -
32.174 -
32.175 -lemma underS_Field3:
32.176 -"Field r \<noteq> {} \<Longrightarrow> underS a < Field r"
32.177 -by(cases "a \<in> Field r", simp add: underS_Field2, auto simp add: underS_empty)
32.178 -
32.179 -
32.180 -lemma Under_Field: "Under A \<le> Field r"
32.181 -by(unfold Under_def Field_def, auto)
32.182 -
32.183 -
32.184 -lemma UnderS_Field: "UnderS A \<le> Field r"
32.185 -by(unfold UnderS_def Field_def, auto)
32.186 -
32.187 -
32.188 -lemma AboveS_Field: "AboveS A \<le> Field r"
32.189 -by(unfold AboveS_def Field_def, auto)
32.190 -
32.191 -
32.192 -lemma under_incr:
32.193 -assumes TRANS: "trans r" and REL: "(a,b) \<in> r"
32.194 -shows "under a \<le> under b"
32.195 -proof(unfold under_def, auto)
32.196 - fix x assume "(x,a) \<in> r"
32.197 - with REL TRANS trans_def[of r]
32.198 - show "(x,b) \<in> r" by blast
32.199 -qed
32.200 -
32.201 -
32.202 -lemma underS_incr:
32.203 -assumes TRANS: "trans r" and ANTISYM: "antisym r" and
32.204 - REL: "(a,b) \<in> r"
32.205 -shows "underS a \<le> underS b"
32.206 -proof(unfold underS_def, auto)
32.207 - assume *: "b \<noteq> a" and **: "(b,a) \<in> r"
32.208 - with ANTISYM antisym_def[of r] REL
32.209 - show False by blast
32.210 -next
32.211 - fix x assume "x \<noteq> a" "(x,a) \<in> r"
32.212 - with REL TRANS trans_def[of r]
32.213 - show "(x,b) \<in> r" by blast
32.214 -qed
32.215 -
32.216 -
32.217 -lemma underS_incl_iff:
32.218 -assumes LO: "Linear_order r" and
32.219 - INa: "a \<in> Field r" and INb: "b \<in> Field r"
32.220 -shows "(underS a \<le> underS b) = ((a,b) \<in> r)"
32.221 -proof
32.222 - assume "(a,b) \<in> r"
32.223 - thus "underS a \<le> underS b" using LO
32.224 - by (simp add: order_on_defs underS_incr)
32.225 -next
32.226 - assume *: "underS a \<le> underS b"
32.227 - {assume "a = b"
32.228 - hence "(a,b) \<in> r" using assms
32.229 - by (simp add: order_on_defs refl_on_def)
32.230 - }
32.231 - moreover
32.232 - {assume "a \<noteq> b \<and> (b,a) \<in> r"
32.233 - hence "b \<in> underS a" unfolding underS_def by blast
32.234 - hence "b \<in> underS b" using * by blast
32.235 - hence False by (simp add: underS_notIn)
32.236 - }
32.237 - ultimately
32.238 - show "(a,b) \<in> r" using assms
32.239 - order_on_defs[of "Field r" r] total_on_def[of "Field r" r] by blast
32.240 -qed
32.241 -
32.242 -
32.243 -lemma under_Under_trans:
32.244 -assumes TRANS: "trans r" and
32.245 - IN1: "a \<in> under b" and IN2: "b \<in> Under C"
32.246 -shows "a \<in> Under C"
32.247 -proof-
32.248 - have "(a,b) \<in> r \<and> (\<forall>c \<in> C. (b,c) \<in> r)"
32.249 - using IN1 IN2 under_def Under_def by blast
32.250 - hence "\<forall>c \<in> C. (a,c) \<in> r"
32.251 - using TRANS trans_def[of r] by blast
32.252 - moreover
32.253 - have "a \<in> Field r" using IN1 unfolding Field_def under_def by blast
32.254 - ultimately
32.255 - show ?thesis unfolding Under_def by blast
32.256 -qed
32.257 -
32.258 -
32.259 -lemma under_UnderS_trans:
32.260 -assumes TRANS: "trans r" and ANTISYM: "antisym r" and
32.261 - IN1: "a \<in> under b" and IN2: "b \<in> UnderS C"
32.262 -shows "a \<in> UnderS C"
32.263 -proof-
32.264 - from IN2 have "b \<in> Under C"
32.265 - using UnderS_subset_Under[of C] by blast
32.266 - with assms under_Under_trans
32.267 - have "a \<in> Under C" by blast
32.268 - (* *)
32.269 - moreover
32.270 - have "a \<notin> C"
32.271 - proof
32.272 - assume *: "a \<in> C"
32.273 - have 1: "(a,b) \<in> r"
32.274 - using IN1 under_def[of b] by auto
32.275 - have "\<forall>c \<in> C. b \<noteq> c \<and> (b,c) \<in> r"
32.276 - using IN2 UnderS_def[of C] by blast
32.277 - with * have "b \<noteq> a \<and> (b,a) \<in> r" by blast
32.278 - with 1 ANTISYM antisym_def[of r]
32.279 - show False by blast
32.280 - qed
32.281 - (* *)
32.282 - ultimately
32.283 - show ?thesis unfolding UnderS_def Under_def by fast
32.284 -qed
32.285 -
32.286 -
32.287 -end (* context rel *)
32.288 -
32.289 -end
33.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
33.2 +++ b/src/HOL/Cardinals/Order_Relation_More_FP.thy Tue Nov 19 17:07:52 2013 +0100
33.3 @@ -0,0 +1,230 @@
33.4 +(* Title: HOL/Cardinals/Order_Relation_More_FP.thy
33.5 + Author: Andrei Popescu, TU Muenchen
33.6 + Copyright 2012
33.7 +
33.8 +Basics on order-like relations (FP).
33.9 +*)
33.10 +
33.11 +header {* Basics on Order-Like Relations (FP) *}
33.12 +
33.13 +theory Order_Relation_More_FP
33.14 +imports "~~/src/HOL/Library/Order_Relation"
33.15 +begin
33.16 +
33.17 +
33.18 +text{* In this section, we develop basic concepts and results pertaining
33.19 +to order-like relations, i.e., to reflexive and/or transitive and/or symmetric and/or
33.20 +total relations. The development is placed on top of the definitions
33.21 +from the theory @{text "Order_Relation"}. We also
33.22 +further define upper and lower bounds operators. *}
33.23 +
33.24 +
33.25 +locale rel = fixes r :: "'a rel"
33.26 +
33.27 +text{* The following context encompasses all this section, except
33.28 +for its last subsection. In other words, for the rest of this section except its last
33.29 +subsection, we consider a fixed relation @{text "r"}. *}
33.30 +
33.31 +context rel
33.32 +begin
33.33 +
33.34 +
33.35 +subsection {* Auxiliaries *}
33.36 +
33.37 +
33.38 +lemma refl_on_domain:
33.39 +"\<lbrakk>refl_on A r; (a,b) : r\<rbrakk> \<Longrightarrow> a \<in> A \<and> b \<in> A"
33.40 +by(auto simp add: refl_on_def)
33.41 +
33.42 +
33.43 +corollary well_order_on_domain:
33.44 +"\<lbrakk>well_order_on A r; (a,b) \<in> r\<rbrakk> \<Longrightarrow> a \<in> A \<and> b \<in> A"
33.45 +by(simp add: refl_on_domain order_on_defs)
33.46 +
33.47 +
33.48 +lemma well_order_on_Field:
33.49 +"well_order_on A r \<Longrightarrow> A = Field r"
33.50 +by(auto simp add: refl_on_def Field_def order_on_defs)
33.51 +
33.52 +
33.53 +lemma well_order_on_Well_order:
33.54 +"well_order_on A r \<Longrightarrow> A = Field r \<and> Well_order r"
33.55 +using well_order_on_Field by simp
33.56 +
33.57 +
33.58 +lemma Total_subset_Id:
33.59 +assumes TOT: "Total r" and SUB: "r \<le> Id"
33.60 +shows "r = {} \<or> (\<exists>a. r = {(a,a)})"
33.61 +proof-
33.62 + {assume "r \<noteq> {}"
33.63 + then obtain a b where 1: "(a,b) \<in> r" by fast
33.64 + hence "a = b" using SUB by blast
33.65 + hence 2: "(a,a) \<in> r" using 1 by simp
33.66 + {fix c d assume "(c,d) \<in> r"
33.67 + hence "{a,c,d} \<le> Field r" using 1 unfolding Field_def by blast
33.68 + hence "((a,c) \<in> r \<or> (c,a) \<in> r \<or> a = c) \<and>
33.69 + ((a,d) \<in> r \<or> (d,a) \<in> r \<or> a = d)"
33.70 + using TOT unfolding total_on_def by blast
33.71 + hence "a = c \<and> a = d" using SUB by blast
33.72 + }
33.73 + hence "r \<le> {(a,a)}" by auto
33.74 + with 2 have "\<exists>a. r = {(a,a)}" by blast
33.75 + }
33.76 + thus ?thesis by blast
33.77 +qed
33.78 +
33.79 +
33.80 +lemma Linear_order_in_diff_Id:
33.81 +assumes LI: "Linear_order r" and
33.82 + IN1: "a \<in> Field r" and IN2: "b \<in> Field r"
33.83 +shows "((a,b) \<in> r) = ((b,a) \<notin> r - Id)"
33.84 +using assms unfolding order_on_defs total_on_def antisym_def Id_def refl_on_def by force
33.85 +
33.86 +
33.87 +subsection {* The upper and lower bounds operators *}
33.88 +
33.89 +
33.90 +text{* Here we define upper (``above") and lower (``below") bounds operators.
33.91 +We think of @{text "r"} as a {\em non-strict} relation. The suffix ``S"
33.92 +at the names of some operators indicates that the bounds are strict -- e.g.,
33.93 +@{text "underS a"} is the set of all strict lower bounds of @{text "a"} (w.r.t. @{text "r"}).
33.94 +Capitalization of the first letter in the name reminds that the operator acts on sets, rather
33.95 +than on individual elements. *}
33.96 +
33.97 +definition under::"'a \<Rightarrow> 'a set"
33.98 +where "under a \<equiv> {b. (b,a) \<in> r}"
33.99 +
33.100 +definition underS::"'a \<Rightarrow> 'a set"
33.101 +where "underS a \<equiv> {b. b \<noteq> a \<and> (b,a) \<in> r}"
33.102 +
33.103 +definition Under::"'a set \<Rightarrow> 'a set"
33.104 +where "Under A \<equiv> {b \<in> Field r. \<forall>a \<in> A. (b,a) \<in> r}"
33.105 +
33.106 +definition UnderS::"'a set \<Rightarrow> 'a set"
33.107 +where "UnderS A \<equiv> {b \<in> Field r. \<forall>a \<in> A. b \<noteq> a \<and> (b,a) \<in> r}"
33.108 +
33.109 +definition above::"'a \<Rightarrow> 'a set"
33.110 +where "above a \<equiv> {b. (a,b) \<in> r}"
33.111 +
33.112 +definition aboveS::"'a \<Rightarrow> 'a set"
33.113 +where "aboveS a \<equiv> {b. b \<noteq> a \<and> (a,b) \<in> r}"
33.114 +
33.115 +definition Above::"'a set \<Rightarrow> 'a set"
33.116 +where "Above A \<equiv> {b \<in> Field r. \<forall>a \<in> A. (a,b) \<in> r}"
33.117 +
33.118 +definition AboveS::"'a set \<Rightarrow> 'a set"
33.119 +where "AboveS A \<equiv> {b \<in> Field r. \<forall>a \<in> A. b \<noteq> a \<and> (a,b) \<in> r}"
33.120 +(* *)
33.121 +
33.122 +text{* Note: In the definitions of @{text "Above[S]"} and @{text "Under[S]"},
33.123 + we bounded comprehension by @{text "Field r"} in order to properly cover
33.124 + the case of @{text "A"} being empty. *}
33.125 +
33.126 +
33.127 +lemma underS_subset_under: "underS a \<le> under a"
33.128 +by(auto simp add: underS_def under_def)
33.129 +
33.130 +
33.131 +lemma underS_notIn: "a \<notin> underS a"
33.132 +by(simp add: underS_def)
33.133 +
33.134 +
33.135 +lemma Refl_under_in: "\<lbrakk>Refl r; a \<in> Field r\<rbrakk> \<Longrightarrow> a \<in> under a"
33.136 +by(simp add: refl_on_def under_def)
33.137 +
33.138 +
33.139 +lemma AboveS_disjoint: "A Int (AboveS A) = {}"
33.140 +by(auto simp add: AboveS_def)
33.141 +
33.142 +
33.143 +lemma in_AboveS_underS: "a \<in> Field r \<Longrightarrow> a \<in> AboveS (underS a)"
33.144 +by(auto simp add: AboveS_def underS_def)
33.145 +
33.146 +
33.147 +lemma Refl_under_underS:
33.148 +assumes "Refl r" "a \<in> Field r"
33.149 +shows "under a = underS a \<union> {a}"
33.150 +unfolding under_def underS_def
33.151 +using assms refl_on_def[of _ r] by fastforce
33.152 +
33.153 +
33.154 +lemma underS_empty: "a \<notin> Field r \<Longrightarrow> underS a = {}"
33.155 +by (auto simp: Field_def underS_def)
33.156 +
33.157 +
33.158 +lemma under_Field: "under a \<le> Field r"
33.159 +by(unfold under_def Field_def, auto)
33.160 +
33.161 +
33.162 +lemma underS_Field: "underS a \<le> Field r"
33.163 +by(unfold underS_def Field_def, auto)
33.164 +
33.165 +
33.166 +lemma underS_Field2:
33.167 +"a \<in> Field r \<Longrightarrow> underS a < Field r"
33.168 +using assms underS_notIn underS_Field by blast
33.169 +
33.170 +
33.171 +lemma underS_Field3:
33.172 +"Field r \<noteq> {} \<Longrightarrow> underS a < Field r"
33.173 +by(cases "a \<in> Field r", simp add: underS_Field2, auto simp add: underS_empty)
33.174 +
33.175 +
33.176 +lemma AboveS_Field: "AboveS A \<le> Field r"
33.177 +by(unfold AboveS_def Field_def, auto)
33.178 +
33.179 +
33.180 +lemma under_incr:
33.181 +assumes TRANS: "trans r" and REL: "(a,b) \<in> r"
33.182 +shows "under a \<le> under b"
33.183 +proof(unfold under_def, auto)
33.184 + fix x assume "(x,a) \<in> r"
33.185 + with REL TRANS trans_def[of r]
33.186 + show "(x,b) \<in> r" by blast
33.187 +qed
33.188 +
33.189 +
33.190 +lemma underS_incr:
33.191 +assumes TRANS: "trans r" and ANTISYM: "antisym r" and
33.192 + REL: "(a,b) \<in> r"
33.193 +shows "underS a \<le> underS b"
33.194 +proof(unfold underS_def, auto)
33.195 + assume *: "b \<noteq> a" and **: "(b,a) \<in> r"
33.196 + with ANTISYM antisym_def[of r] REL
33.197 + show False by blast
33.198 +next
33.199 + fix x assume "x \<noteq> a" "(x,a) \<in> r"
33.200 + with REL TRANS trans_def[of r]
33.201 + show "(x,b) \<in> r" by blast
33.202 +qed
33.203 +
33.204 +
33.205 +lemma underS_incl_iff:
33.206 +assumes LO: "Linear_order r" and
33.207 + INa: "a \<in> Field r" and INb: "b \<in> Field r"
33.208 +shows "(underS a \<le> underS b) = ((a,b) \<in> r)"
33.209 +proof
33.210 + assume "(a,b) \<in> r"
33.211 + thus "underS a \<le> underS b" using LO
33.212 + by (simp add: order_on_defs underS_incr)
33.213 +next
33.214 + assume *: "underS a \<le> underS b"
33.215 + {assume "a = b"
33.216 + hence "(a,b) \<in> r" using assms
33.217 + by (simp add: order_on_defs refl_on_def)
33.218 + }
33.219 + moreover
33.220 + {assume "a \<noteq> b \<and> (b,a) \<in> r"
33.221 + hence "b \<in> underS a" unfolding underS_def by blast
33.222 + hence "b \<in> underS b" using * by blast
33.223 + hence False by (simp add: underS_notIn)
33.224 + }
33.225 + ultimately
33.226 + show "(a,b) \<in> r" using assms
33.227 + order_on_defs[of "Field r" r] total_on_def[of "Field r" r] by blast
33.228 +qed
33.229 +
33.230 +
33.231 +end (* context rel *)
33.232 +
33.233 +end
34.1 --- a/src/HOL/Cardinals/README.txt Mon Nov 18 17:15:01 2013 +0100
34.2 +++ b/src/HOL/Cardinals/README.txt Tue Nov 19 17:07:52 2013 +0100
34.3 @@ -89,15 +89,16 @@
34.4 Minor technicalities and naming issues:
34.5 ---------------------------------------
34.6
34.7 -1. Most of the definitions and theorems are proved in files suffixed with
34.8 -"_Base". Bootstrapping considerations (for the (co)datatype package) made this
34.9 -division desirable.
34.10 +1. Most of the definitions and theorems are proved in files suffixed with "_FP".
34.11 +Bootstrapping considerations (for the (co)datatype package) made this division
34.12 +desirable.
34.13
34.14
34.15 -2. Even though we would have preferred to use "initial segment" instead of
34.16 -"order filter", we chose the latter to avoid terminological clash with
34.17 -the operator "init_seg_of" from Zorn.thy. The latter expresses a related, but different
34.18 -concept -- it considers a relation, rather than a set, as initial segment of a relation.
34.19 +2. Even though we would have preferred to use "initial segment" instead of
34.20 +"order filter", we chose the latter to avoid terminological clash with the
34.21 +operator "init_seg_of" from Zorn.thy. The latter expresses a related, but
34.22 +different concept -- it considers a relation, rather than a set, as initial
34.23 +segment of a relation.
34.24
34.25
34.26 3. We prefer to define the upper-bound operations under, underS,
34.27 @@ -148,7 +149,7 @@
34.28 Notes for anyone who would like to enrich these theories in the future
34.29 --------------------------------------------------------------------------------------
34.30
34.31 -Theory Fun_More (and Fun_More_Base):
34.32 +Theory Fun_More (and Fun_More_FP):
34.33 - Careful: "inj" is an abbreviation for "inj_on UNIV", while
34.34 "bij" is not an abreviation for "bij_betw UNIV UNIV", but
34.35 a defined constant; there is no "surj_betw", but only "surj".
34.36 @@ -166,7 +167,7 @@
34.37 - In subsection "Other facts":
34.38 -- Does the lemma "atLeastLessThan_injective" already exist anywhere?
34.39
34.40 -Theory Order_Relation_More (and Order_Relation_More_Base):
34.41 +Theory Order_Relation_More (and Order_Relation_More_FP):
34.42 - In subsection "Auxiliaries":
34.43 -- Recall the lemmas "order_on_defs", "Field_def", "Domain_def", "Range_def", "converse_def".
34.44 -- Recall that "refl_on r A" forces r to not be defined outside A.
34.45 @@ -181,16 +182,16 @@
34.46 abbreviation "Linear_order r ≡ linear_order_on (Field r) r"
34.47 abbreviation "Well_order r ≡ well_order_on (Field r) r"
34.48
34.49 -Theory Wellorder_Relation (and Wellorder_Relation_Base):
34.50 +Theory Wellorder_Relation (and Wellorder_Relation_FP):
34.51 - In subsection "Auxiliaries": recall lemmas "order_on_defs"
34.52 - In subsection "The notions of maximum, minimum, supremum, successor and order filter":
34.53 Should we define all constants from "wo_rel" in "rel" instead,
34.54 so that their outside definition not be conditional in "wo_rel r"?
34.55
34.56 -Theory Wellfounded_More (and Wellfounded_More_Base):
34.57 +Theory Wellfounded_More (and Wellfounded_More_FP):
34.58 Recall the lemmas "wfrec" and "wf_induct".
34.59
34.60 -Theory Wellorder_Embedding (and Wellorder_Embedding_Base):
34.61 +Theory Wellorder_Embedding (and Wellorder_Embedding_FP):
34.62 - Recall "inj_on_def" and "bij_betw_def".
34.63 - Line 5 in the proof of lemma embed_in_Field: we have to figure out for this and many other
34.64 situations: Why did it work without annotations to Refl_under_in?
34.65 @@ -200,7 +201,7 @@
34.66 making impossible to debug theorem instantiations.
34.67 - At lemma "embed_unique": If we add the attribute "rule format" at lemma, we get an error at qed.
34.68
34.69 -Theory Constructions_on_Wellorders (and Constructions_on_Wellorders_Base):
34.70 +Theory Constructions_on_Wellorders (and Constructions_on_Wellorders_FP):
34.71 - Some of the lemmas in this section are about more general kinds of relations than
34.72 well-orders, but it is not clear whether they are useful in such more general contexts.
34.73 - Recall that "equiv" does not have the "equiv_on" and "Equiv" versions,
34.74 @@ -208,7 +209,7 @@
34.75 - The lemmas "ord_trans" are not clearly useful together, as their employment within blast or auto
34.76 tends to diverge.
34.77
34.78 -Theory Cardinal_Order_Relation (and Cardinal_Order_Relation_Base):
34.79 +Theory Cardinal_Order_Relation (and Cardinal_Order_Relation_FP):
34.80 - Careful: if "|..|" meets an outer parehthesis, an extra space needs to be inserted, as in
34.81 "( |A| )".
34.82 - At lemma like ordLeq_Sigma_mono1: Not worth stating something like ordLeq_Sigma_mono2 --
35.1 --- a/src/HOL/Cardinals/Wellfounded_More.thy Mon Nov 18 17:15:01 2013 +0100
35.2 +++ b/src/HOL/Cardinals/Wellfounded_More.thy Tue Nov 19 17:07:52 2013 +0100
35.3 @@ -8,7 +8,7 @@
35.4 header {* More on Well-Founded Relations *}
35.5
35.6 theory Wellfounded_More
35.7 -imports Wellfounded_More_Base Order_Relation_More
35.8 +imports Wellfounded_More_FP Order_Relation_More
35.9 begin
35.10
35.11
36.1 --- a/src/HOL/Cardinals/Wellfounded_More_Base.thy Mon Nov 18 17:15:01 2013 +0100
36.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
36.3 @@ -1,194 +0,0 @@
36.4 -(* Title: HOL/Cardinals/Wellfounded_More_Base.thy
36.5 - Author: Andrei Popescu, TU Muenchen
36.6 - Copyright 2012
36.7 -
36.8 -More on well-founded relations (base).
36.9 -*)
36.10 -
36.11 -header {* More on Well-Founded Relations (Base) *}
36.12 -
36.13 -theory Wellfounded_More_Base
36.14 -imports Order_Relation_More_Base "~~/src/HOL/Library/Wfrec"
36.15 -begin
36.16 -
36.17 -
36.18 -text {* This section contains some variations of results in the theory
36.19 -@{text "Wellfounded.thy"}:
36.20 -\begin{itemize}
36.21 -\item means for slightly more direct definitions by well-founded recursion;
36.22 -\item variations of well-founded induction;
36.23 -\item means for proving a linear order to be a well-order.
36.24 -\end{itemize} *}
36.25 -
36.26 -
36.27 -subsection {* Well-founded recursion via genuine fixpoints *}
36.28 -
36.29 -
36.30 -(*2*)lemma wfrec_fixpoint:
36.31 -fixes r :: "('a * 'a) set" and
36.32 - H :: "('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b"
36.33 -assumes WF: "wf r" and ADM: "adm_wf r H"
36.34 -shows "wfrec r H = H (wfrec r H)"
36.35 -proof(rule ext)
36.36 - fix x
36.37 - have "wfrec r H x = H (cut (wfrec r H) r x) x"
36.38 - using wfrec[of r H] WF by simp
36.39 - also
36.40 - {have "\<And> y. (y,x) : r \<Longrightarrow> (cut (wfrec r H) r x) y = (wfrec r H) y"
36.41 - by (auto simp add: cut_apply)
36.42 - hence "H (cut (wfrec r H) r x) x = H (wfrec r H) x"
36.43 - using ADM adm_wf_def[of r H] by auto
36.44 - }
36.45 - finally show "wfrec r H x = H (wfrec r H) x" .
36.46 -qed
36.47 -
36.48 -
36.49 -
36.50 -subsection {* Characterizations of well-founded-ness *}
36.51 -
36.52 -
36.53 -text {* A transitive relation is well-founded iff it is ``locally" well-founded,
36.54 -i.e., iff its restriction to the lower bounds of of any element is well-founded. *}
36.55 -
36.56 -(*3*)lemma trans_wf_iff:
36.57 -assumes "trans r"
36.58 -shows "wf r = (\<forall>a. wf(r Int (r^-1``{a} \<times> r^-1``{a})))"
36.59 -proof-
36.60 - obtain R where R_def: "R = (\<lambda> a. r Int (r^-1``{a} \<times> r^-1``{a}))" by blast
36.61 - {assume *: "wf r"
36.62 - {fix a
36.63 - have "wf(R a)"
36.64 - using * R_def wf_subset[of r "R a"] by auto
36.65 - }
36.66 - }
36.67 - (* *)
36.68 - moreover
36.69 - {assume *: "\<forall>a. wf(R a)"
36.70 - have "wf r"
36.71 - proof(unfold wf_def, clarify)
36.72 - fix phi a
36.73 - assume **: "\<forall>a. (\<forall>b. (b,a) \<in> r \<longrightarrow> phi b) \<longrightarrow> phi a"
36.74 - obtain chi where chi_def: "chi = (\<lambda>b. (b,a) \<in> r \<longrightarrow> phi b)" by blast
36.75 - with * have "wf (R a)" by auto
36.76 - hence "(\<forall>b. (\<forall>c. (c,b) \<in> R a \<longrightarrow> chi c) \<longrightarrow> chi b) \<longrightarrow> (\<forall>b. chi b)"
36.77 - unfolding wf_def by blast
36.78 - moreover
36.79 - have "\<forall>b. (\<forall>c. (c,b) \<in> R a \<longrightarrow> chi c) \<longrightarrow> chi b"
36.80 - proof(auto simp add: chi_def R_def)
36.81 - fix b
36.82 - assume 1: "(b,a) \<in> r" and 2: "\<forall>c. (c, b) \<in> r \<and> (c, a) \<in> r \<longrightarrow> phi c"
36.83 - hence "\<forall>c. (c, b) \<in> r \<longrightarrow> phi c"
36.84 - using assms trans_def[of r] by blast
36.85 - thus "phi b" using ** by blast
36.86 - qed
36.87 - ultimately have "\<forall>b. chi b" by (rule mp)
36.88 - with ** chi_def show "phi a" by blast
36.89 - qed
36.90 - }
36.91 - ultimately show ?thesis using R_def by blast
36.92 -qed
36.93 -
36.94 -
36.95 -text {* The next lemma is a variation of @{text "wf_eq_minimal"} from Wellfounded,
36.96 -allowing one to assume the set included in the field. *}
36.97 -
36.98 -(*2*)lemma wf_eq_minimal2:
36.99 -"wf r = (\<forall>A. A <= Field r \<and> A \<noteq> {} \<longrightarrow> (\<exists>a \<in> A. \<forall>a' \<in> A. \<not> (a',a) \<in> r))"
36.100 -proof-
36.101 - let ?phi = "\<lambda> A. A \<noteq> {} \<longrightarrow> (\<exists>a \<in> A. \<forall>a' \<in> A. \<not> (a',a) \<in> r)"
36.102 - have "wf r = (\<forall>A. ?phi A)"
36.103 - by (auto simp: ex_in_conv [THEN sym], erule wfE_min, assumption, blast)
36.104 - (rule wfI_min, metis)
36.105 - (* *)
36.106 - also have "(\<forall>A. ?phi A) = (\<forall>B \<le> Field r. ?phi B)"
36.107 - proof
36.108 - assume "\<forall>A. ?phi A"
36.109 - thus "\<forall>B \<le> Field r. ?phi B" by simp
36.110 - next
36.111 - assume *: "\<forall>B \<le> Field r. ?phi B"
36.112 - show "\<forall>A. ?phi A"
36.113 - proof(clarify)
36.114 - fix A::"'a set" assume **: "A \<noteq> {}"
36.115 - obtain B where B_def: "B = A Int (Field r)" by blast
36.116 - show "\<exists>a \<in> A. \<forall>a' \<in> A. (a',a) \<notin> r"
36.117 - proof(cases "B = {}")
36.118 - assume Case1: "B = {}"
36.119 - obtain a where 1: "a \<in> A \<and> a \<notin> Field r"
36.120 - using ** Case1 unfolding B_def by blast
36.121 - hence "\<forall>a' \<in> A. (a',a) \<notin> r" using 1 unfolding Field_def by blast
36.122 - thus ?thesis using 1 by blast
36.123 - next
36.124 - assume Case2: "B \<noteq> {}" have 1: "B \<le> Field r" unfolding B_def by blast
36.125 - obtain a where 2: "a \<in> B \<and> (\<forall>a' \<in> B. (a',a) \<notin> r)"
36.126 - using Case2 1 * by blast
36.127 - have "\<forall>a' \<in> A. (a',a) \<notin> r"
36.128 - proof(clarify)
36.129 - fix a' assume "a' \<in> A" and **: "(a',a) \<in> r"
36.130 - hence "a' \<in> B" unfolding B_def Field_def by blast
36.131 - thus False using 2 ** by blast
36.132 - qed
36.133 - thus ?thesis using 2 unfolding B_def by blast
36.134 - qed
36.135 - qed
36.136 - qed
36.137 - finally show ?thesis by blast
36.138 -qed
36.139 -
36.140 -subsection {* Characterizations of well-founded-ness *}
36.141 -
36.142 -text {* The next lemma and its corollary enable one to prove that
36.143 -a linear order is a well-order in a way which is more standard than
36.144 -via well-founded-ness of the strict version of the relation. *}
36.145 -
36.146 -(*3*)
36.147 -lemma Linear_order_wf_diff_Id:
36.148 -assumes LI: "Linear_order r"
36.149 -shows "wf(r - Id) = (\<forall>A \<le> Field r. A \<noteq> {} \<longrightarrow> (\<exists>a \<in> A. \<forall>a' \<in> A. (a,a') \<in> r))"
36.150 -proof(cases "r \<le> Id")
36.151 - assume Case1: "r \<le> Id"
36.152 - hence temp: "r - Id = {}" by blast
36.153 - hence "wf(r - Id)" by (simp add: temp)
36.154 - moreover
36.155 - {fix A assume *: "A \<le> Field r" and **: "A \<noteq> {}"
36.156 - obtain a where 1: "r = {} \<or> r = {(a,a)}" using LI
36.157 - unfolding order_on_defs using Case1 rel.Total_subset_Id by metis
36.158 - hence "A = {a} \<and> r = {(a,a)}" using * ** unfolding Field_def by blast
36.159 - hence "\<exists>a \<in> A. \<forall>a' \<in> A. (a,a') \<in> r" using 1 by blast
36.160 - }
36.161 - ultimately show ?thesis by blast
36.162 -next
36.163 - assume Case2: "\<not> r \<le> Id"
36.164 - hence 1: "Field r = Field(r - Id)" using Total_Id_Field LI
36.165 - unfolding order_on_defs by blast
36.166 - show ?thesis
36.167 - proof
36.168 - assume *: "wf(r - Id)"
36.169 - show "\<forall>A \<le> Field r. A \<noteq> {} \<longrightarrow> (\<exists>a \<in> A. \<forall>a' \<in> A. (a,a') \<in> r)"
36.170 - proof(clarify)
36.171 - fix A assume **: "A \<le> Field r" and ***: "A \<noteq> {}"
36.172 - hence "\<exists>a \<in> A. \<forall>a' \<in> A. (a',a) \<notin> r - Id"
36.173 - using 1 * unfolding wf_eq_minimal2 by simp
36.174 - moreover have "\<forall>a \<in> A. \<forall>a' \<in> A. ((a,a') \<in> r) = ((a',a) \<notin> r - Id)"
36.175 - using rel.Linear_order_in_diff_Id[of r] ** LI by blast
36.176 - ultimately show "\<exists>a \<in> A. \<forall>a' \<in> A. (a,a') \<in> r" by blast
36.177 - qed
36.178 - next
36.179 - assume *: "\<forall>A \<le> Field r. A \<noteq> {} \<longrightarrow> (\<exists>a \<in> A. \<forall>a' \<in> A. (a,a') \<in> r)"
36.180 - show "wf(r - Id)"
36.181 - proof(unfold wf_eq_minimal2, clarify)
36.182 - fix A assume **: "A \<le> Field(r - Id)" and ***: "A \<noteq> {}"
36.183 - hence "\<exists>a \<in> A. \<forall>a' \<in> A. (a,a') \<in> r"
36.184 - using 1 * by simp
36.185 - moreover have "\<forall>a \<in> A. \<forall>a' \<in> A. ((a,a') \<in> r) = ((a',a) \<notin> r - Id)"
36.186 - using rel.Linear_order_in_diff_Id[of r] ** LI mono_Field[of "r - Id" r] by blast
36.187 - ultimately show "\<exists>a \<in> A. \<forall>a' \<in> A. (a',a) \<notin> r - Id" by blast
36.188 - qed
36.189 - qed
36.190 -qed
36.191 -
36.192 -(*3*)corollary Linear_order_Well_order_iff:
36.193 -assumes "Linear_order r"
36.194 -shows "Well_order r = (\<forall>A \<le> Field r. A \<noteq> {} \<longrightarrow> (\<exists>a \<in> A. \<forall>a' \<in> A. (a,a') \<in> r))"
36.195 -using assms unfolding well_order_on_def using Linear_order_wf_diff_Id[of r] by blast
36.196 -
36.197 -end
37.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
37.2 +++ b/src/HOL/Cardinals/Wellfounded_More_FP.thy Tue Nov 19 17:07:52 2013 +0100
37.3 @@ -0,0 +1,194 @@
37.4 +(* Title: HOL/Cardinals/Wellfounded_More_FP.thy
37.5 + Author: Andrei Popescu, TU Muenchen
37.6 + Copyright 2012
37.7 +
37.8 +More on well-founded relations (FP).
37.9 +*)
37.10 +
37.11 +header {* More on Well-Founded Relations (FP) *}
37.12 +
37.13 +theory Wellfounded_More_FP
37.14 +imports Order_Relation_More_FP "~~/src/HOL/Library/Wfrec"
37.15 +begin
37.16 +
37.17 +
37.18 +text {* This section contains some variations of results in the theory
37.19 +@{text "Wellfounded.thy"}:
37.20 +\begin{itemize}
37.21 +\item means for slightly more direct definitions by well-founded recursion;
37.22 +\item variations of well-founded induction;
37.23 +\item means for proving a linear order to be a well-order.
37.24 +\end{itemize} *}
37.25 +
37.26 +
37.27 +subsection {* Well-founded recursion via genuine fixpoints *}
37.28 +
37.29 +
37.30 +(*2*)lemma wfrec_fixpoint:
37.31 +fixes r :: "('a * 'a) set" and
37.32 + H :: "('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b"
37.33 +assumes WF: "wf r" and ADM: "adm_wf r H"
37.34 +shows "wfrec r H = H (wfrec r H)"
37.35 +proof(rule ext)
37.36 + fix x
37.37 + have "wfrec r H x = H (cut (wfrec r H) r x) x"
37.38 + using wfrec[of r H] WF by simp
37.39 + also
37.40 + {have "\<And> y. (y,x) : r \<Longrightarrow> (cut (wfrec r H) r x) y = (wfrec r H) y"
37.41 + by (auto simp add: cut_apply)
37.42 + hence "H (cut (wfrec r H) r x) x = H (wfrec r H) x"
37.43 + using ADM adm_wf_def[of r H] by auto
37.44 + }
37.45 + finally show "wfrec r H x = H (wfrec r H) x" .
37.46 +qed
37.47 +
37.48 +
37.49 +
37.50 +subsection {* Characterizations of well-founded-ness *}
37.51 +
37.52 +
37.53 +text {* A transitive relation is well-founded iff it is ``locally" well-founded,
37.54 +i.e., iff its restriction to the lower bounds of of any element is well-founded. *}
37.55 +
37.56 +(*3*)lemma trans_wf_iff:
37.57 +assumes "trans r"
37.58 +shows "wf r = (\<forall>a. wf(r Int (r^-1``{a} \<times> r^-1``{a})))"
37.59 +proof-
37.60 + obtain R where R_def: "R = (\<lambda> a. r Int (r^-1``{a} \<times> r^-1``{a}))" by blast
37.61 + {assume *: "wf r"
37.62 + {fix a
37.63 + have "wf(R a)"
37.64 + using * R_def wf_subset[of r "R a"] by auto
37.65 + }
37.66 + }
37.67 + (* *)
37.68 + moreover
37.69 + {assume *: "\<forall>a. wf(R a)"
37.70 + have "wf r"
37.71 + proof(unfold wf_def, clarify)
37.72 + fix phi a
37.73 + assume **: "\<forall>a. (\<forall>b. (b,a) \<in> r \<longrightarrow> phi b) \<longrightarrow> phi a"
37.74 + obtain chi where chi_def: "chi = (\<lambda>b. (b,a) \<in> r \<longrightarrow> phi b)" by blast
37.75 + with * have "wf (R a)" by auto
37.76 + hence "(\<forall>b. (\<forall>c. (c,b) \<in> R a \<longrightarrow> chi c) \<longrightarrow> chi b) \<longrightarrow> (\<forall>b. chi b)"
37.77 + unfolding wf_def by blast
37.78 + moreover
37.79 + have "\<forall>b. (\<forall>c. (c,b) \<in> R a \<longrightarrow> chi c) \<longrightarrow> chi b"
37.80 + proof(auto simp add: chi_def R_def)
37.81 + fix b
37.82 + assume 1: "(b,a) \<in> r" and 2: "\<forall>c. (c, b) \<in> r \<and> (c, a) \<in> r \<longrightarrow> phi c"
37.83 + hence "\<forall>c. (c, b) \<in> r \<longrightarrow> phi c"
37.84 + using assms trans_def[of r] by blast
37.85 + thus "phi b" using ** by blast
37.86 + qed
37.87 + ultimately have "\<forall>b. chi b" by (rule mp)
37.88 + with ** chi_def show "phi a" by blast
37.89 + qed
37.90 + }
37.91 + ultimately show ?thesis using R_def by blast
37.92 +qed
37.93 +
37.94 +
37.95 +text {* The next lemma is a variation of @{text "wf_eq_minimal"} from Wellfounded,
37.96 +allowing one to assume the set included in the field. *}
37.97 +
37.98 +(*2*)lemma wf_eq_minimal2:
37.99 +"wf r = (\<forall>A. A <= Field r \<and> A \<noteq> {} \<longrightarrow> (\<exists>a \<in> A. \<forall>a' \<in> A. \<not> (a',a) \<in> r))"
37.100 +proof-
37.101 + let ?phi = "\<lambda> A. A \<noteq> {} \<longrightarrow> (\<exists>a \<in> A. \<forall>a' \<in> A. \<not> (a',a) \<in> r)"
37.102 + have "wf r = (\<forall>A. ?phi A)"
37.103 + by (auto simp: ex_in_conv [THEN sym], erule wfE_min, assumption, blast)
37.104 + (rule wfI_min, metis)
37.105 + (* *)
37.106 + also have "(\<forall>A. ?phi A) = (\<forall>B \<le> Field r. ?phi B)"
37.107 + proof
37.108 + assume "\<forall>A. ?phi A"
37.109 + thus "\<forall>B \<le> Field r. ?phi B" by simp
37.110 + next
37.111 + assume *: "\<forall>B \<le> Field r. ?phi B"
37.112 + show "\<forall>A. ?phi A"
37.113 + proof(clarify)
37.114 + fix A::"'a set" assume **: "A \<noteq> {}"
37.115 + obtain B where B_def: "B = A Int (Field r)" by blast
37.116 + show "\<exists>a \<in> A. \<forall>a' \<in> A. (a',a) \<notin> r"
37.117 + proof(cases "B = {}")
37.118 + assume Case1: "B = {}"
37.119 + obtain a where 1: "a \<in> A \<and> a \<notin> Field r"
37.120 + using ** Case1 unfolding B_def by blast
37.121 + hence "\<forall>a' \<in> A. (a',a) \<notin> r" using 1 unfolding Field_def by blast
37.122 + thus ?thesis using 1 by blast
37.123 + next
37.124 + assume Case2: "B \<noteq> {}" have 1: "B \<le> Field r" unfolding B_def by blast
37.125 + obtain a where 2: "a \<in> B \<and> (\<forall>a' \<in> B. (a',a) \<notin> r)"
37.126 + using Case2 1 * by blast
37.127 + have "\<forall>a' \<in> A. (a',a) \<notin> r"
37.128 + proof(clarify)
37.129 + fix a' assume "a' \<in> A" and **: "(a',a) \<in> r"
37.130 + hence "a' \<in> B" unfolding B_def Field_def by blast
37.131 + thus False using 2 ** by blast
37.132 + qed
37.133 + thus ?thesis using 2 unfolding B_def by blast
37.134 + qed
37.135 + qed
37.136 + qed
37.137 + finally show ?thesis by blast
37.138 +qed
37.139 +
37.140 +subsection {* Characterizations of well-founded-ness *}
37.141 +
37.142 +text {* The next lemma and its corollary enable one to prove that
37.143 +a linear order is a well-order in a way which is more standard than
37.144 +via well-founded-ness of the strict version of the relation. *}
37.145 +
37.146 +(*3*)
37.147 +lemma Linear_order_wf_diff_Id:
37.148 +assumes LI: "Linear_order r"
37.149 +shows "wf(r - Id) = (\<forall>A \<le> Field r. A \<noteq> {} \<longrightarrow> (\<exists>a \<in> A. \<forall>a' \<in> A. (a,a') \<in> r))"
37.150 +proof(cases "r \<le> Id")
37.151 + assume Case1: "r \<le> Id"
37.152 + hence temp: "r - Id = {}" by blast
37.153 + hence "wf(r - Id)" by (simp add: temp)
37.154 + moreover
37.155 + {fix A assume *: "A \<le> Field r" and **: "A \<noteq> {}"
37.156 + obtain a where 1: "r = {} \<or> r = {(a,a)}" using LI
37.157 + unfolding order_on_defs using Case1 rel.Total_subset_Id by metis
37.158 + hence "A = {a} \<and> r = {(a,a)}" using * ** unfolding Field_def by blast
37.159 + hence "\<exists>a \<in> A. \<forall>a' \<in> A. (a,a') \<in> r" using 1 by blast
37.160 + }
37.161 + ultimately show ?thesis by blast
37.162 +next
37.163 + assume Case2: "\<not> r \<le> Id"
37.164 + hence 1: "Field r = Field(r - Id)" using Total_Id_Field LI
37.165 + unfolding order_on_defs by blast
37.166 + show ?thesis
37.167 + proof
37.168 + assume *: "wf(r - Id)"
37.169 + show "\<forall>A \<le> Field r. A \<noteq> {} \<longrightarrow> (\<exists>a \<in> A. \<forall>a' \<in> A. (a,a') \<in> r)"
37.170 + proof(clarify)
37.171 + fix A assume **: "A \<le> Field r" and ***: "A \<noteq> {}"
37.172 + hence "\<exists>a \<in> A. \<forall>a' \<in> A. (a',a) \<notin> r - Id"
37.173 + using 1 * unfolding wf_eq_minimal2 by simp
37.174 + moreover have "\<forall>a \<in> A. \<forall>a' \<in> A. ((a,a') \<in> r) = ((a',a) \<notin> r - Id)"
37.175 + using rel.Linear_order_in_diff_Id[of r] ** LI by blast
37.176 + ultimately show "\<exists>a \<in> A. \<forall>a' \<in> A. (a,a') \<in> r" by blast
37.177 + qed
37.178 + next
37.179 + assume *: "\<forall>A \<le> Field r. A \<noteq> {} \<longrightarrow> (\<exists>a \<in> A. \<forall>a' \<in> A. (a,a') \<in> r)"
37.180 + show "wf(r - Id)"
37.181 + proof(unfold wf_eq_minimal2, clarify)
37.182 + fix A assume **: "A \<le> Field(r - Id)" and ***: "A \<noteq> {}"
37.183 + hence "\<exists>a \<in> A. \<forall>a' \<in> A. (a,a') \<in> r"
37.184 + using 1 * by simp
37.185 + moreover have "\<forall>a \<in> A. \<forall>a' \<in> A. ((a,a') \<in> r) = ((a',a) \<notin> r - Id)"
37.186 + using rel.Linear_order_in_diff_Id[of r] ** LI mono_Field[of "r - Id" r] by blast
37.187 + ultimately show "\<exists>a \<in> A. \<forall>a' \<in> A. (a',a) \<notin> r - Id" by blast
37.188 + qed
37.189 + qed
37.190 +qed
37.191 +
37.192 +(*3*)corollary Linear_order_Well_order_iff:
37.193 +assumes "Linear_order r"
37.194 +shows "Well_order r = (\<forall>A \<le> Field r. A \<noteq> {} \<longrightarrow> (\<exists>a \<in> A. \<forall>a' \<in> A. (a,a') \<in> r))"
37.195 +using assms unfolding well_order_on_def using Linear_order_wf_diff_Id[of r] by blast
37.196 +
37.197 +end
38.1 --- a/src/HOL/Cardinals/Wellorder_Embedding.thy Mon Nov 18 17:15:01 2013 +0100
38.2 +++ b/src/HOL/Cardinals/Wellorder_Embedding.thy Tue Nov 19 17:07:52 2013 +0100
38.3 @@ -8,7 +8,7 @@
38.4 header {* Well-Order Embeddings *}
38.5
38.6 theory Wellorder_Embedding
38.7 -imports Wellorder_Embedding_Base Fun_More Wellorder_Relation
38.8 +imports Wellorder_Embedding_FP Fun_More Wellorder_Relation
38.9 begin
38.10
38.11
39.1 --- a/src/HOL/Cardinals/Wellorder_Embedding_Base.thy Mon Nov 18 17:15:01 2013 +0100
39.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
39.3 @@ -1,1146 +0,0 @@
39.4 -(* Title: HOL/Cardinals/Wellorder_Embedding_Base.thy
39.5 - Author: Andrei Popescu, TU Muenchen
39.6 - Copyright 2012
39.7 -
39.8 -Well-order embeddings (base).
39.9 -*)
39.10 -
39.11 -header {* Well-Order Embeddings (Base) *}
39.12 -
39.13 -theory Wellorder_Embedding_Base
39.14 -imports "~~/src/HOL/Library/Zorn" Fun_More_Base Wellorder_Relation_Base
39.15 -begin
39.16 -
39.17 -
39.18 -text{* In this section, we introduce well-order {\em embeddings} and {\em isomorphisms} and
39.19 -prove their basic properties. The notion of embedding is considered from the point
39.20 -of view of the theory of ordinals, and therefore requires the source to be injected
39.21 -as an {\em initial segment} (i.e., {\em order filter}) of the target. A main result
39.22 -of this section is the existence of embeddings (in one direction or another) between
39.23 -any two well-orders, having as a consequence the fact that, given any two sets on
39.24 -any two types, one is smaller than (i.e., can be injected into) the other. *}
39.25 -
39.26 -
39.27 -subsection {* Auxiliaries *}
39.28 -
39.29 -lemma UNION_inj_on_ofilter:
39.30 -assumes WELL: "Well_order r" and
39.31 - OF: "\<And> i. i \<in> I \<Longrightarrow> wo_rel.ofilter r (A i)" and
39.32 - INJ: "\<And> i. i \<in> I \<Longrightarrow> inj_on f (A i)"
39.33 -shows "inj_on f (\<Union> i \<in> I. A i)"
39.34 -proof-
39.35 - have "wo_rel r" using WELL by (simp add: wo_rel_def)
39.36 - hence "\<And> i j. \<lbrakk>i \<in> I; j \<in> I\<rbrakk> \<Longrightarrow> A i <= A j \<or> A j <= A i"
39.37 - using wo_rel.ofilter_linord[of r] OF by blast
39.38 - with WELL INJ show ?thesis
39.39 - by (auto simp add: inj_on_UNION_chain)
39.40 -qed
39.41 -
39.42 -
39.43 -lemma under_underS_bij_betw:
39.44 -assumes WELL: "Well_order r" and WELL': "Well_order r'" and
39.45 - IN: "a \<in> Field r" and IN': "f a \<in> Field r'" and
39.46 - BIJ: "bij_betw f (rel.underS r a) (rel.underS r' (f a))"
39.47 -shows "bij_betw f (rel.under r a) (rel.under r' (f a))"
39.48 -proof-
39.49 - have "a \<notin> rel.underS r a \<and> f a \<notin> rel.underS r' (f a)"
39.50 - unfolding rel.underS_def by auto
39.51 - moreover
39.52 - {have "Refl r \<and> Refl r'" using WELL WELL'
39.53 - by (auto simp add: order_on_defs)
39.54 - hence "rel.under r a = rel.underS r a \<union> {a} \<and>
39.55 - rel.under r' (f a) = rel.underS r' (f a) \<union> {f a}"
39.56 - using IN IN' by(auto simp add: rel.Refl_under_underS)
39.57 - }
39.58 - ultimately show ?thesis
39.59 - using BIJ notIn_Un_bij_betw[of a "rel.underS r a" f "rel.underS r' (f a)"] by auto
39.60 -qed
39.61 -
39.62 -
39.63 -
39.64 -subsection {* (Well-order) embeddings, strict embeddings, isomorphisms and order-compatible
39.65 -functions *}
39.66 -
39.67 -
39.68 -text{* Standardly, a function is an embedding of a well-order in another if it injectively and
39.69 -order-compatibly maps the former into an order filter of the latter.
39.70 -Here we opt for a more succinct definition (operator @{text "embed"}),
39.71 -asking that, for any element in the source, the function should be a bijection
39.72 -between the set of strict lower bounds of that element
39.73 -and the set of strict lower bounds of its image. (Later we prove equivalence with
39.74 -the standard definition -- lemma @{text "embed_iff_compat_inj_on_ofilter"}.)
39.75 -A {\em strict embedding} (operator @{text "embedS"}) is a non-bijective embedding
39.76 -and an isomorphism (operator @{text "iso"}) is a bijective embedding. *}
39.77 -
39.78 -
39.79 -definition embed :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> ('a \<Rightarrow> 'a') \<Rightarrow> bool"
39.80 -where
39.81 -"embed r r' f \<equiv> \<forall>a \<in> Field r. bij_betw f (rel.under r a) (rel.under r' (f a))"
39.82 -
39.83 -
39.84 -lemmas embed_defs = embed_def embed_def[abs_def]
39.85 -
39.86 -
39.87 -text {* Strict embeddings: *}
39.88 -
39.89 -definition embedS :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> ('a \<Rightarrow> 'a') \<Rightarrow> bool"
39.90 -where
39.91 -"embedS r r' f \<equiv> embed r r' f \<and> \<not> bij_betw f (Field r) (Field r')"
39.92 -
39.93 -
39.94 -lemmas embedS_defs = embedS_def embedS_def[abs_def]
39.95 -
39.96 -
39.97 -definition iso :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> ('a \<Rightarrow> 'a') \<Rightarrow> bool"
39.98 -where
39.99 -"iso r r' f \<equiv> embed r r' f \<and> bij_betw f (Field r) (Field r')"
39.100 -
39.101 -
39.102 -lemmas iso_defs = iso_def iso_def[abs_def]
39.103 -
39.104 -
39.105 -definition compat :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> ('a \<Rightarrow> 'a') \<Rightarrow> bool"
39.106 -where
39.107 -"compat r r' f \<equiv> \<forall>a b. (a,b) \<in> r \<longrightarrow> (f a, f b) \<in> r'"
39.108 -
39.109 -
39.110 -lemma compat_wf:
39.111 -assumes CMP: "compat r r' f" and WF: "wf r'"
39.112 -shows "wf r"
39.113 -proof-
39.114 - have "r \<le> inv_image r' f"
39.115 - unfolding inv_image_def using CMP
39.116 - by (auto simp add: compat_def)
39.117 - with WF show ?thesis
39.118 - using wf_inv_image[of r' f] wf_subset[of "inv_image r' f"] by auto
39.119 -qed
39.120 -
39.121 -
39.122 -lemma id_embed: "embed r r id"
39.123 -by(auto simp add: id_def embed_def bij_betw_def)
39.124 -
39.125 -
39.126 -lemma id_iso: "iso r r id"
39.127 -by(auto simp add: id_def embed_def iso_def bij_betw_def)
39.128 -
39.129 -
39.130 -lemma embed_in_Field:
39.131 -assumes WELL: "Well_order r" and
39.132 - EMB: "embed r r' f" and IN: "a \<in> Field r"
39.133 -shows "f a \<in> Field r'"
39.134 -proof-
39.135 - have Well: "wo_rel r"
39.136 - using WELL by (auto simp add: wo_rel_def)
39.137 - hence 1: "Refl r"
39.138 - by (auto simp add: wo_rel.REFL)
39.139 - hence "a \<in> rel.under r a" using IN rel.Refl_under_in by fastforce
39.140 - hence "f a \<in> rel.under r' (f a)"
39.141 - using EMB IN by (auto simp add: embed_def bij_betw_def)
39.142 - thus ?thesis unfolding Field_def
39.143 - by (auto simp: rel.under_def)
39.144 -qed
39.145 -
39.146 -
39.147 -lemma comp_embed:
39.148 -assumes WELL: "Well_order r" and
39.149 - EMB: "embed r r' f" and EMB': "embed r' r'' f'"
39.150 -shows "embed r r'' (f' o f)"
39.151 -proof(unfold embed_def, auto)
39.152 - fix a assume *: "a \<in> Field r"
39.153 - hence "bij_betw f (rel.under r a) (rel.under r' (f a))"
39.154 - using embed_def[of r] EMB by auto
39.155 - moreover
39.156 - {have "f a \<in> Field r'"
39.157 - using EMB WELL * by (auto simp add: embed_in_Field)
39.158 - hence "bij_betw f' (rel.under r' (f a)) (rel.under r'' (f' (f a)))"
39.159 - using embed_def[of r'] EMB' by auto
39.160 - }
39.161 - ultimately
39.162 - show "bij_betw (f' \<circ> f) (rel.under r a) (rel.under r'' (f'(f a)))"
39.163 - by(auto simp add: bij_betw_trans)
39.164 -qed
39.165 -
39.166 -
39.167 -lemma comp_iso:
39.168 -assumes WELL: "Well_order r" and
39.169 - EMB: "iso r r' f" and EMB': "iso r' r'' f'"
39.170 -shows "iso r r'' (f' o f)"
39.171 -using assms unfolding iso_def
39.172 -by (auto simp add: comp_embed bij_betw_trans)
39.173 -
39.174 -
39.175 -text{* That @{text "embedS"} is also preserved by function composition shall be proved only later. *}
39.176 -
39.177 -
39.178 -lemma embed_Field:
39.179 -"\<lbrakk>Well_order r; embed r r' f\<rbrakk> \<Longrightarrow> f`(Field r) \<le> Field r'"
39.180 -by (auto simp add: embed_in_Field)
39.181 -
39.182 -
39.183 -lemma embed_preserves_ofilter:
39.184 -assumes WELL: "Well_order r" and WELL': "Well_order r'" and
39.185 - EMB: "embed r r' f" and OF: "wo_rel.ofilter r A"
39.186 -shows "wo_rel.ofilter r' (f`A)"
39.187 -proof-
39.188 - (* Preliminary facts *)
39.189 - from WELL have Well: "wo_rel r" unfolding wo_rel_def .
39.190 - from WELL' have Well': "wo_rel r'" unfolding wo_rel_def .
39.191 - from OF have 0: "A \<le> Field r" by(auto simp add: Well wo_rel.ofilter_def)
39.192 - (* Main proof *)
39.193 - show ?thesis using Well' WELL EMB 0 embed_Field[of r r' f]
39.194 - proof(unfold wo_rel.ofilter_def, auto simp add: image_def)
39.195 - fix a b'
39.196 - assume *: "a \<in> A" and **: "b' \<in> rel.under r' (f a)"
39.197 - hence "a \<in> Field r" using 0 by auto
39.198 - hence "bij_betw f (rel.under r a) (rel.under r' (f a))"
39.199 - using * EMB by (auto simp add: embed_def)
39.200 - hence "f`(rel.under r a) = rel.under r' (f a)"
39.201 - by (simp add: bij_betw_def)
39.202 - with ** image_def[of f "rel.under r a"] obtain b where
39.203 - 1: "b \<in> rel.under r a \<and> b' = f b" by blast
39.204 - hence "b \<in> A" using Well * OF
39.205 - by (auto simp add: wo_rel.ofilter_def)
39.206 - with 1 show "\<exists>b \<in> A. b' = f b" by blast
39.207 - qed
39.208 -qed
39.209 -
39.210 -
39.211 -lemma embed_Field_ofilter:
39.212 -assumes WELL: "Well_order r" and WELL': "Well_order r'" and
39.213 - EMB: "embed r r' f"
39.214 -shows "wo_rel.ofilter r' (f`(Field r))"
39.215 -proof-
39.216 - have "wo_rel.ofilter r (Field r)"
39.217 - using WELL by (auto simp add: wo_rel_def wo_rel.Field_ofilter)
39.218 - with WELL WELL' EMB
39.219 - show ?thesis by (auto simp add: embed_preserves_ofilter)
39.220 -qed
39.221 -
39.222 -
39.223 -lemma embed_compat:
39.224 -assumes EMB: "embed r r' f"
39.225 -shows "compat r r' f"
39.226 -proof(unfold compat_def, clarify)
39.227 - fix a b
39.228 - assume *: "(a,b) \<in> r"
39.229 - hence 1: "b \<in> Field r" using Field_def[of r] by blast
39.230 - have "a \<in> rel.under r b"
39.231 - using * rel.under_def[of r] by simp
39.232 - hence "f a \<in> rel.under r' (f b)"
39.233 - using EMB embed_def[of r r' f]
39.234 - bij_betw_def[of f "rel.under r b" "rel.under r' (f b)"]
39.235 - image_def[of f "rel.under r b"] 1 by auto
39.236 - thus "(f a, f b) \<in> r'"
39.237 - by (auto simp add: rel.under_def)
39.238 -qed
39.239 -
39.240 -
39.241 -lemma embed_inj_on:
39.242 -assumes WELL: "Well_order r" and EMB: "embed r r' f"
39.243 -shows "inj_on f (Field r)"
39.244 -proof(unfold inj_on_def, clarify)
39.245 - (* Preliminary facts *)
39.246 - from WELL have Well: "wo_rel r" unfolding wo_rel_def .
39.247 - with wo_rel.TOTAL[of r]
39.248 - have Total: "Total r" by simp
39.249 - from Well wo_rel.REFL[of r]
39.250 - have Refl: "Refl r" by simp
39.251 - (* Main proof *)
39.252 - fix a b
39.253 - assume *: "a \<in> Field r" and **: "b \<in> Field r" and
39.254 - ***: "f a = f b"
39.255 - hence 1: "a \<in> Field r \<and> b \<in> Field r"
39.256 - unfolding Field_def by auto
39.257 - {assume "(a,b) \<in> r"
39.258 - hence "a \<in> rel.under r b \<and> b \<in> rel.under r b"
39.259 - using Refl by(auto simp add: rel.under_def refl_on_def)
39.260 - hence "a = b"
39.261 - using EMB 1 ***
39.262 - by (auto simp add: embed_def bij_betw_def inj_on_def)
39.263 - }
39.264 - moreover
39.265 - {assume "(b,a) \<in> r"
39.266 - hence "a \<in> rel.under r a \<and> b \<in> rel.under r a"
39.267 - using Refl by(auto simp add: rel.under_def refl_on_def)
39.268 - hence "a = b"
39.269 - using EMB 1 ***
39.270 - by (auto simp add: embed_def bij_betw_def inj_on_def)
39.271 - }
39.272 - ultimately
39.273 - show "a = b" using Total 1
39.274 - by (auto simp add: total_on_def)
39.275 -qed
39.276 -
39.277 -
39.278 -lemma embed_underS:
39.279 -assumes WELL: "Well_order r" and WELL': "Well_order r'" and
39.280 - EMB: "embed r r' f" and IN: "a \<in> Field r"
39.281 -shows "bij_betw f (rel.underS r a) (rel.underS r' (f a))"
39.282 -proof-
39.283 - have "bij_betw f (rel.under r a) (rel.under r' (f a))"
39.284 - using assms by (auto simp add: embed_def)
39.285 - moreover
39.286 - {have "f a \<in> Field r'" using assms embed_Field[of r r' f] by auto
39.287 - hence "rel.under r a = rel.underS r a \<union> {a} \<and>
39.288 - rel.under r' (f a) = rel.underS r' (f a) \<union> {f a}"
39.289 - using assms by (auto simp add: order_on_defs rel.Refl_under_underS)
39.290 - }
39.291 - moreover
39.292 - {have "a \<notin> rel.underS r a \<and> f a \<notin> rel.underS r' (f a)"
39.293 - unfolding rel.underS_def by blast
39.294 - }
39.295 - ultimately show ?thesis
39.296 - by (auto simp add: notIn_Un_bij_betw3)
39.297 -qed
39.298 -
39.299 -
39.300 -lemma embed_iff_compat_inj_on_ofilter:
39.301 -assumes WELL: "Well_order r" and WELL': "Well_order r'"
39.302 -shows "embed r r' f = (compat r r' f \<and> inj_on f (Field r) \<and> wo_rel.ofilter r' (f`(Field r)))"
39.303 -using assms
39.304 -proof(auto simp add: embed_compat embed_inj_on embed_Field_ofilter,
39.305 - unfold embed_def, auto) (* get rid of one implication *)
39.306 - fix a
39.307 - assume *: "inj_on f (Field r)" and
39.308 - **: "compat r r' f" and
39.309 - ***: "wo_rel.ofilter r' (f`(Field r))" and
39.310 - ****: "a \<in> Field r"
39.311 - (* Preliminary facts *)
39.312 - have Well: "wo_rel r"
39.313 - using WELL wo_rel_def[of r] by simp
39.314 - hence Refl: "Refl r"
39.315 - using wo_rel.REFL[of r] by simp
39.316 - have Total: "Total r"
39.317 - using Well wo_rel.TOTAL[of r] by simp
39.318 - have Well': "wo_rel r'"
39.319 - using WELL' wo_rel_def[of r'] by simp
39.320 - hence Antisym': "antisym r'"
39.321 - using wo_rel.ANTISYM[of r'] by simp
39.322 - have "(a,a) \<in> r"
39.323 - using **** Well wo_rel.REFL[of r]
39.324 - refl_on_def[of _ r] by auto
39.325 - hence "(f a, f a) \<in> r'"
39.326 - using ** by(auto simp add: compat_def)
39.327 - hence 0: "f a \<in> Field r'"
39.328 - unfolding Field_def by auto
39.329 - have "f a \<in> f`(Field r)"
39.330 - using **** by auto
39.331 - hence 2: "rel.under r' (f a) \<le> f`(Field r)"
39.332 - using Well' *** wo_rel.ofilter_def[of r' "f`(Field r)"] by fastforce
39.333 - (* Main proof *)
39.334 - show "bij_betw f (rel.under r a) (rel.under r' (f a))"
39.335 - proof(unfold bij_betw_def, auto)
39.336 - show "inj_on f (rel.under r a)"
39.337 - using *
39.338 - by (auto simp add: rel.under_Field subset_inj_on)
39.339 - next
39.340 - fix b assume "b \<in> rel.under r a"
39.341 - thus "f b \<in> rel.under r' (f a)"
39.342 - unfolding rel.under_def using **
39.343 - by (auto simp add: compat_def)
39.344 - next
39.345 - fix b' assume *****: "b' \<in> rel.under r' (f a)"
39.346 - hence "b' \<in> f`(Field r)"
39.347 - using 2 by auto
39.348 - with Field_def[of r] obtain b where
39.349 - 3: "b \<in> Field r" and 4: "b' = f b" by auto
39.350 - have "(b,a): r"
39.351 - proof-
39.352 - {assume "(a,b) \<in> r"
39.353 - with ** 4 have "(f a, b'): r'"
39.354 - by (auto simp add: compat_def)
39.355 - with ***** Antisym' have "f a = b'"
39.356 - by(auto simp add: rel.under_def antisym_def)
39.357 - with 3 **** 4 * have "a = b"
39.358 - by(auto simp add: inj_on_def)
39.359 - }
39.360 - moreover
39.361 - {assume "a = b"
39.362 - hence "(b,a) \<in> r" using Refl **** 3
39.363 - by (auto simp add: refl_on_def)
39.364 - }
39.365 - ultimately
39.366 - show ?thesis using Total **** 3 by (fastforce simp add: total_on_def)
39.367 - qed
39.368 - with 4 show "b' \<in> f`(rel.under r a)"
39.369 - unfolding rel.under_def by auto
39.370 - qed
39.371 -qed
39.372 -
39.373 -
39.374 -lemma inv_into_ofilter_embed:
39.375 -assumes WELL: "Well_order r" and OF: "wo_rel.ofilter r A" and
39.376 - BIJ: "\<forall>b \<in> A. bij_betw f (rel.under r b) (rel.under r' (f b))" and
39.377 - IMAGE: "f ` A = Field r'"
39.378 -shows "embed r' r (inv_into A f)"
39.379 -proof-
39.380 - (* Preliminary facts *)
39.381 - have Well: "wo_rel r"
39.382 - using WELL wo_rel_def[of r] by simp
39.383 - have Refl: "Refl r"
39.384 - using Well wo_rel.REFL[of r] by simp
39.385 - have Total: "Total r"
39.386 - using Well wo_rel.TOTAL[of r] by simp
39.387 - (* Main proof *)
39.388 - have 1: "bij_betw f A (Field r')"
39.389 - proof(unfold bij_betw_def inj_on_def, auto simp add: IMAGE)
39.390 - fix b1 b2
39.391 - assume *: "b1 \<in> A" and **: "b2 \<in> A" and
39.392 - ***: "f b1 = f b2"
39.393 - have 11: "b1 \<in> Field r \<and> b2 \<in> Field r"
39.394 - using * ** Well OF by (auto simp add: wo_rel.ofilter_def)
39.395 - moreover
39.396 - {assume "(b1,b2) \<in> r"
39.397 - hence "b1 \<in> rel.under r b2 \<and> b2 \<in> rel.under r b2"
39.398 - unfolding rel.under_def using 11 Refl
39.399 - by (auto simp add: refl_on_def)
39.400 - hence "b1 = b2" using BIJ * ** ***
39.401 - by (auto simp add: bij_betw_def inj_on_def)
39.402 - }
39.403 - moreover
39.404 - {assume "(b2,b1) \<in> r"
39.405 - hence "b1 \<in> rel.under r b1 \<and> b2 \<in> rel.under r b1"
39.406 - unfolding rel.under_def using 11 Refl
39.407 - by (auto simp add: refl_on_def)
39.408 - hence "b1 = b2" using BIJ * ** ***
39.409 - by (auto simp add: bij_betw_def inj_on_def)
39.410 - }
39.411 - ultimately
39.412 - show "b1 = b2"
39.413 - using Total by (auto simp add: total_on_def)
39.414 - qed
39.415 - (* *)
39.416 - let ?f' = "(inv_into A f)"
39.417 - (* *)
39.418 - have 2: "\<forall>b \<in> A. bij_betw ?f' (rel.under r' (f b)) (rel.under r b)"
39.419 - proof(clarify)
39.420 - fix b assume *: "b \<in> A"
39.421 - hence "rel.under r b \<le> A"
39.422 - using Well OF by(auto simp add: wo_rel.ofilter_def)
39.423 - moreover
39.424 - have "f ` (rel.under r b) = rel.under r' (f b)"
39.425 - using * BIJ by (auto simp add: bij_betw_def)
39.426 - ultimately
39.427 - show "bij_betw ?f' (rel.under r' (f b)) (rel.under r b)"
39.428 - using 1 by (auto simp add: bij_betw_inv_into_subset)
39.429 - qed
39.430 - (* *)
39.431 - have 3: "\<forall>b' \<in> Field r'. bij_betw ?f' (rel.under r' b') (rel.under r (?f' b'))"
39.432 - proof(clarify)
39.433 - fix b' assume *: "b' \<in> Field r'"
39.434 - have "b' = f (?f' b')" using * 1
39.435 - by (auto simp add: bij_betw_inv_into_right)
39.436 - moreover
39.437 - {obtain b where 31: "b \<in> A" and "f b = b'" using IMAGE * by force
39.438 - hence "?f' b' = b" using 1 by (auto simp add: bij_betw_inv_into_left)
39.439 - with 31 have "?f' b' \<in> A" by auto
39.440 - }
39.441 - ultimately
39.442 - show "bij_betw ?f' (rel.under r' b') (rel.under r (?f' b'))"
39.443 - using 2 by auto
39.444 - qed
39.445 - (* *)
39.446 - thus ?thesis unfolding embed_def .
39.447 -qed
39.448 -
39.449 -
39.450 -lemma inv_into_underS_embed:
39.451 -assumes WELL: "Well_order r" and
39.452 - BIJ: "\<forall>b \<in> rel.underS r a. bij_betw f (rel.under r b) (rel.under r' (f b))" and
39.453 - IN: "a \<in> Field r" and
39.454 - IMAGE: "f ` (rel.underS r a) = Field r'"
39.455 -shows "embed r' r (inv_into (rel.underS r a) f)"
39.456 -using assms
39.457 -by(auto simp add: wo_rel_def wo_rel.underS_ofilter inv_into_ofilter_embed)
39.458 -
39.459 -
39.460 -lemma inv_into_Field_embed:
39.461 -assumes WELL: "Well_order r" and EMB: "embed r r' f" and
39.462 - IMAGE: "Field r' \<le> f ` (Field r)"
39.463 -shows "embed r' r (inv_into (Field r) f)"
39.464 -proof-
39.465 - have "(\<forall>b \<in> Field r. bij_betw f (rel.under r b) (rel.under r' (f b)))"
39.466 - using EMB by (auto simp add: embed_def)
39.467 - moreover
39.468 - have "f ` (Field r) \<le> Field r'"
39.469 - using EMB WELL by (auto simp add: embed_Field)
39.470 - ultimately
39.471 - show ?thesis using assms
39.472 - by(auto simp add: wo_rel_def wo_rel.Field_ofilter inv_into_ofilter_embed)
39.473 -qed
39.474 -
39.475 -
39.476 -lemma inv_into_Field_embed_bij_betw:
39.477 -assumes WELL: "Well_order r" and
39.478 - EMB: "embed r r' f" and BIJ: "bij_betw f (Field r) (Field r')"
39.479 -shows "embed r' r (inv_into (Field r) f)"
39.480 -proof-
39.481 - have "Field r' \<le> f ` (Field r)"
39.482 - using BIJ by (auto simp add: bij_betw_def)
39.483 - thus ?thesis using assms
39.484 - by(auto simp add: inv_into_Field_embed)
39.485 -qed
39.486 -
39.487 -
39.488 -
39.489 -
39.490 -
39.491 -subsection {* Given any two well-orders, one can be embedded in the other *}
39.492 -
39.493 -
39.494 -text{* Here is an overview of the proof of of this fact, stated in theorem
39.495 -@{text "wellorders_totally_ordered"}:
39.496 -
39.497 - Fix the well-orders @{text "r::'a rel"} and @{text "r'::'a' rel"}.
39.498 - Attempt to define an embedding @{text "f::'a \<Rightarrow> 'a'"} from @{text "r"} to @{text "r'"} in the
39.499 - natural way by well-order recursion ("hoping" that @{text "Field r"} turns out to be smaller
39.500 - than @{text "Field r'"}), but also record, at the recursive step, in a function
39.501 - @{text "g::'a \<Rightarrow> bool"}, the extra information of whether @{text "Field r'"}
39.502 - gets exhausted or not.
39.503 -
39.504 - If @{text "Field r'"} does not get exhausted, then @{text "Field r"} is indeed smaller
39.505 - and @{text "f"} is the desired embedding from @{text "r"} to @{text "r'"}
39.506 - (lemma @{text "wellorders_totally_ordered_aux"}).
39.507 -
39.508 - Otherwise, it means that @{text "Field r'"} is the smaller one, and the inverse of
39.509 - (the "good" segment of) @{text "f"} is the desired embedding from @{text "r'"} to @{text "r"}
39.510 - (lemma @{text "wellorders_totally_ordered_aux2"}).
39.511 -*}
39.512 -
39.513 -
39.514 -lemma wellorders_totally_ordered_aux:
39.515 -fixes r ::"'a rel" and r'::"'a' rel" and
39.516 - f :: "'a \<Rightarrow> 'a'" and a::'a
39.517 -assumes WELL: "Well_order r" and WELL': "Well_order r'" and IN: "a \<in> Field r" and
39.518 - IH: "\<forall>b \<in> rel.underS r a. bij_betw f (rel.under r b) (rel.under r' (f b))" and
39.519 - NOT: "f ` (rel.underS r a) \<noteq> Field r'" and SUC: "f a = wo_rel.suc r' (f`(rel.underS r a))"
39.520 -shows "bij_betw f (rel.under r a) (rel.under r' (f a))"
39.521 -proof-
39.522 - (* Preliminary facts *)
39.523 - have Well: "wo_rel r" using WELL unfolding wo_rel_def .
39.524 - hence Refl: "Refl r" using wo_rel.REFL[of r] by auto
39.525 - have Trans: "trans r" using Well wo_rel.TRANS[of r] by auto
39.526 - have Well': "wo_rel r'" using WELL' unfolding wo_rel_def .
39.527 - have OF: "wo_rel.ofilter r (rel.underS r a)"
39.528 - by (auto simp add: Well wo_rel.underS_ofilter)
39.529 - hence UN: "rel.underS r a = (\<Union> b \<in> rel.underS r a. rel.under r b)"
39.530 - using Well wo_rel.ofilter_under_UNION[of r "rel.underS r a"] by blast
39.531 - (* Gather facts about elements of rel.underS r a *)
39.532 - {fix b assume *: "b \<in> rel.underS r a"
39.533 - hence t0: "(b,a) \<in> r \<and> b \<noteq> a" unfolding rel.underS_def by auto
39.534 - have t1: "b \<in> Field r"
39.535 - using * rel.underS_Field[of r a] by auto
39.536 - have t2: "f`(rel.under r b) = rel.under r' (f b)"
39.537 - using IH * by (auto simp add: bij_betw_def)
39.538 - hence t3: "wo_rel.ofilter r' (f`(rel.under r b))"
39.539 - using Well' by (auto simp add: wo_rel.under_ofilter)
39.540 - have "f`(rel.under r b) \<le> Field r'"
39.541 - using t2 by (auto simp add: rel.under_Field)
39.542 - moreover
39.543 - have "b \<in> rel.under r b"
39.544 - using t1 by(auto simp add: Refl rel.Refl_under_in)
39.545 - ultimately
39.546 - have t4: "f b \<in> Field r'" by auto
39.547 - have "f`(rel.under r b) = rel.under r' (f b) \<and>
39.548 - wo_rel.ofilter r' (f`(rel.under r b)) \<and>
39.549 - f b \<in> Field r'"
39.550 - using t2 t3 t4 by auto
39.551 - }
39.552 - hence bFact:
39.553 - "\<forall>b \<in> rel.underS r a. f`(rel.under r b) = rel.under r' (f b) \<and>
39.554 - wo_rel.ofilter r' (f`(rel.under r b)) \<and>
39.555 - f b \<in> Field r'" by blast
39.556 - (* *)
39.557 - have subField: "f`(rel.underS r a) \<le> Field r'"
39.558 - using bFact by blast
39.559 - (* *)
39.560 - have OF': "wo_rel.ofilter r' (f`(rel.underS r a))"
39.561 - proof-
39.562 - have "f`(rel.underS r a) = f`(\<Union> b \<in> rel.underS r a. rel.under r b)"
39.563 - using UN by auto
39.564 - also have "\<dots> = (\<Union> b \<in> rel.underS r a. f`(rel.under r b))" by blast
39.565 - also have "\<dots> = (\<Union> b \<in> rel.underS r a. (rel.under r' (f b)))"
39.566 - using bFact by auto
39.567 - finally
39.568 - have "f`(rel.underS r a) = (\<Union> b \<in> rel.underS r a. (rel.under r' (f b)))" .
39.569 - thus ?thesis
39.570 - using Well' bFact
39.571 - wo_rel.ofilter_UNION[of r' "rel.underS r a" "\<lambda> b. rel.under r' (f b)"] by fastforce
39.572 - qed
39.573 - (* *)
39.574 - have "f`(rel.underS r a) \<union> rel.AboveS r' (f`(rel.underS r a)) = Field r'"
39.575 - using Well' OF' by (auto simp add: wo_rel.ofilter_AboveS_Field)
39.576 - hence NE: "rel.AboveS r' (f`(rel.underS r a)) \<noteq> {}"
39.577 - using subField NOT by blast
39.578 - (* Main proof *)
39.579 - have INCL1: "f`(rel.underS r a) \<le> rel.underS r' (f a) "
39.580 - proof(auto)
39.581 - fix b assume *: "b \<in> rel.underS r a"
39.582 - have "f b \<noteq> f a \<and> (f b, f a) \<in> r'"
39.583 - using subField Well' SUC NE *
39.584 - wo_rel.suc_greater[of r' "f`(rel.underS r a)" "f b"] by auto
39.585 - thus "f b \<in> rel.underS r' (f a)"
39.586 - unfolding rel.underS_def by simp
39.587 - qed
39.588 - (* *)
39.589 - have INCL2: "rel.underS r' (f a) \<le> f`(rel.underS r a)"
39.590 - proof
39.591 - fix b' assume "b' \<in> rel.underS r' (f a)"
39.592 - hence "b' \<noteq> f a \<and> (b', f a) \<in> r'"
39.593 - unfolding rel.underS_def by simp
39.594 - thus "b' \<in> f`(rel.underS r a)"
39.595 - using Well' SUC NE OF'
39.596 - wo_rel.suc_ofilter_in[of r' "f ` rel.underS r a" b'] by auto
39.597 - qed
39.598 - (* *)
39.599 - have INJ: "inj_on f (rel.underS r a)"
39.600 - proof-
39.601 - have "\<forall>b \<in> rel.underS r a. inj_on f (rel.under r b)"
39.602 - using IH by (auto simp add: bij_betw_def)
39.603 - moreover
39.604 - have "\<forall>b. wo_rel.ofilter r (rel.under r b)"
39.605 - using Well by (auto simp add: wo_rel.under_ofilter)
39.606 - ultimately show ?thesis
39.607 - using WELL bFact UN
39.608 - UNION_inj_on_ofilter[of r "rel.underS r a" "\<lambda>b. rel.under r b" f]
39.609 - by auto
39.610 - qed
39.611 - (* *)
39.612 - have BIJ: "bij_betw f (rel.underS r a) (rel.underS r' (f a))"
39.613 - unfolding bij_betw_def
39.614 - using INJ INCL1 INCL2 by auto
39.615 - (* *)
39.616 - have "f a \<in> Field r'"
39.617 - using Well' subField NE SUC
39.618 - by (auto simp add: wo_rel.suc_inField)
39.619 - thus ?thesis
39.620 - using WELL WELL' IN BIJ under_underS_bij_betw[of r r' a f] by auto
39.621 -qed
39.622 -
39.623 -
39.624 -lemma wellorders_totally_ordered_aux2:
39.625 -fixes r ::"'a rel" and r'::"'a' rel" and
39.626 - f :: "'a \<Rightarrow> 'a'" and g :: "'a \<Rightarrow> bool" and a::'a
39.627 -assumes WELL: "Well_order r" and WELL': "Well_order r'" and
39.628 -MAIN1:
39.629 - "\<And> a. (False \<notin> g`(rel.underS r a) \<and> f`(rel.underS r a) \<noteq> Field r'
39.630 - \<longrightarrow> f a = wo_rel.suc r' (f`(rel.underS r a)) \<and> g a = True)
39.631 - \<and>
39.632 - (\<not>(False \<notin> (g`(rel.underS r a)) \<and> f`(rel.underS r a) \<noteq> Field r')
39.633 - \<longrightarrow> g a = False)" and
39.634 -MAIN2: "\<And> a. a \<in> Field r \<and> False \<notin> g`(rel.under r a) \<longrightarrow>
39.635 - bij_betw f (rel.under r a) (rel.under r' (f a))" and
39.636 -Case: "a \<in> Field r \<and> False \<in> g`(rel.under r a)"
39.637 -shows "\<exists>f'. embed r' r f'"
39.638 -proof-
39.639 - have Well: "wo_rel r" using WELL unfolding wo_rel_def .
39.640 - hence Refl: "Refl r" using wo_rel.REFL[of r] by auto
39.641 - have Trans: "trans r" using Well wo_rel.TRANS[of r] by auto
39.642 - have Antisym: "antisym r" using Well wo_rel.ANTISYM[of r] by auto
39.643 - have Well': "wo_rel r'" using WELL' unfolding wo_rel_def .
39.644 - (* *)
39.645 - have 0: "rel.under r a = rel.underS r a \<union> {a}"
39.646 - using Refl Case by(auto simp add: rel.Refl_under_underS)
39.647 - (* *)
39.648 - have 1: "g a = False"
39.649 - proof-
39.650 - {assume "g a \<noteq> False"
39.651 - with 0 Case have "False \<in> g`(rel.underS r a)" by blast
39.652 - with MAIN1 have "g a = False" by blast}
39.653 - thus ?thesis by blast
39.654 - qed
39.655 - let ?A = "{a \<in> Field r. g a = False}"
39.656 - let ?a = "(wo_rel.minim r ?A)"
39.657 - (* *)
39.658 - have 2: "?A \<noteq> {} \<and> ?A \<le> Field r" using Case 1 by blast
39.659 - (* *)
39.660 - have 3: "False \<notin> g`(rel.underS r ?a)"
39.661 - proof
39.662 - assume "False \<in> g`(rel.underS r ?a)"
39.663 - then obtain b where "b \<in> rel.underS r ?a" and 31: "g b = False" by auto
39.664 - hence 32: "(b,?a) \<in> r \<and> b \<noteq> ?a"
39.665 - by (auto simp add: rel.underS_def)
39.666 - hence "b \<in> Field r" unfolding Field_def by auto
39.667 - with 31 have "b \<in> ?A" by auto
39.668 - hence "(?a,b) \<in> r" using wo_rel.minim_least 2 Well by fastforce
39.669 - (* again: why worked without type annotations? *)
39.670 - with 32 Antisym show False
39.671 - by (auto simp add: antisym_def)
39.672 - qed
39.673 - have temp: "?a \<in> ?A"
39.674 - using Well 2 wo_rel.minim_in[of r ?A] by auto
39.675 - hence 4: "?a \<in> Field r" by auto
39.676 - (* *)
39.677 - have 5: "g ?a = False" using temp by blast
39.678 - (* *)
39.679 - have 6: "f`(rel.underS r ?a) = Field r'"
39.680 - using MAIN1[of ?a] 3 5 by blast
39.681 - (* *)
39.682 - have 7: "\<forall>b \<in> rel.underS r ?a. bij_betw f (rel.under r b) (rel.under r' (f b))"
39.683 - proof
39.684 - fix b assume as: "b \<in> rel.underS r ?a"
39.685 - moreover
39.686 - have "wo_rel.ofilter r (rel.underS r ?a)"
39.687 - using Well by (auto simp add: wo_rel.underS_ofilter)
39.688 - ultimately
39.689 - have "False \<notin> g`(rel.under r b)" using 3 Well by (subst (asm) wo_rel.ofilter_def) fast+
39.690 - moreover have "b \<in> Field r"
39.691 - unfolding Field_def using as by (auto simp add: rel.underS_def)
39.692 - ultimately
39.693 - show "bij_betw f (rel.under r b) (rel.under r' (f b))"
39.694 - using MAIN2 by auto
39.695 - qed
39.696 - (* *)
39.697 - have "embed r' r (inv_into (rel.underS r ?a) f)"
39.698 - using WELL WELL' 7 4 6 inv_into_underS_embed[of r ?a f r'] by auto
39.699 - thus ?thesis
39.700 - unfolding embed_def by blast
39.701 -qed
39.702 -
39.703 -
39.704 -theorem wellorders_totally_ordered:
39.705 -fixes r ::"'a rel" and r'::"'a' rel"
39.706 -assumes WELL: "Well_order r" and WELL': "Well_order r'"
39.707 -shows "(\<exists>f. embed r r' f) \<or> (\<exists>f'. embed r' r f')"
39.708 -proof-
39.709 - (* Preliminary facts *)
39.710 - have Well: "wo_rel r" using WELL unfolding wo_rel_def .
39.711 - hence Refl: "Refl r" using wo_rel.REFL[of r] by auto
39.712 - have Trans: "trans r" using Well wo_rel.TRANS[of r] by auto
39.713 - have Well': "wo_rel r'" using WELL' unfolding wo_rel_def .
39.714 - (* Main proof *)
39.715 - obtain H where H_def: "H =
39.716 - (\<lambda>h a. if False \<notin> (snd o h)`(rel.underS r a) \<and> (fst o h)`(rel.underS r a) \<noteq> Field r'
39.717 - then (wo_rel.suc r' ((fst o h)`(rel.underS r a)), True)
39.718 - else (undefined, False))" by blast
39.719 - have Adm: "wo_rel.adm_wo r H"
39.720 - using Well
39.721 - proof(unfold wo_rel.adm_wo_def, clarify)
39.722 - fix h1::"'a \<Rightarrow> 'a' * bool" and h2::"'a \<Rightarrow> 'a' * bool" and x
39.723 - assume "\<forall>y\<in>rel.underS r x. h1 y = h2 y"
39.724 - hence "\<forall>y\<in>rel.underS r x. (fst o h1) y = (fst o h2) y \<and>
39.725 - (snd o h1) y = (snd o h2) y" by auto
39.726 - hence "(fst o h1)`(rel.underS r x) = (fst o h2)`(rel.underS r x) \<and>
39.727 - (snd o h1)`(rel.underS r x) = (snd o h2)`(rel.underS r x)"
39.728 - by (auto simp add: image_def)
39.729 - thus "H h1 x = H h2 x" by (simp add: H_def del: not_False_in_image_Ball)
39.730 - qed
39.731 - (* More constant definitions: *)
39.732 - obtain h::"'a \<Rightarrow> 'a' * bool" and f::"'a \<Rightarrow> 'a'" and g::"'a \<Rightarrow> bool"
39.733 - where h_def: "h = wo_rel.worec r H" and
39.734 - f_def: "f = fst o h" and g_def: "g = snd o h" by blast
39.735 - obtain test where test_def:
39.736 - "test = (\<lambda> a. False \<notin> (g`(rel.underS r a)) \<and> f`(rel.underS r a) \<noteq> Field r')" by blast
39.737 - (* *)
39.738 - have *: "\<And> a. h a = H h a"
39.739 - using Adm Well wo_rel.worec_fixpoint[of r H] by (simp add: h_def)
39.740 - have Main1:
39.741 - "\<And> a. (test a \<longrightarrow> f a = wo_rel.suc r' (f`(rel.underS r a)) \<and> g a = True) \<and>
39.742 - (\<not>(test a) \<longrightarrow> g a = False)"
39.743 - proof- (* How can I prove this withou fixing a? *)
39.744 - fix a show "(test a \<longrightarrow> f a = wo_rel.suc r' (f`(rel.underS r a)) \<and> g a = True) \<and>
39.745 - (\<not>(test a) \<longrightarrow> g a = False)"
39.746 - using *[of a] test_def f_def g_def H_def by auto
39.747 - qed
39.748 - (* *)
39.749 - let ?phi = "\<lambda> a. a \<in> Field r \<and> False \<notin> g`(rel.under r a) \<longrightarrow>
39.750 - bij_betw f (rel.under r a) (rel.under r' (f a))"
39.751 - have Main2: "\<And> a. ?phi a"
39.752 - proof-
39.753 - fix a show "?phi a"
39.754 - proof(rule wo_rel.well_order_induct[of r ?phi],
39.755 - simp only: Well, clarify)
39.756 - fix a
39.757 - assume IH: "\<forall>b. b \<noteq> a \<and> (b,a) \<in> r \<longrightarrow> ?phi b" and
39.758 - *: "a \<in> Field r" and
39.759 - **: "False \<notin> g`(rel.under r a)"
39.760 - have 1: "\<forall>b \<in> rel.underS r a. bij_betw f (rel.under r b) (rel.under r' (f b))"
39.761 - proof(clarify)
39.762 - fix b assume ***: "b \<in> rel.underS r a"
39.763 - hence 0: "(b,a) \<in> r \<and> b \<noteq> a" unfolding rel.underS_def by auto
39.764 - moreover have "b \<in> Field r"
39.765 - using *** rel.underS_Field[of r a] by auto
39.766 - moreover have "False \<notin> g`(rel.under r b)"
39.767 - using 0 ** Trans rel.under_incr[of r b a] by auto
39.768 - ultimately show "bij_betw f (rel.under r b) (rel.under r' (f b))"
39.769 - using IH by auto
39.770 - qed
39.771 - (* *)
39.772 - have 21: "False \<notin> g`(rel.underS r a)"
39.773 - using ** rel.underS_subset_under[of r a] by auto
39.774 - have 22: "g`(rel.under r a) \<le> {True}" using ** by auto
39.775 - moreover have 23: "a \<in> rel.under r a"
39.776 - using Refl * by (auto simp add: rel.Refl_under_in)
39.777 - ultimately have 24: "g a = True" by blast
39.778 - have 2: "f`(rel.underS r a) \<noteq> Field r'"
39.779 - proof
39.780 - assume "f`(rel.underS r a) = Field r'"
39.781 - hence "g a = False" using Main1 test_def by blast
39.782 - with 24 show False using ** by blast
39.783 - qed
39.784 - (* *)
39.785 - have 3: "f a = wo_rel.suc r' (f`(rel.underS r a))"
39.786 - using 21 2 Main1 test_def by blast
39.787 - (* *)
39.788 - show "bij_betw f (rel.under r a) (rel.under r' (f a))"
39.789 - using WELL WELL' 1 2 3 *
39.790 - wellorders_totally_ordered_aux[of r r' a f] by auto
39.791 - qed
39.792 - qed
39.793 - (* *)
39.794 - let ?chi = "(\<lambda> a. a \<in> Field r \<and> False \<in> g`(rel.under r a))"
39.795 - show ?thesis
39.796 - proof(cases "\<exists>a. ?chi a")
39.797 - assume "\<not> (\<exists>a. ?chi a)"
39.798 - hence "\<forall>a \<in> Field r. bij_betw f (rel.under r a) (rel.under r' (f a))"
39.799 - using Main2 by blast
39.800 - thus ?thesis unfolding embed_def by blast
39.801 - next
39.802 - assume "\<exists>a. ?chi a"
39.803 - then obtain a where "?chi a" by blast
39.804 - hence "\<exists>f'. embed r' r f'"
39.805 - using wellorders_totally_ordered_aux2[of r r' g f a]
39.806 - WELL WELL' Main1 Main2 test_def by blast
39.807 - thus ?thesis by blast
39.808 - qed
39.809 -qed
39.810 -
39.811 -
39.812 -subsection {* Uniqueness of embeddings *}
39.813 -
39.814 -
39.815 -text{* Here we show a fact complementary to the one from the previous subsection -- namely,
39.816 -that between any two well-orders there is {\em at most} one embedding, and is the one
39.817 -definable by the expected well-order recursive equation. As a consequence, any two
39.818 -embeddings of opposite directions are mutually inverse. *}
39.819 -
39.820 -
39.821 -lemma embed_determined:
39.822 -assumes WELL: "Well_order r" and WELL': "Well_order r'" and
39.823 - EMB: "embed r r' f" and IN: "a \<in> Field r"
39.824 -shows "f a = wo_rel.suc r' (f`(rel.underS r a))"
39.825 -proof-
39.826 - have "bij_betw f (rel.underS r a) (rel.underS r' (f a))"
39.827 - using assms by (auto simp add: embed_underS)
39.828 - hence "f`(rel.underS r a) = rel.underS r' (f a)"
39.829 - by (auto simp add: bij_betw_def)
39.830 - moreover
39.831 - {have "f a \<in> Field r'" using IN
39.832 - using EMB WELL embed_Field[of r r' f] by auto
39.833 - hence "f a = wo_rel.suc r' (rel.underS r' (f a))"
39.834 - using WELL' by (auto simp add: wo_rel_def wo_rel.suc_underS)
39.835 - }
39.836 - ultimately show ?thesis by simp
39.837 -qed
39.838 -
39.839 -
39.840 -lemma embed_unique:
39.841 -assumes WELL: "Well_order r" and WELL': "Well_order r'" and
39.842 - EMBf: "embed r r' f" and EMBg: "embed r r' g"
39.843 -shows "a \<in> Field r \<longrightarrow> f a = g a"
39.844 -proof(rule wo_rel.well_order_induct[of r], auto simp add: WELL wo_rel_def)
39.845 - fix a
39.846 - assume IH: "\<forall>b. b \<noteq> a \<and> (b,a): r \<longrightarrow> b \<in> Field r \<longrightarrow> f b = g b" and
39.847 - *: "a \<in> Field r"
39.848 - hence "\<forall>b \<in> rel.underS r a. f b = g b"
39.849 - unfolding rel.underS_def by (auto simp add: Field_def)
39.850 - hence "f`(rel.underS r a) = g`(rel.underS r a)" by force
39.851 - thus "f a = g a"
39.852 - using assms * embed_determined[of r r' f a] embed_determined[of r r' g a] by auto
39.853 -qed
39.854 -
39.855 -
39.856 -lemma embed_bothWays_inverse:
39.857 -assumes WELL: "Well_order r" and WELL': "Well_order r'" and
39.858 - EMB: "embed r r' f" and EMB': "embed r' r f'"
39.859 -shows "(\<forall>a \<in> Field r. f'(f a) = a) \<and> (\<forall>a' \<in> Field r'. f(f' a') = a')"
39.860 -proof-
39.861 - have "embed r r (f' o f)" using assms
39.862 - by(auto simp add: comp_embed)
39.863 - moreover have "embed r r id" using assms
39.864 - by (auto simp add: id_embed)
39.865 - ultimately have "\<forall>a \<in> Field r. f'(f a) = a"
39.866 - using assms embed_unique[of r r "f' o f" id] id_def by auto
39.867 - moreover
39.868 - {have "embed r' r' (f o f')" using assms
39.869 - by(auto simp add: comp_embed)
39.870 - moreover have "embed r' r' id" using assms
39.871 - by (auto simp add: id_embed)
39.872 - ultimately have "\<forall>a' \<in> Field r'. f(f' a') = a'"
39.873 - using assms embed_unique[of r' r' "f o f'" id] id_def by auto
39.874 - }
39.875 - ultimately show ?thesis by blast
39.876 -qed
39.877 -
39.878 -
39.879 -lemma embed_bothWays_bij_betw:
39.880 -assumes WELL: "Well_order r" and WELL': "Well_order r'" and
39.881 - EMB: "embed r r' f" and EMB': "embed r' r g"
39.882 -shows "bij_betw f (Field r) (Field r')"
39.883 -proof-
39.884 - let ?A = "Field r" let ?A' = "Field r'"
39.885 - have "embed r r (g o f) \<and> embed r' r' (f o g)"
39.886 - using assms by (auto simp add: comp_embed)
39.887 - hence 1: "(\<forall>a \<in> ?A. g(f a) = a) \<and> (\<forall>a' \<in> ?A'. f(g a') = a')"
39.888 - using WELL id_embed[of r] embed_unique[of r r "g o f" id]
39.889 - WELL' id_embed[of r'] embed_unique[of r' r' "f o g" id]
39.890 - id_def by auto
39.891 - have 2: "(\<forall>a \<in> ?A. f a \<in> ?A') \<and> (\<forall>a' \<in> ?A'. g a' \<in> ?A)"
39.892 - using assms embed_Field[of r r' f] embed_Field[of r' r g] by blast
39.893 - (* *)
39.894 - show ?thesis
39.895 - proof(unfold bij_betw_def inj_on_def, auto simp add: 2)
39.896 - fix a b assume *: "a \<in> ?A" "b \<in> ?A" and **: "f a = f b"
39.897 - have "a = g(f a) \<and> b = g(f b)" using * 1 by auto
39.898 - with ** show "a = b" by auto
39.899 - next
39.900 - fix a' assume *: "a' \<in> ?A'"
39.901 - hence "g a' \<in> ?A \<and> f(g a') = a'" using 1 2 by auto
39.902 - thus "a' \<in> f ` ?A" by force
39.903 - qed
39.904 -qed
39.905 -
39.906 -
39.907 -lemma embed_bothWays_iso:
39.908 -assumes WELL: "Well_order r" and WELL': "Well_order r'" and
39.909 - EMB: "embed r r' f" and EMB': "embed r' r g"
39.910 -shows "iso r r' f"
39.911 -unfolding iso_def using assms by (auto simp add: embed_bothWays_bij_betw)
39.912 -
39.913 -
39.914 -subsection {* More properties of embeddings, strict embeddings and isomorphisms *}
39.915 -
39.916 -
39.917 -lemma embed_bothWays_Field_bij_betw:
39.918 -assumes WELL: "Well_order r" and WELL': "Well_order r'" and
39.919 - EMB: "embed r r' f" and EMB': "embed r' r f'"
39.920 -shows "bij_betw f (Field r) (Field r')"
39.921 -proof-
39.922 - have "(\<forall>a \<in> Field r. f'(f a) = a) \<and> (\<forall>a' \<in> Field r'. f(f' a') = a')"
39.923 - using assms by (auto simp add: embed_bothWays_inverse)
39.924 - moreover
39.925 - have "f`(Field r) \<le> Field r' \<and> f' ` (Field r') \<le> Field r"
39.926 - using assms by (auto simp add: embed_Field)
39.927 - ultimately
39.928 - show ?thesis using bij_betw_byWitness[of "Field r" f' f "Field r'"] by auto
39.929 -qed
39.930 -
39.931 -
39.932 -lemma embedS_comp_embed:
39.933 -assumes WELL: "Well_order r" and WELL': "Well_order r'" and WELL'': "Well_order r''"
39.934 - and EMB: "embedS r r' f" and EMB': "embed r' r'' f'"
39.935 -shows "embedS r r'' (f' o f)"
39.936 -proof-
39.937 - let ?g = "(f' o f)" let ?h = "inv_into (Field r) ?g"
39.938 - have 1: "embed r r' f \<and> \<not> (bij_betw f (Field r) (Field r'))"
39.939 - using EMB by (auto simp add: embedS_def)
39.940 - hence 2: "embed r r'' ?g"
39.941 - using WELL EMB' comp_embed[of r r' f r'' f'] by auto
39.942 - moreover
39.943 - {assume "bij_betw ?g (Field r) (Field r'')"
39.944 - hence "embed r'' r ?h" using 2 WELL
39.945 - by (auto simp add: inv_into_Field_embed_bij_betw)
39.946 - hence "embed r' r (?h o f')" using WELL' EMB'
39.947 - by (auto simp add: comp_embed)
39.948 - hence "bij_betw f (Field r) (Field r')" using WELL WELL' 1
39.949 - by (auto simp add: embed_bothWays_Field_bij_betw)
39.950 - with 1 have False by blast
39.951 - }
39.952 - ultimately show ?thesis unfolding embedS_def by auto
39.953 -qed
39.954 -
39.955 -
39.956 -lemma embed_comp_embedS:
39.957 -assumes WELL: "Well_order r" and WELL': "Well_order r'" and WELL'': "Well_order r''"
39.958 - and EMB: "embed r r' f" and EMB': "embedS r' r'' f'"
39.959 -shows "embedS r r'' (f' o f)"
39.960 -proof-
39.961 - let ?g = "(f' o f)" let ?h = "inv_into (Field r) ?g"
39.962 - have 1: "embed r' r'' f' \<and> \<not> (bij_betw f' (Field r') (Field r''))"
39.963 - using EMB' by (auto simp add: embedS_def)
39.964 - hence 2: "embed r r'' ?g"
39.965 - using WELL EMB comp_embed[of r r' f r'' f'] by auto
39.966 - moreover
39.967 - {assume "bij_betw ?g (Field r) (Field r'')"
39.968 - hence "embed r'' r ?h" using 2 WELL
39.969 - by (auto simp add: inv_into_Field_embed_bij_betw)
39.970 - hence "embed r'' r' (f o ?h)" using WELL'' EMB
39.971 - by (auto simp add: comp_embed)
39.972 - hence "bij_betw f' (Field r') (Field r'')" using WELL' WELL'' 1
39.973 - by (auto simp add: embed_bothWays_Field_bij_betw)
39.974 - with 1 have False by blast
39.975 - }
39.976 - ultimately show ?thesis unfolding embedS_def by auto
39.977 -qed
39.978 -
39.979 -
39.980 -lemma embed_comp_iso:
39.981 -assumes WELL: "Well_order r" and WELL': "Well_order r'" and WELL'': "Well_order r''"
39.982 - and EMB: "embed r r' f" and EMB': "iso r' r'' f'"
39.983 -shows "embed r r'' (f' o f)"
39.984 -using assms unfolding iso_def
39.985 -by (auto simp add: comp_embed)
39.986 -
39.987 -
39.988 -lemma iso_comp_embed:
39.989 -assumes WELL: "Well_order r" and WELL': "Well_order r'" and WELL'': "Well_order r''"
39.990 - and EMB: "iso r r' f" and EMB': "embed r' r'' f'"
39.991 -shows "embed r r'' (f' o f)"
39.992 -using assms unfolding iso_def
39.993 -by (auto simp add: comp_embed)
39.994 -
39.995 -
39.996 -lemma embedS_comp_iso:
39.997 -assumes WELL: "Well_order r" and WELL': "Well_order r'" and WELL'': "Well_order r''"
39.998 - and EMB: "embedS r r' f" and EMB': "iso r' r'' f'"
39.999 -shows "embedS r r'' (f' o f)"
39.1000 -using assms unfolding iso_def
39.1001 -by (auto simp add: embedS_comp_embed)
39.1002 -
39.1003 -
39.1004 -lemma iso_comp_embedS:
39.1005 -assumes WELL: "Well_order r" and WELL': "Well_order r'" and WELL'': "Well_order r''"
39.1006 - and EMB: "iso r r' f" and EMB': "embedS r' r'' f'"
39.1007 -shows "embedS r r'' (f' o f)"
39.1008 -using assms unfolding iso_def using embed_comp_embedS
39.1009 -by (auto simp add: embed_comp_embedS)
39.1010 -
39.1011 -
39.1012 -lemma embedS_Field:
39.1013 -assumes WELL: "Well_order r" and EMB: "embedS r r' f"
39.1014 -shows "f ` (Field r) < Field r'"
39.1015 -proof-
39.1016 - have "f`(Field r) \<le> Field r'" using assms
39.1017 - by (auto simp add: embed_Field embedS_def)
39.1018 - moreover
39.1019 - {have "inj_on f (Field r)" using assms
39.1020 - by (auto simp add: embedS_def embed_inj_on)
39.1021 - hence "f`(Field r) \<noteq> Field r'" using EMB
39.1022 - by (auto simp add: embedS_def bij_betw_def)
39.1023 - }
39.1024 - ultimately show ?thesis by blast
39.1025 -qed
39.1026 -
39.1027 -
39.1028 -lemma embedS_iff:
39.1029 -assumes WELL: "Well_order r" and ISO: "embed r r' f"
39.1030 -shows "embedS r r' f = (f ` (Field r) < Field r')"
39.1031 -proof
39.1032 - assume "embedS r r' f"
39.1033 - thus "f ` Field r \<subset> Field r'"
39.1034 - using WELL by (auto simp add: embedS_Field)
39.1035 -next
39.1036 - assume "f ` Field r \<subset> Field r'"
39.1037 - hence "\<not> bij_betw f (Field r) (Field r')"
39.1038 - unfolding bij_betw_def by blast
39.1039 - thus "embedS r r' f" unfolding embedS_def
39.1040 - using ISO by auto
39.1041 -qed
39.1042 -
39.1043 -
39.1044 -lemma iso_Field:
39.1045 -"iso r r' f \<Longrightarrow> f ` (Field r) = Field r'"
39.1046 -using assms by (auto simp add: iso_def bij_betw_def)
39.1047 -
39.1048 -
39.1049 -lemma iso_iff:
39.1050 -assumes "Well_order r"
39.1051 -shows "iso r r' f = (embed r r' f \<and> f ` (Field r) = Field r')"
39.1052 -proof
39.1053 - assume "iso r r' f"
39.1054 - thus "embed r r' f \<and> f ` (Field r) = Field r'"
39.1055 - by (auto simp add: iso_Field iso_def)
39.1056 -next
39.1057 - assume *: "embed r r' f \<and> f ` Field r = Field r'"
39.1058 - hence "inj_on f (Field r)" using assms by (auto simp add: embed_inj_on)
39.1059 - with * have "bij_betw f (Field r) (Field r')"
39.1060 - unfolding bij_betw_def by simp
39.1061 - with * show "iso r r' f" unfolding iso_def by auto
39.1062 -qed
39.1063 -
39.1064 -
39.1065 -lemma iso_iff2:
39.1066 -assumes "Well_order r"
39.1067 -shows "iso r r' f = (bij_betw f (Field r) (Field r') \<and>
39.1068 - (\<forall>a \<in> Field r. \<forall>b \<in> Field r.
39.1069 - (((a,b) \<in> r) = ((f a, f b) \<in> r'))))"
39.1070 -using assms
39.1071 -proof(auto simp add: iso_def)
39.1072 - fix a b
39.1073 - assume "embed r r' f"
39.1074 - hence "compat r r' f" using embed_compat[of r] by auto
39.1075 - moreover assume "(a,b) \<in> r"
39.1076 - ultimately show "(f a, f b) \<in> r'" using compat_def[of r] by auto
39.1077 -next
39.1078 - let ?f' = "inv_into (Field r) f"
39.1079 - assume "embed r r' f" and 1: "bij_betw f (Field r) (Field r')"
39.1080 - hence "embed r' r ?f'" using assms
39.1081 - by (auto simp add: inv_into_Field_embed_bij_betw)
39.1082 - hence 2: "compat r' r ?f'" using embed_compat[of r'] by auto
39.1083 - fix a b assume *: "a \<in> Field r" "b \<in> Field r" and **: "(f a,f b) \<in> r'"
39.1084 - hence "?f'(f a) = a \<and> ?f'(f b) = b" using 1
39.1085 - by (auto simp add: bij_betw_inv_into_left)
39.1086 - thus "(a,b) \<in> r" using ** 2 compat_def[of r' r ?f'] by fastforce
39.1087 -next
39.1088 - assume *: "bij_betw f (Field r) (Field r')" and
39.1089 - **: "\<forall>a\<in>Field r. \<forall>b\<in>Field r. ((a, b) \<in> r) = ((f a, f b) \<in> r')"
39.1090 - have 1: "\<And> a. rel.under r a \<le> Field r \<and> rel.under r' (f a) \<le> Field r'"
39.1091 - by (auto simp add: rel.under_Field)
39.1092 - have 2: "inj_on f (Field r)" using * by (auto simp add: bij_betw_def)
39.1093 - {fix a assume ***: "a \<in> Field r"
39.1094 - have "bij_betw f (rel.under r a) (rel.under r' (f a))"
39.1095 - proof(unfold bij_betw_def, auto)
39.1096 - show "inj_on f (rel.under r a)"
39.1097 - using 1 2 by (auto simp add: subset_inj_on)
39.1098 - next
39.1099 - fix b assume "b \<in> rel.under r a"
39.1100 - hence "a \<in> Field r \<and> b \<in> Field r \<and> (b,a) \<in> r"
39.1101 - unfolding rel.under_def by (auto simp add: Field_def Range_def Domain_def)
39.1102 - with 1 ** show "f b \<in> rel.under r' (f a)"
39.1103 - unfolding rel.under_def by auto
39.1104 - next
39.1105 - fix b' assume "b' \<in> rel.under r' (f a)"
39.1106 - hence 3: "(b',f a) \<in> r'" unfolding rel.under_def by simp
39.1107 - hence "b' \<in> Field r'" unfolding Field_def by auto
39.1108 - with * obtain b where "b \<in> Field r \<and> f b = b'"
39.1109 - unfolding bij_betw_def by force
39.1110 - with 3 ** ***
39.1111 - show "b' \<in> f ` (rel.under r a)" unfolding rel.under_def by blast
39.1112 - qed
39.1113 - }
39.1114 - thus "embed r r' f" unfolding embed_def using * by auto
39.1115 -qed
39.1116 -
39.1117 -
39.1118 -lemma iso_iff3:
39.1119 -assumes WELL: "Well_order r" and WELL': "Well_order r'"
39.1120 -shows "iso r r' f = (bij_betw f (Field r) (Field r') \<and> compat r r' f)"
39.1121 -proof
39.1122 - assume "iso r r' f"
39.1123 - thus "bij_betw f (Field r) (Field r') \<and> compat r r' f"
39.1124 - unfolding compat_def using WELL by (auto simp add: iso_iff2 Field_def)
39.1125 -next
39.1126 - have Well: "wo_rel r \<and> wo_rel r'" using WELL WELL'
39.1127 - by (auto simp add: wo_rel_def)
39.1128 - assume *: "bij_betw f (Field r) (Field r') \<and> compat r r' f"
39.1129 - thus "iso r r' f"
39.1130 - unfolding "compat_def" using assms
39.1131 - proof(auto simp add: iso_iff2)
39.1132 - fix a b assume **: "a \<in> Field r" "b \<in> Field r" and
39.1133 - ***: "(f a, f b) \<in> r'"
39.1134 - {assume "(b,a) \<in> r \<or> b = a"
39.1135 - hence "(b,a): r"using Well ** wo_rel.REFL[of r] refl_on_def[of _ r] by blast
39.1136 - hence "(f b, f a) \<in> r'" using * unfolding compat_def by auto
39.1137 - hence "f a = f b"
39.1138 - using Well *** wo_rel.ANTISYM[of r'] antisym_def[of r'] by blast
39.1139 - hence "a = b" using * ** unfolding bij_betw_def inj_on_def by auto
39.1140 - hence "(a,b) \<in> r" using Well ** wo_rel.REFL[of r] refl_on_def[of _ r] by blast
39.1141 - }
39.1142 - thus "(a,b) \<in> r"
39.1143 - using Well ** wo_rel.TOTAL[of r] total_on_def[of _ r] by blast
39.1144 - qed
39.1145 -qed
39.1146 -
39.1147 -
39.1148 -
39.1149 -end
40.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
40.2 +++ b/src/HOL/Cardinals/Wellorder_Embedding_FP.thy Tue Nov 19 17:07:52 2013 +0100
40.3 @@ -0,0 +1,1145 @@
40.4 +(* Title: HOL/Cardinals/Wellorder_Embedding_FP.thy
40.5 + Author: Andrei Popescu, TU Muenchen
40.6 + Copyright 2012
40.7 +
40.8 +Well-order embeddings (FP).
40.9 +*)
40.10 +
40.11 +header {* Well-Order Embeddings (FP) *}
40.12 +
40.13 +theory Wellorder_Embedding_FP
40.14 +imports "~~/src/HOL/Library/Zorn" Fun_More_FP Wellorder_Relation_FP
40.15 +begin
40.16 +
40.17 +
40.18 +text{* In this section, we introduce well-order {\em embeddings} and {\em isomorphisms} and
40.19 +prove their basic properties. The notion of embedding is considered from the point
40.20 +of view of the theory of ordinals, and therefore requires the source to be injected
40.21 +as an {\em initial segment} (i.e., {\em order filter}) of the target. A main result
40.22 +of this section is the existence of embeddings (in one direction or another) between
40.23 +any two well-orders, having as a consequence the fact that, given any two sets on
40.24 +any two types, one is smaller than (i.e., can be injected into) the other. *}
40.25 +
40.26 +
40.27 +subsection {* Auxiliaries *}
40.28 +
40.29 +lemma UNION_inj_on_ofilter:
40.30 +assumes WELL: "Well_order r" and
40.31 + OF: "\<And> i. i \<in> I \<Longrightarrow> wo_rel.ofilter r (A i)" and
40.32 + INJ: "\<And> i. i \<in> I \<Longrightarrow> inj_on f (A i)"
40.33 +shows "inj_on f (\<Union> i \<in> I. A i)"
40.34 +proof-
40.35 + have "wo_rel r" using WELL by (simp add: wo_rel_def)
40.36 + hence "\<And> i j. \<lbrakk>i \<in> I; j \<in> I\<rbrakk> \<Longrightarrow> A i <= A j \<or> A j <= A i"
40.37 + using wo_rel.ofilter_linord[of r] OF by blast
40.38 + with WELL INJ show ?thesis
40.39 + by (auto simp add: inj_on_UNION_chain)
40.40 +qed
40.41 +
40.42 +
40.43 +lemma under_underS_bij_betw:
40.44 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and
40.45 + IN: "a \<in> Field r" and IN': "f a \<in> Field r'" and
40.46 + BIJ: "bij_betw f (rel.underS r a) (rel.underS r' (f a))"
40.47 +shows "bij_betw f (rel.under r a) (rel.under r' (f a))"
40.48 +proof-
40.49 + have "a \<notin> rel.underS r a \<and> f a \<notin> rel.underS r' (f a)"
40.50 + unfolding rel.underS_def by auto
40.51 + moreover
40.52 + {have "Refl r \<and> Refl r'" using WELL WELL'
40.53 + by (auto simp add: order_on_defs)
40.54 + hence "rel.under r a = rel.underS r a \<union> {a} \<and>
40.55 + rel.under r' (f a) = rel.underS r' (f a) \<union> {f a}"
40.56 + using IN IN' by(auto simp add: rel.Refl_under_underS)
40.57 + }
40.58 + ultimately show ?thesis
40.59 + using BIJ notIn_Un_bij_betw[of a "rel.underS r a" f "rel.underS r' (f a)"] by auto
40.60 +qed
40.61 +
40.62 +
40.63 +
40.64 +subsection {* (Well-order) embeddings, strict embeddings, isomorphisms and order-compatible
40.65 +functions *}
40.66 +
40.67 +
40.68 +text{* Standardly, a function is an embedding of a well-order in another if it injectively and
40.69 +order-compatibly maps the former into an order filter of the latter.
40.70 +Here we opt for a more succinct definition (operator @{text "embed"}),
40.71 +asking that, for any element in the source, the function should be a bijection
40.72 +between the set of strict lower bounds of that element
40.73 +and the set of strict lower bounds of its image. (Later we prove equivalence with
40.74 +the standard definition -- lemma @{text "embed_iff_compat_inj_on_ofilter"}.)
40.75 +A {\em strict embedding} (operator @{text "embedS"}) is a non-bijective embedding
40.76 +and an isomorphism (operator @{text "iso"}) is a bijective embedding. *}
40.77 +
40.78 +
40.79 +definition embed :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> ('a \<Rightarrow> 'a') \<Rightarrow> bool"
40.80 +where
40.81 +"embed r r' f \<equiv> \<forall>a \<in> Field r. bij_betw f (rel.under r a) (rel.under r' (f a))"
40.82 +
40.83 +
40.84 +lemmas embed_defs = embed_def embed_def[abs_def]
40.85 +
40.86 +
40.87 +text {* Strict embeddings: *}
40.88 +
40.89 +definition embedS :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> ('a \<Rightarrow> 'a') \<Rightarrow> bool"
40.90 +where
40.91 +"embedS r r' f \<equiv> embed r r' f \<and> \<not> bij_betw f (Field r) (Field r')"
40.92 +
40.93 +
40.94 +lemmas embedS_defs = embedS_def embedS_def[abs_def]
40.95 +
40.96 +
40.97 +definition iso :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> ('a \<Rightarrow> 'a') \<Rightarrow> bool"
40.98 +where
40.99 +"iso r r' f \<equiv> embed r r' f \<and> bij_betw f (Field r) (Field r')"
40.100 +
40.101 +
40.102 +lemmas iso_defs = iso_def iso_def[abs_def]
40.103 +
40.104 +
40.105 +definition compat :: "'a rel \<Rightarrow> 'a' rel \<Rightarrow> ('a \<Rightarrow> 'a') \<Rightarrow> bool"
40.106 +where
40.107 +"compat r r' f \<equiv> \<forall>a b. (a,b) \<in> r \<longrightarrow> (f a, f b) \<in> r'"
40.108 +
40.109 +
40.110 +lemma compat_wf:
40.111 +assumes CMP: "compat r r' f" and WF: "wf r'"
40.112 +shows "wf r"
40.113 +proof-
40.114 + have "r \<le> inv_image r' f"
40.115 + unfolding inv_image_def using CMP
40.116 + by (auto simp add: compat_def)
40.117 + with WF show ?thesis
40.118 + using wf_inv_image[of r' f] wf_subset[of "inv_image r' f"] by auto
40.119 +qed
40.120 +
40.121 +
40.122 +lemma id_embed: "embed r r id"
40.123 +by(auto simp add: id_def embed_def bij_betw_def)
40.124 +
40.125 +
40.126 +lemma id_iso: "iso r r id"
40.127 +by(auto simp add: id_def embed_def iso_def bij_betw_def)
40.128 +
40.129 +
40.130 +lemma embed_in_Field:
40.131 +assumes WELL: "Well_order r" and
40.132 + EMB: "embed r r' f" and IN: "a \<in> Field r"
40.133 +shows "f a \<in> Field r'"
40.134 +proof-
40.135 + have Well: "wo_rel r"
40.136 + using WELL by (auto simp add: wo_rel_def)
40.137 + hence 1: "Refl r"
40.138 + by (auto simp add: wo_rel.REFL)
40.139 + hence "a \<in> rel.under r a" using IN rel.Refl_under_in by fastforce
40.140 + hence "f a \<in> rel.under r' (f a)"
40.141 + using EMB IN by (auto simp add: embed_def bij_betw_def)
40.142 + thus ?thesis unfolding Field_def
40.143 + by (auto simp: rel.under_def)
40.144 +qed
40.145 +
40.146 +
40.147 +lemma comp_embed:
40.148 +assumes WELL: "Well_order r" and
40.149 + EMB: "embed r r' f" and EMB': "embed r' r'' f'"
40.150 +shows "embed r r'' (f' o f)"
40.151 +proof(unfold embed_def, auto)
40.152 + fix a assume *: "a \<in> Field r"
40.153 + hence "bij_betw f (rel.under r a) (rel.under r' (f a))"
40.154 + using embed_def[of r] EMB by auto
40.155 + moreover
40.156 + {have "f a \<in> Field r'"
40.157 + using EMB WELL * by (auto simp add: embed_in_Field)
40.158 + hence "bij_betw f' (rel.under r' (f a)) (rel.under r'' (f' (f a)))"
40.159 + using embed_def[of r'] EMB' by auto
40.160 + }
40.161 + ultimately
40.162 + show "bij_betw (f' \<circ> f) (rel.under r a) (rel.under r'' (f'(f a)))"
40.163 + by(auto simp add: bij_betw_trans)
40.164 +qed
40.165 +
40.166 +
40.167 +lemma comp_iso:
40.168 +assumes WELL: "Well_order r" and
40.169 + EMB: "iso r r' f" and EMB': "iso r' r'' f'"
40.170 +shows "iso r r'' (f' o f)"
40.171 +using assms unfolding iso_def
40.172 +by (auto simp add: comp_embed bij_betw_trans)
40.173 +
40.174 +
40.175 +text{* That @{text "embedS"} is also preserved by function composition shall be proved only later. *}
40.176 +
40.177 +
40.178 +lemma embed_Field:
40.179 +"\<lbrakk>Well_order r; embed r r' f\<rbrakk> \<Longrightarrow> f`(Field r) \<le> Field r'"
40.180 +by (auto simp add: embed_in_Field)
40.181 +
40.182 +
40.183 +lemma embed_preserves_ofilter:
40.184 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and
40.185 + EMB: "embed r r' f" and OF: "wo_rel.ofilter r A"
40.186 +shows "wo_rel.ofilter r' (f`A)"
40.187 +proof-
40.188 + (* Preliminary facts *)
40.189 + from WELL have Well: "wo_rel r" unfolding wo_rel_def .
40.190 + from WELL' have Well': "wo_rel r'" unfolding wo_rel_def .
40.191 + from OF have 0: "A \<le> Field r" by(auto simp add: Well wo_rel.ofilter_def)
40.192 + (* Main proof *)
40.193 + show ?thesis using Well' WELL EMB 0 embed_Field[of r r' f]
40.194 + proof(unfold wo_rel.ofilter_def, auto simp add: image_def)
40.195 + fix a b'
40.196 + assume *: "a \<in> A" and **: "b' \<in> rel.under r' (f a)"
40.197 + hence "a \<in> Field r" using 0 by auto
40.198 + hence "bij_betw f (rel.under r a) (rel.under r' (f a))"
40.199 + using * EMB by (auto simp add: embed_def)
40.200 + hence "f`(rel.under r a) = rel.under r' (f a)"
40.201 + by (simp add: bij_betw_def)
40.202 + with ** image_def[of f "rel.under r a"] obtain b where
40.203 + 1: "b \<in> rel.under r a \<and> b' = f b" by blast
40.204 + hence "b \<in> A" using Well * OF
40.205 + by (auto simp add: wo_rel.ofilter_def)
40.206 + with 1 show "\<exists>b \<in> A. b' = f b" by blast
40.207 + qed
40.208 +qed
40.209 +
40.210 +
40.211 +lemma embed_Field_ofilter:
40.212 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and
40.213 + EMB: "embed r r' f"
40.214 +shows "wo_rel.ofilter r' (f`(Field r))"
40.215 +proof-
40.216 + have "wo_rel.ofilter r (Field r)"
40.217 + using WELL by (auto simp add: wo_rel_def wo_rel.Field_ofilter)
40.218 + with WELL WELL' EMB
40.219 + show ?thesis by (auto simp add: embed_preserves_ofilter)
40.220 +qed
40.221 +
40.222 +
40.223 +lemma embed_compat:
40.224 +assumes EMB: "embed r r' f"
40.225 +shows "compat r r' f"
40.226 +proof(unfold compat_def, clarify)
40.227 + fix a b
40.228 + assume *: "(a,b) \<in> r"
40.229 + hence 1: "b \<in> Field r" using Field_def[of r] by blast
40.230 + have "a \<in> rel.under r b"
40.231 + using * rel.under_def[of r] by simp
40.232 + hence "f a \<in> rel.under r' (f b)"
40.233 + using EMB embed_def[of r r' f]
40.234 + bij_betw_def[of f "rel.under r b" "rel.under r' (f b)"]
40.235 + image_def[of f "rel.under r b"] 1 by auto
40.236 + thus "(f a, f b) \<in> r'"
40.237 + by (auto simp add: rel.under_def)
40.238 +qed
40.239 +
40.240 +
40.241 +lemma embed_inj_on:
40.242 +assumes WELL: "Well_order r" and EMB: "embed r r' f"
40.243 +shows "inj_on f (Field r)"
40.244 +proof(unfold inj_on_def, clarify)
40.245 + (* Preliminary facts *)
40.246 + from WELL have Well: "wo_rel r" unfolding wo_rel_def .
40.247 + with wo_rel.TOTAL[of r]
40.248 + have Total: "Total r" by simp
40.249 + from Well wo_rel.REFL[of r]
40.250 + have Refl: "Refl r" by simp
40.251 + (* Main proof *)
40.252 + fix a b
40.253 + assume *: "a \<in> Field r" and **: "b \<in> Field r" and
40.254 + ***: "f a = f b"
40.255 + hence 1: "a \<in> Field r \<and> b \<in> Field r"
40.256 + unfolding Field_def by auto
40.257 + {assume "(a,b) \<in> r"
40.258 + hence "a \<in> rel.under r b \<and> b \<in> rel.under r b"
40.259 + using Refl by(auto simp add: rel.under_def refl_on_def)
40.260 + hence "a = b"
40.261 + using EMB 1 ***
40.262 + by (auto simp add: embed_def bij_betw_def inj_on_def)
40.263 + }
40.264 + moreover
40.265 + {assume "(b,a) \<in> r"
40.266 + hence "a \<in> rel.under r a \<and> b \<in> rel.under r a"
40.267 + using Refl by(auto simp add: rel.under_def refl_on_def)
40.268 + hence "a = b"
40.269 + using EMB 1 ***
40.270 + by (auto simp add: embed_def bij_betw_def inj_on_def)
40.271 + }
40.272 + ultimately
40.273 + show "a = b" using Total 1
40.274 + by (auto simp add: total_on_def)
40.275 +qed
40.276 +
40.277 +
40.278 +lemma embed_underS:
40.279 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and
40.280 + EMB: "embed r r' f" and IN: "a \<in> Field r"
40.281 +shows "bij_betw f (rel.underS r a) (rel.underS r' (f a))"
40.282 +proof-
40.283 + have "bij_betw f (rel.under r a) (rel.under r' (f a))"
40.284 + using assms by (auto simp add: embed_def)
40.285 + moreover
40.286 + {have "f a \<in> Field r'" using assms embed_Field[of r r' f] by auto
40.287 + hence "rel.under r a = rel.underS r a \<union> {a} \<and>
40.288 + rel.under r' (f a) = rel.underS r' (f a) \<union> {f a}"
40.289 + using assms by (auto simp add: order_on_defs rel.Refl_under_underS)
40.290 + }
40.291 + moreover
40.292 + {have "a \<notin> rel.underS r a \<and> f a \<notin> rel.underS r' (f a)"
40.293 + unfolding rel.underS_def by blast
40.294 + }
40.295 + ultimately show ?thesis
40.296 + by (auto simp add: notIn_Un_bij_betw3)
40.297 +qed
40.298 +
40.299 +
40.300 +lemma embed_iff_compat_inj_on_ofilter:
40.301 +assumes WELL: "Well_order r" and WELL': "Well_order r'"
40.302 +shows "embed r r' f = (compat r r' f \<and> inj_on f (Field r) \<and> wo_rel.ofilter r' (f`(Field r)))"
40.303 +using assms
40.304 +proof(auto simp add: embed_compat embed_inj_on embed_Field_ofilter,
40.305 + unfold embed_def, auto) (* get rid of one implication *)
40.306 + fix a
40.307 + assume *: "inj_on f (Field r)" and
40.308 + **: "compat r r' f" and
40.309 + ***: "wo_rel.ofilter r' (f`(Field r))" and
40.310 + ****: "a \<in> Field r"
40.311 + (* Preliminary facts *)
40.312 + have Well: "wo_rel r"
40.313 + using WELL wo_rel_def[of r] by simp
40.314 + hence Refl: "Refl r"
40.315 + using wo_rel.REFL[of r] by simp
40.316 + have Total: "Total r"
40.317 + using Well wo_rel.TOTAL[of r] by simp
40.318 + have Well': "wo_rel r'"
40.319 + using WELL' wo_rel_def[of r'] by simp
40.320 + hence Antisym': "antisym r'"
40.321 + using wo_rel.ANTISYM[of r'] by simp
40.322 + have "(a,a) \<in> r"
40.323 + using **** Well wo_rel.REFL[of r]
40.324 + refl_on_def[of _ r] by auto
40.325 + hence "(f a, f a) \<in> r'"
40.326 + using ** by(auto simp add: compat_def)
40.327 + hence 0: "f a \<in> Field r'"
40.328 + unfolding Field_def by auto
40.329 + have "f a \<in> f`(Field r)"
40.330 + using **** by auto
40.331 + hence 2: "rel.under r' (f a) \<le> f`(Field r)"
40.332 + using Well' *** wo_rel.ofilter_def[of r' "f`(Field r)"] by fastforce
40.333 + (* Main proof *)
40.334 + show "bij_betw f (rel.under r a) (rel.under r' (f a))"
40.335 + proof(unfold bij_betw_def, auto)
40.336 + show "inj_on f (rel.under r a)"
40.337 + using * by (metis (no_types) rel.under_Field subset_inj_on)
40.338 + next
40.339 + fix b assume "b \<in> rel.under r a"
40.340 + thus "f b \<in> rel.under r' (f a)"
40.341 + unfolding rel.under_def using **
40.342 + by (auto simp add: compat_def)
40.343 + next
40.344 + fix b' assume *****: "b' \<in> rel.under r' (f a)"
40.345 + hence "b' \<in> f`(Field r)"
40.346 + using 2 by auto
40.347 + with Field_def[of r] obtain b where
40.348 + 3: "b \<in> Field r" and 4: "b' = f b" by auto
40.349 + have "(b,a): r"
40.350 + proof-
40.351 + {assume "(a,b) \<in> r"
40.352 + with ** 4 have "(f a, b'): r'"
40.353 + by (auto simp add: compat_def)
40.354 + with ***** Antisym' have "f a = b'"
40.355 + by(auto simp add: rel.under_def antisym_def)
40.356 + with 3 **** 4 * have "a = b"
40.357 + by(auto simp add: inj_on_def)
40.358 + }
40.359 + moreover
40.360 + {assume "a = b"
40.361 + hence "(b,a) \<in> r" using Refl **** 3
40.362 + by (auto simp add: refl_on_def)
40.363 + }
40.364 + ultimately
40.365 + show ?thesis using Total **** 3 by (fastforce simp add: total_on_def)
40.366 + qed
40.367 + with 4 show "b' \<in> f`(rel.under r a)"
40.368 + unfolding rel.under_def by auto
40.369 + qed
40.370 +qed
40.371 +
40.372 +
40.373 +lemma inv_into_ofilter_embed:
40.374 +assumes WELL: "Well_order r" and OF: "wo_rel.ofilter r A" and
40.375 + BIJ: "\<forall>b \<in> A. bij_betw f (rel.under r b) (rel.under r' (f b))" and
40.376 + IMAGE: "f ` A = Field r'"
40.377 +shows "embed r' r (inv_into A f)"
40.378 +proof-
40.379 + (* Preliminary facts *)
40.380 + have Well: "wo_rel r"
40.381 + using WELL wo_rel_def[of r] by simp
40.382 + have Refl: "Refl r"
40.383 + using Well wo_rel.REFL[of r] by simp
40.384 + have Total: "Total r"
40.385 + using Well wo_rel.TOTAL[of r] by simp
40.386 + (* Main proof *)
40.387 + have 1: "bij_betw f A (Field r')"
40.388 + proof(unfold bij_betw_def inj_on_def, auto simp add: IMAGE)
40.389 + fix b1 b2
40.390 + assume *: "b1 \<in> A" and **: "b2 \<in> A" and
40.391 + ***: "f b1 = f b2"
40.392 + have 11: "b1 \<in> Field r \<and> b2 \<in> Field r"
40.393 + using * ** Well OF by (auto simp add: wo_rel.ofilter_def)
40.394 + moreover
40.395 + {assume "(b1,b2) \<in> r"
40.396 + hence "b1 \<in> rel.under r b2 \<and> b2 \<in> rel.under r b2"
40.397 + unfolding rel.under_def using 11 Refl
40.398 + by (auto simp add: refl_on_def)
40.399 + hence "b1 = b2" using BIJ * ** ***
40.400 + by (simp add: bij_betw_def inj_on_def)
40.401 + }
40.402 + moreover
40.403 + {assume "(b2,b1) \<in> r"
40.404 + hence "b1 \<in> rel.under r b1 \<and> b2 \<in> rel.under r b1"
40.405 + unfolding rel.under_def using 11 Refl
40.406 + by (auto simp add: refl_on_def)
40.407 + hence "b1 = b2" using BIJ * ** ***
40.408 + by (simp add: bij_betw_def inj_on_def)
40.409 + }
40.410 + ultimately
40.411 + show "b1 = b2"
40.412 + using Total by (auto simp add: total_on_def)
40.413 + qed
40.414 + (* *)
40.415 + let ?f' = "(inv_into A f)"
40.416 + (* *)
40.417 + have 2: "\<forall>b \<in> A. bij_betw ?f' (rel.under r' (f b)) (rel.under r b)"
40.418 + proof(clarify)
40.419 + fix b assume *: "b \<in> A"
40.420 + hence "rel.under r b \<le> A"
40.421 + using Well OF by(auto simp add: wo_rel.ofilter_def)
40.422 + moreover
40.423 + have "f ` (rel.under r b) = rel.under r' (f b)"
40.424 + using * BIJ by (auto simp add: bij_betw_def)
40.425 + ultimately
40.426 + show "bij_betw ?f' (rel.under r' (f b)) (rel.under r b)"
40.427 + using 1 by (auto simp add: bij_betw_inv_into_subset)
40.428 + qed
40.429 + (* *)
40.430 + have 3: "\<forall>b' \<in> Field r'. bij_betw ?f' (rel.under r' b') (rel.under r (?f' b'))"
40.431 + proof(clarify)
40.432 + fix b' assume *: "b' \<in> Field r'"
40.433 + have "b' = f (?f' b')" using * 1
40.434 + by (auto simp add: bij_betw_inv_into_right)
40.435 + moreover
40.436 + {obtain b where 31: "b \<in> A" and "f b = b'" using IMAGE * by force
40.437 + hence "?f' b' = b" using 1 by (auto simp add: bij_betw_inv_into_left)
40.438 + with 31 have "?f' b' \<in> A" by auto
40.439 + }
40.440 + ultimately
40.441 + show "bij_betw ?f' (rel.under r' b') (rel.under r (?f' b'))"
40.442 + using 2 by auto
40.443 + qed
40.444 + (* *)
40.445 + thus ?thesis unfolding embed_def .
40.446 +qed
40.447 +
40.448 +
40.449 +lemma inv_into_underS_embed:
40.450 +assumes WELL: "Well_order r" and
40.451 + BIJ: "\<forall>b \<in> rel.underS r a. bij_betw f (rel.under r b) (rel.under r' (f b))" and
40.452 + IN: "a \<in> Field r" and
40.453 + IMAGE: "f ` (rel.underS r a) = Field r'"
40.454 +shows "embed r' r (inv_into (rel.underS r a) f)"
40.455 +using assms
40.456 +by(auto simp add: wo_rel_def wo_rel.underS_ofilter inv_into_ofilter_embed)
40.457 +
40.458 +
40.459 +lemma inv_into_Field_embed:
40.460 +assumes WELL: "Well_order r" and EMB: "embed r r' f" and
40.461 + IMAGE: "Field r' \<le> f ` (Field r)"
40.462 +shows "embed r' r (inv_into (Field r) f)"
40.463 +proof-
40.464 + have "(\<forall>b \<in> Field r. bij_betw f (rel.under r b) (rel.under r' (f b)))"
40.465 + using EMB by (auto simp add: embed_def)
40.466 + moreover
40.467 + have "f ` (Field r) \<le> Field r'"
40.468 + using EMB WELL by (auto simp add: embed_Field)
40.469 + ultimately
40.470 + show ?thesis using assms
40.471 + by(auto simp add: wo_rel_def wo_rel.Field_ofilter inv_into_ofilter_embed)
40.472 +qed
40.473 +
40.474 +
40.475 +lemma inv_into_Field_embed_bij_betw:
40.476 +assumes WELL: "Well_order r" and
40.477 + EMB: "embed r r' f" and BIJ: "bij_betw f (Field r) (Field r')"
40.478 +shows "embed r' r (inv_into (Field r) f)"
40.479 +proof-
40.480 + have "Field r' \<le> f ` (Field r)"
40.481 + using BIJ by (auto simp add: bij_betw_def)
40.482 + thus ?thesis using assms
40.483 + by(auto simp add: inv_into_Field_embed)
40.484 +qed
40.485 +
40.486 +
40.487 +
40.488 +
40.489 +
40.490 +subsection {* Given any two well-orders, one can be embedded in the other *}
40.491 +
40.492 +
40.493 +text{* Here is an overview of the proof of of this fact, stated in theorem
40.494 +@{text "wellorders_totally_ordered"}:
40.495 +
40.496 + Fix the well-orders @{text "r::'a rel"} and @{text "r'::'a' rel"}.
40.497 + Attempt to define an embedding @{text "f::'a \<Rightarrow> 'a'"} from @{text "r"} to @{text "r'"} in the
40.498 + natural way by well-order recursion ("hoping" that @{text "Field r"} turns out to be smaller
40.499 + than @{text "Field r'"}), but also record, at the recursive step, in a function
40.500 + @{text "g::'a \<Rightarrow> bool"}, the extra information of whether @{text "Field r'"}
40.501 + gets exhausted or not.
40.502 +
40.503 + If @{text "Field r'"} does not get exhausted, then @{text "Field r"} is indeed smaller
40.504 + and @{text "f"} is the desired embedding from @{text "r"} to @{text "r'"}
40.505 + (lemma @{text "wellorders_totally_ordered_aux"}).
40.506 +
40.507 + Otherwise, it means that @{text "Field r'"} is the smaller one, and the inverse of
40.508 + (the "good" segment of) @{text "f"} is the desired embedding from @{text "r'"} to @{text "r"}
40.509 + (lemma @{text "wellorders_totally_ordered_aux2"}).
40.510 +*}
40.511 +
40.512 +
40.513 +lemma wellorders_totally_ordered_aux:
40.514 +fixes r ::"'a rel" and r'::"'a' rel" and
40.515 + f :: "'a \<Rightarrow> 'a'" and a::'a
40.516 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and IN: "a \<in> Field r" and
40.517 + IH: "\<forall>b \<in> rel.underS r a. bij_betw f (rel.under r b) (rel.under r' (f b))" and
40.518 + NOT: "f ` (rel.underS r a) \<noteq> Field r'" and SUC: "f a = wo_rel.suc r' (f`(rel.underS r a))"
40.519 +shows "bij_betw f (rel.under r a) (rel.under r' (f a))"
40.520 +proof-
40.521 + (* Preliminary facts *)
40.522 + have Well: "wo_rel r" using WELL unfolding wo_rel_def .
40.523 + hence Refl: "Refl r" using wo_rel.REFL[of r] by auto
40.524 + have Trans: "trans r" using Well wo_rel.TRANS[of r] by auto
40.525 + have Well': "wo_rel r'" using WELL' unfolding wo_rel_def .
40.526 + have OF: "wo_rel.ofilter r (rel.underS r a)"
40.527 + by (auto simp add: Well wo_rel.underS_ofilter)
40.528 + hence UN: "rel.underS r a = (\<Union> b \<in> rel.underS r a. rel.under r b)"
40.529 + using Well wo_rel.ofilter_under_UNION[of r "rel.underS r a"] by blast
40.530 + (* Gather facts about elements of rel.underS r a *)
40.531 + {fix b assume *: "b \<in> rel.underS r a"
40.532 + hence t0: "(b,a) \<in> r \<and> b \<noteq> a" unfolding rel.underS_def by auto
40.533 + have t1: "b \<in> Field r"
40.534 + using * rel.underS_Field[of r a] by auto
40.535 + have t2: "f`(rel.under r b) = rel.under r' (f b)"
40.536 + using IH * by (auto simp add: bij_betw_def)
40.537 + hence t3: "wo_rel.ofilter r' (f`(rel.under r b))"
40.538 + using Well' by (auto simp add: wo_rel.under_ofilter)
40.539 + have "f`(rel.under r b) \<le> Field r'"
40.540 + using t2 by (auto simp add: rel.under_Field)
40.541 + moreover
40.542 + have "b \<in> rel.under r b"
40.543 + using t1 by(auto simp add: Refl rel.Refl_under_in)
40.544 + ultimately
40.545 + have t4: "f b \<in> Field r'" by auto
40.546 + have "f`(rel.under r b) = rel.under r' (f b) \<and>
40.547 + wo_rel.ofilter r' (f`(rel.under r b)) \<and>
40.548 + f b \<in> Field r'"
40.549 + using t2 t3 t4 by auto
40.550 + }
40.551 + hence bFact:
40.552 + "\<forall>b \<in> rel.underS r a. f`(rel.under r b) = rel.under r' (f b) \<and>
40.553 + wo_rel.ofilter r' (f`(rel.under r b)) \<and>
40.554 + f b \<in> Field r'" by blast
40.555 + (* *)
40.556 + have subField: "f`(rel.underS r a) \<le> Field r'"
40.557 + using bFact by blast
40.558 + (* *)
40.559 + have OF': "wo_rel.ofilter r' (f`(rel.underS r a))"
40.560 + proof-
40.561 + have "f`(rel.underS r a) = f`(\<Union> b \<in> rel.underS r a. rel.under r b)"
40.562 + using UN by auto
40.563 + also have "\<dots> = (\<Union> b \<in> rel.underS r a. f`(rel.under r b))" by blast
40.564 + also have "\<dots> = (\<Union> b \<in> rel.underS r a. (rel.under r' (f b)))"
40.565 + using bFact by auto
40.566 + finally
40.567 + have "f`(rel.underS r a) = (\<Union> b \<in> rel.underS r a. (rel.under r' (f b)))" .
40.568 + thus ?thesis
40.569 + using Well' bFact
40.570 + wo_rel.ofilter_UNION[of r' "rel.underS r a" "\<lambda> b. rel.under r' (f b)"] by fastforce
40.571 + qed
40.572 + (* *)
40.573 + have "f`(rel.underS r a) \<union> rel.AboveS r' (f`(rel.underS r a)) = Field r'"
40.574 + using Well' OF' by (auto simp add: wo_rel.ofilter_AboveS_Field)
40.575 + hence NE: "rel.AboveS r' (f`(rel.underS r a)) \<noteq> {}"
40.576 + using subField NOT by blast
40.577 + (* Main proof *)
40.578 + have INCL1: "f`(rel.underS r a) \<le> rel.underS r' (f a) "
40.579 + proof(auto)
40.580 + fix b assume *: "b \<in> rel.underS r a"
40.581 + have "f b \<noteq> f a \<and> (f b, f a) \<in> r'"
40.582 + using subField Well' SUC NE *
40.583 + wo_rel.suc_greater[of r' "f`(rel.underS r a)" "f b"] by force
40.584 + thus "f b \<in> rel.underS r' (f a)"
40.585 + unfolding rel.underS_def by simp
40.586 + qed
40.587 + (* *)
40.588 + have INCL2: "rel.underS r' (f a) \<le> f`(rel.underS r a)"
40.589 + proof
40.590 + fix b' assume "b' \<in> rel.underS r' (f a)"
40.591 + hence "b' \<noteq> f a \<and> (b', f a) \<in> r'"
40.592 + unfolding rel.underS_def by simp
40.593 + thus "b' \<in> f`(rel.underS r a)"
40.594 + using Well' SUC NE OF'
40.595 + wo_rel.suc_ofilter_in[of r' "f ` rel.underS r a" b'] by auto
40.596 + qed
40.597 + (* *)
40.598 + have INJ: "inj_on f (rel.underS r a)"
40.599 + proof-
40.600 + have "\<forall>b \<in> rel.underS r a. inj_on f (rel.under r b)"
40.601 + using IH by (auto simp add: bij_betw_def)
40.602 + moreover
40.603 + have "\<forall>b. wo_rel.ofilter r (rel.under r b)"
40.604 + using Well by (auto simp add: wo_rel.under_ofilter)
40.605 + ultimately show ?thesis
40.606 + using WELL bFact UN
40.607 + UNION_inj_on_ofilter[of r "rel.underS r a" "\<lambda>b. rel.under r b" f]
40.608 + by auto
40.609 + qed
40.610 + (* *)
40.611 + have BIJ: "bij_betw f (rel.underS r a) (rel.underS r' (f a))"
40.612 + unfolding bij_betw_def
40.613 + using INJ INCL1 INCL2 by auto
40.614 + (* *)
40.615 + have "f a \<in> Field r'"
40.616 + using Well' subField NE SUC
40.617 + by (auto simp add: wo_rel.suc_inField)
40.618 + thus ?thesis
40.619 + using WELL WELL' IN BIJ under_underS_bij_betw[of r r' a f] by auto
40.620 +qed
40.621 +
40.622 +
40.623 +lemma wellorders_totally_ordered_aux2:
40.624 +fixes r ::"'a rel" and r'::"'a' rel" and
40.625 + f :: "'a \<Rightarrow> 'a'" and g :: "'a \<Rightarrow> bool" and a::'a
40.626 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and
40.627 +MAIN1:
40.628 + "\<And> a. (False \<notin> g`(rel.underS r a) \<and> f`(rel.underS r a) \<noteq> Field r'
40.629 + \<longrightarrow> f a = wo_rel.suc r' (f`(rel.underS r a)) \<and> g a = True)
40.630 + \<and>
40.631 + (\<not>(False \<notin> (g`(rel.underS r a)) \<and> f`(rel.underS r a) \<noteq> Field r')
40.632 + \<longrightarrow> g a = False)" and
40.633 +MAIN2: "\<And> a. a \<in> Field r \<and> False \<notin> g`(rel.under r a) \<longrightarrow>
40.634 + bij_betw f (rel.under r a) (rel.under r' (f a))" and
40.635 +Case: "a \<in> Field r \<and> False \<in> g`(rel.under r a)"
40.636 +shows "\<exists>f'. embed r' r f'"
40.637 +proof-
40.638 + have Well: "wo_rel r" using WELL unfolding wo_rel_def .
40.639 + hence Refl: "Refl r" using wo_rel.REFL[of r] by auto
40.640 + have Trans: "trans r" using Well wo_rel.TRANS[of r] by auto
40.641 + have Antisym: "antisym r" using Well wo_rel.ANTISYM[of r] by auto
40.642 + have Well': "wo_rel r'" using WELL' unfolding wo_rel_def .
40.643 + (* *)
40.644 + have 0: "rel.under r a = rel.underS r a \<union> {a}"
40.645 + using Refl Case by(auto simp add: rel.Refl_under_underS)
40.646 + (* *)
40.647 + have 1: "g a = False"
40.648 + proof-
40.649 + {assume "g a \<noteq> False"
40.650 + with 0 Case have "False \<in> g`(rel.underS r a)" by blast
40.651 + with MAIN1 have "g a = False" by blast}
40.652 + thus ?thesis by blast
40.653 + qed
40.654 + let ?A = "{a \<in> Field r. g a = False}"
40.655 + let ?a = "(wo_rel.minim r ?A)"
40.656 + (* *)
40.657 + have 2: "?A \<noteq> {} \<and> ?A \<le> Field r" using Case 1 by blast
40.658 + (* *)
40.659 + have 3: "False \<notin> g`(rel.underS r ?a)"
40.660 + proof
40.661 + assume "False \<in> g`(rel.underS r ?a)"
40.662 + then obtain b where "b \<in> rel.underS r ?a" and 31: "g b = False" by auto
40.663 + hence 32: "(b,?a) \<in> r \<and> b \<noteq> ?a"
40.664 + by (auto simp add: rel.underS_def)
40.665 + hence "b \<in> Field r" unfolding Field_def by auto
40.666 + with 31 have "b \<in> ?A" by auto
40.667 + hence "(?a,b) \<in> r" using wo_rel.minim_least 2 Well by fastforce
40.668 + (* again: why worked without type annotations? *)
40.669 + with 32 Antisym show False
40.670 + by (auto simp add: antisym_def)
40.671 + qed
40.672 + have temp: "?a \<in> ?A"
40.673 + using Well 2 wo_rel.minim_in[of r ?A] by auto
40.674 + hence 4: "?a \<in> Field r" by auto
40.675 + (* *)
40.676 + have 5: "g ?a = False" using temp by blast
40.677 + (* *)
40.678 + have 6: "f`(rel.underS r ?a) = Field r'"
40.679 + using MAIN1[of ?a] 3 5 by blast
40.680 + (* *)
40.681 + have 7: "\<forall>b \<in> rel.underS r ?a. bij_betw f (rel.under r b) (rel.under r' (f b))"
40.682 + proof
40.683 + fix b assume as: "b \<in> rel.underS r ?a"
40.684 + moreover
40.685 + have "wo_rel.ofilter r (rel.underS r ?a)"
40.686 + using Well by (auto simp add: wo_rel.underS_ofilter)
40.687 + ultimately
40.688 + have "False \<notin> g`(rel.under r b)" using 3 Well by (subst (asm) wo_rel.ofilter_def) fast+
40.689 + moreover have "b \<in> Field r"
40.690 + unfolding Field_def using as by (auto simp add: rel.underS_def)
40.691 + ultimately
40.692 + show "bij_betw f (rel.under r b) (rel.under r' (f b))"
40.693 + using MAIN2 by auto
40.694 + qed
40.695 + (* *)
40.696 + have "embed r' r (inv_into (rel.underS r ?a) f)"
40.697 + using WELL WELL' 7 4 6 inv_into_underS_embed[of r ?a f r'] by auto
40.698 + thus ?thesis
40.699 + unfolding embed_def by blast
40.700 +qed
40.701 +
40.702 +
40.703 +theorem wellorders_totally_ordered:
40.704 +fixes r ::"'a rel" and r'::"'a' rel"
40.705 +assumes WELL: "Well_order r" and WELL': "Well_order r'"
40.706 +shows "(\<exists>f. embed r r' f) \<or> (\<exists>f'. embed r' r f')"
40.707 +proof-
40.708 + (* Preliminary facts *)
40.709 + have Well: "wo_rel r" using WELL unfolding wo_rel_def .
40.710 + hence Refl: "Refl r" using wo_rel.REFL[of r] by auto
40.711 + have Trans: "trans r" using Well wo_rel.TRANS[of r] by auto
40.712 + have Well': "wo_rel r'" using WELL' unfolding wo_rel_def .
40.713 + (* Main proof *)
40.714 + obtain H where H_def: "H =
40.715 + (\<lambda>h a. if False \<notin> (snd o h)`(rel.underS r a) \<and> (fst o h)`(rel.underS r a) \<noteq> Field r'
40.716 + then (wo_rel.suc r' ((fst o h)`(rel.underS r a)), True)
40.717 + else (undefined, False))" by blast
40.718 + have Adm: "wo_rel.adm_wo r H"
40.719 + using Well
40.720 + proof(unfold wo_rel.adm_wo_def, clarify)
40.721 + fix h1::"'a \<Rightarrow> 'a' * bool" and h2::"'a \<Rightarrow> 'a' * bool" and x
40.722 + assume "\<forall>y\<in>rel.underS r x. h1 y = h2 y"
40.723 + hence "\<forall>y\<in>rel.underS r x. (fst o h1) y = (fst o h2) y \<and>
40.724 + (snd o h1) y = (snd o h2) y" by auto
40.725 + hence "(fst o h1)`(rel.underS r x) = (fst o h2)`(rel.underS r x) \<and>
40.726 + (snd o h1)`(rel.underS r x) = (snd o h2)`(rel.underS r x)"
40.727 + by (auto simp add: image_def)
40.728 + thus "H h1 x = H h2 x" by (simp add: H_def del: not_False_in_image_Ball)
40.729 + qed
40.730 + (* More constant definitions: *)
40.731 + obtain h::"'a \<Rightarrow> 'a' * bool" and f::"'a \<Rightarrow> 'a'" and g::"'a \<Rightarrow> bool"
40.732 + where h_def: "h = wo_rel.worec r H" and
40.733 + f_def: "f = fst o h" and g_def: "g = snd o h" by blast
40.734 + obtain test where test_def:
40.735 + "test = (\<lambda> a. False \<notin> (g`(rel.underS r a)) \<and> f`(rel.underS r a) \<noteq> Field r')" by blast
40.736 + (* *)
40.737 + have *: "\<And> a. h a = H h a"
40.738 + using Adm Well wo_rel.worec_fixpoint[of r H] by (simp add: h_def)
40.739 + have Main1:
40.740 + "\<And> a. (test a \<longrightarrow> f a = wo_rel.suc r' (f`(rel.underS r a)) \<and> g a = True) \<and>
40.741 + (\<not>(test a) \<longrightarrow> g a = False)"
40.742 + proof- (* How can I prove this withou fixing a? *)
40.743 + fix a show "(test a \<longrightarrow> f a = wo_rel.suc r' (f`(rel.underS r a)) \<and> g a = True) \<and>
40.744 + (\<not>(test a) \<longrightarrow> g a = False)"
40.745 + using *[of a] test_def f_def g_def H_def by auto
40.746 + qed
40.747 + (* *)
40.748 + let ?phi = "\<lambda> a. a \<in> Field r \<and> False \<notin> g`(rel.under r a) \<longrightarrow>
40.749 + bij_betw f (rel.under r a) (rel.under r' (f a))"
40.750 + have Main2: "\<And> a. ?phi a"
40.751 + proof-
40.752 + fix a show "?phi a"
40.753 + proof(rule wo_rel.well_order_induct[of r ?phi],
40.754 + simp only: Well, clarify)
40.755 + fix a
40.756 + assume IH: "\<forall>b. b \<noteq> a \<and> (b,a) \<in> r \<longrightarrow> ?phi b" and
40.757 + *: "a \<in> Field r" and
40.758 + **: "False \<notin> g`(rel.under r a)"
40.759 + have 1: "\<forall>b \<in> rel.underS r a. bij_betw f (rel.under r b) (rel.under r' (f b))"
40.760 + proof(clarify)
40.761 + fix b assume ***: "b \<in> rel.underS r a"
40.762 + hence 0: "(b,a) \<in> r \<and> b \<noteq> a" unfolding rel.underS_def by auto
40.763 + moreover have "b \<in> Field r"
40.764 + using *** rel.underS_Field[of r a] by auto
40.765 + moreover have "False \<notin> g`(rel.under r b)"
40.766 + using 0 ** Trans rel.under_incr[of r b a] by auto
40.767 + ultimately show "bij_betw f (rel.under r b) (rel.under r' (f b))"
40.768 + using IH by auto
40.769 + qed
40.770 + (* *)
40.771 + have 21: "False \<notin> g`(rel.underS r a)"
40.772 + using ** rel.underS_subset_under[of r a] by auto
40.773 + have 22: "g`(rel.under r a) \<le> {True}" using ** by auto
40.774 + moreover have 23: "a \<in> rel.under r a"
40.775 + using Refl * by (auto simp add: rel.Refl_under_in)
40.776 + ultimately have 24: "g a = True" by blast
40.777 + have 2: "f`(rel.underS r a) \<noteq> Field r'"
40.778 + proof
40.779 + assume "f`(rel.underS r a) = Field r'"
40.780 + hence "g a = False" using Main1 test_def by blast
40.781 + with 24 show False using ** by blast
40.782 + qed
40.783 + (* *)
40.784 + have 3: "f a = wo_rel.suc r' (f`(rel.underS r a))"
40.785 + using 21 2 Main1 test_def by blast
40.786 + (* *)
40.787 + show "bij_betw f (rel.under r a) (rel.under r' (f a))"
40.788 + using WELL WELL' 1 2 3 *
40.789 + wellorders_totally_ordered_aux[of r r' a f] by auto
40.790 + qed
40.791 + qed
40.792 + (* *)
40.793 + let ?chi = "(\<lambda> a. a \<in> Field r \<and> False \<in> g`(rel.under r a))"
40.794 + show ?thesis
40.795 + proof(cases "\<exists>a. ?chi a")
40.796 + assume "\<not> (\<exists>a. ?chi a)"
40.797 + hence "\<forall>a \<in> Field r. bij_betw f (rel.under r a) (rel.under r' (f a))"
40.798 + using Main2 by blast
40.799 + thus ?thesis unfolding embed_def by blast
40.800 + next
40.801 + assume "\<exists>a. ?chi a"
40.802 + then obtain a where "?chi a" by blast
40.803 + hence "\<exists>f'. embed r' r f'"
40.804 + using wellorders_totally_ordered_aux2[of r r' g f a]
40.805 + WELL WELL' Main1 Main2 test_def by fast
40.806 + thus ?thesis by blast
40.807 + qed
40.808 +qed
40.809 +
40.810 +
40.811 +subsection {* Uniqueness of embeddings *}
40.812 +
40.813 +
40.814 +text{* Here we show a fact complementary to the one from the previous subsection -- namely,
40.815 +that between any two well-orders there is {\em at most} one embedding, and is the one
40.816 +definable by the expected well-order recursive equation. As a consequence, any two
40.817 +embeddings of opposite directions are mutually inverse. *}
40.818 +
40.819 +
40.820 +lemma embed_determined:
40.821 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and
40.822 + EMB: "embed r r' f" and IN: "a \<in> Field r"
40.823 +shows "f a = wo_rel.suc r' (f`(rel.underS r a))"
40.824 +proof-
40.825 + have "bij_betw f (rel.underS r a) (rel.underS r' (f a))"
40.826 + using assms by (auto simp add: embed_underS)
40.827 + hence "f`(rel.underS r a) = rel.underS r' (f a)"
40.828 + by (auto simp add: bij_betw_def)
40.829 + moreover
40.830 + {have "f a \<in> Field r'" using IN
40.831 + using EMB WELL embed_Field[of r r' f] by auto
40.832 + hence "f a = wo_rel.suc r' (rel.underS r' (f a))"
40.833 + using WELL' by (auto simp add: wo_rel_def wo_rel.suc_underS)
40.834 + }
40.835 + ultimately show ?thesis by simp
40.836 +qed
40.837 +
40.838 +
40.839 +lemma embed_unique:
40.840 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and
40.841 + EMBf: "embed r r' f" and EMBg: "embed r r' g"
40.842 +shows "a \<in> Field r \<longrightarrow> f a = g a"
40.843 +proof(rule wo_rel.well_order_induct[of r], auto simp add: WELL wo_rel_def)
40.844 + fix a
40.845 + assume IH: "\<forall>b. b \<noteq> a \<and> (b,a): r \<longrightarrow> b \<in> Field r \<longrightarrow> f b = g b" and
40.846 + *: "a \<in> Field r"
40.847 + hence "\<forall>b \<in> rel.underS r a. f b = g b"
40.848 + unfolding rel.underS_def by (auto simp add: Field_def)
40.849 + hence "f`(rel.underS r a) = g`(rel.underS r a)" by force
40.850 + thus "f a = g a"
40.851 + using assms * embed_determined[of r r' f a] embed_determined[of r r' g a] by auto
40.852 +qed
40.853 +
40.854 +
40.855 +lemma embed_bothWays_inverse:
40.856 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and
40.857 + EMB: "embed r r' f" and EMB': "embed r' r f'"
40.858 +shows "(\<forall>a \<in> Field r. f'(f a) = a) \<and> (\<forall>a' \<in> Field r'. f(f' a') = a')"
40.859 +proof-
40.860 + have "embed r r (f' o f)" using assms
40.861 + by(auto simp add: comp_embed)
40.862 + moreover have "embed r r id" using assms
40.863 + by (auto simp add: id_embed)
40.864 + ultimately have "\<forall>a \<in> Field r. f'(f a) = a"
40.865 + using assms embed_unique[of r r "f' o f" id] id_def by auto
40.866 + moreover
40.867 + {have "embed r' r' (f o f')" using assms
40.868 + by(auto simp add: comp_embed)
40.869 + moreover have "embed r' r' id" using assms
40.870 + by (auto simp add: id_embed)
40.871 + ultimately have "\<forall>a' \<in> Field r'. f(f' a') = a'"
40.872 + using assms embed_unique[of r' r' "f o f'" id] id_def by auto
40.873 + }
40.874 + ultimately show ?thesis by blast
40.875 +qed
40.876 +
40.877 +
40.878 +lemma embed_bothWays_bij_betw:
40.879 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and
40.880 + EMB: "embed r r' f" and EMB': "embed r' r g"
40.881 +shows "bij_betw f (Field r) (Field r')"
40.882 +proof-
40.883 + let ?A = "Field r" let ?A' = "Field r'"
40.884 + have "embed r r (g o f) \<and> embed r' r' (f o g)"
40.885 + using assms by (auto simp add: comp_embed)
40.886 + hence 1: "(\<forall>a \<in> ?A. g(f a) = a) \<and> (\<forall>a' \<in> ?A'. f(g a') = a')"
40.887 + using WELL id_embed[of r] embed_unique[of r r "g o f" id]
40.888 + WELL' id_embed[of r'] embed_unique[of r' r' "f o g" id]
40.889 + id_def by auto
40.890 + have 2: "(\<forall>a \<in> ?A. f a \<in> ?A') \<and> (\<forall>a' \<in> ?A'. g a' \<in> ?A)"
40.891 + using assms embed_Field[of r r' f] embed_Field[of r' r g] by blast
40.892 + (* *)
40.893 + show ?thesis
40.894 + proof(unfold bij_betw_def inj_on_def, auto simp add: 2)
40.895 + fix a b assume *: "a \<in> ?A" "b \<in> ?A" and **: "f a = f b"
40.896 + have "a = g(f a) \<and> b = g(f b)" using * 1 by auto
40.897 + with ** show "a = b" by auto
40.898 + next
40.899 + fix a' assume *: "a' \<in> ?A'"
40.900 + hence "g a' \<in> ?A \<and> f(g a') = a'" using 1 2 by auto
40.901 + thus "a' \<in> f ` ?A" by force
40.902 + qed
40.903 +qed
40.904 +
40.905 +
40.906 +lemma embed_bothWays_iso:
40.907 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and
40.908 + EMB: "embed r r' f" and EMB': "embed r' r g"
40.909 +shows "iso r r' f"
40.910 +unfolding iso_def using assms by (auto simp add: embed_bothWays_bij_betw)
40.911 +
40.912 +
40.913 +subsection {* More properties of embeddings, strict embeddings and isomorphisms *}
40.914 +
40.915 +
40.916 +lemma embed_bothWays_Field_bij_betw:
40.917 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and
40.918 + EMB: "embed r r' f" and EMB': "embed r' r f'"
40.919 +shows "bij_betw f (Field r) (Field r')"
40.920 +proof-
40.921 + have "(\<forall>a \<in> Field r. f'(f a) = a) \<and> (\<forall>a' \<in> Field r'. f(f' a') = a')"
40.922 + using assms by (auto simp add: embed_bothWays_inverse)
40.923 + moreover
40.924 + have "f`(Field r) \<le> Field r' \<and> f' ` (Field r') \<le> Field r"
40.925 + using assms by (auto simp add: embed_Field)
40.926 + ultimately
40.927 + show ?thesis using bij_betw_byWitness[of "Field r" f' f "Field r'"] by auto
40.928 +qed
40.929 +
40.930 +
40.931 +lemma embedS_comp_embed:
40.932 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and WELL'': "Well_order r''"
40.933 + and EMB: "embedS r r' f" and EMB': "embed r' r'' f'"
40.934 +shows "embedS r r'' (f' o f)"
40.935 +proof-
40.936 + let ?g = "(f' o f)" let ?h = "inv_into (Field r) ?g"
40.937 + have 1: "embed r r' f \<and> \<not> (bij_betw f (Field r) (Field r'))"
40.938 + using EMB by (auto simp add: embedS_def)
40.939 + hence 2: "embed r r'' ?g"
40.940 + using WELL EMB' comp_embed[of r r' f r'' f'] by auto
40.941 + moreover
40.942 + {assume "bij_betw ?g (Field r) (Field r'')"
40.943 + hence "embed r'' r ?h" using 2 WELL
40.944 + by (auto simp add: inv_into_Field_embed_bij_betw)
40.945 + hence "embed r' r (?h o f')" using WELL' EMB'
40.946 + by (auto simp add: comp_embed)
40.947 + hence "bij_betw f (Field r) (Field r')" using WELL WELL' 1
40.948 + by (auto simp add: embed_bothWays_Field_bij_betw)
40.949 + with 1 have False by blast
40.950 + }
40.951 + ultimately show ?thesis unfolding embedS_def by auto
40.952 +qed
40.953 +
40.954 +
40.955 +lemma embed_comp_embedS:
40.956 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and WELL'': "Well_order r''"
40.957 + and EMB: "embed r r' f" and EMB': "embedS r' r'' f'"
40.958 +shows "embedS r r'' (f' o f)"
40.959 +proof-
40.960 + let ?g = "(f' o f)" let ?h = "inv_into (Field r) ?g"
40.961 + have 1: "embed r' r'' f' \<and> \<not> (bij_betw f' (Field r') (Field r''))"
40.962 + using EMB' by (auto simp add: embedS_def)
40.963 + hence 2: "embed r r'' ?g"
40.964 + using WELL EMB comp_embed[of r r' f r'' f'] by auto
40.965 + moreover
40.966 + {assume "bij_betw ?g (Field r) (Field r'')"
40.967 + hence "embed r'' r ?h" using 2 WELL
40.968 + by (auto simp add: inv_into_Field_embed_bij_betw)
40.969 + hence "embed r'' r' (f o ?h)" using WELL'' EMB
40.970 + by (auto simp add: comp_embed)
40.971 + hence "bij_betw f' (Field r') (Field r'')" using WELL' WELL'' 1
40.972 + by (auto simp add: embed_bothWays_Field_bij_betw)
40.973 + with 1 have False by blast
40.974 + }
40.975 + ultimately show ?thesis unfolding embedS_def by auto
40.976 +qed
40.977 +
40.978 +
40.979 +lemma embed_comp_iso:
40.980 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and WELL'': "Well_order r''"
40.981 + and EMB: "embed r r' f" and EMB': "iso r' r'' f'"
40.982 +shows "embed r r'' (f' o f)"
40.983 +using assms unfolding iso_def
40.984 +by (auto simp add: comp_embed)
40.985 +
40.986 +
40.987 +lemma iso_comp_embed:
40.988 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and WELL'': "Well_order r''"
40.989 + and EMB: "iso r r' f" and EMB': "embed r' r'' f'"
40.990 +shows "embed r r'' (f' o f)"
40.991 +using assms unfolding iso_def
40.992 +by (auto simp add: comp_embed)
40.993 +
40.994 +
40.995 +lemma embedS_comp_iso:
40.996 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and WELL'': "Well_order r''"
40.997 + and EMB: "embedS r r' f" and EMB': "iso r' r'' f'"
40.998 +shows "embedS r r'' (f' o f)"
40.999 +using assms unfolding iso_def
40.1000 +by (auto simp add: embedS_comp_embed)
40.1001 +
40.1002 +
40.1003 +lemma iso_comp_embedS:
40.1004 +assumes WELL: "Well_order r" and WELL': "Well_order r'" and WELL'': "Well_order r''"
40.1005 + and EMB: "iso r r' f" and EMB': "embedS r' r'' f'"
40.1006 +shows "embedS r r'' (f' o f)"
40.1007 +using assms unfolding iso_def using embed_comp_embedS
40.1008 +by (auto simp add: embed_comp_embedS)
40.1009 +
40.1010 +
40.1011 +lemma embedS_Field:
40.1012 +assumes WELL: "Well_order r" and EMB: "embedS r r' f"
40.1013 +shows "f ` (Field r) < Field r'"
40.1014 +proof-
40.1015 + have "f`(Field r) \<le> Field r'" using assms
40.1016 + by (auto simp add: embed_Field embedS_def)
40.1017 + moreover
40.1018 + {have "inj_on f (Field r)" using assms
40.1019 + by (auto simp add: embedS_def embed_inj_on)
40.1020 + hence "f`(Field r) \<noteq> Field r'" using EMB
40.1021 + by (auto simp add: embedS_def bij_betw_def)
40.1022 + }
40.1023 + ultimately show ?thesis by blast
40.1024 +qed
40.1025 +
40.1026 +
40.1027 +lemma embedS_iff:
40.1028 +assumes WELL: "Well_order r" and ISO: "embed r r' f"
40.1029 +shows "embedS r r' f = (f ` (Field r) < Field r')"
40.1030 +proof
40.1031 + assume "embedS r r' f"
40.1032 + thus "f ` Field r \<subset> Field r'"
40.1033 + using WELL by (auto simp add: embedS_Field)
40.1034 +next
40.1035 + assume "f ` Field r \<subset> Field r'"
40.1036 + hence "\<not> bij_betw f (Field r) (Field r')"
40.1037 + unfolding bij_betw_def by blast
40.1038 + thus "embedS r r' f" unfolding embedS_def
40.1039 + using ISO by auto
40.1040 +qed
40.1041 +
40.1042 +
40.1043 +lemma iso_Field:
40.1044 +"iso r r' f \<Longrightarrow> f ` (Field r) = Field r'"
40.1045 +using assms by (auto simp add: iso_def bij_betw_def)
40.1046 +
40.1047 +
40.1048 +lemma iso_iff:
40.1049 +assumes "Well_order r"
40.1050 +shows "iso r r' f = (embed r r' f \<and> f ` (Field r) = Field r')"
40.1051 +proof
40.1052 + assume "iso r r' f"
40.1053 + thus "embed r r' f \<and> f ` (Field r) = Field r'"
40.1054 + by (auto simp add: iso_Field iso_def)
40.1055 +next
40.1056 + assume *: "embed r r' f \<and> f ` Field r = Field r'"
40.1057 + hence "inj_on f (Field r)" using assms by (auto simp add: embed_inj_on)
40.1058 + with * have "bij_betw f (Field r) (Field r')"
40.1059 + unfolding bij_betw_def by simp
40.1060 + with * show "iso r r' f" unfolding iso_def by auto
40.1061 +qed
40.1062 +
40.1063 +
40.1064 +lemma iso_iff2:
40.1065 +assumes "Well_order r"
40.1066 +shows "iso r r' f = (bij_betw f (Field r) (Field r') \<and>
40.1067 + (\<forall>a \<in> Field r. \<forall>b \<in> Field r.
40.1068 + (((a,b) \<in> r) = ((f a, f b) \<in> r'))))"
40.1069 +using assms
40.1070 +proof(auto simp add: iso_def)
40.1071 + fix a b
40.1072 + assume "embed r r' f"
40.1073 + hence "compat r r' f" using embed_compat[of r] by auto
40.1074 + moreover assume "(a,b) \<in> r"
40.1075 + ultimately show "(f a, f b) \<in> r'" using compat_def[of r] by auto
40.1076 +next
40.1077 + let ?f' = "inv_into (Field r) f"
40.1078 + assume "embed r r' f" and 1: "bij_betw f (Field r) (Field r')"
40.1079 + hence "embed r' r ?f'" using assms
40.1080 + by (auto simp add: inv_into_Field_embed_bij_betw)
40.1081 + hence 2: "compat r' r ?f'" using embed_compat[of r'] by auto
40.1082 + fix a b assume *: "a \<in> Field r" "b \<in> Field r" and **: "(f a,f b) \<in> r'"
40.1083 + hence "?f'(f a) = a \<and> ?f'(f b) = b" using 1
40.1084 + by (auto simp add: bij_betw_inv_into_left)
40.1085 + thus "(a,b) \<in> r" using ** 2 compat_def[of r' r ?f'] by fastforce
40.1086 +next
40.1087 + assume *: "bij_betw f (Field r) (Field r')" and
40.1088 + **: "\<forall>a\<in>Field r. \<forall>b\<in>Field r. ((a, b) \<in> r) = ((f a, f b) \<in> r')"
40.1089 + have 1: "\<And> a. rel.under r a \<le> Field r \<and> rel.under r' (f a) \<le> Field r'"
40.1090 + by (auto simp add: rel.under_Field)
40.1091 + have 2: "inj_on f (Field r)" using * by (auto simp add: bij_betw_def)
40.1092 + {fix a assume ***: "a \<in> Field r"
40.1093 + have "bij_betw f (rel.under r a) (rel.under r' (f a))"
40.1094 + proof(unfold bij_betw_def, auto)
40.1095 + show "inj_on f (rel.under r a)"
40.1096 + using 1 2 by (metis subset_inj_on)
40.1097 + next
40.1098 + fix b assume "b \<in> rel.under r a"
40.1099 + hence "a \<in> Field r \<and> b \<in> Field r \<and> (b,a) \<in> r"
40.1100 + unfolding rel.under_def by (auto simp add: Field_def Range_def Domain_def)
40.1101 + with 1 ** show "f b \<in> rel.under r' (f a)"
40.1102 + unfolding rel.under_def by auto
40.1103 + next
40.1104 + fix b' assume "b' \<in> rel.under r' (f a)"
40.1105 + hence 3: "(b',f a) \<in> r'" unfolding rel.under_def by simp
40.1106 + hence "b' \<in> Field r'" unfolding Field_def by auto
40.1107 + with * obtain b where "b \<in> Field r \<and> f b = b'"
40.1108 + unfolding bij_betw_def by force
40.1109 + with 3 ** ***
40.1110 + show "b' \<in> f ` (rel.under r a)" unfolding rel.under_def by blast
40.1111 + qed
40.1112 + }
40.1113 + thus "embed r r' f" unfolding embed_def using * by auto
40.1114 +qed
40.1115 +
40.1116 +
40.1117 +lemma iso_iff3:
40.1118 +assumes WELL: "Well_order r" and WELL': "Well_order r'"
40.1119 +shows "iso r r' f = (bij_betw f (Field r) (Field r') \<and> compat r r' f)"
40.1120 +proof
40.1121 + assume "iso r r' f"
40.1122 + thus "bij_betw f (Field r) (Field r') \<and> compat r r' f"
40.1123 + unfolding compat_def using WELL by (auto simp add: iso_iff2 Field_def)
40.1124 +next
40.1125 + have Well: "wo_rel r \<and> wo_rel r'" using WELL WELL'
40.1126 + by (auto simp add: wo_rel_def)
40.1127 + assume *: "bij_betw f (Field r) (Field r') \<and> compat r r' f"
40.1128 + thus "iso r r' f"
40.1129 + unfolding "compat_def" using assms
40.1130 + proof(auto simp add: iso_iff2)
40.1131 + fix a b assume **: "a \<in> Field r" "b \<in> Field r" and
40.1132 + ***: "(f a, f b) \<in> r'"
40.1133 + {assume "(b,a) \<in> r \<or> b = a"
40.1134 + hence "(b,a): r"using Well ** wo_rel.REFL[of r] refl_on_def[of _ r] by blast
40.1135 + hence "(f b, f a) \<in> r'" using * unfolding compat_def by auto
40.1136 + hence "f a = f b"
40.1137 + using Well *** wo_rel.ANTISYM[of r'] antisym_def[of r'] by blast
40.1138 + hence "a = b" using * ** unfolding bij_betw_def inj_on_def by auto
40.1139 + hence "(a,b) \<in> r" using Well ** wo_rel.REFL[of r] refl_on_def[of _ r] by blast
40.1140 + }
40.1141 + thus "(a,b) \<in> r"
40.1142 + using Well ** wo_rel.TOTAL[of r] total_on_def[of _ r] by blast
40.1143 + qed
40.1144 +qed
40.1145 +
40.1146 +
40.1147 +
40.1148 +end
41.1 --- a/src/HOL/Cardinals/Wellorder_Relation.thy Mon Nov 18 17:15:01 2013 +0100
41.2 +++ b/src/HOL/Cardinals/Wellorder_Relation.thy Tue Nov 19 17:07:52 2013 +0100
41.3 @@ -8,7 +8,7 @@
41.4 header {* Well-Order Relations *}
41.5
41.6 theory Wellorder_Relation
41.7 -imports Wellorder_Relation_Base Wellfounded_More
41.8 +imports Wellorder_Relation_FP Wellfounded_More
41.9 begin
41.10
41.11 context wo_rel
41.12 @@ -64,17 +64,7 @@
41.13
41.14 lemma minim_Under:
41.15 "\<lbrakk>B \<le> Field r; B \<noteq> {}\<rbrakk> \<Longrightarrow> minim B \<in> Under B"
41.16 -by(auto simp add: Under_def
41.17 -minim_in
41.18 -minim_inField
41.19 -minim_least
41.20 -under_ofilter
41.21 -underS_ofilter
41.22 -Field_ofilter
41.23 -ofilter_Under
41.24 -ofilter_UnderS
41.25 -ofilter_Un
41.26 -)
41.27 +by(auto simp add: Under_def minim_inField minim_least)
41.28
41.29 lemma equals_minim_Under:
41.30 "\<lbrakk>B \<le> Field r; a \<in> B; a \<in> Under B\<rbrakk>
41.31 @@ -410,7 +400,41 @@
41.32 qed
41.33
41.34
41.35 -subsubsection {* Properties of order filters *}
41.36 +subsubsection {* Properties of order filters *}
41.37 +
41.38 +lemma ofilter_Under[simp]:
41.39 +assumes "A \<le> Field r"
41.40 +shows "ofilter(Under A)"
41.41 +proof(unfold ofilter_def, auto)
41.42 + fix x assume "x \<in> Under A"
41.43 + thus "x \<in> Field r"
41.44 + using Under_Field assms by auto
41.45 +next
41.46 + fix a x
41.47 + assume "a \<in> Under A" and "x \<in> under a"
41.48 + thus "x \<in> Under A"
41.49 + using TRANS under_Under_trans by auto
41.50 +qed
41.51 +
41.52 +lemma ofilter_UnderS[simp]:
41.53 +assumes "A \<le> Field r"
41.54 +shows "ofilter(UnderS A)"
41.55 +proof(unfold ofilter_def, auto)
41.56 + fix x assume "x \<in> UnderS A"
41.57 + thus "x \<in> Field r"
41.58 + using UnderS_Field assms by auto
41.59 +next
41.60 + fix a x
41.61 + assume "a \<in> UnderS A" and "x \<in> under a"
41.62 + thus "x \<in> UnderS A"
41.63 + using TRANS ANTISYM under_UnderS_trans by auto
41.64 +qed
41.65 +
41.66 +lemma ofilter_Int[simp]: "\<lbrakk>ofilter A; ofilter B\<rbrakk> \<Longrightarrow> ofilter(A Int B)"
41.67 +unfolding ofilter_def by blast
41.68 +
41.69 +lemma ofilter_Un[simp]: "\<lbrakk>ofilter A; ofilter B\<rbrakk> \<Longrightarrow> ofilter(A \<union> B)"
41.70 +unfolding ofilter_def by blast
41.71
41.72 lemma ofilter_INTER:
41.73 "\<lbrakk>I \<noteq> {}; \<And> i. i \<in> I \<Longrightarrow> ofilter(A i)\<rbrakk> \<Longrightarrow> ofilter (\<Inter> i \<in> I. A i)"
41.74 @@ -496,10 +520,6 @@
41.75 under_ofilter[simp]
41.76 underS_ofilter[simp]
41.77 Field_ofilter[simp]
41.78 - ofilter_Under[simp]
41.79 - ofilter_UnderS[simp]
41.80 - ofilter_Int[simp]
41.81 - ofilter_Un[simp]
41.82
41.83 end
41.84
42.1 --- a/src/HOL/Cardinals/Wellorder_Relation_Base.thy Mon Nov 18 17:15:01 2013 +0100
42.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
42.3 @@ -1,669 +0,0 @@
42.4 -(* Title: HOL/Cardinals/Wellorder_Relation_Base.thy
42.5 - Author: Andrei Popescu, TU Muenchen
42.6 - Copyright 2012
42.7 -
42.8 -Well-order relations (base).
42.9 -*)
42.10 -
42.11 -header {* Well-Order Relations (Base) *}
42.12 -
42.13 -theory Wellorder_Relation_Base
42.14 -imports Wellfounded_More_Base
42.15 -begin
42.16 -
42.17 -
42.18 -text{* In this section, we develop basic concepts and results pertaining
42.19 -to well-order relations. Note that we consider well-order relations
42.20 -as {\em non-strict relations},
42.21 -i.e., as containing the diagonals of their fields. *}
42.22 -
42.23 -
42.24 -locale wo_rel = rel + assumes WELL: "Well_order r"
42.25 -begin
42.26 -
42.27 -text{* The following context encompasses all this section. In other words,
42.28 -for the whole section, we consider a fixed well-order relation @{term "r"}. *}
42.29 -
42.30 -(* context wo_rel *)
42.31 -
42.32 -
42.33 -subsection {* Auxiliaries *}
42.34 -
42.35 -
42.36 -lemma REFL: "Refl r"
42.37 -using WELL order_on_defs[of _ r] by auto
42.38 -
42.39 -
42.40 -lemma TRANS: "trans r"
42.41 -using WELL order_on_defs[of _ r] by auto
42.42 -
42.43 -
42.44 -lemma ANTISYM: "antisym r"
42.45 -using WELL order_on_defs[of _ r] by auto
42.46 -
42.47 -
42.48 -lemma TOTAL: "Total r"
42.49 -using WELL order_on_defs[of _ r] by auto
42.50 -
42.51 -
42.52 -lemma TOTALS: "\<forall>a \<in> Field r. \<forall>b \<in> Field r. (a,b) \<in> r \<or> (b,a) \<in> r"
42.53 -using REFL TOTAL refl_on_def[of _ r] total_on_def[of _ r] by force
42.54 -
42.55 -
42.56 -lemma LIN: "Linear_order r"
42.57 -using WELL well_order_on_def[of _ r] by auto
42.58 -
42.59 -
42.60 -lemma WF: "wf (r - Id)"
42.61 -using WELL well_order_on_def[of _ r] by auto
42.62 -
42.63 -
42.64 -lemma cases_Total:
42.65 -"\<And> phi a b. \<lbrakk>{a,b} <= Field r; ((a,b) \<in> r \<Longrightarrow> phi a b); ((b,a) \<in> r \<Longrightarrow> phi a b)\<rbrakk>
42.66 - \<Longrightarrow> phi a b"
42.67 -using TOTALS by auto
42.68 -
42.69 -
42.70 -lemma cases_Total3:
42.71 -"\<And> phi a b. \<lbrakk>{a,b} \<le> Field r; ((a,b) \<in> r - Id \<or> (b,a) \<in> r - Id \<Longrightarrow> phi a b);
42.72 - (a = b \<Longrightarrow> phi a b)\<rbrakk> \<Longrightarrow> phi a b"
42.73 -using TOTALS by auto
42.74 -
42.75 -
42.76 -subsection {* Well-founded induction and recursion adapted to non-strict well-order relations *}
42.77 -
42.78 -
42.79 -text{* Here we provide induction and recursion principles specific to {\em non-strict}
42.80 -well-order relations.
42.81 -Although minor variations of those for well-founded relations, they will be useful
42.82 -for doing away with the tediousness of
42.83 -having to take out the diagonal each time in order to switch to a well-founded relation. *}
42.84 -
42.85 -
42.86 -lemma well_order_induct:
42.87 -assumes IND: "\<And>x. \<forall>y. y \<noteq> x \<and> (y, x) \<in> r \<longrightarrow> P y \<Longrightarrow> P x"
42.88 -shows "P a"
42.89 -proof-
42.90 - have "\<And>x. \<forall>y. (y, x) \<in> r - Id \<longrightarrow> P y \<Longrightarrow> P x"
42.91 - using IND by blast
42.92 - thus "P a" using WF wf_induct[of "r - Id" P a] by blast
42.93 -qed
42.94 -
42.95 -
42.96 -definition
42.97 -worec :: "(('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b"
42.98 -where
42.99 -"worec F \<equiv> wfrec (r - Id) F"
42.100 -
42.101 -
42.102 -definition
42.103 -adm_wo :: "(('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b) \<Rightarrow> bool"
42.104 -where
42.105 -"adm_wo H \<equiv> \<forall>f g x. (\<forall>y \<in> underS x. f y = g y) \<longrightarrow> H f x = H g x"
42.106 -
42.107 -
42.108 -lemma worec_fixpoint:
42.109 -assumes ADM: "adm_wo H"
42.110 -shows "worec H = H (worec H)"
42.111 -proof-
42.112 - let ?rS = "r - Id"
42.113 - have "adm_wf (r - Id) H"
42.114 - unfolding adm_wf_def
42.115 - using ADM adm_wo_def[of H] underS_def by auto
42.116 - hence "wfrec ?rS H = H (wfrec ?rS H)"
42.117 - using WF wfrec_fixpoint[of ?rS H] by simp
42.118 - thus ?thesis unfolding worec_def .
42.119 -qed
42.120 -
42.121 -
42.122 -subsection {* The notions of maximum, minimum, supremum, successor and order filter *}
42.123 -
42.124 -
42.125 -text{*
42.126 -We define the successor {\em of a set}, and not of an element (the latter is of course
42.127 -a particular case). Also, we define the maximum {\em of two elements}, @{text "max2"},
42.128 -and the minimum {\em of a set}, @{text "minim"} -- we chose these variants since we
42.129 -consider them the most useful for well-orders. The minimum is defined in terms of the
42.130 -auxiliary relational operator @{text "isMinim"}. Then, supremum and successor are
42.131 -defined in terms of minimum as expected.
42.132 -The minimum is only meaningful for non-empty sets, and the successor is only
42.133 -meaningful for sets for which strict upper bounds exist.
42.134 -Order filters for well-orders are also known as ``initial segments". *}
42.135 -
42.136 -
42.137 -definition max2 :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"
42.138 -where "max2 a b \<equiv> if (a,b) \<in> r then b else a"
42.139 -
42.140 -
42.141 -definition isMinim :: "'a set \<Rightarrow> 'a \<Rightarrow> bool"
42.142 -where "isMinim A b \<equiv> b \<in> A \<and> (\<forall>a \<in> A. (b,a) \<in> r)"
42.143 -
42.144 -definition minim :: "'a set \<Rightarrow> 'a"
42.145 -where "minim A \<equiv> THE b. isMinim A b"
42.146 -
42.147 -
42.148 -definition supr :: "'a set \<Rightarrow> 'a"
42.149 -where "supr A \<equiv> minim (Above A)"
42.150 -
42.151 -definition suc :: "'a set \<Rightarrow> 'a"
42.152 -where "suc A \<equiv> minim (AboveS A)"
42.153 -
42.154 -definition ofilter :: "'a set \<Rightarrow> bool"
42.155 -where
42.156 -"ofilter A \<equiv> (A \<le> Field r) \<and> (\<forall>a \<in> A. under a \<le> A)"
42.157 -
42.158 -
42.159 -subsubsection {* Properties of max2 *}
42.160 -
42.161 -
42.162 -lemma max2_greater_among:
42.163 -assumes "a \<in> Field r" and "b \<in> Field r"
42.164 -shows "(a, max2 a b) \<in> r \<and> (b, max2 a b) \<in> r \<and> max2 a b \<in> {a,b}"
42.165 -proof-
42.166 - {assume "(a,b) \<in> r"
42.167 - hence ?thesis using max2_def assms REFL refl_on_def
42.168 - by (auto simp add: refl_on_def)
42.169 - }
42.170 - moreover
42.171 - {assume "a = b"
42.172 - hence "(a,b) \<in> r" using REFL assms
42.173 - by (auto simp add: refl_on_def)
42.174 - }
42.175 - moreover
42.176 - {assume *: "a \<noteq> b \<and> (b,a) \<in> r"
42.177 - hence "(a,b) \<notin> r" using ANTISYM
42.178 - by (auto simp add: antisym_def)
42.179 - hence ?thesis using * max2_def assms REFL refl_on_def
42.180 - by (auto simp add: refl_on_def)
42.181 - }
42.182 - ultimately show ?thesis using assms TOTAL
42.183 - total_on_def[of "Field r" r] by blast
42.184 -qed
42.185 -
42.186 -
42.187 -lemma max2_greater:
42.188 -assumes "a \<in> Field r" and "b \<in> Field r"
42.189 -shows "(a, max2 a b) \<in> r \<and> (b, max2 a b) \<in> r"
42.190 -using assms by (auto simp add: max2_greater_among)
42.191 -
42.192 -
42.193 -lemma max2_among:
42.194 -assumes "a \<in> Field r" and "b \<in> Field r"
42.195 -shows "max2 a b \<in> {a, b}"
42.196 -using assms max2_greater_among[of a b] by simp
42.197 -
42.198 -
42.199 -lemma max2_equals1:
42.200 -assumes "a \<in> Field r" and "b \<in> Field r"
42.201 -shows "(max2 a b = a) = ((b,a) \<in> r)"
42.202 -using assms ANTISYM unfolding antisym_def using TOTALS
42.203 -by(auto simp add: max2_def max2_among)
42.204 -
42.205 -
42.206 -lemma max2_equals2:
42.207 -assumes "a \<in> Field r" and "b \<in> Field r"
42.208 -shows "(max2 a b = b) = ((a,b) \<in> r)"
42.209 -using assms ANTISYM unfolding antisym_def using TOTALS
42.210 -unfolding max2_def by auto
42.211 -
42.212 -
42.213 -subsubsection {* Existence and uniqueness for isMinim and well-definedness of minim *}
42.214 -
42.215 -
42.216 -lemma isMinim_unique:
42.217 -assumes MINIM: "isMinim B a" and MINIM': "isMinim B a'"
42.218 -shows "a = a'"
42.219 -proof-
42.220 - {have "a \<in> B"
42.221 - using MINIM isMinim_def by simp
42.222 - hence "(a',a) \<in> r"
42.223 - using MINIM' isMinim_def by simp
42.224 - }
42.225 - moreover
42.226 - {have "a' \<in> B"
42.227 - using MINIM' isMinim_def by simp
42.228 - hence "(a,a') \<in> r"
42.229 - using MINIM isMinim_def by simp
42.230 - }
42.231 - ultimately
42.232 - show ?thesis using ANTISYM antisym_def[of r] by blast
42.233 -qed
42.234 -
42.235 -
42.236 -lemma Well_order_isMinim_exists:
42.237 -assumes SUB: "B \<le> Field r" and NE: "B \<noteq> {}"
42.238 -shows "\<exists>b. isMinim B b"
42.239 -proof-
42.240 - from spec[OF WF[unfolded wf_eq_minimal[of "r - Id"]], of B] NE obtain b where
42.241 - *: "b \<in> B \<and> (\<forall>b'. b' \<noteq> b \<and> (b',b) \<in> r \<longrightarrow> b' \<notin> B)" by auto
42.242 - show ?thesis
42.243 - proof(simp add: isMinim_def, rule exI[of _ b], auto)
42.244 - show "b \<in> B" using * by simp
42.245 - next
42.246 - fix b' assume As: "b' \<in> B"
42.247 - hence **: "b \<in> Field r \<and> b' \<in> Field r" using As SUB * by auto
42.248 - (* *)
42.249 - from As * have "b' = b \<or> (b',b) \<notin> r" by auto
42.250 - moreover
42.251 - {assume "b' = b"
42.252 - hence "(b,b') \<in> r"
42.253 - using ** REFL by (auto simp add: refl_on_def)
42.254 - }
42.255 - moreover
42.256 - {assume "b' \<noteq> b \<and> (b',b) \<notin> r"
42.257 - hence "(b,b') \<in> r"
42.258 - using ** TOTAL by (auto simp add: total_on_def)
42.259 - }
42.260 - ultimately show "(b,b') \<in> r" by blast
42.261 - qed
42.262 -qed
42.263 -
42.264 -
42.265 -lemma minim_isMinim:
42.266 -assumes SUB: "B \<le> Field r" and NE: "B \<noteq> {}"
42.267 -shows "isMinim B (minim B)"
42.268 -proof-
42.269 - let ?phi = "(\<lambda> b. isMinim B b)"
42.270 - from assms Well_order_isMinim_exists
42.271 - obtain b where *: "?phi b" by blast
42.272 - moreover
42.273 - have "\<And> b'. ?phi b' \<Longrightarrow> b' = b"
42.274 - using isMinim_unique * by auto
42.275 - ultimately show ?thesis
42.276 - unfolding minim_def using theI[of ?phi b] by blast
42.277 -qed
42.278 -
42.279 -
42.280 -subsubsection{* Properties of minim *}
42.281 -
42.282 -
42.283 -lemma minim_in:
42.284 -assumes "B \<le> Field r" and "B \<noteq> {}"
42.285 -shows "minim B \<in> B"
42.286 -proof-
42.287 - from minim_isMinim[of B] assms
42.288 - have "isMinim B (minim B)" by simp
42.289 - thus ?thesis by (simp add: isMinim_def)
42.290 -qed
42.291 -
42.292 -
42.293 -lemma minim_inField:
42.294 -assumes "B \<le> Field r" and "B \<noteq> {}"
42.295 -shows "minim B \<in> Field r"
42.296 -proof-
42.297 - have "minim B \<in> B" using assms by (simp add: minim_in)
42.298 - thus ?thesis using assms by blast
42.299 -qed
42.300 -
42.301 -
42.302 -lemma minim_least:
42.303 -assumes SUB: "B \<le> Field r" and IN: "b \<in> B"
42.304 -shows "(minim B, b) \<in> r"
42.305 -proof-
42.306 - from minim_isMinim[of B] assms
42.307 - have "isMinim B (minim B)" by auto
42.308 - thus ?thesis by (auto simp add: isMinim_def IN)
42.309 -qed
42.310 -
42.311 -
42.312 -lemma equals_minim:
42.313 -assumes SUB: "B \<le> Field r" and IN: "a \<in> B" and
42.314 - LEAST: "\<And> b. b \<in> B \<Longrightarrow> (a,b) \<in> r"
42.315 -shows "a = minim B"
42.316 -proof-
42.317 - from minim_isMinim[of B] assms
42.318 - have "isMinim B (minim B)" by auto
42.319 - moreover have "isMinim B a" using IN LEAST isMinim_def by auto
42.320 - ultimately show ?thesis
42.321 - using isMinim_unique by auto
42.322 -qed
42.323 -
42.324 -
42.325 -subsubsection{* Properties of successor *}
42.326 -
42.327 -
42.328 -lemma suc_AboveS:
42.329 -assumes SUB: "B \<le> Field r" and ABOVES: "AboveS B \<noteq> {}"
42.330 -shows "suc B \<in> AboveS B"
42.331 -proof(unfold suc_def)
42.332 - have "AboveS B \<le> Field r"
42.333 - using AboveS_Field by auto
42.334 - thus "minim (AboveS B) \<in> AboveS B"
42.335 - using assms by (simp add: minim_in)
42.336 -qed
42.337 -
42.338 -
42.339 -lemma suc_greater:
42.340 -assumes SUB: "B \<le> Field r" and ABOVES: "AboveS B \<noteq> {}" and
42.341 - IN: "b \<in> B"
42.342 -shows "suc B \<noteq> b \<and> (b,suc B) \<in> r"
42.343 -proof-
42.344 - from assms suc_AboveS
42.345 - have "suc B \<in> AboveS B" by simp
42.346 - with IN AboveS_def show ?thesis by simp
42.347 -qed
42.348 -
42.349 -
42.350 -lemma suc_least_AboveS:
42.351 -assumes ABOVES: "a \<in> AboveS B"
42.352 -shows "(suc B,a) \<in> r"
42.353 -proof(unfold suc_def)
42.354 - have "AboveS B \<le> Field r"
42.355 - using AboveS_Field by auto
42.356 - thus "(minim (AboveS B),a) \<in> r"
42.357 - using assms minim_least by simp
42.358 -qed
42.359 -
42.360 -
42.361 -lemma suc_inField:
42.362 -assumes "B \<le> Field r" and "AboveS B \<noteq> {}"
42.363 -shows "suc B \<in> Field r"
42.364 -proof-
42.365 - have "suc B \<in> AboveS B" using suc_AboveS assms by simp
42.366 - thus ?thesis
42.367 - using assms AboveS_Field by auto
42.368 -qed
42.369 -
42.370 -
42.371 -lemma equals_suc_AboveS:
42.372 -assumes SUB: "B \<le> Field r" and ABV: "a \<in> AboveS B" and
42.373 - MINIM: "\<And> a'. a' \<in> AboveS B \<Longrightarrow> (a,a') \<in> r"
42.374 -shows "a = suc B"
42.375 -proof(unfold suc_def)
42.376 - have "AboveS B \<le> Field r"
42.377 - using AboveS_Field[of B] by auto
42.378 - thus "a = minim (AboveS B)"
42.379 - using assms equals_minim
42.380 - by simp
42.381 -qed
42.382 -
42.383 -
42.384 -lemma suc_underS:
42.385 -assumes IN: "a \<in> Field r"
42.386 -shows "a = suc (underS a)"
42.387 -proof-
42.388 - have "underS a \<le> Field r"
42.389 - using underS_Field by auto
42.390 - moreover
42.391 - have "a \<in> AboveS (underS a)"
42.392 - using in_AboveS_underS IN by auto
42.393 - moreover
42.394 - have "\<forall>a' \<in> AboveS (underS a). (a,a') \<in> r"
42.395 - proof(clarify)
42.396 - fix a'
42.397 - assume *: "a' \<in> AboveS (underS a)"
42.398 - hence **: "a' \<in> Field r"
42.399 - using AboveS_Field by auto
42.400 - {assume "(a,a') \<notin> r"
42.401 - hence "a' = a \<or> (a',a) \<in> r"
42.402 - using TOTAL IN ** by (auto simp add: total_on_def)
42.403 - moreover
42.404 - {assume "a' = a"
42.405 - hence "(a,a') \<in> r"
42.406 - using REFL IN ** by (auto simp add: refl_on_def)
42.407 - }
42.408 - moreover
42.409 - {assume "a' \<noteq> a \<and> (a',a) \<in> r"
42.410 - hence "a' \<in> underS a"
42.411 - unfolding underS_def by simp
42.412 - hence "a' \<notin> AboveS (underS a)"
42.413 - using AboveS_disjoint by blast
42.414 - with * have False by simp
42.415 - }
42.416 - ultimately have "(a,a') \<in> r" by blast
42.417 - }
42.418 - thus "(a, a') \<in> r" by blast
42.419 - qed
42.420 - ultimately show ?thesis
42.421 - using equals_suc_AboveS by auto
42.422 -qed
42.423 -
42.424 -
42.425 -subsubsection {* Properties of order filters *}
42.426 -
42.427 -
42.428 -lemma under_ofilter:
42.429 -"ofilter (under a)"
42.430 -proof(unfold ofilter_def under_def, auto simp add: Field_def)
42.431 - fix aa x
42.432 - assume "(aa,a) \<in> r" "(x,aa) \<in> r"
42.433 - thus "(x,a) \<in> r"
42.434 - using TRANS trans_def[of r] by blast
42.435 -qed
42.436 -
42.437 -
42.438 -lemma underS_ofilter:
42.439 -"ofilter (underS a)"
42.440 -proof(unfold ofilter_def underS_def under_def, auto simp add: Field_def)
42.441 - fix aa assume "(a, aa) \<in> r" "(aa, a) \<in> r" and DIFF: "aa \<noteq> a"
42.442 - thus False
42.443 - using ANTISYM antisym_def[of r] by blast
42.444 -next
42.445 - fix aa x
42.446 - assume "(aa,a) \<in> r" "aa \<noteq> a" "(x,aa) \<in> r"
42.447 - thus "(x,a) \<in> r"
42.448 - using TRANS trans_def[of r] by blast
42.449 -qed
42.450 -
42.451 -
42.452 -lemma Field_ofilter:
42.453 -"ofilter (Field r)"
42.454 -by(unfold ofilter_def under_def, auto simp add: Field_def)
42.455 -
42.456 -
42.457 -lemma ofilter_underS_Field:
42.458 -"ofilter A = ((\<exists>a \<in> Field r. A = underS a) \<or> (A = Field r))"
42.459 -proof
42.460 - assume "(\<exists>a\<in>Field r. A = underS a) \<or> A = Field r"
42.461 - thus "ofilter A"
42.462 - by (auto simp: underS_ofilter Field_ofilter)
42.463 -next
42.464 - assume *: "ofilter A"
42.465 - let ?One = "(\<exists>a\<in>Field r. A = underS a)"
42.466 - let ?Two = "(A = Field r)"
42.467 - show "?One \<or> ?Two"
42.468 - proof(cases ?Two, simp)
42.469 - let ?B = "(Field r) - A"
42.470 - let ?a = "minim ?B"
42.471 - assume "A \<noteq> Field r"
42.472 - moreover have "A \<le> Field r" using * ofilter_def by simp
42.473 - ultimately have 1: "?B \<noteq> {}" by blast
42.474 - hence 2: "?a \<in> Field r" using minim_inField[of ?B] by blast
42.475 - have 3: "?a \<in> ?B" using minim_in[of ?B] 1 by blast
42.476 - hence 4: "?a \<notin> A" by blast
42.477 - have 5: "A \<le> Field r" using * ofilter_def[of A] by auto
42.478 - (* *)
42.479 - moreover
42.480 - have "A = underS ?a"
42.481 - proof
42.482 - show "A \<le> underS ?a"
42.483 - proof(unfold underS_def, auto simp add: 4)
42.484 - fix x assume **: "x \<in> A"
42.485 - hence 11: "x \<in> Field r" using 5 by auto
42.486 - have 12: "x \<noteq> ?a" using 4 ** by auto
42.487 - have 13: "under x \<le> A" using * ofilter_def ** by auto
42.488 - {assume "(x,?a) \<notin> r"
42.489 - hence "(?a,x) \<in> r"
42.490 - using TOTAL total_on_def[of "Field r" r]
42.491 - 2 4 11 12 by auto
42.492 - hence "?a \<in> under x" using under_def by auto
42.493 - hence "?a \<in> A" using ** 13 by blast
42.494 - with 4 have False by simp
42.495 - }
42.496 - thus "(x,?a) \<in> r" by blast
42.497 - qed
42.498 - next
42.499 - show "underS ?a \<le> A"
42.500 - proof(unfold underS_def, auto)
42.501 - fix x
42.502 - assume **: "x \<noteq> ?a" and ***: "(x,?a) \<in> r"
42.503 - hence 11: "x \<in> Field r" using Field_def by fastforce
42.504 - {assume "x \<notin> A"
42.505 - hence "x \<in> ?B" using 11 by auto
42.506 - hence "(?a,x) \<in> r" using 3 minim_least[of ?B x] by blast
42.507 - hence False
42.508 - using ANTISYM antisym_def[of r] ** *** by auto
42.509 - }
42.510 - thus "x \<in> A" by blast
42.511 - qed
42.512 - qed
42.513 - ultimately have ?One using 2 by blast
42.514 - thus ?thesis by simp
42.515 - qed
42.516 -qed
42.517 -
42.518 -
42.519 -lemma ofilter_Under:
42.520 -assumes "A \<le> Field r"
42.521 -shows "ofilter(Under A)"
42.522 -proof(unfold ofilter_def, auto)
42.523 - fix x assume "x \<in> Under A"
42.524 - thus "x \<in> Field r"
42.525 - using Under_Field assms by auto
42.526 -next
42.527 - fix a x
42.528 - assume "a \<in> Under A" and "x \<in> under a"
42.529 - thus "x \<in> Under A"
42.530 - using TRANS under_Under_trans by auto
42.531 -qed
42.532 -
42.533 -
42.534 -lemma ofilter_UnderS:
42.535 -assumes "A \<le> Field r"
42.536 -shows "ofilter(UnderS A)"
42.537 -proof(unfold ofilter_def, auto)
42.538 - fix x assume "x \<in> UnderS A"
42.539 - thus "x \<in> Field r"
42.540 - using UnderS_Field assms by auto
42.541 -next
42.542 - fix a x
42.543 - assume "a \<in> UnderS A" and "x \<in> under a"
42.544 - thus "x \<in> UnderS A"
42.545 - using TRANS ANTISYM under_UnderS_trans by auto
42.546 -qed
42.547 -
42.548 -
42.549 -lemma ofilter_Int: "\<lbrakk>ofilter A; ofilter B\<rbrakk> \<Longrightarrow> ofilter(A Int B)"
42.550 -unfolding ofilter_def by blast
42.551 -
42.552 -
42.553 -lemma ofilter_Un: "\<lbrakk>ofilter A; ofilter B\<rbrakk> \<Longrightarrow> ofilter(A \<union> B)"
42.554 -unfolding ofilter_def by blast
42.555 -
42.556 -
42.557 -lemma ofilter_UNION:
42.558 -"(\<And> i. i \<in> I \<Longrightarrow> ofilter(A i)) \<Longrightarrow> ofilter (\<Union> i \<in> I. A i)"
42.559 -unfolding ofilter_def by blast
42.560 -
42.561 -
42.562 -lemma ofilter_under_UNION:
42.563 -assumes "ofilter A"
42.564 -shows "A = (\<Union> a \<in> A. under a)"
42.565 -proof
42.566 - have "\<forall>a \<in> A. under a \<le> A"
42.567 - using assms ofilter_def by auto
42.568 - thus "(\<Union> a \<in> A. under a) \<le> A" by blast
42.569 -next
42.570 - have "\<forall>a \<in> A. a \<in> under a"
42.571 - using REFL Refl_under_in assms ofilter_def by blast
42.572 - thus "A \<le> (\<Union> a \<in> A. under a)" by blast
42.573 -qed
42.574 -
42.575 -
42.576 -subsubsection{* Other properties *}
42.577 -
42.578 -
42.579 -lemma ofilter_linord:
42.580 -assumes OF1: "ofilter A" and OF2: "ofilter B"
42.581 -shows "A \<le> B \<or> B \<le> A"
42.582 -proof(cases "A = Field r")
42.583 - assume Case1: "A = Field r"
42.584 - hence "B \<le> A" using OF2 ofilter_def by auto
42.585 - thus ?thesis by simp
42.586 -next
42.587 - assume Case2: "A \<noteq> Field r"
42.588 - with ofilter_underS_Field OF1 obtain a where
42.589 - 1: "a \<in> Field r \<and> A = underS a" by auto
42.590 - show ?thesis
42.591 - proof(cases "B = Field r")
42.592 - assume Case21: "B = Field r"
42.593 - hence "A \<le> B" using OF1 ofilter_def by auto
42.594 - thus ?thesis by simp
42.595 - next
42.596 - assume Case22: "B \<noteq> Field r"
42.597 - with ofilter_underS_Field OF2 obtain b where
42.598 - 2: "b \<in> Field r \<and> B = underS b" by auto
42.599 - have "a = b \<or> (a,b) \<in> r \<or> (b,a) \<in> r"
42.600 - using 1 2 TOTAL total_on_def[of _ r] by auto
42.601 - moreover
42.602 - {assume "a = b" with 1 2 have ?thesis by auto
42.603 - }
42.604 - moreover
42.605 - {assume "(a,b) \<in> r"
42.606 - with underS_incr TRANS ANTISYM 1 2
42.607 - have "A \<le> B" by auto
42.608 - hence ?thesis by auto
42.609 - }
42.610 - moreover
42.611 - {assume "(b,a) \<in> r"
42.612 - with underS_incr TRANS ANTISYM 1 2
42.613 - have "B \<le> A" by auto
42.614 - hence ?thesis by auto
42.615 - }
42.616 - ultimately show ?thesis by blast
42.617 - qed
42.618 -qed
42.619 -
42.620 -
42.621 -lemma ofilter_AboveS_Field:
42.622 -assumes "ofilter A"
42.623 -shows "A \<union> (AboveS A) = Field r"
42.624 -proof
42.625 - show "A \<union> (AboveS A) \<le> Field r"
42.626 - using assms ofilter_def AboveS_Field by auto
42.627 -next
42.628 - {fix x assume *: "x \<in> Field r" and **: "x \<notin> A"
42.629 - {fix y assume ***: "y \<in> A"
42.630 - with ** have 1: "y \<noteq> x" by auto
42.631 - {assume "(y,x) \<notin> r"
42.632 - moreover
42.633 - have "y \<in> Field r" using assms ofilter_def *** by auto
42.634 - ultimately have "(x,y) \<in> r"
42.635 - using 1 * TOTAL total_on_def[of _ r] by auto
42.636 - with *** assms ofilter_def under_def have "x \<in> A" by auto
42.637 - with ** have False by contradiction
42.638 - }
42.639 - hence "(y,x) \<in> r" by blast
42.640 - with 1 have "y \<noteq> x \<and> (y,x) \<in> r" by auto
42.641 - }
42.642 - with * have "x \<in> AboveS A" unfolding AboveS_def by auto
42.643 - }
42.644 - thus "Field r \<le> A \<union> (AboveS A)" by blast
42.645 -qed
42.646 -
42.647 -
42.648 -lemma suc_ofilter_in:
42.649 -assumes OF: "ofilter A" and ABOVE_NE: "AboveS A \<noteq> {}" and
42.650 - REL: "(b,suc A) \<in> r" and DIFF: "b \<noteq> suc A"
42.651 -shows "b \<in> A"
42.652 -proof-
42.653 - have *: "suc A \<in> Field r \<and> b \<in> Field r"
42.654 - using WELL REL well_order_on_domain by auto
42.655 - {assume **: "b \<notin> A"
42.656 - hence "b \<in> AboveS A"
42.657 - using OF * ofilter_AboveS_Field by auto
42.658 - hence "(suc A, b) \<in> r"
42.659 - using suc_least_AboveS by auto
42.660 - hence False using REL DIFF ANTISYM *
42.661 - by (auto simp add: antisym_def)
42.662 - }
42.663 - thus ?thesis by blast
42.664 -qed
42.665 -
42.666 -
42.667 -
42.668 -end (* context wo_rel *)
42.669 -
42.670 -
42.671 -
42.672 -end
43.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
43.2 +++ b/src/HOL/Cardinals/Wellorder_Relation_FP.thy Tue Nov 19 17:07:52 2013 +0100
43.3 @@ -0,0 +1,631 @@
43.4 +(* Title: HOL/Cardinals/Wellorder_Relation_FP.thy
43.5 + Author: Andrei Popescu, TU Muenchen
43.6 + Copyright 2012
43.7 +
43.8 +Well-order relations (FP).
43.9 +*)
43.10 +
43.11 +header {* Well-Order Relations (FP) *}
43.12 +
43.13 +theory Wellorder_Relation_FP
43.14 +imports Wellfounded_More_FP
43.15 +begin
43.16 +
43.17 +
43.18 +text{* In this section, we develop basic concepts and results pertaining
43.19 +to well-order relations. Note that we consider well-order relations
43.20 +as {\em non-strict relations},
43.21 +i.e., as containing the diagonals of their fields. *}
43.22 +
43.23 +
43.24 +locale wo_rel = rel + assumes WELL: "Well_order r"
43.25 +begin
43.26 +
43.27 +text{* The following context encompasses all this section. In other words,
43.28 +for the whole section, we consider a fixed well-order relation @{term "r"}. *}
43.29 +
43.30 +(* context wo_rel *)
43.31 +
43.32 +
43.33 +subsection {* Auxiliaries *}
43.34 +
43.35 +
43.36 +lemma REFL: "Refl r"
43.37 +using WELL order_on_defs[of _ r] by auto
43.38 +
43.39 +
43.40 +lemma TRANS: "trans r"
43.41 +using WELL order_on_defs[of _ r] by auto
43.42 +
43.43 +
43.44 +lemma ANTISYM: "antisym r"
43.45 +using WELL order_on_defs[of _ r] by auto
43.46 +
43.47 +
43.48 +lemma TOTAL: "Total r"
43.49 +using WELL order_on_defs[of _ r] by auto
43.50 +
43.51 +
43.52 +lemma TOTALS: "\<forall>a \<in> Field r. \<forall>b \<in> Field r. (a,b) \<in> r \<or> (b,a) \<in> r"
43.53 +using REFL TOTAL refl_on_def[of _ r] total_on_def[of _ r] by force
43.54 +
43.55 +
43.56 +lemma LIN: "Linear_order r"
43.57 +using WELL well_order_on_def[of _ r] by auto
43.58 +
43.59 +
43.60 +lemma WF: "wf (r - Id)"
43.61 +using WELL well_order_on_def[of _ r] by auto
43.62 +
43.63 +
43.64 +lemma cases_Total:
43.65 +"\<And> phi a b. \<lbrakk>{a,b} <= Field r; ((a,b) \<in> r \<Longrightarrow> phi a b); ((b,a) \<in> r \<Longrightarrow> phi a b)\<rbrakk>
43.66 + \<Longrightarrow> phi a b"
43.67 +using TOTALS by auto
43.68 +
43.69 +
43.70 +lemma cases_Total3:
43.71 +"\<And> phi a b. \<lbrakk>{a,b} \<le> Field r; ((a,b) \<in> r - Id \<or> (b,a) \<in> r - Id \<Longrightarrow> phi a b);
43.72 + (a = b \<Longrightarrow> phi a b)\<rbrakk> \<Longrightarrow> phi a b"
43.73 +using TOTALS by auto
43.74 +
43.75 +
43.76 +subsection {* Well-founded induction and recursion adapted to non-strict well-order relations *}
43.77 +
43.78 +
43.79 +text{* Here we provide induction and recursion principles specific to {\em non-strict}
43.80 +well-order relations.
43.81 +Although minor variations of those for well-founded relations, they will be useful
43.82 +for doing away with the tediousness of
43.83 +having to take out the diagonal each time in order to switch to a well-founded relation. *}
43.84 +
43.85 +
43.86 +lemma well_order_induct:
43.87 +assumes IND: "\<And>x. \<forall>y. y \<noteq> x \<and> (y, x) \<in> r \<longrightarrow> P y \<Longrightarrow> P x"
43.88 +shows "P a"
43.89 +proof-
43.90 + have "\<And>x. \<forall>y. (y, x) \<in> r - Id \<longrightarrow> P y \<Longrightarrow> P x"
43.91 + using IND by blast
43.92 + thus "P a" using WF wf_induct[of "r - Id" P a] by blast
43.93 +qed
43.94 +
43.95 +
43.96 +definition
43.97 +worec :: "(('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b"
43.98 +where
43.99 +"worec F \<equiv> wfrec (r - Id) F"
43.100 +
43.101 +
43.102 +definition
43.103 +adm_wo :: "(('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b) \<Rightarrow> bool"
43.104 +where
43.105 +"adm_wo H \<equiv> \<forall>f g x. (\<forall>y \<in> underS x. f y = g y) \<longrightarrow> H f x = H g x"
43.106 +
43.107 +
43.108 +lemma worec_fixpoint:
43.109 +assumes ADM: "adm_wo H"
43.110 +shows "worec H = H (worec H)"
43.111 +proof-
43.112 + let ?rS = "r - Id"
43.113 + have "adm_wf (r - Id) H"
43.114 + unfolding adm_wf_def
43.115 + using ADM adm_wo_def[of H] underS_def by auto
43.116 + hence "wfrec ?rS H = H (wfrec ?rS H)"
43.117 + using WF wfrec_fixpoint[of ?rS H] by simp
43.118 + thus ?thesis unfolding worec_def .
43.119 +qed
43.120 +
43.121 +
43.122 +subsection {* The notions of maximum, minimum, supremum, successor and order filter *}
43.123 +
43.124 +
43.125 +text{*
43.126 +We define the successor {\em of a set}, and not of an element (the latter is of course
43.127 +a particular case). Also, we define the maximum {\em of two elements}, @{text "max2"},
43.128 +and the minimum {\em of a set}, @{text "minim"} -- we chose these variants since we
43.129 +consider them the most useful for well-orders. The minimum is defined in terms of the
43.130 +auxiliary relational operator @{text "isMinim"}. Then, supremum and successor are
43.131 +defined in terms of minimum as expected.
43.132 +The minimum is only meaningful for non-empty sets, and the successor is only
43.133 +meaningful for sets for which strict upper bounds exist.
43.134 +Order filters for well-orders are also known as ``initial segments". *}
43.135 +
43.136 +
43.137 +definition max2 :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"
43.138 +where "max2 a b \<equiv> if (a,b) \<in> r then b else a"
43.139 +
43.140 +
43.141 +definition isMinim :: "'a set \<Rightarrow> 'a \<Rightarrow> bool"
43.142 +where "isMinim A b \<equiv> b \<in> A \<and> (\<forall>a \<in> A. (b,a) \<in> r)"
43.143 +
43.144 +definition minim :: "'a set \<Rightarrow> 'a"
43.145 +where "minim A \<equiv> THE b. isMinim A b"
43.146 +
43.147 +
43.148 +definition supr :: "'a set \<Rightarrow> 'a"
43.149 +where "supr A \<equiv> minim (Above A)"
43.150 +
43.151 +definition suc :: "'a set \<Rightarrow> 'a"
43.152 +where "suc A \<equiv> minim (AboveS A)"
43.153 +
43.154 +definition ofilter :: "'a set \<Rightarrow> bool"
43.155 +where
43.156 +"ofilter A \<equiv> (A \<le> Field r) \<and> (\<forall>a \<in> A. under a \<le> A)"
43.157 +
43.158 +
43.159 +subsubsection {* Properties of max2 *}
43.160 +
43.161 +
43.162 +lemma max2_greater_among:
43.163 +assumes "a \<in> Field r" and "b \<in> Field r"
43.164 +shows "(a, max2 a b) \<in> r \<and> (b, max2 a b) \<in> r \<and> max2 a b \<in> {a,b}"
43.165 +proof-
43.166 + {assume "(a,b) \<in> r"
43.167 + hence ?thesis using max2_def assms REFL refl_on_def
43.168 + by (auto simp add: refl_on_def)
43.169 + }
43.170 + moreover
43.171 + {assume "a = b"
43.172 + hence "(a,b) \<in> r" using REFL assms
43.173 + by (auto simp add: refl_on_def)
43.174 + }
43.175 + moreover
43.176 + {assume *: "a \<noteq> b \<and> (b,a) \<in> r"
43.177 + hence "(a,b) \<notin> r" using ANTISYM
43.178 + by (auto simp add: antisym_def)
43.179 + hence ?thesis using * max2_def assms REFL refl_on_def
43.180 + by (auto simp add: refl_on_def)
43.181 + }
43.182 + ultimately show ?thesis using assms TOTAL
43.183 + total_on_def[of "Field r" r] by blast
43.184 +qed
43.185 +
43.186 +
43.187 +lemma max2_greater:
43.188 +assumes "a \<in> Field r" and "b \<in> Field r"
43.189 +shows "(a, max2 a b) \<in> r \<and> (b, max2 a b) \<in> r"
43.190 +using assms by (auto simp add: max2_greater_among)
43.191 +
43.192 +
43.193 +lemma max2_among:
43.194 +assumes "a \<in> Field r" and "b \<in> Field r"
43.195 +shows "max2 a b \<in> {a, b}"
43.196 +using assms max2_greater_among[of a b] by simp
43.197 +
43.198 +
43.199 +lemma max2_equals1:
43.200 +assumes "a \<in> Field r" and "b \<in> Field r"
43.201 +shows "(max2 a b = a) = ((b,a) \<in> r)"
43.202 +using assms ANTISYM unfolding antisym_def using TOTALS
43.203 +by(auto simp add: max2_def max2_among)
43.204 +
43.205 +
43.206 +lemma max2_equals2:
43.207 +assumes "a \<in> Field r" and "b \<in> Field r"
43.208 +shows "(max2 a b = b) = ((a,b) \<in> r)"
43.209 +using assms ANTISYM unfolding antisym_def using TOTALS
43.210 +unfolding max2_def by auto
43.211 +
43.212 +
43.213 +subsubsection {* Existence and uniqueness for isMinim and well-definedness of minim *}
43.214 +
43.215 +
43.216 +lemma isMinim_unique:
43.217 +assumes MINIM: "isMinim B a" and MINIM': "isMinim B a'"
43.218 +shows "a = a'"
43.219 +proof-
43.220 + {have "a \<in> B"
43.221 + using MINIM isMinim_def by simp
43.222 + hence "(a',a) \<in> r"
43.223 + using MINIM' isMinim_def by simp
43.224 + }
43.225 + moreover
43.226 + {have "a' \<in> B"
43.227 + using MINIM' isMinim_def by simp
43.228 + hence "(a,a') \<in> r"
43.229 + using MINIM isMinim_def by simp
43.230 + }
43.231 + ultimately
43.232 + show ?thesis using ANTISYM antisym_def[of r] by blast
43.233 +qed
43.234 +
43.235 +
43.236 +lemma Well_order_isMinim_exists:
43.237 +assumes SUB: "B \<le> Field r" and NE: "B \<noteq> {}"
43.238 +shows "\<exists>b. isMinim B b"
43.239 +proof-
43.240 + from spec[OF WF[unfolded wf_eq_minimal[of "r - Id"]], of B] NE obtain b where
43.241 + *: "b \<in> B \<and> (\<forall>b'. b' \<noteq> b \<and> (b',b) \<in> r \<longrightarrow> b' \<notin> B)" by auto
43.242 + show ?thesis
43.243 + proof(simp add: isMinim_def, rule exI[of _ b], auto)
43.244 + show "b \<in> B" using * by simp
43.245 + next
43.246 + fix b' assume As: "b' \<in> B"
43.247 + hence **: "b \<in> Field r \<and> b' \<in> Field r" using As SUB * by auto
43.248 + (* *)
43.249 + from As * have "b' = b \<or> (b',b) \<notin> r" by auto
43.250 + moreover
43.251 + {assume "b' = b"
43.252 + hence "(b,b') \<in> r"
43.253 + using ** REFL by (auto simp add: refl_on_def)
43.254 + }
43.255 + moreover
43.256 + {assume "b' \<noteq> b \<and> (b',b) \<notin> r"
43.257 + hence "(b,b') \<in> r"
43.258 + using ** TOTAL by (auto simp add: total_on_def)
43.259 + }
43.260 + ultimately show "(b,b') \<in> r" by blast
43.261 + qed
43.262 +qed
43.263 +
43.264 +
43.265 +lemma minim_isMinim:
43.266 +assumes SUB: "B \<le> Field r" and NE: "B \<noteq> {}"
43.267 +shows "isMinim B (minim B)"
43.268 +proof-
43.269 + let ?phi = "(\<lambda> b. isMinim B b)"
43.270 + from assms Well_order_isMinim_exists
43.271 + obtain b where *: "?phi b" by blast
43.272 + moreover
43.273 + have "\<And> b'. ?phi b' \<Longrightarrow> b' = b"
43.274 + using isMinim_unique * by auto
43.275 + ultimately show ?thesis
43.276 + unfolding minim_def using theI[of ?phi b] by blast
43.277 +qed
43.278 +
43.279 +
43.280 +subsubsection{* Properties of minim *}
43.281 +
43.282 +
43.283 +lemma minim_in:
43.284 +assumes "B \<le> Field r" and "B \<noteq> {}"
43.285 +shows "minim B \<in> B"
43.286 +proof-
43.287 + from minim_isMinim[of B] assms
43.288 + have "isMinim B (minim B)" by simp
43.289 + thus ?thesis by (simp add: isMinim_def)
43.290 +qed
43.291 +
43.292 +
43.293 +lemma minim_inField:
43.294 +assumes "B \<le> Field r" and "B \<noteq> {}"
43.295 +shows "minim B \<in> Field r"
43.296 +proof-
43.297 + have "minim B \<in> B" using assms by (simp add: minim_in)
43.298 + thus ?thesis using assms by blast
43.299 +qed
43.300 +
43.301 +
43.302 +lemma minim_least:
43.303 +assumes SUB: "B \<le> Field r" and IN: "b \<in> B"
43.304 +shows "(minim B, b) \<in> r"
43.305 +proof-
43.306 + from minim_isMinim[of B] assms
43.307 + have "isMinim B (minim B)" by auto
43.308 + thus ?thesis by (auto simp add: isMinim_def IN)
43.309 +qed
43.310 +
43.311 +
43.312 +lemma equals_minim:
43.313 +assumes SUB: "B \<le> Field r" and IN: "a \<in> B" and
43.314 + LEAST: "\<And> b. b \<in> B \<Longrightarrow> (a,b) \<in> r"
43.315 +shows "a = minim B"
43.316 +proof-
43.317 + from minim_isMinim[of B] assms
43.318 + have "isMinim B (minim B)" by auto
43.319 + moreover have "isMinim B a" using IN LEAST isMinim_def by auto
43.320 + ultimately show ?thesis
43.321 + using isMinim_unique by auto
43.322 +qed
43.323 +
43.324 +
43.325 +subsubsection{* Properties of successor *}
43.326 +
43.327 +
43.328 +lemma suc_AboveS:
43.329 +assumes SUB: "B \<le> Field r" and ABOVES: "AboveS B \<noteq> {}"
43.330 +shows "suc B \<in> AboveS B"
43.331 +proof(unfold suc_def)
43.332 + have "AboveS B \<le> Field r"
43.333 + using AboveS_Field by auto
43.334 + thus "minim (AboveS B) \<in> AboveS B"
43.335 + using assms by (simp add: minim_in)
43.336 +qed
43.337 +
43.338 +
43.339 +lemma suc_greater:
43.340 +assumes SUB: "B \<le> Field r" and ABOVES: "AboveS B \<noteq> {}" and
43.341 + IN: "b \<in> B"
43.342 +shows "suc B \<noteq> b \<and> (b,suc B) \<in> r"
43.343 +proof-
43.344 + from assms suc_AboveS
43.345 + have "suc B \<in> AboveS B" by simp
43.346 + with IN AboveS_def show ?thesis by simp
43.347 +qed
43.348 +
43.349 +
43.350 +lemma suc_least_AboveS:
43.351 +assumes ABOVES: "a \<in> AboveS B"
43.352 +shows "(suc B,a) \<in> r"
43.353 +proof(unfold suc_def)
43.354 + have "AboveS B \<le> Field r"
43.355 + using AboveS_Field by auto
43.356 + thus "(minim (AboveS B),a) \<in> r"
43.357 + using assms minim_least by simp
43.358 +qed
43.359 +
43.360 +
43.361 +lemma suc_inField:
43.362 +assumes "B \<le> Field r" and "AboveS B \<noteq> {}"
43.363 +shows "suc B \<in> Field r"
43.364 +proof-
43.365 + have "suc B \<in> AboveS B" using suc_AboveS assms by simp
43.366 + thus ?thesis
43.367 + using assms AboveS_Field by auto
43.368 +qed
43.369 +
43.370 +
43.371 +lemma equals_suc_AboveS:
43.372 +assumes SUB: "B \<le> Field r" and ABV: "a \<in> AboveS B" and
43.373 + MINIM: "\<And> a'. a' \<in> AboveS B \<Longrightarrow> (a,a') \<in> r"
43.374 +shows "a = suc B"
43.375 +proof(unfold suc_def)
43.376 + have "AboveS B \<le> Field r"
43.377 + using AboveS_Field[of B] by auto
43.378 + thus "a = minim (AboveS B)"
43.379 + using assms equals_minim
43.380 + by simp
43.381 +qed
43.382 +
43.383 +
43.384 +lemma suc_underS:
43.385 +assumes IN: "a \<in> Field r"
43.386 +shows "a = suc (underS a)"
43.387 +proof-
43.388 + have "underS a \<le> Field r"
43.389 + using underS_Field by auto
43.390 + moreover
43.391 + have "a \<in> AboveS (underS a)"
43.392 + using in_AboveS_underS IN by auto
43.393 + moreover
43.394 + have "\<forall>a' \<in> AboveS (underS a). (a,a') \<in> r"
43.395 + proof(clarify)
43.396 + fix a'
43.397 + assume *: "a' \<in> AboveS (underS a)"
43.398 + hence **: "a' \<in> Field r"
43.399 + using AboveS_Field by auto
43.400 + {assume "(a,a') \<notin> r"
43.401 + hence "a' = a \<or> (a',a) \<in> r"
43.402 + using TOTAL IN ** by (auto simp add: total_on_def)
43.403 + moreover
43.404 + {assume "a' = a"
43.405 + hence "(a,a') \<in> r"
43.406 + using REFL IN ** by (auto simp add: refl_on_def)
43.407 + }
43.408 + moreover
43.409 + {assume "a' \<noteq> a \<and> (a',a) \<in> r"
43.410 + hence "a' \<in> underS a"
43.411 + unfolding underS_def by simp
43.412 + hence "a' \<notin> AboveS (underS a)"
43.413 + using AboveS_disjoint by blast
43.414 + with * have False by simp
43.415 + }
43.416 + ultimately have "(a,a') \<in> r" by blast
43.417 + }
43.418 + thus "(a, a') \<in> r" by blast
43.419 + qed
43.420 + ultimately show ?thesis
43.421 + using equals_suc_AboveS by auto
43.422 +qed
43.423 +
43.424 +
43.425 +subsubsection {* Properties of order filters *}
43.426 +
43.427 +
43.428 +lemma under_ofilter:
43.429 +"ofilter (under a)"
43.430 +proof(unfold ofilter_def under_def, auto simp add: Field_def)
43.431 + fix aa x
43.432 + assume "(aa,a) \<in> r" "(x,aa) \<in> r"
43.433 + thus "(x,a) \<in> r"
43.434 + using TRANS trans_def[of r] by blast
43.435 +qed
43.436 +
43.437 +
43.438 +lemma underS_ofilter:
43.439 +"ofilter (underS a)"
43.440 +proof(unfold ofilter_def underS_def under_def, auto simp add: Field_def)
43.441 + fix aa assume "(a, aa) \<in> r" "(aa, a) \<in> r" and DIFF: "aa \<noteq> a"
43.442 + thus False
43.443 + using ANTISYM antisym_def[of r] by blast
43.444 +next
43.445 + fix aa x
43.446 + assume "(aa,a) \<in> r" "aa \<noteq> a" "(x,aa) \<in> r"
43.447 + thus "(x,a) \<in> r"
43.448 + using TRANS trans_def[of r] by blast
43.449 +qed
43.450 +
43.451 +
43.452 +lemma Field_ofilter:
43.453 +"ofilter (Field r)"
43.454 +by(unfold ofilter_def under_def, auto simp add: Field_def)
43.455 +
43.456 +
43.457 +lemma ofilter_underS_Field:
43.458 +"ofilter A = ((\<exists>a \<in> Field r. A = underS a) \<or> (A = Field r))"
43.459 +proof
43.460 + assume "(\<exists>a\<in>Field r. A = underS a) \<or> A = Field r"
43.461 + thus "ofilter A"
43.462 + by (auto simp: underS_ofilter Field_ofilter)
43.463 +next
43.464 + assume *: "ofilter A"
43.465 + let ?One = "(\<exists>a\<in>Field r. A = underS a)"
43.466 + let ?Two = "(A = Field r)"
43.467 + show "?One \<or> ?Two"
43.468 + proof(cases ?Two, simp)
43.469 + let ?B = "(Field r) - A"
43.470 + let ?a = "minim ?B"
43.471 + assume "A \<noteq> Field r"
43.472 + moreover have "A \<le> Field r" using * ofilter_def by simp
43.473 + ultimately have 1: "?B \<noteq> {}" by blast
43.474 + hence 2: "?a \<in> Field r" using minim_inField[of ?B] by blast
43.475 + have 3: "?a \<in> ?B" using minim_in[of ?B] 1 by blast
43.476 + hence 4: "?a \<notin> A" by blast
43.477 + have 5: "A \<le> Field r" using * ofilter_def[of A] by auto
43.478 + (* *)
43.479 + moreover
43.480 + have "A = underS ?a"
43.481 + proof
43.482 + show "A \<le> underS ?a"
43.483 + proof(unfold underS_def, auto simp add: 4)
43.484 + fix x assume **: "x \<in> A"
43.485 + hence 11: "x \<in> Field r" using 5 by auto
43.486 + have 12: "x \<noteq> ?a" using 4 ** by auto
43.487 + have 13: "under x \<le> A" using * ofilter_def ** by auto
43.488 + {assume "(x,?a) \<notin> r"
43.489 + hence "(?a,x) \<in> r"
43.490 + using TOTAL total_on_def[of "Field r" r]
43.491 + 2 4 11 12 by auto
43.492 + hence "?a \<in> under x" using under_def by auto
43.493 + hence "?a \<in> A" using ** 13 by blast
43.494 + with 4 have False by simp
43.495 + }
43.496 + thus "(x,?a) \<in> r" by blast
43.497 + qed
43.498 + next
43.499 + show "underS ?a \<le> A"
43.500 + proof(unfold underS_def, auto)
43.501 + fix x
43.502 + assume **: "x \<noteq> ?a" and ***: "(x,?a) \<in> r"
43.503 + hence 11: "x \<in> Field r" using Field_def by fastforce
43.504 + {assume "x \<notin> A"
43.505 + hence "x \<in> ?B" using 11 by auto
43.506 + hence "(?a,x) \<in> r" using 3 minim_least[of ?B x] by blast
43.507 + hence False
43.508 + using ANTISYM antisym_def[of r] ** *** by auto
43.509 + }
43.510 + thus "x \<in> A" by blast
43.511 + qed
43.512 + qed
43.513 + ultimately have ?One using 2 by blast
43.514 + thus ?thesis by simp
43.515 + qed
43.516 +qed
43.517 +
43.518 +
43.519 +lemma ofilter_UNION:
43.520 +"(\<And> i. i \<in> I \<Longrightarrow> ofilter(A i)) \<Longrightarrow> ofilter (\<Union> i \<in> I. A i)"
43.521 +unfolding ofilter_def by blast
43.522 +
43.523 +
43.524 +lemma ofilter_under_UNION:
43.525 +assumes "ofilter A"
43.526 +shows "A = (\<Union> a \<in> A. under a)"
43.527 +proof
43.528 + have "\<forall>a \<in> A. under a \<le> A"
43.529 + using assms ofilter_def by auto
43.530 + thus "(\<Union> a \<in> A. under a) \<le> A" by blast
43.531 +next
43.532 + have "\<forall>a \<in> A. a \<in> under a"
43.533 + using REFL Refl_under_in assms ofilter_def by blast
43.534 + thus "A \<le> (\<Union> a \<in> A. under a)" by blast
43.535 +qed
43.536 +
43.537 +
43.538 +subsubsection{* Other properties *}
43.539 +
43.540 +
43.541 +lemma ofilter_linord:
43.542 +assumes OF1: "ofilter A" and OF2: "ofilter B"
43.543 +shows "A \<le> B \<or> B \<le> A"
43.544 +proof(cases "A = Field r")
43.545 + assume Case1: "A = Field r"
43.546 + hence "B \<le> A" using OF2 ofilter_def by auto
43.547 + thus ?thesis by simp
43.548 +next
43.549 + assume Case2: "A \<noteq> Field r"
43.550 + with ofilter_underS_Field OF1 obtain a where
43.551 + 1: "a \<in> Field r \<and> A = underS a" by auto
43.552 + show ?thesis
43.553 + proof(cases "B = Field r")
43.554 + assume Case21: "B = Field r"
43.555 + hence "A \<le> B" using OF1 ofilter_def by auto
43.556 + thus ?thesis by simp
43.557 + next
43.558 + assume Case22: "B \<noteq> Field r"
43.559 + with ofilter_underS_Field OF2 obtain b where
43.560 + 2: "b \<in> Field r \<and> B = underS b" by auto
43.561 + have "a = b \<or> (a,b) \<in> r \<or> (b,a) \<in> r"
43.562 + using 1 2 TOTAL total_on_def[of _ r] by auto
43.563 + moreover
43.564 + {assume "a = b" with 1 2 have ?thesis by auto
43.565 + }
43.566 + moreover
43.567 + {assume "(a,b) \<in> r"
43.568 + with underS_incr TRANS ANTISYM 1 2
43.569 + have "A \<le> B" by auto
43.570 + hence ?thesis by auto
43.571 + }
43.572 + moreover
43.573 + {assume "(b,a) \<in> r"
43.574 + with underS_incr TRANS ANTISYM 1 2
43.575 + have "B \<le> A" by auto
43.576 + hence ?thesis by auto
43.577 + }
43.578 + ultimately show ?thesis by blast
43.579 + qed
43.580 +qed
43.581 +
43.582 +
43.583 +lemma ofilter_AboveS_Field:
43.584 +assumes "ofilter A"
43.585 +shows "A \<union> (AboveS A) = Field r"
43.586 +proof
43.587 + show "A \<union> (AboveS A) \<le> Field r"
43.588 + using assms ofilter_def AboveS_Field by auto
43.589 +next
43.590 + {fix x assume *: "x \<in> Field r" and **: "x \<notin> A"
43.591 + {fix y assume ***: "y \<in> A"
43.592 + with ** have 1: "y \<noteq> x" by auto
43.593 + {assume "(y,x) \<notin> r"
43.594 + moreover
43.595 + have "y \<in> Field r" using assms ofilter_def *** by auto
43.596 + ultimately have "(x,y) \<in> r"
43.597 + using 1 * TOTAL total_on_def[of _ r] by auto
43.598 + with *** assms ofilter_def under_def have "x \<in> A" by auto
43.599 + with ** have False by contradiction
43.600 + }
43.601 + hence "(y,x) \<in> r" by blast
43.602 + with 1 have "y \<noteq> x \<and> (y,x) \<in> r" by auto
43.603 + }
43.604 + with * have "x \<in> AboveS A" unfolding AboveS_def by auto
43.605 + }
43.606 + thus "Field r \<le> A \<union> (AboveS A)" by blast
43.607 +qed
43.608 +
43.609 +
43.610 +lemma suc_ofilter_in:
43.611 +assumes OF: "ofilter A" and ABOVE_NE: "AboveS A \<noteq> {}" and
43.612 + REL: "(b,suc A) \<in> r" and DIFF: "b \<noteq> suc A"
43.613 +shows "b \<in> A"
43.614 +proof-
43.615 + have *: "suc A \<in> Field r \<and> b \<in> Field r"
43.616 + using WELL REL well_order_on_domain by auto
43.617 + {assume **: "b \<notin> A"
43.618 + hence "b \<in> AboveS A"
43.619 + using OF * ofilter_AboveS_Field by auto
43.620 + hence "(suc A, b) \<in> r"
43.621 + using suc_least_AboveS by auto
43.622 + hence False using REL DIFF ANTISYM *
43.623 + by (auto simp add: antisym_def)
43.624 + }
43.625 + thus ?thesis by blast
43.626 +qed
43.627 +
43.628 +
43.629 +
43.630 +end (* context wo_rel *)
43.631 +
43.632 +
43.633 +
43.634 +end
44.1 --- a/src/HOL/Code_Numeral.thy Mon Nov 18 17:15:01 2013 +0100
44.2 +++ b/src/HOL/Code_Numeral.thy Tue Nov 19 17:07:52 2013 +0100
44.3 @@ -96,10 +96,6 @@
44.4 qed
44.5
44.6 lemma [transfer_rule]:
44.7 - "fun_rel HOL.eq pcr_integer (neg_numeral :: num \<Rightarrow> int) (neg_numeral :: num \<Rightarrow> integer)"
44.8 - by (unfold neg_numeral_def [abs_def]) transfer_prover
44.9 -
44.10 -lemma [transfer_rule]:
44.11 "fun_rel HOL.eq (fun_rel HOL.eq pcr_integer) (Num.sub :: _ \<Rightarrow> _ \<Rightarrow> int) (Num.sub :: _ \<Rightarrow> _ \<Rightarrow> integer)"
44.12 by (unfold Num.sub_def [abs_def]) transfer_prover
44.13
44.14 @@ -147,10 +143,6 @@
44.15 "int_of_integer (numeral k) = numeral k"
44.16 by transfer rule
44.17
44.18 -lemma int_of_integer_neg_numeral [simp]:
44.19 - "int_of_integer (neg_numeral k) = neg_numeral k"
44.20 - by transfer rule
44.21 -
44.22 lemma int_of_integer_sub [simp]:
44.23 "int_of_integer (Num.sub k l) = Num.sub k l"
44.24 by transfer rule
44.25 @@ -253,11 +245,11 @@
44.26
44.27 definition Neg :: "num \<Rightarrow> integer"
44.28 where
44.29 - [simp, code_abbrev]: "Neg = neg_numeral"
44.30 + [simp, code_abbrev]: "Neg n = - Pos n"
44.31
44.32 lemma [transfer_rule]:
44.33 - "fun_rel HOL.eq pcr_integer neg_numeral Neg"
44.34 - by simp transfer_prover
44.35 + "fun_rel HOL.eq pcr_integer (\<lambda>n. - numeral n) Neg"
44.36 + by (simp add: Neg_def [abs_def]) transfer_prover
44.37
44.38 code_datatype "0::integer" Pos Neg
44.39
44.40 @@ -272,7 +264,7 @@
44.41 "dup 0 = 0"
44.42 "dup (Pos n) = Pos (Num.Bit0 n)"
44.43 "dup (Neg n) = Neg (Num.Bit0 n)"
44.44 - by (transfer, simp only: neg_numeral_def numeral_Bit0 minus_add_distrib)+
44.45 + by (transfer, simp only: numeral_Bit0 minus_add_distrib)+
44.46
44.47 lift_definition sub :: "num \<Rightarrow> num \<Rightarrow> integer"
44.48 is "\<lambda>m n. numeral m - numeral n :: int"
45.1 --- a/src/HOL/Complex.thy Mon Nov 18 17:15:01 2013 +0100
45.2 +++ b/src/HOL/Complex.thy Tue Nov 19 17:07:52 2013 +0100
45.3 @@ -108,7 +108,12 @@
45.4 definition complex_divide_def:
45.5 "x / (y\<Colon>complex) = x * inverse y"
45.6
45.7 -lemma Complex_eq_1 [simp]: "(Complex a b = 1) = (a = 1 \<and> b = 0)"
45.8 +lemma Complex_eq_1 [simp]:
45.9 + "Complex a b = 1 \<longleftrightarrow> a = 1 \<and> b = 0"
45.10 + by (simp add: complex_one_def)
45.11 +
45.12 +lemma Complex_eq_neg_1 [simp]:
45.13 + "Complex a b = - 1 \<longleftrightarrow> a = - 1 \<and> b = 0"
45.14 by (simp add: complex_one_def)
45.15
45.16 lemma complex_Re_one [simp]: "Re 1 = 1"
45.17 @@ -166,21 +171,21 @@
45.18 lemma complex_Re_numeral [simp]: "Re (numeral v) = numeral v"
45.19 using complex_Re_of_int [of "numeral v"] by simp
45.20
45.21 -lemma complex_Re_neg_numeral [simp]: "Re (neg_numeral v) = neg_numeral v"
45.22 - using complex_Re_of_int [of "neg_numeral v"] by simp
45.23 +lemma complex_Re_neg_numeral [simp]: "Re (- numeral v) = - numeral v"
45.24 + using complex_Re_of_int [of "- numeral v"] by simp
45.25
45.26 lemma complex_Im_numeral [simp]: "Im (numeral v) = 0"
45.27 using complex_Im_of_int [of "numeral v"] by simp
45.28
45.29 -lemma complex_Im_neg_numeral [simp]: "Im (neg_numeral v) = 0"
45.30 - using complex_Im_of_int [of "neg_numeral v"] by simp
45.31 +lemma complex_Im_neg_numeral [simp]: "Im (- numeral v) = 0"
45.32 + using complex_Im_of_int [of "- numeral v"] by simp
45.33
45.34 lemma Complex_eq_numeral [simp]:
45.35 - "(Complex a b = numeral w) = (a = numeral w \<and> b = 0)"
45.36 + "Complex a b = numeral w \<longleftrightarrow> a = numeral w \<and> b = 0"
45.37 by (simp add: complex_eq_iff)
45.38
45.39 lemma Complex_eq_neg_numeral [simp]:
45.40 - "(Complex a b = neg_numeral w) = (a = neg_numeral w \<and> b = 0)"
45.41 + "Complex a b = - numeral w \<longleftrightarrow> a = - numeral w \<and> b = 0"
45.42 by (simp add: complex_eq_iff)
45.43
45.44
45.45 @@ -421,7 +426,7 @@
45.46 lemma complex_i_not_numeral [simp]: "ii \<noteq> numeral w"
45.47 by (simp add: complex_eq_iff)
45.48
45.49 -lemma complex_i_not_neg_numeral [simp]: "ii \<noteq> neg_numeral w"
45.50 +lemma complex_i_not_neg_numeral [simp]: "ii \<noteq> - numeral w"
45.51 by (simp add: complex_eq_iff)
45.52
45.53 lemma i_mult_Complex [simp]: "ii * Complex a b = Complex (- b) a"
45.54 @@ -508,7 +513,7 @@
45.55 lemma complex_cnj_numeral [simp]: "cnj (numeral w) = numeral w"
45.56 by (simp add: complex_eq_iff)
45.57
45.58 -lemma complex_cnj_neg_numeral [simp]: "cnj (neg_numeral w) = neg_numeral w"
45.59 +lemma complex_cnj_neg_numeral [simp]: "cnj (- numeral w) = - numeral w"
45.60 by (simp add: complex_eq_iff)
45.61
45.62 lemma complex_cnj_scaleR: "cnj (scaleR r x) = scaleR r (cnj x)"
46.1 --- a/src/HOL/Decision_Procs/Approximation.thy Mon Nov 18 17:15:01 2013 +0100
46.2 +++ b/src/HOL/Decision_Procs/Approximation.thy Tue Nov 19 17:07:52 2013 +0100
46.3 @@ -11,8 +11,10 @@
46.4 "~~/src/HOL/Library/Code_Target_Numeral"
46.5 begin
46.6
46.7 -declare powr_numeral[simp]
46.8 -declare powr_neg_numeral[simp]
46.9 +declare powr_one [simp]
46.10 +declare powr_numeral [simp]
46.11 +declare powr_neg_one [simp]
46.12 +declare powr_neg_numeral [simp]
46.13
46.14 section "Horner Scheme"
46.15
46.16 @@ -1261,8 +1263,8 @@
46.17 unfolding cos_periodic_int ..
46.18 also have "\<dots> \<le> cos ((?ux - 2 * ?lpi))"
46.19 using cos_monotone_minus_pi_0'[OF pi_x x_le_ux ux_0]
46.20 - by (simp only: minus_float.rep_eq real_of_int_minus real_of_one minus_one[symmetric]
46.21 - mult_minus_left mult_1_left) simp
46.22 + by (simp only: minus_float.rep_eq real_of_int_minus real_of_one
46.23 + mult_minus_left mult_1_left) simp
46.24 also have "\<dots> = cos ((- (?ux - 2 * ?lpi)))"
46.25 unfolding uminus_float.rep_eq cos_minus ..
46.26 also have "\<dots> \<le> (ub_cos prec (- (?ux - 2 * ?lpi)))"
46.27 @@ -1306,7 +1308,7 @@
46.28 also have "\<dots> \<le> cos ((?lx + 2 * ?lpi))"
46.29 using cos_monotone_0_pi'[OF lx_0 lx_le_x pi_x]
46.30 by (simp only: minus_float.rep_eq real_of_int_minus real_of_one
46.31 - minus_one[symmetric] mult_minus_left mult_1_left) simp
46.32 + mult_minus_left mult_1_left) simp
46.33 also have "\<dots> \<le> (ub_cos prec (?lx + 2 * ?lpi))"
46.34 using lb_cos[OF lx_0 pi_lx] by simp
46.35 finally show ?thesis unfolding u by (simp add: real_of_float_max)
46.36 @@ -2104,8 +2106,9 @@
46.37 lemma interpret_floatarith_num:
46.38 shows "interpret_floatarith (Num (Float 0 0)) vs = 0"
46.39 and "interpret_floatarith (Num (Float 1 0)) vs = 1"
46.40 + and "interpret_floatarith (Num (Float (- 1) 0)) vs = - 1"
46.41 and "interpret_floatarith (Num (Float (numeral a) 0)) vs = numeral a"
46.42 - and "interpret_floatarith (Num (Float (neg_numeral a) 0)) vs = neg_numeral a" by auto
46.43 + and "interpret_floatarith (Num (Float (- numeral a) 0)) vs = - numeral a" by auto
46.44
46.45 subsection "Implement approximation function"
46.46
47.1 --- a/src/HOL/Decision_Procs/Cooper.thy Mon Nov 18 17:15:01 2013 +0100
47.2 +++ b/src/HOL/Decision_Procs/Cooper.thy Tue Nov 19 17:07:52 2013 +0100
47.3 @@ -2006,9 +2006,10 @@
47.4 | SOME n => @{code Bound} (@{code nat_of_integer} n))
47.5 | num_of_term vs @{term "0::int"} = @{code C} (@{code int_of_integer} 0)
47.6 | num_of_term vs @{term "1::int"} = @{code C} (@{code int_of_integer} 1)
47.7 + | num_of_term vs @{term "- 1::int"} = @{code C} (@{code int_of_integer} (~ 1))
47.8 | num_of_term vs (@{term "numeral :: _ \<Rightarrow> int"} $ t) =
47.9 @{code C} (@{code int_of_integer} (HOLogic.dest_num t))
47.10 - | num_of_term vs (@{term "neg_numeral :: _ \<Rightarrow> int"} $ t) =
47.11 + | num_of_term vs (@{term "- numeral :: _ \<Rightarrow> int"} $ t) =
47.12 @{code C} (@{code int_of_integer} (~(HOLogic.dest_num t)))
47.13 | num_of_term vs (Bound i) = @{code Bound} (@{code nat_of_integer} i)
47.14 | num_of_term vs (@{term "uminus :: int \<Rightarrow> int"} $ t') = @{code Neg} (num_of_term vs t')
48.1 --- a/src/HOL/Decision_Procs/MIR.thy Mon Nov 18 17:15:01 2013 +0100
48.2 +++ b/src/HOL/Decision_Procs/MIR.thy Tue Nov 19 17:07:52 2013 +0100
48.3 @@ -3154,7 +3154,7 @@
48.4 hence "\<exists> j1\<in> {1 .. c*d}. real (c*i) = (- ?N i e + real j1) - 1"
48.5 by (simp only: algebra_simps)
48.6 hence "\<exists> j1\<in> {1 .. c*d}. real (c*i) = - 1 - ?N i e + real j1"
48.7 - by (simp add: algebra_simps minus_one [symmetric] del: minus_one)
48.8 + by (simp add: algebra_simps)
48.9 with nob have ?case by blast }
48.10 ultimately show ?case by blast
48.11 next
48.12 @@ -5549,6 +5549,7 @@
48.13 | num_of_term vs @{term "real (1::int)"} = mk_C 1
48.14 | num_of_term vs @{term "0::real"} = mk_C 0
48.15 | num_of_term vs @{term "1::real"} = mk_C 1
48.16 + | num_of_term vs @{term "- 1::real"} = mk_C (~ 1)
48.17 | num_of_term vs (Bound i) = mk_Bound i
48.18 | num_of_term vs (@{term "uminus :: real \<Rightarrow> real"} $ t') = @{code Neg} (num_of_term vs t')
48.19 | num_of_term vs (@{term "op + :: real \<Rightarrow> real \<Rightarrow> real"} $ t1 $ t2) =
48.20 @@ -5561,7 +5562,7 @@
48.21 | _ => error "num_of_term: unsupported Multiplication")
48.22 | num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ (@{term "numeral :: _ \<Rightarrow> int"} $ t')) =
48.23 mk_C (HOLogic.dest_num t')
48.24 - | num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ (@{term "neg_numeral :: _ \<Rightarrow> int"} $ t')) =
48.25 + | num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ (@{term "- numeral :: _ \<Rightarrow> int"} $ t')) =
48.26 mk_C (~ (HOLogic.dest_num t'))
48.27 | num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ (@{term "floor :: real \<Rightarrow> int"} $ t')) =
48.28 @{code Floor} (num_of_term vs t')
48.29 @@ -5569,7 +5570,7 @@
48.30 @{code Neg} (@{code Floor} (@{code Neg} (num_of_term vs t')))
48.31 | num_of_term vs (@{term "numeral :: _ \<Rightarrow> real"} $ t') =
48.32 mk_C (HOLogic.dest_num t')
48.33 - | num_of_term vs (@{term "neg_numeral :: _ \<Rightarrow> real"} $ t') =
48.34 + | num_of_term vs (@{term "- numeral :: _ \<Rightarrow> real"} $ t') =
48.35 mk_C (~ (HOLogic.dest_num t'))
48.36 | num_of_term vs t = error ("num_of_term: unknown term " ^ Syntax.string_of_term @{context} t);
48.37
48.38 @@ -5583,7 +5584,7 @@
48.39 @{code Eq} (@{code Sub} (num_of_term vs t1, num_of_term vs t2))
48.40 | fm_of_term vs (@{term "op rdvd"} $ (@{term "real :: int \<Rightarrow> real"} $ (@{term "numeral :: _ \<Rightarrow> int"} $ t1)) $ t2) =
48.41 mk_Dvd (HOLogic.dest_num t1, num_of_term vs t2)
48.42 - | fm_of_term vs (@{term "op rdvd"} $ (@{term "real :: int \<Rightarrow> real"} $ (@{term "neg_numeral :: _ \<Rightarrow> int"} $ t1)) $ t2) =
48.43 + | fm_of_term vs (@{term "op rdvd"} $ (@{term "real :: int \<Rightarrow> real"} $ (@{term "- numeral :: _ \<Rightarrow> int"} $ t1)) $ t2) =
48.44 mk_Dvd (~ (HOLogic.dest_num t1), num_of_term vs t2)
48.45 | fm_of_term vs (@{term "op = :: bool \<Rightarrow> bool \<Rightarrow> bool"} $ t1 $ t2) =
48.46 @{code Iff} (fm_of_term vs t1, fm_of_term vs t2)
49.1 --- a/src/HOL/Decision_Procs/Reflected_Multivariate_Polynomial.thy Mon Nov 18 17:15:01 2013 +0100
49.2 +++ b/src/HOL/Decision_Procs/Reflected_Multivariate_Polynomial.thy Tue Nov 19 17:07:52 2013 +0100
49.3 @@ -1256,12 +1256,10 @@
49.4 apply (case_tac n', simp, simp)
49.5 apply (case_tac n, simp, simp)
49.6 apply (case_tac n, case_tac n', simp add: Let_def)
49.7 - apply (case_tac "pa +\<^sub>p p' = 0\<^sub>p")
49.8 - apply (auto simp add: polyadd_eq_const_degree)
49.9 + apply (auto simp add: polyadd_eq_const_degree)[2]
49.10 apply (metis head_nz)
49.11 apply (metis head_nz)
49.12 apply (metis degree.simps(9) gr0_conv_Suc head.simps(1) less_Suc0 not_less_eq)
49.13 - apply (metis degree.simps(9) gr0_conv_Suc nat_less_le order_le_less_trans)
49.14 done
49.15
49.16 lemma polymul_head_polyeq:
50.1 --- a/src/HOL/Divides.thy Mon Nov 18 17:15:01 2013 +0100
50.2 +++ b/src/HOL/Divides.thy Tue Nov 19 17:07:52 2013 +0100
50.3 @@ -1919,10 +1919,9 @@
50.4 val zero = @{term "0 :: int"}
50.5 val less = @{term "op < :: int \<Rightarrow> int \<Rightarrow> bool"}
50.6 val le = @{term "op \<le> :: int \<Rightarrow> int \<Rightarrow> bool"}
50.7 - val simps = @{thms arith_simps} @ @{thms rel_simps} @
50.8 - map (fn th => th RS sym) [@{thm numeral_1_eq_1}]
50.9 - fun prove ctxt goal = Goal.prove ctxt [] [] (HOLogic.mk_Trueprop goal)
50.10 - (K (ALLGOALS (full_simp_tac (put_simpset HOL_basic_ss ctxt addsimps simps))));
50.11 + val simps = @{thms arith_simps} @ @{thms rel_simps} @ [@{thm numeral_1_eq_1 [symmetric]}]
50.12 + fun prove ctxt goal = (writeln "prove"; Goal.prove ctxt [] [] (HOLogic.mk_Trueprop goal)
50.13 + (K (ALLGOALS (full_simp_tac (put_simpset HOL_basic_ss ctxt addsimps simps)))));
50.14 fun binary_proc proc ctxt ct =
50.15 (case Thm.term_of ct of
50.16 _ $ t $ u =>
50.17 @@ -1945,23 +1944,23 @@
50.18
50.19 simproc_setup binary_int_div
50.20 ("numeral m div numeral n :: int" |
50.21 - "numeral m div neg_numeral n :: int" |
50.22 - "neg_numeral m div numeral n :: int" |
50.23 - "neg_numeral m div neg_numeral n :: int") =
50.24 + "numeral m div - numeral n :: int" |
50.25 + "- numeral m div numeral n :: int" |
50.26 + "- numeral m div - numeral n :: int") =
50.27 {* K (divmod_proc @{thm int_div_pos_eq} @{thm int_div_neg_eq}) *}
50.28
50.29 simproc_setup binary_int_mod
50.30 ("numeral m mod numeral n :: int" |
50.31 - "numeral m mod neg_numeral n :: int" |
50.32 - "neg_numeral m mod numeral n :: int" |
50.33 - "neg_numeral m mod neg_numeral n :: int") =
50.34 + "numeral m mod - numeral n :: int" |
50.35 + "- numeral m mod numeral n :: int" |
50.36 + "- numeral m mod - numeral n :: int") =
50.37 {* K (divmod_proc @{thm int_mod_pos_eq} @{thm int_mod_neg_eq}) *}
50.38
50.39 lemmas posDivAlg_eqn_numeral [simp] =
50.40 posDivAlg_eqn [of "numeral v" "numeral w", OF zero_less_numeral] for v w
50.41
50.42 lemmas negDivAlg_eqn_numeral [simp] =
50.43 - negDivAlg_eqn [of "numeral v" "neg_numeral w", OF zero_less_numeral] for v w
50.44 + negDivAlg_eqn [of "numeral v" "- numeral w", OF zero_less_numeral] for v w
50.45
50.46
50.47 text{*Special-case simplification *}
50.48 @@ -1973,14 +1972,14 @@
50.49 div_pos_pos [OF zero_less_one, of "numeral w", OF zero_le_numeral] for w
50.50
50.51 lemmas div_pos_neg_1_numeral [simp] =
50.52 - div_pos_neg [OF zero_less_one, of "neg_numeral w",
50.53 + div_pos_neg [OF zero_less_one, of "- numeral w",
50.54 OF neg_numeral_less_zero] for w
50.55
50.56 lemmas mod_pos_pos_1_numeral [simp] =
50.57 mod_pos_pos [OF zero_less_one, of "numeral w", OF zero_le_numeral] for w
50.58
50.59 lemmas mod_pos_neg_1_numeral [simp] =
50.60 - mod_pos_neg [OF zero_less_one, of "neg_numeral w",
50.61 + mod_pos_neg [OF zero_less_one, of "- numeral w",
50.62 OF neg_numeral_less_zero] for w
50.63
50.64 lemmas posDivAlg_eqn_1_numeral [simp] =
50.65 @@ -2290,6 +2289,8 @@
50.66 shows "divmod_int_rel (1 + 2*a) (2*b) (q, 1 + 2*r)"
50.67 using assms unfolding divmod_int_rel_def by auto
50.68
50.69 +declaration {* K (Lin_Arith.add_simps @{thms uminus_numeral_One}) *}
50.70 +
50.71 lemma neg_divmod_int_rel_mult_2:
50.72 assumes "b \<le> 0"
50.73 assumes "divmod_int_rel (a + 1) b (q, r)"
50.74 @@ -2427,13 +2428,13 @@
50.75
50.76 lemma dvd_neg_numeral_left [simp]:
50.77 fixes y :: "'a::comm_ring_1"
50.78 - shows "(neg_numeral k) dvd y \<longleftrightarrow> (numeral k) dvd y"
50.79 - unfolding neg_numeral_def minus_dvd_iff ..
50.80 + shows "(- numeral k) dvd y \<longleftrightarrow> (numeral k) dvd y"
50.81 + by (fact minus_dvd_iff)
50.82
50.83 lemma dvd_neg_numeral_right [simp]:
50.84 fixes x :: "'a::comm_ring_1"
50.85 - shows "x dvd (neg_numeral k) \<longleftrightarrow> x dvd (numeral k)"
50.86 - unfolding neg_numeral_def dvd_minus_iff ..
50.87 + shows "x dvd (- numeral k) \<longleftrightarrow> x dvd (numeral k)"
50.88 + by (fact dvd_minus_iff)
50.89
50.90 lemmas dvd_eq_mod_eq_0_numeral [simp] =
50.91 dvd_eq_mod_eq_0 [of "numeral x" "numeral y"] for x y
51.1 --- a/src/HOL/GCD.thy Mon Nov 18 17:15:01 2013 +0100
51.2 +++ b/src/HOL/GCD.thy Tue Nov 19 17:07:52 2013 +0100
51.3 @@ -134,6 +134,14 @@
51.4 lemma gcd_neg2_int [simp]: "gcd (x::int) (-y) = gcd x y"
51.5 by (simp add: gcd_int_def)
51.6
51.7 +lemma gcd_neg_numeral_1_int [simp]:
51.8 + "gcd (- numeral n :: int) x = gcd (numeral n) x"
51.9 + by (fact gcd_neg1_int)
51.10 +
51.11 +lemma gcd_neg_numeral_2_int [simp]:
51.12 + "gcd x (- numeral n :: int) = gcd x (numeral n)"
51.13 + by (fact gcd_neg2_int)
51.14 +
51.15 lemma abs_gcd_int[simp]: "abs(gcd (x::int) y) = gcd x y"
51.16 by(simp add: gcd_int_def)
51.17
52.1 --- a/src/HOL/IMP/Hoare_Examples.thy Mon Nov 18 17:15:01 2013 +0100
52.2 +++ b/src/HOL/IMP/Hoare_Examples.thy Tue Nov 19 17:07:52 2013 +0100
52.3 @@ -2,17 +2,6 @@
52.4
52.5 theory Hoare_Examples imports Hoare begin
52.6
52.7 -text{* Improves proof automation for negative numerals: *}
52.8 -
52.9 -lemma add_neg1R[simp]:
52.10 - "x + -1 = x - (1 :: int)"
52.11 -by arith
52.12 -
52.13 -lemma add_neg_numeralR[simp]:
52.14 - "x + neg_numeral n = (x::'a::neg_numeral) - numeral(n)"
52.15 -by (simp only: diff_minus_eq_add[symmetric] minus_neg_numeral)
52.16 -
52.17 -
52.18 text{* Summing up the first @{text x} natural numbers in variable @{text y}. *}
52.19
52.20 fun sum :: "int \<Rightarrow> int" where
53.1 --- a/src/HOL/Int.thy Mon Nov 18 17:15:01 2013 +0100
53.2 +++ b/src/HOL/Int.thy Tue Nov 19 17:07:52 2013 +0100
53.3 @@ -232,9 +232,8 @@
53.4 lemma of_int_numeral [simp, code_post]: "of_int (numeral k) = numeral k"
53.5 by (simp add: of_nat_numeral [symmetric] of_int_of_nat_eq [symmetric])
53.6
53.7 -lemma of_int_neg_numeral [simp, code_post]: "of_int (neg_numeral k) = neg_numeral k"
53.8 - unfolding neg_numeral_def neg_numeral_class.neg_numeral_def
53.9 - by (simp only: of_int_minus of_int_numeral)
53.10 +lemma of_int_neg_numeral [code_post]: "of_int (- numeral k) = - numeral k"
53.11 + by simp
53.12
53.13 lemma of_int_power:
53.14 "of_int (z ^ n) = of_int z ^ n"
53.15 @@ -370,7 +369,7 @@
53.16 by (simp add: nat_eq_iff)
53.17
53.18 lemma nat_neg_numeral [simp]:
53.19 - "nat (neg_numeral k) = 0"
53.20 + "nat (- numeral k) = 0"
53.21 by simp
53.22
53.23 lemma nat_2: "nat 2 = Suc (Suc 0)"
53.24 @@ -511,13 +510,13 @@
53.25
53.26 lemma nonneg_int_cases:
53.27 assumes "0 \<le> k" obtains n where "k = int n"
53.28 - using assms by (cases k, simp, simp del: of_nat_Suc)
53.29 + using assms by (rule nonneg_eq_int)
53.30
53.31 lemma Let_numeral [simp]: "Let (numeral v) f = f (numeral v)"
53.32 -- {* Unfold all @{text let}s involving constants *}
53.33 unfolding Let_def ..
53.34
53.35 -lemma Let_neg_numeral [simp]: "Let (neg_numeral v) f = f (neg_numeral v)"
53.36 +lemma Let_neg_numeral [simp]: "Let (- numeral v) f = f (- numeral v)"
53.37 -- {* Unfold all @{text let}s involving constants *}
53.38 unfolding Let_def ..
53.39
53.40 @@ -525,15 +524,15 @@
53.41
53.42 lemmas max_number_of [simp] =
53.43 max_def [of "numeral u" "numeral v"]
53.44 - max_def [of "numeral u" "neg_numeral v"]
53.45 - max_def [of "neg_numeral u" "numeral v"]
53.46 - max_def [of "neg_numeral u" "neg_numeral v"] for u v
53.47 + max_def [of "numeral u" "- numeral v"]
53.48 + max_def [of "- numeral u" "numeral v"]
53.49 + max_def [of "- numeral u" "- numeral v"] for u v
53.50
53.51 lemmas min_number_of [simp] =
53.52 min_def [of "numeral u" "numeral v"]
53.53 - min_def [of "numeral u" "neg_numeral v"]
53.54 - min_def [of "neg_numeral u" "numeral v"]
53.55 - min_def [of "neg_numeral u" "neg_numeral v"] for u v
53.56 + min_def [of "numeral u" "- numeral v"]
53.57 + min_def [of "- numeral u" "numeral v"]
53.58 + min_def [of "- numeral u" "- numeral v"] for u v
53.59
53.60
53.61 subsubsection {* Binary comparisons *}
53.62 @@ -1070,8 +1069,6 @@
53.63 by auto
53.64 qed
53.65
53.66 -ML_val {* @{const_name neg_numeral} *}
53.67 -
53.68 lemma pos_zmult_eq_1_iff_lemma: "(m * n = 1) ==> m = (1::int) | m = -1"
53.69 by (insert abs_zmult_eq_1 [of m n], arith)
53.70
53.71 @@ -1127,62 +1124,30 @@
53.72 inverse_eq_divide [of "numeral w"] for w
53.73
53.74 lemmas inverse_eq_divide_neg_numeral [simp] =
53.75 - inverse_eq_divide [of "neg_numeral w"] for w
53.76 + inverse_eq_divide [of "- numeral w"] for w
53.77
53.78 text {*These laws simplify inequalities, moving unary minus from a term
53.79 into the literal.*}
53.80
53.81 -lemmas le_minus_iff_numeral [simp, no_atp] =
53.82 - le_minus_iff [of "numeral v"]
53.83 - le_minus_iff [of "neg_numeral v"] for v
53.84 +lemmas equation_minus_iff_numeral [no_atp] =
53.85 + equation_minus_iff [of "numeral v"] for v
53.86
53.87 -lemmas equation_minus_iff_numeral [simp, no_atp] =
53.88 - equation_minus_iff [of "numeral v"]
53.89 - equation_minus_iff [of "neg_numeral v"] for v
53.90 +lemmas minus_equation_iff_numeral [no_atp] =
53.91 + minus_equation_iff [of _ "numeral v"] for v
53.92
53.93 -lemmas minus_less_iff_numeral [simp, no_atp] =
53.94 - minus_less_iff [of _ "numeral v"]
53.95 - minus_less_iff [of _ "neg_numeral v"] for v
53.96 +lemmas le_minus_iff_numeral [no_atp] =
53.97 + le_minus_iff [of "numeral v"] for v
53.98
53.99 -lemmas minus_le_iff_numeral [simp, no_atp] =
53.100 - minus_le_iff [of _ "numeral v"]
53.101 - minus_le_iff [of _ "neg_numeral v"] for v
53.102 +lemmas minus_le_iff_numeral [no_atp] =
53.103 + minus_le_iff [of _ "numeral v"] for v
53.104
53.105 -lemmas minus_equation_iff_numeral [simp, no_atp] =
53.106 - minus_equation_iff [of _ "numeral v"]
53.107 - minus_equation_iff [of _ "neg_numeral v"] for v
53.108 +lemmas less_minus_iff_numeral [no_atp] =
53.109 + less_minus_iff [of "numeral v"] for v
53.110
53.111 -text{*To Simplify Inequalities Where One Side is the Constant 1*}
53.112 +lemmas minus_less_iff_numeral [no_atp] =
53.113 + minus_less_iff [of _ "numeral v"] for v
53.114
53.115 -lemma less_minus_iff_1 [simp]:
53.116 - fixes b::"'b::linordered_idom"
53.117 - shows "(1 < - b) = (b < -1)"
53.118 -by auto
53.119 -
53.120 -lemma le_minus_iff_1 [simp]:
53.121 - fixes b::"'b::linordered_idom"
53.122 - shows "(1 \<le> - b) = (b \<le> -1)"
53.123 -by auto
53.124 -
53.125 -lemma equation_minus_iff_1 [simp]:
53.126 - fixes b::"'b::ring_1"
53.127 - shows "(1 = - b) = (b = -1)"
53.128 -by (subst equation_minus_iff, auto)
53.129 -
53.130 -lemma minus_less_iff_1 [simp]:
53.131 - fixes a::"'b::linordered_idom"
53.132 - shows "(- a < 1) = (-1 < a)"
53.133 -by auto
53.134 -
53.135 -lemma minus_le_iff_1 [simp]:
53.136 - fixes a::"'b::linordered_idom"
53.137 - shows "(- a \<le> 1) = (-1 \<le> a)"
53.138 -by auto
53.139 -
53.140 -lemma minus_equation_iff_1 [simp]:
53.141 - fixes a::"'b::ring_1"
53.142 - shows "(- a = 1) = (a = -1)"
53.143 -by (subst minus_equation_iff, auto)
53.144 +-- {* FIXME maybe simproc *}
53.145
53.146
53.147 text {*Cancellation of constant factors in comparisons (@{text "<"} and @{text "\<le>"}) *}
53.148 @@ -1197,27 +1162,28 @@
53.149
53.150 lemmas le_divide_eq_numeral1 [simp] =
53.151 pos_le_divide_eq [of "numeral w", OF zero_less_numeral]
53.152 - neg_le_divide_eq [of "neg_numeral w", OF neg_numeral_less_zero] for w
53.153 + neg_le_divide_eq [of "- numeral w", OF neg_numeral_less_zero] for w
53.154
53.155 lemmas divide_le_eq_numeral1 [simp] =
53.156 pos_divide_le_eq [of "numeral w", OF zero_less_numeral]
53.157 - neg_divide_le_eq [of "neg_numeral w", OF neg_numeral_less_zero] for w
53.158 + neg_divide_le_eq [of "- numeral w", OF neg_numeral_less_zero] for w
53.159
53.160 lemmas less_divide_eq_numeral1 [simp] =
53.161 pos_less_divide_eq [of "numeral w", OF zero_less_numeral]
53.162 - neg_less_divide_eq [of "neg_numeral w", OF neg_numeral_less_zero] for w
53.163 + neg_less_divide_eq [of "- numeral w", OF neg_numeral_less_zero] for w
53.164
53.165 lemmas divide_less_eq_numeral1 [simp] =
53.166 pos_divide_less_eq [of "numeral w", OF zero_less_numeral]
53.167 - neg_divide_less_eq [of "neg_numeral w", OF neg_numeral_less_zero] for w
53.168 + neg_divide_less_eq [of "- numeral w", OF neg_numeral_less_zero] for w
53.169
53.170 lemmas eq_divide_eq_numeral1 [simp] =
53.171 eq_divide_eq [of _ _ "numeral w"]
53.172 - eq_divide_eq [of _ _ "neg_numeral w"] for w
53.173 + eq_divide_eq [of _ _ "- numeral w"] for w
53.174
53.175 lemmas divide_eq_eq_numeral1 [simp] =
53.176 divide_eq_eq [of _ "numeral w"]
53.177 - divide_eq_eq [of _ "neg_numeral w"] for w
53.178 + divide_eq_eq [of _ "- numeral w"] for w
53.179 +
53.180
53.181 subsubsection{*Optional Simplification Rules Involving Constants*}
53.182
53.183 @@ -1225,27 +1191,27 @@
53.184
53.185 lemmas le_divide_eq_numeral =
53.186 le_divide_eq [of "numeral w"]
53.187 - le_divide_eq [of "neg_numeral w"] for w
53.188 + le_divide_eq [of "- numeral w"] for w
53.189
53.190 lemmas divide_le_eq_numeral =
53.191 divide_le_eq [of _ _ "numeral w"]
53.192 - divide_le_eq [of _ _ "neg_numeral w"] for w
53.193 + divide_le_eq [of _ _ "- numeral w"] for w
53.194
53.195 lemmas less_divide_eq_numeral =
53.196 less_divide_eq [of "numeral w"]
53.197 - less_divide_eq [of "neg_numeral w"] for w
53.198 + less_divide_eq [of "- numeral w"] for w
53.199
53.200 lemmas divide_less_eq_numeral =
53.201 divide_less_eq [of _ _ "numeral w"]
53.202 - divide_less_eq [of _ _ "neg_numeral w"] for w
53.203 + divide_less_eq [of _ _ "- numeral w"] for w
53.204
53.205 lemmas eq_divide_eq_numeral =
53.206 eq_divide_eq [of "numeral w"]
53.207 - eq_divide_eq [of "neg_numeral w"] for w
53.208 + eq_divide_eq [of "- numeral w"] for w
53.209
53.210 lemmas divide_eq_eq_numeral =
53.211 divide_eq_eq [of _ _ "numeral w"]
53.212 - divide_eq_eq [of _ _ "neg_numeral w"] for w
53.213 + divide_eq_eq [of _ _ "- numeral w"] for w
53.214
53.215
53.216 text{*Not good as automatic simprules because they cause case splits.*}
53.217 @@ -1257,21 +1223,20 @@
53.218 text{*Division By @{text "-1"}*}
53.219
53.220 lemma divide_minus1 [simp]: "(x::'a::field) / -1 = - x"
53.221 - unfolding minus_one [symmetric]
53.222 unfolding nonzero_minus_divide_right [OF one_neq_zero, symmetric]
53.223 by simp
53.224
53.225 lemma minus1_divide [simp]: "-1 / (x::'a::field) = - (1 / x)"
53.226 - unfolding minus_one [symmetric] by (rule divide_minus_left)
53.227 + by (fact divide_minus_left)
53.228
53.229 lemma half_gt_zero_iff:
53.230 - "(0 < r/2) = (0 < (r::'a::linordered_field_inverse_zero))"
53.231 -by auto
53.232 + "(0 < r/2) = (0 < (r::'a::linordered_field_inverse_zero))"
53.233 + by auto
53.234
53.235 lemmas half_gt_zero [simp] = half_gt_zero_iff [THEN iffD2]
53.236
53.237 lemma divide_Numeral1: "(x::'a::field) / Numeral1 = x"
53.238 - by simp
53.239 + by (fact divide_numeral_1)
53.240
53.241
53.242 subsection {* The divides relation *}
53.243 @@ -1475,7 +1440,7 @@
53.244 [simp, code_abbrev]: "Pos = numeral"
53.245
53.246 definition Neg :: "num \<Rightarrow> int" where
53.247 - [simp, code_abbrev]: "Neg = neg_numeral"
53.248 + [simp, code_abbrev]: "Neg n = - (Pos n)"
53.249
53.250 code_datatype "0::int" Pos Neg
53.251
53.252 @@ -1489,7 +1454,7 @@
53.253 "dup 0 = 0"
53.254 "dup (Pos n) = Pos (Num.Bit0 n)"
53.255 "dup (Neg n) = Neg (Num.Bit0 n)"
53.256 - unfolding Pos_def Neg_def neg_numeral_def
53.257 + unfolding Pos_def Neg_def
53.258 by (simp_all add: numeral_Bit0)
53.259
53.260 definition sub :: "num \<Rightarrow> num \<Rightarrow> int" where
53.261 @@ -1505,12 +1470,10 @@
53.262 "sub (Num.Bit1 m) (Num.Bit1 n) = dup (sub m n)"
53.263 "sub (Num.Bit1 m) (Num.Bit0 n) = dup (sub m n) + 1"
53.264 "sub (Num.Bit0 m) (Num.Bit1 n) = dup (sub m n) - 1"
53.265 - apply (simp_all only: sub_def dup_def numeral.simps Pos_def Neg_def
53.266 - neg_numeral_def numeral_BitM)
53.267 + apply (simp_all only: sub_def dup_def numeral.simps Pos_def Neg_def numeral_BitM)
53.268 apply (simp_all only: algebra_simps minus_diff_eq)
53.269 apply (simp_all only: add.commute [of _ "- (numeral n + numeral n)"])
53.270 apply (simp_all only: minus_add add.assoc left_minus)
53.271 - apply (simp_all only: algebra_simps right_minus)
53.272 done
53.273
53.274 text {* Implementations *}
53.275 @@ -1606,10 +1569,10 @@
53.276 "nat (Int.Neg k) = 0"
53.277 "nat 0 = 0"
53.278 "nat (Int.Pos k) = nat_of_num k"
53.279 - by (simp_all add: nat_of_num_numeral nat_numeral)
53.280 + by (simp_all add: nat_of_num_numeral)
53.281
53.282 lemma (in ring_1) of_int_code [code]:
53.283 - "of_int (Int.Neg k) = neg_numeral k"
53.284 + "of_int (Int.Neg k) = - numeral k"
53.285 "of_int 0 = 0"
53.286 "of_int (Int.Pos k) = numeral k"
53.287 by simp_all
53.288 @@ -1653,7 +1616,7 @@
53.289
53.290 lemma int_power:
53.291 "int (m ^ n) = int m ^ n"
53.292 - by (rule of_nat_power)
53.293 + by (fact of_nat_power)
53.294
53.295 lemmas zpower_int = int_power [symmetric]
53.296
54.1 --- a/src/HOL/Library/Binomial.thy Mon Nov 18 17:15:01 2013 +0100
54.2 +++ b/src/HOL/Library/Binomial.thy Tue Nov 19 17:07:52 2013 +0100
54.3 @@ -370,7 +370,7 @@
54.4 by auto
54.5 from False show ?thesis
54.6 by (simp add: pochhammer_def gbinomial_def field_simps
54.7 - eq setprod_timesf[symmetric] del: minus_one)
54.8 + eq setprod_timesf[symmetric])
54.9 qed
54.10
54.11 lemma binomial_fact_lemma: "k \<le> n \<Longrightarrow> fact k * fact (n - k) * (n choose k) = fact n"
54.12 @@ -441,9 +441,9 @@
54.13 from eq[symmetric]
54.14 have ?thesis using kn
54.15 apply (simp add: binomial_fact[OF kn, where ?'a = 'a]
54.16 - gbinomial_pochhammer field_simps pochhammer_Suc_setprod del: minus_one)
54.17 + gbinomial_pochhammer field_simps pochhammer_Suc_setprod)
54.18 apply (simp add: pochhammer_Suc_setprod fact_altdef_nat h
54.19 - of_nat_setprod setprod_timesf[symmetric] eq' del: One_nat_def power_Suc del: minus_one)
54.20 + of_nat_setprod setprod_timesf[symmetric] eq' del: One_nat_def power_Suc)
54.21 unfolding setprod_Un_disjoint[OF th0, unfolded eq3, of "of_nat:: nat \<Rightarrow> 'a"] eq[unfolded h]
54.22 unfolding mult_assoc[symmetric]
54.23 unfolding setprod_timesf[symmetric]
55.1 --- a/src/HOL/Library/Bit.thy Mon Nov 18 17:15:01 2013 +0100
55.2 +++ b/src/HOL/Library/Bit.thy Tue Nov 19 17:07:52 2013 +0100
55.3 @@ -147,11 +147,11 @@
55.4
55.5 text {* All numerals reduce to either 0 or 1. *}
55.6
55.7 -lemma bit_minus1 [simp]: "-1 = (1 :: bit)"
55.8 - by (simp only: minus_one [symmetric] uminus_bit_def)
55.9 +lemma bit_minus1 [simp]: "- 1 = (1 :: bit)"
55.10 + by (simp only: uminus_bit_def)
55.11
55.12 -lemma bit_neg_numeral [simp]: "(neg_numeral w :: bit) = numeral w"
55.13 - by (simp only: neg_numeral_def uminus_bit_def)
55.14 +lemma bit_neg_numeral [simp]: "(- numeral w :: bit) = numeral w"
55.15 + by (simp only: uminus_bit_def)
55.16
55.17 lemma bit_numeral_even [simp]: "numeral (Num.Bit0 w) = (0 :: bit)"
55.18 by (simp only: numeral_Bit0 bit_add_self)
56.1 --- a/src/HOL/Library/Code_Prolog.thy Mon Nov 18 17:15:01 2013 +0100
56.2 +++ b/src/HOL/Library/Code_Prolog.thy Tue Nov 19 17:07:52 2013 +0100
56.3 @@ -12,10 +12,8 @@
56.4
56.5 section {* Setup for Numerals *}
56.6
56.7 -setup {* Predicate_Compile_Data.ignore_consts
56.8 - [@{const_name numeral}, @{const_name neg_numeral}] *}
56.9 +setup {* Predicate_Compile_Data.ignore_consts [@{const_name numeral}] *}
56.10
56.11 -setup {* Predicate_Compile_Data.keep_functions
56.12 - [@{const_name numeral}, @{const_name neg_numeral}] *}
56.13 +setup {* Predicate_Compile_Data.keep_functions [@{const_name numeral}] *}
56.14
56.15 end
57.1 --- a/src/HOL/Library/Code_Real_Approx_By_Float.thy Mon Nov 18 17:15:01 2013 +0100
57.2 +++ b/src/HOL/Library/Code_Real_Approx_By_Float.thy Tue Nov 19 17:07:52 2013 +0100
57.3 @@ -169,7 +169,7 @@
57.4 by simp
57.5
57.6 lemma [code_unfold del]:
57.7 - "neg_numeral k \<equiv> (of_rat (neg_numeral k) :: real)"
57.8 + "- numeral k \<equiv> (of_rat (- numeral k) :: real)"
57.9 by simp
57.10
57.11 hide_const (open) real_of_int
58.1 --- a/src/HOL/Library/Code_Target_Int.thy Mon Nov 18 17:15:01 2013 +0100
58.2 +++ b/src/HOL/Library/Code_Target_Int.thy Tue Nov 19 17:07:52 2013 +0100
58.3 @@ -30,7 +30,7 @@
58.4 by transfer simp
58.5
58.6 lemma [code_abbrev]:
58.7 - "int_of_integer (neg_numeral k) = Int.Neg k"
58.8 + "int_of_integer (- numeral k) = Int.Neg k"
58.9 by transfer simp
58.10
58.11 lemma [code, symmetric, code_post]:
59.1 --- a/src/HOL/Library/Extended.thy Mon Nov 18 17:15:01 2013 +0100
59.2 +++ b/src/HOL/Library/Extended.thy Tue Nov 19 17:07:52 2013 +0100
59.3 @@ -161,8 +161,8 @@
59.4 apply (simp only: numeral_inc one_extended_def plus_extended.simps(1)[symmetric])
59.5 done
59.6
59.7 -lemma Fin_neg_numeral: "Fin(neg_numeral w) = - numeral w"
59.8 -by (simp only: Fin_numeral minus_numeral[symmetric] uminus_extended.simps[symmetric])
59.9 +lemma Fin_neg_numeral: "Fin (- numeral w) = - numeral w"
59.10 +by (simp only: Fin_numeral uminus_extended.simps[symmetric])
59.11
59.12
59.13 instantiation extended :: (lattice)bounded_lattice
60.1 --- a/src/HOL/Library/Float.thy Mon Nov 18 17:15:01 2013 +0100
60.2 +++ b/src/HOL/Library/Float.thy Tue Nov 19 17:07:52 2013 +0100
60.3 @@ -45,7 +45,7 @@
60.4 lemma zero_float[simp]: "0 \<in> float" by (auto simp: float_def)
60.5 lemma one_float[simp]: "1 \<in> float" by (intro floatI[of 1 0]) simp
60.6 lemma numeral_float[simp]: "numeral i \<in> float" by (intro floatI[of "numeral i" 0]) simp
60.7 -lemma neg_numeral_float[simp]: "neg_numeral i \<in> float" by (intro floatI[of "neg_numeral i" 0]) simp
60.8 +lemma neg_numeral_float[simp]: "- numeral i \<in> float" by (intro floatI[of "- numeral i" 0]) simp
60.9 lemma real_of_int_float[simp]: "real (x :: int) \<in> float" by (intro floatI[of x 0]) simp
60.10 lemma real_of_nat_float[simp]: "real (x :: nat) \<in> float" by (intro floatI[of x 0]) simp
60.11 lemma two_powr_int_float[simp]: "2 powr (real (i::int)) \<in> float" by (intro floatI[of 1 i]) simp
60.12 @@ -53,7 +53,7 @@
60.13 lemma two_powr_minus_int_float[simp]: "2 powr - (real (i::int)) \<in> float" by (intro floatI[of 1 "-i"]) simp
60.14 lemma two_powr_minus_nat_float[simp]: "2 powr - (real (i::nat)) \<in> float" by (intro floatI[of 1 "-i"]) simp
60.15 lemma two_powr_numeral_float[simp]: "2 powr numeral i \<in> float" by (intro floatI[of 1 "numeral i"]) simp
60.16 -lemma two_powr_neg_numeral_float[simp]: "2 powr neg_numeral i \<in> float" by (intro floatI[of 1 "neg_numeral i"]) simp
60.17 +lemma two_powr_neg_numeral_float[simp]: "2 powr - numeral i \<in> float" by (intro floatI[of 1 "- numeral i"]) simp
60.18 lemma two_pow_float[simp]: "2 ^ n \<in> float" by (intro floatI[of 1 "n"]) (simp add: powr_realpow)
60.19 lemma real_of_float_float[simp]: "real (f::float) \<in> float" by (cases f) simp
60.20
60.21 @@ -121,11 +121,11 @@
60.22 qed
60.23
60.24 lemma div_neg_numeral_Bit0_float[simp]:
60.25 - assumes x: "x / numeral n \<in> float" shows "x / (neg_numeral (Num.Bit0 n)) \<in> float"
60.26 + assumes x: "x / numeral n \<in> float" shows "x / (- numeral (Num.Bit0 n)) \<in> float"
60.27 proof -
60.28 have "- (x / numeral (Num.Bit0 n)) \<in> float" using x by simp
60.29 - also have "- (x / numeral (Num.Bit0 n)) = x / neg_numeral (Num.Bit0 n)"
60.30 - unfolding neg_numeral_def by (simp del: minus_numeral)
60.31 + also have "- (x / numeral (Num.Bit0 n)) = x / - numeral (Num.Bit0 n)"
60.32 + by simp
60.33 finally show ?thesis .
60.34 qed
60.35
60.36 @@ -197,7 +197,7 @@
60.37 then show "\<exists>c. a < c \<and> c < b"
60.38 apply (intro exI[of _ "(a + b) * Float 1 -1"])
60.39 apply transfer
60.40 - apply (simp add: powr_neg_numeral)
60.41 + apply (simp add: powr_minus)
60.42 done
60.43 qed
60.44
60.45 @@ -226,16 +226,16 @@
60.46 "fun_rel (op =) pcr_float (numeral :: _ \<Rightarrow> real) (numeral :: _ \<Rightarrow> float)"
60.47 unfolding fun_rel_def float.pcr_cr_eq cr_float_def by simp
60.48
60.49 -lemma float_neg_numeral[simp]: "real (neg_numeral x :: float) = neg_numeral x"
60.50 - by (simp add: minus_numeral[symmetric] del: minus_numeral)
60.51 +lemma float_neg_numeral[simp]: "real (- numeral x :: float) = - numeral x"
60.52 + by simp
60.53
60.54 lemma transfer_neg_numeral [transfer_rule]:
60.55 - "fun_rel (op =) pcr_float (neg_numeral :: _ \<Rightarrow> real) (neg_numeral :: _ \<Rightarrow> float)"
60.56 + "fun_rel (op =) pcr_float (- numeral :: _ \<Rightarrow> real) (- numeral :: _ \<Rightarrow> float)"
60.57 unfolding fun_rel_def float.pcr_cr_eq cr_float_def by simp
60.58
60.59 lemma
60.60 shows float_of_numeral[simp]: "numeral k = float_of (numeral k)"
60.61 - and float_of_neg_numeral[simp]: "neg_numeral k = float_of (neg_numeral k)"
60.62 + and float_of_neg_numeral[simp]: "- numeral k = float_of (- numeral k)"
60.63 unfolding real_of_float_eq by simp_all
60.64
60.65 subsection {* Represent floats as unique mantissa and exponent *}
60.66 @@ -439,7 +439,7 @@
60.67 by transfer simp
60.68 hide_fact (open) compute_float_numeral
60.69
60.70 -lemma compute_float_neg_numeral[code_abbrev]: "Float (neg_numeral k) 0 = neg_numeral k"
60.71 +lemma compute_float_neg_numeral[code_abbrev]: "Float (- numeral k) 0 = - numeral k"
60.72 by transfer simp
60.73 hide_fact (open) compute_float_neg_numeral
60.74
60.75 @@ -960,7 +960,7 @@
60.76 also have "... < (1 / 2) * 2 powr real (rat_precision n (int x) (int y))"
60.77 apply (rule mult_strict_right_mono) by (insert assms) auto
60.78 also have "\<dots> = 2 powr real (rat_precision n (int x) (int y) - 1)"
60.79 - using powr_add [of 2 _ "- 1", simplified add_uminus_conv_diff] by (simp add: powr_neg_numeral)
60.80 + using powr_add [of 2 _ "- 1", simplified add_uminus_conv_diff] by (simp add: powr_minus)
60.81 also have "\<dots> = 2 ^ nat (rat_precision n (int x) (int y) - 1)"
60.82 using rat_precision_pos[of x y n] assms by (simp add: powr_realpow[symmetric])
60.83 also have "\<dots> \<le> 2 ^ nat (rat_precision n (int x) (int y)) - 1"
61.1 --- a/src/HOL/Library/Formal_Power_Series.thy Mon Nov 18 17:15:01 2013 +0100
61.2 +++ b/src/HOL/Library/Formal_Power_Series.thy Tue Nov 19 17:07:52 2013 +0100
61.3 @@ -384,8 +384,8 @@
61.4 by (induct k) (simp_all only: numeral.simps fps_const_1_eq_1
61.5 fps_const_add [symmetric])
61.6
61.7 -lemma neg_numeral_fps_const: "neg_numeral k = fps_const (neg_numeral k)"
61.8 - by (simp only: neg_numeral_def numeral_fps_const fps_const_neg)
61.9 +lemma neg_numeral_fps_const: "- numeral k = fps_const (- numeral k)"
61.10 + by (simp only: numeral_fps_const fps_const_neg)
61.11
61.12 subsection{* The eXtractor series X*}
61.13
61.14 @@ -1202,7 +1202,7 @@
61.15 have eq: "(1 + X) * ?r = 1"
61.16 unfolding minus_one_power_iff
61.17 by (auto simp add: field_simps fps_eq_iff)
61.18 - show ?thesis by (auto simp add: eq intro: fps_inverse_unique simp del: minus_one)
61.19 + show ?thesis by (auto simp add: eq intro: fps_inverse_unique)
61.20 qed
61.21
61.22
61.23 @@ -1245,7 +1245,7 @@
61.24 lemma numeral_compose[simp]: "(numeral k::('a::{comm_ring_1}) fps) oo b = numeral k"
61.25 unfolding numeral_fps_const by simp
61.26
61.27 -lemma neg_numeral_compose[simp]: "(neg_numeral k::('a::{comm_ring_1}) fps) oo b = neg_numeral k"
61.28 +lemma neg_numeral_compose[simp]: "(- numeral k::('a::{comm_ring_1}) fps) oo b = - numeral k"
61.29 unfolding neg_numeral_fps_const by simp
61.30
61.31 lemma X_fps_compose_startby0[simp]: "a$0 = 0 \<Longrightarrow> X oo a = (a :: ('a :: comm_ring_1) fps)"
61.32 @@ -2363,7 +2363,7 @@
61.33 next
61.34 case (Suc n1)
61.35 have "?i $ n = setsum (\<lambda>i. (fps_inv a $ i) * (a^i)$n) {0 .. n1} + fps_inv a $ Suc n1 * (a $ 1)^ Suc n1"
61.36 - by (simp add: fps_compose_nth Suc startsby_zero_power_nth_same[OF a0] del: power_Suc)
61.37 + by (simp only: fps_compose_nth) (simp add: Suc startsby_zero_power_nth_same [OF a0] del: power_Suc)
61.38 also have "\<dots> = setsum (\<lambda>i. (fps_inv a $ i) * (a^i)$n) {0 .. n1} +
61.39 (X$ Suc n1 - setsum (\<lambda>i. (fps_inv a $ i) * (a^i)$n) {0 .. n1})"
61.40 using a0 a1 Suc by (simp add: fps_inv_def)
61.41 @@ -2404,7 +2404,7 @@
61.42 next
61.43 case (Suc n1)
61.44 have "?i $ n = setsum (\<lambda>i. (fps_ginv b a $ i) * (a^i)$n) {0 .. n1} + fps_ginv b a $ Suc n1 * (a $ 1)^ Suc n1"
61.45 - by (simp add: fps_compose_nth Suc startsby_zero_power_nth_same[OF a0] del: power_Suc)
61.46 + by (simp only: fps_compose_nth) (simp add: Suc startsby_zero_power_nth_same [OF a0] del: power_Suc)
61.47 also have "\<dots> = setsum (\<lambda>i. (fps_ginv b a $ i) * (a^i)$n) {0 .. n1} +
61.48 (b$ Suc n1 - setsum (\<lambda>i. (fps_ginv b a $ i) * (a^i)$n) {0 .. n1})"
61.49 using a0 a1 Suc by (simp add: fps_ginv_def)
61.50 @@ -2564,9 +2564,9 @@
61.51
61.52
61.53 lemma fps_compose_mult_distrib:
61.54 - assumes c0: "c$0 = (0::'a::idom)"
61.55 - shows "(a * b) oo c = (a oo c) * (b oo c)" (is "?l = ?r")
61.56 - apply (simp add: fps_eq_iff fps_compose_mult_distrib_lemma[OF c0])
61.57 + assumes c0: "c $ 0 = (0::'a::idom)"
61.58 + shows "(a * b) oo c = (a oo c) * (b oo c)"
61.59 + apply (simp add: fps_eq_iff fps_compose_mult_distrib_lemma [OF c0])
61.60 apply (simp add: fps_compose_nth fps_mult_nth setsum_left_distrib)
61.61 done
61.62
61.63 @@ -2941,7 +2941,7 @@
61.64 (is "inverse ?l = ?r")
61.65 proof -
61.66 have th: "?l * ?r = 1"
61.67 - by (auto simp add: field_simps fps_eq_iff minus_one_power_iff simp del: minus_one)
61.68 + by (auto simp add: field_simps fps_eq_iff minus_one_power_iff)
61.69 have th': "?l $ 0 \<noteq> 0" by (simp add: )
61.70 from fps_inverse_unique[OF th' th] show ?thesis .
61.71 qed
61.72 @@ -3165,7 +3165,7 @@
61.73 have th: "?r$0 \<noteq> 0" by simp
61.74 have th': "fps_deriv (inverse ?r) = fps_const (- 1) * inverse ?r / (1 + X)"
61.75 by (simp add: fps_inverse_deriv[OF th] fps_divide_def
61.76 - power2_eq_square mult_commute fps_const_neg[symmetric] del: fps_const_neg minus_one)
61.77 + power2_eq_square mult_commute fps_const_neg[symmetric] del: fps_const_neg)
61.78 have eq: "inverse ?r $ 0 = 1"
61.79 by (simp add: fps_inverse_def)
61.80 from iffD1[OF fps_binomial_ODE_unique[of "inverse (1 + X)" "- 1"] th'] eq
61.81 @@ -3276,7 +3276,7 @@
61.82 have th1: "(?m1 k * ?p (of_nat n) k) / ?f n = 1 / of_nat(fact (n - k))"
61.83 unfolding m1nk
61.84 unfolding m h pochhammer_Suc_setprod
61.85 - apply (simp add: field_simps del: fact_Suc minus_one)
61.86 + apply (simp add: field_simps del: fact_Suc)
61.87 unfolding fact_altdef_nat id_def
61.88 unfolding of_nat_setprod
61.89 unfolding setprod_timesf[symmetric]
61.90 @@ -3593,7 +3593,7 @@
61.91 unfolding even_mult_two_ex by blast
61.92
61.93 have "?l $n = ?r$n"
61.94 - by (simp add: m fps_sin_def fps_cos_def power_mult_distrib power_mult power_minus)
61.95 + by (simp add: m fps_sin_def fps_cos_def power_mult_distrib power_mult power_minus [of "c ^ 2"])
61.96 }
61.97 moreover
61.98 {
61.99 @@ -3602,7 +3602,7 @@
61.100 unfolding odd_nat_equiv_def2 by (auto simp add: mult_2)
61.101 have "?l $n = ?r$n"
61.102 by (simp add: m fps_sin_def fps_cos_def power_mult_distrib
61.103 - power_mult power_minus)
61.104 + power_mult power_minus [of "c ^ 2"])
61.105 }
61.106 ultimately have "?l $n = ?r$n" by blast
61.107 } then show ?thesis by (simp add: fps_eq_iff)
62.1 --- a/src/HOL/Library/Fundamental_Theorem_Algebra.thy Mon Nov 18 17:15:01 2013 +0100
62.2 +++ b/src/HOL/Library/Fundamental_Theorem_Algebra.thy Tue Nov 19 17:07:52 2013 +0100
62.3 @@ -207,12 +207,14 @@
62.4 from unimodular_reduce_norm[OF th0] o
62.5 have "\<exists>v. cmod (complex_of_real (cmod b) / b + v^n) < 1"
62.6 apply (cases "cmod (complex_of_real (cmod b) / b + 1) < 1", rule_tac x="1" in exI, simp)
62.7 - apply (cases "cmod (complex_of_real (cmod b) / b - 1) < 1", rule_tac x="-1" in exI, simp del: minus_one add: minus_one [symmetric])
62.8 + apply (cases "cmod (complex_of_real (cmod b) / b - 1) < 1", rule_tac x="-1" in exI, simp)
62.9 apply (cases "cmod (complex_of_real (cmod b) / b + ii) < 1")
62.10 apply (cases "even m", rule_tac x="ii" in exI, simp add: m power_mult)
62.11 apply (rule_tac x="- ii" in exI, simp add: m power_mult)
62.12 apply (cases "even m", rule_tac x="- ii" in exI, simp add: m power_mult)
62.13 - apply (rule_tac x="ii" in exI, simp add: m power_mult)
62.14 + apply (auto simp add: m power_mult)
62.15 + apply (rule_tac x="ii" in exI)
62.16 + apply (auto simp add: m power_mult)
62.17 done
62.18 then obtain v where v: "cmod (complex_of_real (cmod b) / b + v^n) < 1" by blast
62.19 let ?w = "v / complex_of_real (root n (cmod b))"
63.1 --- a/src/HOL/Library/Order_Relation.thy Mon Nov 18 17:15:01 2013 +0100
63.2 +++ b/src/HOL/Library/Order_Relation.thy Tue Nov 19 17:07:52 2013 +0100
63.3 @@ -93,7 +93,7 @@
63.4 using mono_Field[of "r - Id" r] Diff_subset[of r Id]
63.5 proof(auto)
63.6 have "r \<noteq> {}" using NID by fast
63.7 - then obtain b and c where "b \<noteq> c \<and> (b,c) \<in> r" using NID by fast
63.8 + then obtain b and c where "b \<noteq> c \<and> (b,c) \<in> r" using NID by auto
63.9 hence 1: "b \<noteq> c \<and> {b,c} \<le> Field r" by (auto simp: Field_def)
63.10 (* *)
63.11 fix a assume *: "a \<in> Field r"
64.1 --- a/src/HOL/Library/Order_Union.thy Mon Nov 18 17:15:01 2013 +0100
64.2 +++ b/src/HOL/Library/Order_Union.thy Tue Nov 19 17:07:52 2013 +0100
64.3 @@ -7,7 +7,7 @@
64.4 header {* Order Union *}
64.5
64.6 theory Order_Union
64.7 -imports "~~/src/HOL/Cardinals/Wellfounded_More_Base"
64.8 +imports "~~/src/HOL/Cardinals/Wellfounded_More_FP"
64.9 begin
64.10
64.11 definition Osum :: "'a rel \<Rightarrow> 'a rel \<Rightarrow> 'a rel" (infix "Osum" 60) where
64.12 @@ -31,7 +31,7 @@
64.13 assume Case1: "B \<noteq> {}"
64.14 hence "B \<noteq> {} \<and> B \<le> Field r" using B_def by auto
64.15 then obtain a where 1: "a \<in> B" and 2: "\<forall>a1 \<in> B. (a1,a) \<notin> r"
64.16 - using WF unfolding wf_eq_minimal2 by blast
64.17 + using WF unfolding wf_eq_minimal2 by metis
64.18 hence 3: "a \<in> Field r \<and> a \<notin> Field r'" using B_def FLD by auto
64.19 (* *)
64.20 have "\<forall>a1 \<in> A. (a1,a) \<notin> r Osum r'"
64.21 @@ -59,7 +59,7 @@
64.22 assume Case2: "B = {}"
64.23 hence 1: "A \<noteq> {} \<and> A \<le> Field r'" using * ** B_def by auto
64.24 then obtain a' where 2: "a' \<in> A" and 3: "\<forall>a1' \<in> A. (a1',a') \<notin> r'"
64.25 - using WF' unfolding wf_eq_minimal2 by blast
64.26 + using WF' unfolding wf_eq_minimal2 by metis
64.27 hence 4: "a' \<in> Field r' \<and> a' \<notin> Field r" using 1 FLD by blast
64.28 (* *)
64.29 have "\<forall>a1' \<in> A. (a1',a') \<notin> r Osum r'"
64.30 @@ -299,7 +299,7 @@
64.31 using assms Total_Id_Field by blast
64.32 hence ?thesis unfolding Osum_def by auto
64.33 }
64.34 - ultimately show ?thesis using * unfolding Osum_def by blast
64.35 + ultimately show ?thesis using * unfolding Osum_def by fast
64.36 qed
64.37 }
64.38 thus ?thesis by(auto simp add: Osum_def)
64.39 @@ -308,12 +308,7 @@
64.40 lemma wf_Int_Times:
64.41 assumes "A Int B = {}"
64.42 shows "wf(A \<times> B)"
64.43 -proof(unfold wf_def, auto)
64.44 - fix P x
64.45 - assume *: "\<forall>x. (\<forall>y. y \<in> A \<and> x \<in> B \<longrightarrow> P y) \<longrightarrow> P x"
64.46 - moreover have "\<forall>y \<in> A. P y" using assms * by blast
64.47 - ultimately show "P x" using * by (case_tac "x \<in> B", auto)
64.48 -qed
64.49 +unfolding wf_def using assms by blast
64.50
64.51 lemma Osum_wf_Id:
64.52 assumes TOT: "Total r" and TOT': "Total r'" and
64.53 @@ -343,7 +338,7 @@
64.54 using 1 WF' wf_Un[of "Field r \<times> Field r'" "r' - Id"]
64.55 by (auto simp add: Un_commute)
64.56 }
64.57 - ultimately have ?thesis by (auto simp add: wf_subset)
64.58 + ultimately have ?thesis by (metis wf_subset)
64.59 }
64.60 moreover
64.61 {assume Case22: "r' \<le> Id"
64.62 @@ -356,7 +351,7 @@
64.63 using 1 WF wf_Un[of "r - Id" "Field r \<times> Field r'"]
64.64 by (auto simp add: Un_commute)
64.65 }
64.66 - ultimately have ?thesis by (auto simp add: wf_subset)
64.67 + ultimately have ?thesis by (metis wf_subset)
64.68 }
64.69 ultimately show ?thesis by blast
64.70 qed
65.1 --- a/src/HOL/Library/Polynomial.thy Mon Nov 18 17:15:01 2013 +0100
65.2 +++ b/src/HOL/Library/Polynomial.thy Tue Nov 19 17:07:52 2013 +0100
65.3 @@ -1575,12 +1575,12 @@
65.4 lemma poly_div_minus_left [simp]:
65.5 fixes x y :: "'a::field poly"
65.6 shows "(- x) div y = - (x div y)"
65.7 - using div_smult_left [of "- 1::'a"] by (simp del: minus_one) (* FIXME *)
65.8 + using div_smult_left [of "- 1::'a"] by simp
65.9
65.10 lemma poly_mod_minus_left [simp]:
65.11 fixes x y :: "'a::field poly"
65.12 shows "(- x) mod y = - (x mod y)"
65.13 - using mod_smult_left [of "- 1::'a"] by (simp del: minus_one) (* FIXME *)
65.14 + using mod_smult_left [of "- 1::'a"] by simp
65.15
65.16 lemma pdivmod_rel_smult_right:
65.17 "\<lbrakk>a \<noteq> 0; pdivmod_rel x y q r\<rbrakk>
65.18 @@ -1597,13 +1597,12 @@
65.19 lemma poly_div_minus_right [simp]:
65.20 fixes x y :: "'a::field poly"
65.21 shows "x div (- y) = - (x div y)"
65.22 - using div_smult_right [of "- 1::'a"]
65.23 - by (simp add: nonzero_inverse_minus_eq del: minus_one) (* FIXME *)
65.24 + using div_smult_right [of "- 1::'a"] by (simp add: nonzero_inverse_minus_eq)
65.25
65.26 lemma poly_mod_minus_right [simp]:
65.27 fixes x y :: "'a::field poly"
65.28 shows "x mod (- y) = x mod y"
65.29 - using mod_smult_right [of "- 1::'a"] by (simp del: minus_one) (* FIXME *)
65.30 + using mod_smult_right [of "- 1::'a"] by simp
65.31
65.32 lemma pdivmod_rel_mult:
65.33 "\<lbrakk>pdivmod_rel x y q r; pdivmod_rel q z q' r'\<rbrakk>
66.1 --- a/src/HOL/Library/Predicate_Compile_Alternative_Defs.thy Mon Nov 18 17:15:01 2013 +0100
66.2 +++ b/src/HOL/Library/Predicate_Compile_Alternative_Defs.thy Tue Nov 19 17:07:52 2013 +0100
66.3 @@ -45,8 +45,8 @@
66.4
66.5 section {* Setup for Numerals *}
66.6
66.7 -setup {* Predicate_Compile_Data.ignore_consts [@{const_name numeral}, @{const_name neg_numeral}] *}
66.8 -setup {* Predicate_Compile_Data.keep_functions [@{const_name numeral}, @{const_name neg_numeral}] *}
66.9 +setup {* Predicate_Compile_Data.ignore_consts [@{const_name numeral}] *}
66.10 +setup {* Predicate_Compile_Data.keep_functions [@{const_name numeral}] *}
66.11
66.12 setup {* Predicate_Compile_Data.ignore_consts [@{const_name div}, @{const_name mod}, @{const_name times}] *}
66.13
67.1 --- a/src/HOL/Library/Sublist.thy Mon Nov 18 17:15:01 2013 +0100
67.2 +++ b/src/HOL/Library/Sublist.thy Tue Nov 19 17:07:52 2013 +0100
67.3 @@ -107,16 +107,22 @@
67.4
67.5 lemma append_one_prefixeq:
67.6 "prefixeq xs ys \<Longrightarrow> length xs < length ys \<Longrightarrow> prefixeq (xs @ [ys ! length xs]) ys"
67.7 - unfolding prefixeq_def
67.8 - by (metis Cons_eq_appendI append_eq_appendI append_eq_conv_conj
67.9 - eq_Nil_appendI nth_drop')
67.10 + proof (unfold prefixeq_def)
67.11 + assume a1: "\<exists>zs. ys = xs @ zs"
67.12 + then obtain sk :: "'a list" where sk: "ys = xs @ sk" by fastforce
67.13 + assume a2: "length xs < length ys"
67.14 + have f1: "\<And>v. ([]\<Colon>'a list) @ v = v" using append_Nil2 by simp
67.15 + have "[] \<noteq> sk" using a1 a2 sk less_not_refl by force
67.16 + hence "\<exists>v. xs @ hd sk # v = ys" using sk by (metis hd_Cons_tl)
67.17 + thus "\<exists>zs. ys = (xs @ [ys ! length xs]) @ zs" using f1 by fastforce
67.18 + qed
67.19
67.20 theorem prefixeq_length_le: "prefixeq xs ys \<Longrightarrow> length xs \<le> length ys"
67.21 by (auto simp add: prefixeq_def)
67.22
67.23 lemma prefixeq_same_cases:
67.24 "prefixeq (xs\<^sub>1::'a list) ys \<Longrightarrow> prefixeq xs\<^sub>2 ys \<Longrightarrow> prefixeq xs\<^sub>1 xs\<^sub>2 \<or> prefixeq xs\<^sub>2 xs\<^sub>1"
67.25 - unfolding prefixeq_def by (metis append_eq_append_conv2)
67.26 + unfolding prefixeq_def by (force simp: append_eq_append_conv2)
67.27
67.28 lemma set_mono_prefixeq: "prefixeq xs ys \<Longrightarrow> set xs \<subseteq> set ys"
67.29 by (auto simp add: prefixeq_def)
67.30 @@ -224,9 +230,9 @@
67.31 then show ?thesis by (metis append_Nil2 parallelE prefixeqI snoc.prems ys)
67.32 next
67.33 fix c cs assume ys': "ys' = c # cs"
67.34 - then show ?thesis
67.35 - by (metis Cons_eq_appendI eq_Nil_appendI parallelE prefixeqI
67.36 - same_prefixeq_prefixeq snoc.prems ys)
67.37 + have "x \<noteq> c" using snoc.prems ys ys' by fastforce
67.38 + thus "\<exists>as b bs c cs. b \<noteq> c \<and> xs @ [x] = as @ b # bs \<and> ys = as @ c # cs"
67.39 + using ys ys' by blast
67.40 qed
67.41 next
67.42 assume "prefix ys xs"
67.43 @@ -464,7 +470,7 @@
67.44 then show ?case by (metis append_Cons)
67.45 next
67.46 case (list_hembeq_Cons2 x y xs ys)
67.47 - then show ?case by (cases xs) (auto, blast+)
67.48 + then show ?case by blast
67.49 qed
67.50
67.51 lemma list_hembeq_appendD:
67.52 @@ -475,9 +481,14 @@
67.53 case Nil then show ?case by auto
67.54 next
67.55 case (Cons x xs)
67.56 - then obtain us v vs where "zs = us @ v # vs"
67.57 - and "P\<^sup>=\<^sup>= x v" and "list_hembeq P (xs @ ys) vs" by (auto dest: list_hembeq_ConsD)
67.58 - with Cons show ?case by (metis append_Cons append_assoc list_hembeq_Cons2 list_hembeq_append2)
67.59 + then obtain us v vs where
67.60 + zs: "zs = us @ v # vs" and p: "P\<^sup>=\<^sup>= x v" and lh: "list_hembeq P (xs @ ys) vs"
67.61 + by (auto dest: list_hembeq_ConsD)
67.62 + obtain sk\<^sub>0 :: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a list" and sk\<^sub>1 :: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a list" where
67.63 + sk: "\<forall>x\<^sub>0 x\<^sub>1. \<not> list_hembeq P (xs @ x\<^sub>0) x\<^sub>1 \<or> sk\<^sub>0 x\<^sub>0 x\<^sub>1 @ sk\<^sub>1 x\<^sub>0 x\<^sub>1 = x\<^sub>1 \<and> list_hembeq P xs (sk\<^sub>0 x\<^sub>0 x\<^sub>1) \<and> list_hembeq P x\<^sub>0 (sk\<^sub>1 x\<^sub>0 x\<^sub>1)"
67.64 + using Cons(1) by (metis (no_types))
67.65 + hence "\<forall>x\<^sub>2. list_hembeq P (x # xs) (x\<^sub>2 @ v # sk\<^sub>0 ys vs)" using p lh by auto
67.66 + thus ?case using lh zs sk by (metis (no_types) append_Cons append_assoc)
67.67 qed
67.68
67.69 lemma list_hembeq_suffix:
67.70 @@ -550,7 +561,7 @@
67.71 by (simp_all)
67.72
67.73 lemma sublisteq_Cons': "sublisteq (x#xs) ys \<Longrightarrow> sublisteq xs ys"
67.74 - by (induct xs) (auto dest: list_hembeq_ConsD)
67.75 + by (induct xs, simp, blast dest: list_hembeq_ConsD)
67.76
67.77 lemma sublisteq_Cons2':
67.78 assumes "sublisteq (x#xs) (x#ys)" shows "sublisteq xs ys"
67.79 @@ -579,11 +590,11 @@
67.80 from list_hembeq_Nil2 [OF this] show ?case by simp
67.81 next
67.82 case list_hembeq_Cons2
67.83 - then show ?case by simp
67.84 + thus ?case by simp
67.85 next
67.86 case list_hembeq_Cons
67.87 - then show ?case
67.88 - by (metis sublisteq_Cons' list_hembeq_length Suc_length_conv Suc_n_not_le_n)
67.89 + hence False using sublisteq_Cons' by fastforce
67.90 + thus ?case ..
67.91 qed
67.92
67.93 lemma sublisteq_trans: "sublisteq xs ys \<Longrightarrow> sublisteq ys zs \<Longrightarrow> sublisteq xs zs"
67.94 @@ -650,7 +661,7 @@
67.95
67.96 lemma sublisteq_filter [simp]:
67.97 assumes "sublisteq xs ys" shows "sublisteq (filter P xs) (filter P ys)"
67.98 - using assms by (induct) auto
67.99 + using assms by induct auto
67.100
67.101 lemma "sublisteq xs ys \<longleftrightarrow> (\<exists>N. xs = sublist ys N)" (is "?L = ?R")
67.102 proof
68.1 --- a/src/HOL/Library/Sum_of_Squares/sum_of_squares.ML Mon Nov 18 17:15:01 2013 +0100
68.2 +++ b/src/HOL/Library/Sum_of_Squares/sum_of_squares.ML Tue Nov 19 17:07:52 2013 +0100
68.3 @@ -875,7 +875,6 @@
68.4 @{term "0::real"}, @{term "1::real"},
68.5 @{term "numeral :: num => nat"},
68.6 @{term "numeral :: num => real"},
68.7 - @{term "neg_numeral :: num => real"},
68.8 @{term "Num.Bit0"}, @{term "Num.Bit1"}, @{term "Num.One"}];
68.9
68.10 fun check_sos kcts ct =
69.1 --- a/src/HOL/Library/Wfrec.thy Mon Nov 18 17:15:01 2013 +0100
69.2 +++ b/src/HOL/Library/Wfrec.thy Tue Nov 19 17:07:52 2013 +0100
69.3 @@ -48,7 +48,7 @@
69.4 apply (fast dest!: theI')
69.5 apply (erule wfrec_rel.cases, simp)
69.6 apply (erule allE, erule allE, erule allE, erule mp)
69.7 -apply (fast intro: the_equality [symmetric])
69.8 +apply (blast intro: the_equality [symmetric])
69.9 done
69.10
69.11 lemma adm_lemma: "adm_wf R (%f x. F (cut f R x) x)"
70.1 --- a/src/HOL/Library/Zorn.thy Mon Nov 18 17:15:01 2013 +0100
70.2 +++ b/src/HOL/Library/Zorn.thy Tue Nov 19 17:07:52 2013 +0100
70.3 @@ -71,7 +71,7 @@
70.4
70.5 lemma suc_not_equals:
70.6 "chain C \<Longrightarrow> \<not> maxchain C \<Longrightarrow> suc C \<noteq> C"
70.7 - by (auto simp: suc_def) (metis less_irrefl not_maxchain_Some)
70.8 + by (auto simp: suc_def) (metis (no_types) less_irrefl not_maxchain_Some)
70.9
70.10 lemma subset_suc:
70.11 assumes "X \<subseteq> Y" shows "X \<subseteq> suc Y"
70.12 @@ -258,7 +258,7 @@
70.13 shows "chain X"
70.14 using assms
70.15 proof (induct)
70.16 - case (suc X) then show ?case by (simp add: suc_def) (metis not_maxchain_Some)
70.17 + case (suc X) then show ?case by (simp add: suc_def) (metis (no_types) not_maxchain_Some)
70.18 next
70.19 case (Union X)
70.20 then have "\<Union>X \<subseteq> A" by (auto dest: suc_Union_closed_in_carrier)
70.21 @@ -378,7 +378,7 @@
70.22 using `subset.maxchain A M` by (auto simp: subset.maxchain_def)
70.23 qed
70.24 qed
70.25 - ultimately show ?thesis by blast
70.26 + ultimately show ?thesis by metis
70.27 qed
70.28
70.29 text{*Alternative version of Zorn's lemma for the subset relation.*}
70.30 @@ -423,7 +423,7 @@
70.31 unfolding Chains_def by blast
70.32
70.33 lemma chain_subset_alt_def: "chain\<^sub>\<subseteq> C = subset.chain UNIV C"
70.34 - by (auto simp add: chain_subset_def subset.chain_def)
70.35 + unfolding chain_subset_def subset.chain_def by fast
70.36
70.37 lemma chains_alt_def: "chains A = {C. subset.chain A C}"
70.38 by (simp add: chains_def chain_subset_alt_def subset.chain_def)
70.39 @@ -487,7 +487,7 @@
70.40 fix a B assume aB: "B \<in> C" "a \<in> B"
70.41 with 1 obtain x where "x \<in> Field r" and "B = r\<inverse> `` {x}" by auto
70.42 thus "(a, u) \<in> r" using uA and aB and `Preorder r`
70.43 - by (auto simp add: preorder_on_def refl_on_def) (metis transD)
70.44 + unfolding preorder_on_def refl_on_def by simp (fast dest: transD)
70.45 qed
70.46 then have "\<exists>u\<in>Field r. ?P u" using `u \<in> Field r` by blast
70.47 }
70.48 @@ -524,8 +524,7 @@
70.49
70.50 lemma trans_init_seg_of:
70.51 "r initial_segment_of s \<Longrightarrow> s initial_segment_of t \<Longrightarrow> r initial_segment_of t"
70.52 - by (simp (no_asm_use) add: init_seg_of_def)
70.53 - (metis UnCI Un_absorb2 subset_trans)
70.54 + by (simp (no_asm_use) add: init_seg_of_def) blast
70.55
70.56 lemma antisym_init_seg_of:
70.57 "r initial_segment_of s \<Longrightarrow> s initial_segment_of r \<Longrightarrow> r = s"
70.58 @@ -539,14 +538,13 @@
70.59 "chain\<^sub>\<subseteq> R \<Longrightarrow> \<forall>r\<in>R. trans r \<Longrightarrow> trans (\<Union>R)"
70.60 apply (auto simp add: chain_subset_def)
70.61 apply (simp (no_asm_use) add: trans_def)
70.62 -apply (metis subsetD)
70.63 -done
70.64 +by (metis subsetD)
70.65
70.66 lemma chain_subset_antisym_Union:
70.67 "chain\<^sub>\<subseteq> R \<Longrightarrow> \<forall>r\<in>R. antisym r \<Longrightarrow> antisym (\<Union>R)"
70.68 -apply (auto simp add: chain_subset_def antisym_def)
70.69 -apply (metis subsetD)
70.70 -done
70.71 +unfolding chain_subset_def antisym_def
70.72 +apply simp
70.73 +by (metis (no_types) subsetD)
70.74
70.75 lemma chain_subset_Total_Union:
70.76 assumes "chain\<^sub>\<subseteq> R" and "\<forall>r\<in>R. Total r"
70.77 @@ -558,11 +556,11 @@
70.78 thus "(\<exists>r\<in>R. (a, b) \<in> r) \<or> (\<exists>r\<in>R. (b, a) \<in> r)"
70.79 proof
70.80 assume "r \<subseteq> s" hence "(a, b) \<in> s \<or> (b, a) \<in> s" using assms(2) A
70.81 - by (simp add: total_on_def) (metis mono_Field subsetD)
70.82 + by (simp add: total_on_def) (metis (no_types) mono_Field subsetD)
70.83 thus ?thesis using `s \<in> R` by blast
70.84 next
70.85 assume "s \<subseteq> r" hence "(a, b) \<in> r \<or> (b, a) \<in> r" using assms(2) A
70.86 - by (simp add: total_on_def) (metis mono_Field subsetD)
70.87 + by (simp add: total_on_def) (metis (no_types) mono_Field subsetD)
70.88 thus ?thesis using `r \<in> R` by blast
70.89 qed
70.90 qed
70.91 @@ -604,7 +602,7 @@
70.92 def I \<equiv> "init_seg_of \<inter> ?WO \<times> ?WO"
70.93 have I_init: "I \<subseteq> init_seg_of" by (auto simp: I_def)
70.94 hence subch: "\<And>R. R \<in> Chains I \<Longrightarrow> chain\<^sub>\<subseteq> R"
70.95 - by (auto simp: init_seg_of_def chain_subset_def Chains_def)
70.96 + unfolding init_seg_of_def chain_subset_def Chains_def by blast
70.97 have Chains_wo: "\<And>R r. R \<in> Chains I \<Longrightarrow> r \<in> R \<Longrightarrow> Well_order r"
70.98 by (simp add: Chains_def I_def) blast
70.99 have FI: "Field I = ?WO" by (auto simp add: I_def init_seg_of_def Field_def)
70.100 @@ -619,7 +617,7 @@
70.101 have "\<forall>r\<in>R. Refl r" and "\<forall>r\<in>R. trans r" and "\<forall>r\<in>R. antisym r"
70.102 and "\<forall>r\<in>R. Total r" and "\<forall>r\<in>R. wf (r - Id)"
70.103 using Chains_wo [OF `R \<in> Chains I`] by (simp_all add: order_on_defs)
70.104 - have "Refl (\<Union>R)" using `\<forall>r\<in>R. Refl r` by (auto simp: refl_on_def)
70.105 + have "Refl (\<Union>R)" using `\<forall>r\<in>R. Refl r` unfolding refl_on_def by fastforce
70.106 moreover have "trans (\<Union>R)"
70.107 by (rule chain_subset_trans_Union [OF subch `\<forall>r\<in>R. trans r`])
70.108 moreover have "antisym (\<Union>R)"
70.109 @@ -630,7 +628,7 @@
70.110 proof -
70.111 have "(\<Union>R) - Id = \<Union>{r - Id | r. r \<in> R}" by blast
70.112 with `\<forall>r\<in>R. wf (r - Id)` and wf_Union_wf_init_segs [OF Chains_inits_DiffI [OF Ris]]
70.113 - show ?thesis by (simp (no_asm_simp)) blast
70.114 + show ?thesis by fastforce
70.115 qed
70.116 ultimately have "Well_order (\<Union>R)" by(simp add:order_on_defs)
70.117 moreover have "\<forall>r \<in> R. r initial_segment_of \<Union>R" using Ris
70.118 @@ -643,7 +641,7 @@
70.119 --{*Zorn's Lemma yields a maximal well-order m:*}
70.120 then obtain m::"'a rel" where "Well_order m" and
70.121 max: "\<forall>r. Well_order r \<and> (m, r) \<in> I \<longrightarrow> r = m"
70.122 - using Zorns_po_lemma[OF 0 1] by (auto simp:FI)
70.123 + using Zorns_po_lemma[OF 0 1] unfolding FI by fastforce
70.124 --{*Now show by contradiction that m covers the whole type:*}
70.125 { fix x::'a assume "x \<notin> Field m"
70.126 --{*We assume that x is not covered and extend m at the top with x*}
70.127 @@ -666,7 +664,7 @@
70.128 have "Refl m" and "trans m" and "antisym m" and "Total m" and "wf (m - Id)"
70.129 using `Well_order m` by (simp_all add: order_on_defs)
70.130 --{*We show that the extension is a well-order*}
70.131 - have "Refl ?m" using `Refl m` Fm by (auto simp: refl_on_def)
70.132 + have "Refl ?m" using `Refl m` Fm unfolding refl_on_def by blast
70.133 moreover have "trans ?m" using `trans m` and `x \<notin> Field m`
70.134 unfolding trans_def Field_def by blast
70.135 moreover have "antisym ?m" using `antisym m` and `x \<notin> Field m`
70.136 @@ -678,7 +676,7 @@
70.137 by (auto simp add: wf_eq_minimal Field_def) metis
70.138 thus ?thesis using `wf (m - Id)` and `x \<notin> Field m`
70.139 wf_subset [OF `wf ?s` Diff_subset]
70.140 - by (fastforce intro!: wf_Un simp add: Un_Diff Field_def)
70.141 + unfolding Un_Diff Field_def by (auto intro: wf_Un)
70.142 qed
70.143 ultimately have "Well_order ?m" by (simp add: order_on_defs)
70.144 --{*We show that the extension is above m*}
70.145 @@ -709,7 +707,7 @@
70.146 moreover have "Total ?r" using `Total r` by (simp add:total_on_def 1 univ)
70.147 moreover have "wf (?r - Id)" by (rule wf_subset [OF `wf (r - Id)`]) blast
70.148 ultimately have "Well_order ?r" by (simp add: order_on_defs)
70.149 - with 1 show ?thesis by metis
70.150 + with 1 show ?thesis by auto
70.151 qed
70.152
70.153 subsection {* Extending Well-founded Relations to Well-Orders *}
70.154 @@ -732,7 +730,7 @@
70.155
70.156 lemma downset_onD:
70.157 "downset_on A r \<Longrightarrow> (x, y) \<in> r \<Longrightarrow> y \<in> A \<Longrightarrow> x \<in> A"
70.158 - by (auto simp: downset_on_def)
70.159 + unfolding downset_on_def by blast
70.160
70.161 text {*Extensions of relations w.r.t.\ a given set.*}
70.162 definition extension_on where
70.163 @@ -755,7 +753,8 @@
70.164 assumes "chain\<^sub>\<subseteq> R" and "\<And>r. r \<in> R \<Longrightarrow> extension_on (Field r) r p"
70.165 shows "extension_on (Field (\<Union>R)) (\<Union>R) p"
70.166 using assms
70.167 - by (simp add: chain_subset_def extension_on_def) (metis mono_Field set_mp)
70.168 + by (simp add: chain_subset_def extension_on_def)
70.169 + (metis (no_types) mono_Field set_mp)
70.170
70.171 lemma downset_on_empty [simp]: "downset_on {} p"
70.172 by (auto simp: downset_on_def)
70.173 @@ -789,7 +788,7 @@
70.174 "\<And>r. r \<in> R \<Longrightarrow> downset_on (Field r) p" and
70.175 "\<And>r. r \<in> R \<Longrightarrow> extension_on (Field r) r p"
70.176 using Chains_wo [OF `R \<in> Chains I`] by (simp_all add: order_on_defs)
70.177 - have "Refl (\<Union>R)" using `\<forall>r\<in>R. Refl r` by (auto simp: refl_on_def)
70.178 + have "Refl (\<Union>R)" using `\<forall>r\<in>R. Refl r` unfolding refl_on_def by fastforce
70.179 moreover have "trans (\<Union>R)"
70.180 by (rule chain_subset_trans_Union [OF subch `\<forall>r\<in>R. trans r`])
70.181 moreover have "antisym (\<Union>R)"
70.182 @@ -800,7 +799,7 @@
70.183 proof -
70.184 have "(\<Union>R) - Id = \<Union>{r - Id | r. r \<in> R}" by blast
70.185 with `\<forall>r\<in>R. wf (r - Id)` wf_Union_wf_init_segs [OF Chains_inits_DiffI [OF Ris]]
70.186 - show ?thesis by (simp (no_asm_simp)) blast
70.187 + show ?thesis by fastforce
70.188 qed
70.189 ultimately have "Well_order (\<Union>R)" by (simp add: order_on_defs)
70.190 moreover have "\<forall>r\<in>R. r initial_segment_of \<Union>R" using Ris
70.191 @@ -853,8 +852,9 @@
70.192 using `extension_on (Field m) m p` `downset_on (Field m) p`
70.193 by (subst Fm) (auto simp: extension_on_def dest: downset_onD)
70.194 moreover have "downset_on (Field ?m) p"
70.195 + apply (subst Fm)
70.196 using `downset_on (Field m) p` and min
70.197 - by (subst Fm, simp add: downset_on_def Field_def) (metis Domain_iff)
70.198 + unfolding downset_on_def Field_def by blast
70.199 moreover have "(m, ?m) \<in> I"
70.200 using `Well_order m` and `Well_order ?m` and
70.201 `downset_on (Field m) p` and `downset_on (Field ?m) p` and
70.202 @@ -867,7 +867,7 @@
70.203 qed
70.204 have "p \<subseteq> m"
70.205 using `Field p \<subseteq> Field m` and `extension_on (Field m) m p`
70.206 - by (force simp: Field_def extension_on_def)
70.207 + unfolding Field_def extension_on_def by auto fast
70.208 with `Well_order m` show ?thesis by blast
70.209 qed
70.210
71.1 --- a/src/HOL/List.thy Mon Nov 18 17:15:01 2013 +0100
71.2 +++ b/src/HOL/List.thy Tue Nov 19 17:07:52 2013 +0100
71.3 @@ -3075,9 +3075,9 @@
71.4
71.5 lemmas upto_rec_numeral [simp] =
71.6 upto.simps[of "numeral m" "numeral n"]
71.7 - upto.simps[of "numeral m" "neg_numeral n"]
71.8 - upto.simps[of "neg_numeral m" "numeral n"]
71.9 - upto.simps[of "neg_numeral m" "neg_numeral n"] for m n
71.10 + upto.simps[of "numeral m" "- numeral n"]
71.11 + upto.simps[of "- numeral m" "numeral n"]
71.12 + upto.simps[of "- numeral m" "- numeral n"] for m n
71.13
71.14 lemma upto_empty[simp]: "j < i \<Longrightarrow> [i..j] = []"
71.15 by(simp add: upto.simps)
72.1 --- a/src/HOL/Matrix_LP/ComputeFloat.thy Mon Nov 18 17:15:01 2013 +0100
72.2 +++ b/src/HOL/Matrix_LP/ComputeFloat.thy Tue Nov 19 17:07:52 2013 +0100
72.3 @@ -79,8 +79,8 @@
72.4 lemma real_is_int_numeral[simp]: "real_is_int (numeral x)"
72.5 by (auto simp: real_is_int_def intro!: exI[of _ "numeral x"])
72.6
72.7 -lemma real_is_int_neg_numeral[simp]: "real_is_int (neg_numeral x)"
72.8 - by (auto simp: real_is_int_def intro!: exI[of _ "neg_numeral x"])
72.9 +lemma real_is_int_neg_numeral[simp]: "real_is_int (- numeral x)"
72.10 + by (auto simp: real_is_int_def intro!: exI[of _ "- numeral x"])
72.11
72.12 lemma int_of_real_0[simp]: "int_of_real (0::real) = (0::int)"
72.13 by (simp add: int_of_real_def)
72.14 @@ -96,7 +96,7 @@
72.15 by (intro some_equality)
72.16 (auto simp add: real_of_int_inject[symmetric] simp del: real_of_int_inject)
72.17
72.18 -lemma int_of_real_neg_numeral[simp]: "int_of_real (neg_numeral b) = neg_numeral b"
72.19 +lemma int_of_real_neg_numeral[simp]: "int_of_real (- numeral b) = - numeral b"
72.20 unfolding int_of_real_def
72.21 by (intro some_equality)
72.22 (auto simp add: real_of_int_inject[symmetric] simp del: real_of_int_inject)
73.1 --- a/src/HOL/Multivariate_Analysis/Cartesian_Euclidean_Space.thy Mon Nov 18 17:15:01 2013 +0100
73.2 +++ b/src/HOL/Multivariate_Analysis/Cartesian_Euclidean_Space.thy Tue Nov 19 17:07:52 2013 +0100
73.3 @@ -228,7 +228,10 @@
73.4 then show ?case by vector
73.5 qed
73.6
73.7 -lemma one_index[simp]: "(1 :: 'a::one ^'n)$i = 1"
73.8 +lemma one_index [simp]: "(1 :: 'a :: one ^ 'n) $ i = 1"
73.9 + by vector
73.10 +
73.11 +lemma neg_one_index [simp]: "(- 1 :: 'a :: {one, uminus} ^ 'n) $ i = - 1"
73.12 by vector
73.13
73.14 instance vec :: (semiring_char_0, finite) semiring_char_0
73.15 @@ -244,8 +247,8 @@
73.16 lemma numeral_index [simp]: "numeral w $ i = numeral w"
73.17 by (induct w) (simp_all only: numeral.simps vector_add_component one_index)
73.18
73.19 -lemma neg_numeral_index [simp]: "neg_numeral w $ i = neg_numeral w"
73.20 - by (simp only: neg_numeral_def vector_uminus_component numeral_index)
73.21 +lemma neg_numeral_index [simp]: "- numeral w $ i = - numeral w"
73.22 + by (simp only: vector_uminus_component numeral_index)
73.23
73.24 instance vec :: (comm_ring_1, finite) comm_ring_1 ..
73.25 instance vec :: (ring_char_0, finite) ring_char_0 ..
74.1 --- a/src/HOL/Multivariate_Analysis/Linear_Algebra.thy Mon Nov 18 17:15:01 2013 +0100
74.2 +++ b/src/HOL/Multivariate_Analysis/Linear_Algebra.thy Tue Nov 19 17:07:52 2013 +0100
74.3 @@ -337,10 +337,10 @@
74.4 by (simp add: bilinear_def linear_iff)
74.5
74.6 lemma bilinear_lneg: "bilinear h \<Longrightarrow> h (- x) y = - h x y"
74.7 - by (simp only: scaleR_minus1_left [symmetric] bilinear_lmul)
74.8 + by (drule bilinear_lmul [of _ "- 1"]) simp
74.9
74.10 lemma bilinear_rneg: "bilinear h \<Longrightarrow> h x (- y) = - h x y"
74.11 - by (simp only: scaleR_minus1_left [symmetric] bilinear_rmul)
74.12 + by (drule bilinear_rmul [of _ _ "- 1"]) simp
74.13
74.14 lemma (in ab_group_add) eq_add_iff: "x = x + y \<longleftrightarrow> y = 0"
74.15 using add_imp_eq[of x y 0] by auto
75.1 --- a/src/HOL/Multivariate_Analysis/Topology_Euclidean_Space.thy Mon Nov 18 17:15:01 2013 +0100
75.2 +++ b/src/HOL/Multivariate_Analysis/Topology_Euclidean_Space.thy Tue Nov 19 17:07:52 2013 +0100
75.3 @@ -5163,9 +5163,8 @@
75.4
75.5 lemma open_negations:
75.6 fixes s :: "'a::real_normed_vector set"
75.7 - shows "open s \<Longrightarrow> open ((\<lambda> x. -x) ` s)"
75.8 - unfolding scaleR_minus1_left [symmetric]
75.9 - by (rule open_scaling, auto)
75.10 + shows "open s \<Longrightarrow> open ((\<lambda>x. - x) ` s)"
75.11 + using open_scaling [of "- 1" s] by simp
75.12
75.13 lemma open_translation:
75.14 fixes s :: "'a::real_normed_vector set"
76.1 --- a/src/HOL/NSA/HTranscendental.thy Mon Nov 18 17:15:01 2013 +0100
76.2 +++ b/src/HOL/NSA/HTranscendental.thy Tue Nov 19 17:07:52 2013 +0100
76.3 @@ -258,7 +258,7 @@
76.4 simp add: mult_assoc)
76.5 apply (rule approx_add_right_cancel [where d="-1"])
76.6 apply (rule approx_sym [THEN [2] approx_trans2])
76.7 -apply (auto simp add: mem_infmal_iff minus_one [symmetric] simp del: minus_one)
76.8 +apply (auto simp add: mem_infmal_iff)
76.9 done
76.10
76.11 lemma STAR_exp_epsilon [simp]: "( *f* exp) epsilon @= 1"
76.12 @@ -450,7 +450,7 @@
76.13 apply (auto intro: Infinitesimal_subset_HFinite [THEN subsetD]
76.14 simp add: mult_assoc)
76.15 apply (rule approx_add_right_cancel [where d = "-1"])
76.16 -apply (simp add: minus_one [symmetric] del: minus_one)
76.17 +apply simp
76.18 done
76.19
76.20 lemma STAR_tan_zero [simp]: "( *f* tan) 0 = 0"
77.1 --- a/src/HOL/NSA/HyperDef.thy Mon Nov 18 17:15:01 2013 +0100
77.2 +++ b/src/HOL/NSA/HyperDef.thy Tue Nov 19 17:07:52 2013 +0100
77.3 @@ -425,7 +425,7 @@
77.4 declare power_hypreal_of_real_numeral [of _ "numeral w", simp] for w
77.5
77.6 lemma power_hypreal_of_real_neg_numeral:
77.7 - "(neg_numeral v :: hypreal) ^ n = hypreal_of_real ((neg_numeral v) ^ n)"
77.8 + "(- numeral v :: hypreal) ^ n = hypreal_of_real ((- numeral v) ^ n)"
77.9 by simp
77.10 declare power_hypreal_of_real_neg_numeral [of _ "numeral w", simp] for w
77.11 (*
78.1 --- a/src/HOL/NSA/NSA.thy Mon Nov 18 17:15:01 2013 +0100
78.2 +++ b/src/HOL/NSA/NSA.thy Tue Nov 19 17:07:52 2013 +0100
78.3 @@ -654,7 +654,7 @@
78.4 (*reorientation simplification procedure: reorients (polymorphic)
78.5 0 = x, 1 = x, nnn = x provided x isn't 0, 1 or a numeral.*)
78.6 simproc_setup approx_reorient_simproc
78.7 - ("0 @= x" | "1 @= y" | "numeral w @= z" | "neg_numeral w @= r") =
78.8 + ("0 @= x" | "1 @= y" | "numeral w @= z" | "- 1 @= y" | "- numeral w @= r") =
78.9 {*
78.10 let val rule = @{thm approx_reorient} RS eq_reflection
78.11 fun proc phi ss ct = case term_of ct of
78.12 @@ -1849,8 +1849,12 @@
78.13 lemma st_numeral [simp]: "st (numeral w) = numeral w"
78.14 by (rule Reals_numeral [THEN st_SReal_eq])
78.15
78.16 -lemma st_neg_numeral [simp]: "st (neg_numeral w) = neg_numeral w"
78.17 -by (rule Reals_neg_numeral [THEN st_SReal_eq])
78.18 +lemma st_neg_numeral [simp]: "st (- numeral w) = - numeral w"
78.19 +proof -
78.20 + from Reals_numeral have "numeral w \<in> \<real>" .
78.21 + then have "- numeral w \<in> \<real>" by simp
78.22 + with st_SReal_eq show ?thesis .
78.23 +qed
78.24
78.25 lemma st_0 [simp]: "st 0 = 0"
78.26 by (simp add: st_SReal_eq)
78.27 @@ -1858,6 +1862,9 @@
78.28 lemma st_1 [simp]: "st 1 = 1"
78.29 by (simp add: st_SReal_eq)
78.30
78.31 +lemma st_neg_1 [simp]: "st (- 1) = - 1"
78.32 +by (simp add: st_SReal_eq)
78.33 +
78.34 lemma st_minus: "x \<in> HFinite \<Longrightarrow> st (- x) = - st x"
78.35 by (simp add: st_unique st_SReal st_approx_self approx_minus)
78.36
79.1 --- a/src/HOL/NSA/NSComplex.thy Mon Nov 18 17:15:01 2013 +0100
79.2 +++ b/src/HOL/NSA/NSComplex.thy Tue Nov 19 17:07:52 2013 +0100
79.3 @@ -635,7 +635,7 @@
79.4 by transfer (rule of_real_numeral [symmetric])
79.5
79.6 lemma hcomplex_hypreal_neg_numeral:
79.7 - "hcomplex_of_complex (neg_numeral w) = hcomplex_of_hypreal(neg_numeral w)"
79.8 + "hcomplex_of_complex (- numeral w) = hcomplex_of_hypreal(- numeral w)"
79.9 by transfer (rule of_real_neg_numeral [symmetric])
79.10
79.11 lemma hcomplex_numeral_hcnj [simp]:
79.12 @@ -647,7 +647,7 @@
79.13 by transfer (rule norm_numeral)
79.14
79.15 lemma hcomplex_neg_numeral_hcmod [simp]:
79.16 - "hcmod(neg_numeral v :: hcomplex) = (numeral v :: hypreal)"
79.17 + "hcmod(- numeral v :: hcomplex) = (numeral v :: hypreal)"
79.18 by transfer (rule norm_neg_numeral)
79.19
79.20 lemma hcomplex_numeral_hRe [simp]:
80.1 --- a/src/HOL/NSA/StarDef.thy Mon Nov 18 17:15:01 2013 +0100
80.2 +++ b/src/HOL/NSA/StarDef.thy Tue Nov 19 17:07:52 2013 +0100
80.3 @@ -968,13 +968,13 @@
80.4 by transfer (rule refl)
80.5
80.6 lemma star_neg_numeral_def [transfer_unfold]:
80.7 - "neg_numeral k = star_of (neg_numeral k)"
80.8 -by (simp only: neg_numeral_def star_of_minus star_of_numeral)
80.9 + "- numeral k = star_of (- numeral k)"
80.10 +by (simp only: star_of_minus star_of_numeral)
80.11
80.12 -lemma Standard_neg_numeral [simp]: "neg_numeral k \<in> Standard"
80.13 -by (simp add: star_neg_numeral_def)
80.14 +lemma Standard_neg_numeral [simp]: "- numeral k \<in> Standard"
80.15 + using star_neg_numeral_def [of k] by simp
80.16
80.17 -lemma star_of_neg_numeral [simp]: "star_of (neg_numeral k) = neg_numeral k"
80.18 +lemma star_of_neg_numeral [simp]: "star_of (- numeral k) = - numeral k"
80.19 by transfer (rule refl)
80.20
80.21 lemma star_of_nat_def [transfer_unfold]: "of_nat n = star_of (of_nat n)"
80.22 @@ -987,12 +987,12 @@
80.23 star_of_less [of _ "numeral k", simplified star_of_numeral]
80.24 star_of_le [of _ "numeral k", simplified star_of_numeral]
80.25 star_of_eq [of _ "numeral k", simplified star_of_numeral]
80.26 - star_of_less [of "neg_numeral k", simplified star_of_numeral]
80.27 - star_of_le [of "neg_numeral k", simplified star_of_numeral]
80.28 - star_of_eq [of "neg_numeral k", simplified star_of_numeral]
80.29 - star_of_less [of _ "neg_numeral k", simplified star_of_numeral]
80.30 - star_of_le [of _ "neg_numeral k", simplified star_of_numeral]
80.31 - star_of_eq [of _ "neg_numeral k", simplified star_of_numeral] for k
80.32 + star_of_less [of "- numeral k", simplified star_of_numeral]
80.33 + star_of_le [of "- numeral k", simplified star_of_numeral]
80.34 + star_of_eq [of "- numeral k", simplified star_of_numeral]
80.35 + star_of_less [of _ "- numeral k", simplified star_of_numeral]
80.36 + star_of_le [of _ "- numeral k", simplified star_of_numeral]
80.37 + star_of_eq [of _ "- numeral k", simplified star_of_numeral] for k
80.38
80.39 lemma Standard_of_nat [simp]: "of_nat n \<in> Standard"
80.40 by (simp add: star_of_nat_def)
81.1 --- a/src/HOL/Nominal/Nominal.thy Mon Nov 18 17:15:01 2013 +0100
81.2 +++ b/src/HOL/Nominal/Nominal.thy Tue Nov 19 17:07:52 2013 +0100
81.3 @@ -3517,7 +3517,7 @@
81.4 by (simp add: perm_int_def perm_int_def)
81.5
81.6 lemma neg_numeral_int_eqvt:
81.7 - shows "pi\<bullet>((neg_numeral n)::int) = neg_numeral n"
81.8 + shows "pi\<bullet>((- numeral n)::int) = - numeral n"
81.9 by (simp add: perm_int_def perm_int_def)
81.10
81.11 lemma max_int_eqvt:
82.1 --- a/src/HOL/Num.thy Mon Nov 18 17:15:01 2013 +0100
82.2 +++ b/src/HOL/Num.thy Tue Nov 19 17:07:52 2013 +0100
82.3 @@ -275,16 +275,6 @@
82.4
82.5 end
82.6
82.7 -text {* Negative numerals. *}
82.8 -
82.9 -class neg_numeral = numeral + group_add
82.10 -begin
82.11 -
82.12 -definition neg_numeral :: "num \<Rightarrow> 'a" where
82.13 - "neg_numeral k = - numeral k"
82.14 -
82.15 -end
82.16 -
82.17 text {* Numeral syntax. *}
82.18
82.19 syntax
82.20 @@ -299,8 +289,8 @@
82.21 | (n, 0) => Syntax.const @{const_name Bit0} $ num_of_int n
82.22 | (n, 1) => Syntax.const @{const_name Bit1} $ num_of_int n)
82.23 else raise Match
82.24 - val pos = Syntax.const @{const_name numeral}
82.25 - val neg = Syntax.const @{const_name neg_numeral}
82.26 + val numeral = Syntax.const @{const_name numeral}
82.27 + val uminus = Syntax.const @{const_name uminus}
82.28 val one = Syntax.const @{const_name Groups.one}
82.29 val zero = Syntax.const @{const_name Groups.zero}
82.30 fun numeral_tr [(c as Const (@{syntax_const "_constrain"}, _)) $ t $ u] =
82.31 @@ -311,8 +301,9 @@
82.32 in
82.33 if value = 0 then zero else
82.34 if value > 0
82.35 - then pos $ num_of_int value
82.36 - else neg $ num_of_int (~value)
82.37 + then numeral $ num_of_int value
82.38 + else if value = ~1 then uminus $ one
82.39 + else uminus $ (numeral $ num_of_int (~value))
82.40 end
82.41 | numeral_tr ts = raise TERM ("numeral_tr", ts);
82.42 in [("_Numeral", K numeral_tr)] end
82.43 @@ -323,12 +314,12 @@
82.44 fun dest_num (Const (@{const_syntax Bit0}, _) $ n) = 2 * dest_num n
82.45 | dest_num (Const (@{const_syntax Bit1}, _) $ n) = 2 * dest_num n + 1
82.46 | dest_num (Const (@{const_syntax One}, _)) = 1;
82.47 - fun num_tr' sign ctxt T [n] =
82.48 + fun num_tr' ctxt T [n] =
82.49 let
82.50 val k = dest_num n;
82.51 val t' =
82.52 Syntax.const @{syntax_const "_Numeral"} $
82.53 - Syntax.free (sign ^ string_of_int k);
82.54 + Syntax.free (string_of_int k);
82.55 in
82.56 (case T of
82.57 Type (@{type_name fun}, [_, T']) =>
82.58 @@ -339,8 +330,7 @@
82.59 | _ => if T = dummyT then t' else raise Match)
82.60 end;
82.61 in
82.62 - [(@{const_syntax numeral}, num_tr' ""),
82.63 - (@{const_syntax neg_numeral}, num_tr' "-")]
82.64 + [(@{const_syntax numeral}, num_tr')]
82.65 end
82.66 *}
82.67
82.68 @@ -383,9 +373,13 @@
82.69 Structures with negation: class @{text neg_numeral}
82.70 *}
82.71
82.72 -context neg_numeral
82.73 +class neg_numeral = numeral + group_add
82.74 begin
82.75
82.76 +lemma uminus_numeral_One:
82.77 + "- Numeral1 = - 1"
82.78 + by (simp add: numeral_One)
82.79 +
82.80 text {* Numerals form an abelian subgroup. *}
82.81
82.82 inductive is_num :: "'a \<Rightarrow> bool" where
82.83 @@ -403,7 +397,7 @@
82.84 apply simp
82.85 apply (rule_tac a=x in add_left_imp_eq)
82.86 apply (rule_tac a=x in add_right_imp_eq)
82.87 - apply (simp add: add_assoc minus_add_cancel)
82.88 + apply (simp add: add_assoc)
82.89 apply (simp add: add_assoc [symmetric], simp add: add_assoc)
82.90 apply (rule_tac a=x in add_left_imp_eq)
82.91 apply (rule_tac a=x in add_right_imp_eq)
82.92 @@ -431,77 +425,85 @@
82.93 by (simp only: BitM_plus_one [symmetric] numeral_add numeral_One eq_diff_eq)
82.94
82.95 lemma dbl_simps [simp]:
82.96 - "dbl (neg_numeral k) = neg_numeral (Bit0 k)"
82.97 + "dbl (- numeral k) = - dbl (numeral k)"
82.98 "dbl 0 = 0"
82.99 "dbl 1 = 2"
82.100 + "dbl (- 1) = - 2"
82.101 "dbl (numeral k) = numeral (Bit0 k)"
82.102 - by (simp_all add: dbl_def neg_numeral_def numeral.simps minus_add)
82.103 + by (simp_all add: dbl_def numeral.simps minus_add)
82.104
82.105 lemma dbl_inc_simps [simp]:
82.106 - "dbl_inc (neg_numeral k) = neg_numeral (BitM k)"
82.107 + "dbl_inc (- numeral k) = - dbl_dec (numeral k)"
82.108 "dbl_inc 0 = 1"
82.109 "dbl_inc 1 = 3"
82.110 + "dbl_inc (- 1) = - 1"
82.111 "dbl_inc (numeral k) = numeral (Bit1 k)"
82.112 - by (simp_all add: dbl_inc_def neg_numeral_def numeral.simps numeral_BitM is_num_normalize algebra_simps del: add_uminus_conv_diff)
82.113 + by (simp_all add: dbl_inc_def dbl_dec_def numeral.simps numeral_BitM is_num_normalize algebra_simps del: add_uminus_conv_diff)
82.114
82.115 lemma dbl_dec_simps [simp]:
82.116 - "dbl_dec (neg_numeral k) = neg_numeral (Bit1 k)"
82.117 - "dbl_dec 0 = -1"
82.118 + "dbl_dec (- numeral k) = - dbl_inc (numeral k)"
82.119 + "dbl_dec 0 = - 1"
82.120 "dbl_dec 1 = 1"
82.121 + "dbl_dec (- 1) = - 3"
82.122 "dbl_dec (numeral k) = numeral (BitM k)"
82.123 - by (simp_all add: dbl_dec_def neg_numeral_def numeral.simps numeral_BitM is_num_normalize)
82.124 + by (simp_all add: dbl_dec_def dbl_inc_def numeral.simps numeral_BitM is_num_normalize)
82.125
82.126 lemma sub_num_simps [simp]:
82.127 "sub One One = 0"
82.128 - "sub One (Bit0 l) = neg_numeral (BitM l)"
82.129 - "sub One (Bit1 l) = neg_numeral (Bit0 l)"
82.130 + "sub One (Bit0 l) = - numeral (BitM l)"
82.131 + "sub One (Bit1 l) = - numeral (Bit0 l)"
82.132 "sub (Bit0 k) One = numeral (BitM k)"
82.133 "sub (Bit1 k) One = numeral (Bit0 k)"
82.134 "sub (Bit0 k) (Bit0 l) = dbl (sub k l)"
82.135 "sub (Bit0 k) (Bit1 l) = dbl_dec (sub k l)"
82.136 "sub (Bit1 k) (Bit0 l) = dbl_inc (sub k l)"
82.137 "sub (Bit1 k) (Bit1 l) = dbl (sub k l)"
82.138 - by (simp_all add: dbl_def dbl_dec_def dbl_inc_def sub_def neg_numeral_def numeral.simps
82.139 + by (simp_all add: dbl_def dbl_dec_def dbl_inc_def sub_def numeral.simps
82.140 numeral_BitM is_num_normalize del: add_uminus_conv_diff add: diff_conv_add_uminus)
82.141
82.142 lemma add_neg_numeral_simps:
82.143 - "numeral m + neg_numeral n = sub m n"
82.144 - "neg_numeral m + numeral n = sub n m"
82.145 - "neg_numeral m + neg_numeral n = neg_numeral (m + n)"
82.146 - by (simp_all add: sub_def neg_numeral_def numeral_add numeral.simps is_num_normalize
82.147 + "numeral m + - numeral n = sub m n"
82.148 + "- numeral m + numeral n = sub n m"
82.149 + "- numeral m + - numeral n = - (numeral m + numeral n)"
82.150 + by (simp_all add: sub_def numeral_add numeral.simps is_num_normalize
82.151 del: add_uminus_conv_diff add: diff_conv_add_uminus)
82.152
82.153 lemma add_neg_numeral_special:
82.154 - "1 + neg_numeral m = sub One m"
82.155 - "neg_numeral m + 1 = sub One m"
82.156 - by (simp_all add: sub_def neg_numeral_def numeral_add numeral.simps is_num_normalize)
82.157 + "1 + - numeral m = sub One m"
82.158 + "- numeral m + 1 = sub One m"
82.159 + "numeral m + - 1 = sub m One"
82.160 + "- 1 + numeral n = sub n One"
82.161 + "- 1 + - numeral n = - numeral (inc n)"
82.162 + "- numeral m + - 1 = - numeral (inc m)"
82.163 + "1 + - 1 = 0"
82.164 + "- 1 + 1 = 0"
82.165 + "- 1 + - 1 = - 2"
82.166 + by (simp_all add: sub_def numeral_add numeral.simps is_num_normalize right_minus numeral_inc
82.167 + del: add_uminus_conv_diff add: diff_conv_add_uminus)
82.168
82.169 lemma diff_numeral_simps:
82.170 "numeral m - numeral n = sub m n"
82.171 - "numeral m - neg_numeral n = numeral (m + n)"
82.172 - "neg_numeral m - numeral n = neg_numeral (m + n)"
82.173 - "neg_numeral m - neg_numeral n = sub n m"
82.174 - by (simp_all add: neg_numeral_def sub_def numeral_add numeral.simps is_num_normalize
82.175 + "numeral m - - numeral n = numeral (m + n)"
82.176 + "- numeral m - numeral n = - numeral (m + n)"
82.177 + "- numeral m - - numeral n = sub n m"
82.178 + by (simp_all add: sub_def numeral_add numeral.simps is_num_normalize
82.179 del: add_uminus_conv_diff add: diff_conv_add_uminus)
82.180
82.181 lemma diff_numeral_special:
82.182 "1 - numeral n = sub One n"
82.183 - "1 - neg_numeral n = numeral (One + n)"
82.184 "numeral m - 1 = sub m One"
82.185 - "neg_numeral m - 1 = neg_numeral (m + One)"
82.186 - by (simp_all add: neg_numeral_def sub_def numeral_add numeral.simps add: is_num_normalize)
82.187 -
82.188 -lemma minus_one: "- 1 = -1"
82.189 - unfolding neg_numeral_def numeral.simps ..
82.190 -
82.191 -lemma minus_numeral: "- numeral n = neg_numeral n"
82.192 - unfolding neg_numeral_def ..
82.193 -
82.194 -lemma minus_neg_numeral: "- neg_numeral n = numeral n"
82.195 - unfolding neg_numeral_def by simp
82.196 -
82.197 -lemmas minus_numeral_simps [simp] =
82.198 - minus_one minus_numeral minus_neg_numeral
82.199 + "1 - - numeral n = numeral (One + n)"
82.200 + "- numeral m - 1 = - numeral (m + One)"
82.201 + "- 1 - numeral n = - numeral (inc n)"
82.202 + "numeral m - - 1 = numeral (inc m)"
82.203 + "- 1 - - numeral n = sub n One"
82.204 + "- numeral m - - 1 = sub One m"
82.205 + "1 - 1 = 0"
82.206 + "- 1 - 1 = - 2"
82.207 + "1 - - 1 = 2"
82.208 + "- 1 - - 1 = 0"
82.209 + by (simp_all add: sub_def numeral_add numeral.simps is_num_normalize numeral_inc
82.210 + del: add_uminus_conv_diff add: diff_conv_add_uminus)
82.211
82.212 end
82.213
82.214 @@ -675,17 +677,17 @@
82.215 subclass neg_numeral ..
82.216
82.217 lemma mult_neg_numeral_simps:
82.218 - "neg_numeral m * neg_numeral n = numeral (m * n)"
82.219 - "neg_numeral m * numeral n = neg_numeral (m * n)"
82.220 - "numeral m * neg_numeral n = neg_numeral (m * n)"
82.221 - unfolding neg_numeral_def mult_minus_left mult_minus_right
82.222 + "- numeral m * - numeral n = numeral (m * n)"
82.223 + "- numeral m * numeral n = - numeral (m * n)"
82.224 + "numeral m * - numeral n = - numeral (m * n)"
82.225 + unfolding mult_minus_left mult_minus_right
82.226 by (simp_all only: minus_minus numeral_mult)
82.227
82.228 -lemma mult_minus1 [simp]: "-1 * z = - z"
82.229 - unfolding neg_numeral_def numeral.simps mult_minus_left by simp
82.230 +lemma mult_minus1 [simp]: "- 1 * z = - z"
82.231 + unfolding numeral.simps mult_minus_left by simp
82.232
82.233 -lemma mult_minus1_right [simp]: "z * -1 = - z"
82.234 - unfolding neg_numeral_def numeral.simps mult_minus_right by simp
82.235 +lemma mult_minus1_right [simp]: "z * - 1 = - z"
82.236 + unfolding numeral.simps mult_minus_right by simp
82.237
82.238 end
82.239
82.240 @@ -708,9 +710,15 @@
82.241 lemma not_iszero_Numeral1: "\<not> iszero Numeral1"
82.242 by (simp add: numeral_One)
82.243
82.244 +lemma not_iszero_neg_1 [simp]: "\<not> iszero (- 1)"
82.245 + by (simp add: iszero_def)
82.246 +
82.247 +lemma not_iszero_neg_Numeral1: "\<not> iszero (- Numeral1)"
82.248 + by (simp add: numeral_One)
82.249 +
82.250 lemma iszero_neg_numeral [simp]:
82.251 - "iszero (neg_numeral w) \<longleftrightarrow> iszero (numeral w)"
82.252 - unfolding iszero_def neg_numeral_def
82.253 + "iszero (- numeral w) \<longleftrightarrow> iszero (numeral w)"
82.254 + unfolding iszero_def
82.255 by (rule neg_equal_0_iff_equal)
82.256
82.257 lemma eq_iff_iszero_diff: "x = y \<longleftrightarrow> iszero (x - y)"
82.258 @@ -730,17 +738,17 @@
82.259
82.260 lemma eq_numeral_iff_iszero:
82.261 "numeral x = numeral y \<longleftrightarrow> iszero (sub x y)"
82.262 - "numeral x = neg_numeral y \<longleftrightarrow> iszero (numeral (x + y))"
82.263 - "neg_numeral x = numeral y \<longleftrightarrow> iszero (numeral (x + y))"
82.264 - "neg_numeral x = neg_numeral y \<longleftrightarrow> iszero (sub y x)"
82.265 + "numeral x = - numeral y \<longleftrightarrow> iszero (numeral (x + y))"
82.266 + "- numeral x = numeral y \<longleftrightarrow> iszero (numeral (x + y))"
82.267 + "- numeral x = - numeral y \<longleftrightarrow> iszero (sub y x)"
82.268 "numeral x = 1 \<longleftrightarrow> iszero (sub x One)"
82.269 "1 = numeral y \<longleftrightarrow> iszero (sub One y)"
82.270 - "neg_numeral x = 1 \<longleftrightarrow> iszero (numeral (x + One))"
82.271 - "1 = neg_numeral y \<longleftrightarrow> iszero (numeral (One + y))"
82.272 + "- numeral x = 1 \<longleftrightarrow> iszero (numeral (x + One))"
82.273 + "1 = - numeral y \<longleftrightarrow> iszero (numeral (One + y))"
82.274 "numeral x = 0 \<longleftrightarrow> iszero (numeral x)"
82.275 "0 = numeral y \<longleftrightarrow> iszero (numeral y)"
82.276 - "neg_numeral x = 0 \<longleftrightarrow> iszero (numeral x)"
82.277 - "0 = neg_numeral y \<longleftrightarrow> iszero (numeral y)"
82.278 + "- numeral x = 0 \<longleftrightarrow> iszero (numeral x)"
82.279 + "0 = - numeral y \<longleftrightarrow> iszero (numeral y)"
82.280 unfolding eq_iff_iszero_diff diff_numeral_simps diff_numeral_special
82.281 by simp_all
82.282
82.283 @@ -756,33 +764,69 @@
82.284 lemma not_iszero_numeral [simp]: "\<not> iszero (numeral w)"
82.285 by (simp add: iszero_def)
82.286
82.287 -lemma neg_numeral_eq_iff: "neg_numeral m = neg_numeral n \<longleftrightarrow> m = n"
82.288 - by (simp only: neg_numeral_def neg_equal_iff_equal numeral_eq_iff)
82.289 +lemma neg_numeral_eq_iff: "- numeral m = - numeral n \<longleftrightarrow> m = n"
82.290 + by simp
82.291
82.292 -lemma numeral_neq_neg_numeral: "numeral m \<noteq> neg_numeral n"
82.293 - unfolding neg_numeral_def eq_neg_iff_add_eq_0
82.294 +lemma numeral_neq_neg_numeral: "numeral m \<noteq> - numeral n"
82.295 + unfolding eq_neg_iff_add_eq_0
82.296 by (simp add: numeral_plus_numeral)
82.297
82.298 -lemma neg_numeral_neq_numeral: "neg_numeral m \<noteq> numeral n"
82.299 +lemma neg_numeral_neq_numeral: "- numeral m \<noteq> numeral n"
82.300 by (rule numeral_neq_neg_numeral [symmetric])
82.301
82.302 -lemma zero_neq_neg_numeral: "0 \<noteq> neg_numeral n"
82.303 - unfolding neg_numeral_def neg_0_equal_iff_equal by simp
82.304 +lemma zero_neq_neg_numeral: "0 \<noteq> - numeral n"
82.305 + unfolding neg_0_equal_iff_equal by simp
82.306
82.307 -lemma neg_numeral_neq_zero: "neg_numeral n \<noteq> 0"
82.308 - unfolding neg_numeral_def neg_equal_0_iff_equal by simp
82.309 +lemma neg_numeral_neq_zero: "- numeral n \<noteq> 0"
82.310 + unfolding neg_equal_0_iff_equal by simp
82.311
82.312 -lemma one_neq_neg_numeral: "1 \<noteq> neg_numeral n"
82.313 +lemma one_neq_neg_numeral: "1 \<noteq> - numeral n"
82.314 using numeral_neq_neg_numeral [of One n] by (simp add: numeral_One)
82.315
82.316 -lemma neg_numeral_neq_one: "neg_numeral n \<noteq> 1"
82.317 +lemma neg_numeral_neq_one: "- numeral n \<noteq> 1"
82.318 using neg_numeral_neq_numeral [of n One] by (simp add: numeral_One)
82.319
82.320 +lemma neg_one_neq_numeral:
82.321 + "- 1 \<noteq> numeral n"
82.322 + using neg_numeral_neq_numeral [of One n] by (simp add: numeral_One)
82.323 +
82.324 +lemma numeral_neq_neg_one:
82.325 + "numeral n \<noteq> - 1"
82.326 + using numeral_neq_neg_numeral [of n One] by (simp add: numeral_One)
82.327 +
82.328 +lemma neg_one_eq_numeral_iff:
82.329 + "- 1 = - numeral n \<longleftrightarrow> n = One"
82.330 + using neg_numeral_eq_iff [of One n] by (auto simp add: numeral_One)
82.331 +
82.332 +lemma numeral_eq_neg_one_iff:
82.333 + "- numeral n = - 1 \<longleftrightarrow> n = One"
82.334 + using neg_numeral_eq_iff [of n One] by (auto simp add: numeral_One)
82.335 +
82.336 +lemma neg_one_neq_zero:
82.337 + "- 1 \<noteq> 0"
82.338 + by simp
82.339 +
82.340 +lemma zero_neq_neg_one:
82.341 + "0 \<noteq> - 1"
82.342 + by simp
82.343 +
82.344 +lemma neg_one_neq_one:
82.345 + "- 1 \<noteq> 1"
82.346 + using neg_numeral_neq_numeral [of One One] by (simp only: numeral_One not_False_eq_True)
82.347 +
82.348 +lemma one_neq_neg_one:
82.349 + "1 \<noteq> - 1"
82.350 + using numeral_neq_neg_numeral [of One One] by (simp only: numeral_One not_False_eq_True)
82.351 +
82.352 lemmas eq_neg_numeral_simps [simp] =
82.353 neg_numeral_eq_iff
82.354 numeral_neq_neg_numeral neg_numeral_neq_numeral
82.355 one_neq_neg_numeral neg_numeral_neq_one
82.356 zero_neq_neg_numeral neg_numeral_neq_zero
82.357 + neg_one_neq_numeral numeral_neq_neg_one
82.358 + neg_one_eq_numeral_iff numeral_eq_neg_one_iff
82.359 + neg_one_neq_zero zero_neq_neg_one
82.360 + neg_one_neq_one one_neq_neg_one
82.361
82.362 end
82.363
82.364 @@ -795,48 +839,72 @@
82.365
82.366 subclass ring_char_0 ..
82.367
82.368 -lemma neg_numeral_le_iff: "neg_numeral m \<le> neg_numeral n \<longleftrightarrow> n \<le> m"
82.369 - by (simp only: neg_numeral_def neg_le_iff_le numeral_le_iff)
82.370 +lemma neg_numeral_le_iff: "- numeral m \<le> - numeral n \<longleftrightarrow> n \<le> m"
82.371 + by (simp only: neg_le_iff_le numeral_le_iff)
82.372
82.373 -lemma neg_numeral_less_iff: "neg_numeral m < neg_numeral n \<longleftrightarrow> n < m"
82.374 - by (simp only: neg_numeral_def neg_less_iff_less numeral_less_iff)
82.375 +lemma neg_numeral_less_iff: "- numeral m < - numeral n \<longleftrightarrow> n < m"
82.376 + by (simp only: neg_less_iff_less numeral_less_iff)
82.377
82.378 -lemma neg_numeral_less_zero: "neg_numeral n < 0"
82.379 - by (simp only: neg_numeral_def neg_less_0_iff_less zero_less_numeral)
82.380 +lemma neg_numeral_less_zero: "- numeral n < 0"
82.381 + by (simp only: neg_less_0_iff_less zero_less_numeral)
82.382
82.383 -lemma neg_numeral_le_zero: "neg_numeral n \<le> 0"
82.384 - by (simp only: neg_numeral_def neg_le_0_iff_le zero_le_numeral)
82.385 +lemma neg_numeral_le_zero: "- numeral n \<le> 0"
82.386 + by (simp only: neg_le_0_iff_le zero_le_numeral)
82.387
82.388 -lemma not_zero_less_neg_numeral: "\<not> 0 < neg_numeral n"
82.389 +lemma not_zero_less_neg_numeral: "\<not> 0 < - numeral n"
82.390 by (simp only: not_less neg_numeral_le_zero)
82.391
82.392 -lemma not_zero_le_neg_numeral: "\<not> 0 \<le> neg_numeral n"
82.393 +lemma not_zero_le_neg_numeral: "\<not> 0 \<le> - numeral n"
82.394 by (simp only: not_le neg_numeral_less_zero)
82.395
82.396 -lemma neg_numeral_less_numeral: "neg_numeral m < numeral n"
82.397 +lemma neg_numeral_less_numeral: "- numeral m < numeral n"
82.398 using neg_numeral_less_zero zero_less_numeral by (rule less_trans)
82.399
82.400 -lemma neg_numeral_le_numeral: "neg_numeral m \<le> numeral n"
82.401 +lemma neg_numeral_le_numeral: "- numeral m \<le> numeral n"
82.402 by (simp only: less_imp_le neg_numeral_less_numeral)
82.403
82.404 -lemma not_numeral_less_neg_numeral: "\<not> numeral m < neg_numeral n"
82.405 +lemma not_numeral_less_neg_numeral: "\<not> numeral m < - numeral n"
82.406 by (simp only: not_less neg_numeral_le_numeral)
82.407
82.408 -lemma not_numeral_le_neg_numeral: "\<not> numeral m \<le> neg_numeral n"
82.409 +lemma not_numeral_le_neg_numeral: "\<not> numeral m \<le> - numeral n"
82.410 by (simp only: not_le neg_numeral_less_numeral)
82.411
82.412 -lemma neg_numeral_less_one: "neg_numeral m < 1"
82.413 +lemma neg_numeral_less_one: "- numeral m < 1"
82.414 by (rule neg_numeral_less_numeral [of m One, unfolded numeral_One])
82.415
82.416 -lemma neg_numeral_le_one: "neg_numeral m \<le> 1"
82.417 +lemma neg_numeral_le_one: "- numeral m \<le> 1"
82.418 by (rule neg_numeral_le_numeral [of m One, unfolded numeral_One])
82.419
82.420 -lemma not_one_less_neg_numeral: "\<not> 1 < neg_numeral m"
82.421 +lemma not_one_less_neg_numeral: "\<not> 1 < - numeral m"
82.422 by (simp only: not_less neg_numeral_le_one)
82.423
82.424 -lemma not_one_le_neg_numeral: "\<not> 1 \<le> neg_numeral m"
82.425 +lemma not_one_le_neg_numeral: "\<not> 1 \<le> - numeral m"
82.426 by (simp only: not_le neg_numeral_less_one)
82.427
82.428 +lemma not_numeral_less_neg_one: "\<not> numeral m < - 1"
82.429 + using not_numeral_less_neg_numeral [of m One] by (simp add: numeral_One)
82.430 +
82.431 +lemma not_numeral_le_neg_one: "\<not> numeral m \<le> - 1"
82.432 + using not_numeral_le_neg_numeral [of m One] by (simp add: numeral_One)
82.433 +
82.434 +lemma neg_one_less_numeral: "- 1 < numeral m"
82.435 + using neg_numeral_less_numeral [of One m] by (simp add: numeral_One)
82.436 +
82.437 +lemma neg_one_le_numeral: "- 1 \<le> numeral m"
82.438 + using neg_numeral_le_numeral [of One m] by (simp add: numeral_One)
82.439 +
82.440 +lemma neg_numeral_less_neg_one_iff: "- numeral m < - 1 \<longleftrightarrow> m \<noteq> One"
82.441 + by (cases m) simp_all
82.442 +
82.443 +lemma neg_numeral_le_neg_one: "- numeral m \<le> - 1"
82.444 + by simp
82.445 +
82.446 +lemma not_neg_one_less_neg_numeral: "\<not> - 1 < - numeral m"
82.447 + by simp
82.448 +
82.449 +lemma not_neg_one_le_neg_numeral_iff: "\<not> - 1 \<le> - numeral m \<longleftrightarrow> m \<noteq> One"
82.450 + by (cases m) simp_all
82.451 +
82.452 lemma sub_non_negative:
82.453 "sub n m \<ge> 0 \<longleftrightarrow> n \<ge> m"
82.454 by (simp only: sub_def le_diff_eq) simp
82.455 @@ -858,18 +926,40 @@
82.456 neg_numeral_le_numeral not_numeral_le_neg_numeral
82.457 neg_numeral_le_zero not_zero_le_neg_numeral
82.458 neg_numeral_le_one not_one_le_neg_numeral
82.459 + neg_one_le_numeral not_numeral_le_neg_one
82.460 + neg_numeral_le_neg_one not_neg_one_le_neg_numeral_iff
82.461 +
82.462 +lemma le_minus_one_simps [simp]:
82.463 + "- 1 \<le> 0"
82.464 + "- 1 \<le> 1"
82.465 + "\<not> 0 \<le> - 1"
82.466 + "\<not> 1 \<le> - 1"
82.467 + by simp_all
82.468
82.469 lemmas less_neg_numeral_simps [simp] =
82.470 neg_numeral_less_iff
82.471 neg_numeral_less_numeral not_numeral_less_neg_numeral
82.472 neg_numeral_less_zero not_zero_less_neg_numeral
82.473 neg_numeral_less_one not_one_less_neg_numeral
82.474 + neg_one_less_numeral not_numeral_less_neg_one
82.475 + neg_numeral_less_neg_one_iff not_neg_one_less_neg_numeral
82.476 +
82.477 +lemma less_minus_one_simps [simp]:
82.478 + "- 1 < 0"
82.479 + "- 1 < 1"
82.480 + "\<not> 0 < - 1"
82.481 + "\<not> 1 < - 1"
82.482 + by (simp_all add: less_le)
82.483
82.484 lemma abs_numeral [simp]: "abs (numeral n) = numeral n"
82.485 by simp
82.486
82.487 -lemma abs_neg_numeral [simp]: "abs (neg_numeral n) = numeral n"
82.488 - by (simp only: neg_numeral_def abs_minus_cancel abs_numeral)
82.489 +lemma abs_neg_numeral [simp]: "abs (- numeral n) = numeral n"
82.490 + by (simp only: abs_minus_cancel abs_numeral)
82.491 +
82.492 +lemma abs_neg_one [simp]:
82.493 + "abs (- 1) = 1"
82.494 + by simp
82.495
82.496 end
82.497
82.498 @@ -1032,31 +1122,36 @@
82.499 text{*Theorem lists for the cancellation simprocs. The use of a binary
82.500 numeral for 1 reduces the number of special cases.*}
82.501
82.502 -lemmas mult_1s =
82.503 - mult_numeral_1 mult_numeral_1_right
82.504 - mult_minus1 mult_minus1_right
82.505 +lemma mult_1s:
82.506 + fixes a :: "'a::semiring_numeral"
82.507 + and b :: "'b::ring_1"
82.508 + shows "Numeral1 * a = a"
82.509 + "a * Numeral1 = a"
82.510 + "- Numeral1 * b = - b"
82.511 + "b * - Numeral1 = - b"
82.512 + by simp_all
82.513
82.514 setup {*
82.515 Reorient_Proc.add
82.516 (fn Const (@{const_name numeral}, _) $ _ => true
82.517 - | Const (@{const_name neg_numeral}, _) $ _ => true
82.518 + | Const (@{const_name uminus}, _) $ (Const (@{const_name numeral}, _) $ _) => true
82.519 | _ => false)
82.520 *}
82.521
82.522 simproc_setup reorient_numeral
82.523 - ("numeral w = x" | "neg_numeral w = y") = Reorient_Proc.proc
82.524 + ("numeral w = x" | "- numeral w = y") = Reorient_Proc.proc
82.525
82.526
82.527 subsubsection {* Simplification of arithmetic operations on integer constants. *}
82.528
82.529 lemmas arith_special = (* already declared simp above *)
82.530 add_numeral_special add_neg_numeral_special
82.531 - diff_numeral_special minus_one
82.532 + diff_numeral_special
82.533
82.534 (* rules already in simpset *)
82.535 lemmas arith_extra_simps =
82.536 numeral_plus_numeral add_neg_numeral_simps add_0_left add_0_right
82.537 - minus_numeral minus_neg_numeral minus_zero minus_one
82.538 + minus_zero
82.539 diff_numeral_simps diff_0 diff_0_right
82.540 numeral_times_numeral mult_neg_numeral_simps
82.541 mult_zero_left mult_zero_right
82.542 @@ -1089,15 +1184,15 @@
82.543
82.544 lemmas rel_simps =
82.545 le_num_simps less_num_simps eq_num_simps
82.546 - le_numeral_simps le_neg_numeral_simps le_numeral_extra
82.547 - less_numeral_simps less_neg_numeral_simps less_numeral_extra
82.548 + le_numeral_simps le_neg_numeral_simps le_minus_one_simps le_numeral_extra
82.549 + less_numeral_simps less_neg_numeral_simps less_minus_one_simps less_numeral_extra
82.550 eq_numeral_simps eq_neg_numeral_simps eq_numeral_extra
82.551
82.552 lemma Let_numeral [simp]: "Let (numeral v) f = f (numeral v)"
82.553 -- {* Unfold all @{text let}s involving constants *}
82.554 unfolding Let_def ..
82.555
82.556 -lemma Let_neg_numeral [simp]: "Let (neg_numeral v) f = f (neg_numeral v)"
82.557 +lemma Let_neg_numeral [simp]: "Let (- numeral v) f = f (- numeral v)"
82.558 -- {* Unfold all @{text let}s involving constants *}
82.559 unfolding Let_def ..
82.560
82.561 @@ -1133,16 +1228,16 @@
82.562 by (simp_all add: add_assoc [symmetric])
82.563
82.564 lemma add_neg_numeral_left [simp]:
82.565 - "numeral v + (neg_numeral w + y) = (sub v w + y)"
82.566 - "neg_numeral v + (numeral w + y) = (sub w v + y)"
82.567 - "neg_numeral v + (neg_numeral w + y) = (neg_numeral(v + w) + y)"
82.568 + "numeral v + (- numeral w + y) = (sub v w + y)"
82.569 + "- numeral v + (numeral w + y) = (sub w v + y)"
82.570 + "- numeral v + (- numeral w + y) = (- numeral(v + w) + y)"
82.571 by (simp_all add: add_assoc [symmetric])
82.572
82.573 lemma mult_numeral_left [simp]:
82.574 "numeral v * (numeral w * z) = (numeral(v * w) * z :: 'a::semiring_numeral)"
82.575 - "neg_numeral v * (numeral w * y) = (neg_numeral(v * w) * y :: 'b::ring_1)"
82.576 - "numeral v * (neg_numeral w * y) = (neg_numeral(v * w) * y :: 'b::ring_1)"
82.577 - "neg_numeral v * (neg_numeral w * y) = (numeral(v * w) * y :: 'b::ring_1)"
82.578 + "- numeral v * (numeral w * y) = (- numeral(v * w) * y :: 'b::ring_1)"
82.579 + "numeral v * (- numeral w * y) = (- numeral(v * w) * y :: 'b::ring_1)"
82.580 + "- numeral v * (- numeral w * y) = (numeral(v * w) * y :: 'b::ring_1)"
82.581 by (simp_all add: mult_assoc [symmetric])
82.582
82.583 hide_const (open) One Bit0 Bit1 BitM inc pow sqr sub dbl dbl_inc dbl_dec
83.1 --- a/src/HOL/Number_Theory/Cong.thy Mon Nov 18 17:15:01 2013 +0100
83.2 +++ b/src/HOL/Number_Theory/Cong.thy Tue Nov 19 17:07:52 2013 +0100
83.3 @@ -323,8 +323,6 @@
83.4 \<Longrightarrow> [a = 1] (mod p) \<or> [a = - 1] (mod p)"
83.5 apply (simp only: cong_altdef_int)
83.6 apply (subst prime_dvd_mult_eq_int [symmetric], assumption)
83.7 - (* any way around this? *)
83.8 - apply (subgoal_tac "a * a - 1 = (a - 1) * (a - -1)")
83.9 apply (auto simp add: field_simps)
83.10 done
83.11
83.12 @@ -665,7 +663,6 @@
83.13 apply auto
83.14 apply (cases "n \<ge> 0")
83.15 apply auto
83.16 - apply (subst cong_int_def, auto)
83.17 apply (frule cong_solve_int [of a n])
83.18 apply auto
83.19 done
84.1 --- a/src/HOL/Number_Theory/Residues.thy Mon Nov 18 17:15:01 2013 +0100
84.2 +++ b/src/HOL/Number_Theory/Residues.thy Tue Nov 19 17:07:52 2013 +0100
84.3 @@ -455,6 +455,7 @@
84.4 apply (subst fact_altdef_int, simp)
84.5 apply (subst cong_int_def)
84.6 apply simp
84.7 + apply arith
84.8 apply (rule residues_prime.wilson_theorem1)
84.9 apply (rule residues_prime.intro)
84.10 apply auto
85.1 --- a/src/HOL/Numeral_Simprocs.thy Mon Nov 18 17:15:01 2013 +0100
85.2 +++ b/src/HOL/Numeral_Simprocs.thy Tue Nov 19 17:07:52 2013 +0100
85.3 @@ -17,7 +17,7 @@
85.4 if_False if_True
85.5 add_0 add_Suc add_numeral_left
85.6 add_neg_numeral_left mult_numeral_left
85.7 - numeral_1_eq_1 [symmetric] Suc_eq_plus1
85.8 + numeral_One [symmetric] uminus_numeral_One [symmetric] Suc_eq_plus1
85.9 eq_numeral_iff_iszero not_iszero_Numeral1
85.10
85.11 declare split_div [of _ _ "numeral k", arith_split] for k
85.12 @@ -85,18 +85,19 @@
85.13
85.14 text {* For @{text cancel_factor} *}
85.15
85.16 -lemma nat_mult_le_cancel_disj: "(k*m <= k*n) = ((0::nat) < k --> m<=n)"
85.17 -by auto
85.18 +lemmas nat_mult_le_cancel_disj = mult_le_cancel1
85.19
85.20 -lemma nat_mult_less_cancel_disj: "(k*m < k*n) = ((0::nat) < k & m<n)"
85.21 -by auto
85.22 +lemmas nat_mult_less_cancel_disj = mult_less_cancel1
85.23
85.24 -lemma nat_mult_eq_cancel_disj: "(k*m = k*n) = (k = (0::nat) | m=n)"
85.25 -by auto
85.26 +lemma nat_mult_eq_cancel_disj:
85.27 + fixes k m n :: nat
85.28 + shows "k * m = k * n \<longleftrightarrow> k = 0 \<or> m = n"
85.29 + by auto
85.30
85.31 -lemma nat_mult_div_cancel_disj[simp]:
85.32 - "(k*m) div (k*n) = (if k = (0::nat) then 0 else m div n)"
85.33 -by (simp add: nat_mult_div_cancel1)
85.34 +lemma nat_mult_div_cancel_disj [simp]:
85.35 + fixes k m n :: nat
85.36 + shows "(k * m) div (k * n) = (if k = 0 then 0 else m div n)"
85.37 + by (fact div_mult_mult1_if)
85.38
85.39 ML_file "Tools/numeral_simprocs.ML"
85.40
86.1 --- a/src/HOL/Parity.thy Mon Nov 18 17:15:01 2013 +0100
86.2 +++ b/src/HOL/Parity.thy Tue Nov 19 17:07:52 2013 +0100
86.3 @@ -78,7 +78,7 @@
86.4 unfolding even_def by simp
86.5
86.6 (* TODO: proper simp rules for Num.Bit0, Num.Bit1 *)
86.7 -declare even_def [of "neg_numeral v", simp] for v
86.8 +declare even_def [of "- numeral v", simp] for v
86.9
86.10 lemma even_numeral_nat [simp]: "even (numeral (Num.Bit0 k) :: nat)"
86.11 unfolding even_nat_def by simp
86.12 @@ -190,14 +190,9 @@
86.13 by (induct n) simp_all
86.14
86.15 lemma (in comm_ring_1)
86.16 - shows minus_one_even_power [simp]: "even n \<Longrightarrow> (- 1) ^ n = 1"
86.17 - and minus_one_odd_power [simp]: "odd n \<Longrightarrow> (- 1) ^ n = - 1"
86.18 - by (simp_all add: neg_power_if del: minus_one)
86.19 -
86.20 -lemma (in comm_ring_1)
86.21 - shows neg_one_even_power [simp]: "even n \<Longrightarrow> (-1) ^ n = 1"
86.22 - and neg_one_odd_power [simp]: "odd n \<Longrightarrow> (-1) ^ n = - 1"
86.23 - by (simp_all add: minus_one [symmetric] del: minus_one)
86.24 + shows neg_one_even_power [simp]: "even n \<Longrightarrow> (- 1) ^ n = 1"
86.25 + and neg_one_odd_power [simp]: "odd n \<Longrightarrow> (- 1) ^ n = - 1"
86.26 + by (simp_all add: neg_power_if)
86.27
86.28 lemma zero_le_even_power: "even n ==>
86.29 0 <= (x::'a::{linordered_ring,monoid_mult}) ^ n"
87.1 --- a/src/HOL/Power.thy Mon Nov 18 17:15:01 2013 +0100
87.2 +++ b/src/HOL/Power.thy Tue Nov 19 17:07:52 2013 +0100
87.3 @@ -209,14 +209,6 @@
87.4 "(- x) ^ numeral (Num.Bit1 k) = - (x ^ numeral (Num.Bit1 k))"
87.5 by (simp only: eval_nat_numeral(3) power_Suc power_minus_Bit0 mult_minus_left)
87.6
87.7 -lemma power_neg_numeral_Bit0 [simp]:
87.8 - "neg_numeral k ^ numeral (Num.Bit0 l) = numeral (Num.pow k (Num.Bit0 l))"
87.9 - by (simp only: neg_numeral_def power_minus_Bit0 power_numeral)
87.10 -
87.11 -lemma power_neg_numeral_Bit1 [simp]:
87.12 - "neg_numeral k ^ numeral (Num.Bit1 l) = neg_numeral (Num.pow k (Num.Bit1 l))"
87.13 - by (simp only: neg_numeral_def power_minus_Bit1 power_numeral pow.simps)
87.14 -
87.15 lemma power2_minus [simp]:
87.16 "(- a)\<^sup>2 = a\<^sup>2"
87.17 by (rule power_minus_Bit0)
88.1 --- a/src/HOL/ROOT Mon Nov 18 17:15:01 2013 +0100
88.2 +++ b/src/HOL/ROOT Tue Nov 19 17:07:52 2013 +0100
88.3 @@ -687,14 +687,14 @@
88.4 theories Nominal_Examples
88.5 theories [quick_and_dirty] VC_Condition
88.6
88.7 -session "HOL-Cardinals-Base" in Cardinals = HOL +
88.8 +session "HOL-Cardinals-FP" in Cardinals = HOL +
88.9 description {*
88.10 - Ordinals and Cardinals, Base Theories.
88.11 + Ordinals and Cardinals, Theories Needed for BNF FP Constructions.
88.12 *}
88.13 options [document = false]
88.14 - theories Cardinal_Arithmetic
88.15 + theories Cardinal_Arithmetic_FP
88.16
88.17 -session "HOL-Cardinals" in Cardinals = "HOL-Cardinals-Base" +
88.18 +session "HOL-Cardinals" in Cardinals = "HOL-Cardinals-FP" +
88.19 description {*
88.20 Ordinals and Cardinals, Full Theories.
88.21 *}
88.22 @@ -705,16 +705,16 @@
88.23 "document/root.tex"
88.24 "document/root.bib"
88.25
88.26 -session "HOL-BNF-LFP" in BNF = "HOL-Cardinals-Base" +
88.27 +session "HOL-BNF-FP" in BNF = "HOL-Cardinals-FP" +
88.28 description {*
88.29 - Bounded Natural Functors for Datatypes.
88.30 + Bounded Natural Functors for (Co)datatypes.
88.31 *}
88.32 options [document = false]
88.33 - theories BNF_LFP
88.34 + theories BNF_LFP BNF_GFP
88.35
88.36 -session "HOL-BNF" in BNF = "HOL-Cardinals" +
88.37 +session "HOL-BNF" in BNF = "HOL-BNF-FP" +
88.38 description {*
88.39 - Bounded Natural Functors for (Co)datatypes.
88.40 + Bounded Natural Functors for (Co)datatypes, Including More BNFs.
88.41 *}
88.42 options [document = false]
88.43 theories BNF
89.1 --- a/src/HOL/Rat.thy Mon Nov 18 17:15:01 2013 +0100
89.2 +++ b/src/HOL/Rat.thy Tue Nov 19 17:07:52 2013 +0100
89.3 @@ -215,17 +215,19 @@
89.4 "Fract 0 k = 0"
89.5 "Fract 1 1 = 1"
89.6 "Fract (numeral w) 1 = numeral w"
89.7 - "Fract (neg_numeral w) 1 = neg_numeral w"
89.8 + "Fract (- numeral w) 1 = - numeral w"
89.9 + "Fract (- 1) 1 = - 1"
89.10 "Fract k 0 = 0"
89.11 using Fract_of_int_eq [of "numeral w"]
89.12 - using Fract_of_int_eq [of "neg_numeral w"]
89.13 + using Fract_of_int_eq [of "- numeral w"]
89.14 by (simp_all add: Zero_rat_def One_rat_def eq_rat)
89.15
89.16 lemma rat_number_expand:
89.17 "0 = Fract 0 1"
89.18 "1 = Fract 1 1"
89.19 "numeral k = Fract (numeral k) 1"
89.20 - "neg_numeral k = Fract (neg_numeral k) 1"
89.21 + "- 1 = Fract (- 1) 1"
89.22 + "- numeral k = Fract (- numeral k) 1"
89.23 by (simp_all add: rat_number_collapse)
89.24
89.25 lemma Rat_cases_nonzero [case_names Fract 0]:
89.26 @@ -356,7 +358,8 @@
89.27 "quotient_of 0 = (0, 1)"
89.28 "quotient_of 1 = (1, 1)"
89.29 "quotient_of (numeral k) = (numeral k, 1)"
89.30 - "quotient_of (neg_numeral k) = (neg_numeral k, 1)"
89.31 + "quotient_of (- 1) = (- 1, 1)"
89.32 + "quotient_of (- numeral k) = (- numeral k, 1)"
89.33 by (simp_all add: rat_number_expand quotient_of_Fract)
89.34
89.35 lemma quotient_of_eq: "quotient_of (Fract a b) = (p, q) \<Longrightarrow> Fract p q = Fract a b"
89.36 @@ -620,7 +623,7 @@
89.37 #> Lin_Arith.add_simps [@{thm neg_less_iff_less},
89.38 @{thm True_implies_equals},
89.39 read_instantiate @{context} [(("a", 0), "(numeral ?v)")] @{thm distrib_left},
89.40 - read_instantiate @{context} [(("a", 0), "(neg_numeral ?v)")] @{thm distrib_left},
89.41 + read_instantiate @{context} [(("a", 0), "(- numeral ?v)")] @{thm distrib_left},
89.42 @{thm divide_1}, @{thm divide_zero_left},
89.43 @{thm times_divide_eq_right}, @{thm times_divide_eq_left},
89.44 @{thm minus_divide_left} RS sym, @{thm minus_divide_right} RS sym,
89.45 @@ -664,6 +667,10 @@
89.46 lemma of_rat_minus: "of_rat (- a) = - of_rat a"
89.47 by transfer simp
89.48
89.49 +lemma of_rat_neg_one [simp]:
89.50 + "of_rat (- 1) = - 1"
89.51 + by (simp add: of_rat_minus)
89.52 +
89.53 lemma of_rat_diff: "of_rat (a - b) = of_rat a - of_rat b"
89.54 using of_rat_add [of a "- b"] by (simp add: of_rat_minus)
89.55
89.56 @@ -778,8 +785,8 @@
89.57 using of_rat_of_int_eq [of "numeral w"] by simp
89.58
89.59 lemma of_rat_neg_numeral_eq [simp]:
89.60 - "of_rat (neg_numeral w) = neg_numeral w"
89.61 -using of_rat_of_int_eq [of "neg_numeral w"] by simp
89.62 + "of_rat (- numeral w) = - numeral w"
89.63 +using of_rat_of_int_eq [of "- numeral w"] by simp
89.64
89.65 lemmas zero_rat = Zero_rat_def
89.66 lemmas one_rat = One_rat_def
89.67 @@ -820,9 +827,6 @@
89.68 lemma Rats_number_of [simp]: "numeral w \<in> Rats"
89.69 by (subst of_rat_numeral_eq [symmetric], rule Rats_of_rat)
89.70
89.71 -lemma Rats_neg_number_of [simp]: "neg_numeral w \<in> Rats"
89.72 -by (subst of_rat_neg_numeral_eq [symmetric], rule Rats_of_rat)
89.73 -
89.74 lemma Rats_0 [simp]: "0 \<in> Rats"
89.75 apply (unfold Rats_def)
89.76 apply (rule range_eqI)
89.77 @@ -943,7 +947,7 @@
89.78 by (simp add: Rat.of_int_def)
89.79
89.80 lemma [code_unfold]:
89.81 - "neg_numeral k = Rat.of_int (neg_numeral k)"
89.82 + "- numeral k = Rat.of_int (- numeral k)"
89.83 by (simp add: Rat.of_int_def)
89.84
89.85 lemma Frct_code_post [code_post]:
89.86 @@ -951,13 +955,13 @@
89.87 "Frct (a, 0) = 0"
89.88 "Frct (1, 1) = 1"
89.89 "Frct (numeral k, 1) = numeral k"
89.90 - "Frct (neg_numeral k, 1) = neg_numeral k"
89.91 + "Frct (- numeral k, 1) = - numeral k"
89.92 "Frct (1, numeral k) = 1 / numeral k"
89.93 - "Frct (1, neg_numeral k) = 1 / neg_numeral k"
89.94 + "Frct (1, - numeral k) = 1 / - numeral k"
89.95 "Frct (numeral k, numeral l) = numeral k / numeral l"
89.96 - "Frct (numeral k, neg_numeral l) = numeral k / neg_numeral l"
89.97 - "Frct (neg_numeral k, numeral l) = neg_numeral k / numeral l"
89.98 - "Frct (neg_numeral k, neg_numeral l) = neg_numeral k / neg_numeral l"
89.99 + "Frct (numeral k, - numeral l) = numeral k / - numeral l"
89.100 + "Frct (- numeral k, numeral l) = - numeral k / numeral l"
89.101 + "Frct (- numeral k, - numeral l) = - numeral k / - numeral l"
89.102 by (simp_all add: Fract_of_int_quotient)
89.103
89.104
89.105 @@ -1156,7 +1160,7 @@
89.106 in
89.107 if i = 0 then Syntax.const @{const_syntax Groups.zero}
89.108 else if i > 0 then Syntax.const @{const_syntax Num.numeral} $ mk i
89.109 - else Syntax.const @{const_syntax Num.neg_numeral} $ mk (~i)
89.110 + else Syntax.const @{const_syntax Groups.uminus} $ (Syntax.const @{const_syntax Num.numeral} $ mk (~i))
89.111 end;
89.112
89.113 fun mk_frac str =
90.1 --- a/src/HOL/Real.thy Mon Nov 18 17:15:01 2013 +0100
90.2 +++ b/src/HOL/Real.thy Tue Nov 19 17:07:52 2013 +0100
90.3 @@ -1447,13 +1447,13 @@
90.4
90.5 lemma [code_abbrev]:
90.6 "real_of_int (numeral k) = numeral k"
90.7 - "real_of_int (neg_numeral k) = neg_numeral k"
90.8 + "real_of_int (- numeral k) = - numeral k"
90.9 by simp_all
90.10
90.11 -text{*Collapse applications of @{term real} to @{term number_of}*}
90.12 +text{*Collapse applications of @{const real} to @{const numeral}*}
90.13 lemma real_numeral [simp]:
90.14 "real (numeral v :: int) = numeral v"
90.15 - "real (neg_numeral v :: int) = neg_numeral v"
90.16 + "real (- numeral v :: int) = - numeral v"
90.17 by (simp_all add: real_of_int_def)
90.18
90.19 lemma real_of_nat_numeral [simp]:
90.20 @@ -1559,11 +1559,11 @@
90.21 unfolding real_of_int_le_iff[symmetric] by simp
90.22
90.23 lemma neg_numeral_power_le_real_of_int_cancel_iff[simp]:
90.24 - "(neg_numeral x::real) ^ n \<le> real a \<longleftrightarrow> (neg_numeral x::int) ^ n \<le> a"
90.25 + "(- numeral x::real) ^ n \<le> real a \<longleftrightarrow> (- numeral x::int) ^ n \<le> a"
90.26 unfolding real_of_int_le_iff[symmetric] by simp
90.27
90.28 lemma real_of_int_le_neg_numeral_power_cancel_iff[simp]:
90.29 - "real a \<le> (neg_numeral x::real) ^ n \<longleftrightarrow> a \<le> (neg_numeral x::int) ^ n"
90.30 + "real a \<le> (- numeral x::real) ^ n \<longleftrightarrow> a \<le> (- numeral x::int) ^ n"
90.31 unfolding real_of_int_le_iff[symmetric] by simp
90.32
90.33 subsection{*Density of the Reals*}
90.34 @@ -2051,7 +2051,7 @@
90.35 by simp
90.36
90.37 lemma [code_abbrev]:
90.38 - "(of_rat (neg_numeral k) :: real) = neg_numeral k"
90.39 + "(of_rat (- numeral k) :: real) = - numeral k"
90.40 by simp
90.41
90.42 lemma [code_post]:
90.43 @@ -2059,14 +2059,14 @@
90.44 "(of_rat (r / 0) :: real) = 0"
90.45 "(of_rat (1 / 1) :: real) = 1"
90.46 "(of_rat (numeral k / 1) :: real) = numeral k"
90.47 - "(of_rat (neg_numeral k / 1) :: real) = neg_numeral k"
90.48 + "(of_rat (- numeral k / 1) :: real) = - numeral k"
90.49 "(of_rat (1 / numeral k) :: real) = 1 / numeral k"
90.50 - "(of_rat (1 / neg_numeral k) :: real) = 1 / neg_numeral k"
90.51 + "(of_rat (1 / - numeral k) :: real) = 1 / - numeral k"
90.52 "(of_rat (numeral k / numeral l) :: real) = numeral k / numeral l"
90.53 - "(of_rat (numeral k / neg_numeral l) :: real) = numeral k / neg_numeral l"
90.54 - "(of_rat (neg_numeral k / numeral l) :: real) = neg_numeral k / numeral l"
90.55 - "(of_rat (neg_numeral k / neg_numeral l) :: real) = neg_numeral k / neg_numeral l"
90.56 - by (simp_all add: of_rat_divide)
90.57 + "(of_rat (numeral k / - numeral l) :: real) = numeral k / - numeral l"
90.58 + "(of_rat (- numeral k / numeral l) :: real) = - numeral k / numeral l"
90.59 + "(of_rat (- numeral k / - numeral l) :: real) = - numeral k / - numeral l"
90.60 + by (simp_all add: of_rat_divide of_rat_minus)
90.61
90.62
90.63 text {* Operations *}
91.1 --- a/src/HOL/Real_Vector_Spaces.thy Mon Nov 18 17:15:01 2013 +0100
91.2 +++ b/src/HOL/Real_Vector_Spaces.thy Tue Nov 19 17:07:52 2013 +0100
91.3 @@ -307,8 +307,8 @@
91.4 lemma of_real_numeral: "of_real (numeral w) = numeral w"
91.5 using of_real_of_int_eq [of "numeral w"] by simp
91.6
91.7 -lemma of_real_neg_numeral: "of_real (neg_numeral w) = neg_numeral w"
91.8 -using of_real_of_int_eq [of "neg_numeral w"] by simp
91.9 +lemma of_real_neg_numeral: "of_real (- numeral w) = - numeral w"
91.10 +using of_real_of_int_eq [of "- numeral w"] by simp
91.11
91.12 text{*Every real algebra has characteristic zero*}
91.13
91.14 @@ -341,9 +341,6 @@
91.15 lemma Reals_numeral [simp]: "numeral w \<in> Reals"
91.16 by (subst of_real_numeral [symmetric], rule Reals_of_real)
91.17
91.18 -lemma Reals_neg_numeral [simp]: "neg_numeral w \<in> Reals"
91.19 -by (subst of_real_neg_numeral [symmetric], rule Reals_of_real)
91.20 -
91.21 lemma Reals_0 [simp]: "0 \<in> Reals"
91.22 apply (unfold Reals_def)
91.23 apply (rule range_eqI)
91.24 @@ -602,7 +599,7 @@
91.25 by (subst of_real_numeral [symmetric], subst norm_of_real, simp)
91.26
91.27 lemma norm_neg_numeral [simp]:
91.28 - "norm (neg_numeral w::'a::real_normed_algebra_1) = numeral w"
91.29 + "norm (- numeral w::'a::real_normed_algebra_1) = numeral w"
91.30 by (subst of_real_neg_numeral [symmetric], subst norm_of_real, simp)
91.31
91.32 lemma norm_of_int [simp]:
92.1 --- a/src/HOL/Rings.thy Mon Nov 18 17:15:01 2013 +0100
92.2 +++ b/src/HOL/Rings.thy Tue Nov 19 17:07:52 2013 +0100
92.3 @@ -1058,6 +1058,34 @@
92.4 "\<bar>l\<bar> = \<bar>k\<bar> \<Longrightarrow> l dvd k"
92.5 by(subst abs_dvd_iff[symmetric]) simp
92.6
92.7 +text {* The following lemmas can be proven in more generale structures, but
92.8 +are dangerous as simp rules in absence of @{thm neg_equal_zero},
92.9 +@{thm neg_less_pos}, @{thm neg_less_eq_nonneg}. *}
92.10 +
92.11 +lemma equation_minus_iff_1 [simp, no_atp]:
92.12 + "1 = - a \<longleftrightarrow> a = - 1"
92.13 + by (fact equation_minus_iff)
92.14 +
92.15 +lemma minus_equation_iff_1 [simp, no_atp]:
92.16 + "- a = 1 \<longleftrightarrow> a = - 1"
92.17 + by (subst minus_equation_iff, auto)
92.18 +
92.19 +lemma le_minus_iff_1 [simp, no_atp]:
92.20 + "1 \<le> - b \<longleftrightarrow> b \<le> - 1"
92.21 + by (fact le_minus_iff)
92.22 +
92.23 +lemma minus_le_iff_1 [simp, no_atp]:
92.24 + "- a \<le> 1 \<longleftrightarrow> - 1 \<le> a"
92.25 + by (fact minus_le_iff)
92.26 +
92.27 +lemma less_minus_iff_1 [simp, no_atp]:
92.28 + "1 < - b \<longleftrightarrow> b < - 1"
92.29 + by (fact less_minus_iff)
92.30 +
92.31 +lemma minus_less_iff_1 [simp, no_atp]:
92.32 + "- a < 1 \<longleftrightarrow> - 1 < a"
92.33 + by (fact minus_less_iff)
92.34 +
92.35 end
92.36
92.37 text {* Simprules for comparisons where common factors can be cancelled. *}
93.1 --- a/src/HOL/SMT_Examples/SMT_Tests.thy Mon Nov 18 17:15:01 2013 +0100
93.2 +++ b/src/HOL/SMT_Examples/SMT_Tests.thy Tue Nov 19 17:07:52 2013 +0100
93.3 @@ -374,7 +374,6 @@
93.4
93.5 lemma
93.6 "(0::int) = 0"
93.7 - "(0::int) = -0"
93.8 "(0::int) = (- 0)"
93.9 "(1::int) = 1"
93.10 "\<not>(-1 = (1::int))"
94.1 --- a/src/HOL/SMT_Examples/SMT_Word_Examples.certs Mon Nov 18 17:15:01 2013 +0100
94.2 +++ b/src/HOL/SMT_Examples/SMT_Word_Examples.certs Tue Nov 19 17:07:52 2013 +0100
94.3 @@ -54,3 +54,5 @@
94.4 unsat
94.5 e5c27ae0a583eeafeaa4ef3c59b1b4ec53e06b0f 1 0
94.6 unsat
94.7 +7d3ef49480d3ed3a7e5f2d7a12e7108cf7fc7819 1 0
94.8 +unsat
95.1 --- a/src/HOL/TPTP/atp_problem_import.ML Mon Nov 18 17:15:01 2013 +0100
95.2 +++ b/src/HOL/TPTP/atp_problem_import.ML Tue Nov 19 17:07:52 2013 +0100
95.3 @@ -20,7 +20,7 @@
95.4 val sledgehammer_tptp_file : theory -> int -> string -> unit
95.5 val isabelle_tptp_file : theory -> int -> string -> unit
95.6 val isabelle_hot_tptp_file : theory -> int -> string -> unit
95.7 - val translate_tptp_file : theory -> string -> string -> string -> unit
95.8 + val translate_tptp_file : theory -> string -> string -> unit
95.9 end;
95.10
95.11 structure ATP_Problem_Import : ATP_PROBLEM_IMPORT =
95.12 @@ -301,9 +301,9 @@
95.13
95.14 (** Translator between TPTP(-like) file formats **)
95.15
95.16 -fun translate_tptp_file thy format_str in_file_name out_file_name =
95.17 +fun translate_tptp_file thy format_str file_name =
95.18 let
95.19 - val (conjs, (defs, nondefs), ctxt) = read_tptp_file thy I in_file_name
95.20 + val (conjs, (defs, nondefs), ctxt) = read_tptp_file thy I file_name
95.21 val conj = make_conj ([], []) (map snd conjs)
95.22
95.23 val (format, type_enc, lam_trans) =
95.24 @@ -327,7 +327,7 @@
95.25 val ord_info = K []
95.26 val lines = lines_of_atp_problem format ord ord_info atp_problem
95.27 in
95.28 - File.write_list (exploded_absolute_path out_file_name) lines
95.29 + List.app Output.physical_stdout lines
95.30 end
95.31
95.32 end;
96.1 --- a/src/HOL/TPTP/lib/Tools/tptp_translate Mon Nov 18 17:15:01 2013 +0100
96.2 +++ b/src/HOL/TPTP/lib/Tools/tptp_translate Tue Nov 19 17:07:52 2013 +0100
96.3 @@ -9,20 +9,21 @@
96.4
96.5 function usage() {
96.6 echo
96.7 - echo "Usage: isabelle $PRG FORMAT IN_FILE OUT_FILE"
96.8 + echo "Usage: isabelle $PRG FORMAT FILE"
96.9 echo
96.10 echo " Translates TPTP input file to the specified format (\"FOF\", \"TFF0\", \"THF0\", or \"DFG\")."
96.11 + echo " Emits the result to standard output."
96.12 echo
96.13 exit 1
96.14 }
96.15
96.16 -[ "$#" -ne 3 -o "$1" = "-?" ] && usage
96.17 +[ "$#" -ne 2 -o "$1" = "-?" ] && usage
96.18
96.19 SCRATCH="Scratch_${PRG}_$$_${RANDOM}"
96.20
96.21 args=("$@")
96.22
96.23 echo "theory $SCRATCH imports \"$TPTP_HOME/ATP_Problem_Import\" begin \
96.24 -ML {* ATP_Problem_Import.translate_tptp_file @{theory} \"${args[0]}\" \"${args[1]}\" \"${args[2]}\" *} end;" \
96.25 +ML {* ATP_Problem_Import.translate_tptp_file @{theory} \"${args[0]}\" \"${args[1]}\" *} end;" \
96.26 > /tmp/$SCRATCH.thy
96.27 "$ISABELLE_PROCESS" -q -e "use_thy \"/tmp/$SCRATCH\"; exit 1;" HOL-TPTP | grep --line-buffered -v "^###\|^PROOF FAILED for depth\|^Failure node\|inferences so far. Searching to depth\|^val \|^Loading theory"
97.1 --- a/src/HOL/Tools/Datatype/datatype_data.ML Mon Nov 18 17:15:01 2013 +0100
97.2 +++ b/src/HOL/Tools/Datatype/datatype_data.ML Tue Nov 19 17:07:52 2013 +0100
97.3 @@ -118,7 +118,7 @@
97.4 expands = [],
97.5 sel_splits = [],
97.6 sel_split_asms = [],
97.7 - case_ifs = []};
97.8 + case_eq_ifs = []};
97.9
97.10 fun register dt_infos =
97.11 Data.map (fn {types, constrs, cases} =>
98.1 --- a/src/HOL/Tools/Nitpick/nitpick_hol.ML Mon Nov 18 17:15:01 2013 +0100
98.2 +++ b/src/HOL/Tools/Nitpick/nitpick_hol.ML Tue Nov 19 17:07:52 2013 +0100
98.3 @@ -1645,10 +1645,10 @@
98.4 (hol_ctxt as {thy, ctxt, stds, whacks, total_consts, case_names,
98.5 def_tables, ground_thm_table, ersatz_table, ...}) =
98.6 let
98.7 - fun do_numeral depth Ts mult T t0 t1 =
98.8 + fun do_numeral depth Ts mult T some_t0 t1 t2 =
98.9 (if is_number_type ctxt T then
98.10 let
98.11 - val j = mult * HOLogic.dest_num t1
98.12 + val j = mult * HOLogic.dest_num t2
98.13 in
98.14 if j = 1 then
98.15 raise SAME ()
98.16 @@ -1667,15 +1667,16 @@
98.17 handle TERM _ => raise SAME ()
98.18 else
98.19 raise SAME ())
98.20 - handle SAME () => s_betapply [] (do_term depth Ts t0, do_term depth Ts t1)
98.21 + handle SAME () => (case some_t0 of NONE => s_betapply [] (do_term depth Ts t1, do_term depth Ts t2)
98.22 + | SOME t0 => s_betapply [] (do_term depth Ts t0, s_betapply [] (do_term depth Ts t1, do_term depth Ts t2)))
98.23 and do_term depth Ts t =
98.24 case t of
98.25 - (t0 as Const (@{const_name Num.neg_numeral_class.neg_numeral},
98.26 - Type (@{type_name fun}, [_, ran_T]))) $ t1 =>
98.27 - do_numeral depth Ts ~1 ran_T t0 t1
98.28 - | (t0 as Const (@{const_name Num.numeral_class.numeral},
98.29 - Type (@{type_name fun}, [_, ran_T]))) $ t1 =>
98.30 - do_numeral depth Ts 1 ran_T t0 t1
98.31 + (t0 as Const (@{const_name uminus}, _) $ ((t1 as Const (@{const_name numeral},
98.32 + Type (@{type_name fun}, [_, ran_T]))) $ t2)) =>
98.33 + do_numeral depth Ts ~1 ran_T (SOME t0) t1 t2
98.34 + | (t1 as Const (@{const_name numeral},
98.35 + Type (@{type_name fun}, [_, ran_T]))) $ t2 =>
98.36 + do_numeral depth Ts 1 ran_T NONE t1 t2
98.37 | Const (@{const_name refl_on}, T) $ Const (@{const_name top}, _) $ t2 =>
98.38 do_const depth Ts t (@{const_name refl'}, range_type T) [t2]
98.39 | (t0 as Const (@{const_name Sigma}, Type (_, [T1, Type (_, [T2, T3])])))
99.1 --- a/src/HOL/Tools/Qelim/cooper.ML Mon Nov 18 17:15:01 2013 +0100
99.2 +++ b/src/HOL/Tools/Qelim/cooper.ML Tue Nov 19 17:07:52 2013 +0100
99.3 @@ -42,7 +42,6 @@
99.4 @{term "nat"}, @{term "int"},
99.5 @{term "Num.One"}, @{term "Num.Bit0"}, @{term "Num.Bit1"},
99.6 @{term "Num.numeral :: num => int"}, @{term "Num.numeral :: num => nat"},
99.7 - @{term "Num.neg_numeral :: num => int"},
99.8 @{term "0::int"}, @{term "1::int"}, @{term "0::nat"}, @{term "1::nat"},
99.9 @{term "True"}, @{term "False"}];
99.10
99.11 @@ -610,8 +609,6 @@
99.12 | num_of_term vs @{term "1::int"} = Proc.C (Proc.Int_of_integer 1)
99.13 | num_of_term vs (t as Const (@{const_name numeral}, _) $ _) =
99.14 Proc.C (Proc.Int_of_integer (dest_number t))
99.15 - | num_of_term vs (t as Const (@{const_name neg_numeral}, _) $ _) =
99.16 - Proc.Neg (Proc.C (Proc.Int_of_integer (dest_number t)))
99.17 | num_of_term vs (Const (@{const_name Groups.uminus}, _) $ t') =
99.18 Proc.Neg (num_of_term vs t')
99.19 | num_of_term vs (Const (@{const_name Groups.plus}, _) $ t1 $ t2) =
100.1 --- a/src/HOL/Tools/SMT/smt_builtin.ML Mon Nov 18 17:15:01 2013 +0100
100.2 +++ b/src/HOL/Tools/SMT/smt_builtin.ML Tue Nov 19 17:07:52 2013 +0100
100.3 @@ -144,9 +144,10 @@
100.4 (case try HOLogic.dest_number t of
100.5 NONE => NONE
100.6 | SOME (T, i) =>
100.7 - (case lookup_builtin_typ ctxt T of
100.8 - SOME (_, Int (_, g)) => g T i |> Option.map (rpair T)
100.9 - | _ => NONE))
100.10 + if i < 0 then NONE else
100.11 + (case lookup_builtin_typ ctxt T of
100.12 + SOME (_, Int (_, g)) => g T i |> Option.map (rpair T)
100.13 + | _ => NONE))
100.14
100.15 val is_builtin_num = is_some oo dest_builtin_num
100.16
101.1 --- a/src/HOL/Tools/SMT/smt_normalize.ML Mon Nov 18 17:15:01 2013 +0100
101.2 +++ b/src/HOL/Tools/SMT/smt_normalize.ML Tue Nov 19 17:07:52 2013 +0100
101.3 @@ -526,23 +526,26 @@
101.4
101.5 local
101.6 (*
101.7 - rewrite negative numerals into positive numerals,
101.8 - rewrite Numeral0 into 0
101.9 rewrite Numeral1 into 1
101.10 + rewrite - 0 into 0
101.11 *)
101.12
101.13 - fun is_strange_number ctxt (t as Const (@{const_name neg_numeral}, _) $ _) =
101.14 - SMT_Builtin.is_builtin_num ctxt t
101.15 - | is_strange_number _ _ = false
101.16 + fun is_irregular_number (Const (@{const_name numeral}, _) $ Const (@{const_name num.One}, _)) =
101.17 + true
101.18 + | is_irregular_number (Const (@{const_name uminus}, _) $ Const (@{const_name Groups.zero}, _)) =
101.19 + true
101.20 + | is_irregular_number _ =
101.21 + false;
101.22
101.23 - val pos_num_ss =
101.24 + fun is_strange_number ctxt t = is_irregular_number t andalso SMT_Builtin.is_builtin_num ctxt t;
101.25 +
101.26 + val proper_num_ss =
101.27 simpset_of (put_simpset HOL_ss @{context}
101.28 - addsimps [@{thm Num.numeral_One}]
101.29 - addsimps [@{thm Num.neg_numeral_def}])
101.30 + addsimps @{thms Num.numeral_One minus_zero})
101.31
101.32 fun norm_num_conv ctxt =
101.33 SMT_Utils.if_conv (is_strange_number ctxt)
101.34 - (Simplifier.rewrite (put_simpset pos_num_ss ctxt)) Conv.no_conv
101.35 + (Simplifier.rewrite (put_simpset proper_num_ss ctxt)) Conv.no_conv
101.36 in
101.37
101.38 fun normalize_numerals_conv ctxt =
102.1 --- a/src/HOL/Tools/SMT/smt_utils.ML Mon Nov 18 17:15:01 2013 +0100
102.2 +++ b/src/HOL/Tools/SMT/smt_utils.ML Tue Nov 19 17:07:52 2013 +0100
102.3 @@ -140,7 +140,6 @@
102.4 is_num env t andalso is_num env u
102.5 | is_num env (Const (@{const_name Let}, _) $ t $ Abs (_, _, u)) =
102.6 is_num (t :: env) u
102.7 - | is_num env (Const (@{const_name uminus}, _) $ t) = is_num env t
102.8 | is_num env (Bound i) = i < length env andalso is_num env (nth env i)
102.9 | is_num _ t = can HOLogic.dest_number t
102.10 in is_num [] end
103.1 --- a/src/HOL/Tools/Sledgehammer/sledgehammer_provers.ML Mon Nov 18 17:15:01 2013 +0100
103.2 +++ b/src/HOL/Tools/Sledgehammer/sledgehammer_provers.ML Tue Nov 19 17:07:52 2013 +0100
103.3 @@ -838,9 +838,10 @@
103.4 Output.urgent_message "Generating proof text..."
103.5 else
103.6 ()
103.7 + val atp_proof = (fn () => termify_atp_proof ctxt pool lifted sym_tab atp_proof)
103.8 val isar_params =
103.9 - (debug, verbose, preplay_timeout, isar_compress, isar_try0,
103.10 - pool, fact_names, lifted, sym_tab, atp_proof, goal)
103.11 + (debug, verbose, preplay_timeout, isar_compress, isar_try0, fact_names, atp_proof,
103.12 + goal)
103.13 val one_line_params =
103.14 (preplay, proof_banner mode name, used_facts,
103.15 choose_minimize_command ctxt params minimize_command name
104.1 --- a/src/HOL/Tools/Sledgehammer/sledgehammer_reconstruct.ML Mon Nov 18 17:15:01 2013 +0100
104.2 +++ b/src/HOL/Tools/Sledgehammer/sledgehammer_reconstruct.ML Tue Nov 19 17:07:52 2013 +0100
104.3 @@ -7,14 +7,14 @@
104.4
104.5 signature SLEDGEHAMMER_RECONSTRUCT =
104.6 sig
104.7 + type ('a, 'b) atp_step = ('a, 'b) ATP_Proof.atp_step
104.8 type 'a atp_proof = 'a ATP_Proof.atp_proof
104.9 type stature = ATP_Problem_Generate.stature
104.10 - type one_line_params = Sledgehammer_Print.one_line_params
104.11 + type one_line_params = Sledgehammer_Reconstructor.one_line_params
104.12
104.13 type isar_params =
104.14 - bool * bool * Time.time option * real * bool * string Symtab.table
104.15 - * (string * stature) list vector * (string * term) list * int Symtab.table
104.16 - * string atp_proof * thm
104.17 + bool * bool * Time.time option * real * bool * (string * stature) list vector
104.18 + * (unit -> (term, string) atp_step list) * thm
104.19
104.20 val lam_trans_of_atp_proof : string atp_proof -> string -> string
104.21 val is_typed_helper_used_in_atp_proof : string atp_proof -> bool
104.22 @@ -24,6 +24,9 @@
104.23 val used_facts_in_unsound_atp_proof :
104.24 Proof.context -> (string * stature) list vector -> 'a atp_proof ->
104.25 string list option
104.26 + val termify_atp_proof :
104.27 + Proof.context -> string Symtab.table -> (string * term) list ->
104.28 + int Symtab.table -> string atp_proof -> (term, string) atp_step list
104.29 val isar_proof_text :
104.30 Proof.context -> bool option -> isar_params -> one_line_params -> string
104.31 val proof_text :
104.32 @@ -407,14 +410,19 @@
104.33 and chain_proofs proofs = map (chain_proof) proofs
104.34 in chain_proof end
104.35
104.36 +fun termify_atp_proof ctxt pool lifted sym_tab =
104.37 + clean_up_atp_proof_dependencies
104.38 + #> nasty_atp_proof pool
104.39 + #> map_term_names_in_atp_proof repair_name
104.40 + #> map (decode_line ctxt lifted sym_tab)
104.41 + #> repair_waldmeister_endgame
104.42 +
104.43 type isar_params =
104.44 - bool * bool * Time.time option * real * bool * string Symtab.table
104.45 - * (string * stature) list vector * (string * term) list * int Symtab.table
104.46 - * string atp_proof * thm
104.47 + bool * bool * Time.time option * real * bool * (string * stature) list vector
104.48 + * (unit -> (term, string) atp_step list) * thm
104.49
104.50 fun isar_proof_text ctxt isar_proofs
104.51 - (debug, verbose, preplay_timeout, isar_compress, isar_try0, pool,
104.52 - fact_names, lifted, sym_tab, atp_proof, goal)
104.53 + (debug, verbose, preplay_timeout, isar_compress, isar_try0, fact_names, atp_proof, goal)
104.54 (one_line_params as (_, _, _, _, subgoal, subgoal_count)) =
104.55 let
104.56 val (params, hyp_ts, concl_t) = strip_subgoal goal subgoal ctxt
104.57 @@ -425,6 +433,7 @@
104.58 ctxt |> Variable.set_body false
104.59 |> Proof_Context.add_fixes fixes)
104.60 val one_line_proof = one_line_proof_text 0 one_line_params
104.61 + val atp_proof = atp_proof ()
104.62 val type_enc =
104.63 if is_typed_helper_used_in_atp_proof atp_proof then full_typesN
104.64 else partial_typesN
104.65 @@ -435,11 +444,6 @@
104.66 let
104.67 val atp_proof =
104.68 atp_proof
104.69 - |> clean_up_atp_proof_dependencies
104.70 - |> nasty_atp_proof pool
104.71 - |> map_term_names_in_atp_proof repair_name
104.72 - |> map (decode_line ctxt lifted sym_tab)
104.73 - |> repair_waldmeister_endgame
104.74 |> rpair [] |-> fold_rev (add_line fact_names)
104.75 |> rpair [] |-> fold_rev add_nontrivial_line
104.76 |> rpair (0, [])
105.1 --- a/src/HOL/Tools/Sledgehammer/sledgehammer_reconstructor.ML Mon Nov 18 17:15:01 2013 +0100
105.2 +++ b/src/HOL/Tools/Sledgehammer/sledgehammer_reconstructor.ML Tue Nov 19 17:07:52 2013 +0100
105.3 @@ -7,7 +7,6 @@
105.4
105.5 signature SLEDGEHAMMER_RECONSTRUCTOR =
105.6 sig
105.7 -
105.8 type stature = ATP_Problem_Generate.stature
105.9
105.10 datatype reconstructor =
105.11 @@ -25,8 +24,7 @@
105.12 play * string * (string * stature) list * minimize_command * int * int
105.13
105.14 val smtN : string
105.15 -
105.16 -end
105.17 +end;
105.18
105.19 structure Sledgehammer_Reconstructor : SLEDGEHAMMER_RECONSTRUCTOR =
105.20 struct
105.21 @@ -49,4 +47,4 @@
105.22
105.23 val smtN = "smt"
105.24
105.25 -end
105.26 +end;
106.1 --- a/src/HOL/Tools/ctr_sugar.ML Mon Nov 18 17:15:01 2013 +0100
106.2 +++ b/src/HOL/Tools/ctr_sugar.ML Tue Nov 19 17:07:52 2013 +0100
106.3 @@ -30,7 +30,7 @@
106.4 expands: thm list,
106.5 sel_splits: thm list,
106.6 sel_split_asms: thm list,
106.7 - case_ifs: thm list};
106.8 + case_eq_ifs: thm list};
106.9
106.10 val morph_ctr_sugar: morphism -> ctr_sugar -> ctr_sugar
106.11 val transfer_ctr_sugar: Proof.context -> ctr_sugar -> ctr_sugar
106.12 @@ -90,7 +90,7 @@
106.13 expands: thm list,
106.14 sel_splits: thm list,
106.15 sel_split_asms: thm list,
106.16 - case_ifs: thm list};
106.17 + case_eq_ifs: thm list};
106.18
106.19 fun eq_ctr_sugar ({ctrs = ctrs1, casex = case1, discs = discs1, selss = selss1, ...} : ctr_sugar,
106.20 {ctrs = ctrs2, casex = case2, discs = discs2, selss = selss2, ...} : ctr_sugar) =
106.21 @@ -98,7 +98,7 @@
106.22
106.23 fun morph_ctr_sugar phi {ctrs, casex, discs, selss, exhaust, nchotomy, injects, distincts,
106.24 case_thms, case_cong, weak_case_cong, split, split_asm, disc_thmss, discIs, sel_thmss,
106.25 - disc_exhausts, sel_exhausts, collapses, expands, sel_splits, sel_split_asms, case_ifs} =
106.26 + disc_exhausts, sel_exhausts, collapses, expands, sel_splits, sel_split_asms, case_eq_ifs} =
106.27 {ctrs = map (Morphism.term phi) ctrs,
106.28 casex = Morphism.term phi casex,
106.29 discs = map (Morphism.term phi) discs,
106.30 @@ -121,7 +121,7 @@
106.31 expands = map (Morphism.thm phi) expands,
106.32 sel_splits = map (Morphism.thm phi) sel_splits,
106.33 sel_split_asms = map (Morphism.thm phi) sel_split_asms,
106.34 - case_ifs = map (Morphism.thm phi) case_ifs};
106.35 + case_eq_ifs = map (Morphism.thm phi) case_eq_ifs};
106.36
106.37 val transfer_ctr_sugar =
106.38 morph_ctr_sugar o Morphism.thm_morphism o Thm.transfer o Proof_Context.theory_of;
106.39 @@ -160,7 +160,7 @@
106.40
106.41 val caseN = "case";
106.42 val case_congN = "case_cong";
106.43 -val case_ifN = "case_if";
106.44 +val case_eq_ifN = "case_eq_if";
106.45 val collapseN = "collapse";
106.46 val disc_excludeN = "disc_exclude";
106.47 val disc_exhaustN = "disc_exhaust";
106.48 @@ -390,7 +390,7 @@
106.49 qualify false
106.50 (if Binding.is_empty raw_case_binding orelse
106.51 Binding.eq_name (raw_case_binding, standard_binding) then
106.52 - Binding.suffix_name ("_" ^ caseN) fc_b
106.53 + Binding.prefix_name (caseN ^ "_") fc_b
106.54 else
106.55 raw_case_binding);
106.56
106.57 @@ -657,7 +657,7 @@
106.58
106.59 val (all_sel_thms, sel_thmss, disc_thmss, nontriv_disc_thms, discI_thms, nontriv_discI_thms,
106.60 disc_exclude_thms, disc_exhaust_thms, sel_exhaust_thms, all_collapse_thms,
106.61 - safe_collapse_thms, expand_thms, sel_split_thms, sel_split_asm_thms, case_if_thms) =
106.62 + safe_collapse_thms, expand_thms, sel_split_thms, sel_split_asm_thms, case_eq_if_thms) =
106.63 if no_discs_sels then
106.64 ([], [], [], [], [], [], [], [], [], [], [], [], [], [], [])
106.65 else
106.66 @@ -861,12 +861,12 @@
106.67 (thm, asm_thm)
106.68 end;
106.69
106.70 - val case_if_thm =
106.71 + val case_eq_if_thm =
106.72 let
106.73 val goal = mk_Trueprop_eq (ufcase, mk_IfN B udiscs usel_fs);
106.74 in
106.75 Goal.prove_sorry lthy [] [] goal (fn {context = ctxt, ...} =>
106.76 - mk_case_if_tac ctxt n uexhaust_thm case_thms disc_thmss' sel_thmss)
106.77 + mk_case_eq_if_tac ctxt n uexhaust_thm case_thms disc_thmss' sel_thmss)
106.78 |> Thm.close_derivation
106.79 |> singleton (Proof_Context.export names_lthy lthy)
106.80 end;
106.81 @@ -874,7 +874,7 @@
106.82 (all_sel_thms, sel_thmss, disc_thmss, nontriv_disc_thms, discI_thms,
106.83 nontriv_discI_thms, disc_exclude_thms, [disc_exhaust_thm], [sel_exhaust_thm],
106.84 all_collapse_thms, safe_collapse_thms, [expand_thm], [sel_split_thm],
106.85 - [sel_split_asm_thm], [case_if_thm])
106.86 + [sel_split_asm_thm], [case_eq_if_thm])
106.87 end;
106.88
106.89 val exhaust_case_names_attr = Attrib.internal (K (Rule_Cases.case_names exhaust_cases));
106.90 @@ -890,7 +890,7 @@
106.91 val notes =
106.92 [(caseN, case_thms, code_nitpicksimp_simp_attrs),
106.93 (case_congN, [case_cong_thm], []),
106.94 - (case_ifN, case_if_thms, []),
106.95 + (case_eq_ifN, case_eq_if_thms, []),
106.96 (collapseN, safe_collapse_thms, simp_attrs),
106.97 (discN, nontriv_disc_thms, simp_attrs),
106.98 (discIN, nontriv_discI_thms, []),
106.99 @@ -921,7 +921,7 @@
106.100 discIs = discI_thms, sel_thmss = sel_thmss, disc_exhausts = disc_exhaust_thms,
106.101 sel_exhausts = sel_exhaust_thms, collapses = all_collapse_thms, expands = expand_thms,
106.102 sel_splits = sel_split_thms, sel_split_asms = sel_split_asm_thms,
106.103 - case_ifs = case_if_thms};
106.104 + case_eq_ifs = case_eq_if_thms};
106.105 in
106.106 (ctr_sugar,
106.107 lthy
107.1 --- a/src/HOL/Tools/ctr_sugar_tactics.ML Mon Nov 18 17:15:01 2013 +0100
107.2 +++ b/src/HOL/Tools/ctr_sugar_tactics.ML Tue Nov 19 17:07:52 2013 +0100
107.3 @@ -18,8 +18,8 @@
107.4 val mk_alternate_disc_def_tac: Proof.context -> int -> thm -> thm -> thm -> tactic
107.5 val mk_case_tac: Proof.context -> int -> int -> thm -> thm list -> thm list list -> tactic
107.6 val mk_case_cong_tac: Proof.context -> thm -> thm list -> tactic
107.7 - val mk_case_if_tac: Proof.context -> int -> thm -> thm list -> thm list list -> thm list list ->
107.8 - tactic
107.9 + val mk_case_eq_if_tac: Proof.context -> int -> thm -> thm list -> thm list list ->
107.10 + thm list list -> tactic
107.11 val mk_collapse_tac: Proof.context -> int -> thm -> thm list -> tactic
107.12 val mk_disc_exhaust_tac: int -> thm -> thm list -> tactic
107.13 val mk_expand_tac: Proof.context -> int -> int list -> thm -> thm -> thm list ->
107.14 @@ -28,8 +28,8 @@
107.15 val mk_nchotomy_tac: int -> thm -> tactic
107.16 val mk_other_half_disc_exclude_tac: thm -> tactic
107.17 val mk_sel_exhaust_tac: int -> thm -> thm list -> tactic
107.18 - val mk_split_tac: Proof.context -> thm -> thm list -> thm list list -> thm list list -> thm list
107.19 - list list -> tactic
107.20 + val mk_split_tac: Proof.context -> thm -> thm list -> thm list list -> thm list list ->
107.21 + thm list list list -> tactic
107.22 val mk_split_asm_tac: Proof.context -> thm -> tactic
107.23 val mk_unique_disc_def_tac: int -> thm -> tactic
107.24 end;
107.25 @@ -143,17 +143,17 @@
107.26 else mk_case_distinct_ctrs_tac ctxt distincts)) ks distinctss))
107.27 end;
107.28
107.29 -fun mk_case_if_tac ctxt n uexhaust cases discss' selss =
107.30 +fun mk_case_cong_tac ctxt uexhaust cases =
107.31 + HEADGOAL (rtac uexhaust THEN'
107.32 + EVERY' (maps (fn casex => [dtac sym, asm_simp_tac (ss_only [casex] ctxt)]) cases));
107.33 +
107.34 +fun mk_case_eq_if_tac ctxt n uexhaust cases discss' selss =
107.35 HEADGOAL (rtac uexhaust THEN'
107.36 EVERY' (map3 (fn casex => fn if_discs => fn sels =>
107.37 EVERY' [hyp_subst_tac ctxt, SELECT_GOAL (unfold_thms_tac ctxt (if_discs @ sels)),
107.38 rtac casex])
107.39 cases (map2 (seq_conds if_P_or_not_P_OF n) (1 upto n) discss') selss));
107.40
107.41 -fun mk_case_cong_tac ctxt uexhaust cases =
107.42 - HEADGOAL (rtac uexhaust THEN'
107.43 - EVERY' (maps (fn casex => [dtac sym, asm_simp_tac (ss_only [casex] ctxt)]) cases));
107.44 -
107.45 fun mk_split_tac ctxt uexhaust cases selss injectss distinctsss =
107.46 HEADGOAL (rtac uexhaust) THEN
107.47 ALLGOALS (fn k => (hyp_subst_tac ctxt THEN'
107.48 @@ -169,4 +169,4 @@
107.49
107.50 end;
107.51
107.52 -structure Ctr_Sugar_General_Tactics: CTR_SUGAR_GENERAL_TACTICS = Ctr_Sugar_Tactics;
107.53 +structure Ctr_Sugar_General_Tactics : CTR_SUGAR_GENERAL_TACTICS = Ctr_Sugar_Tactics;
108.1 --- a/src/HOL/Tools/ctr_sugar_util.ML Mon Nov 18 17:15:01 2013 +0100
108.2 +++ b/src/HOL/Tools/ctr_sugar_util.ML Tue Nov 19 17:07:52 2013 +0100
108.3 @@ -176,9 +176,7 @@
108.4 fun rapp u t = betapply (t, u);
108.5
108.6 fun list_quant_free quant_const =
108.7 - fold_rev (fn free => fn P =>
108.8 - let val (x, T) = Term.dest_Free free;
108.9 - in quant_const T $ Term.absfree (x, T) P end);
108.10 + fold_rev (fn Free (xT as (_, T)) => fn P => quant_const T $ Term.absfree xT P);
108.11
108.12 val list_all_free = list_quant_free HOLogic.all_const;
108.13 val list_exists_free = list_quant_free HOLogic.exists_const;
109.1 --- a/src/HOL/Tools/hologic.ML Mon Nov 18 17:15:01 2013 +0100
109.2 +++ b/src/HOL/Tools/hologic.ML Tue Nov 19 17:07:52 2013 +0100
109.3 @@ -104,7 +104,6 @@
109.4 val mk_numeral: int -> term
109.5 val dest_num: term -> int
109.6 val numeral_const: typ -> term
109.7 - val neg_numeral_const: typ -> term
109.8 val add_numerals: term -> (term * typ) list -> (term * typ) list
109.9 val mk_number: typ -> int -> term
109.10 val dest_number: term -> typ * int
109.11 @@ -548,7 +547,6 @@
109.12 | dest_num t = raise TERM ("dest_num", [t]);
109.13
109.14 fun numeral_const T = Const ("Num.numeral_class.numeral", numT --> T);
109.15 -fun neg_numeral_const T = Const ("Num.neg_numeral_class.neg_numeral", numT --> T);
109.16
109.17 fun add_numerals (Const ("Num.numeral_class.numeral", Type (_, [_, T])) $ t) = cons (t, T)
109.18 | add_numerals (t $ u) = add_numerals t #> add_numerals u
109.19 @@ -559,14 +557,14 @@
109.20 | mk_number T 1 = Const ("Groups.one_class.one", T)
109.21 | mk_number T i =
109.22 if i > 0 then numeral_const T $ mk_numeral i
109.23 - else neg_numeral_const T $ mk_numeral (~ i);
109.24 + else Const ("Groups.uminus_class.uminus", T --> T) $ mk_number T (~ i);
109.25
109.26 fun dest_number (Const ("Groups.zero_class.zero", T)) = (T, 0)
109.27 | dest_number (Const ("Groups.one_class.one", T)) = (T, 1)
109.28 | dest_number (Const ("Num.numeral_class.numeral", Type ("fun", [_, T])) $ t) =
109.29 (T, dest_num t)
109.30 - | dest_number (Const ("Num.neg_numeral_class.neg_numeral", Type ("fun", [_, T])) $ t) =
109.31 - (T, ~ (dest_num t))
109.32 + | dest_number (Const ("Groups.uminus_class.uminus", Type ("fun", [_, T])) $ t) =
109.33 + apsnd (op ~) (dest_number t)
109.34 | dest_number t = raise TERM ("dest_number", [t]);
109.35
109.36
110.1 --- a/src/HOL/Tools/lin_arith.ML Mon Nov 18 17:15:01 2013 +0100
110.2 +++ b/src/HOL/Tools/lin_arith.ML Tue Nov 19 17:07:52 2013 +0100
110.3 @@ -183,9 +183,6 @@
110.4 | demult (t as Const ("Num.numeral_class.numeral", _) $ n, m) =
110.5 ((NONE, Rat.mult m (Rat.rat_of_int (HOLogic.dest_num n)))
110.6 handle TERM _ => (SOME t, m))
110.7 - | demult (t as Const ("Num.neg_numeral_class.neg_numeral", _) $ n, m) =
110.8 - ((NONE, Rat.mult m (Rat.rat_of_int (~ (HOLogic.dest_num n))))
110.9 - handle TERM _ => (SOME t, m))
110.10 | demult (t as Const (@{const_name Suc}, _) $ _, m) =
110.11 ((NONE, Rat.mult m (Rat.rat_of_int (HOLogic.dest_nat t)))
110.12 handle TERM _ => (SOME t, m))
110.13 @@ -212,6 +209,10 @@
110.14 pi
110.15 | poly (Const (@{const_name Groups.one}, _), m, (p, i)) =
110.16 (p, Rat.add i m)
110.17 + | poly (all as Const ("Num.numeral_class.numeral", Type(_,[_,_])) $ t, m, pi as (p, i)) =
110.18 + (let val k = HOLogic.dest_num t
110.19 + in (p, Rat.add i (Rat.mult m (Rat.rat_of_int k))) end
110.20 + handle TERM _ => add_atom all m pi)
110.21 | poly (Const (@{const_name Suc}, _) $ t, m, (p, i)) =
110.22 poly (t, m, (p, Rat.add i m))
110.23 | poly (all as Const (@{const_name Groups.times}, _) $ _ $ _, m, pi as (p, i)) =
110.24 @@ -222,14 +223,6 @@
110.25 (case demult inj_consts (all, m) of
110.26 (NONE, m') => (p, Rat.add i m')
110.27 | (SOME u, m') => add_atom u m' pi)
110.28 - | poly (all as Const ("Num.numeral_class.numeral", Type(_,[_,_])) $ t, m, pi as (p, i)) =
110.29 - (let val k = HOLogic.dest_num t
110.30 - in (p, Rat.add i (Rat.mult m (Rat.rat_of_int k))) end
110.31 - handle TERM _ => add_atom all m pi)
110.32 - | poly (all as Const ("Num.neg_numeral_class.neg_numeral", Type(_,[_,_])) $ t, m, pi as (p, i)) =
110.33 - (let val k = HOLogic.dest_num t
110.34 - in (p, Rat.add i (Rat.mult m (Rat.rat_of_int (~ k)))) end
110.35 - handle TERM _ => add_atom all m pi)
110.36 | poly (all as Const f $ x, m, pi) =
110.37 if member (op =) inj_consts f then poly (x, m, pi) else add_atom all m pi
110.38 | poly (all, m, pi) =
111.1 --- a/src/HOL/Tools/numeral.ML Mon Nov 18 17:15:01 2013 +0100
111.2 +++ b/src/HOL/Tools/numeral.ML Tue Nov 19 17:07:52 2013 +0100
111.3 @@ -45,8 +45,8 @@
111.4 val numeral = @{cpat "numeral"};
111.5 val numeralT = Thm.ctyp_of @{theory} (Term.range_type (Thm.typ_of (Thm.ctyp_of_term numeral)));
111.6
111.7 -val neg_numeral = @{cpat "neg_numeral"};
111.8 -val neg_numeralT = Thm.ctyp_of @{theory} (Term.range_type (Thm.typ_of (Thm.ctyp_of_term neg_numeral)));
111.9 +val uminus = @{cpat "uminus"};
111.10 +val uminusT = Thm.ctyp_of @{theory} (Term.range_type (Thm.typ_of (Thm.ctyp_of_term uminus)));
111.11
111.12 fun instT T V = Thm.instantiate_cterm ([(V, T)], []);
111.13
111.14 @@ -56,7 +56,7 @@
111.15 | mk_cnumber T 1 = instT T oneT one
111.16 | mk_cnumber T i =
111.17 if i > 0 then Thm.apply (instT T numeralT numeral) (mk_cnumeral i)
111.18 - else Thm.apply (instT T neg_numeralT neg_numeral) (mk_cnumeral (~i));
111.19 + else Thm.apply (instT T uminusT uminus) (Thm.apply (instT T numeralT numeral) (mk_cnumeral (~i)));
111.20
111.21 end;
111.22
112.1 --- a/src/HOL/Tools/numeral_simprocs.ML Mon Nov 18 17:15:01 2013 +0100
112.2 +++ b/src/HOL/Tools/numeral_simprocs.ML Tue Nov 19 17:07:52 2013 +0100
112.3 @@ -56,9 +56,6 @@
112.4 val long_mk_sum = Arith_Data.long_mk_sum;
112.5 val dest_sum = Arith_Data.dest_sum;
112.6
112.7 -val mk_diff = HOLogic.mk_binop @{const_name Groups.minus};
112.8 -val dest_diff = HOLogic.dest_bin @{const_name Groups.minus} dummyT;
112.9 -
112.10 val mk_times = HOLogic.mk_binop @{const_name Groups.times};
112.11
112.12 fun one_of T = Const(@{const_name Groups.one}, T);
112.13 @@ -181,7 +178,7 @@
112.14
112.15 (*Simplify 0+n, n+0, Numeral1*n, n*Numeral1, 1*x, x*1, x/1 *)
112.16 val add_0s = @{thms add_0s};
112.17 -val mult_1s = @{thms mult_1s mult_1_left mult_1_right divide_1};
112.18 +val mult_1s = @{thms mult_1s divide_numeral_1 mult_1_left mult_1_right mult_minus1 mult_minus1_right divide_1};
112.19
112.20 (* For post-simplification of the rhs of simproc-generated rules *)
112.21 val post_simps =
112.22 @@ -194,9 +191,8 @@
112.23 val field_post_simps =
112.24 post_simps @ [@{thm divide_zero_left}, @{thm divide_1}]
112.25
112.26 -(*Simplify inverse Numeral1, a/Numeral1*)
112.27 +(*Simplify inverse Numeral1*)
112.28 val inverse_1s = [@{thm inverse_numeral_1}];
112.29 -val divide_1s = [@{thm divide_numeral_1}];
112.30
112.31 (*To perform binary arithmetic. The "left" rewriting handles patterns
112.32 created by the Numeral_Simprocs, such as 3 * (5 * x). *)
112.33 @@ -217,7 +213,7 @@
112.34 @{thms add_neg_numeral_simps}) simps;
112.35
112.36 (*To evaluate binary negations of coefficients*)
112.37 -val minus_simps = [@{thm minus_zero}, @{thm minus_one}, @{thm minus_numeral}, @{thm minus_neg_numeral}];
112.38 +val minus_simps = [@{thm minus_zero}, @{thm minus_minus}];
112.39
112.40 (*To let us treat subtraction as addition*)
112.41 val diff_simps = [@{thm diff_conv_add_uminus}, @{thm minus_add_distrib}, @{thm minus_minus}];
112.42 @@ -225,16 +221,13 @@
112.43 (*To let us treat division as multiplication*)
112.44 val divide_simps = [@{thm divide_inverse}, @{thm inverse_mult_distrib}, @{thm inverse_inverse_eq}];
112.45
112.46 -(*push the unary minus down*)
112.47 -val minus_mult_eq_1_to_2 = @{lemma "- (a::'a::ring) * b = a * - b" by simp};
112.48 -
112.49 (*to extract again any uncancelled minuses*)
112.50 val minus_from_mult_simps =
112.51 [@{thm minus_minus}, @{thm mult_minus_left}, @{thm mult_minus_right}];
112.52
112.53 (*combine unary minus with numeric literals, however nested within a product*)
112.54 val mult_minus_simps =
112.55 - [@{thm mult_assoc}, @{thm minus_mult_left}, minus_mult_eq_1_to_2];
112.56 + [@{thm mult_assoc}, @{thm minus_mult_right}, @{thm minus_mult_commute}];
112.57
112.58 val norm_ss1 =
112.59 simpset_of (put_simpset num_ss @{context}
112.60 @@ -247,7 +240,7 @@
112.61
112.62 val norm_ss3 =
112.63 simpset_of (put_simpset num_ss @{context}
112.64 - addsimps minus_from_mult_simps @ @{thms add_ac} @ @{thms mult_ac})
112.65 + addsimps minus_from_mult_simps @ @{thms add_ac} @ @{thms mult_ac minus_mult_commute})
112.66
112.67 structure CancelNumeralsCommon =
112.68 struct
112.69 @@ -330,7 +323,7 @@
112.70 structure FieldCombineNumeralsData =
112.71 struct
112.72 type coeff = int * int
112.73 - val iszero = (fn (p, q) => p = 0)
112.74 + val iszero = (fn (p, _) => p = 0)
112.75 val add = add_frac
112.76 val mk_sum = long_mk_sum
112.77 val dest_sum = dest_sum
112.78 @@ -368,7 +361,7 @@
112.79
112.80 structure Semiring_Times_Assoc_Data : ASSOC_FOLD_DATA =
112.81 struct
112.82 - val assoc_ss = simpset_of (put_simpset HOL_basic_ss @{context} addsimps @{thms mult_ac})
112.83 + val assoc_ss = simpset_of (put_simpset HOL_basic_ss @{context} addsimps @{thms mult_ac minus_mult_commute})
112.84 val eq_reflection = eq_reflection
112.85 val is_numeral = can HOLogic.dest_number
112.86 end;
112.87 @@ -388,7 +381,7 @@
112.88 val norm_ss2 =
112.89 simpset_of (put_simpset HOL_basic_ss @{context} addsimps simps @ mult_minus_simps)
112.90 val norm_ss3 =
112.91 - simpset_of (put_simpset HOL_basic_ss @{context} addsimps @{thms mult_ac})
112.92 + simpset_of (put_simpset HOL_basic_ss @{context} addsimps @{thms mult_ac minus_mult_commute})
112.93 fun norm_tac ctxt =
112.94 ALLGOALS (simp_tac (put_simpset norm_ss1 ctxt))
112.95 THEN ALLGOALS (simp_tac (put_simpset norm_ss2 ctxt))
112.96 @@ -463,9 +456,9 @@
112.97 ["((l::'a::field_inverse_zero) * m) / n",
112.98 "(l::'a::field_inverse_zero) / (m * n)",
112.99 "((numeral v)::'a::field_inverse_zero) / (numeral w)",
112.100 - "((numeral v)::'a::field_inverse_zero) / (neg_numeral w)",
112.101 - "((neg_numeral v)::'a::field_inverse_zero) / (numeral w)",
112.102 - "((neg_numeral v)::'a::field_inverse_zero) / (neg_numeral w)"],
112.103 + "((numeral v)::'a::field_inverse_zero) / (- numeral w)",
112.104 + "((- numeral v)::'a::field_inverse_zero) / (numeral w)",
112.105 + "((- numeral v)::'a::field_inverse_zero) / (- numeral w)"],
112.106 DivideCancelNumeralFactor.proc)]
112.107
112.108
112.109 @@ -516,7 +509,7 @@
112.110 val find_first = find_first_t []
112.111 val trans_tac = trans_tac
112.112 val norm_ss =
112.113 - simpset_of (put_simpset HOL_basic_ss @{context} addsimps mult_1s @ @{thms mult_ac})
112.114 + simpset_of (put_simpset HOL_basic_ss @{context} addsimps mult_1s @ @{thms mult_ac minus_mult_commute})
112.115 fun norm_tac ctxt =
112.116 ALLGOALS (simp_tac (put_simpset norm_ss ctxt))
112.117 val simplify_meta_eq = cancel_simplify_meta_eq
113.1 --- a/src/HOL/Transcendental.thy Mon Nov 18 17:15:01 2013 +0100
113.2 +++ b/src/HOL/Transcendental.thy Tue Nov 19 17:07:52 2013 +0100
113.3 @@ -2000,8 +2000,8 @@
113.4 apply (subst powr_add, simp, simp)
113.5 done
113.6
113.7 -lemma powr_realpow_numeral: "0 < x \<Longrightarrow> x powr (numeral n :: real) = x^(numeral n)"
113.8 - unfolding real_of_nat_numeral[symmetric] by (rule powr_realpow)
113.9 +lemma powr_realpow_numeral: "0 < x \<Longrightarrow> x powr (numeral n :: real) = x ^ (numeral n)"
113.10 + unfolding real_of_nat_numeral [symmetric] by (rule powr_realpow)
113.11
113.12 lemma powr_realpow2: "0 <= x ==> 0 < n ==> x^n = (if (x = 0) then 0 else x powr (real n))"
113.13 apply (case_tac "x = 0", simp, simp)
113.14 @@ -2020,11 +2020,17 @@
113.15 then show ?thesis by (simp add: assms powr_realpow[symmetric])
113.16 qed
113.17
113.18 -lemma powr_numeral: "0 < x \<Longrightarrow> x powr numeral n = x^numeral n"
113.19 - using powr_realpow[of x "numeral n"] by simp
113.20 -
113.21 -lemma powr_neg_numeral: "0 < x \<Longrightarrow> x powr neg_numeral n = 1 / x^numeral n"
113.22 - using powr_int[of x "neg_numeral n"] by simp
113.23 +lemma powr_one: "0 < x \<Longrightarrow> x powr 1 = x"
113.24 + using powr_realpow [of x 1] by simp
113.25 +
113.26 +lemma powr_numeral: "0 < x \<Longrightarrow> x powr numeral n = x ^ numeral n"
113.27 + by (fact powr_realpow_numeral)
113.28 +
113.29 +lemma powr_neg_one: "0 < x \<Longrightarrow> x powr - 1 = 1 / x"
113.30 + using powr_int [of x "- 1"] by simp
113.31 +
113.32 +lemma powr_neg_numeral: "0 < x \<Longrightarrow> x powr - numeral n = 1 / x ^ numeral n"
113.33 + using powr_int [of x "- numeral n"] by simp
113.34
113.35 lemma root_powr_inverse: "0 < n \<Longrightarrow> 0 < x \<Longrightarrow> root n x = x powr (1/n)"
113.36 by (rule real_root_pos_unique) (auto simp: powr_realpow[symmetric] powr_powr)
113.37 @@ -4047,7 +4053,7 @@
113.38 show "sgn x * pi / 2 - arctan x < pi / 2"
113.39 using arctan_bounded [of "- x"] assms
113.40 unfolding sgn_real_def arctan_minus
113.41 - by auto
113.42 + by (auto simp add: algebra_simps)
113.43 show "tan (sgn x * pi / 2 - arctan x) = 1 / x"
113.44 unfolding tan_inverse [of "arctan x", unfolded tan_arctan]
113.45 unfolding sgn_real_def
114.1 --- a/src/HOL/Word/Bit_Int.thy Mon Nov 18 17:15:01 2013 +0100
114.2 +++ b/src/HOL/Word/Bit_Int.thy Tue Nov 19 17:07:52 2013 +0100
114.3 @@ -52,10 +52,10 @@
114.4 lemma int_not_simps [simp]:
114.5 "NOT (0::int) = -1"
114.6 "NOT (1::int) = -2"
114.7 - "NOT (-1::int) = 0"
114.8 - "NOT (numeral w::int) = neg_numeral (w + Num.One)"
114.9 - "NOT (neg_numeral (Num.Bit0 w)::int) = numeral (Num.BitM w)"
114.10 - "NOT (neg_numeral (Num.Bit1 w)::int) = numeral (Num.Bit0 w)"
114.11 + "NOT (- 1::int) = 0"
114.12 + "NOT (numeral w::int) = - numeral (w + Num.One)"
114.13 + "NOT (- numeral (Num.Bit0 w)::int) = numeral (Num.BitM w)"
114.14 + "NOT (- numeral (Num.Bit1 w)::int) = numeral (Num.Bit0 w)"
114.15 unfolding int_not_def by simp_all
114.16
114.17 lemma int_not_not [simp]: "NOT (NOT (x::int)) = x"
114.18 @@ -228,11 +228,11 @@
114.19 by (metis bin_rl_simp)
114.20
114.21 lemma bin_rest_neg_numeral_BitM [simp]:
114.22 - "bin_rest (neg_numeral (Num.BitM w)) = neg_numeral w"
114.23 + "bin_rest (- numeral (Num.BitM w)) = - numeral w"
114.24 by (simp only: BIT_bin_simps [symmetric] bin_rest_BIT)
114.25
114.26 lemma bin_last_neg_numeral_BitM [simp]:
114.27 - "bin_last (neg_numeral (Num.BitM w)) = 1"
114.28 + "bin_last (- numeral (Num.BitM w)) = 1"
114.29 by (simp only: BIT_bin_simps [symmetric] bin_last_BIT)
114.30
114.31 text {* FIXME: The rule sets below are very large (24 rules for each
114.32 @@ -243,26 +243,26 @@
114.33 "numeral (Num.Bit0 x) AND numeral (Num.Bit1 y) = (numeral x AND numeral y) BIT 0"
114.34 "numeral (Num.Bit1 x) AND numeral (Num.Bit0 y) = (numeral x AND numeral y) BIT 0"
114.35 "numeral (Num.Bit1 x) AND numeral (Num.Bit1 y) = (numeral x AND numeral y) BIT 1"
114.36 - "numeral (Num.Bit0 x) AND neg_numeral (Num.Bit0 y) = (numeral x AND neg_numeral y) BIT 0"
114.37 - "numeral (Num.Bit0 x) AND neg_numeral (Num.Bit1 y) = (numeral x AND neg_numeral (y + Num.One)) BIT 0"
114.38 - "numeral (Num.Bit1 x) AND neg_numeral (Num.Bit0 y) = (numeral x AND neg_numeral y) BIT 0"
114.39 - "numeral (Num.Bit1 x) AND neg_numeral (Num.Bit1 y) = (numeral x AND neg_numeral (y + Num.One)) BIT 1"
114.40 - "neg_numeral (Num.Bit0 x) AND numeral (Num.Bit0 y) = (neg_numeral x AND numeral y) BIT 0"
114.41 - "neg_numeral (Num.Bit0 x) AND numeral (Num.Bit1 y) = (neg_numeral x AND numeral y) BIT 0"
114.42 - "neg_numeral (Num.Bit1 x) AND numeral (Num.Bit0 y) = (neg_numeral (x + Num.One) AND numeral y) BIT 0"
114.43 - "neg_numeral (Num.Bit1 x) AND numeral (Num.Bit1 y) = (neg_numeral (x + Num.One) AND numeral y) BIT 1"
114.44 - "neg_numeral (Num.Bit0 x) AND neg_numeral (Num.Bit0 y) = (neg_numeral x AND neg_numeral y) BIT 0"
114.45 - "neg_numeral (Num.Bit0 x) AND neg_numeral (Num.Bit1 y) = (neg_numeral x AND neg_numeral (y + Num.One)) BIT 0"
114.46 - "neg_numeral (Num.Bit1 x) AND neg_numeral (Num.Bit0 y) = (neg_numeral (x + Num.One) AND neg_numeral y) BIT 0"
114.47 - "neg_numeral (Num.Bit1 x) AND neg_numeral (Num.Bit1 y) = (neg_numeral (x + Num.One) AND neg_numeral (y + Num.One)) BIT 1"
114.48 + "numeral (Num.Bit0 x) AND - numeral (Num.Bit0 y) = (numeral x AND - numeral y) BIT 0"
114.49 + "numeral (Num.Bit0 x) AND - numeral (Num.Bit1 y) = (numeral x AND - numeral (y + Num.One)) BIT 0"
114.50 + "numeral (Num.Bit1 x) AND - numeral (Num.Bit0 y) = (numeral x AND - numeral y) BIT 0"
114.51 + "numeral (Num.Bit1 x) AND - numeral (Num.Bit1 y) = (numeral x AND - numeral (y + Num.One)) BIT 1"
114.52 + "- numeral (Num.Bit0 x) AND numeral (Num.Bit0 y) = (- numeral x AND numeral y) BIT 0"
114.53 + "- numeral (Num.Bit0 x) AND numeral (Num.Bit1 y) = (- numeral x AND numeral y) BIT 0"
114.54 + "- numeral (Num.Bit1 x) AND numeral (Num.Bit0 y) = (- numeral (x + Num.One) AND numeral y) BIT 0"
114.55 + "- numeral (Num.Bit1 x) AND numeral (Num.Bit1 y) = (- numeral (x + Num.One) AND numeral y) BIT 1"
114.56 + "- numeral (Num.Bit0 x) AND - numeral (Num.Bit0 y) = (- numeral x AND - numeral y) BIT 0"
114.57 + "- numeral (Num.Bit0 x) AND - numeral (Num.Bit1 y) = (- numeral x AND - numeral (y + Num.One)) BIT 0"
114.58 + "- numeral (Num.Bit1 x) AND - numeral (Num.Bit0 y) = (- numeral (x + Num.One) AND - numeral y) BIT 0"
114.59 + "- numeral (Num.Bit1 x) AND - numeral (Num.Bit1 y) = (- numeral (x + Num.One) AND - numeral (y + Num.One)) BIT 1"
114.60 "(1::int) AND numeral (Num.Bit0 y) = 0"
114.61 "(1::int) AND numeral (Num.Bit1 y) = 1"
114.62 - "(1::int) AND neg_numeral (Num.Bit0 y) = 0"
114.63 - "(1::int) AND neg_numeral (Num.Bit1 y) = 1"
114.64 + "(1::int) AND - numeral (Num.Bit0 y) = 0"
114.65 + "(1::int) AND - numeral (Num.Bit1 y) = 1"
114.66 "numeral (Num.Bit0 x) AND (1::int) = 0"
114.67 "numeral (Num.Bit1 x) AND (1::int) = 1"
114.68 - "neg_numeral (Num.Bit0 x) AND (1::int) = 0"
114.69 - "neg_numeral (Num.Bit1 x) AND (1::int) = 1"
114.70 + "- numeral (Num.Bit0 x) AND (1::int) = 0"
114.71 + "- numeral (Num.Bit1 x) AND (1::int) = 1"
114.72 by (rule bin_rl_eqI, simp, simp)+
114.73
114.74 lemma int_or_numerals [simp]:
114.75 @@ -270,26 +270,26 @@
114.76 "numeral (Num.Bit0 x) OR numeral (Num.Bit1 y) = (numeral x OR numeral y) BIT 1"
114.77 "numeral (Num.Bit1 x) OR numeral (Num.Bit0 y) = (numeral x OR numeral y) BIT 1"
114.78 "numeral (Num.Bit1 x) OR numeral (Num.Bit1 y) = (numeral x OR numeral y) BIT 1"
114.79 - "numeral (Num.Bit0 x) OR neg_numeral (Num.Bit0 y) = (numeral x OR neg_numeral y) BIT 0"
114.80 - "numeral (Num.Bit0 x) OR neg_numeral (Num.Bit1 y) = (numeral x OR neg_numeral (y + Num.One)) BIT 1"
114.81 - "numeral (Num.Bit1 x) OR neg_numeral (Num.Bit0 y) = (numeral x OR neg_numeral y) BIT 1"
114.82 - "numeral (Num.Bit1 x) OR neg_numeral (Num.Bit1 y) = (numeral x OR neg_numeral (y + Num.One)) BIT 1"
114.83 - "neg_numeral (Num.Bit0 x) OR numeral (Num.Bit0 y) = (neg_numeral x OR numeral y) BIT 0"
114.84 - "neg_numeral (Num.Bit0 x) OR numeral (Num.Bit1 y) = (neg_numeral x OR numeral y) BIT 1"
114.85 - "neg_numeral (Num.Bit1 x) OR numeral (Num.Bit0 y) = (neg_numeral (x + Num.One) OR numeral y) BIT 1"
114.86 - "neg_numeral (Num.Bit1 x) OR numeral (Num.Bit1 y) = (neg_numeral (x + Num.One) OR numeral y) BIT 1"
114.87 - "neg_numeral (Num.Bit0 x) OR neg_numeral (Num.Bit0 y) = (neg_numeral x OR neg_numeral y) BIT 0"
114.88 - "neg_numeral (Num.Bit0 x) OR neg_numeral (Num.Bit1 y) = (neg_numeral x OR neg_numeral (y + Num.One)) BIT 1"
114.89 - "neg_numeral (Num.Bit1 x) OR neg_numeral (Num.Bit0 y) = (neg_numeral (x + Num.One) OR neg_numeral y) BIT 1"
114.90 - "neg_numeral (Num.Bit1 x) OR neg_numeral (Num.Bit1 y) = (neg_numeral (x + Num.One) OR neg_numeral (y + Num.One)) BIT 1"
114.91 + "numeral (Num.Bit0 x) OR - numeral (Num.Bit0 y) = (numeral x OR - numeral y) BIT 0"
114.92 + "numeral (Num.Bit0 x) OR - numeral (Num.Bit1 y) = (numeral x OR - numeral (y + Num.One)) BIT 1"
114.93 + "numeral (Num.Bit1 x) OR - numeral (Num.Bit0 y) = (numeral x OR - numeral y) BIT 1"
114.94 + "numeral (Num.Bit1 x) OR - numeral (Num.Bit1 y) = (numeral x OR - numeral (y + Num.One)) BIT 1"
114.95 + "- numeral (Num.Bit0 x) OR numeral (Num.Bit0 y) = (- numeral x OR numeral y) BIT 0"
114.96 + "- numeral (Num.Bit0 x) OR numeral (Num.Bit1 y) = (- numeral x OR numeral y) BIT 1"
114.97 + "- numeral (Num.Bit1 x) OR numeral (Num.Bit0 y) = (- numeral (x + Num.One) OR numeral y) BIT 1"
114.98 + "- numeral (Num.Bit1 x) OR numeral (Num.Bit1 y) = (- numeral (x + Num.One) OR numeral y) BIT 1"
114.99 + "- numeral (Num.Bit0 x) OR - numeral (Num.Bit0 y) = (- numeral x OR - numeral y) BIT 0"
114.100 + "- numeral (Num.Bit0 x) OR - numeral (Num.Bit1 y) = (- numeral x OR - numeral (y + Num.One)) BIT 1"
114.101 + "- numeral (Num.Bit1 x) OR - numeral (Num.Bit0 y) = (- numeral (x + Num.One) OR - numeral y) BIT 1"
114.102 + "- numeral (Num.Bit1 x) OR - numeral (Num.Bit1 y) = (- numeral (x + Num.One) OR - numeral (y + Num.One)) BIT 1"
114.103 "(1::int) OR numeral (Num.Bit0 y) = numeral (Num.Bit1 y)"
114.104 "(1::int) OR numeral (Num.Bit1 y) = numeral (Num.Bit1 y)"
114.105 - "(1::int) OR neg_numeral (Num.Bit0 y) = neg_numeral (Num.BitM y)"
114.106 - "(1::int) OR neg_numeral (Num.Bit1 y) = neg_numeral (Num.Bit1 y)"
114.107 + "(1::int) OR - numeral (Num.Bit0 y) = - numeral (Num.BitM y)"
114.108 + "(1::int) OR - numeral (Num.Bit1 y) = - numeral (Num.Bit1 y)"
114.109 "numeral (Num.Bit0 x) OR (1::int) = numeral (Num.Bit1 x)"
114.110 "numeral (Num.Bit1 x) OR (1::int) = numeral (Num.Bit1 x)"
114.111 - "neg_numeral (Num.Bit0 x) OR (1::int) = neg_numeral (Num.BitM x)"
114.112 - "neg_numeral (Num.Bit1 x) OR (1::int) = neg_numeral (Num.Bit1 x)"
114.113 + "- numeral (Num.Bit0 x) OR (1::int) = - numeral (Num.BitM x)"
114.114 + "- numeral (Num.Bit1 x) OR (1::int) = - numeral (Num.Bit1 x)"
114.115 by (rule bin_rl_eqI, simp, simp)+
114.116
114.117 lemma int_xor_numerals [simp]:
114.118 @@ -297,26 +297,26 @@
114.119 "numeral (Num.Bit0 x) XOR numeral (Num.Bit1 y) = (numeral x XOR numeral y) BIT 1"
114.120 "numeral (Num.Bit1 x) XOR numeral (Num.Bit0 y) = (numeral x XOR numeral y) BIT 1"
114.121 "numeral (Num.Bit1 x) XOR numeral (Num.Bit1 y) = (numeral x XOR numeral y) BIT 0"
114.122 - "numeral (Num.Bit0 x) XOR neg_numeral (Num.Bit0 y) = (numeral x XOR neg_numeral y) BIT 0"
114.123 - "numeral (Num.Bit0 x) XOR neg_numeral (Num.Bit1 y) = (numeral x XOR neg_numeral (y + Num.One)) BIT 1"
114.124 - "numeral (Num.Bit1 x) XOR neg_numeral (Num.Bit0 y) = (numeral x XOR neg_numeral y) BIT 1"
114.125 - "numeral (Num.Bit1 x) XOR neg_numeral (Num.Bit1 y) = (numeral x XOR neg_numeral (y + Num.One)) BIT 0"
114.126 - "neg_numeral (Num.Bit0 x) XOR numeral (Num.Bit0 y) = (neg_numeral x XOR numeral y) BIT 0"
114.127 - "neg_numeral (Num.Bit0 x) XOR numeral (Num.Bit1 y) = (neg_numeral x XOR numeral y) BIT 1"
114.128 - "neg_numeral (Num.Bit1 x) XOR numeral (Num.Bit0 y) = (neg_numeral (x + Num.One) XOR numeral y) BIT 1"
114.129 - "neg_numeral (Num.Bit1 x) XOR numeral (Num.Bit1 y) = (neg_numeral (x + Num.One) XOR numeral y) BIT 0"
114.130 - "neg_numeral (Num.Bit0 x) XOR neg_numeral (Num.Bit0 y) = (neg_numeral x XOR neg_numeral y) BIT 0"
114.131 - "neg_numeral (Num.Bit0 x) XOR neg_numeral (Num.Bit1 y) = (neg_numeral x XOR neg_numeral (y + Num.One)) BIT 1"
114.132 - "neg_numeral (Num.Bit1 x) XOR neg_numeral (Num.Bit0 y) = (neg_numeral (x + Num.One) XOR neg_numeral y) BIT 1"
114.133 - "neg_numeral (Num.Bit1 x) XOR neg_numeral (Num.Bit1 y) = (neg_numeral (x + Num.One) XOR neg_numeral (y + Num.One)) BIT 0"
114.134 + "numeral (Num.Bit0 x) XOR - numeral (Num.Bit0 y) = (numeral x XOR - numeral y) BIT 0"
114.135 + "numeral (Num.Bit0 x) XOR - numeral (Num.Bit1 y) = (numeral x XOR - numeral (y + Num.One)) BIT 1"
114.136 + "numeral (Num.Bit1 x) XOR - numeral (Num.Bit0 y) = (numeral x XOR - numeral y) BIT 1"
114.137 + "numeral (Num.Bit1 x) XOR - numeral (Num.Bit1 y) = (numeral x XOR - numeral (y + Num.One)) BIT 0"
114.138 + "- numeral (Num.Bit0 x) XOR numeral (Num.Bit0 y) = (- numeral x XOR numeral y) BIT 0"
114.139 + "- numeral (Num.Bit0 x) XOR numeral (Num.Bit1 y) = (- numeral x XOR numeral y) BIT 1"
114.140 + "- numeral (Num.Bit1 x) XOR numeral (Num.Bit0 y) = (- numeral (x + Num.One) XOR numeral y) BIT 1"
114.141 + "- numeral (Num.Bit1 x) XOR numeral (Num.Bit1 y) = (- numeral (x + Num.One) XOR numeral y) BIT 0"
114.142 + "- numeral (Num.Bit0 x) XOR - numeral (Num.Bit0 y) = (- numeral x XOR - numeral y) BIT 0"
114.143 + "- numeral (Num.Bit0 x) XOR - numeral (Num.Bit1 y) = (- numeral x XOR - numeral (y + Num.One)) BIT 1"
114.144 + "- numeral (Num.Bit1 x) XOR - numeral (Num.Bit0 y) = (- numeral (x + Num.One) XOR - numeral y) BIT 1"
114.145 + "- numeral (Num.Bit1 x) XOR - numeral (Num.Bit1 y) = (- numeral (x + Num.One) XOR - numeral (y + Num.One)) BIT 0"
114.146 "(1::int) XOR numeral (Num.Bit0 y) = numeral (Num.Bit1 y)"
114.147 "(1::int) XOR numeral (Num.Bit1 y) = numeral (Num.Bit0 y)"
114.148 - "(1::int) XOR neg_numeral (Num.Bit0 y) = neg_numeral (Num.BitM y)"
114.149 - "(1::int) XOR neg_numeral (Num.Bit1 y) = neg_numeral (Num.Bit0 (y + Num.One))"
114.150 + "(1::int) XOR - numeral (Num.Bit0 y) = - numeral (Num.BitM y)"
114.151 + "(1::int) XOR - numeral (Num.Bit1 y) = - numeral (Num.Bit0 (y + Num.One))"
114.152 "numeral (Num.Bit0 x) XOR (1::int) = numeral (Num.Bit1 x)"
114.153 "numeral (Num.Bit1 x) XOR (1::int) = numeral (Num.Bit0 x)"
114.154 - "neg_numeral (Num.Bit0 x) XOR (1::int) = neg_numeral (Num.BitM x)"
114.155 - "neg_numeral (Num.Bit1 x) XOR (1::int) = neg_numeral (Num.Bit0 (x + Num.One))"
114.156 + "- numeral (Num.Bit0 x) XOR (1::int) = - numeral (Num.BitM x)"
114.157 + "- numeral (Num.Bit1 x) XOR (1::int) = - numeral (Num.Bit0 (x + Num.One))"
114.158 by (rule bin_rl_eqI, simp, simp)+
114.159
114.160 subsubsection {* Interactions with arithmetic *}
115.1 --- a/src/HOL/Word/Bit_Representation.thy Mon Nov 18 17:15:01 2013 +0100
115.2 +++ b/src/HOL/Word/Bit_Representation.thy Tue Nov 19 17:07:52 2013 +0100
115.3 @@ -61,21 +61,23 @@
115.4 lemma BIT_bin_simps [simp]:
115.5 "numeral k BIT 0 = numeral (Num.Bit0 k)"
115.6 "numeral k BIT 1 = numeral (Num.Bit1 k)"
115.7 - "neg_numeral k BIT 0 = neg_numeral (Num.Bit0 k)"
115.8 - "neg_numeral k BIT 1 = neg_numeral (Num.BitM k)"
115.9 - unfolding neg_numeral_def numeral.simps numeral_BitM
115.10 + "(- numeral k) BIT 0 = - numeral (Num.Bit0 k)"
115.11 + "(- numeral k) BIT 1 = - numeral (Num.BitM k)"
115.12 + unfolding numeral.simps numeral_BitM
115.13 unfolding Bit_def bitval_simps
115.14 by (simp_all del: arith_simps add_numeral_special diff_numeral_special)
115.15
115.16 lemma BIT_special_simps [simp]:
115.17 - shows "0 BIT 0 = 0" and "0 BIT 1 = 1" and "1 BIT 0 = 2" and "1 BIT 1 = 3"
115.18 + shows "0 BIT 0 = 0" and "0 BIT 1 = 1"
115.19 + and "1 BIT 0 = 2" and "1 BIT 1 = 3"
115.20 + and "(- 1) BIT 0 = - 2" and "(- 1) BIT 1 = - 1"
115.21 unfolding Bit_def by simp_all
115.22
115.23 lemma Bit_eq_0_iff: "w BIT b = 0 \<longleftrightarrow> w = 0 \<and> b = 0"
115.24 by (subst BIT_eq_iff [symmetric], simp)
115.25
115.26 -lemma Bit_eq_m1_iff: "w BIT b = -1 \<longleftrightarrow> w = -1 \<and> b = 1"
115.27 - by (subst BIT_eq_iff [symmetric], simp)
115.28 +lemma Bit_eq_m1_iff: "w BIT b = - 1 \<longleftrightarrow> w = - 1 \<and> b = 1"
115.29 + by (cases b) (auto simp add: Bit_def, arith)
115.30
115.31 lemma BitM_inc: "Num.BitM (Num.inc w) = Num.Bit1 w"
115.32 by (induct w, simp_all)
115.33 @@ -83,8 +85,8 @@
115.34 lemma expand_BIT:
115.35 "numeral (Num.Bit0 w) = numeral w BIT 0"
115.36 "numeral (Num.Bit1 w) = numeral w BIT 1"
115.37 - "neg_numeral (Num.Bit0 w) = neg_numeral w BIT 0"
115.38 - "neg_numeral (Num.Bit1 w) = neg_numeral (w + Num.One) BIT 1"
115.39 + "- numeral (Num.Bit0 w) = - numeral w BIT 0"
115.40 + "- numeral (Num.Bit1 w) = (- numeral (w + Num.One)) BIT 1"
115.41 unfolding add_One by (simp_all add: BitM_inc)
115.42
115.43 lemma bin_last_numeral_simps [simp]:
115.44 @@ -94,9 +96,9 @@
115.45 "bin_last Numeral1 = 1"
115.46 "bin_last (numeral (Num.Bit0 w)) = 0"
115.47 "bin_last (numeral (Num.Bit1 w)) = 1"
115.48 - "bin_last (neg_numeral (Num.Bit0 w)) = 0"
115.49 - "bin_last (neg_numeral (Num.Bit1 w)) = 1"
115.50 - unfolding expand_BIT bin_last_BIT by (simp_all add: bin_last_def)
115.51 + "bin_last (- numeral (Num.Bit0 w)) = 0"
115.52 + "bin_last (- numeral (Num.Bit1 w)) = 1"
115.53 + unfolding expand_BIT bin_last_BIT by (simp_all add: bin_last_def zmod_zminus1_eq_if)
115.54
115.55 lemma bin_rest_numeral_simps [simp]:
115.56 "bin_rest 0 = 0"
115.57 @@ -105,9 +107,9 @@
115.58 "bin_rest Numeral1 = 0"
115.59 "bin_rest (numeral (Num.Bit0 w)) = numeral w"
115.60 "bin_rest (numeral (Num.Bit1 w)) = numeral w"
115.61 - "bin_rest (neg_numeral (Num.Bit0 w)) = neg_numeral w"
115.62 - "bin_rest (neg_numeral (Num.Bit1 w)) = neg_numeral (w + Num.One)"
115.63 - unfolding expand_BIT bin_rest_BIT by (simp_all add: bin_rest_def)
115.64 + "bin_rest (- numeral (Num.Bit0 w)) = - numeral w"
115.65 + "bin_rest (- numeral (Num.Bit1 w)) = - numeral (w + Num.One)"
115.66 + unfolding expand_BIT bin_rest_BIT by (simp_all add: bin_rest_def zdiv_zminus1_eq_if)
115.67
115.68 lemma less_Bits:
115.69 "(v BIT b < w BIT c) = (v < w | v <= w & b = (0::bit) & c = (1::bit))"
115.70 @@ -197,42 +199,45 @@
115.71 lemma Bit_div2 [simp]: "(w BIT b) div 2 = w"
115.72 unfolding bin_rest_def [symmetric] by (rule bin_rest_BIT)
115.73
115.74 -lemma bin_nth_lem [rule_format]:
115.75 - "ALL y. bin_nth x = bin_nth y --> x = y"
115.76 - apply (induct x rule: bin_induct)
115.77 - apply safe
115.78 - apply (erule rev_mp)
115.79 - apply (induct_tac y rule: bin_induct)
115.80 +lemma bin_nth_eq_iff:
115.81 + "bin_nth x = bin_nth y \<longleftrightarrow> x = y"
115.82 +proof -
115.83 + have bin_nth_lem [rule_format]: "ALL y. bin_nth x = bin_nth y --> x = y"
115.84 + apply (induct x rule: bin_induct)
115.85 apply safe
115.86 + apply (erule rev_mp)
115.87 + apply (induct_tac y rule: bin_induct)
115.88 + apply safe
115.89 + apply (drule_tac x=0 in fun_cong, force)
115.90 + apply (erule notE, rule ext,
115.91 + drule_tac x="Suc x" in fun_cong, force)
115.92 apply (drule_tac x=0 in fun_cong, force)
115.93 - apply (erule notE, rule ext,
115.94 - drule_tac x="Suc x" in fun_cong, force)
115.95 - apply (drule_tac x=0 in fun_cong, force)
115.96 - apply (erule rev_mp)
115.97 - apply (induct_tac y rule: bin_induct)
115.98 - apply safe
115.99 + apply (erule rev_mp)
115.100 + apply (induct_tac y rule: bin_induct)
115.101 + apply safe
115.102 + apply (drule_tac x=0 in fun_cong, force)
115.103 + apply (erule notE, rule ext,
115.104 + drule_tac x="Suc x" in fun_cong, force)
115.105 + apply (metis Bit_eq_m1_iff Z bin_last_BIT)
115.106 + apply (case_tac y rule: bin_exhaust)
115.107 + apply clarify
115.108 + apply (erule allE)
115.109 + apply (erule impE)
115.110 + prefer 2
115.111 + apply (erule conjI)
115.112 apply (drule_tac x=0 in fun_cong, force)
115.113 - apply (erule notE, rule ext,
115.114 - drule_tac x="Suc x" in fun_cong, force)
115.115 - apply (drule_tac x=0 in fun_cong, force)
115.116 - apply (case_tac y rule: bin_exhaust)
115.117 - apply clarify
115.118 - apply (erule allE)
115.119 - apply (erule impE)
115.120 - prefer 2
115.121 - apply (erule conjI)
115.122 - apply (drule_tac x=0 in fun_cong, force)
115.123 - apply (rule ext)
115.124 - apply (drule_tac x="Suc ?x" in fun_cong, force)
115.125 - done
115.126 -
115.127 -lemma bin_nth_eq_iff: "(bin_nth x = bin_nth y) = (x = y)"
115.128 + apply (rule ext)
115.129 + apply (drule_tac x="Suc ?x" in fun_cong, force)
115.130 + done
115.131 + show ?thesis
115.132 by (auto elim: bin_nth_lem)
115.133 +qed
115.134
115.135 lemmas bin_eqI = ext [THEN bin_nth_eq_iff [THEN iffD1]]
115.136
115.137 -lemma bin_eq_iff: "x = y \<longleftrightarrow> (\<forall>n. bin_nth x n = bin_nth y n)"
115.138 - by (auto intro!: bin_nth_lem del: equalityI)
115.139 +lemma bin_eq_iff:
115.140 + "x = y \<longleftrightarrow> (\<forall>n. bin_nth x n = bin_nth y n)"
115.141 + using bin_nth_eq_iff by auto
115.142
115.143 lemma bin_nth_zero [simp]: "\<not> bin_nth 0 n"
115.144 by (induct n) auto
115.145 @@ -276,8 +281,9 @@
115.146 lemma bin_sign_simps [simp]:
115.147 "bin_sign 0 = 0"
115.148 "bin_sign 1 = 0"
115.149 + "bin_sign (- 1) = - 1"
115.150 "bin_sign (numeral k) = 0"
115.151 - "bin_sign (neg_numeral k) = -1"
115.152 + "bin_sign (- numeral k) = -1"
115.153 "bin_sign (w BIT b) = bin_sign w"
115.154 unfolding bin_sign_def Bit_def bitval_def
115.155 by (simp_all split: bit.split)
115.156 @@ -331,18 +337,18 @@
115.157 "bintrunc (Suc n) -1 = bintrunc n -1 BIT 1"
115.158 "bintrunc (Suc n) (numeral (Num.Bit0 w)) = bintrunc n (numeral w) BIT 0"
115.159 "bintrunc (Suc n) (numeral (Num.Bit1 w)) = bintrunc n (numeral w) BIT 1"
115.160 - "bintrunc (Suc n) (neg_numeral (Num.Bit0 w)) =
115.161 - bintrunc n (neg_numeral w) BIT 0"
115.162 - "bintrunc (Suc n) (neg_numeral (Num.Bit1 w)) =
115.163 - bintrunc n (neg_numeral (w + Num.One)) BIT 1"
115.164 + "bintrunc (Suc n) (- numeral (Num.Bit0 w)) =
115.165 + bintrunc n (- numeral w) BIT 0"
115.166 + "bintrunc (Suc n) (- numeral (Num.Bit1 w)) =
115.167 + bintrunc n (- numeral (w + Num.One)) BIT 1"
115.168 by simp_all
115.169
115.170 lemma sbintrunc_0_numeral [simp]:
115.171 "sbintrunc 0 1 = -1"
115.172 "sbintrunc 0 (numeral (Num.Bit0 w)) = 0"
115.173 "sbintrunc 0 (numeral (Num.Bit1 w)) = -1"
115.174 - "sbintrunc 0 (neg_numeral (Num.Bit0 w)) = 0"
115.175 - "sbintrunc 0 (neg_numeral (Num.Bit1 w)) = -1"
115.176 + "sbintrunc 0 (- numeral (Num.Bit0 w)) = 0"
115.177 + "sbintrunc 0 (- numeral (Num.Bit1 w)) = -1"
115.178 by simp_all
115.179
115.180 lemma sbintrunc_Suc_numeral:
115.181 @@ -351,10 +357,10 @@
115.182 sbintrunc n (numeral w) BIT 0"
115.183 "sbintrunc (Suc n) (numeral (Num.Bit1 w)) =
115.184 sbintrunc n (numeral w) BIT 1"
115.185 - "sbintrunc (Suc n) (neg_numeral (Num.Bit0 w)) =
115.186 - sbintrunc n (neg_numeral w) BIT 0"
115.187 - "sbintrunc (Suc n) (neg_numeral (Num.Bit1 w)) =
115.188 - sbintrunc n (neg_numeral (w + Num.One)) BIT 1"
115.189 + "sbintrunc (Suc n) (- numeral (Num.Bit0 w)) =
115.190 + sbintrunc n (- numeral w) BIT 0"
115.191 + "sbintrunc (Suc n) (- numeral (Num.Bit1 w)) =
115.192 + sbintrunc n (- numeral (w + Num.One)) BIT 1"
115.193 by simp_all
115.194
115.195 lemma bit_bool:
115.196 @@ -580,10 +586,10 @@
115.197 bintrunc (pred_numeral k) (numeral w) BIT 0"
115.198 "bintrunc (numeral k) (numeral (Num.Bit1 w)) =
115.199 bintrunc (pred_numeral k) (numeral w) BIT 1"
115.200 - "bintrunc (numeral k) (neg_numeral (Num.Bit0 w)) =
115.201 - bintrunc (pred_numeral k) (neg_numeral w) BIT 0"
115.202 - "bintrunc (numeral k) (neg_numeral (Num.Bit1 w)) =
115.203 - bintrunc (pred_numeral k) (neg_numeral (w + Num.One)) BIT 1"
115.204 + "bintrunc (numeral k) (- numeral (Num.Bit0 w)) =
115.205 + bintrunc (pred_numeral k) (- numeral w) BIT 0"
115.206 + "bintrunc (numeral k) (- numeral (Num.Bit1 w)) =
115.207 + bintrunc (pred_numeral k) (- numeral (w + Num.One)) BIT 1"
115.208 "bintrunc (numeral k) 1 = 1"
115.209 by (simp_all add: bintrunc_numeral)
115.210
115.211 @@ -592,10 +598,10 @@
115.212 sbintrunc (pred_numeral k) (numeral w) BIT 0"
115.213 "sbintrunc (numeral k) (numeral (Num.Bit1 w)) =
115.214 sbintrunc (pred_numeral k) (numeral w) BIT 1"
115.215 - "sbintrunc (numeral k) (neg_numeral (Num.Bit0 w)) =
115.216 - sbintrunc (pred_numeral k) (neg_numeral w) BIT 0"
115.217 - "sbintrunc (numeral k) (neg_numeral (Num.Bit1 w)) =
115.218 - sbintrunc (pred_numeral k) (neg_numeral (w + Num.One)) BIT 1"
115.219 + "sbintrunc (numeral k) (- numeral (Num.Bit0 w)) =
115.220 + sbintrunc (pred_numeral k) (- numeral w) BIT 0"
115.221 + "sbintrunc (numeral k) (- numeral (Num.Bit1 w)) =
115.222 + sbintrunc (pred_numeral k) (- numeral (w + Num.One)) BIT 1"
115.223 "sbintrunc (numeral k) 1 = 1"
115.224 by (simp_all add: sbintrunc_numeral)
115.225
116.1 --- a/src/HOL/Word/Word.thy Mon Nov 18 17:15:01 2013 +0100
116.2 +++ b/src/HOL/Word/Word.thy Tue Nov 19 17:07:52 2013 +0100
116.3 @@ -591,24 +591,24 @@
116.4 declare word_numeral_alt [symmetric, code_abbrev]
116.5
116.6 lemma word_neg_numeral_alt:
116.7 - "neg_numeral b = word_of_int (neg_numeral b)"
116.8 - by (simp only: neg_numeral_def word_numeral_alt wi_hom_neg)
116.9 + "- numeral b = word_of_int (- numeral b)"
116.10 + by (simp only: word_numeral_alt wi_hom_neg)
116.11
116.12 declare word_neg_numeral_alt [symmetric, code_abbrev]
116.13
116.14 lemma word_numeral_transfer [transfer_rule]:
116.15 "(fun_rel op = pcr_word) numeral numeral"
116.16 - "(fun_rel op = pcr_word) neg_numeral neg_numeral"
116.17 - unfolding fun_rel_def word.pcr_cr_eq cr_word_def word_numeral_alt word_neg_numeral_alt
116.18 - by simp_all
116.19 + "(fun_rel op = pcr_word) (- numeral) (- numeral)"
116.20 + apply (simp_all add: fun_rel_def word.pcr_cr_eq cr_word_def)
116.21 + using word_numeral_alt [symmetric] word_neg_numeral_alt [symmetric] by blast+
116.22
116.23 lemma uint_bintrunc [simp]:
116.24 "uint (numeral bin :: 'a word) =
116.25 bintrunc (len_of TYPE ('a :: len0)) (numeral bin)"
116.26 unfolding word_numeral_alt by (rule word_ubin.eq_norm)
116.27
116.28 -lemma uint_bintrunc_neg [simp]: "uint (neg_numeral bin :: 'a word) =
116.29 - bintrunc (len_of TYPE ('a :: len0)) (neg_numeral bin)"
116.30 +lemma uint_bintrunc_neg [simp]: "uint (- numeral bin :: 'a word) =
116.31 + bintrunc (len_of TYPE ('a :: len0)) (- numeral bin)"
116.32 by (simp only: word_neg_numeral_alt word_ubin.eq_norm)
116.33
116.34 lemma sint_sbintrunc [simp]:
116.35 @@ -616,8 +616,8 @@
116.36 sbintrunc (len_of TYPE ('a :: len) - 1) (numeral bin)"
116.37 by (simp only: word_numeral_alt word_sbin.eq_norm)
116.38
116.39 -lemma sint_sbintrunc_neg [simp]: "sint (neg_numeral bin :: 'a word) =
116.40 - sbintrunc (len_of TYPE ('a :: len) - 1) (neg_numeral bin)"
116.41 +lemma sint_sbintrunc_neg [simp]: "sint (- numeral bin :: 'a word) =
116.42 + sbintrunc (len_of TYPE ('a :: len) - 1) (- numeral bin)"
116.43 by (simp only: word_neg_numeral_alt word_sbin.eq_norm)
116.44
116.45 lemma unat_bintrunc [simp]:
116.46 @@ -626,8 +626,8 @@
116.47 by (simp only: unat_def uint_bintrunc)
116.48
116.49 lemma unat_bintrunc_neg [simp]:
116.50 - "unat (neg_numeral bin :: 'a :: len0 word) =
116.51 - nat (bintrunc (len_of TYPE('a)) (neg_numeral bin))"
116.52 + "unat (- numeral bin :: 'a :: len0 word) =
116.53 + nat (bintrunc (len_of TYPE('a)) (- numeral bin))"
116.54 by (simp only: unat_def uint_bintrunc_neg)
116.55
116.56 lemma size_0_eq: "size (w :: 'a :: len0 word) = 0 \<Longrightarrow> v = w"
116.57 @@ -678,7 +678,7 @@
116.58 by (simp only: int_word_uint)
116.59
116.60 lemma uint_neg_numeral:
116.61 - "uint (neg_numeral b :: 'a :: len0 word) = neg_numeral b mod 2 ^ len_of TYPE('a)"
116.62 + "uint (- numeral b :: 'a :: len0 word) = - numeral b mod 2 ^ len_of TYPE('a)"
116.63 unfolding word_neg_numeral_alt
116.64 by (simp only: int_word_uint)
116.65
116.66 @@ -702,13 +702,16 @@
116.67 lemma word_of_int_1 [simp, code_post]: "word_of_int 1 = 1"
116.68 unfolding word_1_wi ..
116.69
116.70 +lemma word_of_int_neg_1 [simp]: "word_of_int (- 1) = - 1"
116.71 + by (simp add: wi_hom_syms)
116.72 +
116.73 lemma word_of_int_numeral [simp] :
116.74 "(word_of_int (numeral bin) :: 'a :: len0 word) = (numeral bin)"
116.75 unfolding word_numeral_alt ..
116.76
116.77 lemma word_of_int_neg_numeral [simp]:
116.78 - "(word_of_int (neg_numeral bin) :: 'a :: len0 word) = (neg_numeral bin)"
116.79 - unfolding neg_numeral_def word_numeral_alt wi_hom_syms ..
116.80 + "(word_of_int (- numeral bin) :: 'a :: len0 word) = (- numeral bin)"
116.81 + unfolding word_numeral_alt wi_hom_syms ..
116.82
116.83 lemma word_int_case_wi:
116.84 "word_int_case f (word_of_int i :: 'b word) =
116.85 @@ -880,8 +883,8 @@
116.86 unfolding word_numeral_alt by (rule to_bl_of_bin)
116.87
116.88 lemma to_bl_neg_numeral [simp]:
116.89 - "to_bl (neg_numeral bin::'a::len0 word) =
116.90 - bin_to_bl (len_of TYPE('a)) (neg_numeral bin)"
116.91 + "to_bl (- numeral bin::'a::len0 word) =
116.92 + bin_to_bl (len_of TYPE('a)) (- numeral bin)"
116.93 unfolding word_neg_numeral_alt by (rule to_bl_of_bin)
116.94
116.95 lemma to_bl_to_bin [simp] : "bl_to_bin (to_bl w) = uint w"
116.96 @@ -1156,11 +1159,8 @@
116.97
116.98 lemmas word_sle_no [simp] = word_sle_def [of "numeral a" "numeral b"] for a b
116.99
116.100 -lemma word_1_no: "(1::'a::len0 word) = Numeral1"
116.101 - by (simp add: word_numeral_alt)
116.102 -
116.103 -lemma word_m1_wi: "-1 = word_of_int -1"
116.104 - by (rule word_neg_numeral_alt)
116.105 +lemma word_m1_wi: "- 1 = word_of_int (- 1)"
116.106 + using word_neg_numeral_alt [of Num.One] by simp
116.107
116.108 lemma word_0_bl [simp]: "of_bl [] = 0"
116.109 unfolding of_bl_def by simp
116.110 @@ -1215,9 +1215,9 @@
116.111 unfolding scast_def by simp
116.112
116.113 lemma sint_n1 [simp] : "sint -1 = -1"
116.114 - unfolding word_m1_wi by (simp add: word_sbin.eq_norm)
116.115 -
116.116 -lemma scast_n1 [simp]: "scast -1 = -1"
116.117 + unfolding word_m1_wi word_sbin.eq_norm by simp
116.118 +
116.119 +lemma scast_n1 [simp]: "scast (- 1) = - 1"
116.120 unfolding scast_def by simp
116.121
116.122 lemma uint_1 [simp]: "uint (1::'a::len word) = 1"
116.123 @@ -1270,8 +1270,8 @@
116.124 lemma succ_pred_no [simp]:
116.125 "word_succ (numeral w) = numeral w + 1"
116.126 "word_pred (numeral w) = numeral w - 1"
116.127 - "word_succ (neg_numeral w) = neg_numeral w + 1"
116.128 - "word_pred (neg_numeral w) = neg_numeral w - 1"
116.129 + "word_succ (- numeral w) = - numeral w + 1"
116.130 + "word_pred (- numeral w) = - numeral w - 1"
116.131 unfolding word_succ_p1 word_pred_m1 by simp_all
116.132
116.133 lemma word_sp_01 [simp] :
116.134 @@ -2151,19 +2151,19 @@
116.135
116.136 lemma word_no_log_defs [simp]:
116.137 "NOT (numeral a) = word_of_int (NOT (numeral a))"
116.138 - "NOT (neg_numeral a) = word_of_int (NOT (neg_numeral a))"
116.139 + "NOT (- numeral a) = word_of_int (NOT (- numeral a))"
116.140 "numeral a AND numeral b = word_of_int (numeral a AND numeral b)"
116.141 - "numeral a AND neg_numeral b = word_of_int (numeral a AND neg_numeral b)"
116.142 - "neg_numeral a AND numeral b = word_of_int (neg_numeral a AND numeral b)"
116.143 - "neg_numeral a AND neg_numeral b = word_of_int (neg_numeral a AND neg_numeral b)"
116.144 + "numeral a AND - numeral b = word_of_int (numeral a AND - numeral b)"
116.145 + "- numeral a AND numeral b = word_of_int (- numeral a AND numeral b)"
116.146 + "- numeral a AND - numeral b = word_of_int (- numeral a AND - numeral b)"
116.147 "numeral a OR numeral b = word_of_int (numeral a OR numeral b)"
116.148 - "numeral a OR neg_numeral b = word_of_int (numeral a OR neg_numeral b)"
116.149 - "neg_numeral a OR numeral b = word_of_int (neg_numeral a OR numeral b)"
116.150 - "neg_numeral a OR neg_numeral b = word_of_int (neg_numeral a OR neg_numeral b)"
116.151 + "numeral a OR - numeral b = word_of_int (numeral a OR - numeral b)"
116.152 + "- numeral a OR numeral b = word_of_int (- numeral a OR numeral b)"
116.153 + "- numeral a OR - numeral b = word_of_int (- numeral a OR - numeral b)"
116.154 "numeral a XOR numeral b = word_of_int (numeral a XOR numeral b)"
116.155 - "numeral a XOR neg_numeral b = word_of_int (numeral a XOR neg_numeral b)"
116.156 - "neg_numeral a XOR numeral b = word_of_int (neg_numeral a XOR numeral b)"
116.157 - "neg_numeral a XOR neg_numeral b = word_of_int (neg_numeral a XOR neg_numeral b)"
116.158 + "numeral a XOR - numeral b = word_of_int (numeral a XOR - numeral b)"
116.159 + "- numeral a XOR numeral b = word_of_int (- numeral a XOR numeral b)"
116.160 + "- numeral a XOR - numeral b = word_of_int (- numeral a XOR - numeral b)"
116.161 by (transfer, rule refl)+
116.162
116.163 text {* Special cases for when one of the arguments equals 1. *}
116.164 @@ -2171,17 +2171,17 @@
116.165 lemma word_bitwise_1_simps [simp]:
116.166 "NOT (1::'a::len0 word) = -2"
116.167 "1 AND numeral b = word_of_int (1 AND numeral b)"
116.168 - "1 AND neg_numeral b = word_of_int (1 AND neg_numeral b)"
116.169 + "1 AND - numeral b = word_of_int (1 AND - numeral b)"
116.170 "numeral a AND 1 = word_of_int (numeral a AND 1)"
116.171 - "neg_numeral a AND 1 = word_of_int (neg_numeral a AND 1)"
116.172 + "- numeral a AND 1 = word_of_int (- numeral a AND 1)"
116.173 "1 OR numeral b = word_of_int (1 OR numeral b)"
116.174 - "1 OR neg_numeral b = word_of_int (1 OR neg_numeral b)"
116.175 + "1 OR - numeral b = word_of_int (1 OR - numeral b)"
116.176 "numeral a OR 1 = word_of_int (numeral a OR 1)"
116.177 - "neg_numeral a OR 1 = word_of_int (neg_numeral a OR 1)"
116.178 + "- numeral a OR 1 = word_of_int (- numeral a OR 1)"
116.179 "1 XOR numeral b = word_of_int (1 XOR numeral b)"
116.180 - "1 XOR neg_numeral b = word_of_int (1 XOR neg_numeral b)"
116.181 + "1 XOR - numeral b = word_of_int (1 XOR - numeral b)"
116.182 "numeral a XOR 1 = word_of_int (numeral a XOR 1)"
116.183 - "neg_numeral a XOR 1 = word_of_int (neg_numeral a XOR 1)"
116.184 + "- numeral a XOR 1 = word_of_int (- numeral a XOR 1)"
116.185 by (transfer, simp)+
116.186
116.187 lemma uint_or: "uint (x OR y) = (uint x) OR (uint y)"
116.188 @@ -2220,8 +2220,8 @@
116.189 by transfer (rule refl)
116.190
116.191 lemma test_bit_neg_numeral [simp]:
116.192 - "(neg_numeral w :: 'a::len0 word) !! n \<longleftrightarrow>
116.193 - n < len_of TYPE('a) \<and> bin_nth (neg_numeral w) n"
116.194 + "(- numeral w :: 'a::len0 word) !! n \<longleftrightarrow>
116.195 + n < len_of TYPE('a) \<and> bin_nth (- numeral w) n"
116.196 by transfer (rule refl)
116.197
116.198 lemma test_bit_1 [simp]: "(1::'a::len word) !! n \<longleftrightarrow> n = 0"
116.199 @@ -2398,7 +2398,7 @@
116.200 unfolding word_numeral_alt by (rule msb_word_of_int)
116.201
116.202 lemma word_msb_neg_numeral [simp]:
116.203 - "msb (neg_numeral w::'a::len word) = bin_nth (neg_numeral w) (len_of TYPE('a) - 1)"
116.204 + "msb (- numeral w::'a::len word) = bin_nth (- numeral w) (len_of TYPE('a) - 1)"
116.205 unfolding word_neg_numeral_alt by (rule msb_word_of_int)
116.206
116.207 lemma word_msb_0 [simp]: "\<not> msb (0::'a::len word)"
116.208 @@ -2528,7 +2528,7 @@
116.209 unfolding word_lsb_alt test_bit_numeral by simp
116.210
116.211 lemma word_lsb_neg_numeral [simp]:
116.212 - "lsb (neg_numeral bin :: 'a :: len word) = (bin_last (neg_numeral bin) = 1)"
116.213 + "lsb (- numeral bin :: 'a :: len word) = (bin_last (- numeral bin) = 1)"
116.214 unfolding word_lsb_alt test_bit_neg_numeral by simp
116.215
116.216 lemma set_bit_word_of_int:
116.217 @@ -2544,8 +2544,8 @@
116.218 unfolding word_numeral_alt by (rule set_bit_word_of_int)
116.219
116.220 lemma word_set_neg_numeral [simp]:
116.221 - "set_bit (neg_numeral bin::'a::len0 word) n b =
116.222 - word_of_int (bin_sc n (if b then 1 else 0) (neg_numeral bin))"
116.223 + "set_bit (- numeral bin::'a::len0 word) n b =
116.224 + word_of_int (bin_sc n (if b then 1 else 0) (- numeral bin))"
116.225 unfolding word_neg_numeral_alt by (rule set_bit_word_of_int)
116.226
116.227 lemma word_set_bit_0 [simp]:
116.228 @@ -2612,8 +2612,14 @@
116.229 apply clarsimp
116.230 apply clarsimp
116.231 apply (drule word_gt_0 [THEN iffD1])
116.232 - apply (safe intro!: word_eqI bin_nth_lem)
116.233 - apply (auto simp add: test_bit_2p nth_2p_bin word_test_bit_def [symmetric])
116.234 + apply (safe intro!: word_eqI)
116.235 + apply (auto simp add: nth_2p_bin)
116.236 + apply (erule notE)
116.237 + apply (simp (no_asm_use) add: uint_word_of_int word_size)
116.238 + apply (subst mod_pos_pos_trivial)
116.239 + apply simp
116.240 + apply (rule power_strict_increasing)
116.241 + apply simp_all
116.242 done
116.243
116.244 lemma word_of_int_2p: "(word_of_int (2 ^ n) :: 'a :: len word) = 2 ^ n"
116.245 @@ -2670,7 +2676,7 @@
116.246 unfolding word_numeral_alt shiftl1_wi by simp
116.247
116.248 lemma shiftl1_neg_numeral [simp]:
116.249 - "shiftl1 (neg_numeral w) = neg_numeral (Num.Bit0 w)"
116.250 + "shiftl1 (- numeral w) = - numeral (Num.Bit0 w)"
116.251 unfolding word_neg_numeral_alt shiftl1_wi by simp
116.252
116.253 lemma shiftl1_0 [simp] : "shiftl1 0 = 0"
116.254 @@ -4638,9 +4644,6 @@
116.255 "1 + n \<noteq> (0::'a::len word) \<Longrightarrow> unat (1 + n) = Suc (unat n)"
116.256 by unat_arith
116.257
116.258 -lemma word_no_1 [simp]: "(Numeral1::'a::len0 word) = 1"
116.259 - by (fact word_1_no [symmetric])
116.260 -
116.261 declare bin_to_bl_def [simp]
116.262
116.263 ML_file "Tools/word_lib.ML"
117.1 --- a/src/HOL/Word/WordBitwise.thy Mon Nov 18 17:15:01 2013 +0100
117.2 +++ b/src/HOL/Word/WordBitwise.thy Tue Nov 19 17:07:52 2013 +0100
117.3 @@ -461,18 +461,18 @@
117.4 = True # rev (bin_to_bl n (numeral nm))"
117.5 "rev (bin_to_bl (Suc n) (numeral (num.One)))
117.6 = True # replicate n False"
117.7 - "rev (bin_to_bl (Suc n) (neg_numeral (num.Bit0 nm)))
117.8 - = False # rev (bin_to_bl n (neg_numeral nm))"
117.9 - "rev (bin_to_bl (Suc n) (neg_numeral (num.Bit1 nm)))
117.10 - = True # rev (bin_to_bl n (neg_numeral (nm + num.One)))"
117.11 - "rev (bin_to_bl (Suc n) (neg_numeral (num.One)))
117.12 + "rev (bin_to_bl (Suc n) (- numeral (num.Bit0 nm)))
117.13 + = False # rev (bin_to_bl n (- numeral nm))"
117.14 + "rev (bin_to_bl (Suc n) (- numeral (num.Bit1 nm)))
117.15 + = True # rev (bin_to_bl n (- numeral (nm + num.One)))"
117.16 + "rev (bin_to_bl (Suc n) (- numeral (num.One)))
117.17 = True # replicate n True"
117.18 - "rev (bin_to_bl (Suc n) (neg_numeral (num.Bit0 nm + num.One)))
117.19 - = True # rev (bin_to_bl n (neg_numeral (nm + num.One)))"
117.20 - "rev (bin_to_bl (Suc n) (neg_numeral (num.Bit1 nm + num.One)))
117.21 - = False # rev (bin_to_bl n (neg_numeral (nm + num.One)))"
117.22 - "rev (bin_to_bl (Suc n) (neg_numeral (num.One + num.One)))
117.23 - = False # rev (bin_to_bl n (neg_numeral num.One))"
117.24 + "rev (bin_to_bl (Suc n) (- numeral (num.Bit0 nm + num.One)))
117.25 + = True # rev (bin_to_bl n (- numeral (nm + num.One)))"
117.26 + "rev (bin_to_bl (Suc n) (- numeral (num.Bit1 nm + num.One)))
117.27 + = False # rev (bin_to_bl n (- numeral (nm + num.One)))"
117.28 + "rev (bin_to_bl (Suc n) (- numeral (num.One + num.One)))
117.29 + = False # rev (bin_to_bl n (- numeral num.One))"
117.30 apply (simp_all add: bin_to_bl_def)
117.31 apply (simp_all only: bin_to_bl_aux_alt)
117.32 apply (simp_all)