18 (* ********************************************************************** *) |
18 (* ********************************************************************** *) |
19 |
19 |
20 |
20 |
21 (* j=|A| *) |
21 (* j=|A| *) |
22 lemma lepoll_imp_ex_le_eqpoll: |
22 lemma lepoll_imp_ex_le_eqpoll: |
23 "[| A \<lesssim> i; Ord(i) |] ==> \<exists>j. j le i & A \<approx> j" |
23 "[| A \<lesssim> i; Ord(i) |] ==> \<exists>j. j \<le> i & A \<approx> j" |
24 by (blast intro!: lepoll_cardinal_le well_ord_Memrel |
24 by (blast intro!: lepoll_cardinal_le well_ord_Memrel |
25 well_ord_cardinal_eqpoll [THEN eqpoll_sym] |
25 well_ord_cardinal_eqpoll [THEN eqpoll_sym] |
26 dest: lepoll_well_ord) |
26 dest: lepoll_well_ord) |
27 |
27 |
28 (* j=|A| *) |
28 (* j=|A| *) |
29 lemma lesspoll_imp_ex_lt_eqpoll: |
29 lemma lesspoll_imp_ex_lt_eqpoll: |
30 "[| A \<prec> i; Ord(i) |] ==> \<exists>j. j<i & A \<approx> j" |
30 "[| A \<prec> i; Ord(i) |] ==> \<exists>j. j<i & A \<approx> j" |
31 by (unfold lesspoll_def, blast dest!: lepoll_imp_ex_le_eqpoll elim!: leE) |
31 by (unfold lesspoll_def, blast dest!: lepoll_imp_ex_le_eqpoll elim!: leE) |
32 |
32 |
33 lemma Inf_Ord_imp_InfCard_cardinal: "[| ~Finite(i); Ord(i) |] ==> InfCard(|i|)" |
33 lemma Inf_Ord_imp_InfCard_cardinal: "[| ~Finite(i); Ord(i) |] ==> InfCard(|i|)" |
34 apply (unfold InfCard_def) |
34 apply (unfold InfCard_def) |
35 apply (rule conjI) |
35 apply (rule conjI) |
36 apply (rule Card_cardinal) |
36 apply (rule Card_cardinal) |
37 apply (rule Card_nat |
37 apply (rule Card_nat |
38 [THEN Card_def [THEN def_imp_iff, THEN iffD1, THEN ssubst]]) |
38 [THEN Card_def [THEN def_imp_iff, THEN iffD1, THEN ssubst]]) |
39 -- "rewriting would loop!" |
39 -- "rewriting would loop!" |
40 apply (rule well_ord_Memrel [THEN well_ord_lepoll_imp_Card_le], assumption) |
40 apply (rule well_ord_Memrel [THEN well_ord_lepoll_imp_Card_le], assumption) |
41 apply (rule nat_le_infinite_Ord [THEN le_imp_lepoll], assumption+) |
41 apply (rule nat_le_infinite_Ord [THEN le_imp_lepoll], assumption+) |
42 done |
42 done |
43 |
43 |
44 text{*An alternative and more general proof goes like this: A and B are both |
44 text{*An alternative and more general proof goes like this: A and B are both |
45 well-ordered (because they are injected into an ordinal), either A lepoll B |
45 well-ordered (because they are injected into an ordinal), either @{term"A \<lesssim> B"} |
46 or B lepoll A. Also both are equipollent to their cardinalities, so |
46 or @{term"B \<lesssim> A"}. Also both are equipollent to their cardinalities, so |
47 (if A and B are infinite) then A Un B lepoll |A|+|B| = max(|A|,|B|) lepoll i. |
47 (if A and B are infinite) then @{term"A \<union> B \<lesssim> |A\<oplus>B| \<longleftrightarrow> max(|A|,|B|) \<lesssim> i"}. |
48 In fact, the correctly strengthened version of this theorem appears below.*} |
48 In fact, the correctly strengthened version of this theorem appears below.*} |
49 lemma Un_lepoll_Inf_Ord_weak: |
49 lemma Un_lepoll_Inf_Ord_weak: |
50 "[|A \<approx> i; B \<approx> i; \<not> Finite(i); Ord(i)|] ==> A \<union> B \<lesssim> i" |
50 "[|A \<approx> i; B \<approx> i; \<not> Finite(i); Ord(i)|] ==> A \<union> B \<lesssim> i" |
51 apply (rule Un_lepoll_sum [THEN lepoll_trans]) |
51 apply (rule Un_lepoll_sum [THEN lepoll_trans]) |
52 apply (rule lepoll_imp_sum_lepoll_prod [THEN lepoll_trans]) |
52 apply (rule lepoll_imp_sum_lepoll_prod [THEN lepoll_trans]) |
53 apply (erule eqpoll_trans [THEN eqpoll_imp_lepoll]) |
53 apply (erule eqpoll_trans [THEN eqpoll_imp_lepoll]) |
54 apply (erule eqpoll_sym) |
54 apply (erule eqpoll_sym) |
55 apply (rule subset_imp_lepoll [THEN lepoll_trans, THEN lepoll_trans]) |
55 apply (rule subset_imp_lepoll [THEN lepoll_trans, THEN lepoll_trans]) |
56 apply (rule nat_2I [THEN OrdmemD], rule Ord_nat) |
56 apply (rule nat_2I [THEN OrdmemD], rule Ord_nat) |
57 apply (rule nat_le_infinite_Ord [THEN le_imp_lepoll], assumption+) |
57 apply (rule nat_le_infinite_Ord [THEN le_imp_lepoll], assumption+) |
58 apply (erule eqpoll_sym [THEN eqpoll_imp_lepoll]) |
58 apply (erule eqpoll_sym [THEN eqpoll_imp_lepoll]) |
59 apply (erule prod_eqpoll_cong [THEN eqpoll_imp_lepoll, THEN lepoll_trans], |
59 apply (erule prod_eqpoll_cong [THEN eqpoll_imp_lepoll, THEN lepoll_trans], |
60 assumption) |
60 assumption) |
61 apply (rule eqpoll_imp_lepoll) |
61 apply (rule eqpoll_imp_lepoll) |
62 apply (rule well_ord_Memrel [THEN well_ord_InfCard_square_eq], assumption) |
62 apply (rule well_ord_Memrel [THEN well_ord_InfCard_square_eq], assumption) |
63 apply (rule Inf_Ord_imp_InfCard_cardinal, assumption+) |
63 apply (rule Inf_Ord_imp_InfCard_cardinal, assumption+) |
64 done |
64 done |
65 |
65 |
66 lemma Un_eqpoll_Inf_Ord: |
66 lemma Un_eqpoll_Inf_Ord: |
67 "[| A \<approx> i; B \<approx> i; ~Finite(i); Ord(i) |] ==> A Un B \<approx> i" |
67 "[| A \<approx> i; B \<approx> i; ~Finite(i); Ord(i) |] ==> A \<union> B \<approx> i" |
68 apply (rule eqpollI) |
68 apply (rule eqpollI) |
69 apply (blast intro: Un_lepoll_Inf_Ord_weak) |
69 apply (blast intro: Un_lepoll_Inf_Ord_weak) |
70 apply (erule eqpoll_sym [THEN eqpoll_imp_lepoll, THEN lepoll_trans]) |
70 apply (erule eqpoll_sym [THEN eqpoll_imp_lepoll, THEN lepoll_trans]) |
71 apply (rule Un_upper1 [THEN subset_imp_lepoll]) |
71 apply (rule Un_upper1 [THEN subset_imp_lepoll]) |
72 done |
72 done |
73 |
73 |
74 schematic_lemma paired_bij: "?f \<in> bij({{y,z}. y \<in> x}, x)" |
74 schematic_lemma paired_bij: "?f \<in> bij({{y,z}. y \<in> x}, x)" |
75 apply (rule RepFun_bijective) |
75 apply (rule RepFun_bijective) |
76 apply (simp add: doubleton_eq_iff, blast) |
76 apply (simp add: doubleton_eq_iff, blast) |
77 done |
77 done |
78 |
78 |
79 lemma paired_eqpoll: "{{y,z}. y \<in> x} \<approx> x" |
79 lemma paired_eqpoll: "{{y,z}. y \<in> x} \<approx> x" |
80 by (unfold eqpoll_def, fast intro!: paired_bij) |
80 by (unfold eqpoll_def, fast intro!: paired_bij) |
81 |
81 |
82 lemma ex_eqpoll_disjoint: "\<exists>B. B \<approx> A & B Int C = 0" |
82 lemma ex_eqpoll_disjoint: "\<exists>B. B \<approx> A & B \<inter> C = 0" |
83 by (fast intro!: paired_eqpoll equals0I elim: mem_asym) |
83 by (fast intro!: paired_eqpoll equals0I elim: mem_asym) |
84 |
84 |
85 (*Finally we reach this result. Surely there's a simpler proof, as sketched |
85 (*Finally we reach this result. Surely there's a simpler proof, as sketched |
86 above?*) |
86 above?*) |
87 lemma Un_lepoll_Inf_Ord: |
87 lemma Un_lepoll_Inf_Ord: |
88 "[| A \<lesssim> i; B \<lesssim> i; ~Finite(i); Ord(i) |] ==> A Un B \<lesssim> i" |
88 "[| A \<lesssim> i; B \<lesssim> i; ~Finite(i); Ord(i) |] ==> A \<union> B \<lesssim> i" |
89 apply (rule_tac A1 = i and C1 = i in ex_eqpoll_disjoint [THEN exE]) |
89 apply (rule_tac A1 = i and C1 = i in ex_eqpoll_disjoint [THEN exE]) |
90 apply (erule conjE) |
90 apply (erule conjE) |
91 apply (drule lepoll_trans) |
91 apply (drule lepoll_trans) |
92 apply (erule eqpoll_sym [THEN eqpoll_imp_lepoll]) |
92 apply (erule eqpoll_sym [THEN eqpoll_imp_lepoll]) |
93 apply (rule Un_lepoll_Un [THEN lepoll_trans], (assumption+)) |
93 apply (rule Un_lepoll_Un [THEN lepoll_trans], (assumption+)) |
94 apply (blast intro: eqpoll_refl Un_eqpoll_Inf_Ord eqpoll_imp_lepoll) |
94 apply (blast intro: eqpoll_refl Un_eqpoll_Inf_Ord eqpoll_imp_lepoll) |
95 done |
95 done |
96 |
96 |
97 lemma Least_in_Ord: "[| P(i); i \<in> j; Ord(j) |] ==> (LEAST i. P(i)) \<in> j" |
97 lemma Least_in_Ord: "[| P(i); i \<in> j; Ord(j) |] ==> (LEAST i. P(i)) \<in> j" |
98 apply (erule Least_le [THEN leE]) |
98 apply (erule Least_le [THEN leE]) |
99 apply (erule Ord_in_Ord, assumption) |
99 apply (erule Ord_in_Ord, assumption) |
120 apply (fast intro!: Least_in_Ord) |
120 apply (fast intro!: Least_in_Ord) |
121 apply (fast intro: LeastI elim!: Ord_in_Ord) |
121 apply (fast intro: LeastI elim!: Ord_in_Ord) |
122 done |
122 done |
123 |
123 |
124 lemma UN_fun_lepoll_lemma [rule_format]: |
124 lemma UN_fun_lepoll_lemma [rule_format]: |
125 "[| well_ord(T, R); ~Finite(a); Ord(a); n \<in> nat |] |
125 "[| well_ord(T, R); ~Finite(a); Ord(a); n \<in> nat |] |
126 ==> \<forall>f. (\<forall>b \<in> a. f`b \<lesssim> n & f`b \<subseteq> T) --> (\<Union>b \<in> a. f`b) \<lesssim> a" |
126 ==> \<forall>f. (\<forall>b \<in> a. f`b \<lesssim> n & f`b \<subseteq> T) \<longrightarrow> (\<Union>b \<in> a. f`b) \<lesssim> a" |
127 apply (induct_tac "n") |
127 apply (induct_tac "n") |
128 apply (rule allI) |
128 apply (rule allI) |
129 apply (rule impI) |
129 apply (rule impI) |
130 apply (rule_tac b = "\<Union>b \<in> a. f`b" in subst) |
130 apply (rule_tac b = "\<Union>b \<in> a. f`b" in subst) |
131 apply (rule_tac [2] empty_lepollI) |
131 apply (rule_tac [2] empty_lepollI) |
132 apply (rule equals0I [symmetric], clarify) |
132 apply (rule equals0I [symmetric], clarify) |
133 apply (fast dest: lepoll_0_is_0 [THEN subst]) |
133 apply (fast dest: lepoll_0_is_0 [THEN subst]) |
134 apply (rule allI) |
134 apply (rule allI) |
135 apply (rule impI) |
135 apply (rule impI) |
136 apply (erule_tac x = "\<lambda>x \<in> a. f`x - {THE b. first (b,f`x,R) }" in allE) |
136 apply (erule_tac x = "\<lambda>x \<in> a. f`x - {THE b. first (b,f`x,R) }" in allE) |
137 apply (erule impE, simp) |
137 apply (erule impE, simp) |
138 apply (fast intro!: Diff_first_lepoll, simp) |
138 apply (fast intro!: Diff_first_lepoll, simp) |
139 apply (rule UN_subset_split [THEN subset_imp_lepoll, THEN lepoll_trans]) |
139 apply (rule UN_subset_split [THEN subset_imp_lepoll, THEN lepoll_trans]) |
140 apply (fast intro: Un_lepoll_Inf_Ord UN_sing_lepoll) |
140 apply (fast intro: Un_lepoll_Inf_Ord UN_sing_lepoll) |
141 done |
141 done |
142 |
142 |
143 lemma UN_fun_lepoll: |
143 lemma UN_fun_lepoll: |
144 "[| \<forall>b \<in> a. f`b \<lesssim> n & f`b \<subseteq> T; well_ord(T, R); |
144 "[| \<forall>b \<in> a. f`b \<lesssim> n & f`b \<subseteq> T; well_ord(T, R); |
145 ~Finite(a); Ord(a); n \<in> nat |] ==> (\<Union>b \<in> a. f`b) \<lesssim> a" |
145 ~Finite(a); Ord(a); n \<in> nat |] ==> (\<Union>b \<in> a. f`b) \<lesssim> a" |
146 by (blast intro: UN_fun_lepoll_lemma) |
146 by (blast intro: UN_fun_lepoll_lemma) |
147 |
147 |
148 lemma UN_lepoll: |
148 lemma UN_lepoll: |
149 "[| \<forall>b \<in> a. F(b) \<lesssim> n & F(b) \<subseteq> T; well_ord(T, R); |
149 "[| \<forall>b \<in> a. F(b) \<lesssim> n & F(b) \<subseteq> T; well_ord(T, R); |
150 ~Finite(a); Ord(a); n \<in> nat |] |
150 ~Finite(a); Ord(a); n \<in> nat |] |
151 ==> (\<Union>b \<in> a. F(b)) \<lesssim> a" |
151 ==> (\<Union>b \<in> a. F(b)) \<lesssim> a" |
152 apply (rule rev_mp) |
152 apply (rule rev_mp) |
153 apply (rule_tac f="\<lambda>b \<in> a. F (b)" in UN_fun_lepoll) |
153 apply (rule_tac f="\<lambda>b \<in> a. F (b)" in UN_fun_lepoll) |
154 apply auto |
154 apply auto |
155 done |
155 done |
156 |
156 |
157 lemma UN_eq_UN_Diffs: |
157 lemma UN_eq_UN_Diffs: |
182 "[| A\<approx>a; ~Finite(a); Card(a); B \<prec> a; A-B \<prec> a |] ==> P" |
182 "[| A\<approx>a; ~Finite(a); Card(a); B \<prec> a; A-B \<prec> a |] ==> P" |
183 apply (elim lesspoll_imp_ex_lt_eqpoll [THEN exE] Card_is_Ord conjE) |
183 apply (elim lesspoll_imp_ex_lt_eqpoll [THEN exE] Card_is_Ord conjE) |
184 apply (frule_tac j=xa in Un_upper1_le [OF lt_Ord lt_Ord], assumption) |
184 apply (frule_tac j=xa in Un_upper1_le [OF lt_Ord lt_Ord], assumption) |
185 apply (frule_tac j=xa in Un_upper2_le [OF lt_Ord lt_Ord], assumption) |
185 apply (frule_tac j=xa in Un_upper2_le [OF lt_Ord lt_Ord], assumption) |
186 apply (drule Un_least_lt, assumption) |
186 apply (drule Un_least_lt, assumption) |
187 apply (drule eqpoll_imp_lepoll [THEN lepoll_trans], |
187 apply (drule eqpoll_imp_lepoll [THEN lepoll_trans], |
188 rule le_imp_lepoll, assumption)+ |
188 rule le_imp_lepoll, assumption)+ |
189 apply (case_tac "Finite(x Un xa)") |
189 apply (case_tac "Finite(x \<union> xa)") |
190 txt{*finite case*} |
190 txt{*finite case*} |
191 apply (drule Finite_Un [OF lepoll_Finite lepoll_Finite], assumption+) |
191 apply (drule Finite_Un [OF lepoll_Finite lepoll_Finite], assumption+) |
192 apply (drule subset_Un_Diff [THEN subset_imp_lepoll, THEN lepoll_Finite]) |
192 apply (drule subset_Un_Diff [THEN subset_imp_lepoll, THEN lepoll_Finite]) |
193 apply (fast dest: eqpoll_sym [THEN eqpoll_imp_lepoll, THEN lepoll_Finite]) |
193 apply (fast dest: eqpoll_sym [THEN eqpoll_imp_lepoll, THEN lepoll_Finite]) |
194 txt{*infinite case*} |
194 txt{*infinite case*} |
195 apply (drule Un_lepoll_Inf_Ord, (assumption+)) |
195 apply (drule Un_lepoll_Inf_Ord, (assumption+)) |
196 apply (blast intro: le_Ord2) |
196 apply (blast intro: le_Ord2) |
197 apply (drule lesspoll_trans1 |
197 apply (drule lesspoll_trans1 |
198 [OF subset_Un_Diff [THEN subset_imp_lepoll, THEN lepoll_trans] |
198 [OF subset_Un_Diff [THEN subset_imp_lepoll, THEN lepoll_trans] |
199 lt_Card_imp_lesspoll], assumption+) |
199 lt_Card_imp_lesspoll], assumption+) |
200 apply (simp add: lesspoll_def) |
200 apply (simp add: lesspoll_def) |
201 done |
201 done |
202 |
202 |
203 lemma Diff_lesspoll_eqpoll_Card: |
203 lemma Diff_lesspoll_eqpoll_Card: |
204 "[| A \<approx> a; ~Finite(a); Card(a); B \<prec> a |] ==> A - B \<approx> a" |
204 "[| A \<approx> a; ~Finite(a); Card(a); B \<prec> a |] ==> A - B \<approx> a" |
205 apply (rule ccontr) |
205 apply (rule ccontr) |
206 apply (rule Diff_lesspoll_eqpoll_Card_lemma, (assumption+)) |
206 apply (rule Diff_lesspoll_eqpoll_Card_lemma, (assumption+)) |
207 apply (blast intro: lesspoll_def [THEN def_imp_iff, THEN iffD2] |
207 apply (blast intro: lesspoll_def [THEN def_imp_iff, THEN iffD2] |
208 subset_imp_lepoll eqpoll_imp_lepoll lepoll_trans) |
208 subset_imp_lepoll eqpoll_imp_lepoll lepoll_trans) |
209 done |
209 done |
210 |
210 |
211 end |
211 end |