1 (* Title: ZF/AC/WO6_WO1.thy |
1 (* Title: ZF/AC/WO6_WO1.thy |
2 ID: $Id$ |
2 ID: $Id$ |
3 Author: Krzysztof Grabczewski |
3 Author: Krzysztof Grabczewski |
4 |
4 |
5 The proof of "WO6 ==> WO1". |
5 Proofs needed to state that formulations WO1,...,WO6 are all equivalent. |
6 |
6 The only hard one is WO6 ==> WO1. |
7 From the book "Equivalents of the Axiom of Choice" by Rubin & Rubin, |
7 |
8 pages 2-5 |
8 Every proof (except WO6 ==> WO1 and WO1 ==> WO2) are described as "clear" |
|
9 by Rubin & Rubin (page 2). |
|
10 They refer reader to a book by Gödel to see the proof WO1 ==> WO2. |
|
11 Fortunately order types made this proof also very easy. |
9 *) |
12 *) |
10 |
13 |
11 WO6_WO1 = "rel_is_fun" + AC_Equiv + Let + |
14 theory WO6_WO1 = Cardinal_aux: |
12 |
15 |
13 consts |
16 constdefs |
14 (* Auxiliary definitions used in proof *) |
17 (* Auxiliary definitions used in proof *) |
15 NN :: i => i |
18 NN :: "i => i" |
16 uu :: [i, i, i, i] => i |
19 "NN(y) == {m \<in> nat. \<exists>a. \<exists>f. Ord(a) & domain(f)=a & |
17 vv1, ww1, gg1 :: [i, i, i] => i |
20 (\<Union>b<a. f`b) = y & (\<forall>b<a. f`b \<lesssim> m)}" |
18 vv2, ww2, gg2 :: [i, i, i, i] => i |
|
19 |
|
20 defs |
|
21 |
|
22 NN_def "NN(y) == {m \\<in> nat. \\<exists>a. \\<exists>f. Ord(a) & domain(f)=a & |
|
23 (\\<Union>b<a. f`b) = y & (\\<forall>b<a. f`b lepoll m)}" |
|
24 |
|
25 uu_def "uu(f, beta, gamma, delta) == (f`beta * f`gamma) Int f`delta" |
|
26 |
|
27 (*Definitions for case 1*) |
|
28 |
|
29 vv1_def "vv1(f,m,b) == |
|
30 let g = LEAST g. (\\<exists>d. Ord(d) & (domain(uu(f,b,g,d)) \\<noteq> 0 & |
|
31 domain(uu(f,b,g,d)) lepoll m)); |
|
32 d = LEAST d. domain(uu(f,b,g,d)) \\<noteq> 0 & |
|
33 domain(uu(f,b,g,d)) lepoll m |
|
34 in if f`b \\<noteq> 0 then domain(uu(f,b,g,d)) else 0" |
|
35 |
|
36 ww1_def "ww1(f,m,b) == f`b - vv1(f,m,b)" |
|
37 |
|
38 gg1_def "gg1(f,a,m) == \\<lambda>b \\<in> a++a. if b<a then vv1(f,m,b) else ww1(f,m,b--a)" |
|
39 |
21 |
40 (*Definitions for case 2*) |
22 uu :: "[i, i, i, i] => i" |
41 |
23 "uu(f, beta, gamma, delta) == (f`beta * f`gamma) Int f`delta" |
42 vv2_def "vv2(f,b,g,s) == |
24 |
43 if f`g \\<noteq> 0 then {uu(f, b, g, LEAST d. uu(f,b,g,d) \\<noteq> 0)`s} else 0" |
25 (** Definitions for case 1 **) |
44 |
26 vv1 :: "[i, i, i] => i" |
45 ww2_def "ww2(f,b,g,s) == f`g - vv2(f,b,g,s)" |
27 "vv1(f,m,b) == |
46 |
28 let g = LEAST g. (\<exists>d. Ord(d) & (domain(uu(f,b,g,d)) \<noteq> 0 & |
47 gg2_def "gg2(f,a,b,s) == |
29 domain(uu(f,b,g,d)) \<lesssim> m)); |
48 \\<lambda>g \\<in> a++a. if g<a then vv2(f,b,g,s) else ww2(f,b,g--a,s)" |
30 d = LEAST d. domain(uu(f,b,g,d)) \<noteq> 0 & |
49 |
31 domain(uu(f,b,g,d)) \<lesssim> m |
|
32 in if f`b \<noteq> 0 then domain(uu(f,b,g,d)) else 0" |
|
33 |
|
34 ww1 :: "[i, i, i] => i" |
|
35 "ww1(f,m,b) == f`b - vv1(f,m,b)" |
|
36 |
|
37 gg1 :: "[i, i, i] => i" |
|
38 "gg1(f,a,m) == \<lambda>b \<in> a++a. if b<a then vv1(f,m,b) else ww1(f,m,b--a)" |
|
39 |
|
40 (** Definitions for case 2 **) |
|
41 vv2 :: "[i, i, i, i] => i" |
|
42 "vv2(f,b,g,s) == |
|
43 if f`g \<noteq> 0 then {uu(f, b, g, LEAST d. uu(f,b,g,d) \<noteq> 0)`s} else 0" |
|
44 |
|
45 ww2 :: "[i, i, i, i] => i" |
|
46 "ww2(f,b,g,s) == f`g - vv2(f,b,g,s)" |
|
47 |
|
48 gg2 :: "[i, i, i, i] => i" |
|
49 "gg2(f,a,b,s) == |
|
50 \<lambda>g \<in> a++a. if g<a then vv2(f,b,g,s) else ww2(f,b,g--a,s)" |
|
51 |
|
52 |
|
53 lemma WO2_WO3: "WO2 ==> WO3" |
|
54 by (unfold WO2_def WO3_def, fast) |
|
55 |
|
56 (* ********************************************************************** *) |
|
57 |
|
58 lemma WO3_WO1: "WO3 ==> WO1" |
|
59 apply (unfold eqpoll_def WO1_def WO3_def) |
|
60 apply (intro allI) |
|
61 apply (drule_tac x=A in spec) |
|
62 apply (blast intro: bij_is_inj well_ord_rvimage |
|
63 well_ord_Memrel [THEN well_ord_subset]) |
|
64 done |
|
65 |
|
66 (* ********************************************************************** *) |
|
67 |
|
68 lemma WO1_WO2: "WO1 ==> WO2" |
|
69 apply (unfold eqpoll_def WO1_def WO2_def) |
|
70 apply (blast intro!: Ord_ordertype ordermap_bij) |
|
71 done |
|
72 |
|
73 (* ********************************************************************** *) |
|
74 |
|
75 lemma lam_sets: "f \<in> A->B ==> (\<lambda>x \<in> A. {f`x}): A -> {{b}. b \<in> B}" |
|
76 by (fast intro!: lam_type apply_type) |
|
77 |
|
78 lemma surj_imp_eq_: "f \<in> surj(A,B) ==> (\<Union>a \<in> A. {f`a}) = B" |
|
79 apply (unfold surj_def) |
|
80 apply (fast elim!: apply_type) |
|
81 done |
|
82 |
|
83 lemma surj_imp_eq: "[| f \<in> surj(A,B); Ord(A) |] ==> (\<Union>a<A. {f`a}) = B" |
|
84 by (fast dest!: surj_imp_eq_ intro!: ltI elim!: ltE) |
|
85 |
|
86 lemma WO1_WO4: "WO1 ==> WO4(1)" |
|
87 apply (unfold WO1_def WO4_def) |
|
88 apply (rule allI) |
|
89 apply (erule_tac x = "A" in allE) |
|
90 apply (erule exE) |
|
91 apply (intro exI conjI) |
|
92 apply (erule Ord_ordertype) |
|
93 apply (erule ordermap_bij [THEN bij_converse_bij, THEN bij_is_fun, THEN lam_sets, THEN domain_of_fun]) |
|
94 apply (simp_all add: singleton_eqpoll_1 eqpoll_imp_lepoll Ord_ordertype |
|
95 ordermap_bij [THEN bij_converse_bij, THEN bij_is_surj, THEN surj_imp_eq]) |
|
96 done |
|
97 |
|
98 (* ********************************************************************** *) |
|
99 |
|
100 lemma WO4_mono: "[| m\<le>n; WO4(m) |] ==> WO4(n)" |
|
101 apply (unfold WO4_def) |
|
102 apply (blast dest!: spec intro: lepoll_trans [OF _ le_imp_lepoll]) |
|
103 done |
|
104 |
|
105 (* ********************************************************************** *) |
|
106 |
|
107 lemma WO4_WO5: "[| m \<in> nat; 1\<le>m; WO4(m) |] ==> WO5" |
|
108 by (unfold WO4_def WO5_def, blast) |
|
109 |
|
110 (* ********************************************************************** *) |
|
111 |
|
112 lemma WO5_WO6: "WO5 ==> WO6" |
|
113 by (unfold WO4_def WO5_def WO6_def, blast) |
|
114 |
|
115 |
|
116 (* ********************************************************************** |
|
117 The proof of "WO6 ==> WO1". Simplified by L C Paulson. |
|
118 |
|
119 From the book "Equivalents of the Axiom of Choice" by Rubin & Rubin, |
|
120 pages 2-5 |
|
121 ************************************************************************* *) |
|
122 |
|
123 lemma lt_oadd_odiff_disj: |
|
124 "[| k < i++j; Ord(i); Ord(j) |] |
|
125 ==> k < i | (~ k<i & k = i ++ (k--i) & (k--i)<j)" |
|
126 apply (rule_tac i = "k" and j = "i" in Ord_linear2) |
|
127 prefer 4 |
|
128 apply (drule odiff_lt_mono2, assumption) |
|
129 apply (simp add: oadd_odiff_inverse odiff_oadd_inverse) |
|
130 apply (auto elim!: lt_Ord) |
|
131 done |
|
132 |
|
133 |
|
134 (* ********************************************************************** *) |
|
135 (* The most complicated part of the proof - lemma ii - p. 2-4 *) |
|
136 (* ********************************************************************** *) |
|
137 |
|
138 (* ********************************************************************** *) |
|
139 (* some properties of relation uu(beta, gamma, delta) - p. 2 *) |
|
140 (* ********************************************************************** *) |
|
141 |
|
142 lemma domain_uu_subset: "domain(uu(f,b,g,d)) \<subseteq> f`b" |
|
143 by (unfold uu_def, blast) |
|
144 |
|
145 lemma quant_domain_uu_lepoll_m: |
|
146 "\<forall>b<a. f`b \<lesssim> m ==> \<forall>b<a. \<forall>g<a. \<forall>d<a. domain(uu(f,b,g,d)) \<lesssim> m" |
|
147 by (blast intro: domain_uu_subset [THEN subset_imp_lepoll] lepoll_trans) |
|
148 |
|
149 lemma uu_subset1: "uu(f,b,g,d) \<subseteq> f`b * f`g" |
|
150 by (unfold uu_def, blast) |
|
151 |
|
152 lemma uu_subset2: "uu(f,b,g,d) \<subseteq> f`d" |
|
153 by (unfold uu_def, blast) |
|
154 |
|
155 lemma uu_lepoll_m: "[| \<forall>b<a. f`b \<lesssim> m; d<a |] ==> uu(f,b,g,d) \<lesssim> m" |
|
156 by (blast intro: uu_subset2 [THEN subset_imp_lepoll] lepoll_trans) |
|
157 |
|
158 (* ********************************************************************** *) |
|
159 (* Two cases for lemma ii *) |
|
160 (* ********************************************************************** *) |
|
161 lemma cases: |
|
162 "\<forall>b<a. \<forall>g<a. \<forall>d<a. u(f,b,g,d) \<lesssim> m |
|
163 ==> (\<forall>b<a. f`b \<noteq> 0 --> |
|
164 (\<exists>g<a. \<exists>d<a. u(f,b,g,d) \<noteq> 0 & u(f,b,g,d) \<prec> m)) |
|
165 | (\<exists>b<a. f`b \<noteq> 0 & (\<forall>g<a. \<forall>d<a. u(f,b,g,d) \<noteq> 0 --> |
|
166 u(f,b,g,d) \<approx> m))" |
|
167 apply (unfold lesspoll_def) |
|
168 apply (blast del: equalityI) |
|
169 done |
|
170 |
|
171 (* ********************************************************************** *) |
|
172 (* Lemmas used in both cases *) |
|
173 (* ********************************************************************** *) |
|
174 lemma UN_oadd: "Ord(a) ==> (\<Union>b<a++a. C(b)) = (\<Union>b<a. C(b) Un C(a++b))" |
|
175 by (blast intro: ltI lt_oadd1 oadd_lt_mono2 dest!: lt_oadd_disj) |
|
176 |
|
177 |
|
178 (* ********************************************************************** *) |
|
179 (* Case 1: lemmas *) |
|
180 (* ********************************************************************** *) |
|
181 |
|
182 lemma vv1_subset: "vv1(f,m,b) \<subseteq> f`b" |
|
183 by (simp add: vv1_def Let_def domain_uu_subset) |
|
184 |
|
185 (* ********************************************************************** *) |
|
186 (* Case 1: Union of images is the whole "y" *) |
|
187 (* ********************************************************************** *) |
|
188 lemma UN_gg1_eq: |
|
189 "[| Ord(a); m \<in> nat |] ==> (\<Union>b<a++a. gg1(f,a,m)`b) = (\<Union>b<a. f`b)" |
|
190 by (simp add: gg1_def UN_oadd lt_oadd1 oadd_le_self [THEN le_imp_not_lt] |
|
191 lt_Ord odiff_oadd_inverse ltD vv1_subset [THEN Diff_partition] |
|
192 ww1_def) |
|
193 |
|
194 lemma domain_gg1: "domain(gg1(f,a,m)) = a++a" |
|
195 by (simp add: lam_funtype [THEN domain_of_fun] gg1_def) |
|
196 |
|
197 (* ********************************************************************** *) |
|
198 (* every value of defined function is less than or equipollent to m *) |
|
199 (* ********************************************************************** *) |
|
200 lemma nested_LeastI: |
|
201 "[| P(a, b); Ord(a); Ord(b); |
|
202 Least_a = (LEAST a. \<exists>x. Ord(x) & P(a, x)) |] |
|
203 ==> P(Least_a, LEAST b. P(Least_a, b))" |
|
204 apply (erule ssubst) |
|
205 apply (rule_tac Q = "%z. P (z, LEAST b. P (z, b))" in LeastI2) |
|
206 apply (fast elim!: LeastI)+ |
|
207 done |
|
208 |
|
209 lemmas nested_Least_instance = |
|
210 nested_LeastI [of "%g d. domain(uu(f,b,g,d)) \<noteq> 0 & |
|
211 domain(uu(f,b,g,d)) \<lesssim> m", |
|
212 standard] (*generalizes the Variables!*) |
|
213 |
|
214 lemma gg1_lepoll_m: |
|
215 "[| Ord(a); m \<in> nat; |
|
216 \<forall>b<a. f`b \<noteq>0 --> |
|
217 (\<exists>g<a. \<exists>d<a. domain(uu(f,b,g,d)) \<noteq> 0 & |
|
218 domain(uu(f,b,g,d)) \<lesssim> m); |
|
219 \<forall>b<a. f`b \<lesssim> succ(m); b<a++a |] |
|
220 ==> gg1(f,a,m)`b \<lesssim> m" |
|
221 apply (unfold gg1_def, simp) |
|
222 apply (safe dest!: lt_oadd_odiff_disj) |
|
223 (*Case b<a \<in> show vv1(f,m,b) \<lesssim> m *) |
|
224 apply (simp add: vv1_def Let_def) |
|
225 apply (fast intro: nested_Least_instance [THEN conjunct2] |
|
226 elim!: lt_Ord intro!: empty_lepollI) |
|
227 (*Case a\<le>b \<in> show ww1(f,m,b--a) \<lesssim> m *) |
|
228 apply (simp add: ww1_def) |
|
229 apply (case_tac "f` (b--a) = 0", simp add: empty_lepollI) |
|
230 apply (rule Diff_lepoll, blast) |
|
231 apply (rule vv1_subset) |
|
232 apply (drule ospec [THEN mp], assumption+) |
|
233 apply (elim oexE conjE) |
|
234 apply (simp add: vv1_def Let_def lt_Ord nested_Least_instance [THEN conjunct1]) |
|
235 done |
|
236 |
|
237 (* ********************************************************************** *) |
|
238 (* Case 2: lemmas *) |
|
239 (* ********************************************************************** *) |
|
240 |
|
241 (* ********************************************************************** *) |
|
242 (* Case 2: vv2_subset *) |
|
243 (* ********************************************************************** *) |
|
244 |
|
245 lemma ex_d_uu_not_empty: |
|
246 "[| b<a; g<a; f`b\<noteq>0; f`g\<noteq>0; |
|
247 y*y \<subseteq> y; (\<Union>b<a. f`b)=y |] |
|
248 ==> \<exists>d<a. uu(f,b,g,d) \<noteq> 0" |
|
249 by (unfold uu_def, blast) |
|
250 |
|
251 lemma uu_not_empty: |
|
252 "[| b<a; g<a; f`b\<noteq>0; f`g\<noteq>0; y*y \<subseteq> y; (\<Union>b<a. f`b)=y |] |
|
253 ==> uu(f,b,g,LEAST d. (uu(f,b,g,d) \<noteq> 0)) \<noteq> 0" |
|
254 apply (drule ex_d_uu_not_empty, assumption+) |
|
255 apply (fast elim!: LeastI lt_Ord) |
|
256 done |
|
257 |
|
258 lemma not_empty_rel_imp_domain: "[| r \<subseteq> A*B; r\<noteq>0 |] ==> domain(r)\<noteq>0" |
|
259 by blast |
|
260 |
|
261 lemma Least_uu_not_empty_lt_a: |
|
262 "[| b<a; g<a; f`b\<noteq>0; f`g\<noteq>0; y*y \<subseteq> y; (\<Union>b<a. f`b)=y |] |
|
263 ==> (LEAST d. uu(f,b,g,d) \<noteq> 0) < a" |
|
264 apply (erule ex_d_uu_not_empty [THEN oexE], assumption+) |
|
265 apply (blast intro: Least_le [THEN lt_trans1] lt_Ord) |
|
266 done |
|
267 |
|
268 lemma subset_Diff_sing: "[| B \<subseteq> A; a\<notin>B |] ==> B \<subseteq> A-{a}" |
|
269 by blast |
|
270 |
|
271 (*Could this be proved more directly?*) |
|
272 lemma supset_lepoll_imp_eq: |
|
273 "[| A \<lesssim> m; m \<lesssim> B; B \<subseteq> A; m \<in> nat |] ==> A=B" |
|
274 apply (erule natE) |
|
275 apply (fast dest!: lepoll_0_is_0 intro!: equalityI) |
|
276 apply (safe intro!: equalityI) |
|
277 apply (rule ccontr) |
|
278 apply (rule succ_lepoll_natE) |
|
279 apply (erule lepoll_trans) |
|
280 apply (rule lepoll_trans) |
|
281 apply (erule subset_Diff_sing [THEN subset_imp_lepoll], assumption) |
|
282 apply (rule Diff_sing_lepoll, assumption+) |
|
283 done |
|
284 |
|
285 lemma uu_Least_is_fun: |
|
286 "[| \<forall>g<a. \<forall>d<a. domain(uu(f, b, g, d))\<noteq>0 --> |
|
287 domain(uu(f, b, g, d)) \<approx> succ(m); |
|
288 \<forall>b<a. f`b \<lesssim> succ(m); y*y \<subseteq> y; |
|
289 (\<Union>b<a. f`b)=y; b<a; g<a; d<a; |
|
290 f`b\<noteq>0; f`g\<noteq>0; m \<in> nat; s \<in> f`b |] |
|
291 ==> uu(f, b, g, LEAST d. uu(f,b,g,d)\<noteq>0) \<in> f`b -> f`g" |
|
292 apply (drule_tac x2=g in ospec [THEN ospec, THEN mp]) |
|
293 apply (rule_tac [3] not_empty_rel_imp_domain [OF uu_subset1 uu_not_empty]) |
|
294 apply (rule_tac [2] Least_uu_not_empty_lt_a, assumption+) |
|
295 apply (rule rel_is_fun) |
|
296 apply (erule eqpoll_sym [THEN eqpoll_imp_lepoll]) |
|
297 apply (erule uu_lepoll_m) |
|
298 apply (rule Least_uu_not_empty_lt_a, assumption+) |
|
299 apply (rule uu_subset1) |
|
300 apply (rule supset_lepoll_imp_eq [OF _ eqpoll_sym [THEN eqpoll_imp_lepoll]]) |
|
301 apply (fast intro!: domain_uu_subset)+ |
|
302 done |
|
303 |
|
304 lemma vv2_subset: |
|
305 "[| \<forall>g<a. \<forall>d<a. domain(uu(f, b, g, d))\<noteq>0 --> |
|
306 domain(uu(f, b, g, d)) \<approx> succ(m); |
|
307 \<forall>b<a. f`b \<lesssim> succ(m); y*y \<subseteq> y; |
|
308 (\<Union>b<a. f`b)=y; b<a; g<a; m \<in> nat; s \<in> f`b |] |
|
309 ==> vv2(f,b,g,s) \<subseteq> f`g" |
|
310 apply (simp add: vv2_def) |
|
311 apply (blast intro: uu_Least_is_fun [THEN apply_type]) |
|
312 done |
|
313 |
|
314 (* ********************************************************************** *) |
|
315 (* Case 2: Union of images is the whole "y" *) |
|
316 (* ********************************************************************** *) |
|
317 lemma UN_gg2_eq: |
|
318 "[| \<forall>g<a. \<forall>d<a. domain(uu(f,b,g,d)) \<noteq> 0 --> |
|
319 domain(uu(f,b,g,d)) \<approx> succ(m); |
|
320 \<forall>b<a. f`b \<lesssim> succ(m); y*y \<subseteq> y; |
|
321 (\<Union>b<a. f`b)=y; Ord(a); m \<in> nat; s \<in> f`b; b<a |] |
|
322 ==> (\<Union>g<a++a. gg2(f,a,b,s) ` g) = y" |
|
323 apply (unfold gg2_def) |
|
324 apply (drule sym) |
|
325 apply (simp add: UN_oadd lt_oadd1 oadd_le_self [THEN le_imp_not_lt] |
|
326 lt_Ord odiff_oadd_inverse ww2_def |
|
327 vv2_subset [THEN Diff_partition]) |
|
328 done |
|
329 |
|
330 lemma domain_gg2: "domain(gg2(f,a,b,s)) = a++a" |
|
331 by (simp add: lam_funtype [THEN domain_of_fun] gg2_def) |
|
332 |
|
333 |
|
334 (* ********************************************************************** *) |
|
335 (* every value of defined function is less than or equipollent to m *) |
|
336 (* ********************************************************************** *) |
|
337 |
|
338 lemma vv2_lepoll: "[| m \<in> nat; m\<noteq>0 |] ==> vv2(f,b,g,s) \<lesssim> m" |
|
339 apply (unfold vv2_def) |
|
340 apply (simp add: empty_lepollI) |
|
341 apply (fast dest!: le_imp_subset [THEN subset_imp_lepoll, THEN lepoll_0_is_0] |
|
342 intro!: singleton_eqpoll_1 [THEN eqpoll_imp_lepoll, THEN lepoll_trans] |
|
343 not_lt_imp_le [THEN le_imp_subset, THEN subset_imp_lepoll] |
|
344 nat_into_Ord nat_1I) |
|
345 done |
|
346 |
|
347 lemma ww2_lepoll: |
|
348 "[| \<forall>b<a. f`b \<lesssim> succ(m); g<a; m \<in> nat; vv2(f,b,g,d) \<subseteq> f`g |] |
|
349 ==> ww2(f,b,g,d) \<lesssim> m" |
|
350 apply (unfold ww2_def) |
|
351 apply (case_tac "f`g = 0") |
|
352 apply (simp add: empty_lepollI) |
|
353 apply (drule ospec, assumption) |
|
354 apply (rule Diff_lepoll, assumption+) |
|
355 apply (simp add: vv2_def not_emptyI) |
|
356 done |
|
357 |
|
358 lemma gg2_lepoll_m: |
|
359 "[| \<forall>g<a. \<forall>d<a. domain(uu(f,b,g,d)) \<noteq> 0 --> |
|
360 domain(uu(f,b,g,d)) \<approx> succ(m); |
|
361 \<forall>b<a. f`b \<lesssim> succ(m); y*y \<subseteq> y; |
|
362 (\<Union>b<a. f`b)=y; b<a; s \<in> f`b; m \<in> nat; m\<noteq> 0; g<a++a |] |
|
363 ==> gg2(f,a,b,s) ` g \<lesssim> m" |
|
364 apply (unfold gg2_def, simp) |
|
365 apply (safe elim!: lt_Ord2 dest!: lt_oadd_odiff_disj) |
|
366 apply (simp add: vv2_lepoll) |
|
367 apply (simp add: ww2_lepoll vv2_subset) |
|
368 done |
|
369 |
|
370 (* ********************************************************************** *) |
|
371 (* lemma ii *) |
|
372 (* ********************************************************************** *) |
|
373 lemma lemma_ii: "[| succ(m) \<in> NN(y); y*y \<subseteq> y; m \<in> nat; m\<noteq>0 |] ==> m \<in> NN(y)" |
|
374 apply (unfold NN_def) |
|
375 apply (elim CollectE exE conjE) |
|
376 apply (rule quant_domain_uu_lepoll_m [THEN cases, THEN disjE], assumption) |
|
377 (* case 1 *) |
|
378 apply (simp add: lesspoll_succ_iff) |
|
379 apply (rule_tac x = "a++a" in exI) |
|
380 apply (fast intro!: Ord_oadd domain_gg1 UN_gg1_eq gg1_lepoll_m) |
|
381 (* case 2 *) |
|
382 apply (elim oexE conjE) |
|
383 apply (rule_tac A = "f`?B" in not_emptyE, assumption) |
|
384 apply (rule CollectI) |
|
385 apply (erule succ_natD) |
|
386 apply (rule_tac x = "a++a" in exI) |
|
387 apply (rule_tac x = "gg2 (f,a,b,x) " in exI) |
|
388 (*Calling fast_tac might get rid of the res_inst_tac calls, but it |
|
389 is just too slow.*) |
|
390 apply (simp add: Ord_oadd domain_gg2 UN_gg2_eq gg2_lepoll_m) |
|
391 done |
|
392 |
|
393 |
|
394 (* ********************************************************************** *) |
|
395 (* lemma iv - p. 4: *) |
|
396 (* For every set x there is a set y such that x Un (y * y) \<subseteq> y *) |
|
397 (* ********************************************************************** *) |
|
398 |
|
399 |
|
400 (* The leading \<forall>-quantifier looks odd but makes the proofs shorter |
|
401 (used only in the following two lemmas) *) |
|
402 |
|
403 lemma z_n_subset_z_succ_n: |
|
404 "\<forall>n \<in> nat. rec(n, x, %k r. r Un r*r) \<subseteq> rec(succ(n), x, %k r. r Un r*r)" |
|
405 by (fast intro: rec_succ [THEN ssubst]) |
|
406 |
|
407 lemma le_subsets: |
|
408 "[| \<forall>n \<in> nat. f(n)<=f(succ(n)); n\<le>m; n \<in> nat; m \<in> nat |] |
|
409 ==> f(n)<=f(m)" |
|
410 apply (erule_tac P = "n\<le>m" in rev_mp) |
|
411 apply (rule_tac P = "%z. n\<le>z --> f (n) \<subseteq> f (z) " in nat_induct) |
|
412 apply (auto simp add: le_iff) |
|
413 done |
|
414 |
|
415 lemma le_imp_rec_subset: |
|
416 "[| n\<le>m; m \<in> nat |] |
|
417 ==> rec(n, x, %k r. r Un r*r) \<subseteq> rec(m, x, %k r. r Un r*r)" |
|
418 apply (rule z_n_subset_z_succ_n [THEN le_subsets]) |
|
419 apply (blast intro: lt_nat_in_nat)+ |
|
420 done |
|
421 |
|
422 lemma lemma_iv: "\<exists>y. x Un y*y \<subseteq> y" |
|
423 apply (rule_tac x = "\<Union>n \<in> nat. rec (n, x, %k r. r Un r*r) " in exI) |
|
424 apply safe |
|
425 apply (rule nat_0I [THEN UN_I], simp) |
|
426 apply (rule_tac a = "succ (n Un na) " in UN_I) |
|
427 apply (erule Un_nat_type [THEN nat_succI], assumption) |
|
428 apply (auto intro: le_imp_rec_subset [THEN subsetD] |
|
429 intro!: Un_upper1_le Un_upper2_le Un_nat_type |
|
430 elim!: nat_into_Ord) |
|
431 done |
|
432 |
|
433 (* ********************************************************************** *) |
|
434 (* Rubin & Rubin wrote, *) |
|
435 (* "It follows from (ii) and mathematical induction that if y*y \<subseteq> y then *) |
|
436 (* y can be well-ordered" *) |
|
437 |
|
438 (* In fact we have to prove *) |
|
439 (* * WO6 ==> NN(y) \<noteq> 0 *) |
|
440 (* * reverse induction which lets us infer that 1 \<in> NN(y) *) |
|
441 (* * 1 \<in> NN(y) ==> y can be well-ordered *) |
|
442 (* ********************************************************************** *) |
|
443 |
|
444 (* ********************************************************************** *) |
|
445 (* WO6 ==> NN(y) \<noteq> 0 *) |
|
446 (* ********************************************************************** *) |
|
447 |
|
448 lemma WO6_imp_NN_not_empty: "WO6 ==> NN(y) \<noteq> 0" |
|
449 apply (unfold WO6_def NN_def, clarify) |
|
450 apply blast |
|
451 done |
|
452 |
|
453 (* ********************************************************************** *) |
|
454 (* 1 \<in> NN(y) ==> y can be well-ordered *) |
|
455 (* ********************************************************************** *) |
|
456 |
|
457 lemma lemma1: |
|
458 "[| (\<Union>b<a. f`b)=y; x \<in> y; \<forall>b<a. f`b \<lesssim> 1; Ord(a) |] ==> \<exists>c<a. f`c = {x}" |
|
459 by (fast elim!: lepoll_1_is_sing) |
|
460 |
|
461 lemma lemma2: |
|
462 "[| (\<Union>b<a. f`b)=y; x \<in> y; \<forall>b<a. f`b \<lesssim> 1; Ord(a) |] |
|
463 ==> f` (LEAST i. f`i = {x}) = {x}" |
|
464 apply (drule lemma1, assumption+) |
|
465 apply (fast elim!: lt_Ord intro: LeastI) |
|
466 done |
|
467 |
|
468 lemma NN_imp_ex_inj: "1 \<in> NN(y) ==> \<exists>a f. Ord(a) & f \<in> inj(y, a)" |
|
469 apply (unfold NN_def) |
|
470 apply (elim CollectE exE conjE) |
|
471 apply (rule_tac x = "a" in exI) |
|
472 apply (rule_tac x = "\<lambda>x \<in> y. LEAST i. f`i = {x}" in exI) |
|
473 apply (rule conjI, assumption) |
|
474 apply (rule_tac d = "%i. THE x. x \<in> f`i" in lam_injective) |
|
475 apply (drule lemma1, assumption+) |
|
476 apply (fast elim!: Least_le [THEN lt_trans1, THEN ltD] lt_Ord) |
|
477 apply (rule lemma2 [THEN ssubst], assumption+, blast) |
|
478 done |
|
479 |
|
480 lemma y_well_ord: "[| y*y \<subseteq> y; 1 \<in> NN(y) |] ==> \<exists>r. well_ord(y, r)" |
|
481 apply (drule NN_imp_ex_inj) |
|
482 apply (fast elim!: well_ord_rvimage [OF _ well_ord_Memrel]) |
|
483 done |
|
484 |
|
485 (* ********************************************************************** *) |
|
486 (* reverse induction which lets us infer that 1 \<in> NN(y) *) |
|
487 (* ********************************************************************** *) |
|
488 |
|
489 lemma rev_induct_lemma [rule_format]: |
|
490 "[| n \<in> nat; !!m. [| m \<in> nat; m\<noteq>0; P(succ(m)) |] ==> P(m) |] |
|
491 ==> n\<noteq>0 --> P(n) --> P(1)" |
|
492 by (erule nat_induct, blast+) |
|
493 |
|
494 lemma rev_induct: |
|
495 "[| n \<in> nat; P(n); n\<noteq>0; |
|
496 !!m. [| m \<in> nat; m\<noteq>0; P(succ(m)) |] ==> P(m) |] |
|
497 ==> P(1)" |
|
498 by (rule rev_induct_lemma, blast+) |
|
499 |
|
500 lemma NN_into_nat: "n \<in> NN(y) ==> n \<in> nat" |
|
501 by (simp add: NN_def) |
|
502 |
|
503 lemma lemma3: "[| n \<in> NN(y); y*y \<subseteq> y; n\<noteq>0 |] ==> 1 \<in> NN(y)" |
|
504 apply (rule rev_induct [OF NN_into_nat], assumption+) |
|
505 apply (rule lemma_ii, assumption+) |
|
506 done |
|
507 |
|
508 (* ********************************************************************** *) |
|
509 (* Main theorem "WO6 ==> WO1" *) |
|
510 (* ********************************************************************** *) |
|
511 |
|
512 (* another helpful lemma *) |
|
513 lemma NN_y_0: "0 \<in> NN(y) ==> y=0" |
|
514 apply (unfold NN_def) |
|
515 apply (fast intro!: equalityI dest!: lepoll_0_is_0 elim: subst) |
|
516 done |
|
517 |
|
518 lemma WO6_imp_WO1: "WO6 ==> WO1" |
|
519 apply (unfold WO1_def) |
|
520 apply (rule allI) |
|
521 apply (case_tac "A=0") |
|
522 apply (fast intro!: well_ord_Memrel nat_0I [THEN nat_into_Ord]) |
|
523 apply (rule_tac x1 = "A" in lemma_iv [THEN revcut_rl]) |
|
524 apply (erule exE) |
|
525 apply (drule WO6_imp_NN_not_empty) |
|
526 apply (erule Un_subset_iff [THEN iffD1, THEN conjE]) |
|
527 apply (erule_tac A = "NN (y) " in not_emptyE) |
|
528 apply (frule y_well_ord) |
|
529 apply (fast intro!: lemma3 dest!: NN_y_0 elim!: not_emptyE) |
|
530 apply (fast elim: well_ord_subset) |
|
531 done |
|
532 |
50 end |
533 end |