--- a/src/ZF/AC/AC15_WO6.ML Wed Jan 16 15:04:37 2002 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,292 +0,0 @@
-(* Title: ZF/AC/AC15_WO6.ML
- ID: $Id$
- Author: Krzysztof Grabczewski
-
-The proofs needed to state that AC10, ..., AC15 are equivalent to the rest.
-We need the following:
-
-WO1 ==> AC10(n) ==> AC11 ==> AC12 ==> AC15 ==> WO6
-
-In order to add the formulations AC13 and AC14 we need:
-
-AC10(succ(n)) ==> AC13(n) ==> AC14 ==> AC15
-
-or
-
-AC1 ==> AC13(1); AC13(m) ==> AC13(n) ==> AC14 ==> AC15 (m le n)
-
-So we don't have to prove all implications of both cases.
-Moreover we don't need to prove AC13(1) ==> AC1 and AC11 ==> AC14 as
-Rubin & Rubin do.
-*)
-
-(* ********************************************************************** *)
-(* Lemmas used in the proofs in which the conclusion is AC13, AC14 *)
-(* or AC15 *)
-(* - cons_times_nat_not_Finite *)
-(* - ex_fun_AC13_AC15 *)
-(* ********************************************************************** *)
-
-Goalw [lepoll_def] "A\\<noteq>0 ==> B lepoll A*B";
-by (etac not_emptyE 1);
-by (res_inst_tac [("x","\\<lambda>z \\<in> B. <x,z>")] exI 1);
-by (fast_tac (claset() addSIs [snd_conv, lam_injective]) 1);
-qed "lepoll_Sigma";
-
-Goal "0\\<notin>A ==> \\<forall>B \\<in> {cons(0,x*nat). x \\<in> A}. ~Finite(B)";
-by (rtac ballI 1);
-by (etac RepFunE 1);
-by (hyp_subst_tac 1);
-by (rtac notI 1);
-by (dresolve_tac [subset_consI RS subset_imp_lepoll RS lepoll_Finite] 1);
-by (resolve_tac [lepoll_Sigma RS lepoll_Finite RS (nat_not_Finite RS notE)] 1
- THEN (assume_tac 2));
-by (Fast_tac 1);
-qed "cons_times_nat_not_Finite";
-
-Goal "[| Union(C)=A; a \\<in> A |] ==> \\<exists>B \\<in> C. a \\<in> B & B \\<subseteq> A";
-by (Fast_tac 1);
-val lemma1 = result();
-
-Goalw [pairwise_disjoint_def]
- "[| pairwise_disjoint(A); B \\<in> A; C \\<in> A; a \\<in> B; a \\<in> C |] ==> B=C";
-by (dtac IntI 1 THEN (assume_tac 1));
-by (dres_inst_tac [("A","B Int C")] not_emptyI 1);
-by (Fast_tac 1);
-val lemma2 = result();
-
-Goalw [sets_of_size_between_def]
- "\\<forall>B \\<in> {cons(0, x*nat). x \\<in> A}. pairwise_disjoint(f`B) & \
-\ sets_of_size_between(f`B, 2, n) & Union(f`B)=B \
-\ ==> \\<forall>B \\<in> A. \\<exists>! u. u \\<in> f`cons(0, B*nat) & u \\<subseteq> cons(0, B*nat) & \
-\ 0 \\<in> u & 2 lepoll u & u lepoll n";
-by (rtac ballI 1);
-by (etac ballE 1);
-by (Fast_tac 2);
-by (REPEAT (etac conjE 1));
-by (dresolve_tac [consI1 RSN (2, lemma1)] 1);
-by (etac bexE 1);
-by (rtac ex1I 1);
-by (Fast_tac 1);
-by (REPEAT (etac conjE 1));
-by (rtac lemma2 1 THEN (REPEAT (assume_tac 1)));
-val lemma3 = result();
-
-Goalw [lepoll_def] "[| A lepoll i; Ord(i) |] ==> {P(a). a \\<in> A} lepoll i";
-by (etac exE 1);
-by (res_inst_tac
- [("x", "\\<lambda>x \\<in> RepFun(A, P). LEAST j. \\<exists>a \\<in> A. x=P(a) & f`a=j")] exI 1);
-by (res_inst_tac [("d", "%y. P(converse(f)`y)")] lam_injective 1);
-by (etac RepFunE 1);
-by (forward_tac [inj_is_fun RS apply_type] 1 THEN (assume_tac 1));
-by (fast_tac (claset() addIs [LeastI2]
- addSEs [Ord_in_Ord, inj_is_fun RS apply_type]) 1);
-by (etac RepFunE 1);
-by (rtac LeastI2 1);
-by (Fast_tac 1);
-by (fast_tac (claset() addSEs [Ord_in_Ord, inj_is_fun RS apply_type]) 1);
-by (fast_tac (claset() addEs [sym, left_inverse RS ssubst]) 1);
-val lemma4 = result();
-
-Goal "[| n \\<in> nat; B \\<in> A; u(B) \\<subseteq> cons(0, B*nat); 0 \\<in> u(B); 2 lepoll u(B); \
-\ u(B) lepoll succ(n) |] \
-\ ==> (\\<lambda>x \\<in> A. {fst(x). x \\<in> u(x)-{0}})`B \\<noteq> 0 & \
-\ (\\<lambda>x \\<in> A. {fst(x). x \\<in> u(x)-{0}})`B \\<subseteq> B & \
-\ (\\<lambda>x \\<in> A. {fst(x). x \\<in> u(x)-{0}})`B lepoll n";
-by (Asm_simp_tac 1);
-by (rtac conjI 1);
-by (fast_tac (empty_cs addSDs [RepFun_eq_0_iff RS iffD1]
- addDs [lepoll_Diff_sing]
- addEs [lepoll_trans RS succ_lepoll_natE, ssubst]
- addSIs [notI, lepoll_refl, nat_0I]) 1);
-by (rtac conjI 1);
-by (fast_tac (claset() addSIs [fst_type] addSEs [consE]) 1);
-by (fast_tac (claset() addSEs [equalityE,
- Diff_lepoll RS (nat_into_Ord RSN (2, lemma4))]) 1);
-val lemma5 = result();
-
-Goal "[| \\<exists>f. \\<forall>B \\<in> {cons(0, x*nat). x \\<in> A}. \
-\ pairwise_disjoint(f`B) & \
-\ sets_of_size_between(f`B, 2, succ(n)) & \
-\ Union(f`B)=B; n \\<in> nat |] \
-\ ==> \\<exists>f. \\<forall>B \\<in> A. f`B \\<noteq> 0 & f`B \\<subseteq> B & f`B lepoll n";
-by (fast_tac (empty_cs addSDs [lemma3, theI] addDs [bspec]
- addSEs [exE, conjE]
- addIs [exI, ballI, lemma5]) 1);
-qed "ex_fun_AC13_AC15";
-
-(* ********************************************************************** *)
-(* The target proofs *)
-(* ********************************************************************** *)
-
-(* ********************************************************************** *)
-(* AC10(n) ==> AC11 *)
-(* ********************************************************************** *)
-
-Goalw AC_defs "[| n \\<in> nat; 1 le n; AC10(n) |] ==> AC11";
-by (rtac bexI 1 THEN (assume_tac 2));
-by (Fast_tac 1);
-qed "AC10_AC11";
-
-(* ********************************************************************** *)
-(* AC11 ==> AC12 *)
-(* ********************************************************************** *)
-
-Goalw AC_defs "AC11 ==> AC12";
-by (fast_tac (FOL_cs addSEs [bexE] addIs [bexI]) 1);
-qed "AC11_AC12";
-
-(* ********************************************************************** *)
-(* AC12 ==> AC15 *)
-(* ********************************************************************** *)
-
-Goalw AC_defs "AC12 ==> AC15";
-by Safe_tac;
-by (etac allE 1);
-by (etac impE 1);
-by (etac cons_times_nat_not_Finite 1);
-by (fast_tac (claset() addSIs [ex_fun_AC13_AC15]) 1);
-qed "AC12_AC15";
-
-(* ********************************************************************** *)
-(* AC15 ==> WO6 *)
-(* ********************************************************************** *)
-
-Goal "Ord(x) ==> (\\<Union>a<x. F(a)) = (\\<Union>a \\<in> x. F(a))";
-by (fast_tac (claset() addSIs [ltI] addSDs [ltD]) 1);
-qed "OUN_eq_UN";
-
-val [prem] = goal thy "\\<forall>x \\<in> Pow(A)-{0}. f`x\\<noteq>0 & f`x \\<subseteq> x & f`x lepoll m ==> \
-\ (\\<Union>i<LEAST x. HH(f,A,x)={A}. HH(f,A,i)) = A";
-by (simp_tac (simpset() addsimps [Ord_Least RS OUN_eq_UN]) 1);
-by (rtac equalityI 1);
-by (fast_tac (claset() addSDs [less_Least_subset_x]) 1);
-by (fast_tac (claset() addSDs [prem RS bspec]
- addSIs [f_subsets_imp_UN_HH_eq_x RS (Diff_eq_0_iff RS iffD1)]) 1);
-val lemma1 = result();
-
-val [prem] = goal thy "\\<forall>x \\<in> Pow(A)-{0}. f`x\\<noteq>0 & f`x \\<subseteq> x & f`x lepoll m ==> \
-\ \\<forall>x<LEAST x. HH(f,A,x)={A}. HH(f,A,x) lepoll m";
-by (rtac oallI 1);
-by (dresolve_tac [ltD RS less_Least_subset_x] 1);
-by (ftac HH_subset_imp_eq 1);
-by (etac ssubst 1);
-by (fast_tac (claset() addIs [prem RS ballE]
- addSDs [HH_subset_x_imp_subset_Diff_UN RS not_emptyI2]) 1);
-val lemma2 = result();
-
-Goalw [AC15_def, WO6_def] "AC15 ==> WO6";
-by (rtac allI 1);
-by (eres_inst_tac [("x","Pow(A)-{0}")] allE 1);
-by (etac impE 1);
-by (Fast_tac 1);
-by (REPEAT (eresolve_tac [bexE,conjE,exE] 1));
-by (rtac bexI 1 THEN (assume_tac 2));
-by (rtac conjI 1 THEN (assume_tac 1));
-by (res_inst_tac [("x","LEAST i. HH(f,A,i)={A}")] exI 1);
-by (res_inst_tac [("x","\\<lambda>j \\<in> (LEAST i. HH(f,A,i)={A}). HH(f,A,j)")] exI 1);
-by (Asm_full_simp_tac 1);
-by (fast_tac (claset() addSIs [Ord_Least, lam_type RS domain_of_fun]
- addSEs [less_Least_subset_x, lemma1, lemma2]) 1);
-qed "AC15_WO6";
-
-
-(* ********************************************************************** *)
-(* The proof needed in the first case, not in the second *)
-(* ********************************************************************** *)
-
-(* ********************************************************************** *)
-(* AC10(n) ==> AC13(n-1) if 2 le n *)
-(* *)
-(* Because of the change to the formal definition of AC10(n) we prove *)
-(* the following obviously equivalent theorem \\<in> *)
-(* AC10(n) implies AC13(n) for (1 le n) *)
-(* ********************************************************************** *)
-
-Goalw AC_defs "[| n \\<in> nat; 1 le n; AC10(n) |] ==> AC13(n)";
-by Safe_tac;
-by (fast_tac (empty_cs addSEs [allE, cons_times_nat_not_Finite RSN (2, impE),
- ex_fun_AC13_AC15]) 1);
-qed "AC10_AC13";
-
-(* ********************************************************************** *)
-(* The proofs needed in the second case, not in the first *)
-(* ********************************************************************** *)
-
-(* ********************************************************************** *)
-(* AC1 ==> AC13(1) *)
-(* ********************************************************************** *)
-
-Goalw AC_defs "AC1 ==> AC13(1)";
-by (rtac allI 1);
-by (etac allE 1);
-by (rtac impI 1);
-by (mp_tac 1);
-by (etac exE 1);
-by (res_inst_tac [("x","\\<lambda>x \\<in> A. {f`x}")] exI 1);
-by (asm_simp_tac (simpset() addsimps
- [singleton_eqpoll_1 RS eqpoll_imp_lepoll,
- singletonI RS not_emptyI]) 1);
-qed "AC1_AC13";
-
-(* ********************************************************************** *)
-(* AC13(m) ==> AC13(n) for m \\<subseteq> n *)
-(* ********************************************************************** *)
-
-Goalw AC_defs "[| m le n; AC13(m) |] ==> AC13(n)";
-by (dtac le_imp_lepoll 1);
-by (fast_tac (claset() addSEs [lepoll_trans]) 1);
-qed "AC13_mono";
-
-(* ********************************************************************** *)
-(* The proofs necessary for both cases *)
-(* ********************************************************************** *)
-
-(* ********************************************************************** *)
-(* AC13(n) ==> AC14 if 1 \\<subseteq> n *)
-(* ********************************************************************** *)
-
-Goalw AC_defs "[| n \\<in> nat; 1 le n; AC13(n) |] ==> AC14";
-by (fast_tac (FOL_cs addIs [bexI]) 1);
-qed "AC13_AC14";
-
-(* ********************************************************************** *)
-(* AC14 ==> AC15 *)
-(* ********************************************************************** *)
-
-Goalw AC_defs "AC14 ==> AC15";
-by (Fast_tac 1);
-qed "AC14_AC15";
-
-(* ********************************************************************** *)
-(* The redundant proofs; however cited by Rubin & Rubin *)
-(* ********************************************************************** *)
-
-(* ********************************************************************** *)
-(* AC13(1) ==> AC1 *)
-(* ********************************************************************** *)
-
-Goal "[| A\\<noteq>0; A lepoll 1 |] ==> \\<exists>a. A={a}";
-by (fast_tac (claset() addSEs [not_emptyE, lepoll_1_is_sing]) 1);
-qed "lemma_aux";
-
-Goal "\\<forall>B \\<in> A. f(B)\\<noteq>0 & f(B)<=B & f(B) lepoll 1 \
-\ ==> (\\<lambda>x \\<in> A. THE y. f(x)={y}) \\<in> (\\<Pi>X \\<in> A. X)";
-by (rtac lam_type 1);
-by (dtac bspec 1 THEN (assume_tac 1));
-by (REPEAT (etac conjE 1));
-by (eresolve_tac [lemma_aux RS exE] 1 THEN (assume_tac 1));
-by (asm_full_simp_tac (simpset() addsimps [the_element]) 1);
-val lemma = result();
-
-Goalw AC_defs "AC13(1) ==> AC1";
-by (fast_tac (claset() addSEs [lemma]) 1);
-qed "AC13_AC1";
-
-(* ********************************************************************** *)
-(* AC11 ==> AC14 *)
-(* ********************************************************************** *)
-
-Goalw [AC11_def, AC14_def] "AC11 ==> AC14";
-by (fast_tac (claset() addSIs [AC10_AC13]) 1);
-qed "AC11_AC14";
--- a/src/ZF/AC/AC15_WO6.thy Wed Jan 16 15:04:37 2002 +0100
+++ b/src/ZF/AC/AC15_WO6.thy Wed Jan 16 17:52:06 2002 +0100
@@ -1,3 +1,290 @@
-(*Dummy theory to document dependencies *)
+(* Title: ZF/AC/AC15_WO6.thy
+ ID: $Id$
+ Author: Krzysztof Grabczewski
+
+The proofs needed to state that AC10, ..., AC15 are equivalent to the rest.
+We need the following:
+
+WO1 ==> AC10(n) ==> AC11 ==> AC12 ==> AC15 ==> WO6
+
+In order to add the formulations AC13 and AC14 we need:
+
+AC10(succ(n)) ==> AC13(n) ==> AC14 ==> AC15
+
+or
+
+AC1 ==> AC13(1); AC13(m) ==> AC13(n) ==> AC14 ==> AC15 (m\<le>n)
+
+So we don't have to prove all implications of both cases.
+Moreover we don't need to prove AC13(1) ==> AC1 and AC11 ==> AC14 as
+Rubin & Rubin do.
+*)
+
+theory AC15_WO6 = HH + Cardinal_aux:
+
+
+(* ********************************************************************** *)
+(* Lemmas used in the proofs in which the conclusion is AC13, AC14 *)
+(* or AC15 *)
+(* - cons_times_nat_not_Finite *)
+(* - ex_fun_AC13_AC15 *)
+(* ********************************************************************** *)
+
+lemma lepoll_Sigma: "A\<noteq>0 ==> B \<lesssim> A*B"
+apply (unfold lepoll_def)
+apply (erule not_emptyE)
+apply (rule_tac x = "\<lambda>z \<in> B. <x,z>" in exI)
+apply (fast intro!: snd_conv lam_injective)
+done
+
+lemma cons_times_nat_not_Finite:
+ "0\<notin>A ==> \<forall>B \<in> {cons(0,x*nat). x \<in> A}. ~Finite(B)"
+apply clarify
+apply (drule subset_consI [THEN subset_imp_lepoll, THEN lepoll_Finite])
+apply (rule nat_not_Finite [THEN notE] )
+apply (subgoal_tac "x ~= 0")
+apply (blast intro: lepoll_Sigma [THEN lepoll_Finite] , blast)
+done
+
+lemma lemma1: "[| Union(C)=A; a \<in> A |] ==> \<exists>B \<in> C. a \<in> B & B \<subseteq> A"
+by fast
+
+lemma lemma2:
+ "[| pairwise_disjoint(A); B \<in> A; C \<in> A; a \<in> B; a \<in> C |] ==> B=C"
+by (unfold pairwise_disjoint_def, blast)
+
+lemma lemma3:
+ "\<forall>B \<in> {cons(0, x*nat). x \<in> A}. pairwise_disjoint(f`B) &
+ sets_of_size_between(f`B, 2, n) & Union(f`B)=B
+ ==> \<forall>B \<in> A. \<exists>! u. u \<in> f`cons(0, B*nat) & u \<subseteq> cons(0, B*nat) &
+ 0 \<in> u & 2 \<lesssim> u & u \<lesssim> n"
+apply (unfold sets_of_size_between_def)
+apply (rule ballI)
+apply (erule ballE)
+prefer 2 apply blast
+apply (blast dest: lemma1 intro!: lemma2)
+done
+
+lemma lemma4: "[| A \<lesssim> i; Ord(i) |] ==> {P(a). a \<in> A} \<lesssim> i"
+apply (unfold lepoll_def)
+apply (erule exE)
+apply (rule_tac x = "\<lambda>x \<in> RepFun(A,P). LEAST j. \<exists>a\<in>A. x=P(a) & f`a=j"
+ in exI)
+apply (rule_tac d = "%y. P (converse (f) `y) " in lam_injective)
+apply (erule RepFunE)
+apply (frule inj_is_fun [THEN apply_type], assumption)
+apply (fast intro: LeastI2 elim!: Ord_in_Ord inj_is_fun [THEN apply_type])
+apply (erule RepFunE)
+apply (rule LeastI2)
+ apply fast
+ apply (fast elim!: Ord_in_Ord inj_is_fun [THEN apply_type])
+apply (fast elim: sym left_inverse [THEN ssubst])
+done
+
+lemma lemma5_1:
+ "[| B \<in> A; 2 \<lesssim> u(B) |] ==> (\<lambda>x \<in> A. {fst(x). x \<in> u(x)-{0}})`B \<noteq> 0"
+apply simp
+apply (fast dest: lepoll_Diff_sing
+ elim: lepoll_trans [THEN succ_lepoll_natE] ssubst
+ intro!: lepoll_refl)
+done
+
+lemma lemma5_2:
+ "[| B \<in> A; u(B) \<subseteq> cons(0, B*nat) |]
+ ==> (\<lambda>x \<in> A. {fst(x). x \<in> u(x)-{0}})`B \<subseteq> B"
+apply auto
+done
+
+lemma lemma5_3:
+ "[| n \<in> nat; B \<in> A; 0 \<in> u(B); u(B) \<lesssim> succ(n) |]
+ ==> (\<lambda>x \<in> A. {fst(x). x \<in> u(x)-{0}})`B \<lesssim> n"
+apply simp
+apply (fast elim!: Diff_lepoll [THEN lemma4 [OF _ nat_into_Ord]])
+done
+
+lemma ex_fun_AC13_AC15:
+ "[| \<forall>B \<in> {cons(0, x*nat). x \<in> A}.
+ pairwise_disjoint(f`B) &
+ sets_of_size_between(f`B, 2, succ(n)) & Union(f`B)=B;
+ n \<in> nat |]
+ ==> \<exists>f. \<forall>B \<in> A. f`B \<noteq> 0 & f`B \<subseteq> B & f`B \<lesssim> n"
+by (fast del: subsetI notI
+ dest!: lemma3 theI intro!: lemma5_1 lemma5_2 lemma5_3)
+
+
+(* ********************************************************************** *)
+(* The target proofs *)
+(* ********************************************************************** *)
+
+(* ********************************************************************** *)
+(* AC10(n) ==> AC11 *)
+(* ********************************************************************** *)
+
+lemma AC10_AC11: "[| n \<in> nat; 1\<le>n; AC10(n) |] ==> AC11"
+by (unfold AC10_def AC11_def, blast)
+
+(* ********************************************************************** *)
+(* AC11 ==> AC12 *)
+(* ********************************************************************** *)
+
+lemma AC11_AC12: "AC11 ==> AC12"
+by (unfold AC10_def AC11_def AC11_def AC12_def, blast)
+
+(* ********************************************************************** *)
+(* AC12 ==> AC15 *)
+(* ********************************************************************** *)
+
+lemma AC12_AC15: "AC12 ==> AC15"
+apply (unfold AC12_def AC15_def)
+apply (blast del: ballI
+ intro!: cons_times_nat_not_Finite ex_fun_AC13_AC15)
+done
-AC15_WO6 = HH
+(* ********************************************************************** *)
+(* AC15 ==> WO6 *)
+(* ********************************************************************** *)
+
+lemma OUN_eq_UN: "Ord(x) ==> (\<Union>a<x. F(a)) = (\<Union>a \<in> x. F(a))"
+by (fast intro!: ltI dest!: ltD)
+
+lemma lemma1:
+ "\<forall>x \<in> Pow(A)-{0}. f`x\<noteq>0 & f`x \<subseteq> x & f`x \<lesssim> m
+ ==> (\<Union>i<LEAST x. HH(f,A,x)={A}. HH(f,A,i)) = A"
+apply (simp add: Ord_Least [THEN OUN_eq_UN])
+apply (rule equalityI)
+apply (fast dest!: less_Least_subset_x)
+apply (blast del: subsetI
+ intro!: f_subsets_imp_UN_HH_eq_x [THEN Diff_eq_0_iff [THEN iffD1]])
+done
+
+lemma lemma2:
+ "\<forall>x \<in> Pow(A)-{0}. f`x\<noteq>0 & f`x \<subseteq> x & f`x \<lesssim> m
+ ==> \<forall>x < (LEAST x. HH(f,A,x)={A}). HH(f,A,x) \<lesssim> m"
+apply (rule oallI)
+apply (drule ltD [THEN less_Least_subset_x])
+apply (frule HH_subset_imp_eq)
+apply (erule ssubst)
+apply (blast dest!: HH_subset_x_imp_subset_Diff_UN [THEN not_emptyI2])
+ (*but can't use del: DiffE despite the obvious conflictc*)
+done
+
+lemma AC15_WO6: "AC15 ==> WO6"
+apply (unfold AC15_def WO6_def)
+apply (rule allI)
+apply (erule_tac x = "Pow (A) -{0}" in allE)
+apply (erule impE, fast)
+apply (elim bexE conjE exE)
+apply (rule bexI)
+apply (rule conjI, assumption)
+apply (rule_tac x = "LEAST i. HH (f,A,i) ={A}" in exI)
+apply (rule_tac x = "\<lambda>j \<in> (LEAST i. HH (f,A,i) ={A}) . HH (f,A,j) " in exI)
+apply simp
+apply (fast intro!: Ord_Least lam_type [THEN domain_of_fun]
+ elim!: less_Least_subset_x lemma1 lemma2, assumption);
+done
+
+
+(* ********************************************************************** *)
+(* The proof needed in the first case, not in the second *)
+(* ********************************************************************** *)
+
+(* ********************************************************************** *)
+(* AC10(n) ==> AC13(n-1) if 2\<le>n *)
+(* *)
+(* Because of the change to the formal definition of AC10(n) we prove *)
+(* the following obviously equivalent theorem \<in> *)
+(* AC10(n) implies AC13(n) for (1\<le>n) *)
+(* ********************************************************************** *)
+
+lemma AC10_AC13: "[| n \<in> nat; 1\<le>n; AC10(n) |] ==> AC13(n)"
+apply (unfold AC10_def AC13_def, safe)
+apply (erule allE)
+apply (erule impE [OF _ cons_times_nat_not_Finite], assumption);
+apply (fast elim!: impE [OF _ cons_times_nat_not_Finite]
+ dest!: ex_fun_AC13_AC15)
+done
+
+(* ********************************************************************** *)
+(* The proofs needed in the second case, not in the first *)
+(* ********************************************************************** *)
+
+(* ********************************************************************** *)
+(* AC1 ==> AC13(1) *)
+(* ********************************************************************** *)
+
+lemma AC1_AC13: "AC1 ==> AC13(1)"
+apply (unfold AC1_def AC13_def)
+apply (rule allI)
+apply (erule allE)
+apply (rule impI)
+apply (drule mp, assumption)
+apply (elim exE)
+apply (rule_tac x = "\<lambda>x \<in> A. {f`x}" in exI)
+apply (simp add: singleton_eqpoll_1 [THEN eqpoll_imp_lepoll])
+done
+
+(* ********************************************************************** *)
+(* AC13(m) ==> AC13(n) for m \<subseteq> n *)
+(* ********************************************************************** *)
+
+lemma AC13_mono: "[| m\<le>n; AC13(m) |] ==> AC13(n)"
+apply (unfold AC13_def)
+apply (drule le_imp_lepoll)
+apply (fast elim!: lepoll_trans)
+done
+
+(* ********************************************************************** *)
+(* The proofs necessary for both cases *)
+(* ********************************************************************** *)
+
+(* ********************************************************************** *)
+(* AC13(n) ==> AC14 if 1 \<subseteq> n *)
+(* ********************************************************************** *)
+
+lemma AC13_AC14: "[| n \<in> nat; 1\<le>n; AC13(n) |] ==> AC14"
+by (unfold AC13_def AC14_def, auto)
+
+(* ********************************************************************** *)
+(* AC14 ==> AC15 *)
+(* ********************************************************************** *)
+
+lemma AC14_AC15: "AC14 ==> AC15"
+by (unfold AC13_def AC14_def AC15_def, fast)
+
+(* ********************************************************************** *)
+(* The redundant proofs; however cited by Rubin & Rubin *)
+(* ********************************************************************** *)
+
+(* ********************************************************************** *)
+(* AC13(1) ==> AC1 *)
+(* ********************************************************************** *)
+
+lemma lemma_aux: "[| A\<noteq>0; A \<lesssim> 1 |] ==> \<exists>a. A={a}"
+by (fast elim!: not_emptyE lepoll_1_is_sing)
+
+lemma AC13_AC1_lemma:
+ "\<forall>B \<in> A. f(B)\<noteq>0 & f(B)<=B & f(B) \<lesssim> 1
+ ==> (\<lambda>x \<in> A. THE y. f(x)={y}) \<in> (\<Pi>X \<in> A. X)"
+apply (rule lam_type)
+apply (drule bspec, assumption)
+apply (elim conjE)
+apply (erule lemma_aux [THEN exE], assumption)
+apply (simp add: the_element)
+done
+
+lemma AC13_AC1: "AC13(1) ==> AC1"
+apply (unfold AC13_def AC1_def)
+apply (fast elim!: AC13_AC1_lemma)
+done
+
+(* ********************************************************************** *)
+(* AC11 ==> AC14 *)
+(* ********************************************************************** *)
+
+lemma AC11_AC14: "AC11 ==> AC14"
+apply (unfold AC11_def AC14_def)
+apply (fast intro!: AC10_AC13)
+done
+
+end
+
--- a/src/ZF/AC/AC16_WO4.ML Wed Jan 16 15:04:37 2002 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,611 +0,0 @@
-(* Title: ZF/AC/AC16_WO4.ML
- ID: $Id$
- Author: Krzysztof Grabczewski
-
- The proof of AC16(n, k) ==> WO4(n-k)
-*)
-
-(* ********************************************************************** *)
-(* The case of finite set *)
-(* ********************************************************************** *)
-
-Goalw [Finite_def] "[| Finite(A); 0<m; m \\<in> nat |] ==> \
-\ \\<exists>a f. Ord(a) & domain(f) = a & \
-\ (\\<Union>b<a. f`b) = A & (\\<forall>b<a. f`b lepoll m)";
-by (etac bexE 1);
-by (dresolve_tac [eqpoll_sym RS (eqpoll_def RS def_imp_iff RS iffD1)] 1);
-by (etac exE 1);
-by (res_inst_tac [("x","n")] exI 1);
-by (res_inst_tac [("x","\\<lambda>i \\<in> n. {f`i}")] exI 1);
-by (Asm_full_simp_tac 1);
-by (rewrite_goals_tac [bij_def, surj_def]);
-by (fast_tac (claset() addSIs [ltI, nat_into_Ord, lam_funtype RS domain_of_fun,
- equalityI, singleton_eqpoll_1 RS eqpoll_imp_lepoll RS lepoll_trans,
- nat_1_lepoll_iff RS iffD2]
- addSEs [apply_type, ltE]) 1);
-val lemma1 = result();
-
-(* ********************************************************************** *)
-(* The case of infinite set *)
-(* ********************************************************************** *)
-
-(* well_ord(x,r) ==> well_ord({{y,z}. y \\<in> x}, Something(x,z)) **)
-bind_thm ("well_ord_paired", (paired_bij RS bij_is_inj RS well_ord_rvimage));
-
-Goal "[| A lepoll B; ~ A lepoll C |] ==> ~ B lepoll C";
-by (fast_tac (claset() addEs [notE, lepoll_trans]) 1);
-qed "lepoll_trans1";
-
-(* ********************************************************************** *)
-(* There exists a well ordered set y such that ... *)
-(* ********************************************************************** *)
-
-val lepoll_paired = paired_eqpoll RS eqpoll_sym RS eqpoll_imp_lepoll;
-
-Goal "\\<exists>y R. well_ord(y,R) & x Int y = 0 & ~y lepoll z & ~Finite(y)";
-by (res_inst_tac [("x","{{a,x}. a \\<in> nat Un Hartog(z)}")] exI 1);
-by (resolve_tac [transfer thy Ord_nat RS well_ord_Memrel RS
- (Ord_Hartog RS
- well_ord_Memrel RSN (2, well_ord_Un)) RS exE] 1);
-by (fast_tac
- (claset() addSIs [Ord_Hartog, well_ord_Memrel, well_ord_paired,
- HartogI RSN (2, lepoll_trans1),
- subset_imp_lepoll RS (lepoll_paired RSN (2, lepoll_trans))]
- addSEs [nat_not_Finite RS notE] addEs [mem_asym]
- addSDs [Un_upper1 RS subset_imp_lepoll RS lepoll_Finite,
- lepoll_paired RS lepoll_Finite]) 1);
-val lemma2 = result();
-
-Goal "~Finite(B) ==> ~Finite(A Un B)";
-by (blast_tac (claset() addIs [subset_Finite]) 1);
-qed "infinite_Un";
-
-(* ********************************************************************** *)
-(* There is a v \\<in> s(u) such that k lepoll x Int y (in our case succ(k)) *)
-(* The idea of the proof is the following \\<in> *)
-(* Suppose not, i.e. every element of s(u) has exactly k-1 elements of y *)
-(* Thence y is less than or equipollent to {v \\<in> Pow(x). v eqpoll n#-k} *)
-(* We have obtained this result in two steps \\<in> *)
-(* 1. y is less than or equipollent to {v \\<in> s(u). a \\<subseteq> v} *)
-(* where a is certain k-2 element subset of y *)
-(* 2. {v \\<in> s(u). a \\<subseteq> v} is less than or equipollent *)
-(* to {v \\<in> Pow(x). v eqpoll n-k} *)
-(* ********************************************************************** *)
-
-(*Proof simplified by LCP*)
-Goal "[| ~(\\<exists>x \\<in> A. f`x=y); f \\<in> inj(A, B); y \\<in> B |] \
-\ ==> (\\<lambda>a \\<in> succ(A). if(a=A, y, f`a)) \\<in> inj(succ(A), B)";
-by (res_inst_tac [("d","%z. if(z=y, A, converse(f)`z)")] lam_injective 1);
-by (force_tac (claset(), simpset() addsimps [inj_is_fun RS apply_type]) 1);
-(*this preliminary simplification prevents looping somehow*)
-by (Asm_simp_tac 1);
-by (force_tac (claset(), simpset() addsimps []) 1);
-qed "succ_not_lepoll_lemma";
-
-Goalw [lepoll_def, eqpoll_def, bij_def, surj_def]
- "[| ~A eqpoll B; A lepoll B |] ==> succ(A) lepoll B";
-by (fast_tac (claset() addSEs [succ_not_lepoll_lemma, inj_is_fun]) 1);
-qed "succ_not_lepoll_imp_eqpoll";
-
-
-(* ********************************************************************** *)
-(* There is a k-2 element subset of y *)
-(* ********************************************************************** *)
-
-val ordertype_eqpoll =
- ordermap_bij RS (exI RS (eqpoll_def RS def_imp_iff RS iffD2));
-
-Goal "[| a \\<subseteq> y; b \\<in> y-a; u \\<in> x |] ==> cons(b, cons(u, a)) \\<in> Pow(x Un y)";
-by (Fast_tac 1);
-qed "cons_cons_subset";
-
-Goal "[| a eqpoll k; a \\<subseteq> y; b \\<in> y-a; u \\<in> x; x Int y = 0 |] \
-\ ==> cons(b, cons(u, a)) eqpoll succ(succ(k))";
-by (fast_tac (claset() addSIs [cons_eqpoll_succ]) 1);
-qed "cons_cons_eqpoll";
-
-Goal "[| succ(k) eqpoll A; k eqpoll B; B \\<subseteq> A; a \\<in> A-B; k \\<in> nat |] \
-\ ==> A = cons(a, B)";
-by (rtac equalityI 1);
-by (Fast_tac 2);
-by (resolve_tac [Diff_eq_0_iff RS iffD1] 1);
-by (rtac equals0I 1);
-by (dresolve_tac [eqpoll_sym RS eqpoll_imp_lepoll] 1);
-by (dresolve_tac [eqpoll_sym RS cons_eqpoll_succ] 1);
-by (Fast_tac 1);
-by (dtac cons_eqpoll_succ 1);
-by (Fast_tac 1);
-by (fast_tac
- (claset()
- addSEs [[eqpoll_sym RS eqpoll_imp_lepoll, subset_imp_lepoll] MRS
- (lepoll_trans RS lepoll_trans) RS succ_lepoll_natE]) 1);
-qed "set_eq_cons";
-
-Goal "[| cons(x,a) = cons(y,a); x\\<notin> a |] ==> x = y ";
-by (fast_tac (claset() addSEs [equalityE]) 1);
-qed "cons_eqE";
-
-Goal "A = B ==> A Int C = B Int C";
-by (Asm_simp_tac 1);
-qed "eq_imp_Int_eq";
-
-(* ********************************************************************** *)
-(* some arithmetic *)
-(* ********************************************************************** *)
-
-Goal "[| k \\<in> nat; m \\<in> nat |] ==> \
-\ \\<forall>A B. A eqpoll k #+ m & k lepoll B & B \\<subseteq> A --> A-B lepoll m";
-by (induct_tac "k" 1);
-by (asm_simp_tac (simpset() addsimps [add_0]) 1);
-by (fast_tac (claset() addIs [eqpoll_imp_lepoll RS
- (Diff_subset RS subset_imp_lepoll RS lepoll_trans)]) 1);
-by (REPEAT (resolve_tac [allI,impI] 1));
-by (resolve_tac [succ_lepoll_imp_not_empty RS not_emptyE] 1);
-by (Fast_tac 1);
-by (eres_inst_tac [("x","A - {xa}")] allE 1);
-by (eres_inst_tac [("x","B - {xa}")] allE 1);
-by (etac impE 1);
-by (asm_full_simp_tac (simpset() addsimps [add_succ]) 1);
-by (fast_tac (claset() addSIs [Diff_sing_eqpoll, lepoll_Diff_sing]) 1);
-by (res_inst_tac [("P","%z. z lepoll m")] subst 1 THEN (assume_tac 2));
-by (Fast_tac 1);
-qed "eqpoll_sum_imp_Diff_lepoll_lemma";
-
-Goal "[| A eqpoll succ(k #+ m); B \\<subseteq> A; succ(k) lepoll B; k \\<in> nat; m \\<in> nat |] \
-\ ==> A-B lepoll m";
-by (dresolve_tac [add_succ RS ssubst] 1);
-by (dresolve_tac [nat_succI RS eqpoll_sum_imp_Diff_lepoll_lemma] 1
- THEN (REPEAT (assume_tac 1)));
-by (Fast_tac 1);
-qed "eqpoll_sum_imp_Diff_lepoll";
-
-(* ********************************************************************** *)
-(* similar properties for eqpoll *)
-(* ********************************************************************** *)
-
-Goal "[| k \\<in> nat; m \\<in> nat |] ==> \
-\ \\<forall>A B. A eqpoll k #+ m & k eqpoll B & B \\<subseteq> A --> A-B eqpoll m";
-by (induct_tac "k" 1);
-by (fast_tac (claset() addSDs [eqpoll_sym RS eqpoll_imp_lepoll RS lepoll_0_is_0]
- addss (simpset() addsimps [add_0])) 1);
-by (REPEAT (resolve_tac [allI,impI] 1));
-by (resolve_tac [succ_lepoll_imp_not_empty RS not_emptyE] 1);
-by (fast_tac (claset() addSEs [eqpoll_imp_lepoll]) 1);
-by (eres_inst_tac [("x","A - {xa}")] allE 1);
-by (eres_inst_tac [("x","B - {xa}")] allE 1);
-by (etac impE 1);
-by (fast_tac (claset() addSIs [Diff_sing_eqpoll,
- eqpoll_sym RSN (2, Diff_sing_eqpoll) RS eqpoll_sym]
- addss (simpset() addsimps [add_succ])) 1);
-by (res_inst_tac [("P","%z. z eqpoll m")] subst 1 THEN (assume_tac 2));
-by (Fast_tac 1);
-qed "eqpoll_sum_imp_Diff_eqpoll_lemma";
-
-Goal "[| A eqpoll succ(k #+ m); B \\<subseteq> A; succ(k) eqpoll B; k \\<in> nat; m \\<in> nat |] \
-\ ==> A-B eqpoll m";
-by (dresolve_tac [add_succ RS ssubst] 1);
-by (dresolve_tac [nat_succI RS eqpoll_sum_imp_Diff_eqpoll_lemma] 1
- THEN (REPEAT (assume_tac 1)));
-by (Fast_tac 1);
-qed "eqpoll_sum_imp_Diff_eqpoll";
-
-
-(* ********************************************************************** *)
-(* LL can be well ordered *)
-(* ********************************************************************** *)
-
-Goal "{x \\<in> Pow(X). x lepoll 0} = {0}";
-by (fast_tac (claset() addSDs [lepoll_0_is_0] addSIs [lepoll_refl]) 1);
-qed "subsets_lepoll_0_eq_unit";
-
-Goal "n \\<in> nat ==> {z \\<in> Pow(y). z lepoll succ(n)} = \
-\ {z \\<in> Pow(y). z lepoll n} Un {z \\<in> Pow(y). z eqpoll succ(n)}";
-by (fast_tac (claset() addIs [le_refl, leI, le_imp_lepoll]
- addSDs [lepoll_succ_disj]
- addSEs [nat_into_Ord, lepoll_trans, eqpoll_imp_lepoll]) 1);
-qed "subsets_lepoll_succ";
-
-Goal "n \\<in> nat ==> {z \\<in> Pow(y). z lepoll n} Int {z \\<in> Pow(y). z eqpoll succ(n)} = 0";
-by (fast_tac (claset() addSEs [eqpoll_sym RS eqpoll_imp_lepoll
- RS lepoll_trans RS succ_lepoll_natE]
- addSIs [equals0I]) 1);
-qed "Int_empty";
-
-
-Open_locale "AC16";
-
-val all_ex = thm "all_ex";
-val disjoint = thm "disjoint";
-val includes = thm "includes";
-val WO_R = thm "WO_R";
-val k_def = thm "k_def";
-val lnat = thm "lnat";
-val mnat = thm "mnat";
-val mpos = thm "mpos";
-val Infinite = thm "Infinite";
-val noLepoll = thm "noLepoll";
-
-val LL_def = thm "LL_def";
-val MM_def = thm "MM_def";
-val GG_def = thm "GG_def";
-val s_def = thm "s_def";
-
-Addsimps [disjoint, WO_R, lnat, mnat, mpos, Infinite];
-AddSIs [disjoint, WO_R, lnat, mnat, mpos];
-
-Goalw [k_def] "k \\<in> nat";
-by Auto_tac;
-qed "knat";
-Addsimps [knat]; AddSIs [knat];
-
-AddSIs [Infinite]; (*if notI is removed!*)
-AddSEs [Infinite RS notE];
-
-AddEs [[disjoint, IntI] MRS (equals0D RS notE)];
-
-(*use k = succ(l) *)
-val includes_l = simplify (FOL_ss addsimps [k_def]) includes;
-val all_ex_l = simplify (FOL_ss addsimps [k_def]) all_ex;
-
-(* ********************************************************************** *)
-(* 1. y is less than or equipollent to {v \\<in> s(u). a \\<subseteq> v} *)
-(* where a is certain k-2 element subset of y *)
-(* ********************************************************************** *)
-
-Goal "[| l eqpoll a; a \\<subseteq> y |] ==> y - a eqpoll y";
-by (cut_facts_tac [WO_R, Infinite, lnat] 1);
-by (fast_tac (empty_cs addIs [lesspoll_trans1]
- addSIs [Card_cardinal, Diff_lesspoll_eqpoll_Card RS eqpoll_trans,
- Card_cardinal RS Card_is_Ord RS nat_le_infinite_Ord
- RS le_imp_lepoll]
- addSEs [well_ord_cardinal_eqpoll,
- well_ord_cardinal_eqpoll RS eqpoll_sym,
- eqpoll_sym RS eqpoll_imp_lepoll,
- n_lesspoll_nat RS lesspoll_trans2,
- well_ord_cardinal_eqpoll RS eqpoll_sym RS eqpoll_imp_lepoll
- RS lepoll_infinite]) 1);
-qed "Diff_Finite_eqpoll";
-
-Goalw [s_def] "s(u) \\<subseteq> t_n";
-by (Fast_tac 1);
-qed "s_subset";
-
-Goalw [s_def, succ_def, k_def]
- "[| w \\<in> t_n; cons(b,cons(u,a)) \\<subseteq> w; a \\<subseteq> y; b \\<in> y-a; l eqpoll a \
-\ |] ==> w \\<in> s(u)";
-by (fast_tac (claset() addDs [eqpoll_imp_lepoll RS cons_lepoll_cong]
- addSEs [subset_imp_lepoll RSN (2, lepoll_trans)]) 1);
-qed "sI";
-
-Goalw [s_def] "v \\<in> s(u) ==> u \\<in> v";
-by (Fast_tac 1);
-qed "in_s_imp_u_in";
-
-
-Goal "[| l eqpoll a; a \\<subseteq> y; b \\<in> y - a; u \\<in> x |] \
-\ ==> \\<exists>! c. c \\<in> s(u) & a \\<subseteq> c & b \\<in> c";
-by (rtac (all_ex_l RS ballE) 1);
-by (blast_tac (claset() delrules [PowI]
- addSIs [cons_cons_subset,
- eqpoll_sym RS cons_cons_eqpoll]) 2);
-by (etac ex1E 1);
-by (res_inst_tac [("a","w")] ex1I 1);
-by (blast_tac (claset() addIs [sI]) 1);
-by (etac allE 1);
-by (etac impE 1);
-by (assume_tac 2);
-by (fast_tac (claset() addSEs [s_subset RS subsetD, in_s_imp_u_in]) 1);
-qed "ex1_superset_a";
-
-Goal "[| \\<forall>v \\<in> s(u). succ(l) eqpoll v Int y; \
-\ l eqpoll a; a \\<subseteq> y; b \\<in> y - a; u \\<in> x |] \
-\ ==> (THE c. c \\<in> s(u) & a \\<subseteq> c & b \\<in> c) \
-\ Int y = cons(b, a)";
-by (forward_tac [ex1_superset_a RS theI] 1 THEN REPEAT (assume_tac 1));
-by (rtac set_eq_cons 1);
-by (REPEAT (Fast_tac 1));
-qed "the_eq_cons";
-
-Goal "[| \\<forall>v \\<in> s(u). succ(l) eqpoll v Int y; \
-\ l eqpoll a; a \\<subseteq> y; u \\<in> x |] \
-\ ==> y lepoll {v \\<in> s(u). a \\<subseteq> v}";
-by (resolve_tac [Diff_Finite_eqpoll RS eqpoll_sym RS
- eqpoll_imp_lepoll RS lepoll_trans] 1
- THEN REPEAT (Fast_tac 1));
-by (res_inst_tac
- [("f3", "\\<lambda>b \\<in> y-a. THE c. c \\<in> s(u) & a \\<subseteq> c & b \\<in> c")]
- (exI RS (lepoll_def RS def_imp_iff RS iffD2)) 1);
-by (simp_tac (simpset() addsimps [inj_def]) 1);
-by (rtac conjI 1);
-by (rtac lam_type 1);
-by (forward_tac [ex1_superset_a RS theI] 1 THEN REPEAT (Fast_tac 1));
-by (Asm_simp_tac 1);
-by (Clarify_tac 1);
-by (rtac cons_eqE 1);
-by (Fast_tac 2);
-by (dres_inst_tac [("A","THE c. ?P(c)"), ("C","y")] eq_imp_Int_eq 1);
-by (asm_full_simp_tac (simpset() addsimps [the_eq_cons]) 1);
-qed "y_lepoll_subset_s";
-
-
-(* ********************************************************************** *)
-(* back to the second part *)
-(* ********************************************************************** *)
-
-Goal "w \\<subseteq> x Un y ==> w Int (x - {u}) = w - cons(u, w Int y)";
-by (Fast_tac 1);
-qed "w_Int_eq_w_Diff";
-
-Goal "[| w \\<in> {v \\<in> s(u). a \\<subseteq> v}; \
-\ l eqpoll a; u \\<in> x; \
-\ \\<forall>v \\<in> s(u). succ(l) eqpoll v Int y \
-\ |] ==> w Int (x - {u}) eqpoll m";
-by (etac CollectE 1);
-by (stac w_Int_eq_w_Diff 1);
-by (fast_tac (claset() addSDs [s_subset RS subsetD,
- includes_l RS subsetD]) 1);
-by (fast_tac (claset() addSDs [bspec]
- addDs [s_subset RS subsetD, includes_l RS subsetD]
- addSEs [eqpoll_sym RS cons_eqpoll_succ RS eqpoll_sym, in_s_imp_u_in]
- addSIs [eqpoll_sum_imp_Diff_eqpoll]) 1);
-qed "w_Int_eqpoll_m";
-
-(* ********************************************************************** *)
-(* 2. {v \\<in> s(u). a \\<subseteq> v} is less than or equipollent *)
-(* to {v \\<in> Pow(x). v eqpoll n-k} *)
-(* ********************************************************************** *)
-
-Goal "x eqpoll m ==> x \\<noteq> 0";
-by (cut_facts_tac [mpos] 1);
-by (fast_tac (claset() addSEs [zero_lt_natE]
- addSDs [eqpoll_succ_imp_not_empty]) 1);
-qed "eqpoll_m_not_empty";
-
-Goal "[| z \\<in> xa Int (x - {u}); l eqpoll a; a \\<subseteq> y; u \\<in> x |] \
-\ ==> \\<exists>! w. w \\<in> t_n & cons(z, cons(u, a)) \\<subseteq> w";
-by (rtac (all_ex RS bspec) 1);
-by (rewtac k_def);
-by (fast_tac (claset() addSIs [cons_eqpoll_succ] addEs [eqpoll_sym]) 1);
-qed "cons_cons_in";
-
-Goal "[| \\<forall>v \\<in> s(u). succ(l) eqpoll v Int y; \
-\ a \\<subseteq> y; l eqpoll a; u \\<in> x |] \
-\ ==> {v \\<in> s(u). a \\<subseteq> v} lepoll {v \\<in> Pow(x). v eqpoll m}";
-by (res_inst_tac [("f3","\\<lambda>w \\<in> {v \\<in> s(u). a \\<subseteq> v}. w Int (x - {u})")]
- (exI RS (lepoll_def RS def_imp_iff RS iffD2)) 1);
-by (simp_tac (simpset() addsimps [inj_def]) 1);
-by (rtac conjI 1);
-by (rtac lam_type 1);
-by (rtac CollectI 1);
-by (Fast_tac 1);
-by (rtac w_Int_eqpoll_m 1 THEN REPEAT (assume_tac 1));
-by (REPEAT (resolve_tac [ballI, impI] 1));
-(** LEVEL 8 **)
-by (resolve_tac [w_Int_eqpoll_m RS eqpoll_m_not_empty RS not_emptyE] 1);
-by (EVERY (map Blast_tac [4,3,2,1]));
-by (dresolve_tac [equalityD1 RS subsetD] 1 THEN (assume_tac 1));
-by (ftac cons_cons_in 1 THEN REPEAT (assume_tac 1));
-by (etac ex1_two_eq 1);
-by (REPEAT (blast_tac
- (claset() addDs [s_subset RS subsetD, in_s_imp_u_in]) 1));
-qed "subset_s_lepoll_w";
-
-
-(* ********************************************************************** *)
-(* well_ord_subsets_lepoll_n *)
-(* ********************************************************************** *)
-
-Goal "n \\<in> nat ==> \\<exists>S. well_ord({z \\<in> Pow(y) . z eqpoll succ(n)}, S)";
-by (resolve_tac [WO_R RS well_ord_infinite_subsets_eqpoll_X
- RS (eqpoll_def RS def_imp_iff RS iffD1) RS exE] 1);
-by (REPEAT (fast_tac (claset() addIs [bij_is_inj RS well_ord_rvimage]) 1));
-qed "well_ord_subsets_eqpoll_n";
-
-Goal "n \\<in> nat ==> \\<exists>R. well_ord({z \\<in> Pow(y). z lepoll n}, R)";
-by (induct_tac "n" 1);
-by (force_tac (claset() addSIs [well_ord_unit],
- simpset() addsimps [subsets_lepoll_0_eq_unit]) 1);
-by (etac exE 1);
-by (resolve_tac [well_ord_subsets_eqpoll_n RS exE] 1 THEN assume_tac 1);
-by (asm_simp_tac (simpset() addsimps [subsets_lepoll_succ]) 1);
-by (dtac well_ord_radd 1 THEN (assume_tac 1));
-by (eresolve_tac [Int_empty RS disj_Un_eqpoll_sum RS
- (eqpoll_def RS def_imp_iff RS iffD1) RS exE] 1);
-by (fast_tac (claset() addSEs [bij_is_inj RS well_ord_rvimage]) 1);
-qed "well_ord_subsets_lepoll_n";
-
-
-Goalw [LL_def, MM_def] "LL \\<subseteq> {z \\<in> Pow(y). z lepoll succ(k #+ m)}";
-by (cut_facts_tac [includes] 1);
-by (fast_tac (claset() addIs [subset_imp_lepoll
- RS (eqpoll_imp_lepoll
- RSN (2, lepoll_trans))]) 1);
-qed "LL_subset";
-
-Goal "\\<exists>S. well_ord(LL,S)";
-by (rtac (well_ord_subsets_lepoll_n RS exE) 1);
-by (blast_tac (claset() addIs [LL_subset RSN (2, well_ord_subset)]) 2);
-by Auto_tac;
-qed "well_ord_LL";
-
-(* ********************************************************************** *)
-(* every element of LL is a contained in exactly one element of MM *)
-(* ********************************************************************** *)
-
-Goalw [MM_def, LL_def] "v \\<in> LL ==> \\<exists>! w. w \\<in> MM & v \\<subseteq> w";
-by Safe_tac;
-by (Fast_tac 1);
-by (resolve_tac [lepoll_imp_eqpoll_subset RS exE] 1 THEN (assume_tac 1));
-by (res_inst_tac [("x","x")] (all_ex RS ballE) 1);
-by (fast_tac (claset() addSEs [eqpoll_sym]) 2);
-by (Blast_tac 1);
-qed "unique_superset_in_MM";
-
-val unique_superset1 = unique_superset_in_MM RS theI RS conjunct1;
-val unique_superset2 = unique_superset_in_MM RS the_equality2;
-
-
-(* ********************************************************************** *)
-(* The function GG satisfies the conditions of WO4 *)
-(* ********************************************************************** *)
-
-(* ********************************************************************** *)
-(* The union of appropriate values is the whole x *)
-(* ********************************************************************** *)
-
-Goalw [LL_def] "w \\<in> MM ==> w Int y \\<in> LL";
-by (Fast_tac 1);
-qed "Int_in_LL";
-
-Goalw [LL_def]
- "v \\<in> LL ==> v = (THE x. x \\<in> MM & v \\<subseteq> x) Int y";
-by (Clarify_tac 1);
-by (stac unique_superset2 1);
-by (auto_tac (claset(), simpset() addsimps [Int_in_LL]));
-qed "in_LL_eq_Int";
-
-Goal "v \\<in> LL ==> (THE x. x \\<in> MM & v \\<subseteq> x) \\<subseteq> x Un y";
-by (dtac unique_superset1 1);
-by (rewtac MM_def);
-by (fast_tac (claset() addSDs [unique_superset1, includes RS subsetD]) 1);
-qed "the_in_MM_subset";
-
-Goalw [GG_def] "v \\<in> LL ==> GG ` v \\<subseteq> x";
-by (ftac the_in_MM_subset 1);
-by (ftac in_LL_eq_Int 1);
-by (force_tac (claset() addEs [equalityE], simpset()) 1);
-qed "GG_subset";
-
-
-Goal "n \\<in> nat ==> \\<exists>z. z \\<subseteq> y & n eqpoll z";
-by (etac nat_lepoll_imp_ex_eqpoll_n 1);
-by (resolve_tac [ordertype_eqpoll RS eqpoll_sym RS eqpoll_imp_lepoll
- RSN (2, lepoll_trans)] 1);
-by (rtac WO_R 2);
-by (fast_tac
- (claset() delrules [notI]
- addSIs [nat_le_infinite_Ord RS le_imp_lepoll]
- addIs [Ord_ordertype,
- ordertype_eqpoll RS eqpoll_imp_lepoll
- RS lepoll_infinite]) 1);
-qed "ex_subset_eqpoll_n";
-
-
-Goal "u \\<in> x ==> \\<exists>v \\<in> s(u). succ(k) lepoll v Int y";
-by (rtac ccontr 1);
-by (subgoal_tac "\\<forall>v \\<in> s(u). k eqpoll v Int y" 1);
-by (full_simp_tac (simpset() addsimps [s_def]) 2);
-by (blast_tac (claset() addIs [succ_not_lepoll_imp_eqpoll]) 2);
-by (rewtac k_def);
-by (cut_facts_tac [all_ex, includes, lnat] 1);
-by (rtac (ex_subset_eqpoll_n RS exE) 1 THEN assume_tac 1);
-by (rtac (noLepoll RS notE) 1);
-by (blast_tac (claset() addIs
- [[y_lepoll_subset_s, subset_s_lepoll_w] MRS lepoll_trans]) 1);
-qed "exists_proper_in_s";
-
-Goal "u \\<in> x ==> \\<exists>w \\<in> MM. u \\<in> w";
-by (eresolve_tac [exists_proper_in_s RS bexE] 1);
-by (rewrite_goals_tac [MM_def, s_def]);
-by (Fast_tac 1);
-qed "exists_in_MM";
-
-Goal "u \\<in> x ==> \\<exists>w \\<in> LL. u \\<in> GG`w";
-by (rtac (exists_in_MM RS bexE) 1);
-by (assume_tac 1);
-by (rtac bexI 1);
-by (etac Int_in_LL 2);
-by (rewtac GG_def);
-by (asm_simp_tac (simpset() addsimps [Int_in_LL]) 1);
-by (stac unique_superset2 1);
-by (REPEAT (fast_tac (claset() addSEs [Int_in_LL]) 1));
-qed "exists_in_LL";
-
-
-Goal "well_ord(LL,S) ==> \
-\ (\\<Union>b<ordertype(LL,S). GG ` (converse(ordermap(LL,S)) ` b)) = x";
-by (rtac equalityI 1);
-by (rtac subsetI 1);
-by (etac OUN_E 1);
-by (resolve_tac [GG_subset RS subsetD] 1);
-by (assume_tac 2);
-by (blast_tac (claset() addIs [ordermap_bij RS bij_converse_bij RS
- bij_is_fun RS apply_type, ltD]) 1);
-by (rtac subsetI 1);
-by (eresolve_tac [exists_in_LL RS bexE] 1);
-by (force_tac (claset() addIs [Ord_ordertype RSN (2, ltI),
- ordermap_type RS apply_type],
- simpset() addsimps [ordermap_bij RS bij_is_inj RS left_inverse]) 1);
-qed "OUN_eq_x";
-
-(* ********************************************************************** *)
-(* Every element of the family is less than or equipollent to n-k (m) *)
-(* ********************************************************************** *)
-
-Goalw [MM_def] "w \\<in> MM ==> w eqpoll succ(k #+ m)";
-by (fast_tac (claset() addDs [includes RS subsetD]) 1);
-qed "in_MM_eqpoll_n";
-
-Goalw [LL_def, MM_def] "w \\<in> LL ==> succ(k) lepoll w";
-by (Fast_tac 1);
-qed "in_LL_eqpoll_n";
-
-val in_LL = in_LL_eq_Int RS equalityD1 RS (Int_lower1 RSN (2, subset_trans));
-
-Goalw [GG_def]
- "well_ord(LL,S) ==> \
-\ \\<forall>b<ordertype(LL,S). GG ` (converse(ordermap(LL,S)) ` b) lepoll m";
-by (rtac oallI 1);
-by (asm_simp_tac
- (simpset() addsimps [ltD,
- ordermap_bij RS bij_converse_bij RS
- bij_is_fun RS apply_type]) 1);
-by (cut_facts_tac [includes] 1);
-by (rtac eqpoll_sum_imp_Diff_lepoll 1);
-by (REPEAT
- (fast_tac (claset() delrules [subsetI]
- addSDs [ltD]
- addSIs [eqpoll_sum_imp_Diff_lepoll, in_LL_eqpoll_n]
- addIs [unique_superset1 RS in_MM_eqpoll_n, in_LL,
- ordermap_bij RS bij_converse_bij RS
- bij_is_fun RS apply_type]) 1 ));
-qed "all_in_lepoll_m";
-
-
-Goal "\\<exists>a f. Ord(a) & domain(f) = a & \
-\ (\\<Union>b<a. f ` b) = x & (\\<forall>b<a. f ` b lepoll m)";
-by (resolve_tac [well_ord_LL RS exE] 1 THEN REPEAT (assume_tac 1));
-by (rename_tac "S" 1);
-by (res_inst_tac [("x","ordertype(LL,S)")] exI 1);
-by (res_inst_tac [("x",
- "\\<lambda>b \\<in> ordertype(LL,S). GG ` (converse(ordermap(LL,S)) ` b)")]
- exI 1);
-by (Simp_tac 1);
-by (REPEAT (ares_tac [conjI, lam_funtype RS domain_of_fun,
- Ord_ordertype,
- all_in_lepoll_m, OUN_eq_x] 1));
-qed "conclusion";
-
-Close_locale "AC16";
-
-
-
-(* ********************************************************************** *)
-(* The main theorem AC16(n, k) ==> WO4(n-k) *)
-(* ********************************************************************** *)
-
-Goalw [AC16_def,WO4_def]
- "[| AC16(k #+ m, k); 0 < k; 0 < m; k \\<in> nat; m \\<in> nat |] ==> WO4(m)";
-by (rtac allI 1);
-by (case_tac "Finite(A)" 1);
-by (rtac lemma1 1 THEN REPEAT (assume_tac 1));
-by (cut_facts_tac [lemma2] 1);
-by (REPEAT (eresolve_tac [exE, conjE] 1));
-by (eres_inst_tac [("x","A Un y")] allE 1);
-by (ftac infinite_Un 1 THEN (mp_tac 1));
-by (etac zero_lt_natE 1);
-by (assume_tac 1);
-by (Clarify_tac 1);
-by (DEPTH_SOLVE (ares_tac [export conclusion] 1));
-qed "AC16_WO4";
-
--- a/src/ZF/AC/AC16_WO4.thy Wed Jan 16 15:04:37 2002 +0100
+++ b/src/ZF/AC/AC16_WO4.thy Wed Jan 16 17:52:06 2002 +0100
@@ -2,40 +2,575 @@
ID: $Id$
Author: Krzysztof Grabczewski
-Tidied using locales by LCP
+The proof of AC16(n, k) ==> WO4(n-k)
+
+Tidied (using locales) by LCP
*)
-AC16_WO4 = OrderType + AC16_lemmas + Cardinal_aux +
+theory AC16_WO4 = AC16_lemmas:
+
+(* ********************************************************************** *)
+(* The case of finite set *)
+(* ********************************************************************** *)
+
+lemma lemma1:
+ "[| Finite(A); 0<m; m \<in> nat |]
+ ==> \<exists>a f. Ord(a) & domain(f) = a &
+ (\<Union>b<a. f`b) = A & (\<forall>b<a. f`b \<lesssim> m)"
+apply (unfold Finite_def)
+apply (erule bexE)
+apply (drule eqpoll_sym [THEN eqpoll_def [THEN def_imp_iff, THEN iffD1]])
+apply (erule exE)
+apply (rule_tac x = "n" in exI)
+apply (rule_tac x = "\<lambda>i \<in> n. {f`i}" in exI, simp)
+apply (unfold bij_def surj_def)
+apply (fast intro!: ltI nat_into_Ord lam_funtype [THEN domain_of_fun]
+ singleton_eqpoll_1 [THEN eqpoll_imp_lepoll, THEN lepoll_trans]
+ nat_1_lepoll_iff [THEN iffD2]
+ elim!: apply_type ltE)
+done
+
+(* ********************************************************************** *)
+(* The case of infinite set *)
+(* ********************************************************************** *)
+
+(* well_ord(x,r) ==> well_ord({{y,z}. y \<in> x}, Something(x,z)) **)
+lemmas well_ord_paired = paired_bij [THEN bij_is_inj, THEN well_ord_rvimage]
+
+lemma lepoll_trans1: "[| A \<lesssim> B; ~ A \<lesssim> C |] ==> ~ B \<lesssim> C"
+by (blast intro: lepoll_trans)
+
+(* ********************************************************************** *)
+(* There exists a well ordered set y such that ... *)
+(* ********************************************************************** *)
+
+lemmas lepoll_paired = paired_eqpoll [THEN eqpoll_sym, THEN eqpoll_imp_lepoll];
+
+lemma lemma2: "\<exists>y R. well_ord(y,R) & x Int y = 0 & ~y \<lesssim> z & ~Finite(y)"
+apply (rule_tac x = "{{a,x}. a \<in> nat Un Hartog (z) }" in exI)
+apply (rule well_ord_Un [OF Ord_nat [THEN well_ord_Memrel]
+ Ord_Hartog [THEN well_ord_Memrel], THEN exE])
+apply (blast intro!: Ord_Hartog well_ord_Memrel well_ord_paired
+ lepoll_trans1 [OF _ not_Hartog_lepoll_self]
+ lepoll_trans [OF subset_imp_lepoll lepoll_paired]
+ elim!: nat_not_Finite [THEN notE]
+ elim: mem_asym
+ dest!: Un_upper1 [THEN subset_imp_lepoll, THEN lepoll_Finite]
+ lepoll_paired [THEN lepoll_Finite])
+done
+
+lemma infinite_Un: "~Finite(B) ==> ~Finite(A Un B)"
+by (blast intro: subset_Finite)
+
+(* ********************************************************************** *)
+(* There is a v \<in> s(u) such that k \<lesssim> x Int y (in our case succ(k)) *)
+(* The idea of the proof is the following \<in> *)
+(* Suppose not, i.e. every element of s(u) has exactly k-1 elements of y *)
+(* Thence y is less than or equipollent to {v \<in> Pow(x). v \<approx> n#-k} *)
+(* We have obtained this result in two steps \<in> *)
+(* 1. y is less than or equipollent to {v \<in> s(u). a \<subseteq> v} *)
+(* where a is certain k-2 element subset of y *)
+(* 2. {v \<in> s(u). a \<subseteq> v} is less than or equipollent *)
+(* to {v \<in> Pow(x). v \<approx> n-k} *)
+(* ********************************************************************** *)
+
+(*Proof simplified by LCP*)
+lemma succ_not_lepoll_lemma:
+ "[| ~(\<exists>x \<in> A. f`x=y); f \<in> inj(A, B); y \<in> B |]
+ ==> (\<lambda>a \<in> succ(A). if(a=A, y, f`a)) \<in> inj(succ(A), B)"
+apply (rule_tac d = "%z. if (z=y, A, converse (f) `z) " in lam_injective)
+apply (force simp add: inj_is_fun [THEN apply_type])
+(*this preliminary simplification prevents looping somehow*)
+apply (simp (no_asm_simp))
+apply force
+done
+
+lemma succ_not_lepoll_imp_eqpoll: "[| ~A \<approx> B; A \<lesssim> B |] ==> succ(A) \<lesssim> B"
+apply (unfold lepoll_def eqpoll_def bij_def surj_def)
+apply (fast elim!: succ_not_lepoll_lemma inj_is_fun)
+done
+
+
+(* ********************************************************************** *)
+(* There is a k-2 element subset of y *)
+(* ********************************************************************** *)
+
+lemmas ordertype_eqpoll =
+ ordermap_bij [THEN exI [THEN eqpoll_def [THEN def_imp_iff, THEN iffD2]]]
+
+lemma cons_cons_subset:
+ "[| a \<subseteq> y; b \<in> y-a; u \<in> x |] ==> cons(b, cons(u, a)) \<in> Pow(x Un y)"
+by fast
+
+lemma cons_cons_eqpoll:
+ "[| a \<approx> k; a \<subseteq> y; b \<in> y-a; u \<in> x; x Int y = 0 |]
+ ==> cons(b, cons(u, a)) \<approx> succ(succ(k))"
+by (fast intro!: cons_eqpoll_succ)
+
+lemma set_eq_cons:
+ "[| succ(k) \<approx> A; k \<approx> B; B \<subseteq> A; a \<in> A-B; k \<in> nat |] ==> A = cons(a, B)"
+apply (rule equalityI)
+prefer 2 apply fast
+apply (rule Diff_eq_0_iff [THEN iffD1])
+apply (rule equals0I)
+apply (drule eqpoll_sym [THEN eqpoll_imp_lepoll])
+apply (drule eqpoll_sym [THEN cons_eqpoll_succ], fast)
+apply (drule cons_eqpoll_succ, fast)
+apply (fast elim!: lepoll_trans [THEN lepoll_trans, THEN succ_lepoll_natE,
+ OF eqpoll_sym [THEN eqpoll_imp_lepoll] subset_imp_lepoll])
+done
+
+lemma cons_eqE: "[| cons(x,a) = cons(y,a); x \<notin> a |] ==> x = y "
+by (fast elim!: equalityE)
+
+lemma eq_imp_Int_eq: "A = B ==> A Int C = B Int C"
+by blast
+
+(* ********************************************************************** *)
+(* some arithmetic *)
+(* ********************************************************************** *)
+
+lemma eqpoll_sum_imp_Diff_lepoll_lemma [rule_format]:
+ "[| k \<in> nat; m \<in> nat |]
+ ==> \<forall>A B. A \<approx> k #+ m & k \<lesssim> B & B \<subseteq> A --> A-B \<lesssim> m"
+apply (induct_tac "k")
+apply (simp add: add_0)
+apply (blast intro: eqpoll_imp_lepoll lepoll_trans
+ Diff_subset [THEN subset_imp_lepoll])
+apply (intro allI impI)
+apply (rule succ_lepoll_imp_not_empty [THEN not_emptyE], fast)
+apply (erule_tac x = "A - {xa}" in allE)
+apply (erule_tac x = "B - {xa}" in allE)
+apply (erule impE)
+apply (simp add: add_succ)
+apply (fast intro!: Diff_sing_eqpoll lepoll_Diff_sing)
+apply (subgoal_tac "A - {xa} - (B - {xa}) = A - B", simp);
+apply blast
+done
+
+lemma eqpoll_sum_imp_Diff_lepoll:
+ "[| A \<approx> succ(k #+ m); B \<subseteq> A; succ(k) \<lesssim> B; k \<in> nat; m \<in> nat |]
+ ==> A-B \<lesssim> m"
+apply (simp only: add_succ [symmetric])
+apply (blast intro: eqpoll_sum_imp_Diff_lepoll_lemma)
+done
+
+(* ********************************************************************** *)
+(* similar properties for \<approx> *)
+(* ********************************************************************** *)
+
+lemma eqpoll_sum_imp_Diff_eqpoll_lemma [rule_format]:
+ "[| k \<in> nat; m \<in> nat |]
+ ==> \<forall>A B. A \<approx> k #+ m & k \<approx> B & B \<subseteq> A --> A-B \<approx> m"
+apply (induct_tac "k")
+apply (force dest!: eqpoll_sym [THEN eqpoll_imp_lepoll, THEN lepoll_0_is_0])
+apply (intro allI impI)
+apply (rule succ_lepoll_imp_not_empty [THEN not_emptyE])
+apply (fast elim!: eqpoll_imp_lepoll)
+apply (erule_tac x = "A - {xa}" in allE)
+apply (erule_tac x = "B - {xa}" in allE)
+apply (erule impE)
+apply (force intro: eqpoll_sym intro!: Diff_sing_eqpoll)
+apply (subgoal_tac "A - {xa} - (B - {xa}) = A - B", simp);
+apply blast
+done
+
+lemma eqpoll_sum_imp_Diff_eqpoll:
+ "[| A \<approx> succ(k #+ m); B \<subseteq> A; succ(k) \<approx> B; k \<in> nat; m \<in> nat |]
+ ==> A-B \<approx> m"
+apply (simp only: add_succ [symmetric])
+apply (blast intro: eqpoll_sum_imp_Diff_eqpoll_lemma)
+done
+
+
+(* ********************************************************************** *)
+(* LL can be well ordered *)
+(* ********************************************************************** *)
+
+lemma subsets_lepoll_0_eq_unit: "{x \<in> Pow(X). x \<lesssim> 0} = {0}"
+by (fast dest!: lepoll_0_is_0 intro!: lepoll_refl)
+
+lemma subsets_lepoll_succ:
+ "n \<in> nat ==> {z \<in> Pow(y). z \<lesssim> succ(n)} =
+ {z \<in> Pow(y). z \<lesssim> n} Un {z \<in> Pow(y). z \<approx> succ(n)}"
+by (blast intro: leI le_imp_lepoll nat_into_Ord
+ lepoll_trans eqpoll_imp_lepoll
+ dest!: lepoll_succ_disj)
+
+lemma Int_empty:
+ "n \<in> nat ==> {z \<in> Pow(y). z \<lesssim> n} Int {z \<in> Pow(y). z \<approx> succ(n)} = 0"
+by (blast intro: eqpoll_sym [THEN eqpoll_imp_lepoll, THEN lepoll_trans]
+ succ_lepoll_natE)
+
locale AC16 =
- fixes
- x :: i
- y :: i
- k :: i
- l :: i
- m :: i
- t_n :: i
- R :: i
- MM :: i
- LL :: i
- GG :: i
- s :: i=>i
- assumes
- all_ex "\\<forall>z \\<in> {z \\<in> Pow(x Un y) . z eqpoll succ(k)}.
- \\<exists>! w. w \\<in> t_n & z \\<subseteq> w "
- disjoint "x Int y = 0"
- includes "t_n \\<subseteq> {v \\<in> Pow(x Un y). v eqpoll succ(k #+ m)}"
- WO_R "well_ord(y,R)"
- lnat "l \\<in> nat"
- mnat "m \\<in> nat"
- mpos "0<m"
- Infinite "~ Finite(y)"
- noLepoll "~ y lepoll {v \\<in> Pow(x). v eqpoll m}"
- defines
- k_def "k == succ(l)"
- MM_def "MM == {v \\<in> t_n. succ(k) lepoll v Int y}"
- LL_def "LL == {v Int y. v \\<in> MM}"
- GG_def "GG == \\<lambda>v \\<in> LL. (THE w. w \\<in> MM & v \\<subseteq> w) - v"
- s_def "s(u) == {v \\<in> t_n. u \\<in> v & k lepoll v Int y}"
+ fixes x and y and k and l and m and t_n and R and MM and LL and GG and s
+ defines k_def: "k == succ(l)"
+ and MM_def: "MM == {v \<in> t_n. succ(k) \<lesssim> v Int y}"
+ and LL_def: "LL == {v Int y. v \<in> MM}"
+ and GG_def: "GG == \<lambda>v \<in> LL. (THE w. w \<in> MM & v \<subseteq> w) - v"
+ and s_def: "s(u) == {v \<in> t_n. u \<in> v & k \<lesssim> v Int y}"
+ assumes all_ex: "\<forall>z \<in> {z \<in> Pow(x Un y) . z \<approx> succ(k)}.
+ \<exists>! w. w \<in> t_n & z \<subseteq> w "
+ and disjoint[iff]: "x Int y = 0"
+ and includes: "t_n \<subseteq> {v \<in> Pow(x Un y). v \<approx> succ(k #+ m)}"
+ and WO_R[iff]: "well_ord(y,R)"
+ and lnat[iff]: "l \<in> nat"
+ and mnat[iff]: "m \<in> nat"
+ and mpos[iff]: "0<m"
+ and Infinite[iff]: "~ Finite(y)"
+ and noLepoll: "~ y \<lesssim> {v \<in> Pow(x). v \<approx> m}"
+
+lemma (in AC16) knat [iff]: "k \<in> nat"
+by (simp add: k_def)
+
+
+(* ********************************************************************** *)
+(* 1. y is less than or equipollent to {v \<in> s(u). a \<subseteq> v} *)
+(* where a is certain k-2 element subset of y *)
+(* ********************************************************************** *)
+
+lemma (in AC16) Diff_Finite_eqpoll: "[| l \<approx> a; a \<subseteq> y |] ==> y - a \<approx> y"
+apply (insert WO_R Infinite lnat)
+apply (rule eqpoll_trans)
+apply (rule Diff_lesspoll_eqpoll_Card)
+apply (erule well_ord_cardinal_eqpoll [THEN eqpoll_sym])
+apply (blast intro: lesspoll_trans1
+ intro!: Card_cardinal
+ Card_cardinal [THEN Card_is_Ord, THEN nat_le_infinite_Ord,
+ THEN le_imp_lepoll]
+ dest: well_ord_cardinal_eqpoll
+ eqpoll_sym eqpoll_imp_lepoll
+ n_lesspoll_nat [THEN lesspoll_trans2]
+ well_ord_cardinal_eqpoll [THEN eqpoll_sym,
+ THEN eqpoll_imp_lepoll, THEN lepoll_infinite])+
+done
+
+
+lemma (in AC16) s_subset: "s(u) \<subseteq> t_n"
+by (unfold s_def, blast)
+
+lemma (in AC16) sI:
+ "[| w \<in> t_n; cons(b,cons(u,a)) \<subseteq> w; a \<subseteq> y; b \<in> y-a; l \<approx> a |]
+ ==> w \<in> s(u)"
+apply (unfold s_def succ_def k_def)
+apply (blast intro!: eqpoll_imp_lepoll [THEN cons_lepoll_cong]
+ intro: subset_imp_lepoll lepoll_trans)
+done
+
+lemma (in AC16) in_s_imp_u_in: "v \<in> s(u) ==> u \<in> v"
+by (unfold s_def, blast)
+
+
+lemma (in AC16) ex1_superset_a:
+ "[| l \<approx> a; a \<subseteq> y; b \<in> y - a; u \<in> x |]
+ ==> \<exists>! c. c \<in> s(u) & a \<subseteq> c & b \<in> c"
+apply (rule all_ex [simplified k_def, THEN ballE])
+ apply (erule ex1E)
+ apply (rule_tac a = "w" in ex1I, blast intro: sI)
+ apply (blast dest: s_subset [THEN subsetD] in_s_imp_u_in)
+apply (blast del: PowI
+ intro!: cons_cons_subset eqpoll_sym [THEN cons_cons_eqpoll])
+done
+
+lemma (in AC16) the_eq_cons:
+ "[| \<forall>v \<in> s(u). succ(l) \<approx> v Int y;
+ l \<approx> a; a \<subseteq> y; b \<in> y - a; u \<in> x |]
+ ==> (THE c. c \<in> s(u) & a \<subseteq> c & b \<in> c) Int y = cons(b, a)"
+apply (frule ex1_superset_a [THEN theI], assumption+)
+apply (rule set_eq_cons)
+apply (fast+)
+done
+
+lemma (in AC16) y_lepoll_subset_s:
+ "[| \<forall>v \<in> s(u). succ(l) \<approx> v Int y;
+ l \<approx> a; a \<subseteq> y; u \<in> x |]
+ ==> y \<lesssim> {v \<in> s(u). a \<subseteq> v}"
+apply (rule Diff_Finite_eqpoll [THEN eqpoll_sym, THEN eqpoll_imp_lepoll,
+ THEN lepoll_trans], fast+)
+apply (rule_tac f3 = "\<lambda>b \<in> y-a. THE c. c \<in> s (u) & a \<subseteq> c & b \<in> c"
+ in exI [THEN lepoll_def [THEN def_imp_iff, THEN iffD2]])
+apply (simp add: inj_def)
+apply (rule conjI)
+apply (rule lam_type)
+apply (frule ex1_superset_a [THEN theI], fast+, clarify)
+apply (rule cons_eqE [of _ a])
+apply (drule_tac A = "THE c. ?P (c) " and C = "y" in eq_imp_Int_eq)
+apply (simp_all add: the_eq_cons)
+done
+
+
+(* ********************************************************************** *)
+(* back to the second part *)
+(* ********************************************************************** *)
+
+
+(*relies on the disjointness of x, y*)
+lemma (in AC16) x_imp_not_y [dest]: "a \<in> x ==> a \<notin> y"
+by (blast dest: disjoint [THEN equalityD1, THEN subsetD, OF IntI])
+
+lemma (in AC16) w_Int_eq_w_Diff:
+ "w \<subseteq> x Un y ==> w Int (x - {u}) = w - cons(u, w Int y)"
+by blast
+
+lemma (in AC16) w_Int_eqpoll_m:
+ "[| w \<in> {v \<in> s(u). a \<subseteq> v};
+ l \<approx> a; u \<in> x;
+ \<forall>v \<in> s(u). succ(l) \<approx> v Int y |]
+ ==> w Int (x - {u}) \<approx> m"
+apply (erule CollectE)
+apply (subst w_Int_eq_w_Diff)
+apply (fast dest!: s_subset [THEN subsetD]
+ includes [simplified k_def, THEN subsetD])
+apply (blast dest: s_subset [THEN subsetD]
+ includes [simplified k_def, THEN subsetD]
+ dest: eqpoll_sym [THEN cons_eqpoll_succ, THEN eqpoll_sym]
+ in_s_imp_u_in
+ intro!: eqpoll_sum_imp_Diff_eqpoll)
+done
+
+
+(* ********************************************************************** *)
+(* 2. {v \<in> s(u). a \<subseteq> v} is less than or equipollent *)
+(* to {v \<in> Pow(x). v \<approx> n-k} *)
+(* ********************************************************************** *)
+
+lemma (in AC16) eqpoll_m_not_empty: "a \<approx> m ==> a \<noteq> 0"
+apply (insert mpos)
+apply (fast elim!: zero_lt_natE dest!: eqpoll_succ_imp_not_empty)
+done
+
+lemma (in AC16) cons_cons_in:
+ "[| z \<in> xa Int (x - {u}); l \<approx> a; a \<subseteq> y; u \<in> x |]
+ ==> \<exists>! w. w \<in> t_n & cons(z, cons(u, a)) \<subseteq> w"
+apply (rule all_ex [THEN bspec])
+apply (unfold k_def)
+apply (fast intro!: cons_eqpoll_succ elim: eqpoll_sym)
+done
+
+lemma (in AC16) subset_s_lepoll_w:
+ "[| \<forall>v \<in> s(u). succ(l) \<approx> v Int y; a \<subseteq> y; l \<approx> a; u \<in> x |]
+ ==> {v \<in> s(u). a \<subseteq> v} \<lesssim> {v \<in> Pow(x). v \<approx> m}"
+apply (rule_tac f3 = "\<lambda>w \<in> {v \<in> s (u) . a \<subseteq> v}. w Int (x - {u})"
+ in exI [THEN lepoll_def [THEN def_imp_iff, THEN iffD2]])
+apply (simp add: inj_def)
+apply (intro conjI lam_type CollectI)
+ apply fast
+ apply (blast intro: w_Int_eqpoll_m)
+apply (intro ballI impI)
+(** LEVEL 8 **)
+apply (rule w_Int_eqpoll_m [THEN eqpoll_m_not_empty, THEN not_emptyE])
+apply (blast, assumption+)
+apply (drule equalityD1 [THEN subsetD], (assumption))
+apply (frule cons_cons_in, assumption+)
+apply (blast dest: ex1_two_eq intro: s_subset [THEN subsetD] in_s_imp_u_in)+
+done
+
+
+(* ********************************************************************** *)
+(* well_ord_subsets_lepoll_n *)
+(* ********************************************************************** *)
+
+lemma (in AC16) well_ord_subsets_eqpoll_n:
+ "n \<in> nat ==> \<exists>S. well_ord({z \<in> Pow(y) . z \<approx> succ(n)}, S)"
+apply (rule WO_R [THEN well_ord_infinite_subsets_eqpoll_X,
+ THEN eqpoll_def [THEN def_imp_iff, THEN iffD1], THEN exE])
+apply (fast intro: bij_is_inj [THEN well_ord_rvimage])+
+done
+
+lemma (in AC16) well_ord_subsets_lepoll_n:
+ "n \<in> nat ==> \<exists>R. well_ord({z \<in> Pow(y). z \<lesssim> n}, R)"
+apply (induct_tac "n")
+apply (force intro!: well_ord_unit simp add: subsets_lepoll_0_eq_unit)
+apply (erule exE)
+apply (rule well_ord_subsets_eqpoll_n [THEN exE], assumption)
+apply (simp add: subsets_lepoll_succ)
+apply (drule well_ord_radd, (assumption))
+apply (erule Int_empty [THEN disj_Un_eqpoll_sum,
+ THEN eqpoll_def [THEN def_imp_iff, THEN iffD1], THEN exE])
+apply (fast elim!: bij_is_inj [THEN well_ord_rvimage])
+done
+
+
+lemma (in AC16) LL_subset: "LL \<subseteq> {z \<in> Pow(y). z \<lesssim> succ(k #+ m)}"
+apply (unfold LL_def MM_def)
+apply (insert includes)
+apply (blast intro: subset_imp_lepoll eqpoll_imp_lepoll lepoll_trans)
+done
+
+lemma (in AC16) well_ord_LL: "\<exists>S. well_ord(LL,S)"
+apply (rule well_ord_subsets_lepoll_n [THEN exE, of "succ(k#+m)"])
+apply simp
+apply (blast intro: well_ord_subset [OF _ LL_subset])
+done
+
+(* ********************************************************************** *)
+(* every element of LL is a contained in exactly one element of MM *)
+(* ********************************************************************** *)
+
+lemma (in AC16) unique_superset_in_MM:
+ "v \<in> LL ==> \<exists>! w. w \<in> MM & v \<subseteq> w"
+apply (unfold MM_def LL_def, safe)
+apply fast
+apply (rule lepoll_imp_eqpoll_subset [THEN exE], (assumption))
+apply (rule_tac x = "x" in all_ex [THEN ballE])
+apply (blast intro: eqpoll_sym)+
+done
+
+
+(* ********************************************************************** *)
+(* The function GG satisfies the conditions of WO4 *)
+(* ********************************************************************** *)
+
+(* ********************************************************************** *)
+(* The union of appropriate values is the whole x *)
+(* ********************************************************************** *)
+
+lemma (in AC16) Int_in_LL: "w \<in> MM ==> w Int y \<in> LL"
+by (unfold LL_def, fast)
+
+lemma (in AC16) in_LL_eq_Int:
+ "v \<in> LL ==> v = (THE x. x \<in> MM & v \<subseteq> x) Int y"
+apply (unfold LL_def, clarify)
+apply (subst unique_superset_in_MM [THEN the_equality2])
+apply (auto simp add: Int_in_LL)
+done
+
+lemma (in AC16) unique_superset1: "a \<in> LL \<Longrightarrow> (THE x. x \<in> MM \<and> a \<subseteq> x) \<in> MM"
+by (erule unique_superset_in_MM [THEN theI, THEN conjunct1]);
+
+lemma (in AC16) the_in_MM_subset:
+ "v \<in> LL ==> (THE x. x \<in> MM & v \<subseteq> x) \<subseteq> x Un y"
+apply (drule unique_superset1)
+apply (unfold MM_def)
+apply (fast dest!: unique_superset1 includes [THEN subsetD])
+done
+
+lemma (in AC16) GG_subset: "v \<in> LL ==> GG ` v \<subseteq> x"
+apply (unfold GG_def)
+apply (frule the_in_MM_subset)
+apply (frule in_LL_eq_Int)
+apply (force elim: equalityE)
+done
+
+lemma (in AC16) nat_lepoll_ordertype: "nat \<lesssim> ordertype(y, R)"
+apply (rule nat_le_infinite_Ord [THEN le_imp_lepoll])
+ apply (rule Ord_ordertype [OF WO_R])
+apply (rule ordertype_eqpoll [THEN eqpoll_imp_lepoll, THEN lepoll_infinite])
+ apply (rule WO_R)
+apply (rule Infinite)
+done
+
+lemma (in AC16) ex_subset_eqpoll_n: "n \<in> nat ==> \<exists>z. z \<subseteq> y & n \<approx> z"
+apply (erule nat_lepoll_imp_ex_eqpoll_n)
+apply (rule lepoll_trans [OF nat_lepoll_ordertype])
+apply (rule ordertype_eqpoll [THEN eqpoll_sym, THEN eqpoll_imp_lepoll])
+apply (rule WO_R)
+done
+
+
+lemma (in AC16) exists_proper_in_s: "u \<in> x ==> \<exists>v \<in> s(u). succ(k) \<lesssim> v Int y"
+apply (rule ccontr)
+apply (subgoal_tac "\<forall>v \<in> s (u) . k \<approx> v Int y")
+prefer 2 apply (simp add: s_def, blast intro: succ_not_lepoll_imp_eqpoll)
+apply (unfold k_def)
+apply (insert all_ex includes lnat)
+apply (rule ex_subset_eqpoll_n [THEN exE], assumption)
+apply (rule noLepoll [THEN notE])
+apply (blast intro: lepoll_trans [OF y_lepoll_subset_s subset_s_lepoll_w])
+done
+
+lemma (in AC16) exists_in_MM: "u \<in> x ==> \<exists>w \<in> MM. u \<in> w"
+apply (erule exists_proper_in_s [THEN bexE])
+apply (unfold MM_def s_def, fast)
+done
+
+lemma (in AC16) exists_in_LL: "u \<in> x ==> \<exists>w \<in> LL. u \<in> GG`w"
+apply (rule exists_in_MM [THEN bexE], assumption)
+apply (rule bexI)
+apply (erule_tac [2] Int_in_LL)
+apply (unfold GG_def)
+apply (simp add: Int_in_LL)
+apply (subst unique_superset_in_MM [THEN the_equality2])
+apply (fast elim!: Int_in_LL)+
+done
+
+lemma (in AC16) OUN_eq_x: "well_ord(LL,S) ==>
+ (\<Union>b<ordertype(LL,S). GG ` (converse(ordermap(LL,S)) ` b)) = x"
+apply (rule equalityI)
+apply (rule subsetI)
+apply (erule OUN_E)
+apply (rule GG_subset [THEN subsetD])
+prefer 2 apply assumption
+apply (blast intro: ltD ordermap_bij [THEN bij_converse_bij, THEN bij_is_fun,
+ THEN apply_type])
+apply (rule subsetI)
+apply (erule exists_in_LL [THEN bexE])
+apply (force intro: ltI [OF _ Ord_ordertype]
+ ordermap_type [THEN apply_type]
+ simp add: ordermap_bij [THEN bij_is_inj, THEN left_inverse])
+done
+
+(* ********************************************************************** *)
+(* Every element of the family is less than or equipollent to n-k (m) *)
+(* ********************************************************************** *)
+
+lemma (in AC16) in_MM_eqpoll_n: "w \<in> MM ==> w \<approx> succ(k #+ m)"
+apply (unfold MM_def)
+apply (fast dest: includes [THEN subsetD])
+done
+
+lemma (in AC16) in_LL_eqpoll_n: "w \<in> LL ==> succ(k) \<lesssim> w"
+by (unfold LL_def MM_def, fast)
+
+lemma (in AC16) in_LL: "w \<in> LL ==> w \<subseteq> (THE x. x \<in> MM \<and> w \<subseteq> x)"
+by (erule subset_trans [OF in_LL_eq_Int [THEN equalityD1] Int_lower1])
+
+lemma (in AC16) all_in_lepoll_m:
+ "well_ord(LL,S) ==>
+ \<forall>b<ordertype(LL,S). GG ` (converse(ordermap(LL,S)) ` b) \<lesssim> m"
+apply (unfold GG_def)
+apply (rule oallI)
+apply (simp add: ltD ordermap_bij [THEN bij_converse_bij, THEN bij_is_fun, THEN apply_type])
+apply (insert includes)
+apply (rule eqpoll_sum_imp_Diff_lepoll)
+apply (blast del: subsetI
+ dest!: ltD
+ intro!: eqpoll_sum_imp_Diff_lepoll in_LL_eqpoll_n
+ intro: in_LL unique_superset1 [THEN in_MM_eqpoll_n]
+ ordermap_bij [THEN bij_converse_bij, THEN bij_is_fun,
+ THEN apply_type])+
+done
+
+lemma (in AC16) conclusion:
+ "\<exists>a f. Ord(a) & domain(f) = a & (\<Union>b<a. f ` b) = x & (\<forall>b<a. f ` b \<lesssim> m)"
+apply (rule well_ord_LL [THEN exE])
+apply (rename_tac S)
+apply (rule_tac x = "ordertype (LL,S)" in exI)
+apply (rule_tac x = "\<lambda>b \<in> ordertype(LL,S).
+ GG ` (converse (ordermap (LL,S)) ` b)" in exI)
+apply simp
+apply (blast intro: lam_funtype [THEN domain_of_fun]
+ Ord_ordertype OUN_eq_x all_in_lepoll_m [THEN ospec])
+done
+
+
+(* ********************************************************************** *)
+(* The main theorem AC16(n, k) ==> WO4(n-k) *)
+(* ********************************************************************** *)
+
+theorem AC16_WO4:
+ "[| AC16(k #+ m, k); 0 < k; 0 < m; k \<in> nat; m \<in> nat |] ==> WO4(m)"
+apply (unfold AC16_def WO4_def)
+apply (rule allI)
+apply (case_tac "Finite (A)")
+apply (rule lemma1, assumption+)
+apply (cut_tac lemma2)
+apply (elim exE conjE)
+apply (erule_tac x = "A Un y" in allE)
+apply (frule infinite_Un, drule mp, assumption)
+apply (erule zero_lt_natE, assumption, clarify)
+apply (blast intro: AC16.conclusion)
+done
end
--- a/src/ZF/AC/AC16_lemmas.ML Wed Jan 16 15:04:37 2002 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,275 +0,0 @@
-(* Title: ZF/AC/AC16_lemmas.ML
- ID: $Id$
- Author: Krzysztof Grabczewski
-
-Lemmas used in the proofs concerning AC16
-*)
-
-Goal "a\\<notin>A ==> cons(a,A)-{a}=A";
-by (Fast_tac 1);
-qed "cons_Diff_eq";
-
-Goalw [lepoll_def] "1 lepoll X <-> (\\<exists>x. x \\<in> X)";
-by (rtac iffI 1);
-by (fast_tac (claset() addIs [inj_is_fun RS apply_type]) 1);
-by (etac exE 1);
-by (res_inst_tac [("x","\\<lambda>a \\<in> 1. x")] exI 1);
-by (fast_tac (claset() addSIs [lam_injective]) 1);
-qed "nat_1_lepoll_iff";
-
-Goal "X eqpoll 1 <-> (\\<exists>x. X={x})";
-by (rtac iffI 1);
-by (etac eqpollE 1);
-by (dresolve_tac [nat_1_lepoll_iff RS iffD1] 1);
-by (fast_tac (claset() addSIs [lepoll_1_is_sing]) 1);
-by (fast_tac (claset() addSIs [singleton_eqpoll_1]) 1);
-qed "eqpoll_1_iff_singleton";
-
-Goalw [succ_def] "[| x eqpoll n; y\\<notin>x |] ==> cons(y,x) eqpoll succ(n)";
-by (fast_tac (claset() addSEs [cons_eqpoll_cong, mem_irrefl]) 1);
-qed "cons_eqpoll_succ";
-
-Goal "{Y \\<in> Pow(X). Y eqpoll 1} = {{x}. x \\<in> X}";
-by (rtac equalityI 1);
-by (rtac subsetI 1);
-by (etac CollectE 1);
-by (dresolve_tac [eqpoll_1_iff_singleton RS iffD1] 1);
-by (fast_tac (claset() addSIs [RepFunI]) 1);
-by (rtac subsetI 1);
-by (etac RepFunE 1);
-by (rtac CollectI 1);
-by (Fast_tac 1);
-by (fast_tac (claset() addSIs [singleton_eqpoll_1]) 1);
-qed "subsets_eqpoll_1_eq";
-
-Goalw [eqpoll_def, bij_def] "X eqpoll {{x}. x \\<in> X}";
-by (res_inst_tac [("x","\\<lambda>x \\<in> X. {x}")] exI 1);
-by (rtac IntI 1);
-by (rewrite_goals_tac [inj_def, surj_def]);
-by (Asm_full_simp_tac 1);
-by (fast_tac (claset() addSIs [lam_type, RepFunI]
- addIs [singleton_eq_iff RS iffD1]) 1);
-by (Asm_full_simp_tac 1);
-by (fast_tac (claset() addSIs [lam_type]) 1);
-qed "eqpoll_RepFun_sing";
-
-Goal "{Y \\<in> Pow(X). Y eqpoll 1} eqpoll X";
-by (resolve_tac [subsets_eqpoll_1_eq RS ssubst] 1);
-by (resolve_tac [eqpoll_RepFun_sing RS eqpoll_sym] 1);
-qed "subsets_eqpoll_1_eqpoll";
-
-Goal "[| InfCard(x); y \\<in> Pow(x); y eqpoll succ(z) |] \
-\ ==> (LEAST i. i \\<in> y) \\<in> y";
-by (eresolve_tac [eqpoll_sym RS eqpoll_imp_lepoll RS
- succ_lepoll_imp_not_empty RS not_emptyE] 1);
-by (fast_tac (claset() addIs [LeastI]
- addSDs [InfCard_is_Card RS Card_is_Ord, PowD RS subsetD]
- addEs [Ord_in_Ord]) 1);
-qed "InfCard_Least_in";
-
-Goalw [lepoll_def] "[| InfCard(x); n \\<in> nat |] ==> \
-\ {y \\<in> Pow(x). y eqpoll succ(succ(n))} lepoll \
-\ x*{y \\<in> Pow(x). y eqpoll succ(n)}";
-by (res_inst_tac [("x","\\<lambda>y \\<in> {y \\<in> Pow(x). y eqpoll succ(succ(n))}. \
-\ <LEAST i. i \\<in> y, y-{LEAST i. i \\<in> y}>")] exI 1);
-by (res_inst_tac [("d","%z. cons(fst(z),snd(z))")] lam_injective 1);
-by (rtac SigmaI 1);
-by (etac CollectE 1);
-by (Asm_full_simp_tac 3);
-by (rtac equalityI 3);
-by (Fast_tac 4);
-by (rtac subsetI 3);
-by (etac consE 3);
-by (Fast_tac 4);
-by (rtac CollectI 2);
-by (Fast_tac 2);
-by (resolve_tac [PowD RS subsetD] 1 THEN (assume_tac 1));
-by (REPEAT (fast_tac (claset() addSIs [Diff_sing_eqpoll]
- addIs [InfCard_Least_in]) 1));
-qed "subsets_lepoll_lemma1";
-
-val prems = goal thy "(!!y. y \\<in> z ==> Ord(y)) ==> z \\<subseteq> succ(Union(z))";
-by (rtac subsetI 1);
-by (res_inst_tac [("Q","\\<forall>y \\<in> z. y \\<subseteq> x")] (excluded_middle RS disjE) 1);
-by (Fast_tac 2);
-by (etac swap 1);
-by (rtac ballI 1);
-by (rtac Ord_linear_le 1);
-by (dtac le_imp_subset 3 THEN (assume_tac 3));
-by (fast_tac (claset() addDs prems) 1);
-by (fast_tac (claset() addDs prems) 1);
-by (fast_tac (claset() addSEs [leE,ltE]) 1);
-qed "set_of_Ord_succ_Union";
-
-Goal "j \\<subseteq> i ==> i \\<notin> j";
-by (fast_tac (claset() addSEs [mem_irrefl]) 1);
-qed "subset_not_mem";
-
-val prems = goal thy "(!!y. y \\<in> z ==> Ord(y)) ==> succ(Union(z)) \\<notin> z";
-by (resolve_tac [set_of_Ord_succ_Union RS subset_not_mem] 1);
-by (eresolve_tac prems 1);
-qed "succ_Union_not_mem";
-
-Goal "Union(cons(succ(Union(z)),z)) = succ(Union(z))";
-by (Fast_tac 1);
-qed "Union_cons_eq_succ_Union";
-
-Goal "[| Ord(i); Ord(j) |] ==> i Un j = i | i Un j = j";
-by (fast_tac (claset() addSDs [le_imp_subset] addEs [Ord_linear_le]) 1);
-qed "Un_Ord_disj";
-
-Goal "x \\<in> X ==> Union(X) = x Un Union(X-{x})";
-by (Fast_tac 1);
-qed "Union_eq_Un";
-
-Goal "n \\<in> nat ==> \
-\ \\<forall>z. (\\<forall>y \\<in> z. Ord(y)) & z eqpoll n & z\\<noteq>0 --> Union(z) \\<in> z";
-by (induct_tac "n" 1);
-by (fast_tac (claset() addSDs [eqpoll_imp_lepoll RS lepoll_0_is_0]) 1);
-by (REPEAT (resolve_tac [allI, impI] 1));
-by (etac natE 1);
-by (fast_tac (claset() addSDs [eqpoll_1_iff_singleton RS iffD1]
- addSIs [Union_singleton]) 1);
-by (hyp_subst_tac 1);
-by (REPEAT (eresolve_tac [conjE, not_emptyE] 1));
-by (eres_inst_tac [("x","z-{xb}")] allE 1);
-by (etac impE 1);
-by (fast_tac (claset() addSEs [Diff_sing_eqpoll,
- Diff_sing_eqpoll RS eqpoll_succ_imp_not_empty]) 1);
-by (resolve_tac [Union_eq_Un RSN (2, subst_elem)] 1 THEN (assume_tac 2));
-by (ftac bspec 1 THEN (assume_tac 1));
-by (dresolve_tac [Diff_subset RS subsetD RSN (2, bspec)] 1 THEN (assume_tac 1));
-by (dtac Un_Ord_disj 1 THEN (assume_tac 1));
-by (etac DiffE 1);
-by (etac disjE 1);
-by (etac subst_elem 1 THEN (assume_tac 1));
-by (rtac subst_elem 1 THEN (TRYALL assume_tac));
-qed "Union_in_lemma";
-
-Goal "[| \\<forall>x \\<in> z. Ord(x); z eqpoll n; z\\<noteq>0; n \\<in> nat |] \
-\ ==> Union(z) \\<in> z";
-by (dtac Union_in_lemma 1);
-by (fast_tac FOL_cs 1);
-qed "Union_in";
-
-Goal "[| InfCard(x); z \\<in> Pow(x); z eqpoll n; n \\<in> nat |] \
-\ ==> succ(Union(z)) \\<in> x";
-by (resolve_tac [Limit_has_succ RS ltE] 1 THEN (assume_tac 3));
-by (etac InfCard_is_Limit 1);
-by (excluded_middle_tac "z=0" 1);
-by (fast_tac (claset() addSIs [InfCard_is_Limit RS Limit_has_0]
- addss (simpset())) 2);
-by (resolve_tac
- [PowD RS subsetD RS (InfCard_is_Card RS Card_is_Ord RSN (2, ltI))] 1
- THEN (TRYALL assume_tac));
-by (fast_tac (claset() addSIs [Union_in]
- addSEs [PowD RS subsetD RSN
- (2, InfCard_is_Card RS Card_is_Ord RS Ord_in_Ord)]) 1);
-qed "succ_Union_in_x";
-
-Goalw [lepoll_def] "[| InfCard(x); n \\<in> nat |] ==> \
-\ {y \\<in> Pow(x). y eqpoll succ(n)} lepoll \
-\ {y \\<in> Pow(x). y eqpoll succ(succ(n))}";
-by (res_inst_tac [("x","\\<lambda>z \\<in> {y \\<in> Pow(x). y eqpoll succ(n)}. \
-\ cons(succ(Union(z)), z)")] exI 1);
-by (res_inst_tac [("d","%z. z-{Union(z)}")] lam_injective 1);
-by (resolve_tac [Union_cons_eq_succ_Union RS ssubst] 2);
-by (rtac cons_Diff_eq 2);
-by (fast_tac (claset() addSDs [InfCard_is_Card RS Card_is_Ord]
- addEs [Ord_in_Ord] addSIs [succ_Union_not_mem]) 2);
-by (rtac CollectI 1);
-by (fast_tac (claset() addSEs [cons_eqpoll_succ]
- addSIs [succ_Union_not_mem]
- addSDs [InfCard_is_Card RS Card_is_Ord]
- addEs [Ord_in_Ord]) 2);
-by (fast_tac (claset() addSIs [succ_Union_in_x]) 1);
-qed "succ_lepoll_succ_succ";
-
-Goal "[| InfCard(X); n \\<in> nat |] \
-\ ==> {Y \\<in> Pow(X). Y eqpoll succ(n)} eqpoll X";
-by (induct_tac "n" 1);
-by (rtac subsets_eqpoll_1_eqpoll 1);
-by (rtac eqpollI 1);
-by (resolve_tac [subsets_lepoll_lemma1 RS lepoll_trans] 1
- THEN (REPEAT (assume_tac 1)));
-by (resolve_tac [InfCard_is_Card RS Card_is_Ord RS well_ord_Memrel RS
- well_ord_InfCard_square_eq RS eqpoll_imp_lepoll
- RSN (2, lepoll_trans)] 1 THEN (assume_tac 2));
-by (resolve_tac [InfCard_is_Card RS Card_cardinal_eq RS ssubst] 2
- THEN (REPEAT (assume_tac 2)));
-by (eresolve_tac [eqpoll_refl RS prod_eqpoll_cong RS eqpoll_imp_lepoll] 1);
-by (fast_tac (claset() addEs [eqpoll_sym RS eqpoll_imp_lepoll RS lepoll_trans]
- addSIs [succ_lepoll_succ_succ]) 1);
-qed "subsets_eqpoll_X";
-
-Goalw [surj_def] "[| f \\<in> surj(A,B); y \\<subseteq> B |] \
-\ ==> f``(converse(f)``y) = y";
-by (fast_tac (claset() addDs [apply_equality2]
- addEs [apply_iff RS iffD2]) 1);
-qed "image_vimage_eq";
-
-Goal "[| f \\<in> inj(A,B); y \\<subseteq> A |] ==> converse(f)``(f``y) = y";
-by (fast_tac (claset() addSEs [inj_is_fun RS apply_Pair]
- addDs [inj_equality]) 1);
-qed "vimage_image_eq";
-
-Goalw [eqpoll_def] "A eqpoll B \
-\ ==> {Y \\<in> Pow(A). Y eqpoll n} eqpoll {Y \\<in> Pow(B). Y eqpoll n}";
-by (etac exE 1);
-by (res_inst_tac [("x","\\<lambda>X \\<in> {Y \\<in> Pow(A). \\<exists>f. f \\<in> bij(Y, n)}. f``X")] exI 1);
-by (res_inst_tac [("d","%Z. converse(f)``Z")] lam_bijective 1);
-by (fast_tac (claset()
- addSIs [bij_is_inj RS restrict_bij RS bij_converse_bij RS comp_bij]
- addSEs [bij_is_fun RS fun_is_rel RS image_subset RS PowI]) 1);
-by (fast_tac (claset() addSIs [bij_converse_bij RS bij_is_inj RS restrict_bij
- RS bij_converse_bij RS comp_bij]
- addSEs [bij_converse_bij RS bij_is_fun RS fun_is_rel
- RS image_subset RS PowI]) 1);
-by (fast_tac (claset() addSEs [bij_is_inj RS vimage_image_eq]) 1);
-by (fast_tac (claset() addSEs [bij_is_surj RS image_vimage_eq]) 1);
-qed "subsets_eqpoll";
-
-Goalw [WO2_def] "WO2 ==> \\<exists>a. Card(a) & X eqpoll a";
-by (REPEAT (eresolve_tac [allE,exE,conjE] 1));
-by (fast_tac (claset() addSEs [well_ord_Memrel RS well_ord_cardinal_eqpoll RS
- (eqpoll_sym RSN (2, eqpoll_trans)) RS eqpoll_sym]
- addSIs [Card_cardinal]) 1);
-qed "WO2_imp_ex_Card";
-
-Goal "[| X lepoll Y; ~Finite(X) |] ==> ~Finite(Y)";
-by (fast_tac (empty_cs addEs [notE, lepoll_Finite] addSIs [notI]) 1);
-qed "lepoll_infinite";
-
-Goalw [InfCard_def] "[| ~Finite(X); Card(X) |] ==> InfCard(X)";
-by (fast_tac (claset() addSEs [Card_is_Ord RS nat_le_infinite_Ord]) 1);
-qed "infinite_Card_is_InfCard";
-
-Goal "[| WO2; n \\<in> nat; ~Finite(X) |] \
-\ ==> {Y \\<in> Pow(X). Y eqpoll succ(n)} eqpoll X";
-by (dtac WO2_imp_ex_Card 1);
-by (REPEAT (eresolve_tac [allE,exE,conjE] 1));
-by (forward_tac [eqpoll_imp_lepoll RS lepoll_infinite] 1 THEN (assume_tac 1));
-by (dtac infinite_Card_is_InfCard 1 THEN (assume_tac 1));
-by (resolve_tac [eqpoll_trans RS eqpoll_trans] 1);
-by (etac subsets_eqpoll 1);
-by (etac subsets_eqpoll_X 1 THEN (assume_tac 1));
-by (etac eqpoll_sym 1);
-qed "WO2_infinite_subsets_eqpoll_X";
-
-Goal "well_ord(X,R) ==> \\<exists>a. Card(a) & X eqpoll a";
-by (fast_tac (claset() addSEs [well_ord_cardinal_eqpoll RS eqpoll_sym]
- addSIs [Card_cardinal]) 1);
-qed "well_ord_imp_ex_Card";
-
-Goal "[| well_ord(X,R); n \\<in> nat; ~Finite(X) |] \
-\ ==> {Y \\<in> Pow(X). Y eqpoll succ(n)} eqpoll X";
-by (dtac well_ord_imp_ex_Card 1);
-by (REPEAT (eresolve_tac [allE,exE,conjE] 1));
-by (forward_tac [eqpoll_imp_lepoll RS lepoll_infinite] 1 THEN (assume_tac 1));
-by (dtac infinite_Card_is_InfCard 1 THEN (assume_tac 1));
-by (resolve_tac [eqpoll_trans RS eqpoll_trans] 1);
-by (etac subsets_eqpoll 1);
-by (etac subsets_eqpoll_X 1 THEN (assume_tac 1));
-by (etac eqpoll_sym 1);
-qed "well_ord_infinite_subsets_eqpoll_X";
-
--- a/src/ZF/AC/AC16_lemmas.thy Wed Jan 16 15:04:37 2002 +0100
+++ b/src/ZF/AC/AC16_lemmas.thy Wed Jan 16 17:52:06 2002 +0100
@@ -1,3 +1,244 @@
-(*Dummy theory to document dependencies *)
+(* Title: ZF/AC/AC16_lemmas.thy
+ ID: $Id$
+ Author: Krzysztof Grabczewski
+
+Lemmas used in the proofs concerning AC16
+*)
+
+theory AC16_lemmas = AC_Equiv + Hartog + Cardinal_aux:
+
+lemma cons_Diff_eq: "a\<notin>A ==> cons(a,A)-{a}=A"
+by fast
+
+lemma nat_1_lepoll_iff: "1\<lesssim>X <-> (\<exists>x. x \<in> X)"
+apply (unfold lepoll_def)
+apply (rule iffI)
+apply (fast intro: inj_is_fun [THEN apply_type])
+apply (erule exE)
+apply (rule_tac x = "\<lambda>a \<in> 1. x" in exI)
+apply (fast intro!: lam_injective)
+done
+
+lemma eqpoll_1_iff_singleton: "X\<approx>1 <-> (\<exists>x. X={x})"
+apply (rule iffI)
+apply (erule eqpollE)
+apply (drule nat_1_lepoll_iff [THEN iffD1])
+apply (fast intro!: lepoll_1_is_sing)
+apply (fast intro!: singleton_eqpoll_1)
+done
+
+lemma cons_eqpoll_succ: "[| x\<approx>n; y\<notin>x |] ==> cons(y,x)\<approx>succ(n)"
+apply (unfold succ_def)
+apply (fast elim!: cons_eqpoll_cong mem_irrefl)
+done
+
+lemma subsets_eqpoll_1_eq: "{Y \<in> Pow(X). Y\<approx>1} = {{x}. x \<in> X}"
+apply (rule equalityI)
+apply (rule subsetI)
+apply (erule CollectE)
+apply (drule eqpoll_1_iff_singleton [THEN iffD1])
+apply (fast intro!: RepFunI)
+apply (rule subsetI)
+apply (erule RepFunE)
+apply (rule CollectI)
+apply fast
+apply (fast intro!: singleton_eqpoll_1)
+done
+
+lemma eqpoll_RepFun_sing: "X\<approx>{{x}. x \<in> X}"
+apply (unfold eqpoll_def bij_def)
+apply (rule_tac x = "\<lambda>x \<in> X. {x}" in exI)
+apply (rule IntI)
+apply (unfold inj_def surj_def)
+apply simp
+apply (fast intro!: lam_type RepFunI intro: singleton_eq_iff [THEN iffD1])
+apply simp
+apply (fast intro!: lam_type)
+done
+
+lemma subsets_eqpoll_1_eqpoll: "{Y \<in> Pow(X). Y\<approx>1}\<approx>X"
+apply (rule subsets_eqpoll_1_eq [THEN ssubst])
+apply (rule eqpoll_RepFun_sing [THEN eqpoll_sym])
+done
+
+lemma InfCard_Least_in:
+ "[| InfCard(x); y \<subseteq> x; y \<approx> succ(z) |] ==> (LEAST i. i \<in> y) \<in> y"
+apply (erule eqpoll_sym [THEN eqpoll_imp_lepoll,
+ THEN succ_lepoll_imp_not_empty, THEN not_emptyE])
+apply (fast intro: LeastI
+ dest!: InfCard_is_Card [THEN Card_is_Ord]
+ elim: Ord_in_Ord)
+done
+
+lemma subsets_lepoll_lemma1:
+ "[| InfCard(x); n \<in> nat |]
+ ==> {y \<in> Pow(x). y\<approx>succ(succ(n))} \<lesssim> x*{y \<in> Pow(x). y\<approx>succ(n)}"
+apply (unfold lepoll_def)
+apply (rule_tac x = "\<lambda>y \<in> {y \<in> Pow(x) . y\<approx>succ (succ (n))}.
+ <LEAST i. i \<in> y, y-{LEAST i. i \<in> y}>" in exI)
+apply (rule_tac d = "%z. cons (fst(z), snd(z))" in lam_injective);
+ apply (blast intro!: Diff_sing_eqpoll intro: InfCard_Least_in);
+apply (simp, blast intro: InfCard_Least_in);
+done
+
+lemma set_of_Ord_succ_Union: "(\<forall>y \<in> z. Ord(y)) ==> z \<subseteq> succ(Union(z))"
+apply (rule subsetI)
+apply (case_tac "\<forall>y \<in> z. y \<subseteq> x", blast );
+apply (simp, erule bexE);
+apply (rule_tac i=xa and j=x in Ord_linear_le)
+apply (blast dest: le_imp_subset elim: leE ltE)+
+done
+
+lemma subset_not_mem: "j \<subseteq> i ==> i \<notin> j"
+by (fast elim!: mem_irrefl)
+
+lemma succ_Union_not_mem:
+ "(!!y. y \<in> z ==> Ord(y)) ==> succ(Union(z)) \<notin> z"
+apply (rule set_of_Ord_succ_Union [THEN subset_not_mem]);
+apply blast
+done
+
+lemma Union_cons_eq_succ_Union:
+ "Union(cons(succ(Union(z)),z)) = succ(Union(z))"
+by fast
+
+lemma Un_Ord_disj: "[| Ord(i); Ord(j) |] ==> i Un j = i | i Un j = j"
+by (fast dest!: le_imp_subset elim: Ord_linear_le)
+
+lemma Union_eq_Un: "x \<in> X ==> Union(X) = x Un Union(X-{x})"
+by fast
-AC16_lemmas = AC_Equiv + Hartog
+lemma Union_in_lemma [rule_format]:
+ "n \<in> nat ==> \<forall>z. (\<forall>y \<in> z. Ord(y)) & z\<approx>n & z\<noteq>0 --> Union(z) \<in> z"
+apply (induct_tac "n")
+apply (fast dest!: eqpoll_imp_lepoll [THEN lepoll_0_is_0])
+apply (intro allI impI)
+apply (erule natE)
+apply (fast dest!: eqpoll_1_iff_singleton [THEN iffD1]
+ intro!: Union_singleton)
+apply (clarify );
+apply (elim not_emptyE)
+apply (erule_tac x = "z-{xb}" in allE)
+apply (erule impE)
+apply (fast elim!: Diff_sing_eqpoll
+ Diff_sing_eqpoll [THEN eqpoll_succ_imp_not_empty])
+apply (subgoal_tac "xb \<union> \<Union>(z - {xb}) \<in> z");
+apply (simp add: Union_eq_Un [symmetric]);
+apply (frule bspec, assumption)
+apply (drule bspec);
+apply (erule Diff_subset [THEN subsetD]);
+apply (drule Un_Ord_disj, assumption)
+apply (auto );
+done
+
+lemma Union_in: "[| \<forall>x \<in> z. Ord(x); z\<approx>n; z\<noteq>0; n \<in> nat |] ==> Union(z) \<in> z"
+apply (blast intro: Union_in_lemma);
+done
+
+lemma succ_Union_in_x:
+ "[| InfCard(x); z \<in> Pow(x); z\<approx>n; n \<in> nat |] ==> succ(Union(z)) \<in> x"
+apply (rule Limit_has_succ [THEN ltE]);
+prefer 3 apply assumption
+apply (erule InfCard_is_Limit)
+apply (case_tac "z=0");
+apply (simp, fast intro!: InfCard_is_Limit [THEN Limit_has_0]);
+apply (rule ltI [OF PowD [THEN subsetD] InfCard_is_Card [THEN Card_is_Ord]]);
+apply assumption;
+apply (blast intro: Union_in
+ InfCard_is_Card [THEN Card_is_Ord, THEN Ord_in_Ord])+
+done
+
+lemma succ_lepoll_succ_succ:
+ "[| InfCard(x); n \<in> nat |]
+ ==> {y \<in> Pow(x). y\<approx>succ(n)} \<lesssim> {y \<in> Pow(x). y\<approx>succ(succ(n))}"
+apply (unfold lepoll_def);
+apply (rule_tac x = "\<lambda>z \<in> {y\<in>Pow(x). y\<approx>succ(n)}. cons(succ(Union(z)), z)"
+ in exI)
+apply (rule_tac d = "%z. z-{Union (z) }" in lam_injective)
+apply (blast intro!: succ_Union_in_x succ_Union_not_mem
+ intro: cons_eqpoll_succ Ord_in_Ord
+ dest!: InfCard_is_Card [THEN Card_is_Ord])
+apply (simp only: Union_cons_eq_succ_Union);
+apply (rule cons_Diff_eq);
+apply (fast dest!: InfCard_is_Card [THEN Card_is_Ord]
+ elim: Ord_in_Ord
+ intro!: succ_Union_not_mem);
+done
+
+lemma subsets_eqpoll_X:
+ "[| InfCard(X); n \<in> nat |] ==> {Y \<in> Pow(X). Y\<approx>succ(n)} \<approx> X"
+apply (induct_tac "n")
+apply (rule subsets_eqpoll_1_eqpoll)
+apply (rule eqpollI)
+apply (rule subsets_lepoll_lemma1 [THEN lepoll_trans], assumption+);
+apply (rule eqpoll_trans [THEN eqpoll_imp_lepoll]);
+ apply (erule eqpoll_refl [THEN prod_eqpoll_cong]);
+apply (erule InfCard_square_eqpoll)
+apply (fast elim: eqpoll_sym [THEN eqpoll_imp_lepoll, THEN lepoll_trans]
+ intro!: succ_lepoll_succ_succ)
+done
+
+lemma image_vimage_eq:
+ "[| f \<in> surj(A,B); y \<subseteq> B |] ==> f``(converse(f)``y) = y"
+apply (unfold surj_def)
+apply (fast dest: apply_equality2 elim: apply_iff [THEN iffD2])
+done
+
+lemma vimage_image_eq: "[| f \<in> inj(A,B); y \<subseteq> A |] ==> converse(f)``(f``y) = y"
+apply (fast elim!: inj_is_fun [THEN apply_Pair] dest: inj_equality)
+done
+
+lemma subsets_eqpoll:
+ "A\<approx>B ==> {Y \<in> Pow(A). Y\<approx>n}\<approx>{Y \<in> Pow(B). Y\<approx>n}"
+apply (unfold eqpoll_def)
+apply (erule exE)
+apply (rule_tac x = "\<lambda>X \<in> {Y \<in> Pow (A) . \<exists>f. f \<in> bij (Y, n) }. f``X" in exI)
+apply (rule_tac d = "%Z. converse (f) ``Z" in lam_bijective)
+apply (fast intro!: bij_is_inj [THEN restrict_bij, THEN bij_converse_bij,
+ THEN comp_bij]
+ elim!: bij_is_fun [THEN fun_is_rel, THEN image_subset])
+apply (blast intro!: bij_is_inj [THEN restrict_bij]
+ comp_bij bij_converse_bij
+ bij_is_fun [THEN fun_is_rel, THEN image_subset])
+apply (fast elim!: bij_is_inj [THEN vimage_image_eq])
+apply (fast elim!: bij_is_surj [THEN image_vimage_eq])
+done
+
+lemma WO2_imp_ex_Card: "WO2 ==> \<exists>a. Card(a) & X\<approx>a"
+apply (unfold WO2_def)
+apply (drule spec [of _ X])
+apply (blast intro: Card_cardinal eqpoll_trans
+ well_ord_Memrel [THEN well_ord_cardinal_eqpoll, THEN eqpoll_sym])
+done
+
+lemma lepoll_infinite: "[| X\<lesssim>Y; ~Finite(X) |] ==> ~Finite(Y)"
+by (blast intro: lepoll_Finite)
+
+lemma infinite_Card_is_InfCard: "[| ~Finite(X); Card(X) |] ==> InfCard(X)"
+apply (unfold InfCard_def)
+apply (fast elim!: Card_is_Ord [THEN nat_le_infinite_Ord])
+done
+
+lemma WO2_infinite_subsets_eqpoll_X: "[| WO2; n \<in> nat; ~Finite(X) |]
+ ==> {Y \<in> Pow(X). Y\<approx>succ(n)}\<approx>X"
+apply (drule WO2_imp_ex_Card)
+apply (elim allE exE conjE);
+apply (frule eqpoll_imp_lepoll [THEN lepoll_infinite], assumption)
+apply (drule infinite_Card_is_InfCard, assumption)
+apply (blast intro: subsets_eqpoll subsets_eqpoll_X eqpoll_sym eqpoll_trans);
+done
+
+lemma well_ord_imp_ex_Card: "well_ord(X,R) ==> \<exists>a. Card(a) & X\<approx>a"
+by (fast elim!: well_ord_cardinal_eqpoll [THEN eqpoll_sym]
+ intro!: Card_cardinal)
+
+lemma well_ord_infinite_subsets_eqpoll_X:
+ "[| well_ord(X,R); n \<in> nat; ~Finite(X) |] ==> {Y \<in> Pow(X). Y\<approx>succ(n)}\<approx>X"
+apply (drule well_ord_imp_ex_Card)
+apply (elim allE exE conjE)
+apply (frule eqpoll_imp_lepoll [THEN lepoll_infinite], assumption)
+apply (drule infinite_Card_is_InfCard, assumption)
+apply (blast intro: subsets_eqpoll subsets_eqpoll_X eqpoll_sym eqpoll_trans);
+done
+
+end
--- a/src/ZF/AC/AC17_AC1.ML Wed Jan 16 15:04:37 2002 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,310 +0,0 @@
-(* Title: ZF/AC/AC1_AC17.ML
- ID: $Id$
- Author: Krzysztof Grabczewski
-
-The equivalence of AC0, AC1 and AC17
-
-Also, the proofs needed to show that each of AC2, AC3, ..., AC6 is equivalent
-to AC0 and AC1.
-*)
-
-
-(** AC0 is equivalent to AC1.
- AC0 comes from Suppes, AC1 from Rubin & Rubin **)
-
-Goal "[| f:(\\<Pi>X \\<in> A. X); D \\<subseteq> A |] ==> \\<exists>g. g:(\\<Pi>X \\<in> D. X)";
-by (fast_tac (claset() addSIs [restrict_type, apply_type]) 1);
-val lemma1 = result();
-
-Goalw AC_defs "AC0 ==> AC1";
-by (blast_tac (claset() addIs [lemma1]) 1);
-qed "AC0_AC1";
-
-Goalw AC_defs "AC1 ==> AC0";
-by (Blast_tac 1);
-qed "AC1_AC0";
-
-
-(**** The proof of AC1 ==> AC17 ****)
-
-Goal "f \\<in> (\\<Pi>X \\<in> Pow(A) - {0}. X) ==> f \\<in> (Pow(A) - {0} -> A)";
-by (rtac Pi_type 1 THEN (assume_tac 1));
-by (dtac apply_type 1 THEN (assume_tac 1));
-by (Fast_tac 1);
-val lemma1 = result();
-
-Goalw AC_defs "AC1 ==> AC17";
-by (rtac allI 1);
-by (rtac ballI 1);
-by (eres_inst_tac [("x","Pow(A)-{0}")] allE 1);
-by (etac impE 1);
-by (Fast_tac 1);
-by (etac exE 1);
-by (rtac bexI 1);
-by (etac lemma1 2);
-by (rtac apply_type 1 THEN (assume_tac 1));
-by (fast_tac (claset() addSDs [lemma1] addSEs [apply_type]) 1);
-qed "AC1_AC17";
-
-
-(**** The proof of AC17 ==> AC1 ****)
-
-(* *********************************************************************** *)
-(* more properties of HH *)
-(* *********************************************************************** *)
-
-Goal "[| x - (\\<Union>j \\<in> LEAST i. HH(\\<lambda>X \\<in> Pow(x)-{0}. {f`X}, x, i) = {x}. \
-\ HH(\\<lambda>X \\<in> Pow(x)-{0}. {f`X}, x, j)) = 0; \
-\ f \\<in> Pow(x)-{0} -> x |] \
-\ ==> \\<exists>r. well_ord(x,r)";
-by (rtac exI 1);
-by (eresolve_tac [[bij_Least_HH_x RS bij_converse_bij RS bij_is_inj,
- Ord_Least RS well_ord_Memrel] MRS well_ord_rvimage] 1);
-by (assume_tac 1);
-qed "UN_eq_imp_well_ord";
-
-(* *********************************************************************** *)
-(* theorems closer to the proof *)
-(* *********************************************************************** *)
-
-Goalw AC_defs "~AC1 ==> \
-\ \\<exists>A. \\<forall>f \\<in> Pow(A)-{0} -> A. \\<exists>u \\<in> Pow(A)-{0}. f`u \\<notin> u";
-by (etac swap 1);
-by (rtac allI 1);
-by (etac swap 1);
-by (res_inst_tac [("x","Union(A)")] exI 1);
-by (rtac ballI 1);
-by (etac swap 1);
-by (rtac impI 1);
-by (fast_tac (claset() addSIs [restrict_type]) 1);
-qed "not_AC1_imp_ex";
-
-Goal "[| \\<forall>f \\<in> Pow(x) - {0} -> x. \\<exists>u \\<in> Pow(x) - {0}. f`u\\<notin>u; \
-\ \\<exists>f \\<in> Pow(x)-{0}->x. \
-\ x - (\\<Union>a \\<in> (LEAST i. HH(\\<lambda>X \\<in> Pow(x)-{0}. {f`X},x,i)={x}). \
-\ HH(\\<lambda>X \\<in> Pow(x)-{0}. {f`X},x,a)) = 0 |] \
-\ ==> P";
-by (etac bexE 1);
-by (eresolve_tac [UN_eq_imp_well_ord RS exE] 1 THEN (assume_tac 1));
-by (eresolve_tac [ex_choice_fun_Pow RS exE] 1);
-by (etac ballE 1);
-by (fast_tac (FOL_cs addEs [bexE, notE, apply_type]) 1);
-by (etac notE 1);
-by (rtac Pi_type 1 THEN (assume_tac 1));
-by (resolve_tac [apply_type RSN (2, subsetD)] 1 THEN TRYALL assume_tac);
-by (Fast_tac 1);
-val lemma1 = result();
-
-Goal "~ (\\<exists>f \\<in> Pow(x)-{0}->x. x - F(f) = 0) \
-\ ==> (\\<lambda>f \\<in> Pow(x)-{0}->x. x - F(f)) \
-\ \\<in> (Pow(x) -{0} -> x) -> Pow(x) - {0}";
-by (fast_tac (claset() addSIs [lam_type] addSDs [Diff_eq_0_iff RS iffD1]) 1);
-val lemma2 = result();
-
-Goal "[| f`Z \\<in> Z; Z \\<in> Pow(x)-{0} |] ==> \
-\ (\\<lambda>X \\<in> Pow(x)-{0}. {f`X})`Z \\<in> Pow(Z)-{0}";
-by Auto_tac;
-val lemma3 = result();
-
-Goal "\\<exists>f \\<in> F. f`((\\<lambda>f \\<in> F. Q(f))`f) \\<in> (\\<lambda>f \\<in> F. Q(f))`f \
-\ ==> \\<exists>f \\<in> F. f`Q(f) \\<in> Q(f)";
-by (Asm_full_simp_tac 1);
-val lemma4 = result();
-
-Goalw [AC17_def] "AC17 ==> AC1";
-by (rtac classical 1);
-by (eresolve_tac [not_AC1_imp_ex RS exE] 1);
-by (excluded_middle_tac
- "\\<exists>f \\<in> Pow(x)-{0}->x. \
-\ x - (\\<Union>a \\<in> (LEAST i. HH(\\<lambda>X \\<in> Pow(x)-{0}. {f`X},x,i)={x}). \
-\ HH(\\<lambda>X \\<in> Pow(x)-{0}. {f`X},x,a)) = 0" 1);
-by (etac lemma1 2 THEN (assume_tac 2));
-by (dtac lemma2 1);
-by (etac allE 1);
-by (dtac bspec 1 THEN (assume_tac 1));
-by (dtac lemma4 1);
-by (etac bexE 1);
-by (dtac apply_type 1 THEN (assume_tac 1));
-by (dresolve_tac [beta RS sym RSN (2, subst_elem)] 1);
-by (assume_tac 1);
-by (dtac lemma3 1 THEN (assume_tac 1));
-by (fast_tac (claset() addSDs [HH_Least_eq_x RS sym RSN (2, subst_elem),
- f_subset_imp_HH_subset] addSEs [mem_irrefl]) 1);
-qed "AC17_AC1";
-
-
-(* **********************************************************************
- AC1 ==> AC2 ==> AC1
- AC1 ==> AC4 ==> AC3 ==> AC1
- AC4 ==> AC5 ==> AC4
- AC1 <-> AC6
-************************************************************************* *)
-
-(* ********************************************************************** *)
-(* AC1 ==> AC2 *)
-(* ********************************************************************** *)
-
-Goal "[| f:(\\<Pi>X \\<in> A. X); B \\<in> A; 0\\<notin>A |] ==> {f`B} \\<subseteq> B Int {f`C. C \\<in> A}";
-by (fast_tac (claset() addSEs [apply_type]) 1);
-val lemma1 = result();
-
-Goalw [pairwise_disjoint_def]
- "[| pairwise_disjoint(A); B \\<in> A; C \\<in> A; D \\<in> B; D \\<in> C |] ==> f`B = f`C";
-by (Fast_tac 1);
-val lemma2 = result();
-
-Goalw AC_defs "AC1 ==> AC2";
-by (rtac allI 1);
-by (rtac impI 1);
-by (REPEAT (eresolve_tac [asm_rl,conjE,allE,exE,impE] 1));
-by (REPEAT (resolve_tac [exI,ballI,equalityI] 1));
-by (rtac lemma1 2 THEN (REPEAT (assume_tac 2)));
-by (fast_tac (claset() addSEs [lemma2] addEs [apply_type]) 1);
-qed "AC1_AC2";
-
-
-(* ********************************************************************** *)
-(* AC2 ==> AC1 *)
-(* ********************************************************************** *)
-
-Goal "0\\<notin>A ==> 0 \\<notin> {B*{B}. B \\<in> A}";
-by (fast_tac (claset() addSDs [sym RS (Sigma_empty_iff RS iffD1)]) 1);
-val lemma1 = result();
-
-Goal "[| X*{X} Int C = {y}; X \\<in> A |] \
-\ ==> (THE y. X*{X} Int C = {y}): X*A";
-by (rtac subst_elem 1);
-by (fast_tac (claset() addSIs [the_equality]
- addSEs [sym RS trans RS (singleton_eq_iff RS iffD1)]) 2);
-by (blast_tac (claset() addSEs [equalityE]) 1);
-val lemma2 = result();
-
-Goal "\\<forall>D \\<in> {E*{E}. E \\<in> A}. \\<exists>y. D Int C = {y} \
-\ ==> (\\<lambda>x \\<in> A. fst(THE z. (x*{x} Int C = {z}))) \\<in> (\\<Pi>X \\<in> A. X)";
-by (fast_tac (claset() addSEs [lemma2]
- addSIs [lam_type, RepFunI, fst_type]) 1);
-val lemma3 = result();
-
-Goalw (AC_defs@AC_aux_defs) "AC2 ==> AC1";
-by (REPEAT (resolve_tac [allI, impI] 1));
-by (REPEAT (eresolve_tac [allE, impE] 1));
-by (fast_tac (claset() addSEs [lemma3]) 2);
-by (fast_tac (claset() addSIs [lemma1, equals0I]) 1);
-qed "AC2_AC1";
-
-
-(* ********************************************************************** *)
-(* AC1 ==> AC4 *)
-(* ********************************************************************** *)
-
-Goal "0 \\<notin> {R``{x}. x \\<in> domain(R)}";
-by (Blast_tac 1);
-val lemma = result();
-
-Goalw AC_defs "AC1 ==> AC4";
-by (REPEAT (resolve_tac [allI, impI] 1));
-by (REPEAT (eresolve_tac [allE, lemma RSN (2, impE), exE] 1));
-by (best_tac (claset() addSIs [lam_type] addSEs [apply_type]) 1);
-qed "AC1_AC4";
-
-
-(* ********************************************************************** *)
-(* AC4 ==> AC3 *)
-(* ********************************************************************** *)
-
-Goal "f \\<in> A->B ==> (\\<Union>z \\<in> A. {z}*f`z) \\<subseteq> A*Union(B)";
-by (fast_tac (claset() addSDs [apply_type]) 1);
-val lemma1 = result();
-
-Goal "domain(\\<Union>z \\<in> A. {z}*f(z)) = {a \\<in> A. f(a)\\<noteq>0}";
-by (Blast_tac 1);
-val lemma2 = result();
-
-Goal "x \\<in> A ==> (\\<Union>z \\<in> A. {z}*f(z))``{x} = f(x)";
-by (Fast_tac 1);
-val lemma3 = result();
-
-Goalw AC_defs "AC4 ==> AC3";
-by (REPEAT (resolve_tac [allI,ballI] 1));
-by (REPEAT (eresolve_tac [allE,impE] 1));
-by (etac lemma1 1);
-by (asm_full_simp_tac (simpset() addsimps [lemma2, lemma3]
- addcongs [Pi_cong]) 1);
-qed "AC4_AC3";
-
-(* ********************************************************************** *)
-(* AC3 ==> AC1 *)
-(* ********************************************************************** *)
-
-Goal "b\\<notin>A ==> (\\<Pi>x \\<in> {a \\<in> A. id(A)`a\\<noteq>b}. id(A)`x) = (\\<Pi>x \\<in> A. x)";
-by (asm_full_simp_tac (simpset() addsimps [id_def] addcongs [Pi_cong]) 1);
-by (res_inst_tac [("b","A")] subst_context 1);
-by (Fast_tac 1);
-val lemma = result();
-
-Goalw AC_defs "AC3 ==> AC1";
-by (fast_tac (claset() addSIs [id_type] addEs [lemma RS subst]) 1);
-qed "AC3_AC1";
-
-(* ********************************************************************** *)
-(* AC4 ==> AC5 *)
-(* ********************************************************************** *)
-
-Goalw (range_def::AC_defs) "AC4 ==> AC5";
-by (REPEAT (resolve_tac [allI,ballI] 1));
-by (REPEAT (eresolve_tac [allE,impE] 1));
-by (eresolve_tac [fun_is_rel RS converse_type] 1);
-by (etac exE 1);
-by (rtac bexI 1);
-by (rtac Pi_type 2 THEN (assume_tac 2));
-by (fast_tac (claset() addSDs [apply_type]
- addSEs [fun_is_rel RS converse_type RS subsetD RS SigmaD2]) 2);
-by (rtac ballI 1);
-by (rtac apply_equality 1 THEN (assume_tac 2));
-by (etac domainE 1);
-by (ftac range_type 1 THEN (assume_tac 1));
-by (fast_tac (claset() addDs [apply_equality]) 1);
-qed "AC4_AC5";
-
-
-(* ********************************************************************** *)
-(* AC5 ==> AC4, Rubin & Rubin, p. 11 *)
-(* ********************************************************************** *)
-
-Goal "R \\<subseteq> A*B ==> (\\<lambda>x \\<in> R. fst(x)) \\<in> R -> A";
-by (fast_tac (claset() addSIs [lam_type, fst_type]) 1);
-val lemma1 = result();
-
-Goalw [range_def] "R \\<subseteq> A*B ==> range(\\<lambda>x \\<in> R. fst(x)) = domain(R)";
-by (force_tac (claset() addIs [lamI RS subst_elem] addSEs [lamE],
- simpset()) 1);
-val lemma2 = result();
-
-Goal "[| \\<exists>f \\<in> A->C. P(f,domain(f)); A=B |] ==> \\<exists>f \\<in> B->C. P(f,B)";
-by (etac bexE 1);
-by (ftac domain_of_fun 1);
-by (Fast_tac 1);
-val lemma3 = result();
-
-Goal "[| R \\<subseteq> A*B; g \\<in> C->R; \\<forall>x \\<in> C. (\\<lambda>z \\<in> R. fst(z))` (g`x) = x |] \
-\ ==> (\\<lambda>x \\<in> C. snd(g`x)): (\\<Pi>x \\<in> C. R``{x})";
-by (rtac lam_type 1);
-by (force_tac (claset() addDs [apply_type], simpset()) 1);
-val lemma4 = result();
-
-Goalw AC_defs "AC5 ==> AC4";
-by (Clarify_tac 1);
-by (REPEAT (eresolve_tac [allE,ballE] 1));
-by (eresolve_tac [lemma1 RSN (2, notE)] 2 THEN (assume_tac 2));
-by (dresolve_tac [lemma2 RSN (2, lemma3)] 1 THEN (assume_tac 1));
-by (fast_tac (claset() addSEs [lemma4]) 1);
-qed "AC5_AC4";
-
-
-(* ********************************************************************** *)
-(* AC1 <-> AC6 *)
-(* ********************************************************************** *)
-
-Goalw AC_defs "AC1 <-> AC6";
-by (Blast_tac 1);
-qed "AC1_iff_AC6";
--- a/src/ZF/AC/AC17_AC1.thy Wed Jan 16 15:04:37 2002 +0100
+++ b/src/ZF/AC/AC17_AC1.thy Wed Jan 16 17:52:06 2002 +0100
@@ -1,3 +1,300 @@
-(*Dummy theory to document dependencies *)
+(* Title: ZF/AC/AC1_AC17.thy
+ ID: $Id$
+ Author: Krzysztof Grabczewski
+
+The equivalence of AC0, AC1 and AC17
+
+Also, the proofs needed to show that each of AC2, AC3, ..., AC6 is equivalent
+to AC0 and AC1.
+*)
+
+theory AC17_AC1 = HH:
+
+
+(** AC0 is equivalent to AC1.
+ AC0 comes from Suppes, AC1 from Rubin & Rubin **)
+
+lemma AC0_AC1_lemma: "[| f:(\<Pi>X \<in> A. X); D \<subseteq> A |] ==> \<exists>g. g:(\<Pi>X \<in> D. X)"
+by (fast intro!: restrict_type apply_type)
+
+lemma AC0_AC1: "AC0 ==> AC1"
+apply (unfold AC0_def AC1_def)
+apply (blast intro: AC0_AC1_lemma)
+done
+
+lemma AC1_AC0: "AC1 ==> AC0"
+by (unfold AC0_def AC1_def, blast)
+
+
+(**** The proof of AC1 ==> AC17 ****)
+
+lemma AC1_AC17_lemma: "f \<in> (\<Pi>X \<in> Pow(A) - {0}. X) ==> f \<in> (Pow(A) - {0} -> A)"
+apply (rule Pi_type, assumption)
+apply (drule apply_type, assumption, fast)
+done
+
+lemma AC1_AC17: "AC1 ==> AC17"
+apply (unfold AC1_def AC17_def)
+apply (rule allI)
+apply (rule ballI)
+apply (erule_tac x = "Pow (A) -{0}" in allE)
+apply (erule impE, fast)
+apply (erule exE)
+apply (rule bexI)
+apply (erule_tac [2] AC1_AC17_lemma)
+apply (rule apply_type, assumption)
+apply (fast dest!: AC1_AC17_lemma elim!: apply_type)
+done
+
+
+(**** The proof of AC17 ==> AC1 ****)
+
+(* *********************************************************************** *)
+(* more properties of HH *)
+(* *********************************************************************** *)
+
+lemma UN_eq_imp_well_ord:
+ "[| x - (\<Union>j \<in> LEAST i. HH(\<lambda>X \<in> Pow(x)-{0}. {f`X}, x, i) = {x}.
+ HH(\<lambda>X \<in> Pow(x)-{0}. {f`X}, x, j)) = 0;
+ f \<in> Pow(x)-{0} -> x |]
+ ==> \<exists>r. well_ord(x,r)"
+apply (rule exI)
+apply (erule well_ord_rvimage
+ [OF bij_Least_HH_x [THEN bij_converse_bij, THEN bij_is_inj]
+ Ord_Least [THEN well_ord_Memrel]], assumption)
+done
+
+(* *********************************************************************** *)
+(* theorems closer to the proof *)
+(* *********************************************************************** *)
+
+lemma not_AC1_imp_ex:
+ "~AC1 ==> \<exists>A. \<forall>f \<in> Pow(A)-{0} -> A. \<exists>u \<in> Pow(A)-{0}. f`u \<notin> u"
+apply (unfold AC1_def)
+apply (erule swap)
+apply (rule allI)
+apply (erule swap)
+apply (rule_tac x = "Union (A)" in exI)
+apply (blast intro: restrict_type)
+done
+
+lemma lemma1:
+ "[| \<forall>f \<in> Pow(x) - {0} -> x. \<exists>u \<in> Pow(x) - {0}. f`u\<notin>u;
+ \<exists>f \<in> Pow(x)-{0}->x.
+ x - (\<Union>a \<in> (LEAST i. HH(\<lambda>X \<in> Pow(x)-{0}. {f`X},x,i)={x}).
+ HH(\<lambda>X \<in> Pow(x)-{0}. {f`X},x,a)) = 0 |]
+ ==> P"
+apply (erule bexE)
+apply (erule UN_eq_imp_well_ord [THEN exE], assumption)
+apply (erule ex_choice_fun_Pow [THEN exE])
+apply (erule ballE)
+apply (fast intro: apply_type del: DiffE)
+apply (erule notE)
+apply (rule Pi_type, assumption)
+apply (blast dest: apply_type)
+done
+
+lemma lemma2:
+ "~ (\<exists>f \<in> Pow(x)-{0}->x. x - F(f) = 0)
+ ==> (\<lambda>f \<in> Pow(x)-{0}->x . x - F(f))
+ \<in> (Pow(x) -{0} -> x) -> Pow(x) - {0}"
+by (fast intro!: lam_type dest!: Diff_eq_0_iff [THEN iffD1])
+
+lemma lemma3:
+ "[| f`Z \<in> Z; Z \<in> Pow(x)-{0} |]
+ ==> (\<lambda>X \<in> Pow(x)-{0}. {f`X})`Z \<in> Pow(Z)-{0}"
+by auto
+
+lemma lemma4:
+ "\<exists>f \<in> F. f`((\<lambda>f \<in> F. Q(f))`f) \<in> (\<lambda>f \<in> F. Q(f))`f
+ ==> \<exists>f \<in> F. f`Q(f) \<in> Q(f)"
+by simp
+
+lemma AC17_AC1: "AC17 ==> AC1"
+apply (unfold AC17_def)
+apply (rule classical)
+apply (erule not_AC1_imp_ex [THEN exE])
+apply (case_tac
+ "\<exists>f \<in> Pow(x)-{0} -> x.
+ x - (\<Union>a \<in> (LEAST i. HH (\<lambda>X \<in> Pow (x) -{0}. {f`X},x,i) ={x}) . HH (\<lambda>X \<in> Pow (x) -{0}. {f`X},x,a)) = 0")
+apply (erule lemma1, assumption)
+apply (drule lemma2)
+apply (erule allE)
+apply (drule bspec, assumption)
+apply (drule lemma4)
+apply (erule bexE)
+apply (drule apply_type, assumption)
+apply (simp add: HH_Least_eq_x del: Diff_iff )
+apply (drule lemma3, assumption)
+apply (fast dest!: subst_elem [OF _ HH_Least_eq_x [symmetric]]
+ f_subset_imp_HH_subset elim!: mem_irrefl)
+done
+
+
+(* **********************************************************************
+ AC1 ==> AC2 ==> AC1
+ AC1 ==> AC4 ==> AC3 ==> AC1
+ AC4 ==> AC5 ==> AC4
+ AC1 <-> AC6
+************************************************************************* *)
+
+(* ********************************************************************** *)
+(* AC1 ==> AC2 *)
+(* ********************************************************************** *)
+
+lemma lemma1:
+ "[| f:(\<Pi>X \<in> A. X); B \<in> A; 0\<notin>A |] ==> {f`B} \<subseteq> B Int {f`C. C \<in> A}"
+by (fast elim!: apply_type)
-AC17_AC1 = HH
+lemma lemma2:
+ "[| pairwise_disjoint(A); B \<in> A; C \<in> A; D \<in> B; D \<in> C |] ==> f`B = f`C"
+by (unfold pairwise_disjoint_def, fast)
+
+lemma AC1_AC2: "AC1 ==> AC2"
+apply (unfold AC1_def AC2_def)
+apply (rule allI)
+apply (rule impI)
+apply (elim asm_rl conjE allE exE impE, assumption)
+apply (intro exI ballI equalityI)
+prefer 2 apply (rule lemma1, assumption+)
+apply (fast elim!: lemma2 elim: apply_type)
+done
+
+
+(* ********************************************************************** *)
+(* AC2 ==> AC1 *)
+(* ********************************************************************** *)
+
+lemma lemma1: "0\<notin>A ==> 0 \<notin> {B*{B}. B \<in> A}"
+by (fast dest!: sym [THEN Sigma_empty_iff [THEN iffD1]])
+
+lemma lemma2: "[| X*{X} Int C = {y}; X \<in> A |]
+ ==> (THE y. X*{X} Int C = {y}): X*A"
+apply (rule subst_elem [of y])
+apply (blast elim!: equalityE)
+apply (auto simp add: singleton_eq_iff)
+done
+
+lemma lemma3:
+ "\<forall>D \<in> {E*{E}. E \<in> A}. \<exists>y. D Int C = {y}
+ ==> (\<lambda>x \<in> A. fst(THE z. (x*{x} Int C = {z}))) \<in> (\<Pi>X \<in> A. X)"
+apply (rule lam_type)
+apply (drule bspec, blast)
+apply (blast intro: lemma2 fst_type)
+done
+
+lemma AC2_AC1: "AC2 ==> AC1"
+apply (unfold AC1_def AC2_def pairwise_disjoint_def)
+apply (intro allI impI)
+apply (elim allE impE)
+prefer 2 apply (fast elim!: lemma3)
+apply (blast intro!: lemma1)
+done
+
+
+(* ********************************************************************** *)
+(* AC1 ==> AC4 *)
+(* ********************************************************************** *)
+
+lemma empty_notin_images: "0 \<notin> {R``{x}. x \<in> domain(R)}"
+by blast
+
+lemma AC1_AC4: "AC1 ==> AC4"
+apply (unfold AC1_def AC4_def)
+apply (intro allI impI)
+apply (drule spec, drule mp [OF _ empty_notin_images])
+apply (best intro!: lam_type elim!: apply_type)
+done
+
+
+(* ********************************************************************** *)
+(* AC4 ==> AC3 *)
+(* ********************************************************************** *)
+
+lemma lemma1: "f \<in> A->B ==> (\<Union>z \<in> A. {z}*f`z) \<subseteq> A*Union(B)"
+by (fast dest!: apply_type)
+
+lemma lemma2: "domain(\<Union>z \<in> A. {z}*f(z)) = {a \<in> A. f(a)\<noteq>0}"
+by blast
+
+lemma lemma3: "x \<in> A ==> (\<Union>z \<in> A. {z}*f(z))``{x} = f(x)"
+by fast
+
+lemma AC4_AC3: "AC4 ==> AC3"
+apply (unfold AC3_def AC4_def)
+apply (intro allI ballI)
+apply (elim allE impE)
+apply (erule lemma1)
+apply (simp add: lemma2 lemma3 cong add: Pi_cong)
+done
+
+(* ********************************************************************** *)
+(* AC3 ==> AC1 *)
+(* ********************************************************************** *)
+
+lemma AC3_AC1_lemma:
+ "b\<notin>A ==> (\<Pi>x \<in> {a \<in> A. id(A)`a\<noteq>b}. id(A)`x) = (\<Pi>x \<in> A. x)"
+apply (simp add: id_def cong add: Pi_cong)
+apply (rule_tac b = "A" in subst_context, fast)
+done
+
+lemma AC3_AC1: "AC3 ==> AC1"
+apply (unfold AC1_def AC3_def)
+apply (fast intro!: id_type elim: AC3_AC1_lemma [THEN subst])
+done
+
+(* ********************************************************************** *)
+(* AC4 ==> AC5 *)
+(* ********************************************************************** *)
+
+lemma AC4_AC5: "AC4 ==> AC5"
+apply (unfold range_def AC4_def AC5_def)
+apply (intro allI ballI)
+apply (elim allE impE)
+apply (erule fun_is_rel [THEN converse_type])
+apply (erule exE)
+apply (rename_tac g)
+apply (rule_tac x=g in bexI)
+apply (blast dest: apply_equality range_type)
+apply (blast intro: Pi_type dest: apply_type fun_is_rel)
+done
+
+
+(* ********************************************************************** *)
+(* AC5 ==> AC4, Rubin & Rubin, p. 11 *)
+(* ********************************************************************** *)
+
+lemma lemma1: "R \<subseteq> A*B ==> (\<lambda>x \<in> R. fst(x)) \<in> R -> A"
+by (fast intro!: lam_type fst_type)
+
+lemma lemma2: "R \<subseteq> A*B ==> range(\<lambda>x \<in> R. fst(x)) = domain(R)"
+by (unfold lam_def, force)
+
+lemma lemma3: "[| \<exists>f \<in> A->C. P(f,domain(f)); A=B |] ==> \<exists>f \<in> B->C. P(f,B)"
+apply (erule bexE)
+apply (frule domain_of_fun, fast)
+done
+
+lemma lemma4: "[| R \<subseteq> A*B; g \<in> C->R; \<forall>x \<in> C. (\<lambda>z \<in> R. fst(z))` (g`x) = x |]
+ ==> (\<lambda>x \<in> C. snd(g`x)): (\<Pi>x \<in> C. R``{x})"
+apply (rule lam_type)
+apply (force dest: apply_type)
+done
+
+lemma AC5_AC4: "AC5 ==> AC4"
+apply (unfold AC4_def AC5_def, clarify)
+apply (elim allE ballE)
+apply (drule lemma3 [OF _ lemma2], assumption)
+apply (fast elim!: lemma4)
+apply (blast intro: lemma1)
+done
+
+
+(* ********************************************************************** *)
+(* AC1 <-> AC6 *)
+(* ********************************************************************** *)
+
+lemma AC1_iff_AC6: "AC1 <-> AC6"
+by (unfold AC1_def AC6_def, blast)
+
+end
--- a/src/ZF/AC/AC18_AC19.ML Wed Jan 16 15:04:37 2002 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,115 +0,0 @@
-(* Title: ZF/AC/AC18_AC19.ML
- ID: $Id$
- Author: Krzysztof Grabczewski
-
-The proof of AC1 ==> AC18 ==> AC19 ==> AC1
-*)
-
-(* ********************************************************************** *)
-(* AC1 ==> AC18 *)
-(* ********************************************************************** *)
-
-Goal "[| f \\<in> (\\<Pi>b \\<in> {P(a). a \\<in> A}. b); \\<forall>a \\<in> A. P(a)<=Q(a) |] \
-\ ==> (\\<lambda>a \\<in> A. f`P(a)) \\<in> (\\<Pi>a \\<in> A. Q(a))";
-by (rtac lam_type 1);
-by (dtac apply_type 1);
-by Auto_tac;
-qed "PROD_subsets";
-
-Goal "[| \\<forall>A. 0 \\<notin> A --> (\\<exists>f. f \\<in> (\\<Pi>X \\<in> A. X)); A \\<noteq> 0 |] ==> \
-\ (\\<Inter>a \\<in> A. \\<Union>b \\<in> B(a). X(a, b)) \\<subseteq> (\\<Union>f \\<in> \\<Pi>a \\<in> A. B(a). \\<Inter>a \\<in> A. X(a, f`a))";
-by (rtac subsetI 1);
-by (eres_inst_tac [("x","{{b \\<in> B(a). x \\<in> X(a,b)}. a \\<in> A}")] allE 1);
-by (etac impE 1);
-by (Fast_tac 1);
-by (etac exE 1);
-by (rtac UN_I 1);
-by (fast_tac (claset() addSEs [PROD_subsets]) 1);
-by (Simp_tac 1);
-by (fast_tac (claset() addSEs [not_emptyE]
- addDs [RepFunI RSN (2, apply_type)]) 1);
-qed "lemma_AC18";
-
-val [prem] = goalw thy (AC18_def::AC_defs) "AC1 ==> AC18";
-by (resolve_tac [prem RS revcut_rl] 1);
-by (fast_tac (claset() addSEs [lemma_AC18, not_emptyE, apply_type]
- addSIs [equalityI, INT_I, UN_I]) 1);
-qed "AC1_AC18";
-
-(* ********************************************************************** *)
-(* AC18 ==> AC19 *)
-(* ********************************************************************** *)
-
-val [prem] = goalw thy [AC18_def, AC19_def] "AC18 ==> AC19";
-by (rtac allI 1);
-by (res_inst_tac [("B1","%x. x")] (forall_elim_vars 0 prem RS revcut_rl) 1);
-by (Fast_tac 1);
-qed "AC18_AC19";
-
-(* ********************************************************************** *)
-(* AC19 ==> AC1 *)
-(* ********************************************************************** *)
-
-Goalw [u_def]
- "[| A \\<noteq> 0; 0 \\<notin> A |] ==> {u_(a). a \\<in> A} \\<noteq> 0 & 0 \\<notin> {u_(a). a \\<in> A}";
-by (fast_tac (claset() addSIs [not_emptyI]
- addSEs [not_emptyE]
- addSDs [sym RS (RepFun_eq_0_iff RS iffD1)]) 1);
-qed "RepRep_conj";
-
-Goal "[|c \\<in> a; x = c Un {0}; x \\<notin> a |] ==> x - {0} \\<in> a";
-by (hyp_subst_tac 1);
-by (rtac subst_elem 1 THEN (assume_tac 1));
-by (rtac equalityI 1);
-by (Fast_tac 1);
-by (rtac subsetI 1);
-by (excluded_middle_tac "x=0" 1);
-by (Fast_tac 1);
-by (fast_tac (claset() addEs [notE, subst_elem]) 1);
-val lemma1_1 = result();
-
-Goalw [u_def]
- "[| f`(u_(a)) \\<notin> a; f \\<in> (\\<Pi>B \\<in> {u_(a). a \\<in> A}. B); a \\<in> A |] \
-\ ==> f`(u_(a))-{0} \\<in> a";
-by (fast_tac (claset() addSEs [lemma1_1] addSDs [apply_type]) 1);
-val lemma1_2 = result();
-
-Goal "\\<exists>f. f \\<in> (\\<Pi>B \\<in> {u_(a). a \\<in> A}. B) ==> \\<exists>f. f \\<in> (\\<Pi>B \\<in> A. B)";
-by (etac exE 1);
-by (res_inst_tac
- [("x","\\<lambda>a \\<in> A. if(f`(u_(a)) \\<in> a, f`(u_(a)), f`(u_(a))-{0})")] exI 1);
-by (rtac lam_type 1);
-by (split_tac [split_if] 1);
-by (rtac conjI 1);
-by (Fast_tac 1);
-by (fast_tac (claset() addSEs [lemma1_2]) 1);
-val lemma1 = result();
-
-Goalw [u_def] "a\\<noteq>0 ==> 0 \\<in> (\\<Union>b \\<in> u_(a). b)";
-by (fast_tac (claset() addSEs [not_emptyE] addSIs [UN_I, RepFunI]) 1);
-val lemma2_1 = result();
-
-Goal "[| A\\<noteq>0; 0\\<notin>A |] ==> (\\<Inter>x \\<in> {u_(a). a \\<in> A}. \\<Union>b \\<in> x. b) \\<noteq> 0";
-by (etac not_emptyE 1);
-by (res_inst_tac [("a","0")] not_emptyI 1);
-by (fast_tac (claset() addSIs [lemma2_1]) 1);
-val lemma2 = result();
-
-Goal "(\\<Union>f \\<in> F. P(f)) \\<noteq> 0 ==> F \\<noteq> 0";
-by (fast_tac (claset() addSEs [not_emptyE]) 1);
-val lemma3 = result();
-
-Goalw AC_defs "AC19 ==> AC1";
-by (Clarify_tac 1);
-by (case_tac "A=0" 1);
-by (Force_tac 1);
-by (eres_inst_tac [("x","{u_(a). a \\<in> A}")] allE 1);
-by (etac impE 1);
-by (etac RepRep_conj 1 THEN (assume_tac 1));
-by (rtac lemma1 1);
-by (dtac lemma2 1 THEN (assume_tac 1));
-by (dres_inst_tac [("P","%x. x\\<noteq>0")] subst 1 THEN (assume_tac 1));
-by (fast_tac (claset() addSEs [lemma3 RS not_emptyE]) 1);
-qed "AC19_AC1";
-
-
--- a/src/ZF/AC/AC18_AC19.thy Wed Jan 16 15:04:37 2002 +0100
+++ b/src/ZF/AC/AC18_AC19.thy Wed Jan 16 17:52:06 2002 +0100
@@ -2,17 +2,106 @@
ID: $Id$
Author: Krzysztof Grabczewski
-Additional definition used in the proof AC19 ==> AC1 which is a part
-of the chain AC1 ==> AC18 ==> AC19 ==> AC1
+The proof of AC1 ==> AC18 ==> AC19 ==> AC1
*)
-AC18_AC19 = AC_Equiv +
+theory AC18_AC19 = AC_Equiv:
+
+constdefs
+ uu :: "i => i"
+ "uu(a) == {c Un {0}. c \<in> a}"
+
+
+(* ********************************************************************** *)
+(* AC1 ==> AC18 *)
+(* ********************************************************************** *)
+
+lemma PROD_subsets:
+ "[| f \<in> (\<Pi>b \<in> {P(a). a \<in> A}. b); \<forall>a \<in> A. P(a)<=Q(a) |]
+ ==> (\<lambda>a \<in> A. f`P(a)) \<in> (\<Pi>a \<in> A. Q(a))"
+by (rule lam_type, drule apply_type, auto)
+
+lemma lemma_AC18:
+ "[| \<forall>A. 0 \<notin> A --> (\<exists>f. f \<in> (\<Pi>X \<in> A. X)); A \<noteq> 0 |]
+ ==> (\<Inter>a \<in> A. \<Union>b \<in> B(a). X(a, b)) \<subseteq>
+ (\<Union>f \<in> \<Pi>a \<in> A. B(a). \<Inter>a \<in> A. X(a, f`a))"
+apply (rule subsetI)
+apply (erule_tac x = "{{b \<in> B (a) . x \<in> X (a,b) }. a \<in> A}" in allE)
+apply (erule impE, fast)
+apply (erule exE)
+apply (rule UN_I)
+ apply (fast elim!: PROD_subsets)
+apply (simp, fast elim!: not_emptyE dest: apply_type [OF _ RepFunI])
+done
+
+lemma AC1_AC18: "AC1 ==> AC18"
+apply (unfold AC1_def AC18_def)
+apply (fast elim!: lemma_AC18 apply_type intro!: equalityI INT_I UN_I)
+done
+
+(* ********************************************************************** *)
+(* AC18 ==> AC19 *)
+(* ********************************************************************** *)
+
+text{*Hard to express because of the need for meta-quantifiers in AC18*}
+lemma "AC18 ==> AC19"
+proof -
+ assume ac18 [unfolded AC18_def, norm_hhf]: AC18
+ show AC19
+ apply (unfold AC18_def AC19_def)
+ apply (intro allI impI)
+ apply (rule ac18 [of _ "%x. x", THEN mp], blast)
+ done
+qed
-consts
- u_ :: i => i
-
-defs
+(* ********************************************************************** *)
+(* AC19 ==> AC1 *)
+(* ********************************************************************** *)
+
+lemma RepRep_conj:
+ "[| A \<noteq> 0; 0 \<notin> A |] ==> {uu(a). a \<in> A} \<noteq> 0 & 0 \<notin> {uu(a). a \<in> A}"
+apply (unfold uu_def, auto)
+apply (blast dest!: sym [THEN RepFun_eq_0_iff [THEN iffD1]])
+done
+
+lemma lemma1_1: "[|c \<in> a; x = c Un {0}; x \<notin> a |] ==> x - {0} \<in> a"
+apply clarify
+apply (rule subst_elem , (assumption))
+apply (fast elim: notE subst_elem)
+done
+
+lemma lemma1_2:
+ "[| f`(uu(a)) \<notin> a; f \<in> (\<Pi>B \<in> {uu(a). a \<in> A}. B); a \<in> A |]
+ ==> f`(uu(a))-{0} \<in> a"
+apply (unfold uu_def, fast elim!: lemma1_1 dest!: apply_type)
+done
- u_def "u_(a) == {c Un {0}. c \\<in> a}"
+lemma lemma1: "\<exists>f. f \<in> (\<Pi>B \<in> {uu(a). a \<in> A}. B) ==> \<exists>f. f \<in> (\<Pi>B \<in> A. B)"
+apply (erule exE)
+apply (rule_tac x = "\<lambda>a\<in>A. if (f` (uu(a)) \<in> a, f` (uu(a)), f` (uu(a))-{0})"
+ in exI)
+apply (rule lam_type)
+apply (simp add: lemma1_2)
+done
+
+lemma lemma2_1: "a\<noteq>0 ==> 0 \<in> (\<Union>b \<in> uu(a). b)"
+by (unfold uu_def, auto)
+
+lemma lemma2: "[| A\<noteq>0; 0\<notin>A |] ==> (\<Inter>x \<in> {uu(a). a \<in> A}. \<Union>b \<in> x. b) \<noteq> 0"
+apply (erule not_emptyE)
+apply (rule_tac a = "0" in not_emptyI)
+apply (fast intro!: lemma2_1)
+done
+
+lemma AC19_AC1: "AC19 ==> AC1"
+apply (unfold AC19_def AC1_def, clarify)
+apply (case_tac "A=0", force)
+apply (erule_tac x = "{uu (a) . a \<in> A}" in allE)
+apply (erule impE)
+apply (erule RepRep_conj , (assumption))
+apply (rule lemma1)
+apply (drule lemma2 , (assumption))
+apply auto
+done
end
--- a/src/ZF/AC/AC1_WO2.ML Wed Jan 16 15:04:37 2002 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,22 +0,0 @@
-(* Title: ZF/AC/AC1_WO2.ML
- ID: $Id$
- Author: Krzysztof Grabczewski
-
-The proof of AC1 ==> WO2
-*)
-
-(*Establishing the existence of a bijection -- hence the need for uresult*)
-val [prem] = goal thy "f \\<in> (\\<Pi>X \\<in> Pow(x) - {0}. X) ==> \
-\ ?g(f) \\<in> bij(x, LEAST i. HH(\\<lambda>X \\<in> Pow(x)-{0}. {f`X}, x, i) = {x})";
-by (resolve_tac [bij_Least_HH_x RS bij_converse_bij] 1);
-by (rtac f_subsets_imp_UN_HH_eq_x 1);
-by (resolve_tac [lam_type RS apply_type] 1 THEN (assume_tac 2));
-by (fast_tac (claset() addSDs [prem RS apply_type]) 1);
-by (fast_tac (claset() addSIs [prem RS Pi_weaken_type]) 1);
-val lemma1 = uresult() |> standard;
-
-Goalw [AC1_def, WO2_def, eqpoll_def] "AC1 ==> WO2";
-by (rtac allI 1);
-by (eres_inst_tac [("x","Pow(A)-{0}")] allE 1);
-by (fast_tac (claset() addSDs [lemma1] addSIs [Ord_Least]) 1);
-qed "AC1_WO2";
--- a/src/ZF/AC/AC1_WO2.thy Wed Jan 16 15:04:37 2002 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,3 +0,0 @@
-(*Dummy theory to document dependencies *)
-
-AC1_WO2 = HH
--- a/src/ZF/AC/AC7_AC9.ML Wed Jan 16 15:04:37 2002 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,188 +0,0 @@
-(* Title: ZF/AC/AC7-AC9.ML
- ID: $Id$
- Author: Krzysztof Grabczewski
-
-The proofs needed to state that AC7, AC8 and AC9 are equivalent to the previous
-instances of AC.
-*)
-
-(* ********************************************************************** *)
-(* Lemmas used in the proofs AC7 ==> AC6 and AC9 ==> AC1 *)
-(* - Sigma_fun_space_not0 *)
-(* - Sigma_fun_space_eqpoll *)
-(* ********************************************************************** *)
-
-Goal "[| 0\\<notin>A; B \\<in> A |] ==> (nat->Union(A)) * B \\<noteq> 0";
-by (blast_tac (claset() addSDs [Sigma_empty_iff RS iffD1,
- Union_empty_iff RS iffD1]) 1);
-qed "Sigma_fun_space_not0";
-
-Goalw [inj_def]
- "C \\<in> A ==> (\\<lambda>g \\<in> (nat->Union(A))*C. \
-\ (\\<lambda>n \\<in> nat. if(n=0, snd(g), fst(g)`(n #- 1)))) \
-\ \\<in> inj((nat->Union(A))*C, (nat->Union(A)) ) ";
-by (rtac CollectI 1);
-by (fast_tac (claset() addSIs [lam_type,RepFunI,if_type,snd_type,apply_type,
- fst_type,diff_type,nat_succI,nat_0I]) 1);
-by (REPEAT (resolve_tac [ballI, impI] 1));
-by (Asm_full_simp_tac 1);
-by (REPEAT (etac SigmaE 1));
-by (REPEAT (hyp_subst_tac 1));
-by (Asm_full_simp_tac 1);
-by (rtac conjI 1);
-by (dresolve_tac [nat_0I RSN (2, lam_eqE)] 2);
-by (Asm_full_simp_tac 2);
-by (rtac fun_extension 1 THEN REPEAT (assume_tac 1));
-by (dresolve_tac [nat_succI RSN (2, lam_eqE)] 1 THEN (assume_tac 1));
-by (asm_full_simp_tac (simpset() addsimps [succ_not_0 RS if_not_P]) 1);
-val lemma = result();
-
-Goal "[| C \\<in> A; 0\\<notin>A |] ==> (nat->Union(A)) * C eqpoll (nat->Union(A))";
-by (rtac eqpollI 1);
-by (fast_tac (claset() addSEs [prod_lepoll_self, not_sym RS not_emptyE,
- subst_elem] addEs [swap]) 2);
-by (rewtac lepoll_def);
-by (fast_tac (claset() addSIs [lemma]) 1);
-qed "Sigma_fun_space_eqpoll";
-
-
-(* ********************************************************************** *)
-(* AC6 ==> AC7 *)
-(* ********************************************************************** *)
-
-Goalw AC_defs "AC6 ==> AC7";
-by (Blast_tac 1);
-qed "AC6_AC7";
-
-(* ********************************************************************** *)
-(* AC7 ==> AC6, Rubin & Rubin p. 12, Theorem 2.8 *)
-(* The case of the empty family of sets added in order to complete *)
-(* the proof. *)
-(* ********************************************************************** *)
-
-Goal "y \\<in> (\\<Pi>B \\<in> A. Y*B) ==> (\\<lambda>B \\<in> A. snd(y`B)): (\\<Pi>B \\<in> A. B)";
-by (fast_tac (claset() addSIs [lam_type, snd_type, apply_type]) 1);
-val lemma1_1 = result();
-
-Goal "y \\<in> (\\<Pi>B \\<in> {Y*C. C \\<in> A}. B) ==> (\\<lambda>B \\<in> A. y`(Y*B)): (\\<Pi>B \\<in> A. Y*B)";
-by (fast_tac (claset() addSIs [lam_type, apply_type]) 1);
-val lemma1_2 = result();
-
-Goal "(\\<Pi>B \\<in> {(nat->Union(A))*C. C \\<in> A}. B) \\<noteq> 0 ==> (\\<Pi>B \\<in> A. B) \\<noteq> 0";
-by (fast_tac (claset() addSIs [equals0I,lemma1_1, lemma1_2]) 1);
-val lemma1 = result();
-
-Goal "0 \\<notin> A ==> 0 \\<notin> {(nat -> Union(A)) * C. C \\<in> A}";
-by (fast_tac (claset() addEs [Sigma_fun_space_not0 RS not_sym RS notE]) 1);
-val lemma2 = result();
-
-Goalw AC_defs "AC7 ==> AC6";
-by (rtac allI 1);
-by (rtac impI 1);
-by (case_tac "A=0" 1);
-by (Asm_simp_tac 1);
-by (rtac lemma1 1);
-by (etac allE 1);
-by (etac impE 1 THEN (assume_tac 2));
-by (blast_tac (claset() addSIs [lemma2]
- addIs [eqpoll_sym, eqpoll_trans, Sigma_fun_space_eqpoll]) 1);
-qed "AC7_AC6";
-
-
-(* ********************************************************************** *)
-(* AC1 ==> AC8 *)
-(* ********************************************************************** *)
-
-Goalw [eqpoll_def]
- "\\<forall>B \\<in> A. \\<exists>B1 B2. B=<B1,B2> & B1 eqpoll B2 \
-\ ==> 0 \\<notin> { bij(fst(B),snd(B)). B \\<in> A }";
-by Auto_tac;
-val lemma1 = result();
-
-Goal "[| f \\<in> (\\<Pi>X \\<in> RepFun(A,p). X); D \\<in> A |] ==> (\\<lambda>x \\<in> A. f`p(x))`D \\<in> p(D)";
-by (resolve_tac [beta RS ssubst] 1 THEN (assume_tac 1));
-by (fast_tac (claset() addSEs [apply_type]) 1);
-val lemma2 = result();
-
-Goalw AC_defs "AC1 ==> AC8";
-by (Clarify_tac 1);
-by (dtac lemma1 1);
-by (fast_tac (claset() addSEs [lemma2]) 1);
-qed "AC1_AC8";
-
-
-(* ********************************************************************** *)
-(* AC8 ==> AC9 *)
-(* - this proof replaces the following two from Rubin & Rubin: *)
-(* AC8 ==> AC1 and AC1 ==> AC9 *)
-(* ********************************************************************** *)
-
-Goal "\\<forall>B1 \\<in> A. \\<forall>B2 \\<in> A. B1 eqpoll B2 \
-\ ==> \\<forall>B \\<in> A*A. \\<exists>B1 B2. B=<B1,B2> & B1 eqpoll B2";
-by (Fast_tac 1);
-val lemma1 = result();
-
-Goal "f \\<in> bij(fst(<a,b>),snd(<a,b>)) ==> f \\<in> bij(a,b)";
-by (Asm_full_simp_tac 1);
-val lemma2 = result();
-
-Goalw AC_defs "AC8 ==> AC9";
-by (rtac allI 1);
-by (rtac impI 1);
-by (etac allE 1);
-by (etac impE 1);
-by (etac lemma1 1);
-by (fast_tac (claset() addSEs [lemma2]) 1);
-qed "AC8_AC9";
-
-
-(* ********************************************************************** *)
-(* AC9 ==> AC1 *)
-(* The idea of this proof comes from "Equivalents of the Axiom of Choice" *)
-(* by Rubin & Rubin. But (x * y) is not necessarily equipollent to *)
-(* (x * y) Un {0} when y is a set of total functions acting from nat to *)
-(* Union(A) -- therefore we have used the set (y * nat) instead of y. *)
-(* ********************************************************************** *)
-
-(* Rules nedded to prove lemma1 *)
-val snd_lepoll_SigmaI = prod_lepoll_self RS
- ((prod_commute_eqpoll RS eqpoll_imp_lepoll) RSN (2,lepoll_trans));
-
-
-Goal "[|0 \\<notin> A; B \\<in> A|] ==> nat \\<lesssim> ((nat \\<rightarrow> Union(A)) \\<times> B) \\<times> nat";
-by (blast_tac (claset() addDs [Sigma_fun_space_not0]
- addIs [snd_lepoll_SigmaI]) 1);
-qed "nat_lepoll_lemma";
-
-
-Goal "[| 0\\<notin>A; A\\<noteq>0; \
-\ C = {((nat->Union(A))*B)*nat. B \\<in> A} Un \
-\ {cons(0,((nat->Union(A))*B)*nat). B \\<in> A}; \
-\ B1: C; B2: C |] \
-\ ==> B1 eqpoll B2";
-by (blast_tac
- (claset() delrules [eqpoll_refl]
- addSIs [nat_lepoll_lemma, nat_cons_eqpoll RS eqpoll_trans,
- eqpoll_refl RSN (2, prod_eqpoll_cong)]
- addIs [eqpoll_trans, eqpoll_sym, Sigma_fun_space_eqpoll]) 1);
-val lemma1 = result();
-
-Goal "\\<forall>B1 \\<in> {(F*B)*N. B \\<in> A} Un {cons(0,(F*B)*N). B \\<in> A}. \
-\ \\<forall>B2 \\<in> {(F*B)*N. B \\<in> A} Un {cons(0,(F*B)*N). B \\<in> A}. \
-\ f`<B1,B2> \\<in> bij(B1, B2) \
-\ ==> (\\<lambda>B \\<in> A. snd(fst((f`<cons(0,(F*B)*N),(F*B)*N>)`0))) \\<in> (\\<Pi>X \\<in> A. X)";
-by (rtac lam_type 1);
-by (rtac snd_type 1);
-by (rtac fst_type 1);
-by (resolve_tac [consI1 RSN (2, apply_type)] 1);
-by (fast_tac (claset() addSIs [fun_weaken_type, bij_is_fun]) 1);
-val lemma2 = result();
-
-Goalw AC_defs "AC9 ==> AC1";
-by (rtac allI 1);
-by (rtac impI 1);
-by (etac allE 1);
-by (case_tac "A=0" 1);
-by (blast_tac (claset() addDs [lemma1,lemma2]) 2);
-by Auto_tac;
-qed "AC9_AC1";
--- a/src/ZF/AC/AC_Equiv.ML Wed Jan 16 15:04:37 2002 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,126 +0,0 @@
-(* Title: ZF/AC/AC_Equiv.ML
- ID: $Id$
- Author: Krzysztof Grabczewski
-
-*)
-
-val WO_defs = [WO1_def, WO2_def, WO3_def, WO4_def, WO5_def, WO6_def, WO8_def];
-
-val AC_defs = [AC0_def, AC1_def, AC2_def, AC3_def, AC4_def, AC5_def,
- AC6_def, AC7_def, AC8_def, AC9_def, AC10_def, AC11_def,
- AC12_def, AC13_def, AC14_def, AC15_def, AC16_def,
- AC17_def, AC18_def, AC19_def];
-
-val AC_aux_defs = [pairwise_disjoint_def, sets_of_size_between_def];
-
-
-(* ********************************************************************** *)
-(* lemmas concerning FOL and pure ZF theory *)
-(* ********************************************************************** *)
-
-(* used only in WO1_DC.ML *)
-(*Note simpler proof*)
-Goal "[| \\<forall>x \\<in> A. f`x=g`x; f \\<in> Df->Cf; g \\<in> Dg->Cg; A \\<subseteq> Df; A \\<subseteq> Dg |] ==> f``A=g``A";
-by (asm_simp_tac (simpset() addsimps [image_fun]) 1);
-qed "images_eq";
-
-(* used in \\<in> AC10-AC15.ML AC16WO4.ML WO6WO1.ML *)
-(*I don't know where to put this one.*)
-Goal
- "!!m A B. [| A lepoll succ(m); B \\<subseteq> A; B\\<noteq>0 |] ==> A-B lepoll m";
-by (rtac not_emptyE 1 THEN (assume_tac 1));
-by (ftac singleton_subsetI 1);
-by (ftac subsetD 1 THEN (assume_tac 1));
-by (res_inst_tac [("A2","A")]
- (Diff_sing_lepoll RSN (2, subset_imp_lepoll RS lepoll_trans)) 1
- THEN (REPEAT (assume_tac 2)));
-by (Fast_tac 1);
-qed "Diff_lepoll";
-
-(* ********************************************************************** *)
-(* lemmas concerning lepoll and eqpoll relations *)
-(* ********************************************************************** *)
-
-(* ********************************************************************** *)
-(* Theorems concerning ordinals *)
-(* ********************************************************************** *)
-
-(* lemma for ordertype_Int *)
-goalw Cardinal.thy [rvimage_def] "rvimage(A,id(A),r) = r Int A*A";
-by (rtac equalityI 1);
-by Safe_tac;
-by (dres_inst_tac [("P","%a. <id(A)`xb,a>:r")] (id_conv RS subst) 1
- THEN (assume_tac 1));
-by (dres_inst_tac [("P","%a. <a,ya>:r")] (id_conv RS subst) 1
- THEN (REPEAT (assume_tac 1)));
-by (fast_tac (claset() addIs [id_conv RS ssubst]) 1);
-qed "rvimage_id";
-
-(* used only in Hartog.ML *)
-goal Cardinal.thy
- "!!A r. well_ord(A,r) ==> ordertype(A, r Int A*A) = ordertype(A,r)";
-by (res_inst_tac [("P","%a. ordertype(A,a)=ordertype(A,r)")]
- (rvimage_id RS subst) 1);
-by (eresolve_tac [id_bij RS bij_ordertype_vimage] 1);
-qed "ordertype_Int";
-
-(* used only in AC16_lemmas.ML *)
-Goalw [InfCard_def]
- "!!i. [| ~Finite(i); Card(i) |] ==> InfCard(i)";
-by (asm_simp_tac (simpset() addsimps [Card_is_Ord RS nat_le_infinite_Ord]) 1);
-qed "Inf_Card_is_InfCard";
-
-Goal "(THE z. {x}={z}) = x";
-by (fast_tac (claset() addSEs [singleton_eq_iff RS iffD1 RS sym]) 1);
-qed "the_element";
-
-Goal "(\\<lambda>x \\<in> A. {x}) \\<in> bij(A, {{x}. x \\<in> A})";
-by (res_inst_tac [("d","%z. THE x. z={x}")] lam_bijective 1);
-by (TRYALL (eresolve_tac [RepFunI, RepFunE]));
-by (REPEAT (asm_full_simp_tac (simpset() addsimps [the_element]) 1));
-qed "lam_sing_bij";
-
-val [major, minor] = Goalw [inj_def]
- "[| f \\<in> inj(A, B); !!a. a \\<in> A ==> f`a \\<in> C |] ==> f \\<in> inj(A,C)";
-by (fast_tac (claset() addSEs [minor]
- addSIs [major RS CollectD1 RS Pi_type, major RS CollectD2]) 1);
-qed "inj_strengthen_type";
-
-Goalw [Finite_def] "~Finite(nat)";
-by (fast_tac (claset() addSDs [eqpoll_imp_lepoll]
- addIs [Ord_nat RSN (2, ltI) RS lt_not_lepoll RS notE]) 1);
-qed "nat_not_Finite";
-
-val le_imp_lepoll = le_imp_subset RS subset_imp_lepoll;
-
-(* ********************************************************************** *)
-(* Another elimination rule for \\<exists>! *)
-(* ********************************************************************** *)
-
-Goal "[| \\<exists>! x. P(x); P(x); P(y) |] ==> x=y";
-by (etac ex1E 1);
-by (res_inst_tac [("b","xa")] (sym RSN (2, trans)) 1);
-by (Fast_tac 1);
-by (Fast_tac 1);
-qed "ex1_two_eq";
-
-(* ********************************************************************** *)
-(* image of a surjection *)
-(* ********************************************************************** *)
-
-Goalw [surj_def] "f \\<in> surj(A, B) ==> f``A = B";
-by (etac CollectE 1);
-by (resolve_tac [subset_refl RSN (2, image_fun) RS ssubst] 1
- THEN (assume_tac 1));
-by (fast_tac (claset() addSEs [apply_type] addIs [equalityI]) 1);
-qed "surj_image_eq";
-
-
-Goal "succ(x) lepoll y ==> y \\<noteq> 0";
-by (fast_tac (claset() addSDs [lepoll_0_is_0]) 1);
-qed "succ_lepoll_imp_not_empty";
-
-Goal "x eqpoll succ(n) ==> x \\<noteq> 0";
-by (fast_tac (claset() addSEs [eqpoll_sym RS eqpoll_0_is_0 RS succ_neq_0]) 1);
-qed "eqpoll_succ_imp_not_empty";
-
--- a/src/ZF/AC/AC_Equiv.thy Wed Jan 16 15:04:37 2002 +0100
+++ b/src/ZF/AC/AC_Equiv.thy Wed Jan 16 17:52:06 2002 +0100
@@ -12,114 +12,231 @@
but slightly changed.
*)
+theory AC_Equiv = Main: (*obviously not Main_ZFC*)
-AC_Equiv = Main + (*obviously not Main_ZFC*)
-
-consts
+constdefs
(* Well Ordering Theorems *)
- WO1, WO2, WO3, WO5, WO6, WO7, WO8 :: o
- WO4 :: i => o
+ WO1 :: o
+ "WO1 == \<forall>A. \<exists>R. well_ord(A,R)"
+
+ WO2 :: o
+ "WO2 == \<forall>A. \<exists>a. Ord(a) & A\<approx>a"
-(* Axioms of Choice *)
- AC0, AC1, AC2, AC3, AC4, AC5, AC6, AC7, AC8, AC9,
- AC11, AC12, AC14, AC15, AC17, AC19 :: o
- AC10, AC13 :: i => o
- AC16 :: [i, i] => o
- AC18 :: prop ("AC18")
+ WO3 :: o
+ "WO3 == \<forall>A. \<exists>a. Ord(a) & (\<exists>b. b \<subseteq> a & A\<approx>b)"
-(* Auxiliary definitions used in definitions *)
- pairwise_disjoint :: i => o
- sets_of_size_between :: [i, i, i] => o
+ WO4 :: "i => o"
+ "WO4(m) == \<forall>A. \<exists>a f. Ord(a) & domain(f)=a &
+ (\<Union>b<a. f`b) = A & (\<forall>b<a. f`b \<lesssim> m)"
-defs
-
-(* Well Ordering Theorems *)
+ WO5 :: o
+ "WO5 == \<exists>m \<in> nat. 1\<le>m & WO4(m)"
- WO1_def "WO1 == \\<forall>A. \\<exists>R. well_ord(A,R)"
-
- WO2_def "WO2 == \\<forall>A. \\<exists>a. Ord(a) & A eqpoll a"
+ WO6 :: o
+ "WO6 == \<forall>A. \<exists>m \<in> nat. 1\<le>m & (\<exists>a f. Ord(a) & domain(f)=a
+ & (\<Union>b<a. f`b) = A & (\<forall>b<a. f`b \<lesssim> m))"
- WO3_def "WO3 == \\<forall>A. \\<exists>a. Ord(a) & (\\<exists>b. b \\<subseteq> a & A eqpoll b)"
-
- WO4_def "WO4(m) == \\<forall>A. \\<exists>a f. Ord(a) & domain(f)=a &
- (\\<Union>b<a. f`b) = A & (\\<forall>b<a. f`b lepoll m)"
+ WO7 :: o
+ "WO7 == \<forall>A. Finite(A) <-> (\<forall>R. well_ord(A,R) --> well_ord(A,converse(R)))"
- WO5_def "WO5 == \\<exists>m \\<in> nat. 1 le m & WO4(m)"
+ WO8 :: o
+ "WO8 == \<forall>A. (\<exists>f. f \<in> (\<Pi>X \<in> A. X)) --> (\<exists>R. well_ord(A,R))"
- WO6_def "WO6 == \\<forall>A. \\<exists>m \\<in> nat. 1 le m & (\\<exists>a f. Ord(a) & domain(f)=a
- & (\\<Union>b<a. f`b) = A & (\\<forall>b<a. f`b lepoll m))"
- WO7_def "WO7 == \\<forall>A. Finite(A) <-> (\\<forall>R. well_ord(A,R) -->
- well_ord(A,converse(R)))"
+(* Auxiliary concepts needed below *)
+ pairwise_disjoint :: "i => o"
+ "pairwise_disjoint(A) == \<forall>A1 \<in> A. \<forall>A2 \<in> A. A1 Int A2 \<noteq> 0 --> A1=A2"
- WO8_def "WO8 == \\<forall>A. (\\<exists>f. f \\<in> (\\<Pi>X \\<in> A. X)) --> (\\<exists>R. well_ord(A,R))"
+ sets_of_size_between :: "[i, i, i] => o"
+ "sets_of_size_between(A,m,n) == \<forall>B \<in> A. m \<lesssim> B & B \<lesssim> n"
+
(* Axioms of Choice *)
+ AC0 :: o
+ "AC0 == \<forall>A. \<exists>f. f \<in> (\<Pi>X \<in> Pow(A)-{0}. X)"
- AC0_def "AC0 == \\<forall>A. \\<exists>f. f \\<in> (\\<Pi>X \\<in> Pow(A)-{0}. X)"
+ AC1 :: o
+ "AC1 == \<forall>A. 0\<notin>A --> (\<exists>f. f \<in> (\<Pi>X \<in> A. X))"
+
+ AC2 :: o
+ "AC2 == \<forall>A. 0\<notin>A & pairwise_disjoint(A)
+ --> (\<exists>C. \<forall>B \<in> A. \<exists>y. B Int C = {y})"
+ AC3 :: o
+ "AC3 == \<forall>A B. \<forall>f \<in> A->B. \<exists>g. g \<in> (\<Pi>x \<in> {a \<in> A. f`a\<noteq>0}. f`x)"
- AC1_def "AC1 == \\<forall>A. 0\\<notin>A --> (\\<exists>f. f \\<in> (\\<Pi>X \\<in> A. X))"
+ AC4 :: o
+ "AC4 == \<forall>R A B. (R \<subseteq> A*B --> (\<exists>f. f \<in> (\<Pi>x \<in> domain(R). R``{x})))"
+
+ AC5 :: o
+ "AC5 == \<forall>A B. \<forall>f \<in> A->B. \<exists>g \<in> range(f)->A. \<forall>x \<in> domain(g). f`(g`x) = x"
+
+ AC6 :: o
+ "AC6 == \<forall>A. 0\<notin>A --> (\<Pi>B \<in> A. B)\<noteq>0"
- AC2_def "AC2 == \\<forall>A. 0\\<notin>A & pairwise_disjoint(A)
- --> (\\<exists>C. \\<forall>B \\<in> A. \\<exists>y. B Int C = {y})"
+ AC7 :: o
+ "AC7 == \<forall>A. 0\<notin>A & (\<forall>B1 \<in> A. \<forall>B2 \<in> A. B1\<approx>B2) --> (\<Pi>B \<in> A. B) \<noteq> 0"
- AC3_def "AC3 == \\<forall>A B. \\<forall>f \\<in> A->B. \\<exists>g. g \\<in> (\\<Pi>x \\<in> {a \\<in> A. f`a\\<noteq>0}. f`x)"
+ AC8 :: o
+ "AC8 == \<forall>A. (\<forall>B \<in> A. \<exists>B1 B2. B=<B1,B2> & B1\<approx>B2)
+ --> (\<exists>f. \<forall>B \<in> A. f`B \<in> bij(fst(B),snd(B)))"
+
+ AC9 :: o
+ "AC9 == \<forall>A. (\<forall>B1 \<in> A. \<forall>B2 \<in> A. B1\<approx>B2) -->
+ (\<exists>f. \<forall>B1 \<in> A. \<forall>B2 \<in> A. f`<B1,B2> \<in> bij(B1,B2))"
- AC4_def "AC4 == \\<forall>R A B. (R \\<subseteq> A*B --> (\\<exists>f. f \\<in> (\\<Pi>x \\<in> domain(R). R``{x})))"
+ AC10 :: "i => o"
+ "AC10(n) == \<forall>A. (\<forall>B \<in> A. ~Finite(B)) -->
+ (\<exists>f. \<forall>B \<in> A. (pairwise_disjoint(f`B) &
+ sets_of_size_between(f`B, 2, succ(n)) & Union(f`B)=B))"
- AC5_def "AC5 == \\<forall>A B. \\<forall>f \\<in> A->B. \\<exists>g \\<in> range(f)->A.
- \\<forall>x \\<in> domain(g). f`(g`x) = x"
+ AC11 :: o
+ "AC11 == \<exists>n \<in> nat. 1\<le>n & AC10(n)"
+
+ AC12 :: o
+ "AC12 == \<forall>A. (\<forall>B \<in> A. ~Finite(B)) -->
+ (\<exists>n \<in> nat. 1\<le>n & (\<exists>f. \<forall>B \<in> A. (pairwise_disjoint(f`B) &
+ sets_of_size_between(f`B, 2, succ(n)) & Union(f`B)=B)))"
- AC6_def "AC6 == \\<forall>A. 0\\<notin>A --> (\\<Pi>B \\<in> A. B)\\<noteq>0"
+ AC13 :: "i => o"
+ "AC13(m) == \<forall>A. 0\<notin>A --> (\<exists>f. \<forall>B \<in> A. f`B\<noteq>0 & f`B \<subseteq> B & f`B \<lesssim> m)"
+
+ AC14 :: o
+ "AC14 == \<exists>m \<in> nat. 1\<le>m & AC13(m)"
+
+ AC15 :: o
+ "AC15 == \<forall>A. 0\<notin>A -->
+ (\<exists>m \<in> nat. 1\<le>m & (\<exists>f. \<forall>B \<in> A. f`B\<noteq>0 & f`B \<subseteq> B & f`B \<lesssim> m))"
- AC7_def "AC7 == \\<forall>A. 0\\<notin>A & (\\<forall>B1 \\<in> A. \\<forall>B2 \\<in> A. B1 eqpoll B2)
- --> (\\<Pi>B \\<in> A. B)\\<noteq>0"
+ AC16 :: "[i, i] => o"
+ "AC16(n, k) ==
+ \<forall>A. ~Finite(A) -->
+ (\<exists>T. T \<subseteq> {X \<in> Pow(A). X\<approx>succ(n)} &
+ (\<forall>X \<in> {X \<in> Pow(A). X\<approx>succ(k)}. \<exists>! Y. Y \<in> T & X \<subseteq> Y))"
- AC8_def "AC8 == \\<forall>A. (\\<forall>B \\<in> A. \\<exists>B1 B2. B=<B1,B2> & B1 eqpoll B2)
- --> (\\<exists>f. \\<forall>B \\<in> A. f`B \\<in> bij(fst(B),snd(B)))"
+ AC17 :: o
+ "AC17 == \<forall>A. \<forall>g \<in> (Pow(A)-{0} -> A) -> Pow(A)-{0}.
+ \<exists>f \<in> Pow(A)-{0} -> A. f`(g`f) \<in> g`f"
- AC9_def "AC9 == \\<forall>A. (\\<forall>B1 \\<in> A. \\<forall>B2 \\<in> A. B1 eqpoll B2) -->
- (\\<exists>f. \\<forall>B1 \\<in> A. \\<forall>B2 \\<in> A. f`<B1,B2> \\<in> bij(B1,B2))"
+ AC18 :: "prop" ("AC18")
+ "AC18 == (!!X A B. A\<noteq>0 & (\<forall>a \<in> A. B(a) \<noteq> 0) -->
+ ((\<Inter>a \<in> A. \<Union>b \<in> B(a). X(a,b)) =
+ (\<Union>f \<in> \<Pi>a \<in> A. B(a). \<Inter>a \<in> A. X(a, f`a))))"
+ --"AC18 can be expressed only using meta-level quantification"
+
+ AC19 :: o
+ "AC19 == \<forall>A. A\<noteq>0 & 0\<notin>A --> ((\<Inter>a \<in> A. \<Union>b \<in> a. b) =
+ (\<Union>f \<in> (\<Pi>B \<in> A. B). \<Inter>a \<in> A. f`a))"
+
+
- AC10_def "AC10(n) == \\<forall>A. (\\<forall>B \\<in> A. ~Finite(B)) -->
- (\\<exists>f. \\<forall>B \\<in> A. (pairwise_disjoint(f`B) &
- sets_of_size_between(f`B, 2, succ(n)) & Union(f`B)=B))"
+(* ********************************************************************** *)
+(* Theorems concerning ordinals *)
+(* ********************************************************************** *)
- AC11_def "AC11 == \\<exists>n \\<in> nat. 1 le n & AC10(n)"
+(* lemma for ordertype_Int *)
+lemma rvimage_id: "rvimage(A,id(A),r) = r Int A*A"
+apply (unfold rvimage_def)
+apply (rule equalityI, safe)
+apply (drule_tac P = "%a. <id (A) `xb,a>:r" in id_conv [THEN subst],
+ (assumption))
+apply (drule_tac P = "%a. <a,ya>:r" in id_conv [THEN subst], (assumption+))
+apply (fast intro: id_conv [THEN ssubst])
+done
- AC12_def "AC12 == \\<forall>A. (\\<forall>B \\<in> A. ~Finite(B)) -->
- (\\<exists>n \\<in> nat. 1 le n & (\\<exists>f. \\<forall>B \\<in> A. (pairwise_disjoint(f`B) &
- sets_of_size_between(f`B, 2, succ(n)) & Union(f`B)=B)))"
+(* used only in Hartog.ML *)
+lemma ordertype_Int:
+ "well_ord(A,r) ==> ordertype(A, r Int A*A) = ordertype(A,r)"
+apply (rule_tac P = "%a. ordertype (A,a) =ordertype (A,r) " in rvimage_id [THEN subst])
+apply (erule id_bij [THEN bij_ordertype_vimage])
+done
+
+lemma the_element: "(THE z. {x}={z}) = x"
+by (fast elim!: singleton_eq_iff [THEN iffD1, symmetric])
- AC13_def "AC13(m) == \\<forall>A. 0\\<notin>A --> (\\<exists>f. \\<forall>B \\<in> A. f`B\\<noteq>0 &
- f`B \\<subseteq> B & f`B lepoll m)"
+lemma lam_sing_bij: "(\<lambda>x \<in> A. {x}) \<in> bij(A, {{x}. x \<in> A})"
+apply (rule_tac d = "%z. THE x. z={x}" in lam_bijective)
+apply (auto simp add: the_element)
+done
+
+lemma inj_strengthen_type:
+ "[| f \<in> inj(A, B); !!a. a \<in> A ==> f`a \<in> C |] ==> f \<in> inj(A,C)"
+by (unfold inj_def, blast intro: Pi_type)
+
+lemma nat_not_Finite: "~ Finite(nat)"
+by (unfold Finite_def, blast dest: eqpoll_imp_lepoll ltI lt_not_lepoll)
- AC14_def "AC14 == \\<exists>m \\<in> nat. 1 le m & AC13(m)"
+lemmas le_imp_lepoll = le_imp_subset [THEN subset_imp_lepoll]
+
+(* ********************************************************************** *)
+(* Another elimination rule for \<exists>! *)
+(* ********************************************************************** *)
+
+lemma ex1_two_eq: "[| \<exists>! x. P(x); P(x); P(y) |] ==> x=y"
+by blast
- AC15_def "AC15 == \\<forall>A. 0\\<notin>A --> (\\<exists>m \\<in> nat. 1 le m & (\\<exists>f. \\<forall>B \\<in> A.
- f`B\\<noteq>0 & f`B \\<subseteq> B & f`B lepoll m))"
+(* ********************************************************************** *)
+(* image of a surjection *)
+(* ********************************************************************** *)
- AC16_def "AC16(n, k) == \\<forall>A. ~Finite(A) -->
- (\\<exists>T. T \\<subseteq> {X \\<in> Pow(A). X eqpoll succ(n)} &
- (\\<forall>X \\<in> {X \\<in> Pow(A). X eqpoll succ(k)}. \\<exists>! Y. Y \\<in> T & X \\<subseteq> Y))"
+lemma surj_image_eq: "f \<in> surj(A, B) ==> f``A = B"
+apply (unfold surj_def)
+apply (erule CollectE)
+apply (rule image_fun [THEN ssubst], (assumption), rule subset_refl)
+apply (blast dest: apply_type)
+done
+
+
+(* ********************************************************************** *)
+(* Lemmas used in the proofs like WO? ==> AC? *)
+(* ********************************************************************** *)
- AC17_def "AC17 == \\<forall>A. \\<forall>g \\<in> (Pow(A)-{0} -> A) -> Pow(A)-{0}.
- \\<exists>f \\<in> Pow(A)-{0} -> A. f`(g`f) \\<in> g`f"
+lemma first_in_B:
+ "[| well_ord(Union(A),r); 0\<notin>A; B \<in> A |] ==> (THE b. first(b,B,r)) \<in> B"
+by (blast dest!: well_ord_imp_ex1_first
+ [THEN theI, THEN first_def [THEN def_imp_iff, THEN iffD1]])
+
+lemma ex_choice_fun: "[| well_ord(Union(A), R); 0\<notin>A |] ==> \<exists>f. f:(\<Pi>X \<in> A. X)"
+by (fast elim!: first_in_B intro!: lam_type)
- AC18_def "AC18 == (!!X A B. A\\<noteq>0 & (\\<forall>a \\<in> A. B(a) \\<noteq> 0) -->
- ((\\<Inter>a \\<in> A. \\<Union>b \\<in> B(a). X(a,b)) =
- (\\<Union>f \\<in> \\<Pi>a \\<in> A. B(a). \\<Inter>a \\<in> A. X(a, f`a))))"
+lemma ex_choice_fun_Pow: "well_ord(A, R) ==> \<exists>f. f:(\<Pi>X \<in> Pow(A)-{0}. X)"
+by (fast elim!: well_ord_subset [THEN ex_choice_fun])
+
- AC19_def "AC19 == \\<forall>A. A\\<noteq>0 & 0\\<notin>A --> ((\\<Inter>a \\<in> A. \\<Union>b \\<in> a. b) =
- (\\<Union>f \\<in> (\\<Pi>B \\<in> A. B). \\<Inter>a \\<in> A. f`a))"
+(* ********************************************************************** *)
+(* Lemmas needed to state when a finite relation is a function. *)
+(* The criteria are cardinalities of the relation and its domain. *)
+(* Used in WO6WO1.ML *)
+(* ********************************************************************** *)
-(* Auxiliary definitions used in the above definitions *)
-
- pairwise_disjoint_def "pairwise_disjoint(A)
- == \\<forall>A1 \\<in> A. \\<forall>A2 \\<in> A. A1 Int A2 \\<noteq> 0 --> A1=A2"
+(*Using AC we could trivially prove, for all u, domain(u) \<lesssim> u*)
+lemma lepoll_m_imp_domain_lepoll_m:
+ "[| m \<in> nat; u \<lesssim> m |] ==> domain(u) \<lesssim> m"
+apply (unfold lepoll_def)
+apply (erule exE)
+apply (rule_tac x = "\<lambda>x \<in> domain(u). LEAST i. \<exists>y. <x,y> \<in> u & f`<x,y> = i"
+ in exI)
+apply (rule_tac d = "%y. fst (converse(f) ` y) " in lam_injective)
+apply (fast intro: LeastI2 nat_into_Ord [THEN Ord_in_Ord]
+ inj_is_fun [THEN apply_type])
+apply (erule domainE)
+apply (frule inj_is_fun [THEN apply_type], (assumption))
+apply (rule LeastI2)
+apply (auto elim!: nat_into_Ord [THEN Ord_in_Ord])
+done
- sets_of_size_between_def "sets_of_size_between(A,m,n)
- == \\<forall>B \\<in> A. m lepoll B & B lepoll n"
-
+lemma rel_domain_ex1:
+ "[| succ(m) \<lesssim> domain(r); r \<lesssim> succ(m); m \<in> nat |] ==> function(r)"
+apply (unfold function_def, safe)
+apply (rule ccontr)
+apply (fast elim!: lepoll_trans [THEN succ_lepoll_natE]
+ lepoll_m_imp_domain_lepoll_m [OF _ Diff_sing_lepoll]
+ elim: domain_Diff_eq [OF _ not_sym, THEN subst])
+done
+
+lemma rel_is_fun:
+ "[| succ(m) \<lesssim> domain(r); r \<lesssim> succ(m); m \<in> nat;
+ r \<subseteq> A*B; A=domain(r) |] ==> r \<in> A->B"
+by (simp add: Pi_iff rel_domain_ex1)
+
end
--- a/src/ZF/AC/Cardinal_aux.ML Wed Jan 16 15:04:37 2002 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,209 +0,0 @@
-(* Title: ZF/AC/Cardinal_aux.ML
- ID: $Id$
- Author: Krzysztof Grabczewski
-
-Auxiliary lemmas concerning cardinalities
-*)
-
-(* ********************************************************************** *)
-(* Lemmas involving ordinals and cardinalities used in the proofs *)
-(* concerning AC16 and DC *)
-(* ********************************************************************** *)
-
-(* j=|A| *)
-Goal "[| A lepoll i; Ord(i) |] ==> \\<exists>j. j le i & A eqpoll j";
-by (blast_tac (claset() addSIs [lepoll_cardinal_le, well_ord_Memrel,
- well_ord_cardinal_eqpoll RS eqpoll_sym]
- addDs [lepoll_well_ord]) 1);
-qed "lepoll_imp_ex_le_eqpoll";
-
-(* j=|A| *)
-Goalw [lesspoll_def]
- "[| A lesspoll i; Ord(i) |] ==> \\<exists>j. j<i & A eqpoll j";
-by (blast_tac (claset() addSDs [lepoll_imp_ex_le_eqpoll] addSEs [leE]) 1);
-qed "lesspoll_imp_ex_lt_eqpoll";
-
-Goalw [InfCard_def] "[| ~Finite(i); Ord(i) |] ==> InfCard(|i|)";
-by (rtac conjI 1);
-by (rtac Card_cardinal 1);
-by (resolve_tac [Card_nat RS (Card_def RS def_imp_iff RS iffD1 RS ssubst)] 1);
-by (resolve_tac [nat_le_infinite_Ord RS le_imp_lepoll
- RSN (2, well_ord_Memrel RS well_ord_lepoll_imp_Card_le)] 1
- THEN REPEAT (assume_tac 1));
-qed "Inf_Ord_imp_InfCard_cardinal";
-
-Goal "[| A eqpoll i; B eqpoll i; ~Finite(i); Ord(i) |] \
-\ ==> A Un B eqpoll i";
-by (rtac eqpollI 1);
-by (eresolve_tac [subset_imp_lepoll RSN (2, eqpoll_sym RS eqpoll_imp_lepoll
- RS lepoll_trans)] 2);
-by (Fast_tac 2);
-by (resolve_tac [Un_lepoll_sum RS lepoll_trans] 1);
-by (resolve_tac [lepoll_imp_sum_lepoll_prod RS lepoll_trans] 1);
-by (eresolve_tac [eqpoll_sym RSN (2, eqpoll_trans) RS eqpoll_imp_lepoll] 1
- THEN (assume_tac 1));
-by (resolve_tac [nat_le_infinite_Ord RS le_imp_lepoll RS
- (Ord_nat RS (nat_2I RS OrdmemD) RS subset_imp_lepoll RS lepoll_trans)
- RS (eqpoll_sym RS eqpoll_imp_lepoll RSN (2, lepoll_trans))] 1
- THEN (REPEAT (assume_tac 1)));
-by (eresolve_tac [prod_eqpoll_cong RS eqpoll_imp_lepoll RS lepoll_trans] 1
- THEN (assume_tac 1));
-by (resolve_tac [Inf_Ord_imp_InfCard_cardinal RSN (2, well_ord_Memrel RS
- well_ord_InfCard_square_eq) RS eqpoll_imp_lepoll] 1
- THEN REPEAT (assume_tac 1));
-qed "Un_eqpoll_Inf_Ord";
-
-
-Goal "?f \\<in> bij({{y,z}. y \\<in> x}, x)";
-by (rtac RepFun_bijective 1);
-by (simp_tac (simpset() addsimps [doubleton_eq_iff]) 1);
-by (Blast_tac 1);
-qed "paired_bij";
-
-Goalw [eqpoll_def] "{{y,z}. y \\<in> x} eqpoll x";
-by (fast_tac (claset() addSIs [paired_bij]) 1);
-qed "paired_eqpoll";
-
-Goal "\\<exists>B. B eqpoll A & B Int C = 0";
-by (fast_tac (claset() addSIs [paired_eqpoll, equals0I] addEs [mem_asym]) 1);
-qed "ex_eqpoll_disjoint";
-
-Goal "[| A lepoll i; B lepoll i; ~Finite(i); Ord(i) |] \
-\ ==> A Un B lepoll i";
-by (res_inst_tac [("A1","i"), ("C1","i")] (ex_eqpoll_disjoint RS exE) 1);
-by (etac conjE 1);
-by (dresolve_tac [eqpoll_sym RS eqpoll_imp_lepoll RSN (2, lepoll_trans)] 1);
-by (assume_tac 1);
-by (resolve_tac [Un_lepoll_Un RS lepoll_trans] 1 THEN (REPEAT (assume_tac 1)));
-by (eresolve_tac [eqpoll_refl RSN (2, Un_eqpoll_Inf_Ord) RS
- eqpoll_imp_lepoll] 1
- THEN (REPEAT (assume_tac 1)));
-qed "Un_lepoll_Inf_Ord";
-
-Goal "[| P(i); i \\<in> j; Ord(j) |] ==> (LEAST i. P(i)) \\<in> j";
-by (eresolve_tac [Least_le RS leE] 1);
-by (etac Ord_in_Ord 1 THEN (assume_tac 1));
-by (etac ltE 1);
-by (fast_tac (claset() addDs [OrdmemD]) 1);
-by (etac subst_elem 1 THEN (assume_tac 1));
-qed "Least_in_Ord";
-
-Goal "[| well_ord(x,r); y \\<subseteq> x; y lepoll succ(n); n \\<in> nat |] \
-\ ==> y-{THE b. first(b,y,r)} lepoll n";
-by (res_inst_tac [("Q","y=0")] (excluded_middle RS disjE) 1);
-by (fast_tac (claset() addSIs [Diff_sing_lepoll, the_first_in]) 1);
-by (res_inst_tac [("b","y-{THE b. first(b, y, r)}")] subst 1);
-by (rtac empty_lepollI 2);
-by (Fast_tac 1);
-qed "Diff_first_lepoll";
-
-Goal "(\\<Union>x \\<in> X. P(x)) \\<subseteq> (\\<Union>x \\<in> X. P(x)-Q(x)) Un (\\<Union>x \\<in> X. Q(x))";
-by (Fast_tac 1);
-qed "UN_subset_split";
-
-Goalw [lepoll_def] "Ord(a) ==> (\\<Union>x \\<in> a. {P(x)}) lepoll a";
-by (res_inst_tac [("x","\\<lambda>z \\<in> (\\<Union>x \\<in> a. {P(x)}). (LEAST i. P(i)=z)")] exI 1);
-by (res_inst_tac [("d","%z. P(z)")] lam_injective 1);
-by (fast_tac (claset() addSIs [Least_in_Ord]) 1);
-by (fast_tac (claset() addIs [LeastI] addSEs [Ord_in_Ord]) 1);
-qed "UN_sing_lepoll";
-
-Goal "[| well_ord(T, R); ~Finite(a); Ord(a); n \\<in> nat |] ==> \
-\ \\<forall>f. (\\<forall>b \\<in> a. f`b lepoll n & f`b \\<subseteq> T) --> (\\<Union>b \\<in> a. f`b) lepoll a";
-by (induct_tac "n" 1);
-by (rtac allI 1);
-by (rtac impI 1);
-by (res_inst_tac [("b","\\<Union>b \\<in> a. f`b")] subst 1);
-by (rtac empty_lepollI 2);
-by (resolve_tac [equals0I RS sym] 1);
-by (REPEAT (eresolve_tac [UN_E, allE] 1));
-by (fast_tac (claset() addDs [lepoll_0_is_0 RS subst]) 1);
-by (rtac allI 1);
-by (rtac impI 1);
-by (eres_inst_tac [("x","\\<lambda>x \\<in> a. f`x - {THE b. first(b,f`x,R)}")] allE 1);
-by (etac impE 1);
-by (Asm_full_simp_tac 1);
-by (fast_tac (claset() addSIs [Diff_first_lepoll]) 1);
-by (Asm_full_simp_tac 1);
-by (resolve_tac [UN_subset_split RS subset_imp_lepoll RS lepoll_trans] 1);
-by (rtac Un_lepoll_Inf_Ord 1 THEN (REPEAT_FIRST assume_tac));
-by (etac UN_sing_lepoll 1);
-qed "UN_fun_lepoll_lemma";
-
-Goal "[| \\<forall>b \\<in> a. f`b lepoll n & f`b \\<subseteq> T; well_ord(T, R); \
-\ ~Finite(a); Ord(a); n \\<in> nat |] ==> (\\<Union>b \\<in> a. f`b) lepoll a";
-by (eresolve_tac [UN_fun_lepoll_lemma RS allE] 1 THEN (REPEAT (assume_tac 1)));
-by (Fast_tac 1);
-qed "UN_fun_lepoll";
-
-Goal "[| \\<forall>b \\<in> a. F(b) lepoll n & F(b) \\<subseteq> T; well_ord(T, R); \
-\ ~Finite(a); Ord(a); n \\<in> nat |] ==> (\\<Union>b \\<in> a. F(b)) lepoll a";
-by (rtac impE 1 THEN (assume_tac 3));
-by (res_inst_tac [("f","\\<lambda>b \\<in> a. F(b)")] (UN_fun_lepoll) 2
- THEN (TRYALL assume_tac));
-by Auto_tac;
-qed "UN_lepoll";
-
-Goal "Ord(a) ==> (\\<Union>b \\<in> a. F(b)) = (\\<Union>b \\<in> a. F(b) - (\\<Union>c \\<in> b. F(c)))";
-by (rtac equalityI 1);
-by (Fast_tac 2);
-by (rtac subsetI 1);
-by (etac UN_E 1);
-by (rtac UN_I 1);
-by (res_inst_tac [("P","%z. x \\<in> F(z)")] Least_in_Ord 1 THEN (REPEAT (assume_tac 1)));
-by (rtac DiffI 1);
-by (resolve_tac [Ord_in_Ord RSN (2, LeastI)] 1 THEN (REPEAT (assume_tac 1)));
-by (rtac notI 1);
-by (etac UN_E 1);
-by (eres_inst_tac [("P","%z. x \\<in> F(z)"),("i","c")] less_LeastE 1);
-by (eresolve_tac [Ord_Least RSN (2, ltI)] 1);
-qed "UN_eq_UN_Diffs";
-
-Goalw [lepoll_def, eqpoll_def]
- "a lepoll X ==> \\<exists>Y. Y \\<subseteq> X & a eqpoll Y";
-by (etac exE 1);
-by (forward_tac [subset_refl RSN (2, restrict_bij)] 1);
-by (res_inst_tac [("x","f``a")] exI 1);
-by (fast_tac (claset() addSEs [inj_is_fun RS fun_is_rel RS image_subset]) 1);
-qed "lepoll_imp_eqpoll_subset";
-
-(* ********************************************************************** *)
-(* Diff_lesspoll_eqpoll_Card *)
-(* ********************************************************************** *)
-
-Goal "[| A\\<approx>a; ~Finite(a); Card(a); B lesspoll a; A-B lesspoll a |] ==> P";
-by (REPEAT (eresolve_tac [lesspoll_imp_ex_lt_eqpoll RS exE,
- Card_is_Ord, conjE] 1));
-by (forw_inst_tac [("j","xa")] ([lt_Ord, lt_Ord] MRS Un_upper1_le) 1
- THEN (assume_tac 1));
-by (forw_inst_tac [("j","xa")] ([lt_Ord, lt_Ord] MRS Un_upper2_le) 1
- THEN (assume_tac 1));
-by (dtac Un_least_lt 1 THEN (assume_tac 1));
-by (dresolve_tac [le_imp_lepoll RSN
- (2, eqpoll_imp_lepoll RS lepoll_trans)] 1
- THEN (assume_tac 1));
-by (dresolve_tac [le_imp_lepoll RSN
- (2, eqpoll_imp_lepoll RS lepoll_trans)] 1
- THEN (assume_tac 1));
-by (res_inst_tac [("Q","Finite(x Un xa)")] (excluded_middle RS disjE) 1);
-by (dresolve_tac [[lepoll_Finite, lepoll_Finite] MRS Finite_Un] 2
- THEN (REPEAT (assume_tac 2)));
-by (dresolve_tac [subset_Un_Diff RS subset_imp_lepoll RS lepoll_Finite] 2);
-by (fast_tac (claset()
- addDs [eqpoll_sym RS eqpoll_imp_lepoll RS lepoll_Finite]) 2);
-by (dresolve_tac [ Un_lepoll_Inf_Ord] 1 THEN (REPEAT (assume_tac 1)));
-by (fast_tac (claset() addSEs [ltE, Ord_in_Ord]) 1);
-by (dresolve_tac [subset_Un_Diff RS subset_imp_lepoll RS lepoll_trans RS
- (lt_Card_imp_lesspoll RSN (2, lesspoll_trans1))] 1
- THEN (TRYALL assume_tac));
-by (fast_tac (claset() addSDs [lesspoll_def RS def_imp_iff RS iffD1]) 1);
-qed "Diff_lesspoll_eqpoll_Card_lemma";
-
-Goal "[| A eqpoll a; ~Finite(a); Card(a); B lesspoll a |] \
-\ ==> A - B eqpoll a";
-by (rtac swap 1 THEN (Fast_tac 1));
-by (rtac Diff_lesspoll_eqpoll_Card_lemma 1 THEN (REPEAT (assume_tac 1)));
-by (fast_tac (claset() addSIs [lesspoll_def RS def_imp_iff RS iffD2,
- subset_imp_lepoll RS (eqpoll_imp_lepoll RSN (2, lepoll_trans))]) 1);
-qed "Diff_lesspoll_eqpoll_Card";
-
--- a/src/ZF/AC/Cardinal_aux.thy Wed Jan 16 15:04:37 2002 +0100
+++ b/src/ZF/AC/Cardinal_aux.thy Wed Jan 16 17:52:06 2002 +0100
@@ -1,3 +1,212 @@
-(*Dummy theory to document dependencies *)
+(* Title: ZF/AC/Cardinal_aux.thy
+ ID: $Id$
+ Author: Krzysztof Grabczewski
+
+Auxiliary lemmas concerning cardinalities
+*)
+
+theory Cardinal_aux = AC_Equiv:
+
+lemma Diff_lepoll: "[| A \<lesssim> succ(m); B \<subseteq> A; B\<noteq>0 |] ==> A-B \<lesssim> m"
+apply (rule not_emptyE, (assumption))
+apply (blast intro: lepoll_trans [OF subset_imp_lepoll Diff_sing_lepoll])
+done
+
+
+(* ********************************************************************** *)
+(* Lemmas involving ordinals and cardinalities used in the proofs *)
+(* concerning AC16 and DC *)
+(* ********************************************************************** *)
+
+
+(* j=|A| *)
+lemma lepoll_imp_ex_le_eqpoll:
+ "[| A \<lesssim> i; Ord(i) |] ==> \<exists>j. j le i & A \<approx> j"
+by (blast intro!: lepoll_cardinal_le well_ord_Memrel
+ well_ord_cardinal_eqpoll [THEN eqpoll_sym]
+ dest: lepoll_well_ord);
+
+(* j=|A| *)
+lemma lesspoll_imp_ex_lt_eqpoll:
+ "[| A \<prec> i; Ord(i) |] ==> \<exists>j. j<i & A \<approx> j"
+by (unfold lesspoll_def, blast dest!: lepoll_imp_ex_le_eqpoll elim!: leE)
+
+lemma Inf_Ord_imp_InfCard_cardinal: "[| ~Finite(i); Ord(i) |] ==> InfCard(|i|)"
+apply (unfold InfCard_def)
+apply (rule conjI)
+apply (rule Card_cardinal)
+apply (rule Card_nat
+ [THEN Card_def [THEN def_imp_iff, THEN iffD1, THEN ssubst]])
+ -- "rewriting would loop!"
+apply (rule well_ord_Memrel [THEN well_ord_lepoll_imp_Card_le], assumption)
+apply (rule nat_le_infinite_Ord [THEN le_imp_lepoll], assumption+)
+done
+
+text{*An alternative and more general proof goes like this: A and B are both
+well-ordered (because they are injected into an ordinal), either A lepoll B
+or B lepoll A. Also both are equipollent to their cardinalities, so
+(if A and B are infinite) then A Un B lepoll |A|+|B| = max(|A|,|B|) lepoll i.
+In fact, the correctly strengthened version of this theorem appears below.*}
+lemma Un_lepoll_Inf_Ord_weak:
+ "[|A \<approx> i; B \<approx> i; \<not> Finite(i); Ord(i)|] ==> A \<union> B \<lesssim> i"
+apply (rule Un_lepoll_sum [THEN lepoll_trans])
+apply (rule lepoll_imp_sum_lepoll_prod [THEN lepoll_trans])
+apply (erule eqpoll_trans [THEN eqpoll_imp_lepoll])
+apply (erule eqpoll_sym)
+apply (rule subset_imp_lepoll [THEN lepoll_trans, THEN lepoll_trans])
+apply (rule nat_2I [THEN OrdmemD], rule Ord_nat)
+apply (rule nat_le_infinite_Ord [THEN le_imp_lepoll], assumption+)
+apply (erule eqpoll_sym [THEN eqpoll_imp_lepoll])
+apply (erule prod_eqpoll_cong [THEN eqpoll_imp_lepoll, THEN lepoll_trans],
+ assumption)
+apply (rule eqpoll_imp_lepoll)
+apply (rule well_ord_Memrel [THEN well_ord_InfCard_square_eq], assumption)
+apply (rule Inf_Ord_imp_InfCard_cardinal, assumption+)
+done
+
+lemma Un_eqpoll_Inf_Ord:
+ "[| A \<approx> i; B \<approx> i; ~Finite(i); Ord(i) |] ==> A Un B \<approx> i"
+apply (rule eqpollI)
+apply (blast intro: Un_lepoll_Inf_Ord_weak)
+apply (erule eqpoll_sym [THEN eqpoll_imp_lepoll, THEN lepoll_trans])
+apply (rule Un_upper1 [THEN subset_imp_lepoll])
+done
+
+lemma paired_bij: "?f \<in> bij({{y,z}. y \<in> x}, x)"
+apply (rule RepFun_bijective)
+apply (simp add: doubleton_eq_iff, blast)
+done
+
+lemma paired_eqpoll: "{{y,z}. y \<in> x} \<approx> x"
+by (unfold eqpoll_def, fast intro!: paired_bij)
+
+lemma ex_eqpoll_disjoint: "\<exists>B. B \<approx> A & B Int C = 0"
+by (fast intro!: paired_eqpoll equals0I elim: mem_asym)
+
+(*Finally we reach this result. Surely there's a simpler proof, as sketched
+ above?*)
+lemma Un_lepoll_Inf_Ord:
+ "[| A \<lesssim> i; B \<lesssim> i; ~Finite(i); Ord(i) |] ==> A Un B \<lesssim> i"
+apply (rule_tac A1 = "i" and C1 = "i" in ex_eqpoll_disjoint [THEN exE])
+apply (erule conjE)
+apply (drule lepoll_trans)
+apply (erule eqpoll_sym [THEN eqpoll_imp_lepoll])
+apply (rule Un_lepoll_Un [THEN lepoll_trans], (assumption+))
+apply (blast intro: eqpoll_refl Un_eqpoll_Inf_Ord eqpoll_imp_lepoll)
+done
+
+lemma Least_in_Ord: "[| P(i); i \<in> j; Ord(j) |] ==> (LEAST i. P(i)) \<in> j"
+apply (erule Least_le [THEN leE])
+apply (erule Ord_in_Ord, assumption)
+apply (erule ltE)
+apply (fast dest: OrdmemD)
+apply (erule subst_elem, assumption)
+done
-Cardinal_aux = AC_Equiv
+lemma Diff_first_lepoll:
+ "[| well_ord(x,r); y \<subseteq> x; y \<lesssim> succ(n); n \<in> nat |]
+ ==> y - {THE b. first(b,y,r)} \<lesssim> n"
+apply (case_tac "y=0", simp add: empty_lepollI)
+apply (fast intro!: Diff_sing_lepoll the_first_in)
+done
+
+lemma UN_subset_split:
+ "(\<Union>x \<in> X. P(x)) \<subseteq> (\<Union>x \<in> X. P(x)-Q(x)) Un (\<Union>x \<in> X. Q(x))"
+by blast
+
+lemma UN_sing_lepoll: "Ord(a) ==> (\<Union>x \<in> a. {P(x)}) \<lesssim> a"
+apply (unfold lepoll_def)
+apply (rule_tac x = "\<lambda>z \<in> (\<Union>x \<in> a. {P (x) }) . (LEAST i. P (i) =z) " in exI)
+apply (rule_tac d = "%z. P (z) " in lam_injective)
+apply (fast intro!: Least_in_Ord)
+apply (fast intro: LeastI elim!: Ord_in_Ord)
+done
+
+lemma UN_fun_lepoll_lemma [rule_format]:
+ "[| well_ord(T, R); ~Finite(a); Ord(a); n \<in> nat |]
+ ==> \<forall>f. (\<forall>b \<in> a. f`b \<lesssim> n & f`b \<subseteq> T) --> (\<Union>b \<in> a. f`b) \<lesssim> a"
+apply (induct_tac "n")
+apply (rule allI)
+apply (rule impI)
+apply (rule_tac b = "\<Union>b \<in> a. f`b" in subst)
+apply (rule_tac [2] empty_lepollI)
+apply (rule equals0I [symmetric], clarify)
+apply (fast dest: lepoll_0_is_0 [THEN subst])
+apply (rule allI)
+apply (rule impI)
+apply (erule_tac x = "\<lambda>x \<in> a. f`x - {THE b. first (b,f`x,R) }" in allE)
+apply (erule impE, simp)
+apply (fast intro!: Diff_first_lepoll, simp)
+apply (rule UN_subset_split [THEN subset_imp_lepoll, THEN lepoll_trans])
+apply (fast intro: Un_lepoll_Inf_Ord UN_sing_lepoll)
+done
+
+lemma UN_fun_lepoll:
+ "[| \<forall>b \<in> a. f`b \<lesssim> n & f`b \<subseteq> T; well_ord(T, R);
+ ~Finite(a); Ord(a); n \<in> nat |] ==> (\<Union>b \<in> a. f`b) \<lesssim> a"
+by (blast intro: UN_fun_lepoll_lemma);
+
+lemma UN_lepoll:
+ "[| \<forall>b \<in> a. F(b) \<lesssim> n & F(b) \<subseteq> T; well_ord(T, R);
+ ~Finite(a); Ord(a); n \<in> nat |]
+ ==> (\<Union>b \<in> a. F(b)) \<lesssim> a"
+apply (rule rev_mp)
+apply (rule_tac f="\<lambda>b \<in> a. F (b)" in UN_fun_lepoll);
+apply auto
+done
+
+lemma UN_eq_UN_Diffs:
+ "Ord(a) ==> (\<Union>b \<in> a. F(b)) = (\<Union>b \<in> a. F(b) - (\<Union>c \<in> b. F(c)))"
+apply (rule equalityI)
+ prefer 2 apply fast
+apply (rule subsetI)
+apply (erule UN_E)
+apply (rule UN_I)
+ apply (rule_tac P = "%z. x \<in> F (z) " in Least_in_Ord, (assumption+))
+apply (rule DiffI, best intro: Ord_in_Ord LeastI, clarify)
+apply (erule_tac P = "%z. x \<in> F (z) " and i = "c" in less_LeastE)
+apply (blast intro: Ord_Least ltI)
+done
+
+lemma lepoll_imp_eqpoll_subset:
+ "a \<lesssim> X ==> \<exists>Y. Y \<subseteq> X & a \<approx> Y"
+apply (unfold lepoll_def eqpoll_def, clarify)
+apply (blast intro: restrict_bij
+ dest: inj_is_fun [THEN fun_is_rel, THEN image_subset])
+done
+
+(* ********************************************************************** *)
+(* Diff_lesspoll_eqpoll_Card *)
+(* ********************************************************************** *)
+
+lemma Diff_lesspoll_eqpoll_Card_lemma:
+ "[| A\<approx>a; ~Finite(a); Card(a); B \<prec> a; A-B \<prec> a |] ==> P"
+apply (elim lesspoll_imp_ex_lt_eqpoll [THEN exE] Card_is_Ord conjE)
+apply (frule_tac j=xa in Un_upper1_le [OF lt_Ord lt_Ord], assumption)
+apply (frule_tac j=xa in Un_upper2_le [OF lt_Ord lt_Ord], assumption)
+apply (drule Un_least_lt, assumption)
+apply (drule eqpoll_imp_lepoll [THEN lepoll_trans],
+ rule le_imp_lepoll, assumption)+
+apply (case_tac "Finite(x Un xa)");
+txt{*finite case*}
+ apply (drule Finite_Un [OF lepoll_Finite lepoll_Finite], assumption+)
+ apply (drule subset_Un_Diff [THEN subset_imp_lepoll, THEN lepoll_Finite])
+ apply (fast dest: eqpoll_sym [THEN eqpoll_imp_lepoll, THEN lepoll_Finite])
+txt{*infinite case*}
+apply (drule Un_lepoll_Inf_Ord, (assumption+))
+apply (blast intro: le_Ord2)
+apply (drule lesspoll_trans1
+ [OF subset_Un_Diff [THEN subset_imp_lepoll, THEN lepoll_trans]
+ lt_Card_imp_lesspoll], assumption+)
+apply (simp add: lesspoll_def)
+done
+
+lemma Diff_lesspoll_eqpoll_Card:
+ "[| A \<approx> a; ~Finite(a); Card(a); B \<prec> a |] ==> A - B \<approx> a"
+apply (rule ccontr)
+apply (rule Diff_lesspoll_eqpoll_Card_lemma, (assumption+))
+apply (blast intro: lesspoll_def [THEN def_imp_iff, THEN iffD2]
+ subset_imp_lepoll eqpoll_imp_lepoll lepoll_trans)
+done
+
+end
--- a/src/ZF/AC/DC.ML Wed Jan 16 15:04:37 2002 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,533 +0,0 @@
-(* Title: ZF/AC/DC.ML
- ID: $Id$
- Author: Krzysztof Grabczewski
-
-The proofs concerning the Axiom of Dependent Choice
-*)
-
-(* ********************************************************************** *)
-(* DC ==> DC(omega) *)
-(* *)
-(* The scheme of the proof: *)
-(* *)
-(* Assume DC. Let R and X satisfy the premise of DC(omega). *)
-(* *)
-(* Define XX and RR as follows: *)
-(* *)
-(* XX = (\\<Union>n \\<in> nat. {f \\<in> n->X. \\<forall>k \\<in> n. <f``k, f`k> \\<in> R}) *)
-(* f RR g iff domain(g)=succ(domain(f)) & *)
-(* restrict(g, domain(f)) = f *)
-(* *)
-(* Then RR satisfies the hypotheses of DC. *)
-(* So applying DC: *)
-(* *)
-(* \\<exists>f \\<in> nat->XX. \\<forall>n \\<in> nat. f`n RR f`succ(n) *)
-(* *)
-(* Thence *)
-(* *)
-(* ff = {<n, f`succ(n)`n>. n \\<in> nat} *)
-(* *)
-(* is the desired function. *)
-(* *)
-(* ********************************************************************** *)
-
-Open_locale "DC0_imp";
-
-val all_ex = thm "all_ex";
-val XX_def = thm "XX_def";
-val RR_def = thm "RR_def";
-
-Goalw [RR_def] "RR \\<subseteq> XX*XX";
-by (Fast_tac 1);
-qed "lemma1_1";
-
-Goalw [RR_def, XX_def] "RR \\<noteq> 0";
-by (rtac (all_ex RS ballE) 1);
-by (eresolve_tac [empty_subsetI RS PowI RSN (2, notE)] 2);
-by (eresolve_tac [nat_0I RS n_lesspoll_nat RSN (2, impE)] 1);
-by (etac bexE 1);
-by (res_inst_tac [("a","<0, {<0, x>}>")] not_emptyI 1);
-by (rtac CollectI 1);
-by (rtac SigmaI 1);
-by (rtac (nat_0I RS UN_I) 1);
-by (asm_simp_tac (simpset() addsimps [nat_0I RS UN_I]) 1);
-by (rtac (nat_1I RS UN_I) 1);
-by (asm_simp_tac (simpset() addsimps [singleton_0]) 2);
-by (force_tac (claset() addSIs [singleton_fun RS Pi_type],
- simpset() addsimps [singleton_0 RS sym]) 1);
-qed "lemma1_2";
-
-Goalw [RR_def, XX_def] "range(RR) \\<subseteq> domain(RR)";
-by (rtac range_subset_domain 1);
-by (Blast_tac 2);
-by (Clarify_tac 1);
-by (forward_tac [fun_is_rel RS image_subset RS PowI RS (all_ex RS bspec)] 1);
-by (eresolve_tac [[nat_into_Ord RSN (2, image_Ord_lepoll), n_lesspoll_nat]
- MRS lesspoll_trans1 RSN (2, impE)] 1
- THEN REPEAT (assume_tac 1));
-by (etac bexE 1);
-by (res_inst_tac [("x","cons(<n,x>, g)")] exI 1);
-by (rtac CollectI 1);
-by (force_tac (claset() addSEs [cons_fun_type2],
- simpset() addsimps [cons_image_n, cons_val_n,
- cons_image_k, cons_val_k]) 1);
-by (asm_full_simp_tac (simpset()
- addsimps [domain_of_fun, succ_def, restrict_cons_eq]) 1);
-qed "lemma1_3";
-
-
-Goal "[| \\<forall>n \\<in> nat. <f`n, f`succ(n)> \\<in> RR; f \\<in> nat -> XX; n \\<in> nat |] \
-\ ==> \\<exists>k \\<in> nat. f`succ(n) \\<in> k -> X & n \\<in> k \
-\ & <f`succ(n)``n, f`succ(n)`n> \\<in> R";
-by (induct_tac "n" 1);
-by (dresolve_tac [nat_1I RSN (2, apply_type)] 1);
-by (dresolve_tac [nat_0I RSN (2, bspec)] 1);
-by (asm_full_simp_tac (simpset() addsimps [XX_def]) 1);
-by Safe_tac;
-by (rtac bexI 1 THEN (assume_tac 2));
-by (best_tac (claset() addIs [ltD]
- addSEs [nat_0_le RS leE]
- addEs [sym RS trans RS succ_neq_0, domain_of_fun]
- addss (simpset() addsimps [RR_def])) 1);
-(** LEVEL 7, other subgoal **)
-by (dresolve_tac [nat_succI RSN (2, bspec)] 1 THEN (assume_tac 1));
-by (subgoal_tac "f ` succ(succ(x)) \\<in> succ(k)->X" 1);
-by (dresolve_tac [nat_succI RS nat_succI RSN (2, apply_type)] 1
- THEN (assume_tac 1));
-by (full_simp_tac (simpset() addsimps [XX_def,RR_def]) 1);
-by Safe_tac;
-by (forw_inst_tac [("a","succ(k)")] (domain_of_fun RS sym RS trans) 1 THEN
- (assume_tac 1));
-by (forw_inst_tac [("a","xa")] (domain_of_fun RS sym RS trans) 1 THEN
- (assume_tac 1));
-by (fast_tac (claset() addSEs [nat_into_Ord RS succ_in_succ]
- addSDs [nat_into_Ord RS succ_in_succ RSN (2, bspec)]) 1);
-by (dtac domain_of_fun 1);
-by (full_simp_tac (simpset() addsimps [XX_def,RR_def]) 1);
-by (deepen_tac (claset() addDs [domain_of_fun RS sym RS trans]) 0 1);
-qed "lemma2";
-
-Goal "[| \\<forall>n \\<in> nat. <f`n, f`succ(n)> \\<in> RR; f \\<in> nat -> XX; m \\<in> nat |] \
-\ ==> {f`succ(x)`x. x \\<in> m} = {f`succ(m)`x. x \\<in> m}";
-by (subgoal_tac "\\<forall>x \\<in> m. f`succ(m)`x = f`succ(x)`x" 1);
-by (Asm_full_simp_tac 1);
-by (induct_tac "m" 1);
-by (Fast_tac 1);
-by (rtac ballI 1);
-by (etac succE 1);
-by (rtac restrict_eq_imp_val_eq 1);
-by (dresolve_tac [nat_succI RSN (2, bspec)] 1 THEN (assume_tac 1));
-by (asm_full_simp_tac (simpset() addsimps [RR_def]) 1);
-by (dtac lemma2 1 THEN REPEAT (assume_tac 1));
-by (fast_tac (claset() addSDs [domain_of_fun]) 1);
-by (dres_inst_tac [("x","xa")] bspec 1 THEN (assume_tac 1));
-by (eresolve_tac [sym RS trans RS sym] 1);
-by (resolve_tac [restrict_eq_imp_val_eq RS sym] 1);
-by (dresolve_tac [nat_succI RSN (2, bspec)] 1 THEN (assume_tac 1));
-by (asm_full_simp_tac (simpset() addsimps [RR_def]) 1);
-by (dtac lemma2 1 THEN REPEAT (assume_tac 1));
-by (blast_tac (claset() addSDs [domain_of_fun]
- addIs [nat_into_Ord RSN (2, OrdmemD) RS subsetD]) 1);
-qed "lemma3_1";
-
-Goal "[| \\<forall>n \\<in> nat. <f`n, f`succ(n)> \\<in> RR; f \\<in> nat -> XX; m \\<in> nat |] \
-\ ==> (\\<lambda>x \\<in> nat. f`succ(x)`x) `` m = f`succ(m)``m";
-by (etac natE 1);
-by (Asm_simp_tac 1);
-by (stac image_lam 1);
-by (fast_tac (claset() addSEs [[nat_succI, Ord_nat] MRS OrdmemD]) 1);
-by (stac lemma3_1 1 THEN REPEAT (assume_tac 1));
-by (Fast_tac 1);
-by (fast_tac (claset() addSDs [lemma2]
- addSEs [nat_into_Ord RSN (2, OrdmemD) RSN
- (2, image_fun RS sym)]) 1);
-qed "lemma3";
-
-Close_locale "DC0_imp";
-
-Goalw [DC_def, DC0_def] "DC0 ==> DC(nat)";
-by (Clarify_tac 1);
-by (REPEAT (etac allE 1));
-by (etac impE 1);
- (*these three results comprise Lemma 1*)
-by (blast_tac (claset() addSIs (map export [lemma1_1, lemma1_2, lemma1_3])) 1);
-by (etac bexE 1);
-by (res_inst_tac [("x","\\<lambda>n \\<in> nat. f`succ(n)`n")] bexI 1);
-by (fast_tac (claset() addSIs [lam_type] addSDs [export lemma2]
- addSEs [fun_weaken_type, apply_type]) 2);
-by (rtac oallI 1);
-by (forward_tac [ltD RSN (3, export lemma2)] 1
- THEN assume_tac 2);
-by (fast_tac (claset() addSEs [fun_weaken_type]) 1);
-(** LEVEL 10: last subgoal **)
-by (stac (ltD RSN (3, export lemma3)) 1);
-by (Force_tac 4);
-by (assume_tac 3);
-by (assume_tac 1);
-by (fast_tac (claset() addSEs [fun_weaken_type]) 1);
-qed "DC0_imp_DC_nat";
-
-
-(* ************************************************************************
- DC(omega) ==> DC
-
- The scheme of the proof:
-
- Assume DC(omega). Let R and x satisfy the premise of DC.
-
- Define XX and RR as follows:
-
- XX = (\\<Union>n \\<in> nat. {f \\<in> succ(n)->domain(R). \\<forall>k \\<in> n. <f`k, f`succ(k)> \\<in> R})
-
- RR = {<z1,z2>:Fin(XX)*XX.
- (domain(z2)=succ(\\<Union>f \\<in> z1. domain(f)) &
- (\\<forall>f \\<in> z1. restrict(z2, domain(f)) = f)) |
- (~ (\\<exists>g \\<in> XX. domain(g)=succ(\\<Union>f \\<in> z1. domain(f)) &
- (\\<forall>f \\<in> z1. restrict(g, domain(f)) = f)) &
- z2={<0,x>})}
-
- Then XX and RR satisfy the hypotheses of DC(omega).
- So applying DC:
-
- \\<exists>f \\<in> nat->XX. \\<forall>n \\<in> nat. f``n RR f`n
-
- Thence
-
- ff = {<n, f`n`n>. n \\<in> nat}
-
- is the desired function.
-
-************************************************************************* *)
-
-Goal "n \\<in> nat ==> \\<forall>A. (A eqpoll n & A \\<subseteq> X) --> A \\<in> Fin(X)";
-by (induct_tac "n" 1);
-by (rtac allI 1);
-by (fast_tac (claset() addSIs [Fin.emptyI]
- addSDs [eqpoll_imp_lepoll RS lepoll_0_is_0]) 1);
-by (rtac allI 1);
-by (rtac impI 1);
-by (etac conjE 1);
-by (resolve_tac [eqpoll_succ_imp_not_empty RS not_emptyE] 1
- THEN (assume_tac 1));
-by (ftac Diff_sing_eqpoll 1 THEN (assume_tac 1));
-by (etac allE 1);
-by (etac impE 1);
-by (Fast_tac 1);
-by (dtac subsetD 1 THEN (assume_tac 1));
-by (dresolve_tac [Fin.consI] 1 THEN (assume_tac 1));
-by (asm_full_simp_tac (simpset() addsimps [cons_Diff]) 1);
-qed "Finite_Fin_lemma";
-
-Goalw [Finite_def] "[| Finite(A); A \\<subseteq> X |] ==> A \\<in> Fin(X)";
-by (etac bexE 1);
-by (dtac Finite_Fin_lemma 1);
-by (etac allE 1);
-by (etac impE 1);
-by (assume_tac 2);
-by (Fast_tac 1);
-qed "Finite_Fin";
-
-Goal
- "x \\<in> X ==> {<0,x>}: (\\<Union>n \\<in> nat. {f \\<in> succ(n)->X. \\<forall>k \\<in> n. <f`k, f`succ(k)> \\<in> R})";
-by (rtac (nat_0I RS UN_I) 1);
-by (fast_tac (claset() addSIs [singleton_fun RS Pi_type]
- addss (simpset() addsimps [singleton_0 RS sym])) 1);
-qed "singleton_in_funs";
-
-
-Open_locale "imp_DC0";
-
-val XX_def = thm "XX_def";
-val RR_def = thm "RR_def";
-val allRR_def = thm "allRR_def";
-
-Goal "[| range(R) \\<subseteq> domain(R); x \\<in> domain(R) |] \
-\ ==> RR \\<subseteq> Pow(XX)*XX & \
-\ (\\<forall>Y \\<in> Pow(XX). Y lesspoll nat --> (\\<exists>x \\<in> XX. <Y,x>:RR))";
-by (rtac conjI 1);
-by (force_tac (claset() addSDs [FinD RS PowI],
- simpset() addsimps [RR_def]) 1);
-by (rtac (impI RS ballI) 1);
-by (dresolve_tac [[lesspoll_nat_is_Finite, PowD] MRS Finite_Fin] 1
- THEN (assume_tac 1));
-by (excluded_middle_tac "\\<exists>g \\<in> XX. domain(g)=succ(\\<Union>f \\<in> Y. domain(f)) \
-\ & (\\<forall>f \\<in> Y. restrict(g, domain(f)) = f)" 1);
-by (fast_tac (claset() addss (simpset() addsimps [RR_def])) 2);
-by (safe_tac (claset() delrules [domainE]));
-by (rewrite_goals_tac [XX_def,RR_def]);
-by (swap_res_tac [bexI] 1 THEN etac singleton_in_funs 2);
-by (asm_full_simp_tac (simpset() addsimps [nat_0I RSN (2, bexI),
- cons_fun_type2]) 1);
-qed "lemma4";
-
-Goal "[| f \\<in> nat->X; n \\<in> nat |] ==> \
-\ (\\<Union>x \\<in> f``succ(n). P(x)) = P(f`n) Un (\\<Union>x \\<in> f``n. P(x))";
-by (asm_full_simp_tac (simpset()
- addsimps [Ord_nat RSN (2, OrdmemD) RSN (2, image_fun),
- [nat_succI, Ord_nat] MRS OrdmemD RSN (2, image_fun)]) 1);
-qed "UN_image_succ_eq";
-
-Goal "[| (\\<Union>x \\<in> f``n. P(x)) = y; P(f`n) = succ(y); \
-\ f \\<in> nat -> X; n \\<in> nat |] ==> (\\<Union>x \\<in> f``succ(n). P(x)) = succ(y)";
-by (asm_full_simp_tac (simpset() addsimps [UN_image_succ_eq]) 1);
-by (Fast_tac 1);
-qed "UN_image_succ_eq_succ";
-
-Goal "[| f \\<in> succ(n) -> D; n \\<in> nat; \
-\ domain(f)=succ(x); x=y |] ==> f`y \\<in> D";
-by (fast_tac (claset() addEs [apply_type]
- addSDs [[sym, domain_of_fun] MRS trans]) 1);
-qed "apply_domain_type";
-
-Goal "[| f \\<in> nat -> X; n \\<in> nat |] ==> f``succ(n) = cons(f`n, f``n)";
-by (asm_full_simp_tac (simpset()
- addsimps [nat_succI, Ord_nat RSN (2, OrdmemD), image_fun]) 1);
-qed "image_fun_succ";
-
-Goalw [XX_def] "[| domain(f`n) = succ(u); f \\<in> nat -> XX; u=k; n \\<in> nat |] \
-\ ==> f`n \\<in> succ(k) -> domain(R)";
-by (dtac apply_type 1 THEN (assume_tac 1));
-by (fast_tac (claset() addEs [domain_eq_imp_fun_type]) 1);
-qed "f_n_type";
-
-Goalw [XX_def]
- "[| f \\<in> nat -> XX; domain(f`n) = succ(k); n \\<in> nat |] \
-\ ==> \\<forall>i \\<in> k. <f`n`i, f`n`succ(i)> \\<in> R";
-by (dtac apply_type 1 THEN (assume_tac 1));
-by (etac UN_E 1);
-by (etac CollectE 1);
-by (dresolve_tac [domain_of_fun RS sym RS trans] 1 THEN (assume_tac 1));
-by (Asm_full_simp_tac 1);
-qed "f_n_pairs_in_R";
-
-Goalw [restrict_def]
- "[| restrict(f, domain(x))=x; f \\<in> n->X; domain(x) \\<subseteq> n |] \
-\ ==> restrict(cons(<n, y>, f), domain(x)) = x";
-by (eresolve_tac [sym RS trans RS sym] 1);
-by (rtac fun_extension 1);
-by (fast_tac (claset() addSIs [lam_type]) 1);
-by (fast_tac (claset() addSIs [lam_type]) 1);
-by (asm_full_simp_tac (simpset() addsimps [subsetD RS cons_val_k]) 1);
-qed "restrict_cons_eq_restrict";
-
-Goal "[| \\<forall>x \\<in> f``n. restrict(f`n, domain(x))=x; \
-\ f \\<in> nat -> XX; \
-\ n \\<in> nat; domain(f`n) = succ(n); \
-\ (\\<Union>x \\<in> f``n. domain(x)) \\<subseteq> n |] \
-\ ==> \\<forall>x \\<in> f``succ(n). restrict(cons(<succ(n),y>, f`n), domain(x)) = x";
-by (rtac ballI 1);
-by (asm_full_simp_tac (simpset() addsimps [image_fun_succ]) 1);
-by (dtac f_n_type 1 THEN REPEAT (ares_tac [refl] 1));
-by (etac disjE 1);
-by (asm_full_simp_tac (simpset() addsimps [domain_of_fun,restrict_cons_eq]) 1);
-by (dtac bspec 1 THEN (assume_tac 1));
-by (fast_tac (claset() addSEs [restrict_cons_eq_restrict]) 1);
-qed "all_in_image_restrict_eq";
-
-Goalw [RR_def, allRR_def]
- "[| \\<forall>b<nat. <f``b, f`b> \\<in> RR; \
-\ f \\<in> nat -> XX; range(R) \\<subseteq> domain(R); x \\<in> domain(R)|] \
-\ ==> allRR";
-by (rtac oallI 1);
-by (dtac ltD 1);
-by (etac nat_induct 1);
-by (dresolve_tac [[nat_0I, Ord_nat] MRS ltI RSN (2, ospec)] 1);
-by (fast_tac (FOL_cs addss
- (simpset() addsimps [singleton_fun RS domain_of_fun,
- singleton_0, singleton_in_funs])) 1);
-(*induction step*) (** LEVEL 5 **)
-by (full_simp_tac (*prevent simplification of ~\\<exists>to \\<forall>~*)
- (FOL_ss addsimps [separation, split]) 1);
-by (dresolve_tac [[nat_succI, Ord_nat] MRS ltI RSN (2, ospec)] 1
- THEN (assume_tac 1));
-by (REPEAT (eresolve_tac [conjE, disjE] 1));
-by (force_tac (FOL_cs addSEs [trans, subst_context]
- addSIs [UN_image_succ_eq_succ], simpset()) 1);
-by (etac conjE 1);
-by (etac notE 1);
-by (asm_lr_simp_tac (simpset() addsimps [XX_def, UN_image_succ_eq_succ]) 1);
-(** LEVEL 12 **)
-by (REPEAT (eresolve_tac [conjE, bexE] 1));
-by (dtac apply_domain_type 1 THEN REPEAT (assume_tac 1));
-by (etac domainE 1);
-by (etac domainE 1);
-by (forward_tac [export f_n_type] 1 THEN REPEAT (assume_tac 1));
-by (rtac bexI 1);
-by (etac nat_succI 2);
-by (res_inst_tac [("x","cons(<succ(xa), ya>, f`xa)")] bexI 1);
-by (rtac conjI 1);
-by (fast_tac (FOL_cs
- addEs [subst_context RSN (2, trans) RS domain_cons_eq_succ,
- subst_context, export all_in_image_restrict_eq,
- trans, equalityD1]) 2);
-by (eresolve_tac [rangeI RSN (2, subsetD) RSN (2, cons_fun_type2)] 2
- THEN REPEAT (assume_tac 2));
-by (rtac ballI 1);
-by (etac succE 1);
-(** LEVEL 25 **)
-by (EVERY [dtac (domain_of_fun RSN (2, export f_n_pairs_in_R)) 2,
- REPEAT (assume_tac 2), dtac bspec 2, assume_tac 2]);
-by (asm_full_simp_tac (simpset()
- addsimps [nat_into_Ord RS succ_in_succ, succI2, cons_val_k]) 2);
-by (asm_full_simp_tac (simpset() addsimps [cons_val_n, cons_val_k]) 1);
-qed "simplify_recursion";
-
-
-Goalw [allRR_def]
- "[| allRR; f \\<in> nat -> XX; range(R) \\<subseteq> domain(R); x \\<in> domain(R); n \\<in> nat |] \
-\ ==> f`n \\<in> succ(n) -> domain(R) & (\\<forall>i \\<in> n. <f`n`i, f`n`succ(i)>:R)";
-by (dtac ospec 1);
-by (eresolve_tac [Ord_nat RSN (2, ltI)] 1);
-by (etac CollectE 1);
-by (Asm_full_simp_tac 1);
-by (rtac conjI 1);
-by (fast_tac (FOL_cs addSEs [conjE, f_n_pairs_in_R, trans, subst_context]) 2);
-by (rewtac XX_def);
-by (fast_tac (claset()
- addSEs [trans RS domain_eq_imp_fun_type, subst_context]) 1);
-qed "lemma2";
-
-Goal "[| allRR; f \\<in> nat -> XX; n \\<in> nat; range(R) \\<subseteq> domain(R); x \\<in> domain(R) \
-\ |] ==> f`n`n = f`succ(n)`n";
-by (forward_tac [lemma2 RS conjunct1 RS domain_of_fun] 1
- THEN REPEAT (assume_tac 1));
-by (rewtac allRR_def);
-by (dresolve_tac [[nat_succI, Ord_nat] MRS ltI RSN (2, ospec)] 1
- THEN (assume_tac 1));
-by (Asm_full_simp_tac 1);
-by (REPEAT (etac conjE 1));
-by (etac ballE 1);
-by (eresolve_tac [restrict_eq_imp_val_eq RS sym] 1);
-by (fast_tac (claset() addSEs [ssubst]) 1);
-by (asm_full_simp_tac (simpset()
- addsimps [[nat_succI, Ord_nat] MRS OrdmemD RSN (2, image_fun)]) 1);
-qed "lemma3";
-
-Close_locale "imp_DC0";
-
-
-Goalw [DC_def, DC0_def] "DC(nat) ==> DC0";
-by (REPEAT (resolve_tac [allI, impI] 1));
-by (REPEAT (eresolve_tac [asm_rl, conjE, ex_in_domain RS exE, allE] 1));
-by (eresolve_tac [export lemma4 RSN (2, impE)] 1
- THEN REPEAT (assume_tac 1));
-by (etac bexE 1);
-by (dresolve_tac [export simplify_recursion] 1
- THEN REPEAT (assume_tac 1));
-by (res_inst_tac [("x","\\<lambda>n \\<in> nat. f`n`n")] bexI 1);
-by (rtac lam_type 2);
-by (eresolve_tac [[export lemma2 RS conjunct1, succI1] MRS apply_type] 2
- THEN REPEAT (assume_tac 2));
-by (rtac ballI 1);
-by (forward_tac [export (nat_succI RSN (5,lemma2)) RS conjunct2] 1
- THEN REPEAT (assume_tac 1));
-by (dresolve_tac [export lemma3] 1 THEN REPEAT (assume_tac 1));
-by (asm_full_simp_tac (simpset() addsimps [nat_succI]) 1);
-qed "DC_nat_imp_DC0";
-
-(* ********************************************************************** *)
-(* \\<forall>K. Card(K) --> DC(K) ==> WO3 *)
-(* ********************************************************************** *)
-
-Goalw [lesspoll_def]
- "[| ~ A lesspoll B; C lesspoll B |] ==> A - C \\<noteq> 0";
-by (fast_tac (claset() addSDs [Diff_eq_0_iff RS iffD1 RS subset_imp_lepoll]
- addSIs [eqpollI] addEs [notE] addSEs [eqpollE, lepoll_trans]) 1);
-qed "lesspoll_lemma";
-
-val [f_type, Ord_a, not_eq] = goalw thy [inj_def]
- "[| f \\<in> a->X; Ord(a); (!!b c. [| b<c; c \\<in> a |] ==> f`b\\<noteq>f`c) |] \
-\ ==> f \\<in> inj(a, X)";
-by (resolve_tac [f_type RS CollectI] 1);
-by (REPEAT (resolve_tac [ballI,impI] 1));
-by (resolve_tac [Ord_a RS Ord_in_Ord RS Ord_linear_lt] 1
- THEN (assume_tac 1));
-by (eres_inst_tac [("j","x")] (Ord_a RS Ord_in_Ord) 1);
-by (REPEAT (fast_tac (claset() addDs [not_eq, not_eq RS not_sym]) 1));
-qed "fun_Ord_inj";
-
-Goal "[| f \\<in> X->Y; A \\<subseteq> X; a \\<in> A |] ==> f`a \\<in> f``A";
-by (fast_tac (claset() addSEs [image_fun RS ssubst]) 1);
-qed "value_in_image";
-
-Goalw [DC_def, WO3_def] "\\<forall>K. Card(K) --> DC(K) ==> WO3";
-by (rtac allI 1);
-by (excluded_middle_tac "A lesspoll Hartog(A)" 1);
-by (fast_tac (claset() addSDs [lesspoll_imp_ex_lt_eqpoll]
- addSIs [Ord_Hartog, leI RS le_imp_subset]) 2);
-by (REPEAT (eresolve_tac [allE, impE] 1));
-by (rtac Card_Hartog 1);
-by (eres_inst_tac [("x","A")] allE 1);
-by (eres_inst_tac [("x","{<z1,z2>:Pow(A)*A . z1 \
-\ lesspoll Hartog(A) & z2 \\<notin> z1}")] allE 1);
-by (Asm_full_simp_tac 1);
-by (etac impE 1);
-by (fast_tac (claset() addEs [lesspoll_lemma RS not_emptyE]) 1);
-by (etac bexE 1);
-by (resolve_tac [exI RS (lepoll_def RS (def_imp_iff RS iffD2))
- RS (HartogI RS notE)] 1);
-by (resolve_tac [Ord_Hartog RSN (2, fun_Ord_inj)] 1 THEN (assume_tac 1));
-by (dresolve_tac [Ord_Hartog RSN (2, OrdmemD) RSN (2,
- ltD RSN (3, value_in_image))] 1
- THEN REPEAT (assume_tac 1));
-by (force_tac (claset() addSDs [Ord_Hartog RSN (2, ltI) RSN (2, ospec)],
- simpset()) 1);
-qed "DC_WO3";
-
-(* ********************************************************************** *)
-(* WO1 ==> \\<forall>K. Card(K) --> DC(K) *)
-(* ********************************************************************** *)
-
-Goal "[| Ord(a); b \\<in> a |] ==> (\\<lambda>x \\<in> a. P(x))``b = (\\<lambda>x \\<in> b. P(x))``b";
-by (rtac images_eq 1);
-by (REPEAT (fast_tac (claset() addSEs [RepFunI, OrdmemD]
- addSIs [lam_type]) 2));
-by (rtac ballI 1);
-by (dresolve_tac [OrdmemD RS subsetD] 1
- THEN REPEAT (assume_tac 1));
-by (Asm_full_simp_tac 1);
-qed "lam_images_eq";
-
-Goalw [lesspoll_def] "[| Card(K); b \\<in> K |] ==> b lesspoll K";
-by (asm_full_simp_tac (simpset() addsimps [Card_iff_initial]) 1);
-by (fast_tac (claset() addSIs [le_imp_lepoll, ltI, leI]) 1);
-qed "in_Card_imp_lesspoll";
-
-Goal "(\\<lambda>b \\<in> a. P(b)) \\<in> a -> {P(b). b \\<in> a}";
-by (fast_tac (claset() addSIs [lam_type, RepFunI]) 1);
-qed "lam_type_RepFun";
-
-Goal "[| \\<forall>Y \\<in> Pow(X). Y lesspoll K --> (\\<exists>x \\<in> X. <Y, x> \\<in> R); \
-\ b \\<in> K; Z \\<in> Pow(X); Z lesspoll K |] \
-\ ==> {x \\<in> X. <Z,x> \\<in> R} \\<noteq> 0";
-by (Blast_tac 1);
-qed "lemmaX";
-
-Goal "[| Card(K); well_ord(X,Q); \
-\ \\<forall>Y \\<in> Pow(X). Y lesspoll K --> (\\<exists>x \\<in> X. <Y, x> \\<in> R); b \\<in> K |] \
-\ ==> ff(b, X, Q, R) \\<in> {x \\<in> X. <(\\<lambda>c \\<in> b. ff(c, X, Q, R))``b, x> \\<in> R}";
-by (res_inst_tac [("P","b \\<in> K")] impE 1 THEN TRYALL assume_tac);
-by (res_inst_tac [("i","b")] (Card_is_Ord RS Ord_in_Ord RS trans_induct) 1
- THEN REPEAT (assume_tac 1));
-by (rtac impI 1);
-by (resolve_tac [ff_def RS def_transrec RS ssubst] 1);
-by (etac the_first_in 1);
-by (Fast_tac 1);
-by (asm_full_simp_tac (simpset()
- addsimps [[lam_type_RepFun, subset_refl] MRS image_fun]) 1);
-by (etac lemmaX 1 THEN assume_tac 1);
-by (blast_tac (claset() addIs [Card_is_Ord RSN (2, OrdmemD) RS subsetD]) 1);
-by (blast_tac (claset() addIs [lesspoll_trans1, in_Card_imp_lesspoll,
- RepFun_lepoll]) 1);
-qed "lemma";
-
-Goalw [DC_def, WO1_def] "WO1 ==> \\<forall>K. Card(K) --> DC(K)";
-by (REPEAT (resolve_tac [allI,impI] 1));
-by (REPEAT (eresolve_tac [allE,exE,conjE] 1));
-by (res_inst_tac [("x","\\<lambda>b \\<in> K. ff(b, X, Ra, R)")] bexI 1);
-by (rtac lam_type 2);
-by (resolve_tac [lemma RS CollectD1] 2 THEN REPEAT (assume_tac 2));
-by (asm_full_simp_tac (simpset()
- addsimps [[Card_is_Ord, ltD] MRS lam_images_eq]) 1);
-by (fast_tac (claset() addSEs [ltE, lemma RS CollectD2]) 1);
-qed "WO1_DC_Card";
--- a/src/ZF/AC/DC.thy Wed Jan 16 15:04:37 2002 +0100
+++ b/src/ZF/AC/DC.thy Wed Jan 16 17:52:06 2002 +0100
@@ -2,69 +2,578 @@
ID: $Id$
Author: Krzysztof Grabczewski
-Theory file for the proofs concernind the Axiom of Dependent Choice
+The proofs concerning the Axiom of Dependent Choice
*)
-DC = AC_Equiv + Hartog + Cardinal_aux + DC_lemmas +
+theory DC = AC_Equiv + Hartog + Cardinal_aux:
+
+lemma RepFun_lepoll: "Ord(a) ==> {P(b). b \<in> a} \<lesssim> a"
+apply (unfold lepoll_def)
+apply (rule_tac x = "\<lambda>z \<in> RepFun (a,P) . LEAST i. z=P (i) " in exI)
+apply (rule_tac d="%z. P (z)" in lam_injective)
+ apply (fast intro!: Least_in_Ord)
+apply (rule sym)
+apply (fast intro: LeastI Ord_in_Ord)
+done
-consts
+text{*Trivial in the presence of AC, but here we need a wellordering of X*}
+lemma image_Ord_lepoll: "[| f \<in> X->Y; Ord(X) |] ==> f``X \<lesssim> X"
+apply (unfold lepoll_def)
+apply (rule_tac x = "\<lambda>x \<in> f``X. LEAST y. f`y = x" in exI)
+apply (rule_tac d = "%z. f`z" in lam_injective)
+apply (fast intro!: Least_in_Ord apply_equality, clarify)
+apply (rule LeastI)
+ apply (erule apply_equality, assumption+)
+apply (blast intro: Ord_in_Ord)
+done
- DC :: i => o
- DC0 :: o
- ff :: [i, i, i, i] => i
+lemma range_subset_domain:
+ "[| R \<subseteq> X*X; !!g. g \<in> X ==> \<exists>u. <g,u> \<in> R |]
+ ==> range(R) \<subseteq> domain(R)"
+by (blast );
+
+lemma cons_fun_type: "g \<in> n->X ==> cons(<n,x>, g) \<in> succ(n) -> cons(x, X)"
+apply (unfold succ_def)
+apply (fast intro!: fun_extend elim!: mem_irrefl)
+done
-rules
+lemma cons_fun_type2:
+ "[| g \<in> n->X; x \<in> X |] ==> cons(<n,x>, g) \<in> succ(n) -> X"
+by (erule cons_absorb [THEN subst], erule cons_fun_type)
+
+lemma cons_image_n: "n \<in> nat ==> cons(<n,x>, g)``n = g``n"
+by (fast elim!: mem_irrefl)
+
+lemma cons_val_n: "g \<in> n->X ==> cons(<n,x>, g)`n = x"
+by (fast intro!: apply_equality elim!: cons_fun_type)
+
+lemma cons_image_k: "k \<in> n ==> cons(<n,x>, g)``k = g``k"
+by (fast elim: mem_asym)
- DC_def "DC(a) ==
- \\<forall>X R. R \\<subseteq> Pow(X)*X &
- (\\<forall>Y \\<in> Pow(X). Y lesspoll a --> (\\<exists>x \\<in> X. <Y,x> \\<in> R))
- --> (\\<exists>f \\<in> a->X. \\<forall>b<a. <f``b,f`b> \\<in> R)"
+lemma cons_val_k: "[| k \<in> n; g \<in> n->X |] ==> cons(<n,x>, g)`k = g`k"
+by (fast intro!: apply_equality consI2 elim!: cons_fun_type apply_Pair)
+
+lemma domain_cons_eq_succ: "domain(f)=x ==> domain(cons(<x,y>, f)) = succ(x)"
+by (simp add: domain_cons succ_def)
+
+lemma restrict_cons_eq: "g \<in> n->X ==> restrict(cons(<n,x>, g), n) = g"
+apply (unfold restrict_def)
+apply (rule fun_extension)
+apply (rule lam_type)
+apply (erule cons_fun_type [THEN apply_type])
+apply (erule succI2, assumption)
+apply (simp add: cons_val_k)
+done
+
+lemma succ_in_succ: "[| Ord(k); i \<in> k |] ==> succ(i) \<in> succ(k)"
+apply (rule Ord_linear [of "succ(i)" "succ(k)", THEN disjE])
+apply (fast elim: Ord_in_Ord mem_irrefl mem_asym)+
+done
- DC0_def "DC0 == \\<forall>A B R. R \\<subseteq> A*B & R\\<noteq>0 & range(R) \\<subseteq> domain(R)
- --> (\\<exists>f \\<in> nat->domain(R). \\<forall>n \\<in> nat. <f`n,f`succ(n)>:R)"
+lemma restrict_eq_imp_val_eq:
+ "[| restrict(f, domain(g)) = g; x \<in> domain(g) |] ==> f`x = g`x"
+apply (unfold restrict_def)
+apply (erule subst, simp)
+done
+
+lemma domain_eq_imp_fun_type: "[| domain(f)=A; f \<in> B->C |] ==> f \<in> A->C"
+by (frule domain_of_fun, fast)
+
+lemma ex_in_domain: "[| R \<subseteq> A * B; R \<noteq> 0 |] ==> \<exists>x. x \<in> domain(R)"
+by (fast elim!: not_emptyE)
+
- ff_def "ff(b, X, Q, R) ==
- transrec(b, %c r. THE x. first(x, {x \\<in> X. <r``c, x> \\<in> R}, Q))"
-
+constdefs
+
+ DC :: "i => o"
+ "DC(a) == \<forall>X R. R \<subseteq> Pow(X)*X &
+ (\<forall>Y \<in> Pow(X). Y \<prec> a --> (\<exists>x \<in> X. <Y,x> \<in> R))
+ --> (\<exists>f \<in> a->X. \<forall>b<a. <f``b,f`b> \<in> R)"
+
+ DC0 :: o
+ "DC0 == \<forall>A B R. R \<subseteq> A*B & R\<noteq>0 & range(R) \<subseteq> domain(R)
+ --> (\<exists>f \<in> nat->domain(R). \<forall>n \<in> nat. <f`n,f`succ(n)>:R)"
+
+ ff :: "[i, i, i, i] => i"
+ "ff(b, X, Q, R) ==
+ transrec(b, %c r. THE x. first(x, {x \<in> X. <r``c, x> \<in> R}, Q))"
+
locale DC0_imp =
- fixes
- XX :: i
- RR :: i
- X :: i
- R :: i
+ fixes XX and RR and X and R
+
+ assumes all_ex: "\<forall>Y \<in> Pow(X). Y \<prec> nat --> (\<exists>x \<in> X. <Y, x> \<in> R)"
+
+ defines XX_def: "XX == (\<Union>n \<in> nat. {f \<in> n->X. \<forall>k \<in> n. <f``k, f`k> \<in> R})"
+ and RR_def: "RR == {<z1,z2>:XX*XX. domain(z2)=succ(domain(z1))
+ & restrict(z2, domain(z1)) = z1}"
+
+
+(* ********************************************************************** *)
+(* DC ==> DC(omega) *)
+(* *)
+(* The scheme of the proof: *)
+(* *)
+(* Assume DC. Let R and X satisfy the premise of DC(omega). *)
+(* *)
+(* Define XX and RR as follows: *)
+(* *)
+(* XX = (\<Union>n \<in> nat. {f \<in> n->X. \<forall>k \<in> n. <f``k, f`k> \<in> R}) *)
+(* f RR g iff domain(g)=succ(domain(f)) & *)
+(* restrict(g, domain(f)) = f *)
+(* *)
+(* Then RR satisfies the hypotheses of DC. *)
+(* So applying DC: *)
+(* *)
+(* \<exists>f \<in> nat->XX. \<forall>n \<in> nat. f`n RR f`succ(n) *)
+(* *)
+(* Thence *)
+(* *)
+(* ff = {<n, f`succ(n)`n>. n \<in> nat} *)
+(* *)
+(* is the desired function. *)
+(* *)
+(* ********************************************************************** *)
+
+lemma (in DC0_imp) lemma1_1: "RR \<subseteq> XX*XX"
+by (unfold RR_def, fast)
+
+lemma (in DC0_imp) lemma1_2: "RR \<noteq> 0"
+apply (unfold RR_def XX_def)
+apply (rule all_ex [THEN ballE])
+apply (erule_tac [2] notE [OF _ empty_subsetI [THEN PowI]])
+apply (erule_tac impE [OF _ nat_0I [THEN n_lesspoll_nat]])
+apply (erule bexE)
+apply (rule_tac a = "<0, {<0, x>}>" in not_emptyI)
+apply (rule CollectI)
+apply (rule SigmaI)
+apply (rule nat_0I [THEN UN_I])
+apply (simp (no_asm_simp) add: nat_0I [THEN UN_I])
+apply (rule nat_1I [THEN UN_I])
+apply (force intro!: singleton_fun [THEN Pi_type]
+ simp add: singleton_0 [symmetric])
+apply (simp add: singleton_0)
+done
+
+lemma (in DC0_imp) lemma1_3: "range(RR) \<subseteq> domain(RR)"
+apply (unfold RR_def XX_def)
+apply (rule range_subset_domain, blast, clarify)
+apply (frule fun_is_rel [THEN image_subset, THEN PowI,
+ THEN all_ex [THEN bspec]])
+apply (erule impE[OF _ lesspoll_trans1[OF image_Ord_lepoll
+ [OF _ nat_into_Ord] n_lesspoll_nat]],
+ assumption+)
+apply (erule bexE)
+apply (rule_tac x = "cons (<n,x>, g) " in exI)
+apply (rule CollectI)
+apply (force elim!: cons_fun_type2
+ simp add: cons_image_n cons_val_n cons_image_k cons_val_k)
+apply (simp add: domain_of_fun succ_def restrict_cons_eq)
+done
- assumes
- all_ex "\\<forall>Y \\<in> Pow(X). Y lesspoll nat --> (\\<exists>x \\<in> X. <Y, x> \\<in> R)"
+lemma (in DC0_imp) lemma2:
+ "[| \<forall>n \<in> nat. <f`n, f`succ(n)> \<in> RR; f \<in> nat -> XX; n \<in> nat |]
+ ==> \<exists>k \<in> nat. f`succ(n) \<in> k -> X & n \<in> k
+ & <f`succ(n)``n, f`succ(n)`n> \<in> R"
+apply (induct_tac "n")
+apply (drule apply_type [OF _ nat_1I])
+apply (drule bspec [OF _ nat_0I])
+apply (simp add: XX_def, safe)
+apply (rule rev_bexI, assumption)
+apply (subgoal_tac "0 \<in> x", force)
+apply (force simp add: RR_def
+ intro: ltD elim!: nat_0_le [THEN leE])
+(** LEVEL 7, other subgoal **)
+apply (drule bspec [OF _ nat_succI], assumption)
+apply (subgoal_tac "f ` succ (succ (x)) \<in> succ (k) ->X")
+apply (drule apply_type [OF _ nat_succI [THEN nat_succI]], assumption)
+apply (simp (no_asm_use) add: XX_def RR_def)
+apply safe
+apply (frule_tac a="succ(k)" in domain_of_fun [symmetric, THEN trans],
+ assumption)
+apply (frule_tac a="xa" in domain_of_fun [symmetric, THEN trans],
+ assumption)
+apply (fast elim!: nat_into_Ord [THEN succ_in_succ]
+ dest!: bspec [OF _ nat_into_Ord [THEN succ_in_succ]])
+apply (drule domain_of_fun)
+apply (simp add: XX_def RR_def, clarify)
+apply (blast dest: domain_of_fun [symmetric, THEN trans] )
+done
+
+lemma (in DC0_imp) lemma3_1:
+ "[| \<forall>n \<in> nat. <f`n, f`succ(n)> \<in> RR; f \<in> nat -> XX; m \<in> nat |]
+ ==> {f`succ(x)`x. x \<in> m} = {f`succ(m)`x. x \<in> m}"
+apply (subgoal_tac "\<forall>x \<in> m. f`succ (m) `x = f`succ (x) `x")
+apply simp
+apply (induct_tac "m", blast)
+apply (rule ballI)
+apply (erule succE)
+ apply (rule restrict_eq_imp_val_eq)
+ apply (drule bspec [OF _ nat_succI], assumption)
+ apply (simp add: RR_def)
+ apply (drule lemma2, assumption+)
+ apply (fast dest!: domain_of_fun)
+apply (drule_tac x = "xa" in bspec, assumption)
+apply (erule sym [THEN trans, symmetric])
+apply (rule restrict_eq_imp_val_eq [symmetric])
+ apply (drule bspec [OF _ nat_succI], assumption)
+ apply (simp add: RR_def)
+apply (drule lemma2, assumption+)
+apply (blast dest!: domain_of_fun
+ intro: nat_into_Ord OrdmemD [THEN subsetD])
+done
- defines
- XX_def "XX == (\\<Union>n \\<in> nat. {f \\<in> n->X. \\<forall>k \\<in> n. <f``k, f`k> \\<in> R})"
- RR_def "RR == {<z1,z2>:XX*XX. domain(z2)=succ(domain(z1))
- & restrict(z2, domain(z1)) = z1}"
+lemma (in DC0_imp) lemma3:
+ "[| \<forall>n \<in> nat. <f`n, f`succ(n)> \<in> RR; f \<in> nat -> XX; m \<in> nat |]
+ ==> (\<lambda>x \<in> nat. f`succ(x)`x) `` m = f`succ(m)``m"
+apply (erule natE, simp)
+apply (subst image_lam)
+ apply (fast elim!: OrdmemD [OF nat_succI Ord_nat])
+apply (subst lemma3_1, assumption+)
+ apply fast
+apply (fast dest!: lemma2
+ elim!: image_fun [symmetric, OF _ OrdmemD [OF _ nat_into_Ord]])
+done
+
+
+theorem DC0_imp_DC_nat: "DC0 ==> DC(nat)"
+apply (unfold DC_def DC0_def, clarify)
+apply (elim allE)
+apply (erule impE)
+ (*these three results comprise Lemma 1*)
+apply (blast intro!: DC0_imp.lemma1_1 DC0_imp.lemma1_2 DC0_imp.lemma1_3)
+apply (erule bexE)
+apply (rule_tac x = "\<lambda>n \<in> nat. f`succ (n) `n" in rev_bexI)
+ apply (rule lam_type, blast dest!: DC0_imp.lemma2 intro: fun_weaken_type)
+apply (rule oallI)
+apply (frule DC0_imp.lemma2, assumption)
+ apply (blast intro: fun_weaken_type)
+ apply (erule ltD)
+(** LEVEL 11: last subgoal **)
+apply (subst DC0_imp.lemma3, assumption+)
+ apply (fast elim!: fun_weaken_type)
+ apply (erule ltD, force)
+done
+
+
+(* ************************************************************************
+ DC(omega) ==> DC
+
+ The scheme of the proof:
+
+ Assume DC(omega). Let R and x satisfy the premise of DC.
+
+ Define XX and RR as follows:
+
+ XX = (\<Union>n \<in> nat. {f \<in> succ(n)->domain(R). \<forall>k \<in> n. <f`k, f`succ(k)> \<in> R})
+
+ RR = {<z1,z2>:Fin(XX)*XX.
+ (domain(z2)=succ(\<Union>f \<in> z1. domain(f)) &
+ (\<forall>f \<in> z1. restrict(z2, domain(f)) = f)) |
+ (~ (\<exists>g \<in> XX. domain(g)=succ(\<Union>f \<in> z1. domain(f)) &
+ (\<forall>f \<in> z1. restrict(g, domain(f)) = f)) &
+ z2={<0,x>})}
+
+ Then XX and RR satisfy the hypotheses of DC(omega).
+ So applying DC:
+
+ \<exists>f \<in> nat->XX. \<forall>n \<in> nat. f``n RR f`n
+
+ Thence
+
+ ff = {<n, f`n`n>. n \<in> nat}
+
+ is the desired function.
+
+************************************************************************* *)
+
+lemma singleton_in_funs:
+ "x \<in> X ==> {<0,x>} \<in>
+ (\<Union>n \<in> nat. {f \<in> succ(n)->X. \<forall>k \<in> n. <f`k, f`succ(k)> \<in> R})"
+apply (rule nat_0I [THEN UN_I])
+apply (force simp add: singleton_0 [symmetric]
+ intro!: singleton_fun [THEN Pi_type])
+done
locale imp_DC0 =
- fixes
- XX :: i
- RR :: i
- x :: i
- R :: i
- f :: i
- allRR :: o
+ fixes XX and RR and x and R and f and allRR
+ defines XX_def: "XX == (\<Union>n \<in> nat.
+ {f \<in> succ(n)->domain(R). \<forall>k \<in> n. <f`k, f`succ(k)> \<in> R})"
+ and RR_def:
+ "RR == {<z1,z2>:Fin(XX)*XX.
+ (domain(z2)=succ(\<Union>f \<in> z1. domain(f))
+ & (\<forall>f \<in> z1. restrict(z2, domain(f)) = f))
+ | (~ (\<exists>g \<in> XX. domain(g)=succ(\<Union>f \<in> z1. domain(f))
+ & (\<forall>f \<in> z1. restrict(g, domain(f)) = f)) & z2={<0,x>})}"
+ and allRR_def:
+ "allRR == \<forall>b<nat.
+ <f``b, f`b> \<in>
+ {<z1,z2>\<in>Fin(XX)*XX. (domain(z2)=succ(\<Union>f \<in> z1. domain(f))
+ & (\<Union>f \<in> z1. domain(f)) = b
+ & (\<forall>f \<in> z1. restrict(z2,domain(f)) = f))}"
+
+lemma (in imp_DC0) lemma4:
+ "[| range(R) \<subseteq> domain(R); x \<in> domain(R) |]
+ ==> RR \<subseteq> Pow(XX)*XX &
+ (\<forall>Y \<in> Pow(XX). Y \<prec> nat --> (\<exists>x \<in> XX. <Y,x>:RR))"
+apply (rule conjI)
+apply (force dest!: FinD [THEN PowI] simp add: RR_def)
+apply (rule impI [THEN ballI])
+apply (drule Finite_Fin [OF lesspoll_nat_is_Finite PowD], assumption)
+apply (case_tac
+ "\<exists>g \<in> XX. domain (g) =
+ succ(\<Union>f \<in> Y. domain(f)) & (\<forall>f\<in>Y. restrict(g, domain(f)) = f)")
+apply (simp add: RR_def, blast)
+apply (safe del: domainE)
+apply (unfold XX_def RR_def)
+apply (rule rev_bexI, erule singleton_in_funs)
+apply (simp add: nat_0I [THEN rev_bexI] cons_fun_type2)
+done
+
+lemma (in imp_DC0) UN_image_succ_eq:
+ "[| f \<in> nat->X; n \<in> nat |]
+ ==> (\<Union>x \<in> f``succ(n). P(x)) = P(f`n) Un (\<Union>x \<in> f``n. P(x))"
+by (simp add: image_fun OrdmemD)
+
+lemma (in imp_DC0) UN_image_succ_eq_succ:
+ "[| (\<Union>x \<in> f``n. P(x)) = y; P(f`n) = succ(y);
+ f \<in> nat -> X; n \<in> nat |] ==> (\<Union>x \<in> f``succ(n). P(x)) = succ(y)"
+by (simp add: UN_image_succ_eq, blast)
+
+lemma (in imp_DC0) apply_domain_type:
+ "[| h \<in> succ(n) -> D; n \<in> nat; domain(h)=succ(y) |] ==> h`y \<in> D"
+by (fast elim: apply_type dest!: trans [OF sym domain_of_fun])
+
+lemma (in imp_DC0) image_fun_succ:
+ "[| h \<in> nat -> X; n \<in> nat |] ==> h``succ(n) = cons(h`n, h``n)"
+by (simp add: image_fun OrdmemD)
+
+lemma (in imp_DC0) f_n_type:
+ "[| domain(f`n) = succ(k); f \<in> nat -> XX; n \<in> nat |]
+ ==> f`n \<in> succ(k) -> domain(R)"
+apply (unfold XX_def)
+apply (drule apply_type, assumption)
+apply (fast elim: domain_eq_imp_fun_type)
+done
+
+lemma (in imp_DC0) f_n_pairs_in_R [rule_format]:
+ "[| h \<in> nat -> XX; domain(h`n) = succ(k); n \<in> nat |]
+ ==> \<forall>i \<in> k. <h`n`i, h`n`succ(i)> \<in> R"
+apply (unfold XX_def)
+apply (drule apply_type, assumption)
+apply (elim UN_E CollectE)
+apply (drule domain_of_fun [symmetric, THEN trans], assumption)
+apply simp
+done
+
+lemma (in imp_DC0) restrict_cons_eq_restrict:
+ "[| restrict(h, domain(u))=u; h \<in> n->X; domain(u) \<subseteq> n |]
+ ==> restrict(cons(<n, y>, h), domain(u)) = u"
+apply (unfold restrict_def)
+apply (erule sym [THEN trans, symmetric])
+apply (rule fun_extension)
+apply (fast intro!: lam_type)
+apply (fast intro!: lam_type)
+apply (simp add: subsetD [THEN cons_val_k])
+done
+
+lemma (in imp_DC0) all_in_image_restrict_eq:
+ "[| \<forall>x \<in> f``n. restrict(f`n, domain(x))=x;
+ f \<in> nat -> XX;
+ n \<in> nat; domain(f`n) = succ(n);
+ (\<Union>x \<in> f``n. domain(x)) \<subseteq> n |]
+ ==> \<forall>x \<in> f``succ(n). restrict(cons(<succ(n),y>, f`n), domain(x)) = x"
+apply (rule ballI)
+apply (simp add: image_fun_succ)
+apply (drule f_n_type, assumption+)
+apply (erule disjE)
+ apply (simp add: domain_of_fun restrict_cons_eq)
+apply (blast intro!: restrict_cons_eq_restrict)
+done
+
+lemma (in imp_DC0) simplify_recursion:
+ "[| \<forall>b<nat. <f``b, f`b> \<in> RR;
+ f \<in> nat -> XX; range(R) \<subseteq> domain(R); x \<in> domain(R)|]
+ ==> allRR"
+apply (unfold RR_def allRR_def)
+apply (rule oallI, drule ltD)
+apply (erule nat_induct)
+apply (drule_tac x="0" in ospec, blast intro: Limit_has_0)
+apply (force simp add: singleton_fun [THEN domain_of_fun] singleton_in_funs)
+(*induction step*) (** LEVEL 5 **)
+(*prevent simplification of ~\<exists> to \<forall>~ *)
+apply (simp only: separation split)
+apply (drule_tac x="succ(xa)" in ospec, blast intro: ltI);
+apply (elim conjE disjE)
+apply (force elim!: trans subst_context
+ intro!: UN_image_succ_eq_succ)
+apply (erule notE)
+apply (simp add: XX_def UN_image_succ_eq_succ)
+apply (elim conjE bexE)
+apply (drule apply_domain_type, assumption+)
+apply (erule domainE)+
+apply (frule f_n_type)
+apply (simp add: XX_def, assumption+)
+apply (rule rev_bexI, erule nat_succI)
+apply (rule_tac x = "cons (<succ (xa), ya>, f`xa) " in bexI)
+prefer 2 apply (blast intro: cons_fun_type2)
+apply (rule conjI)
+prefer 2 apply (fast del: ballI subsetI
+ elim: trans [OF _ subst_context, THEN domain_cons_eq_succ]
+ subst_context
+ all_in_image_restrict_eq [simplified XX_def]
+ trans equalityD1)
+(*one remaining subgoal*)
+apply (rule ballI)
+apply (erule succE)
+(** LEVEL 25 **)
+ apply (simp add: cons_val_n cons_val_k)
+(*assumption+ will not perform the required backtracking!*)
+apply (drule f_n_pairs_in_R [simplified XX_def, OF _ domain_of_fun],
+ assumption, assumption, assumption)
+apply (simp add: nat_into_Ord [THEN succ_in_succ] succI2 cons_val_k)
+done
+
- defines
- XX_def "XX == (\\<Union>n \\<in> nat.
- {f \\<in> succ(n)->domain(R). \\<forall>k \\<in> n. <f`k, f`succ(k)> \\<in> R})"
- RR_def
- "RR == {<z1,z2>:Fin(XX)*XX.
- (domain(z2)=succ(\\<Union>f \\<in> z1. domain(f))
- & (\\<forall>f \\<in> z1. restrict(z2, domain(f)) = f))
- | (~ (\\<exists>g \\<in> XX. domain(g)=succ(\\<Union>f \\<in> z1. domain(f))
- & (\\<forall>f \\<in> z1. restrict(g, domain(f)) = f)) & z2={<0,x>})}"
- allRR_def
- "allRR == \\<forall>b<nat.
- <f``b, f`b> \\<in>
- {<z1,z2>:Fin(XX)*XX. (domain(z2)=succ(\\<Union>f \\<in> z1. domain(f))
- & (\\<Union>f \\<in> z1. domain(f)) = b
- & (\\<forall>f \\<in> z1. restrict(z2,domain(f)) = f))}"
+lemma (in imp_DC0) lemma2:
+ "[| allRR; f \<in> nat->XX; range(R) \<subseteq> domain(R); x \<in> domain(R); n \<in> nat |]
+ ==> f`n \<in> succ(n) -> domain(R) & (\<forall>i \<in> n. <f`n`i, f`n`succ(i)>:R)"
+apply (unfold allRR_def)
+apply (drule ospec)
+apply (erule ltI [OF _ Ord_nat])
+apply (erule CollectE, simp)
+apply (rule conjI)
+prefer 2 apply (fast elim!: f_n_pairs_in_R trans subst_context)
+apply (unfold XX_def)
+apply (fast elim!: trans [THEN domain_eq_imp_fun_type] subst_context)
+done
+
+lemma (in imp_DC0) lemma3:
+ "[| allRR; f \<in> nat->XX; n\<in>nat; range(R) \<subseteq> domain(R); x \<in> domain(R) |]
+ ==> f`n`n = f`succ(n)`n"
+apply (frule lemma2 [THEN conjunct1, THEN domain_of_fun], assumption+)
+apply (unfold allRR_def)
+apply (drule ospec)
+apply (drule ltI [OF nat_succI Ord_nat], assumption)
+apply simp
+apply (elim conjE ballE)
+apply (erule restrict_eq_imp_val_eq [symmetric], force)
+apply (simp add: image_fun OrdmemD)
+done
+
+
+theorem DC_nat_imp_DC0: "DC(nat) ==> DC0"
+apply (unfold DC_def DC0_def)
+apply (intro allI impI)
+apply (erule asm_rl conjE ex_in_domain [THEN exE] allE)+
+apply (erule impE [OF _ imp_DC0.lemma4], assumption+)
+apply (erule bexE)
+apply (drule imp_DC0.simplify_recursion, assumption+)
+apply (rule_tac x = "\<lambda>n \<in> nat. f`n`n" in bexI)
+apply (rule_tac [2] lam_type)
+apply (erule_tac [2] apply_type [OF imp_DC0.lemma2 [THEN conjunct1] succI1])
+apply (rule ballI)
+apply (frule_tac n="succ(n)" in imp_DC0.lemma2,
+ (assumption|erule nat_succI)+)
+apply (drule imp_DC0.lemma3, auto)
+done
+
+(* ********************************************************************** *)
+(* \<forall>K. Card(K) --> DC(K) ==> WO3 *)
+(* ********************************************************************** *)
+
+lemma fun_Ord_inj:
+ "[| f \<in> a->X; Ord(a);
+ !!b c. [| b<c; c \<in> a |] ==> f`b\<noteq>f`c |]
+ ==> f \<in> inj(a, X)"
+apply (unfold inj_def, simp)
+apply (intro ballI impI)
+apply (rule_tac j=x in Ord_in_Ord [THEN Ord_linear_lt], assumption+)
+apply (blast intro: Ord_in_Ord, auto)
+apply (atomize, blast dest: not_sym)
+done
+
+lemma value_in_image: "[| f \<in> X->Y; A \<subseteq> X; a \<in> A |] ==> f`a \<in> f``A"
+by (fast elim!: image_fun [THEN ssubst]);
+
+theorem DC_WO3: "(\<forall>K. Card(K) --> DC(K)) ==> WO3"
+apply (unfold DC_def WO3_def)
+apply (rule allI)
+apply (case_tac "A \<prec> Hartog (A)");
+apply (fast dest!: lesspoll_imp_ex_lt_eqpoll
+ intro!: Ord_Hartog leI [THEN le_imp_subset])
+apply (erule allE impE)+
+apply (rule Card_Hartog)
+apply (erule_tac x = "A" in allE)
+apply (erule_tac x = "{<z1,z2> \<in> Pow (A) *A . z1 \<prec> Hartog (A) & z2 \<notin> z1}"
+ in allE)
+apply simp
+apply (erule impE, fast elim: lesspoll_lemma [THEN not_emptyE])
+apply (erule bexE)
+apply (rule Hartog_lepoll_selfE)
+apply (rule lepoll_def [THEN def_imp_iff, THEN iffD2])
+apply (rule exI, rule fun_Ord_inj, assumption, rule Ord_Hartog)
+apply (drule value_in_image)
+apply (drule OrdmemD, rule Ord_Hartog, assumption+, erule ltD)
+apply (drule ospec)
+apply (blast intro: ltI Ord_Hartog, force)
+done
+
+(* ********************************************************************** *)
+(* WO1 ==> \<forall>K. Card(K) --> DC(K) *)
+(* ********************************************************************** *)
+
+lemma images_eq:
+ "[| \<forall>x \<in> A. f`x=g`x; f \<in> Df->Cf; g \<in> Dg->Cg; A \<subseteq> Df; A \<subseteq> Dg |]
+ ==> f``A = g``A"
+apply (simp (no_asm_simp) add: image_fun)
+done
+
+lemma lam_images_eq:
+ "[| Ord(a); b \<in> a |] ==> (\<lambda>x \<in> a. h(x))``b = (\<lambda>x \<in> b. h(x))``b"
+apply (rule images_eq)
+ apply (rule ballI)
+ apply (drule OrdmemD [THEN subsetD], assumption+)
+ apply simp
+ apply (fast elim!: RepFunI OrdmemD intro!: lam_type)+
+done
+
+lemma lam_type_RepFun: "(\<lambda>b \<in> a. h(b)) \<in> a -> {h(b). b \<in> a}"
+by (fast intro!: lam_type RepFunI)
+
+lemma lemmaX:
+ "[| \<forall>Y \<in> Pow(X). Y \<prec> K --> (\<exists>x \<in> X. <Y, x> \<in> R);
+ b \<in> K; Z \<in> Pow(X); Z \<prec> K |]
+ ==> {x \<in> X. <Z,x> \<in> R} \<noteq> 0"
+by blast
+
+
+lemma WO1_DC_lemma:
+ "[| Card(K); well_ord(X,Q);
+ \<forall>Y \<in> Pow(X). Y \<prec> K --> (\<exists>x \<in> X. <Y, x> \<in> R); b \<in> K |]
+ ==> ff(b, X, Q, R) \<in> {x \<in> X. <(\<lambda>c \<in> b. ff(c, X, Q, R))``b, x> \<in> R}"
+apply (rule_tac P = "b \<in> K" in impE, (erule_tac [2] asm_rl)+)
+apply (rule_tac i=b in Card_is_Ord [THEN Ord_in_Ord, THEN trans_induct],
+ assumption+)
+apply (rule impI)
+apply (rule ff_def [THEN def_transrec, THEN ssubst])
+apply (erule the_first_in, fast)
+apply (simp add: image_fun [OF lam_type_RepFun subset_refl])
+apply (erule lemmaX, assumption)
+ apply (blast intro: Card_is_Ord OrdmemD [THEN subsetD])
+apply (blast intro: lesspoll_trans1 in_Card_imp_lesspoll RepFun_lepoll)
+done
+
+theorem WO1_DC_Card: "WO1 ==> \<forall>K. Card(K) --> DC(K)"
+apply (unfold DC_def WO1_def)
+apply (rule allI impI)+
+apply (erule allE exE conjE)+
+apply (rule_tac x = "\<lambda>b \<in> K. ff (b, X, Ra, R) " in bexI)
+ apply (simp add: lam_images_eq [OF Card_is_Ord ltD])
+ apply (fast elim!: ltE WO1_DC_lemma [THEN CollectD2])
+apply (rule_tac lam_type)
+apply (rule WO1_DC_lemma [THEN CollectD1], assumption+)
+done
+
end
--- a/src/ZF/AC/DC_lemmas.ML Wed Jan 16 15:04:37 2002 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,105 +0,0 @@
-(* Title: ZF/AC/DC_lemmas.ML
- ID: $Id$
- Author: Krzysztof Grabczewski
-
-More general lemmas used in the proofs concerning DC
-
-*)
-
-val [prem] = goalw thy [lepoll_def]
- "Ord(a) ==> {P(b). b \\<in> a} lepoll a";
-by (res_inst_tac [("x","\\<lambda>z \\<in> RepFun(a,P). LEAST i. z=P(i)")] exI 1);
-by (res_inst_tac [("d","%z. P(z)")] (sym RSN (2, lam_injective)) 1);
-by (fast_tac (claset() addSIs [Least_in_Ord, prem]) 1);
-by (REPEAT (eresolve_tac [RepFunE, LeastI, prem RS Ord_in_Ord] 1));
-qed "RepFun_lepoll";
-
-Goalw [lesspoll_def] "n \\<in> nat ==> n lesspoll nat";
-by (rtac conjI 1);
-by (eresolve_tac [Ord_nat RSN (2, OrdmemD) RS subset_imp_lepoll] 1);
-by (rtac notI 1);
-by (etac eqpollE 1);
-by (rtac succ_lepoll_natE 1 THEN (assume_tac 2));
-by (eresolve_tac [nat_succI RS (Ord_nat RSN (2, OrdmemD) RS
- subset_imp_lepoll) RS lepoll_trans] 1
- THEN (assume_tac 1));
-qed "n_lesspoll_nat";
-
-Goalw [lepoll_def]
- "[| f \\<in> X->Y; Ord(X) |] ==> f``X lepoll X";
-by (res_inst_tac [("x","\\<lambda>x \\<in> f``X. LEAST y. f`y = x")] exI 1);
-by (res_inst_tac [("d","%z. f`z")] lam_injective 1);
-by (fast_tac (claset() addSIs [Least_in_Ord, apply_equality]) 1);
-by (fast_tac (claset() addSEs [Ord_in_Ord] addSIs [LeastI, apply_equality]) 1);
-qed "image_Ord_lepoll";
-
-val [major, minor] = goal thy
- "[| (!!g. g \\<in> X ==> \\<exists>u. <g,u>:R); R \\<subseteq> X*X \
-\ |] ==> range(R) \\<subseteq> domain(R)";
-by (rtac subsetI 1);
-by (etac rangeE 1);
-by (dresolve_tac [minor RS subsetD RS SigmaD2 RS major] 1);
-by (Fast_tac 1);
-qed "range_subset_domain";
-
-val prems = goal thy "!!k. k \\<in> n ==> k\\<noteq>n";
-by (fast_tac (claset() addSEs [mem_irrefl]) 1);
-qed "mem_not_eq";
-
-Goalw [succ_def] "g \\<in> n->X ==> cons(<n,x>, g) \\<in> succ(n) -> cons(x, X)";
-by (fast_tac (claset() addSIs [fun_extend] addSEs [mem_irrefl]) 1);
-qed "cons_fun_type";
-
-Goal "[| g \\<in> n->X; x \\<in> X |] ==> cons(<n,x>, g) \\<in> succ(n) -> X";
-by (etac (cons_absorb RS subst) 1 THEN etac cons_fun_type 1);
-qed "cons_fun_type2";
-
-Goal "n \\<in> nat ==> cons(<n,x>, g)``n = g``n";
-by (fast_tac (claset() addSEs [mem_irrefl]) 1);
-qed "cons_image_n";
-
-Goal "g \\<in> n->X ==> cons(<n,x>, g)`n = x";
-by (fast_tac (claset() addSIs [apply_equality] addSEs [cons_fun_type]) 1);
-qed "cons_val_n";
-
-Goal "k \\<in> n ==> cons(<n,x>, g)``k = g``k";
-by (fast_tac (claset() addEs [mem_asym]) 1);
-qed "cons_image_k";
-
-Goal "[| k \\<in> n; g \\<in> n->X |] ==> cons(<n,x>, g)`k = g`k";
-by (fast_tac (claset() addSIs [apply_equality, consI2] addSEs [cons_fun_type, apply_Pair]) 1);
-qed "cons_val_k";
-
-Goal "domain(f)=x ==> domain(cons(<x,y>, f)) = succ(x)";
-by (asm_full_simp_tac (simpset() addsimps [domain_cons, succ_def]) 1);
-qed "domain_cons_eq_succ";
-
-Goalw [restrict_def] "g \\<in> n->X ==> restrict(cons(<n,x>, g), n)=g";
-by (rtac fun_extension 1);
-by (rtac lam_type 1);
-by (eresolve_tac [cons_fun_type RS apply_type] 1);
-by (etac succI2 1);
-by (assume_tac 1);
-by (asm_full_simp_tac (simpset() addsimps [cons_val_k]) 1);
-qed "restrict_cons_eq";
-
-Goal "[| Ord(k); i \\<in> k |] ==> succ(i) \\<in> succ(k)";
-by (resolve_tac [Ord_linear RS disjE] 1 THEN (assume_tac 3));
-by (REPEAT (fast_tac (claset() addEs [Ord_in_Ord, mem_irrefl, mem_asym]) 1));
-qed "succ_in_succ";
-
-Goalw [restrict_def]
- "[| restrict(f, domain(g)) = g; x \\<in> domain(g) |] ==> f`x = g`x";
-by (etac subst 1);
-by (Asm_full_simp_tac 1);
-qed "restrict_eq_imp_val_eq";
-
-Goal "[| domain(f)=A; f \\<in> B->C |] ==> f \\<in> A->C";
-by (ftac domain_of_fun 1);
-by (Fast_tac 1);
-qed "domain_eq_imp_fun_type";
-
-Goal "[| R \\<subseteq> A * B; R \\<noteq> 0 |] ==> \\<exists>x. x \\<in> domain(R)";
-by (fast_tac (claset() addSEs [not_emptyE]) 1);
-qed "ex_in_domain";
-
--- a/src/ZF/AC/DC_lemmas.thy Wed Jan 16 15:04:37 2002 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,3 +0,0 @@
-(*Dummy theory to document dependencies *)
-
-DC_lemmas = AC_Equiv + Cardinal_aux
--- a/src/ZF/AC/HH.ML Wed Jan 16 15:04:37 2002 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,212 +0,0 @@
-(* Title: ZF/AC/HH.ML
- ID: $Id$
- Author: Krzysztof Grabczewski
-
-Some properties of the recursive definition of HH used in the proofs of
- AC17 ==> AC1
- AC1 ==> WO2
- AC15 ==> WO6
-*)
-
-(* ********************************************************************** *)
-(* Lemmas useful in each of the three proofs *)
-(* ********************************************************************** *)
-
-Goal "HH(f,x,a) = \
-\ (let z = x - (\\<Union>b \\<in> a. HH(f,x,b)) \
-\ in if(f`z \\<in> Pow(z)-{0}, f`z, {x}))";
-by (resolve_tac [HH_def RS def_transrec RS trans] 1);
-by (Simp_tac 1);
-qed "HH_def_satisfies_eq";
-
-Goal "HH(f,x,a) \\<in> Pow(x)-{0} | HH(f,x,a)={x}";
-by (resolve_tac [HH_def_satisfies_eq RS ssubst] 1);
-by (simp_tac (simpset() addsimps [Let_def, Diff_subset RS PowI]) 1);
-by (Fast_tac 1);
-qed "HH_values";
-
-Goal "B \\<subseteq> A ==> X-(\\<Union>a \\<in> A. P(a)) = X-(\\<Union>a \\<in> A-B. P(a))-(\\<Union>b \\<in> B. P(b))";
-by (Fast_tac 1);
-qed "subset_imp_Diff_eq";
-
-Goal "[| c \\<in> a-b; b<a |] ==> c=b | b<c & c<a";
-by (etac ltE 1);
-by (dtac Ord_linear 1);
-by (fast_tac (claset() addSIs [ltI] addIs [Ord_in_Ord]) 2);
-by (fast_tac (claset() addEs [Ord_in_Ord]) 1);
-qed "Ord_DiffE";
-
-val prems = goal thy "(!!y. y \\<in> A ==> P(y) = {x}) ==> x - (\\<Union>y \\<in> A. P(y)) = x";
-by (asm_full_simp_tac (simpset() addsimps prems) 1);
-by (fast_tac (claset() addSDs [prem] addSEs [mem_irrefl]) 1);
-qed "Diff_UN_eq_self";
-
-Goal "x - (\\<Union>b \\<in> a. HH(f,x,b)) = x - (\\<Union>b \\<in> a1. HH(f,x,b)) \
-\ ==> HH(f,x,a) = HH(f,x,a1)";
-by (resolve_tac [HH_def_satisfies_eq RS
- (HH_def_satisfies_eq RS sym RSN (3, trans RS trans))] 1);
-by (etac subst_context 1);
-qed "HH_eq";
-
-Goal "[| HH(f,x,b)={x}; b<a |] ==> HH(f,x,a)={x}";
-by (res_inst_tac [("P","b<a")] impE 1 THEN REPEAT (assume_tac 2));
-by (eresolve_tac [lt_Ord2 RS trans_induct] 1);
-by (rtac impI 1);
-by (resolve_tac [HH_eq RS trans] 1 THEN (assume_tac 2));
-by (resolve_tac [leI RS le_imp_subset RS subset_imp_Diff_eq RS ssubst] 1
- THEN (assume_tac 1));
-by (res_inst_tac [("t","%z. z-?X")] subst_context 1);
-by (rtac Diff_UN_eq_self 1);
-by (dtac Ord_DiffE 1 THEN (assume_tac 1));
-by (fast_tac (claset() addEs [ltE]) 1);
-qed "HH_is_x_gt_too";
-
-Goal "[| HH(f,x,a) \\<in> Pow(x)-{0}; b<a |] ==> HH(f,x,b) \\<in> Pow(x)-{0}";
-by (resolve_tac [HH_values RS disjE] 1 THEN (assume_tac 1));
-by (dtac HH_is_x_gt_too 1 THEN (assume_tac 1));
-by (dtac subst 1 THEN (assume_tac 1));
-by (fast_tac (claset() addSEs [mem_irrefl]) 1);
-qed "HH_subset_x_lt_too";
-
-Goal "HH(f,x,a) \\<in> Pow(x)-{0} \
-\ ==> HH(f,x,a) \\<in> Pow(x - (\\<Union>b \\<in> a. HH(f,x,b)))-{0}";
-by (dresolve_tac [HH_def_satisfies_eq RS subst] 1);
-by (resolve_tac [HH_def_satisfies_eq RS ssubst] 1);
-by (asm_full_simp_tac (simpset() addsimps [Let_def, Diff_subset RS PowI]) 1);
-by (dresolve_tac [split_if RS iffD1] 1);
-by (Simp_tac 1);
-by (fast_tac (subset_cs addSEs [mem_irrefl]) 1);
-qed "HH_subset_x_imp_subset_Diff_UN";
-
-Goal "[| HH(f,x,v)=HH(f,x,w); HH(f,x,v): Pow(x)-{0}; v \\<in> w |] ==> P";
-by (forw_inst_tac [("P","%y. y \\<in> Pow(x)-{0}")] subst 1 THEN (assume_tac 1));
-by (dres_inst_tac [("a","w")] HH_subset_x_imp_subset_Diff_UN 1);
-by (dtac subst_elem 1 THEN (assume_tac 1));
-by (fast_tac (claset() addSIs [singleton_iff RS iffD2, equals0I]) 1);
-qed "HH_eq_arg_lt";
-
-Goal "[| HH(f,x,v)=HH(f,x,w); HH(f,x,w): Pow(x)-{0}; \
-\ Ord(v); Ord(w) |] ==> v=w";
-by (res_inst_tac [("j","w")] Ord_linear_lt 1 THEN TRYALL assume_tac);
-by (resolve_tac [sym RS (ltD RSN (3, HH_eq_arg_lt))] 2
- THEN REPEAT (assume_tac 2));
-by (dtac subst_elem 1 THEN (assume_tac 1));
-by (fast_tac (FOL_cs addDs [ltD] addSEs [HH_eq_arg_lt]) 1);
-qed "HH_eq_imp_arg_eq";
-
-Goalw [lepoll_def, inj_def]
- "[| HH(f, x, i) \\<in> Pow(x)-{0}; Ord(i) |] ==> i lepoll Pow(x)-{0}";
-by (res_inst_tac [("x","\\<lambda>j \\<in> i. HH(f, x, j)")] exI 1);
-by (Asm_simp_tac 1);
-by (fast_tac (FOL_cs addSEs [HH_eq_imp_arg_eq, Ord_in_Ord, HH_subset_x_lt_too]
- addSIs [lam_type, ballI, ltI] addIs [bexI]) 1);
-qed "HH_subset_x_imp_lepoll";
-
-Goal "HH(f, x, Hartog(Pow(x)-{0})) = {x}";
-by (resolve_tac [HH_values RS disjE] 1 THEN (assume_tac 2));
-by (fast_tac (FOL_cs addSDs [HH_subset_x_imp_lepoll]
- addSIs [Ord_Hartog] addSEs [HartogE]) 1);
-qed "HH_Hartog_is_x";
-
-Goal "HH(f, x, LEAST i. HH(f, x, i) = {x}) = {x}";
-by (fast_tac (claset() addSIs [Ord_Hartog, HH_Hartog_is_x, LeastI]) 1);
-qed "HH_Least_eq_x";
-
-Goal "a \\<in> (LEAST i. HH(f,x,i)={x}) ==> HH(f,x,a) \\<in> Pow(x)-{0}";
-by (resolve_tac [HH_values RS disjE] 1 THEN (assume_tac 1));
-by (rtac less_LeastE 1);
-by (eresolve_tac [Ord_Least RSN (2, ltI)] 2);
-by (assume_tac 1);
-qed "less_Least_subset_x";
-
-(* ********************************************************************** *)
-(* Lemmas used in the proofs of AC1 ==> WO2 and AC17 ==> AC1 *)
-(* ********************************************************************** *)
-
-Goalw [inj_def]
- "(\\<lambda>a \\<in> (LEAST i. HH(f,x,i)={x}). HH(f,x,a)) \
-\ \\<in> inj(LEAST i. HH(f,x,i)={x}, Pow(x)-{0})";
-by (Asm_full_simp_tac 1);
-by (fast_tac (claset() addSIs [lam_type] addDs [less_Least_subset_x]
- addSEs [HH_eq_imp_arg_eq, Ord_Least RS Ord_in_Ord]) 1);
-qed "lam_Least_HH_inj_Pow";
-
-Goal "\\<forall>a \\<in> (LEAST i. HH(f,x,i)={x}). \\<exists>z \\<in> x. HH(f,x,a) = {z} \
-\ ==> (\\<lambda>a \\<in> (LEAST i. HH(f,x,i)={x}). HH(f,x,a)) \
-\ \\<in> inj(LEAST i. HH(f,x,i)={x}, {{y}. y \\<in> x})";
-by (resolve_tac [lam_Least_HH_inj_Pow RS inj_strengthen_type] 1);
-by (Asm_full_simp_tac 1);
-qed "lam_Least_HH_inj";
-
-Goalw [surj_def]
- "[| x - (\\<Union>a \\<in> A. F(a)) = 0; \
-\ \\<forall>a \\<in> A. \\<exists>z \\<in> x. F(a) = {z} |] \
-\ ==> (\\<lambda>a \\<in> A. F(a)) \\<in> surj(A, {{y}. y \\<in> x})";
-by (asm_full_simp_tac (simpset() addsimps [lam_type, Diff_eq_0_iff]) 1);
-by Safe_tac;
-by (set_mp_tac 1);
-by (deepen_tac (claset() addSIs [bexI] addSEs [equalityE]) 4 1);
-qed "lam_surj_sing";
-
-Goal "y \\<in> Pow(x)-{0} ==> x \\<noteq> 0";
-by Auto_tac;
-qed "not_emptyI2";
-
-Goal "f`(x - (\\<Union>j \\<in> i. HH(f,x,j))): Pow(x - (\\<Union>j \\<in> i. HH(f,x,j)))-{0} \
-\ ==> HH(f, x, i) \\<in> Pow(x) - {0}";
-by (resolve_tac [HH_def_satisfies_eq RS ssubst] 1);
-by (asm_full_simp_tac (simpset() addsimps [Let_def, Diff_subset RS PowI,
- not_emptyI2 RS if_P]) 1);
-by (Fast_tac 1);
-qed "f_subset_imp_HH_subset";
-
-val [prem] = goal thy "(!!z. z \\<in> Pow(x)-{0} ==> f`z \\<in> Pow(z)-{0}) ==> \
-\ x - (\\<Union>j \\<in> (LEAST i. HH(f,x,i)={x}). HH(f,x,j)) = 0";
-by (excluded_middle_tac "?P \\<in> {0}" 1);
-by (Fast_tac 2);
-by (dresolve_tac [Diff_subset RS PowI RS DiffI RS prem RS
- f_subset_imp_HH_subset] 1);
-by (fast_tac (claset() addSDs [HH_Least_eq_x RS sym RSN (2, subst_elem)]
- addSEs [mem_irrefl]) 1);
-qed "f_subsets_imp_UN_HH_eq_x";
-
-Goal "HH(f,x,i)=f`(x - (\\<Union>j \\<in> i. HH(f,x,j))) | HH(f,x,i)={x}";
-by (resolve_tac [HH_def_satisfies_eq RS ssubst] 1);
-by (simp_tac (simpset() addsimps [Let_def, Diff_subset RS PowI]) 1);
-qed "HH_values2";
-
-Goal "HH(f,x,i): Pow(x)-{0} ==> HH(f,x,i)=f`(x - (\\<Union>j \\<in> i. HH(f,x,j)))";
-by (resolve_tac [HH_values2 RS disjE] 1 THEN (assume_tac 1));
-by (fast_tac (claset() addSEs [equalityE, mem_irrefl]
- addSDs [singleton_subsetD]) 1);
-qed "HH_subset_imp_eq";
-
-Goal "[| f \\<in> (Pow(x)-{0}) -> {{z}. z \\<in> x}; \
-\ a \\<in> (LEAST i. HH(f,x,i)={x}) |] ==> \\<exists>z \\<in> x. HH(f,x,a) = {z}";
-by (dtac less_Least_subset_x 1);
-by (ftac HH_subset_imp_eq 1);
-by (dtac apply_type 1);
-by (resolve_tac [Diff_subset RS PowI RS DiffI] 1);
-by (fast_tac
- (claset() addSDs [HH_subset_x_imp_subset_Diff_UN RS not_emptyI2]) 1);
-by (fast_tac (claset() addss (simpset())) 1);
-qed "f_sing_imp_HH_sing";
-
-Goalw [bij_def]
- "[| x - (\\<Union>j \\<in> (LEAST i. HH(f,x,i)={x}). HH(f,x,j)) = 0; \
-\ f \\<in> (Pow(x)-{0}) -> {{z}. z \\<in> x} |] \
-\ ==> (\\<lambda>a \\<in> (LEAST i. HH(f,x,i)={x}). HH(f,x,a)) \
-\ \\<in> bij(LEAST i. HH(f,x,i)={x}, {{y}. y \\<in> x})";
-by (fast_tac (claset() addSIs [lam_Least_HH_inj, lam_surj_sing,
- f_sing_imp_HH_sing]) 1);
-qed "f_sing_lam_bij";
-
-Goal "f \\<in> (\\<Pi>X \\<in> Pow(x)-{0}. F(X)) \
-\ ==> (\\<lambda>X \\<in> Pow(x)-{0}. {f`X}) \\<in> (\\<Pi>X \\<in> Pow(x)-{0}. {{z}. z \\<in> F(X)})";
-by (fast_tac (FOL_cs addSIs [lam_type, RepFun_eqI, singleton_eq_iff RS iffD2]
- addDs [apply_type]) 1);
-qed "lam_singI";
-
-val bij_Least_HH_x =
- (lam_singI RSN (2, [f_sing_lam_bij, lam_sing_bij RS bij_converse_bij]
- MRS comp_bij)) |> standard;
--- a/src/ZF/AC/HH.thy Wed Jan 16 15:04:37 2002 +0100
+++ b/src/ZF/AC/HH.thy Wed Jan 16 17:52:06 2002 +0100
@@ -2,22 +2,255 @@
ID: $Id$
Author: Krzysztof Grabczewski
-The theory file for the proofs of
+Some properties of the recursive definition of HH used in the proofs of
AC17 ==> AC1
AC1 ==> WO2
AC15 ==> WO6
*)
-HH = AC_Equiv + Hartog + WO_AC + Let +
+theory HH = AC_Equiv + Hartog:
-consts
+constdefs
- HH :: [i, i, i] => i
+ HH :: "[i, i, i] => i"
+ "HH(f,x,a) == transrec(a, %b r. let z = x - (\<Union>c \<in> b. r`c)
+ in if f`z \<in> Pow(z)-{0} then f`z else {x})"
+
+
+(* ********************************************************************** *)
+(* Lemmas useful in each of the three proofs *)
+(* ********************************************************************** *)
+
+lemma HH_def_satisfies_eq:
+ "HH(f,x,a) = (let z = x - (\<Union>b \<in> a. HH(f,x,b))
+ in if f`z \<in> Pow(z)-{0} then f`z else {x})"
+by (rule HH_def [THEN def_transrec, THEN trans], simp)
+
+lemma HH_values: "HH(f,x,a) \<in> Pow(x)-{0} | HH(f,x,a)={x}"
+apply (rule HH_def_satisfies_eq [THEN ssubst])
+apply (simp add: Let_def Diff_subset [THEN PowI], fast)
+done
+
+lemma subset_imp_Diff_eq:
+ "B \<subseteq> A ==> X-(\<Union>a \<in> A. P(a)) = X-(\<Union>a \<in> A-B. P(a))-(\<Union>b \<in> B. P(b))"
+by fast
+
+lemma Ord_DiffE: "[| c \<in> a-b; b<a |] ==> c=b | b<c & c<a"
+apply (erule ltE)
+apply (drule Ord_linear [of _ c])
+apply (fast elim: Ord_in_Ord)
+apply (fast intro!: ltI intro: Ord_in_Ord)
+done
+
+lemma Diff_UN_eq_self:
+ "(!!y. y \<in> A ==> P(y) = {x}) ==> x - (\<Union>y \<in> A. P(y)) = x"
+apply (simp, fast elim!: mem_irrefl)
+done
+
+lemma HH_eq: "x - (\<Union>b \<in> a. HH(f,x,b)) = x - (\<Union>b \<in> a1. HH(f,x,b))
+ ==> HH(f,x,a) = HH(f,x,a1)"
+apply (subst HH_def_satisfies_eq)
+apply (rule HH_def_satisfies_eq [THEN trans], simp)
+done
+
+lemma HH_is_x_gt_too: "[| HH(f,x,b)={x}; b<a |] ==> HH(f,x,a)={x}"
+apply (rule_tac P = "b<a" in impE)
+prefer 2 apply assumption+
+apply (erule lt_Ord2 [THEN trans_induct])
+apply (rule impI)
+apply (rule HH_eq [THEN trans])
+prefer 2 apply assumption+
+apply (rule leI [THEN le_imp_subset, THEN subset_imp_Diff_eq, THEN ssubst],
+ assumption)
+apply (rule_tac t = "%z. z-?X" in subst_context)
+apply (rule Diff_UN_eq_self)
+apply (drule Ord_DiffE, assumption)
+apply (fast elim: ltE, auto)
+done
+
+lemma HH_subset_x_lt_too:
+ "[| HH(f,x,a) \<in> Pow(x)-{0}; b<a |] ==> HH(f,x,b) \<in> Pow(x)-{0}"
+apply (rule HH_values [THEN disjE], assumption)
+apply (drule HH_is_x_gt_too, assumption)
+apply (drule subst, assumption)
+apply (fast elim!: mem_irrefl)
+done
+
+lemma HH_subset_x_imp_subset_Diff_UN:
+ "HH(f,x,a) \<in> Pow(x)-{0} ==> HH(f,x,a) \<in> Pow(x - (\<Union>b \<in> a. HH(f,x,b)))-{0}"
+apply (drule HH_def_satisfies_eq [THEN subst])
+apply (rule HH_def_satisfies_eq [THEN ssubst])
+apply (simp add: Let_def Diff_subset [THEN PowI])
+apply (drule split_if [THEN iffD1])
+apply (fast elim!: mem_irrefl)
+done
+
+lemma HH_eq_arg_lt:
+ "[| HH(f,x,v)=HH(f,x,w); HH(f,x,v) \<in> Pow(x)-{0}; v \<in> w |] ==> P"
+apply (frule_tac P = "%y. y \<in> Pow (x) -{0}" in subst, assumption)
+apply (drule_tac a = "w" in HH_subset_x_imp_subset_Diff_UN)
+apply (drule subst_elem, assumption)
+apply (fast intro!: singleton_iff [THEN iffD2] equals0I)
+done
+
+lemma HH_eq_imp_arg_eq:
+ "[| HH(f,x,v)=HH(f,x,w); HH(f,x,w) \<in> Pow(x)-{0}; Ord(v); Ord(w) |] ==> v=w"
+apply (rule_tac j = "w" in Ord_linear_lt)
+apply (simp_all (no_asm_simp))
+ apply (drule subst_elem, assumption)
+ apply (blast dest: ltD HH_eq_arg_lt)
+apply (blast dest: HH_eq_arg_lt [OF sym] ltD)
+done
+
+lemma HH_subset_x_imp_lepoll:
+ "[| HH(f, x, i) \<in> Pow(x)-{0}; Ord(i) |] ==> i lepoll Pow(x)-{0}"
+apply (unfold lepoll_def inj_def)
+apply (rule_tac x = "\<lambda>j \<in> i. HH (f, x, j) " in exI)
+apply (simp (no_asm_simp))
+apply (fast del: DiffE
+ elim!: HH_eq_imp_arg_eq Ord_in_Ord HH_subset_x_lt_too
+ intro!: lam_type ballI ltI intro: bexI)
+done
+
+lemma HH_Hartog_is_x: "HH(f, x, Hartog(Pow(x)-{0})) = {x}"
+apply (rule HH_values [THEN disjE])
+prefer 2 apply assumption
+apply (fast del: DiffE
+ intro!: Ord_Hartog
+ dest!: HH_subset_x_imp_lepoll
+ elim!: Hartog_lepoll_selfE)
+done
+
+lemma HH_Least_eq_x: "HH(f, x, LEAST i. HH(f, x, i) = {x}) = {x}"
+by (fast intro!: Ord_Hartog HH_Hartog_is_x LeastI)
+
+lemma less_Least_subset_x:
+ "a \<in> (LEAST i. HH(f,x,i)={x}) ==> HH(f,x,a) \<in> Pow(x)-{0}"
+apply (rule HH_values [THEN disjE], assumption)
+apply (rule less_LeastE)
+apply (erule_tac [2] ltI [OF _ Ord_Least], assumption)
+done
-defs
+(* ********************************************************************** *)
+(* Lemmas used in the proofs of AC1 ==> WO2 and AC17 ==> AC1 *)
+(* ********************************************************************** *)
+
+lemma lam_Least_HH_inj_Pow:
+ "(\<lambda>a \<in> (LEAST i. HH(f,x,i)={x}). HH(f,x,a))
+ \<in> inj(LEAST i. HH(f,x,i)={x}, Pow(x)-{0})"
+apply (unfold inj_def, simp)
+apply (fast intro!: lam_type dest: less_Least_subset_x
+ elim!: HH_eq_imp_arg_eq Ord_Least [THEN Ord_in_Ord])
+done
+
+lemma lam_Least_HH_inj:
+ "\<forall>a \<in> (LEAST i. HH(f,x,i)={x}). \<exists>z \<in> x. HH(f,x,a) = {z}
+ ==> (\<lambda>a \<in> (LEAST i. HH(f,x,i)={x}). HH(f,x,a))
+ \<in> inj(LEAST i. HH(f,x,i)={x}, {{y}. y \<in> x})"
+by (rule lam_Least_HH_inj_Pow [THEN inj_strengthen_type], simp)
+
+lemma lam_surj_sing:
+ "[| x - (\<Union>a \<in> A. F(a)) = 0; \<forall>a \<in> A. \<exists>z \<in> x. F(a) = {z} |]
+ ==> (\<lambda>a \<in> A. F(a)) \<in> surj(A, {{y}. y \<in> x})"
+apply (simp add: surj_def lam_type Diff_eq_0_iff)
+apply (blast elim: equalityE)
+done
+
+lemma not_emptyI2: "y \<in> Pow(x)-{0} ==> x \<noteq> 0"
+by auto
+
+lemma f_subset_imp_HH_subset:
+ "f`(x - (\<Union>j \<in> i. HH(f,x,j))) \<in> Pow(x - (\<Union>j \<in> i. HH(f,x,j)))-{0}
+ ==> HH(f, x, i) \<in> Pow(x) - {0}"
+apply (rule HH_def_satisfies_eq [THEN ssubst])
+apply (simp add: Let_def Diff_subset [THEN PowI] not_emptyI2 [THEN if_P], fast)
+done
+
+lemma f_subsets_imp_UN_HH_eq_x:
+ "\<forall>z \<in> Pow(x)-{0}. f`z \<in> Pow(z)-{0}
+ ==> x - (\<Union>j \<in> (LEAST i. HH(f,x,i)={x}). HH(f,x,j)) = 0"
+apply (case_tac "?P \<in> {0}", fast)
+apply (drule Diff_subset [THEN PowI, THEN DiffI])
+apply (drule bspec, assumption)
+apply (drule f_subset_imp_HH_subset)
+apply (blast dest!: subst_elem [OF _ HH_Least_eq_x [symmetric]]
+ elim!: mem_irrefl)
+done
+
+lemma HH_values2: "HH(f,x,i) = f`(x - (\<Union>j \<in> i. HH(f,x,j))) | HH(f,x,i)={x}"
+apply (rule HH_def_satisfies_eq [THEN ssubst])
+apply (simp add: Let_def Diff_subset [THEN PowI])
+done
+
+lemma HH_subset_imp_eq:
+ "HH(f,x,i): Pow(x)-{0} ==> HH(f,x,i)=f`(x - (\<Union>j \<in> i. HH(f,x,j)))"
+apply (rule HH_values2 [THEN disjE], assumption)
+apply (fast elim!: equalityE mem_irrefl dest!: singleton_subsetD)
+done
- HH_def "HH(f,x,a) == transrec(a, %b r. let z = x - (\\<Union>c \\<in> b. r`c)
- in if(f`z \\<in> Pow(z)-{0}, f`z, {x}))"
+lemma f_sing_imp_HH_sing:
+ "[| f \<in> (Pow(x)-{0}) -> {{z}. z \<in> x};
+ a \<in> (LEAST i. HH(f,x,i)={x}) |] ==> \<exists>z \<in> x. HH(f,x,a) = {z}"
+apply (drule less_Least_subset_x)
+apply (frule HH_subset_imp_eq)
+apply (drule apply_type)
+apply (rule Diff_subset [THEN PowI, THEN DiffI])
+apply (fast dest!: HH_subset_x_imp_subset_Diff_UN [THEN not_emptyI2], force)
+done
+
+lemma f_sing_lam_bij:
+ "[| x - (\<Union>j \<in> (LEAST i. HH(f,x,i)={x}). HH(f,x,j)) = 0;
+ f \<in> (Pow(x)-{0}) -> {{z}. z \<in> x} |]
+ ==> (\<lambda>a \<in> (LEAST i. HH(f,x,i)={x}). HH(f,x,a))
+ \<in> bij(LEAST i. HH(f,x,i)={x}, {{y}. y \<in> x})"
+apply (unfold bij_def)
+apply (fast intro!: lam_Least_HH_inj lam_surj_sing f_sing_imp_HH_sing)
+done
+
+lemma lam_singI:
+ "f \<in> (\<Pi>X \<in> Pow(x)-{0}. F(X))
+ ==> (\<lambda>X \<in> Pow(x)-{0}. {f`X}) \<in> (\<Pi>X \<in> Pow(x)-{0}. {{z}. z \<in> F(X)})"
+by (fast del: DiffI DiffE
+ intro!: lam_type singleton_eq_iff [THEN iffD2] dest: apply_type)
+
+(*FIXME: both uses have the form ...[THEN bij_converse_bij], so
+ simplification is needed!*)
+lemmas bij_Least_HH_x =
+ comp_bij [OF f_sing_lam_bij [OF _ lam_singI]
+ lam_sing_bij [THEN bij_converse_bij], standard]
+
+
+(* ********************************************************************** *)
+(* The proof of AC1 ==> WO2 *)
+(* ********************************************************************** *)
+
+(*Establishing the existence of a bijection, namely
+converse
+ (converse(\<lambda>x\<in>x. {x}) O
+ Lambda
+ (LEAST i. HH(\<lambda>X\<in>Pow(x) - {0}. {f ` X}, x, i) = {x},
+ HH(\<lambda>X\<in>Pow(x) - {0}. {f ` X}, x)))
+Perhaps it could be simplified. *)
+
+lemma bijection:
+ "f \<in> (\<Pi>X \<in> Pow(x) - {0}. X)
+ ==> \<exists>g. g \<in> bij(x, LEAST i. HH(\<lambda>X \<in> Pow(x)-{0}. {f`X}, x, i) = {x})"
+apply (rule exI)
+apply (rule bij_Least_HH_x [THEN bij_converse_bij])
+apply (rule f_subsets_imp_UN_HH_eq_x)
+apply (intro ballI apply_type)
+apply (fast intro: lam_type apply_type del: DiffE)
+apply assumption;
+apply (fast intro: Pi_weaken_type)
+done
+
+lemma AC1_WO2: "AC1 ==> WO2"
+apply (unfold AC1_def WO2_def eqpoll_def)
+apply (intro allI)
+apply (drule_tac x = "Pow(A) - {0}" in spec)
+apply (blast dest: bijection)
+done
end
+
--- a/src/ZF/AC/Hartog.ML Wed Jan 16 15:04:37 2002 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,82 +0,0 @@
-(* Title: ZF/AC/Hartog.ML
- ID: $Id$
- Author: Krzysztof Grabczewski
-
- Some proofs on the Hartogs function.
-*)
-
-Goal "\\<forall>a. Ord(a) --> a \\<in> X ==> P";
-by (res_inst_tac [("X1","{y \\<in> X. Ord(y)}")] (ON_class RS revcut_rl) 1);
-by (Fast_tac 1);
-qed "Ords_in_set";
-
-Goalw [lepoll_def] "[| Ord(a); a lepoll X |] ==> \
-\ \\<exists>Y. Y \\<subseteq> X & (\\<exists>R. well_ord(Y,R) & ordertype(Y,R)=a)";
-by (etac exE 1);
-by (REPEAT (resolve_tac [exI, conjI] 1));
-by (eresolve_tac [inj_is_fun RS fun_is_rel RS image_subset] 1);
-by (rtac exI 1);
-by (rtac conjI 1);
-by (eresolve_tac [well_ord_Memrel RSN (2, subset_refl RSN (2,
- restrict_bij RS bij_converse_bij) RS bij_is_inj RS well_ord_rvimage)] 1
- THEN (assume_tac 1));
-by (resolve_tac [subset_refl RSN (2, restrict_bij RS bij_converse_bij) RS
- (well_ord_Memrel RSN (2, bij_ordertype_vimage)) RS
- (ordertype_Memrel RSN (2, trans))] 1
- THEN (REPEAT (assume_tac 1)));
-qed "Ord_lepoll_imp_ex_well_ord";
-
-Goal "[| Ord(a); a lepoll X |] ==> \
-\ \\<exists>Y. Y \\<subseteq> X & (\\<exists>R. R \\<subseteq> X*X & ordertype(Y,R)=a)";
-by (dtac Ord_lepoll_imp_ex_well_ord 1 THEN (assume_tac 1));
-by Safe_tac;
-by (REPEAT (ares_tac [exI, conjI] 1));
-by (etac ordertype_Int 2);
-by (Fast_tac 1);
-qed "Ord_lepoll_imp_eq_ordertype";
-
-Goal "\\<forall>a. Ord(a) --> a lepoll X ==> \
-\ \\<forall>a. Ord(a) --> \
-\ a:{a. Z \\<in> Pow(X)*Pow(X*X), \\<exists>Y R. Z=<Y,R> & ordertype(Y,R)=a}";
-by (REPEAT (resolve_tac [allI,impI] 1));
-by (REPEAT (eresolve_tac [allE, impE] 1));
-by (assume_tac 1);
-by (dtac Ord_lepoll_imp_eq_ordertype 1 THEN (assume_tac 1));
-by (fast_tac (claset() addSIs [ReplaceI] addEs [sym]) 1);
-qed "Ords_lepoll_set_lemma";
-
-Goal "\\<forall>a. Ord(a) --> a lepoll X ==> P";
-by (eresolve_tac [Ords_lepoll_set_lemma RS Ords_in_set] 1);
-qed "Ords_lepoll_set";
-
-Goal "\\<exists>a. Ord(a) & ~a lepoll X";
-by (rtac swap 1);
-by (Fast_tac 1);
-by (rtac Ords_lepoll_set 1);
-by (Fast_tac 1);
-qed "ex_Ord_not_lepoll";
-
-Goalw [Hartog_def] "~ Hartog(A) lepoll A";
-by (resolve_tac [ex_Ord_not_lepoll RS exE] 1);
-by (rtac LeastI 1);
-by (REPEAT (Fast_tac 1));
-qed "HartogI";
-
-val HartogE = HartogI RS notE;
-
-Goalw [Hartog_def] "Ord(Hartog(A))";
-by (rtac Ord_Least 1);
-qed "Ord_Hartog";
-
-Goalw [Hartog_def] "[| i < Hartog(A); ~ i lepoll A |] ==> P";
-by (fast_tac (claset() addEs [less_LeastE]) 1);
-qed "less_HartogE1";
-
-Goal "[| i < Hartog(A); i eqpoll Hartog(A) |] ==> P";
-by (fast_tac (claset() addEs [less_HartogE1, eqpoll_sym RS eqpoll_imp_lepoll
- RS lepoll_trans RS HartogE]) 1);
-qed "less_HartogE";
-
-Goal "Card(Hartog(A))";
-by (fast_tac (claset() addSIs [CardI, Ord_Hartog] addEs [less_HartogE]) 1);
-qed "Card_Hartog";
--- a/src/ZF/AC/Hartog.thy Wed Jan 16 15:04:37 2002 +0100
+++ b/src/ZF/AC/Hartog.thy Wed Jan 16 17:52:06 2002 +0100
@@ -5,14 +5,79 @@
Hartog's function.
*)
-Hartog = Cardinal +
+theory Hartog = AC_Equiv:
+
+constdefs
+ Hartog :: "i => i"
+ "Hartog(X) == LEAST i. ~ i \<lesssim> X"
+
+lemma Ords_in_set: "\<forall>a. Ord(a) --> a \<in> X ==> P"
+apply (rule_tac X1 = "{y \<in> X. Ord (y) }" in ON_class [THEN revcut_rl])
+apply fast
+done
-consts
+lemma Ord_lepoll_imp_ex_well_ord:
+ "[| Ord(a); a \<lesssim> X |]
+ ==> \<exists>Y. Y \<subseteq> X & (\<exists>R. well_ord(Y,R) & ordertype(Y,R)=a)"
+apply (unfold lepoll_def)
+apply (erule exE)
+apply (intro exI conjI)
+ apply (erule inj_is_fun [THEN fun_is_rel, THEN image_subset])
+ apply (rule well_ord_rvimage [OF bij_is_inj well_ord_Memrel])
+ apply (erule restrict_bij [THEN bij_converse_bij])
+apply (rule subset_refl, assumption);
+apply (rule trans)
+apply (rule bij_ordertype_vimage)
+apply (erule restrict_bij [THEN bij_converse_bij])
+apply (rule subset_refl)
+apply (erule well_ord_Memrel)
+apply (erule ordertype_Memrel)
+done
+
+lemma Ord_lepoll_imp_eq_ordertype:
+ "[| Ord(a); a \<lesssim> X |] ==> \<exists>Y. Y \<subseteq> X & (\<exists>R. R \<subseteq> X*X & ordertype(Y,R)=a)"
+apply (drule Ord_lepoll_imp_ex_well_ord, (assumption))
+apply clarify
+apply (intro exI conjI)
+apply (erule_tac [3] ordertype_Int, auto)
+done
- Hartog :: i => i
+lemma Ords_lepoll_set_lemma:
+ "(\<forall>a. Ord(a) --> a \<lesssim> X) ==>
+ \<forall>a. Ord(a) -->
+ a \<in> {b. Z \<in> Pow(X)*Pow(X*X), \<exists>Y R. Z=<Y,R> & ordertype(Y,R)=b}"
+apply (intro allI impI)
+apply (elim allE impE, assumption)
+apply (blast dest!: Ord_lepoll_imp_eq_ordertype intro: sym)
+done
+
+lemma Ords_lepoll_set: "\<forall>a. Ord(a) --> a \<lesssim> X ==> P"
+by (erule Ords_lepoll_set_lemma [THEN Ords_in_set])
+
+lemma ex_Ord_not_lepoll: "\<exists>a. Ord(a) & ~a \<lesssim> X"
+apply (rule ccontr)
+apply (best intro: Ords_lepoll_set)
+done
-defs
+lemma not_Hartog_lepoll_self: "~ Hartog(A) \<lesssim> A"
+apply (unfold Hartog_def)
+apply (rule ex_Ord_not_lepoll [THEN exE])
+apply (rule LeastI, auto)
+done
+
+lemmas Hartog_lepoll_selfE = not_Hartog_lepoll_self [THEN notE, standard]
- Hartog_def "Hartog(X) == LEAST i. ~i lepoll X"
+lemma Ord_Hartog: "Ord(Hartog(A))"
+by (unfold Hartog_def, rule Ord_Least)
+
+lemma less_HartogE1: "[| i < Hartog(A); ~ i \<lesssim> A |] ==> P"
+by (unfold Hartog_def, fast elim: less_LeastE)
+
+lemma less_HartogE: "[| i < Hartog(A); i \<approx> Hartog(A) |] ==> P"
+by (blast intro: less_HartogE1 eqpoll_sym eqpoll_imp_lepoll
+ lepoll_trans [THEN Hartog_lepoll_selfE]);
+
+lemma Card_Hartog: "Card(Hartog(A))"
+by (fast intro!: CardI Ord_Hartog elim: less_HartogE)
end
--- a/src/ZF/AC/ROOT.ML Wed Jan 16 15:04:37 2002 +0100
+++ b/src/ZF/AC/ROOT.ML Wed Jan 16 17:52:06 2002 +0100
@@ -6,15 +6,12 @@
Executes the proofs of the AC-equivalences, due to Krzysztof Grabczewski
*)
-time_use_thy "AC_Equiv";
-
time_use_thy "WO6_WO1";
time_use_thy "WO1_WO7";
-time_use "AC7_AC9.ML";
+time_use_thy "AC7_AC9";
time_use_thy "WO1_AC";
-time_use_thy "AC1_WO2";
time_use_thy "AC15_WO6";
--- a/src/ZF/AC/WO1_AC.ML Wed Jan 16 15:04:37 2002 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,111 +0,0 @@
-(* Title: ZF/AC/WO1_AC.ML
- ID: $Id$
- Author: Krzysztof Grabczewski
-
-The proofs of WO1 ==> AC1 and WO1 ==> AC10(n) for n >= 1
-
-The latter proof is referred to as clear by the Rubins.
-However it seems to be quite complicated.
-The formal proof presented below is a mechanisation of the proof
-by Lawrence C. Paulson which is the following:
-
-Assume WO1. Let s be a set of infinite sets.
-
-Suppose x \\<in> s. Then x is equipollent to |x| (by WO1), an infinite cardinal;
-call it K. Since K = K |+| K = |K+K| (by InfCard_cdouble_eq) there is an
-isomorphism h \\<in> bij(K+K, x). (Here + means disjoint sum.)
-
-So there is a partition of x into 2-element sets, namely
-
- {{h(Inl(i)), h(Inr(i))} . i \\<in> K}
-
-So for all x \\<in> s the desired partition exists. By AC1 (which follows from WO1)
-there exists a function f that chooses a partition for each x \\<in> s. Therefore we
-have AC10(2).
-
-*)
-
-(* ********************************************************************** *)
-(* WO1 ==> AC1 *)
-(* ********************************************************************** *)
-
-Goalw [AC1_def, WO1_def] "WO1 ==> AC1";
-by (fast_tac (claset() addSEs [ex_choice_fun]) 1);
-qed "WO1_AC1";
-
-(* ********************************************************************** *)
-(* WO1 ==> AC10(n) (n >= 1) *)
-(* ********************************************************************** *)
-
-Goalw [WO1_def] "[| WO1; \\<forall>B \\<in> A. \\<exists>C \\<in> D(B). P(C,B) |] \
-\ ==> \\<exists>f. \\<forall>B \\<in> A. P(f`B,B)";
-by (eres_inst_tac [("x","Union({{C \\<in> D(B). P(C,B)}. B \\<in> A})")] allE 1);
-by (etac exE 1);
-by (dtac ex_choice_fun 1);
-by (Fast_tac 1);
-by (etac exE 1);
-by (res_inst_tac [("x","\\<lambda>x \\<in> A. f`{C \\<in> D(x). P(C,x)}")] exI 1);
-by (Asm_full_simp_tac 1);
-by (blast_tac (claset() addSDs [RepFunI RSN (2, apply_type)]) 1);
-val lemma1 = result();
-
-Goalw [WO1_def] "[| ~Finite(B); WO1 |] ==> |B| + |B| eqpoll B";
-by (rtac eqpoll_trans 1);
-by (fast_tac (claset() addSEs [well_ord_cardinal_eqpoll]) 2);
-by (resolve_tac [eqpoll_sym RS eqpoll_trans] 1);
-by (fast_tac (claset() addSEs [well_ord_cardinal_eqpoll]) 1);
-by (fold_tac [cadd_def]);
-by (resolve_tac [Card_cardinal RSN (2, Inf_Card_is_InfCard) RS
- InfCard_cdouble_eq RS ssubst] 1);
-by (rtac eqpoll_refl 2);
-by (rtac notI 1);
-by (etac notE 1);
-by (resolve_tac [eqpoll_sym RS eqpoll_imp_lepoll RS lepoll_Finite] 1
- THEN (assume_tac 2));
-by (fast_tac (claset() addSEs [well_ord_cardinal_eqpoll]) 1);
-val lemma2_1 = result();
-
-Goal "f \\<in> bij(D+D, B) ==> {{f`Inl(i), f`Inr(i)}. i \\<in> D} \\<in> Pow(Pow(B))";
-by (fast_tac (claset() addSEs [bij_is_fun RS apply_type]) 1);
-val lemma2_2 = result();
-
-Goal "[| f \\<in> inj(A,B); f`a = f`b; a \\<in> A; b \\<in> A |] ==> a=b";
-by (rtac inj_equality 1);
-by (TRYALL (fast_tac (claset() addSEs [inj_is_fun RS apply_Pair] addEs [subst])));
-val lemma = result();
-
-Goalw AC_aux_defs
- "f \\<in> bij(D+D, B) ==> pairwise_disjoint({{f`Inl(i), f`Inr(i)}. i \\<in> D})";
-by (blast_tac (claset() addDs [bij_is_inj RS lemma]) 1);
-val lemma2_3 = result();
-
-val [major, minor] = goalw thy AC_aux_defs
- "[| f \\<in> bij(D+D, B); 1 le n |] ==> \
-\ sets_of_size_between({{f`Inl(i), f`Inr(i)}. i \\<in> D}, 2, succ(n))";
-by (rewtac succ_def);
-by (fast_tac (claset()
- addSIs [cons_lepoll_cong, minor, lepoll_refl]
- addIs [singleton_eqpoll_1 RS eqpoll_imp_lepoll RS lepoll_trans,
- le_imp_subset RS subset_imp_lepoll]
- addDs [major RS bij_is_inj RS lemma]
- addSEs [mem_irrefl]) 1);
-val lemma2_4 = result();
-
-Goalw [bij_def, surj_def]
- "f \\<in> bij(D+D, B) ==> Union({{f`Inl(i), f`Inr(i)}. i \\<in> D})=B";
-by (fast_tac (claset() addSEs [inj_is_fun RS apply_type]) 1);
-val lemma2_5 = result();
-
-Goal "[| WO1; ~Finite(B); 1 le n |] \
-\ ==> \\<exists>C \\<in> Pow(Pow(B)). pairwise_disjoint(C) & \
-\ sets_of_size_between(C, 2, succ(n)) & \
-\ Union(C)=B";
-by (eresolve_tac [lemma2_1 RS (eqpoll_def RS def_imp_iff RS iffD1 RS exE)] 1
- THEN (assume_tac 1));
-by (fast_tac (FOL_cs addSIs [bexI]
- addSEs [lemma2_2, lemma2_3, lemma2_4, lemma2_5]) 1);
-val lemma2 = result();
-
-Goalw AC_defs "[| WO1; 1 le n |] ==> AC10(n)";
-by (fast_tac (claset() addSIs [lemma1] addSEs [lemma2]) 1);
-qed "WO1_AC10";
--- a/src/ZF/AC/WO1_AC.thy Wed Jan 16 15:04:37 2002 +0100
+++ b/src/ZF/AC/WO1_AC.thy Wed Jan 16 17:52:06 2002 +0100
@@ -1,3 +1,105 @@
-(*Dummy theory to document dependencies *)
+(* Title: ZF/AC/WO1_AC.thy
+ ID: $Id$
+ Author: Krzysztof Grabczewski
+
+The proofs of WO1 ==> AC1 and WO1 ==> AC10(n) for n >= 1
+
+The latter proof is referred to as clear by the Rubins.
+However it seems to be quite complicated.
+The formal proof presented below is a mechanisation of the proof
+by Lawrence C. Paulson which is the following:
+
+Assume WO1. Let s be a set of infinite sets.
+
+Suppose x \<in> s. Then x is equipollent to |x| (by WO1), an infinite cardinal
+call it K. Since K = K |+| K = |K+K| (by InfCard_cdouble_eq) there is an
+isomorphism h \<in> bij(K+K, x). (Here + means disjoint sum.)
+
+So there is a partition of x into 2-element sets, namely
+
+ {{h(Inl(i)), h(Inr(i))} . i \<in> K}
+
+So for all x \<in> s the desired partition exists. By AC1 (which follows from WO1)
+there exists a function f that chooses a partition for each x \<in> s. Therefore we
+have AC10(2).
+
+*)
+
+theory WO1_AC = AC_Equiv:
+
+(* ********************************************************************** *)
+(* WO1 ==> AC1 *)
+(* ********************************************************************** *)
+
+theorem WO1_AC1: "WO1 ==> AC1"
+by (unfold AC1_def WO1_def, fast elim!: ex_choice_fun)
+
+(* ********************************************************************** *)
+(* WO1 ==> AC10(n) (n >= 1) *)
+(* ********************************************************************** *)
+
+lemma lemma1: "[| WO1; \<forall>B \<in> A. \<exists>C \<in> D(B). P(C,B) |] ==> \<exists>f. \<forall>B \<in> A. P(f`B,B)"
+apply (unfold WO1_def)
+apply (erule_tac x = "Union ({{C \<in> D (B) . P (C,B) }. B \<in> A}) " in allE)
+apply (erule exE, drule ex_choice_fun, fast)
+apply (erule exE)
+apply (rule_tac x = "\<lambda>x \<in> A. f`{C \<in> D (x) . P (C,x) }" in exI)
+apply (simp, blast dest!: apply_type [OF _ RepFunI])
+done
-WO1_AC = AC_Equiv + WO_AC
+lemma lemma2_1: "[| ~Finite(B); WO1 |] ==> |B| + |B| \<approx> B"
+apply (unfold WO1_def)
+apply (rule eqpoll_trans)
+prefer 2 apply (fast elim!: well_ord_cardinal_eqpoll)
+apply (rule eqpoll_sym [THEN eqpoll_trans])
+apply (fast elim!: well_ord_cardinal_eqpoll)
+apply (drule spec [of _ B])
+apply (clarify dest!: eqpoll_imp_Finite_iff [OF well_ord_cardinal_eqpoll])
+apply (simp add: cadd_def [symmetric]
+ eqpoll_refl InfCard_cdouble_eq Card_cardinal Inf_Card_is_InfCard)
+done
+
+lemma lemma2_2:
+ "f \<in> bij(D+D, B) ==> {{f`Inl(i), f`Inr(i)}. i \<in> D} \<in> Pow(Pow(B))"
+by (fast elim!: bij_is_fun [THEN apply_type])
+
+
+lemma lemma2_3:
+ "f \<in> bij(D+D, B) ==> pairwise_disjoint({{f`Inl(i), f`Inr(i)}. i \<in> D})"
+apply (unfold pairwise_disjoint_def)
+apply (blast dest: bij_is_inj [THEN inj_apply_equality])
+done
+
+lemma lemma2_4:
+ "[| f \<in> bij(D+D, B); 1\<le>n |]
+ ==> sets_of_size_between({{f`Inl(i), f`Inr(i)}. i \<in> D}, 2, succ(n))"
+apply (simp (no_asm_simp) add: sets_of_size_between_def succ_def)
+apply (blast intro!: cons_lepoll_cong
+ intro: singleton_eqpoll_1 [THEN eqpoll_imp_lepoll]
+ le_imp_subset [THEN subset_imp_lepoll] lepoll_trans
+ dest: bij_is_inj [THEN inj_apply_equality] elim!: mem_irrefl)
+done
+
+lemma lemma2_5:
+ "f \<in> bij(D+D, B) ==> Union({{f`Inl(i), f`Inr(i)}. i \<in> D})=B"
+apply (unfold bij_def surj_def)
+apply (fast elim!: inj_is_fun [THEN apply_type])
+done
+
+lemma lemma2:
+ "[| WO1; ~Finite(B); 1\<le>n |]
+ ==> \<exists>C \<in> Pow(Pow(B)). pairwise_disjoint(C) &
+ sets_of_size_between(C, 2, succ(n)) &
+ Union(C)=B"
+apply (drule lemma2_1 [THEN eqpoll_def [THEN def_imp_iff, THEN iffD1]],
+ assumption)
+apply (blast intro!: lemma2_2 lemma2_3 lemma2_4 lemma2_5)
+done
+
+theorem WO1_AC10: "[| WO1; 1\<le>n |] ==> AC10(n)"
+apply (unfold AC10_def)
+apply (fast intro!: lemma1 elim!: lemma2)
+done
+
+end
+
--- a/src/ZF/AC/WO1_WO7.ML Wed Jan 16 15:04:37 2002 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,115 +0,0 @@
-(* Title: ZF/AC/WO1_WO7.ML
- ID: $Id$
- Author: Krzysztof Grabczewski
-
-WO7 <-> LEMMA <-> WO1 (Rubin & Rubin p. 5)
-LEMMA is the sentence denoted by (**)
-
-Also, WO1 <-> WO8
-*)
-
-(* ********************************************************************** *)
-(* It is easy to see, that WO7 is equivallent to (**) *)
-(* ********************************************************************** *)
-
-Goalw [WO7_def, LEMMA_def]
- "WO7 <-> LEMMA";
-by (fast_tac (claset() addSEs [Finite_well_ord_converse]) 1);
-qed "WO7_iff_LEMMA";
-
-(* ********************************************************************** *)
-(* It is also easy to show that LEMMA implies WO1. *)
-(* ********************************************************************** *)
-
-Goalw [WO1_def, LEMMA_def] "LEMMA ==> WO1";
-by (rtac allI 1);
-by (etac allE 1);
-by (excluded_middle_tac "Finite(A)" 1);
-by (Fast_tac 1);
-by (rewrite_goals_tac [Finite_def, eqpoll_def]);
-by (fast_tac (claset() addSIs [[bij_is_inj, nat_implies_well_ord] MRS
- well_ord_rvimage]) 1);
-qed "LEMMA_imp_WO1";
-
-(* ********************************************************************** *)
-(* The Rubins' proof of the other implication is contained within the *)
-(* following sentence \\<in> *)
-(* "... each infinite ordinal is well ordered by < but not by >." *)
-(* This statement can be proved by the following two theorems. *)
-(* But moreover we need to show similar property for any well ordered *)
-(* infinite set. It is not very difficult thanks to Isabelle order types *)
-(* We show that if a set is well ordered by some relation and by its *)
-(* converse, then apropriate order type is well ordered by the converse *)
-(* of it's membership relation, which in connection with the previous *)
-(* gives the conclusion. *)
-(* ********************************************************************** *)
-
-Goalw [wf_on_def, wf_def]
- "[| Ord(a); ~Finite(a) |] ==> ~wf[a](converse(Memrel(a)))";
-by (dresolve_tac [nat_le_infinite_Ord RS le_imp_subset] 1
- THEN (assume_tac 1));
-by (rtac notI 1);
-by (eres_inst_tac [("x","nat")] allE 1);
-by (Blast_tac 1);
-qed "converse_Memrel_not_wf_on";
-
-Goalw [well_ord_def]
- "[| Ord(a); ~Finite(a) |] ==> ~well_ord(a,converse(Memrel(a)))";
-by (fast_tac (claset() addSDs [converse_Memrel_not_wf_on]) 1);
-qed "converse_Memrel_not_well_ord";
-
-Goal "[| well_ord(A,r); well_ord(A,converse(r)) |] \
-\ ==> well_ord(ordertype(A,r), converse(Memrel(ordertype(A, r))))";
-by (rtac ([ordertype_ord_iso RS ord_iso_sym RS ord_iso_rvimage_eq,
- Memrel_type RS (subset_Int_iff RS iffD1)]
- MRS trans RS subst) 1
- THEN (assume_tac 1));
-by (rtac (rvimage_converse RS subst) 1);
-by (etac (ordertype_ord_iso RS ord_iso_sym RS ord_iso_is_bij RS
- bij_is_inj RS well_ord_rvimage) 1
- THEN (assume_tac 1));
-qed "well_ord_converse_Memrel";
-
-Goalw [WO1_def, LEMMA_def] "WO1 ==> LEMMA";
-by (REPEAT (resolve_tac [allI,impI] 1));
-by (REPEAT (eresolve_tac [allE,exE] 1));
-by (REPEAT (ares_tac [exI,conjI,notI] 1));
-by (ftac well_ord_converse_Memrel 1 THEN (assume_tac 1));
-by (forward_tac [Ord_ordertype RS converse_Memrel_not_well_ord] 1);
-by (contr_tac 2);
-by (fast_tac (empty_cs addSEs [ordertype_ord_iso RS ord_iso_is_bij RS
- bij_is_inj RS (exI RS (lepoll_def RS def_imp_iff RS iffD2))
- RS lepoll_Finite]
- addSIs [notI] addEs [notE]) 1);
-qed "WO1_imp_LEMMA";
-
-
-Goal "WO1 <-> WO7";
-by (simp_tac (simpset() addsimps [WO7_iff_LEMMA]) 1);
-by (blast_tac (claset() addIs [LEMMA_imp_WO1, WO1_imp_LEMMA]) 1);
-qed "WO1_iff_WO7";
-
-
-
-(* ********************************************************************** *)
-
-(* The proof of WO8 <-> WO1 (Rubin & Rubin p. 6) *)
-
-(* ********************************************************************** *)
-
-Goalw WO_defs "WO1 ==> WO8";
-by (Fast_tac 1);
-qed "WO1_WO8";
-
-
-(* The proof of "WO8 ==> WO1" - faithful image of Rubin & Rubin's proof *)
-Goalw WO_defs "WO8 ==> WO1";
-by (rtac allI 1);
-by (eres_inst_tac [("x","{{x}. x \\<in> A}")] allE 1);
-by (etac impE 1);
-by (fast_tac (claset() addSEs [lam_sing_bij RS bij_is_inj RS
- well_ord_rvimage]) 2);
-by (res_inst_tac [("x","\\<lambda>a \\<in> {{x}. x \\<in> A}. THE x. a={x}")] exI 1);
-by (force_tac (claset() addSIs [lam_type],
- simpset() addsimps [singleton_eq_iff, the_equality]) 1);
-qed "WO8_WO1";
--- a/src/ZF/AC/WO1_WO7.thy Wed Jan 16 15:04:37 2002 +0100
+++ b/src/ZF/AC/WO1_WO7.thy Wed Jan 16 17:52:06 2002 +0100
@@ -5,13 +5,110 @@
WO7 <-> LEMMA <-> WO1 (Rubin & Rubin p. 5)
LEMMA is the sentence denoted by (**)
+
+Also, WO1 <-> WO8
*)
-WO1_WO7 = AC_Equiv +
+theory WO1_WO7 = AC_Equiv:
constdefs
LEMMA :: o
"LEMMA ==
- \\<forall>X. ~Finite(X) --> (\\<exists>R. well_ord(X,R) & ~well_ord(X,converse(R)))"
+ \<forall>X. ~Finite(X) --> (\<exists>R. well_ord(X,R) & ~well_ord(X,converse(R)))"
+
+(* ********************************************************************** *)
+(* It is easy to see that WO7 is equivalent to (**) *)
+(* ********************************************************************** *)
+
+lemma WO7_iff_LEMMA: "WO7 <-> LEMMA"
+apply (unfold WO7_def LEMMA_def)
+apply (blast intro: Finite_well_ord_converse)
+done
+
+(* ********************************************************************** *)
+(* It is also easy to show that LEMMA implies WO1. *)
+(* ********************************************************************** *)
+
+lemma LEMMA_imp_WO1: "LEMMA ==> WO1"
+apply (unfold WO1_def LEMMA_def Finite_def eqpoll_def)
+apply (blast intro!: well_ord_rvimage [OF bij_is_inj nat_implies_well_ord])
+done
+
+(* ********************************************************************** *)
+(* The Rubins' proof of the other implication is contained within the *)
+(* following sentence \<in> *)
+(* "... each infinite ordinal is well ordered by < but not by >." *)
+(* This statement can be proved by the following two theorems. *)
+(* But moreover we need to show similar property for any well ordered *)
+(* infinite set. It is not very difficult thanks to Isabelle order types *)
+(* We show that if a set is well ordered by some relation and by its *)
+(* converse, then apropriate order type is well ordered by the converse *)
+(* of it's membership relation, which in connection with the previous *)
+(* gives the conclusion. *)
+(* ********************************************************************** *)
+
+lemma converse_Memrel_not_wf_on:
+ "[| Ord(a); ~Finite(a) |] ==> ~wf[a](converse(Memrel(a)))"
+apply (unfold wf_on_def wf_def)
+apply (drule nat_le_infinite_Ord [THEN le_imp_subset], (assumption))
+apply (rule notI)
+apply (erule_tac x = "nat" in allE, blast)
+done
+
+lemma converse_Memrel_not_well_ord:
+ "[| Ord(a); ~Finite(a) |] ==> ~well_ord(a,converse(Memrel(a)))"
+apply (unfold well_ord_def)
+apply (blast dest: converse_Memrel_not_wf_on)
+done
+
+lemma well_ord_rvimage_ordertype:
+ "well_ord(A,r) \<Longrightarrow>
+ rvimage (ordertype(A,r), converse(ordermap(A,r)),r) =
+ Memrel(ordertype(A,r))"
+by (blast intro: ordertype_ord_iso [THEN ord_iso_sym] ord_iso_rvimage_eq
+ Memrel_type [THEN subset_Int_iff [THEN iffD1]] trans)
+
+lemma well_ord_converse_Memrel:
+ "[| well_ord(A,r); well_ord(A,converse(r)) |]
+ ==> well_ord(ordertype(A,r), converse(Memrel(ordertype(A,r))))"
+apply (subst well_ord_rvimage_ordertype [symmetric], assumption)
+apply (rule rvimage_converse [THEN subst])
+apply (blast intro: ordertype_ord_iso ord_iso_sym ord_iso_is_bij
+ bij_is_inj well_ord_rvimage)
+done
+
+lemma WO1_imp_LEMMA: "WO1 ==> LEMMA"
+apply (unfold WO1_def LEMMA_def, clarify)
+apply (blast dest: well_ord_converse_Memrel
+ Ord_ordertype [THEN converse_Memrel_not_well_ord]
+ intro: ordertype_ord_iso ord_iso_is_bij bij_is_inj lepoll_Finite
+ lepoll_def [THEN def_imp_iff, THEN iffD2] )
+done
+
+lemma WO1_iff_WO7: "WO1 <-> WO7"
+apply (simp add: WO7_iff_LEMMA)
+apply (blast intro: LEMMA_imp_WO1 WO1_imp_LEMMA)
+done
+
+
+
+(* ********************************************************************** *)
+(* The proof of WO8 <-> WO1 (Rubin & Rubin p. 6) *)
+(* ********************************************************************** *)
+
+lemma WO1_WO8: "WO1 ==> WO8"
+by (unfold WO1_def WO8_def, fast)
+
+
+(* The implication "WO8 ==> WO1": a faithful image of Rubin & Rubin's proof*)
+lemma WO8_WO1: "WO8 ==> WO1"
+apply (unfold WO1_def WO8_def)
+apply (rule allI)
+apply (erule_tac x = "{{x}. x \<in> A}" in allE)
+apply (erule impE)
+ apply (rule_tac x = "\<lambda>a \<in> {{x}. x \<in> A}. THE x. a={x}" in exI)
+ apply (force intro!: lam_type simp add: singleton_eq_iff the_equality)
+apply (blast intro: lam_sing_bij bij_is_inj well_ord_rvimage)
+done
end
--- a/src/ZF/AC/WO2_AC16.ML Wed Jan 16 15:04:37 2002 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,591 +0,0 @@
-(* Title: ZF/AC/WO2_AC16.ML
- ID: $Id$
- Author: Krzysztof Grabczewski
-
- The proof of WO2 ==> AC16(k #+ m, k)
-
- The main part of the proof is the inductive reasoning concerning
- properties of constructed family T_gamma.
- The proof deals with three cases for ordinals: 0, succ and limit ordinal.
- The first instance is trivial, the third not difficult, but the second
- is very complicated requiring many lemmas.
- We also need to prove that at any stage gamma the set
- (s - Union(...) - k_gamma) (Rubin & Rubin page 15)
- contains m distinct elements (in fact is equipollent to s)
-*)
-
-(* ********************************************************************** *)
-(* case of limit ordinal *)
-(* ********************************************************************** *)
-
-
-Goal "[| \\<forall>y<x. \\<forall>z<a. z<y | (\\<exists>Y \\<in> F(y). f(z)<=Y) \
-\ --> (\\<exists>! Y. Y \\<in> F(y) & f(z)<=Y); \
-\ \\<forall>i j. i le j --> F(i) \\<subseteq> F(j); j le i; i<x; z<a; \
-\ V \\<in> F(i); f(z)<=V; W \\<in> F(j); f(z)<=W |] \
-\ ==> V = W";
-by (REPEAT (eresolve_tac [asm_rl, allE, impE] 1));
-by (dtac subsetD 1 THEN (assume_tac 1));
-by (REPEAT (dtac ospec 1 THEN (assume_tac 1)));
-by (eresolve_tac [disjI2 RSN (2, impE)] 1);
-by (fast_tac (FOL_cs addSIs [bexI]) 1);
-by (etac ex1_two_eq 1 THEN (REPEAT (ares_tac [conjI] 1)));
-val lemma3_1 = result();
-
-
-Goal "[| \\<forall>y<x. \\<forall>z<a. z<y | (\\<exists>Y \\<in> F(y). f(z)<=Y) \
-\ --> (\\<exists>! Y. Y \\<in> F(y) & f(z)<=Y); \
-\ \\<forall>i j. i le j --> F(i) \\<subseteq> F(j); i<x; j<x; z<a; \
-\ V \\<in> F(i); f(z)<=V; W \\<in> F(j); f(z)<=W |] \
-\ ==> V = W";
-by (res_inst_tac [("j","j")] ([lt_Ord, lt_Ord] MRS Ord_linear_le) 1
- THEN (REPEAT (assume_tac 1)));
-by (eresolve_tac [lemma3_1 RS sym] 1 THEN (REPEAT (assume_tac 1)));
-by (etac lemma3_1 1 THEN (REPEAT (assume_tac 1)));
-val lemma3 = result();
-
-
-Goal "[| \\<forall>y<x. F(y) \\<subseteq> X & \
-\ (\\<forall>x<a. x < y | (\\<exists>Y \\<in> F(y). fa(x) \\<subseteq> Y) --> \
-\ (\\<exists>! Y. Y \\<in> F(y) & fa(x) \\<subseteq> Y)); x < a |] \
-\ ==> \\<forall>y<x. \\<forall>z<a. z < y | (\\<exists>Y \\<in> F(y). fa(z) \\<subseteq> Y) --> \
-\ (\\<exists>! Y. Y \\<in> F(y) & fa(z) \\<subseteq> Y)";
-by (REPEAT (resolve_tac [oallI, impI] 1));
-by (dtac ospec 1 THEN (assume_tac 1));
-by (fast_tac (FOL_cs addSEs [oallE]) 1);
-val lemma4 = result();
-
-
-Goal "[| \\<forall>y<x. F(y) \\<subseteq> X & \
-\ (\\<forall>x<a. x < y | (\\<exists>Y \\<in> F(y). fa(x) \\<subseteq> Y) --> \
-\ (\\<exists>! Y. Y \\<in> F(y) & fa(x) \\<subseteq> Y)); \
-\ x < a; Limit(x); \\<forall>i j. i le j --> F(i) \\<subseteq> F(j) |] \
-\ ==> (\\<Union>x<x. F(x)) \\<subseteq> X & \
-\ (\\<forall>xa<a. xa < x | (\\<exists>x \\<in> \\<Union>x<x. F(x). fa(xa) \\<subseteq> x) \
-\ --> (\\<exists>! Y. Y \\<in> (\\<Union>x<x. F(x)) & fa(xa) \\<subseteq> Y))";
-by (rtac conjI 1);
-by (rtac subsetI 1);
-by (etac OUN_E 1);
-by (dtac ospec 1 THEN (assume_tac 1));
-by (Fast_tac 1);
-by (dtac lemma4 1 THEN (assume_tac 1));
-by (rtac oallI 1);
-by (rtac impI 1);
-by (etac disjE 1);
-by (forward_tac [Limit_has_succ RSN (2, ospec)] 1 THEN (REPEAT (assume_tac 1)));
-by (dres_inst_tac [("A","a"),("x","xa")] ospec 1 THEN (assume_tac 1));
-by (eresolve_tac [lt_Ord RS le_refl RSN (2, disjI1 RSN (2, impE))] 1
- THEN (assume_tac 1));
-by (REPEAT (eresolve_tac [ex1E, conjE] 1));
-by (rtac ex1I 1);
-by (rtac conjI 1 THEN (assume_tac 2));
-by (eresolve_tac [Limit_has_succ RS OUN_I] 1 THEN (TRYALL assume_tac));
-by (REPEAT (eresolve_tac [conjE, OUN_E] 1));
-by (etac lemma3 1 THEN (TRYALL assume_tac));
-by (etac Limit_has_succ 1 THEN (assume_tac 1));
-by (etac bexE 1);
-by (rtac ex1I 1);
-by (etac conjI 1 THEN (assume_tac 1));
-by (REPEAT (eresolve_tac [conjE, OUN_E] 1));
-by (etac lemma3 1 THEN (TRYALL assume_tac));
-val lemma5 = result();
-
-(* ********************************************************************** *)
-(* case of successor ordinal *)
-(* ********************************************************************** *)
-
-(*
- First quite complicated proof of the fact used in the recursive construction
- of the family T_gamma (WO2 ==> AC16(k #+ m, k)) - the fact that at any stage
- gamma the set (s - Union(...) - k_gamma) is equipollent to s
- (Rubin & Rubin page 15).
-*)
-
-(* ********************************************************************** *)
-(* dbl_Diff_eqpoll_Card *)
-(* ********************************************************************** *)
-
-
-Goal "[| A eqpoll a; Card(a); ~Finite(a); B lesspoll a; \
-\ C lesspoll a |] ==> A - B - C eqpoll a";
-by (rtac Diff_lesspoll_eqpoll_Card 1 THEN (REPEAT (assume_tac 1)));
-by (rtac Diff_lesspoll_eqpoll_Card 1 THEN (REPEAT (assume_tac 1)));
-qed "dbl_Diff_eqpoll_Card";
-
-(* ********************************************************************** *)
-(* Case of finite ordinals *)
-(* ********************************************************************** *)
-
-
-Goalw [lesspoll_def]
- "[| Finite(X); ~Finite(a); Ord(a) |] ==> X lesspoll a";
-by (rtac conjI 1);
-by (dresolve_tac [nat_le_infinite_Ord RS le_imp_lepoll] 1
- THEN (assume_tac 1));
-by (rewtac Finite_def);
-by (fast_tac (claset() addSEs [eqpoll_sym RS eqpoll_trans]) 2);
-by (rtac lepoll_trans 1 THEN (assume_tac 2));
-by (fast_tac (claset() addSEs [Ord_nat RSN (2, ltI) RS leI RS le_imp_subset RS
- subset_imp_lepoll RSN (2, eqpoll_imp_lepoll RS lepoll_trans)]) 1);
-qed "Finite_lesspoll_infinite_Ord";
-
-Goal "[| \\<forall>x \\<in> X. x lepoll n & x \\<subseteq> T; well_ord(T, R); X lepoll b; \
-\ b<a; ~Finite(a); Card(a); n \\<in> nat |] \
-\ ==> Union(X) lesspoll a";
-by (excluded_middle_tac "Finite(X)" 1);
-by (resolve_tac [Card_is_Ord RSN (3, Finite_lesspoll_infinite_Ord)] 2
- THEN (REPEAT (assume_tac 3)));
-by (fast_tac (claset() addSEs [lepoll_nat_imp_Finite]
- addSIs [Finite_Union]) 2);
-by (dresolve_tac [lt_Ord RSN (2, lepoll_imp_ex_le_eqpoll)] 1 THEN (assume_tac 1));
-by (REPEAT (eresolve_tac [exE, conjE] 1));
-by (forward_tac [eqpoll_imp_lepoll RS lepoll_infinite] 1 THEN (assume_tac 1));
-by (eresolve_tac [eqpoll_sym RS (eqpoll_def RS def_imp_iff RS iffD1) RS
- exE] 1);
-by (forward_tac [bij_is_surj RS surj_image_eq] 1);
-by (dresolve_tac [[bij_is_fun, subset_refl] MRS image_fun] 1);
-by (dresolve_tac [sym RS trans] 1 THEN (assume_tac 1));
-by (blast_tac (claset() addIs [lesspoll_trans1, UN_lepoll, lt_Ord,
- lt_trans1 RSN (2, lt_Card_imp_lesspoll)]) 1);
-qed "Union_lesspoll";
-
-(* ********************************************************************** *)
-(* recfunAC16_lepoll_index *)
-(* ********************************************************************** *)
-
-
-Goal "A Un {a} = cons(a, A)";
-by (Fast_tac 1);
-qed "Un_sing_eq_cons";
-
-
-Goal "A lepoll B ==> A Un {a} lepoll succ(B)";
-by (asm_simp_tac (simpset() addsimps [Un_sing_eq_cons, succ_def]) 1);
-by (eresolve_tac [mem_not_refl RSN (2, cons_lepoll_cong)] 1);
-qed "Un_lepoll_succ";
-
-
-Goal "Ord(a) ==> F(a) - (\\<Union>b<succ(a). F(b)) = 0";
-by (fast_tac (claset() addSIs [OUN_I, le_refl]) 1);
-qed "Diff_UN_succ_empty";
-
-
-Goal "Ord(a) ==> F(a) Un X - (\\<Union>b<succ(a). F(b)) \\<subseteq> X";
-by (fast_tac (claset() addSIs [OUN_I, le_refl]) 1);
-qed "Diff_UN_succ_subset";
-
-
-Goal "Ord(x) ==> \
-\ recfunAC16(f, g, x, a) - (\\<Union>i<x. recfunAC16(f, g, i, a)) lepoll 1";
-by (etac Ord_cases 1);
-by (asm_simp_tac (simpset() addsimps [recfunAC16_0,
- empty_subsetI RS subset_imp_lepoll]) 1);
-by (asm_simp_tac (simpset() addsimps [recfunAC16_Limit, Diff_cancel,
- empty_subsetI RS subset_imp_lepoll]) 2);
-by (asm_simp_tac (simpset() addsimps [recfunAC16_succ]) 1);
-by (rtac conjI 1);
-by (fast_tac (claset() addSIs [empty_subsetI RS subset_imp_lepoll]
- addSEs [Diff_UN_succ_empty RS ssubst]) 1);
-by (fast_tac (claset() addSEs [Diff_UN_succ_subset RS subset_imp_lepoll RS
- (singleton_eqpoll_1 RS eqpoll_imp_lepoll RSN (2, lepoll_trans))]) 1);
-qed "recfunAC16_Diff_lepoll_1";
-
-
-Goal "[| z \\<in> F(x); Ord(x) |] \
-\ ==> z \\<in> F(LEAST i. z \\<in> F(i)) - (\\<Union>j<(LEAST i. z \\<in> F(i)). F(j))";
-by (fast_tac (claset() addEs [less_LeastE] addSEs [OUN_E, LeastI]) 1);
-qed "in_Least_Diff";
-
-
-Goal "[| (LEAST i. w \\<in> F(i)) = (LEAST i. z \\<in> F(i)); \
-\ w \\<in> (\\<Union>i<a. F(i)); z \\<in> (\\<Union>i<a. F(i)) |] \
-\ ==> \\<exists>b<a. w \\<in> (F(b) - (\\<Union>c<b. F(c))) & z \\<in> (F(b) - (\\<Union>c<b. F(c)))";
-by (REPEAT (etac OUN_E 1));
-by (dresolve_tac [lt_Ord RSN (2, in_Least_Diff)] 1 THEN (assume_tac 1));
-by (forward_tac [lt_Ord RSN (2, in_Least_Diff)] 1 THEN (assume_tac 1));
-by (rtac oexI 1);
-by (rtac conjI 1 THEN (assume_tac 2));
-by (etac subst 1 THEN (assume_tac 1));
-by (eresolve_tac [lt_Ord RSN (2, Least_le) RS lt_trans1] 1
- THEN (REPEAT (assume_tac 1)));
-qed "Least_eq_imp_ex";
-
-
-Goal "[| A lepoll 1; a \\<in> A; b \\<in> A |] ==> a=b";
-by (fast_tac (claset() addSDs [lepoll_1_is_sing]) 1);
-qed "two_in_lepoll_1";
-
-
-Goal "[| \\<forall>i<a. F(i)-(\\<Union>j<i. F(j)) lepoll 1; Limit(a) |] \
-\ ==> (\\<Union>x<a. F(x)) lepoll a";
-by (resolve_tac [lepoll_def RS (def_imp_iff RS iffD2)] 1);
-by (res_inst_tac [("x","\\<lambda>z \\<in> (\\<Union>x<a. F(x)). LEAST i. z \\<in> F(i)")] exI 1);
-by (rewtac inj_def);
-by (rtac CollectI 1);
-by (rtac lam_type 1);
-by (etac OUN_E 1);
-by (etac Least_in_Ord 1);
-by (etac ltD 1);
-by (etac lt_Ord2 1);
-by (rtac ballI 1);
-by (rtac ballI 1);
-by (Asm_simp_tac 1);
-by (rtac impI 1);
-by (dtac Least_eq_imp_ex 1 THEN (REPEAT (assume_tac 1)));
-by (fast_tac (claset() addSEs [two_in_lepoll_1]) 1);
-qed "UN_lepoll_index";
-
-
-Goal "Ord(y) ==> recfunAC16(f, fa, y, a) lepoll y";
-by (etac trans_induct 1);
-by (etac Ord_cases 1);
-by (asm_simp_tac (simpset() addsimps [recfunAC16_0, lepoll_refl]) 1);
-by (asm_simp_tac (simpset() addsimps [recfunAC16_succ]) 1);
-by (fast_tac (claset()
- addSDs [succI1 RSN (2, bspec)]
- addSEs [subset_succI RS subset_imp_lepoll RSN (2, lepoll_trans),
- Un_lepoll_succ]) 1);
-by (asm_simp_tac (simpset() addsimps [recfunAC16_Limit]) 1);
-by (fast_tac (claset() addSEs [lt_Ord RS recfunAC16_Diff_lepoll_1]
- addSIs [UN_lepoll_index]) 1);
-qed "recfunAC16_lepoll_index";
-
-
-Goal "[| recfunAC16(f,g,y,a) \\<subseteq> {X \\<in> Pow(A). X eqpoll n}; \
-\ A eqpoll a; y<a; ~Finite(a); Card(a); n \\<in> nat |] \
-\ ==> Union(recfunAC16(f,g,y,a)) lesspoll a";
-by (eresolve_tac [eqpoll_def RS def_imp_iff RS iffD1 RS exE] 1);
-by (rtac Union_lesspoll 1 THEN (TRYALL assume_tac));
-by (eresolve_tac [lt_Ord RS recfunAC16_lepoll_index] 3);
-by (eresolve_tac [[bij_is_inj, Card_is_Ord RS well_ord_Memrel] MRS
- well_ord_rvimage] 2
- THEN (assume_tac 2));
-by (fast_tac (claset() addSEs [eqpoll_imp_lepoll]) 1);
-qed "Union_recfunAC16_lesspoll";
-
-
-Goal "[| recfunAC16(f, fa, y, a) \\<subseteq> {X \\<in> Pow(A) . X eqpoll succ(k #+ m)}; \
-\ Card(a); ~ Finite(a); A eqpoll a; \
-\ k \\<in> nat; y<a; \
-\ fa \\<in> bij(a, {Y \\<in> Pow(A). Y eqpoll succ(k)}) |] \
-\ ==> A - Union(recfunAC16(f, fa, y, a)) - fa`y eqpoll a";
-by (rtac dbl_Diff_eqpoll_Card 1 THEN (TRYALL assume_tac));
-by (rtac Union_recfunAC16_lesspoll 1 THEN (REPEAT (assume_tac 1)));
-by (Simp_tac 1);
-by (resolve_tac [nat_succI RSN
- (2, bexI RS (Finite_def RS def_imp_iff RS iffD2)) RS
- (Card_is_Ord RSN (3, Finite_lesspoll_infinite_Ord))] 1
- THEN (TRYALL assume_tac));
-by (eresolve_tac [ltD RSN (2, bij_is_fun RS apply_type) RS CollectE] 1
- THEN (TRYALL assume_tac));
-qed "dbl_Diff_eqpoll";
-
-(* back to the proof *)
-
-val disj_Un_eqpoll_nat_sum =
- [disj_Un_eqpoll_sum, sum_eqpoll_cong, nat_sum_eqpoll_sum] MRS
- (eqpoll_trans RS eqpoll_trans) |> standard;
-
-
-Goal "[| x \\<in> Pow(A - B - fa`i); x eqpoll m; \
-\ fa \\<in> bij(a, {x \\<in> Pow(A) . x eqpoll k}); i<a; k \\<in> nat; m \\<in> nat |] \
-\ ==> fa ` i Un x \\<in> {x \\<in> Pow(A) . x eqpoll k #+ m}";
-by (rtac CollectI 1);
-by (fast_tac (claset()
- addSEs [ltD RSN (2, bij_is_fun RS apply_type RS CollectE)]) 1);
-by (rtac disj_Un_eqpoll_nat_sum 1
- THEN (TRYALL assume_tac));
-by (fast_tac (claset() addSIs [equals0I]) 1);
-by (eresolve_tac [ltD RSN (2, bij_is_fun RS apply_type RS CollectE)] 1
- THEN (REPEAT (assume_tac 1)));
-qed "Un_in_Collect";
-
-(* ********************************************************************** *)
-(* Lemmas simplifying assumptions *)
-(* ********************************************************************** *)
-
-
-Goal "[| \\<forall>y<succ(j). F(y)<=X & (\\<forall>x<a. x<y | P(x,y) \
-\ --> Q(x,y)); succ(j)<a |] \
-\ ==> F(j)<=X & (\\<forall>x<a. x<j | P(x,j) --> Q(x,j))";
-by (dtac ospec 1);
-by (resolve_tac [lt_Ord RS (succI1 RS ltI RS lt_Ord RS le_refl)] 1
- THEN (REPEAT (assume_tac 1)));
-val lemma6 = result();
-
-
-Goal "[| \\<forall>x<a. x<j | P(x,j) --> Q(x,j); succ(j)<a |] \
-\ ==> P(j,j) --> (\\<forall>x<a. x le j | P(x,j) --> Q(x,j))";
-by (fast_tac (claset() addSEs [leE]) 1);
-val lemma7 = result();
-
-(* ********************************************************************** *)
-(* Lemmas needded to prove ex_next_set which means that for any successor *)
-(* ordinal there is a set satisfying certain properties *)
-(* ********************************************************************** *)
-
-
-Goal "[| A eqpoll a; ~ Finite(a); Ord(a); m \\<in> nat |] \
-\ ==> \\<exists>X \\<in> Pow(A). X eqpoll m";
-by (eresolve_tac [Ord_nat RSN (2, ltI) RS
- (nat_le_infinite_Ord RSN (2, lt_trans2)) RS
- leI RS le_imp_lepoll RS
- ((eqpoll_sym RS eqpoll_imp_lepoll) RSN (2, lepoll_trans)) RS
- lepoll_imp_eqpoll_subset RS exE] 1
- THEN REPEAT (assume_tac 1));
-by (fast_tac (claset() addSEs [eqpoll_sym]) 1);
-qed "ex_subset_eqpoll";
-
-
-Goal "[| A \\<subseteq> B Un C; A Int C = 0 |] ==> A \\<subseteq> B";
-by (Blast_tac 1);
-qed "subset_Un_disjoint";
-
-
-Goal "[| X \\<in> Pow(A - Union(B) -C); T \\<in> B; F \\<subseteq> T |] ==> F Int X = 0";
-by (Blast_tac 1);
-qed "Int_empty";
-
-(* ********************************************************************** *)
-(* equipollent subset (and finite) is the whole set *)
-(* ********************************************************************** *)
-
-
-Goal "[| A \\<subseteq> B; a \\<in> A; A - {a} = B - {a} |] ==> A = B";
-by (fast_tac (claset() addSEs [equalityE]) 1);
-qed "Diffs_eq_imp_eq";
-
-
-Goal "m \\<in> nat ==> \\<forall>A B. A \\<subseteq> B & m lepoll A & B lepoll m --> A=B";
-by (induct_tac "m" 1);
-by (fast_tac (claset() addSDs [lepoll_0_is_0]) 1);
-by (REPEAT (resolve_tac [allI, impI] 1));
-by (REPEAT (etac conjE 1));
-by (resolve_tac [succ_lepoll_imp_not_empty RS not_emptyE] 1
- THEN (assume_tac 1));
-by (forward_tac [subsetD RS Diff_sing_lepoll] 1
- THEN REPEAT (assume_tac 1));
-by (ftac lepoll_Diff_sing 1);
-by (REPEAT (eresolve_tac [allE, impE] 1));
-by (rtac conjI 1);
-by (Fast_tac 2);
-by (Fast_tac 1);
-by (etac Diffs_eq_imp_eq 1
- THEN REPEAT (assume_tac 1));
-qed "subset_imp_eq_lemma";
-
-
-Goal "[| A \\<subseteq> B; m lepoll A; B lepoll m; m \\<in> nat |] ==> A=B";
-by (fast_tac (FOL_cs addSDs [subset_imp_eq_lemma]) 1);
-qed "subset_imp_eq";
-
-
-Goal "[| f \\<in> bij(a, {Y \\<in> X. Y eqpoll succ(k)}); k \\<in> nat; f`b \\<subseteq> f`y; b<a; \
-\ y<a |] ==> b=y";
-by (dtac subset_imp_eq 1);
-by (etac nat_succI 3);
-by (fast_tac (claset() addSEs [bij_is_fun RS (ltD RSN (2, apply_type)) RS
- CollectE, eqpoll_sym RS eqpoll_imp_lepoll]) 1);
-by (fast_tac (claset() addSEs [bij_is_fun RS (ltD RSN (2, apply_type)) RS
- CollectE, eqpoll_imp_lepoll]) 1);
-by (rewrite_goals_tac [bij_def, inj_def]);
-by (fast_tac (claset() addSDs [ltD]) 1);
-qed "bij_imp_arg_eq";
-
-
-Goal "[| recfunAC16(f, fa, y, a) \\<subseteq> {X \\<in> Pow(A) . X eqpoll succ(k #+ m)}; \
-\ Card(a); ~ Finite(a); A eqpoll a; \
-\ k \\<in> nat; m \\<in> nat; y<a; \
-\ fa \\<in> bij(a, {Y \\<in> Pow(A). Y eqpoll succ(k)}); \
-\ ~ (\\<exists>Y \\<in> recfunAC16(f, fa, y, a). fa`y \\<subseteq> Y) |] \
-\ ==> \\<exists>X \\<in> {Y \\<in> Pow(A). Y eqpoll succ(k #+ m)}. fa`y \\<subseteq> X & \
-\ (\\<forall>b<a. fa`b \\<subseteq> X --> \
-\ (\\<forall>T \\<in> recfunAC16(f, fa, y, a). ~ fa`b \\<subseteq> T))";
-by (eresolve_tac [dbl_Diff_eqpoll RS ex_subset_eqpoll RS bexE] 1
- THEN REPEAT (assume_tac 1));
-by (etac Card_is_Ord 1);
-by (ftac Un_in_Collect 2 THEN REPEAT (assume_tac 2));
-by (etac CollectE 4);
-by (rtac bexI 4);
-by (rtac CollectI 5);
-by (assume_tac 5);
-by (eresolve_tac [add_succ RS subst] 5);
-by (assume_tac 1);
-by (etac nat_succI 1);
-by (assume_tac 1);
-by (rtac conjI 1);
-by (Fast_tac 1);
-by (REPEAT (resolve_tac [ballI, impI, oallI, notI] 1));
-by (dresolve_tac [Int_empty RSN (2, subset_Un_disjoint)] 1
- THEN REPEAT (assume_tac 1));
-by (dtac bij_imp_arg_eq 1 THEN REPEAT (assume_tac 1));
-by (hyp_subst_tac 1);
-by (eresolve_tac [bexI RSN (2, notE)] 1 THEN TRYALL assume_tac);
-qed "ex_next_set";
-
-(* ********************************************************************** *)
-(* Lemma ex_next_Ord states that for any successor *)
-(* ordinal there is a number of the set satisfying certain properties *)
-(* ********************************************************************** *)
-
-
-Goal "[| recfunAC16(f, fa, y, a) \\<subseteq> {X \\<in> Pow(A) . X eqpoll succ(k #+ m)}; \
-\ Card(a); ~ Finite(a); A eqpoll a; \
-\ k \\<in> nat; m \\<in> nat; y<a; \
-\ fa \\<in> bij(a, {Y \\<in> Pow(A). Y eqpoll succ(k)}); \
-\ f \\<in> bij(a, {Y \\<in> Pow(A). Y eqpoll succ(k #+ m)}); \
-\ ~ (\\<exists>Y \\<in> recfunAC16(f, fa, y, a). fa`y \\<subseteq> Y) |] \
-\ ==> \\<exists>c<a. fa`y \\<subseteq> f`c & \
-\ (\\<forall>b<a. fa`b \\<subseteq> f`c --> \
-\ (\\<forall>T \\<in> recfunAC16(f, fa, y, a). ~ fa`b \\<subseteq> T))";
-by (dtac ex_next_set 1 THEN REPEAT (assume_tac 1));
-by (etac bexE 1);
-by (resolve_tac [bij_converse_bij RS bij_is_fun RS apply_type RS ltI RSN
- (2, oexI)] 1);
-by (resolve_tac [right_inverse_bij RS ssubst] 1
- THEN REPEAT (ares_tac [Card_is_Ord] 1));
-qed "ex_next_Ord";
-
-
-Goal "[| \\<exists>! Y. Y \\<in> Z & P(Y); ~P(W) |] ==> \\<exists>! Y. Y \\<in> (Z Un {W}) & P(Y)";
-by (Fast_tac 1);
-qed "ex1_in_Un_sing";
-
-(* ********************************************************************** *)
-(* Lemma simplifying assumptions *)
-(* ********************************************************************** *)
-
-
-Goal "[| \\<forall>x<a. x<j | (\\<exists>xa \\<in> F(j). P(x, xa)) \
-\ --> (\\<exists>! Y. Y \\<in> F(j) & P(x, Y)); F(j) \\<subseteq> X; \
-\ L \\<in> X; P(j, L) & (\\<forall>x<a. P(x, L) --> (\\<forall>xa \\<in> F(j). ~P(x, xa))) |] \
-\ ==> F(j) Un {L} \\<subseteq> X & \
-\ (\\<forall>x<a. x le j | (\\<exists>xa \\<in> (F(j) Un {L}). P(x, xa)) --> \
-\ (\\<exists>! Y. Y \\<in> (F(j) Un {L}) & P(x, Y)))";
-by (rtac conjI 1);
-by (fast_tac (claset() addSIs [singleton_subsetI]) 1);
-by (rtac oallI 1);
-by (etac oallE 1 THEN (contr_tac 2));
-by (blast_tac (claset() addSEs [leE]) 1);
-val lemma8 = result();
-
-(* ********************************************************************** *)
-(* The main part of the proof: inductive proof of the property of T_gamma *)
-(* lemma main_induct *)
-(* ********************************************************************** *)
-
-
-Goal "[| b < a; f \\<in> bij(a, {Y \\<in> Pow(A) . Y eqpoll succ(k #+ m)}); \
-\ fa \\<in> bij(a, {Y \\<in> Pow(A) . Y eqpoll succ(k)}); \
-\ ~Finite(a); Card(a); A eqpoll a; k \\<in> nat; m \\<in> nat |] \
-\ ==> recfunAC16(f, fa, b, a) \\<subseteq> {X \\<in> Pow(A) . X eqpoll succ(k #+ m)} & \
-\ (\\<forall>x<a. x < b | (\\<exists>Y \\<in> recfunAC16(f, fa, b, a). fa ` x \\<subseteq> Y) --> \
-\ (\\<exists>! Y. Y \\<in> recfunAC16(f, fa, b, a) & fa ` x \\<subseteq> Y))";
-by (etac lt_induct 1);
-by (ftac lt_Ord 1);
-by (etac Ord_cases 1);
-(* case 0 *)
-by (asm_simp_tac (simpset() addsimps [recfunAC16_0]) 1);
-(* case Limit *)
-by (asm_simp_tac (simpset() addsimps [recfunAC16_Limit]) 2);
-by (rtac lemma5 2 THEN (REPEAT (assume_tac 2)));
-by (fast_tac (FOL_cs addSEs [recfunAC16_mono]) 2);
-(* case succ *)
-by (hyp_subst_tac 1);
-by (eresolve_tac [lemma6 RS conjE] 1 THEN (assume_tac 1));
-by (asm_simp_tac (simpset() delsplits [split_if]
- addsimps [recfunAC16_succ]) 1);
-by (resolve_tac [conjI RS (split_if RS iffD2)] 1);
-by (Asm_simp_tac 1);
-by (etac lemma7 1 THEN assume_tac 1);
-by (rtac impI 1);
-by (resolve_tac [ex_next_Ord RS oexE] 1
- THEN REPEAT (ares_tac [le_refl RS lt_trans] 1));
-by (etac lemma8 1 THEN (assume_tac 1));
-by (resolve_tac [bij_is_fun RS apply_type] 1 THEN (assume_tac 1));
-by (eresolve_tac [Least_le RS lt_trans2 RS ltD] 1
- THEN REPEAT (ares_tac [lt_Ord, succ_leI] 1));
-by (rtac (lt_Ord RSN (2, LeastI)) 1 THEN REPEAT (assume_tac 1));
-qed "main_induct";
-
-(* ********************************************************************** *)
-(* Lemma to simplify the inductive proof *)
-(* - the desired property is a consequence of the inductive assumption *)
-(* ********************************************************************** *)
-
-val [prem1, prem2, prem3, prem4] = goal thy
- "[| (!!b. b<a ==> F(b) \\<subseteq> S & (\\<forall>x<a. (x<b | (\\<exists>Y \\<in> F(b). f`x \\<subseteq> Y)) \
-\ --> (\\<exists>! Y. Y \\<in> F(b) & f`x \\<subseteq> Y))); \
-\ f \\<in> a->f``(a); Limit(a); (!!i j. i le j ==> F(i) \\<subseteq> F(j)) |] \
-\ ==> (\\<Union>j<a. F(j)) \\<subseteq> S & \
-\ (\\<forall>x \\<in> f``a. \\<exists>! Y. Y \\<in> (\\<Union>j<a. F(j)) & x \\<subseteq> Y)";
-by (rtac conjI 1);
-by (rtac subsetI 1);
-by (etac OUN_E 1);
-by (dtac prem1 1);
-by (Fast_tac 1);
-(** LEVEL 5 **)
-by (rtac ballI 1);
-by (etac imageE 1);
-by (dresolve_tac [prem3 RS Limit_is_Ord RSN (2, ltI) RS
- (prem3 RS Limit_has_succ)] 1);
-by (ftac prem1 1);
-by (etac conjE 1);
-(** LEVEL 10 **)
-by (dresolve_tac [leI RS succ_leE RSN (2, ospec)] 1 THEN (assume_tac 1));
-by (etac impE 1);
-by (fast_tac (claset() addSEs [leI RS succ_leE RS lt_Ord RS le_refl]) 1);
-by (dresolve_tac [prem2 RSN (2, apply_equality)] 1);
-by (REPEAT (eresolve_tac [conjE, ex1E] 1));
-(** LEVEL 15 **)
-by (rtac ex1I 1);
-by (fast_tac (claset() addSIs [OUN_I]) 1);
-by (REPEAT (eresolve_tac [conjE, OUN_E] 1));
-by (eresolve_tac [lt_Ord RSN (2, lt_Ord RS Ord_linear_le)] 1
- THEN assume_tac 1);
-by (dresolve_tac [prem4 RS subsetD] 2 THEN (assume_tac 2));
-(** LEVEL 20 **)
-by (fast_tac FOL_cs 2);
-by (ftac prem1 1);
-by (ftac succ_leE 1);
-by (dresolve_tac [prem4 RS subsetD] 1 THEN (assume_tac 1));
-by (etac conjE 1);
-(** LEVEL 25 **)
-by (dresolve_tac [lt_trans RSN (2, ospec)] 1 THEN (TRYALL assume_tac));
-by (dresolve_tac [disjI1 RSN (2, mp)] 1 THEN (assume_tac 1));
-by (etac ex1_two_eq 1);
-by (REPEAT (Fast_tac 1));
-qed "lemma_simp_induct";
-
-(* ********************************************************************** *)
-(* The target theorem *)
-(* ********************************************************************** *)
-
-
-Goalw [AC16_def] "[| WO2; 0<m; k \\<in> nat; m \\<in> nat |] ==> AC16(k #+ m,k)";
-by (rtac allI 1);
-by (rtac impI 1);
-by (ftac WO2_infinite_subsets_eqpoll_X 1
- THEN (REPEAT (assume_tac 1)));
-by (forw_inst_tac [("n","k #+ m")] (WO2_infinite_subsets_eqpoll_X) 1
- THEN (REPEAT (ares_tac [add_type] 1)));
-by (ftac WO2_imp_ex_Card 1);
-by (REPEAT (eresolve_tac [exE,conjE] 1));
-by (dresolve_tac [eqpoll_trans RS eqpoll_sym RS (eqpoll_def RS
- def_imp_iff RS iffD1)] 1 THEN (assume_tac 1));
-by (dresolve_tac [eqpoll_trans RS eqpoll_sym RS (eqpoll_def RS
- def_imp_iff RS iffD1)] 1 THEN (assume_tac 1));
-by (REPEAT (etac exE 1));
-by (res_inst_tac [("x","\\<Union>j<a. recfunAC16(fa,f,j,a)")] exI 1);
-by (res_inst_tac [("P","%z. ?Y & (\\<forall>x \\<in> z. ?Z(x))")]
- (bij_is_surj RS surj_image_eq RS subst) 1
- THEN (assume_tac 1));
-by (rtac lemma_simp_induct 1);
-by (eresolve_tac [bij_is_fun RS surj_image RS surj_is_fun] 2);
-by (eresolve_tac [eqpoll_imp_lepoll RS lepoll_infinite RS
- infinite_Card_is_InfCard RS InfCard_is_Limit] 2
- THEN REPEAT (assume_tac 2));
-by (etac recfunAC16_mono 2);
-by (rtac main_induct 1
- THEN REPEAT (ares_tac [eqpoll_imp_lepoll RS lepoll_infinite] 1));
-qed "WO2_AC16";
--- a/src/ZF/AC/WO2_AC16.thy Wed Jan 16 15:04:37 2002 +0100
+++ b/src/ZF/AC/WO2_AC16.thy Wed Jan 16 17:52:06 2002 +0100
@@ -1,3 +1,588 @@
-(*Dummy theory to document dependencies *)
+(* Title: ZF/AC/WO2_AC16.thy
+ ID: $Id$
+ Author: Krzysztof Grabczewski
+
+ The proof of WO2 ==> AC16(k #+ m, k)
+
+ The main part of the proof is the inductive reasoning concerning
+ properties of constructed family T_gamma.
+ The proof deals with three cases for ordinals: 0, succ and limit ordinal.
+ The first instance is trivial, the third not difficult, but the second
+ is very complicated requiring many lemmas.
+ We also need to prove that at any stage gamma the set
+ (s - Union(...) - k_gamma) (Rubin & Rubin page 15)
+ contains m distinct elements (in fact is equipollent to s)
+*)
+
+theory WO2_AC16 = AC_Equiv + AC16_lemmas + Cardinal_aux:
+
+(**** A recursive definition used in the proof of WO2 ==> AC16 ****)
+
+constdefs
+ recfunAC16 :: "[i,i,i,i] => i"
+ "recfunAC16(f,h,i,a) ==
+ transrec2(i, 0,
+ %g r. if (\<exists>y \<in> r. h`g \<subseteq> y) then r
+ else r Un {f`(LEAST i. h`g \<subseteq> f`i &
+ (\<forall>b<a. (h`b \<subseteq> f`i --> (\<forall>t \<in> r. ~ h`b \<subseteq> t))))})"
+
+(* ********************************************************************** *)
+(* Basic properties of recfunAC16 *)
+(* ********************************************************************** *)
+
+lemma recfunAC16_0: "recfunAC16(f,h,0,a) = 0"
+apply (simp add: recfunAC16_def);
+done
+
+lemma recfunAC16_succ:
+ "recfunAC16(f,h,succ(i),a) =
+ (if (\<exists>y \<in> recfunAC16(f,h,i,a). h ` i \<subseteq> y) then recfunAC16(f,h,i,a)
+ else recfunAC16(f,h,i,a) Un
+ {f ` (LEAST j. h ` i \<subseteq> f ` j &
+ (\<forall>b<a. (h`b \<subseteq> f`j
+ --> (\<forall>t \<in> recfunAC16(f,h,i,a). ~ h`b \<subseteq> t))))})"
+apply (simp add: recfunAC16_def);
+done
+
+lemma recfunAC16_Limit: "Limit(i)
+ ==> recfunAC16(f,h,i,a) = (\<Union>j<i. recfunAC16(f,h,j,a))"
+by (simp add: recfunAC16_def transrec2_Limit);
+
+(* ********************************************************************** *)
+(* Monotonicity of transrec2 *)
+(* ********************************************************************** *)
+
+lemma transrec2_mono_lemma [rule_format]:
+ "[| !!g r. r \<subseteq> B(g,r); Ord(i) |]
+ ==> j<i --> transrec2(j, 0, B) \<subseteq> transrec2(i, 0, B)"
+apply (erule trans_induct);
+apply (rule Ord_cases , assumption+);
+apply fast
+apply (simp (no_asm_simp))
+apply (blast elim!: leE);
+apply (simp add: transrec2_Limit);
+apply (blast intro: OUN_I ltI Ord_in_Ord [THEN le_refl]
+ elim!: Limit_has_succ [THEN ltE])
+done
+
+lemma transrec2_mono:
+ "[| !!g r. r \<subseteq> B(g,r); j\<le>i |]
+ ==> transrec2(j, 0, B) \<subseteq> transrec2(i, 0, B)"
+apply (erule leE);
+apply (rule transrec2_mono_lemma)
+apply (auto intro: lt_Ord2 );
+done
+
+(* ********************************************************************** *)
+(* Monotonicity of recfunAC16 *)
+(* ********************************************************************** *)
+
+lemma recfunAC16_mono:
+ "i\<le>j ==> recfunAC16(f, g, i, a) \<subseteq> recfunAC16(f, g, j, a)"
+apply (unfold recfunAC16_def)
+apply (rule transrec2_mono)
+apply (auto );
+done
+
+(* ********************************************************************** *)
+(* case of limit ordinal *)
+(* ********************************************************************** *)
+
+
+lemma lemma3_1:
+ "[| \<forall>y<x. \<forall>z<a. z<y | (\<exists>Y \<in> F(y). f(z)<=Y) --> (\<exists>! Y. Y \<in> F(y) & f(z)<=Y);
+ \<forall>i j. i\<le>j --> F(i) \<subseteq> F(j); j\<le>i; i<x; z<a;
+ V \<in> F(i); f(z)<=V; W \<in> F(j); f(z)<=W |]
+ ==> V = W"
+apply (erule asm_rl allE impE)+
+apply (drule subsetD, assumption)
+apply blast
+done
+
+
+lemma lemma3:
+ "[| \<forall>y<x. \<forall>z<a. z<y | (\<exists>Y \<in> F(y). f(z)<=Y) --> (\<exists>! Y. Y \<in> F(y) & f(z)<=Y);
+ \<forall>i j. i\<le>j --> F(i) \<subseteq> F(j); i<x; j<x; z<a;
+ V \<in> F(i); f(z)<=V; W \<in> F(j); f(z)<=W |]
+ ==> V = W"
+apply (rule_tac j=j in Ord_linear_le [OF lt_Ord lt_Ord], assumption+)
+apply (erule lemma3_1 [symmetric], assumption+)
+apply (erule lemma3_1, assumption+)
+done
+
+lemma lemma4:
+ "[| \<forall>y<x. F(y) \<subseteq> X &
+ (\<forall>x<a. x < y | (\<exists>Y \<in> F(y). h(x) \<subseteq> Y) -->
+ (\<exists>! Y. Y \<in> F(y) & h(x) \<subseteq> Y));
+ x < a |]
+ ==> \<forall>y<x. \<forall>z<a. z < y | (\<exists>Y \<in> F(y). h(z) \<subseteq> Y) -->
+ (\<exists>! Y. Y \<in> F(y) & h(z) \<subseteq> Y)"
+apply (intro oallI impI)
+apply (drule ospec, assumption)
+apply clarify
+apply (blast elim!: oallE )
+done
+
+lemma lemma5:
+ "[| \<forall>y<x. F(y) \<subseteq> X &
+ (\<forall>x<a. x < y | (\<exists>Y \<in> F(y). h(x) \<subseteq> Y) -->
+ (\<exists>! Y. Y \<in> F(y) & h(x) \<subseteq> Y));
+ x < a; Limit(x); \<forall>i j. i\<le>j --> F(i) \<subseteq> F(j) |]
+ ==> (\<Union>x<x. F(x)) \<subseteq> X &
+ (\<forall>xa<a. xa < x | (\<exists>x \<in> \<Union>x<x. F(x). h(xa) \<subseteq> x)
+ --> (\<exists>! Y. Y \<in> (\<Union>x<x. F(x)) & h(xa) \<subseteq> Y))"
+apply (rule conjI)
+apply (rule subsetI)
+apply (erule OUN_E)
+apply (drule ospec, assumption)
+apply fast
+apply (drule lemma4, assumption)
+apply (rule oallI)
+apply (rule impI)
+apply (erule disjE)
+apply (frule ospec, erule Limit_has_succ, assumption)
+apply (drule_tac A = "a" and x = "xa" in ospec, assumption)
+apply (erule impE, rule le_refl [THEN disjI1], erule lt_Ord)
+apply (blast intro: lemma3 Limit_has_succ)
+apply (blast intro: lemma3)
+done
+
+(* ********************************************************************** *)
+(* case of successor ordinal *)
+(* ********************************************************************** *)
+
+(*
+ First quite complicated proof of the fact used in the recursive construction
+ of the family T_gamma (WO2 ==> AC16(k #+ m, k)) - the fact that at any stage
+ gamma the set (s - Union(...) - k_gamma) is equipollent to s
+ (Rubin & Rubin page 15).
+*)
+
+(* ********************************************************************** *)
+(* dbl_Diff_eqpoll_Card *)
+(* ********************************************************************** *)
+
+
+lemma dbl_Diff_eqpoll_Card:
+ "[| A\<approx>a; Card(a); ~Finite(a); B\<prec>a; C\<prec>a |] ==> A - B - C\<approx>a"
+by (blast intro: Diff_lesspoll_eqpoll_Card)
+
+(* ********************************************************************** *)
+(* Case of finite ordinals *)
+(* ********************************************************************** *)
+
+
+lemma Finite_lesspoll_infinite_Ord:
+ "[| Finite(X); ~Finite(a); Ord(a) |] ==> X\<prec>a"
+apply (unfold lesspoll_def)
+apply (rule conjI)
+apply (drule nat_le_infinite_Ord [THEN le_imp_lepoll], assumption)
+apply (unfold Finite_def)
+apply (blast intro: leI [THEN le_imp_subset, THEN subset_imp_lepoll]
+ ltI eqpoll_imp_lepoll lepoll_trans)
+apply (blast intro: eqpoll_sym [THEN eqpoll_trans])
+done
+
+lemma Union_lesspoll:
+ "[| \<forall>x \<in> X. x lepoll n & x \<subseteq> T; well_ord(T, R); X lepoll b;
+ b<a; ~Finite(a); Card(a); n \<in> nat |]
+ ==> Union(X)\<prec>a"
+apply (case_tac "Finite (X)")
+apply (blast intro: Card_is_Ord Finite_lesspoll_infinite_Ord
+ lepoll_nat_imp_Finite Finite_Union)
+apply (drule lepoll_imp_ex_le_eqpoll)
+apply (erule lt_Ord)
+apply (elim exE conjE)
+apply (frule eqpoll_imp_lepoll [THEN lepoll_infinite], assumption)
+apply (erule eqpoll_sym [THEN eqpoll_def [THEN def_imp_iff, THEN iffD1],
+ THEN exE])
+apply (frule bij_is_surj [THEN surj_image_eq])
+apply (drule image_fun [OF bij_is_fun subset_refl])
+apply (drule sym [THEN trans], assumption)
+apply (blast intro: lt_Ord UN_lepoll lt_Card_imp_lesspoll
+ lt_trans1 lesspoll_trans1)
+done
+
+(* ********************************************************************** *)
+(* recfunAC16_lepoll_index *)
+(* ********************************************************************** *)
+
+lemma Un_sing_eq_cons: "A Un {a} = cons(a, A)"
+by fast
+
+lemma Un_lepoll_succ: "A lepoll B ==> A Un {a} lepoll succ(B)"
+apply (simp add: Un_sing_eq_cons succ_def)
+apply (blast elim!: mem_irrefl intro: cons_lepoll_cong)
+done
+
+lemma Diff_UN_succ_empty: "Ord(a) ==> F(a) - (\<Union>b<succ(a). F(b)) = 0"
+by (fast intro!: le_refl)
+
+lemma Diff_UN_succ_subset: "Ord(a) ==> F(a) Un X - (\<Union>b<succ(a). F(b)) \<subseteq> X"
+by blast
+
+lemma recfunAC16_Diff_lepoll_1:
+ "Ord(x)
+ ==> recfunAC16(f, g, x, a) - (\<Union>i<x. recfunAC16(f, g, i, a)) lepoll 1"
+apply (erule Ord_cases)
+ apply (simp add: recfunAC16_0 empty_subsetI [THEN subset_imp_lepoll])
+(*Limit case*)
+prefer 2 apply (simp add: recfunAC16_Limit Diff_cancel
+ empty_subsetI [THEN subset_imp_lepoll])
+(*succ case*)
+apply (simp add: recfunAC16_succ
+ Diff_UN_succ_empty [of _ "%j. recfunAC16(f,g,j,a)"]
+ empty_subsetI [THEN subset_imp_lepoll])
+apply (best intro: Diff_UN_succ_subset [THEN subset_imp_lepoll]
+ singleton_eqpoll_1 [THEN eqpoll_imp_lepoll] lepoll_trans)
+done
+
+lemma in_Least_Diff:
+ "[| z \<in> F(x); Ord(x) |]
+ ==> z \<in> F(LEAST i. z \<in> F(i)) - (\<Union>j<(LEAST i. z \<in> F(i)). F(j))"
+by (fast elim: less_LeastE elim!: LeastI);
+
+lemma Least_eq_imp_ex:
+ "[| (LEAST i. w \<in> F(i)) = (LEAST i. z \<in> F(i));
+ w \<in> (\<Union>i<a. F(i)); z \<in> (\<Union>i<a. F(i)) |]
+ ==> \<exists>b<a. w \<in> (F(b) - (\<Union>c<b. F(c))) & z \<in> (F(b) - (\<Union>c<b. F(c)))"
+apply (elim OUN_E)
+apply (drule in_Least_Diff, erule lt_Ord)
+apply (frule in_Least_Diff, erule lt_Ord)
+apply (rule oexI, force)
+apply (blast intro: lt_Ord Least_le [THEN lt_trans1])
+done
+
+
+lemma two_in_lepoll_1: "[| A lepoll 1; a \<in> A; b \<in> A |] ==> a=b"
+by (fast dest!: lepoll_1_is_sing)
+
+
+lemma UN_lepoll_index:
+ "[| \<forall>i<a. F(i)-(\<Union>j<i. F(j)) lepoll 1; Limit(a) |]
+ ==> (\<Union>x<a. F(x)) lepoll a"
+apply (rule lepoll_def [THEN def_imp_iff [THEN iffD2]])
+apply (rule_tac x = "\<lambda>z \<in> (\<Union>x<a. F (x)). LEAST i. z \<in> F (i) " in exI)
+apply (unfold inj_def)
+apply (rule CollectI)
+apply (rule lam_type)
+apply (erule OUN_E)
+apply (erule Least_in_Ord)
+apply (erule ltD)
+apply (erule lt_Ord2)
+apply (intro ballI)
+apply (simp (no_asm_simp))
+apply (rule impI)
+apply (drule Least_eq_imp_ex, assumption+)
+apply (fast elim!: two_in_lepoll_1)
+done
+
+
+lemma recfunAC16_lepoll_index: "Ord(y) ==> recfunAC16(f, h, y, a) lepoll y"
+apply (erule trans_induct3)
+(*0 case*)
+apply (simp (no_asm_simp) add: recfunAC16_0 lepoll_refl)
+(*succ case*)
+apply (simp (no_asm_simp) add: recfunAC16_succ)
+apply (blast dest!: succI1 [THEN rev_bspec]
+ intro: subset_succI [THEN subset_imp_lepoll] Un_lepoll_succ
+ lepoll_trans)
+apply (simp (no_asm_simp) add: recfunAC16_Limit)
+apply (blast intro: lt_Ord [THEN recfunAC16_Diff_lepoll_1] UN_lepoll_index)
+done
+
-WO2_AC16 = AC_Equiv + recfunAC16 + AC16_lemmas + Cardinal_aux
+lemma Union_recfunAC16_lesspoll:
+ "[| recfunAC16(f,g,y,a) \<subseteq> {X \<in> Pow(A). X\<approx>n};
+ A\<approx>a; y<a; ~Finite(a); Card(a); n \<in> nat |]
+ ==> Union(recfunAC16(f,g,y,a))\<prec>a"
+apply (erule eqpoll_def [THEN def_imp_iff, THEN iffD1, THEN exE])
+apply (rule_tac T="A" in Union_lesspoll, simp_all)
+apply (blast intro!: eqpoll_imp_lepoll)
+apply (blast intro: bij_is_inj Card_is_Ord [THEN well_ord_Memrel]
+ well_ord_rvimage)
+apply (erule lt_Ord [THEN recfunAC16_lepoll_index])
+done
+
+lemma dbl_Diff_eqpoll:
+ "[| recfunAC16(f, h, y, a) \<subseteq> {X \<in> Pow(A) . X\<approx>succ(k #+ m)};
+ Card(a); ~ Finite(a); A\<approx>a;
+ k \<in> nat; y<a;
+ h \<in> bij(a, {Y \<in> Pow(A). Y\<approx>succ(k)}) |]
+ ==> A - Union(recfunAC16(f, h, y, a)) - h`y\<approx>a"
+apply (rule dbl_Diff_eqpoll_Card, simp_all)
+apply (simp add: Union_recfunAC16_lesspoll)
+apply (rule Finite_lesspoll_infinite_Ord)
+apply (rule Finite_def [THEN def_imp_iff, THEN iffD2])
+apply (blast dest: ltD bij_is_fun [THEN apply_type], assumption);
+apply (blast intro: Card_is_Ord)
+done;
+
+(* back to the proof *)
+
+lemmas disj_Un_eqpoll_nat_sum =
+ eqpoll_trans [THEN eqpoll_trans,
+ OF disj_Un_eqpoll_sum sum_eqpoll_cong nat_sum_eqpoll_sum,
+ standard];
+
+
+lemma Un_in_Collect: "[| x \<in> Pow(A - B - h`i); x\<approx>m;
+ h \<in> bij(a, {x \<in> Pow(A) . x\<approx>k}); i<a; k \<in> nat; m \<in> nat |]
+ ==> h ` i Un x \<in> {x \<in> Pow(A) . x\<approx>k #+ m}"
+by (blast intro: disj_Un_eqpoll_nat_sum
+ dest: ltD bij_is_fun [THEN apply_type])
+
+
+(* ********************************************************************** *)
+(* Lemmas simplifying assumptions *)
+(* ********************************************************************** *)
+
+lemma lemma6:
+ "[| \<forall>y<succ(j). F(y)<=X & (\<forall>x<a. x<y | P(x,y) --> Q(x,y)); succ(j)<a |]
+ ==> F(j)<=X & (\<forall>x<a. x<j | P(x,j) --> Q(x,j))"
+by (blast intro!: lt_Ord succI1 [THEN ltI, THEN lt_Ord, THEN le_refl]);
+
+
+lemma lemma7:
+ "[| \<forall>x<a. x<j | P(x,j) --> Q(x,j); succ(j)<a |]
+ ==> P(j,j) --> (\<forall>x<a. x\<le>j | P(x,j) --> Q(x,j))"
+by (fast elim!: leE)
+
+(* ********************************************************************** *)
+(* Lemmas needed to prove ex_next_set, which means that for any successor *)
+(* ordinal there is a set satisfying certain properties *)
+(* ********************************************************************** *)
+
+lemma ex_subset_eqpoll:
+ "[| A\<approx>a; ~ Finite(a); Ord(a); m \<in> nat |] ==> \<exists>X \<in> Pow(A). X\<approx>m"
+apply (rule lepoll_imp_eqpoll_subset [of m A, THEN exE])
+ apply (rule lepoll_trans, rule leI [THEN le_imp_lepoll])
+ apply (blast intro: lt_trans2 [OF ltI nat_le_infinite_Ord] Ord_nat)
+apply (erule eqpoll_sym [THEN eqpoll_imp_lepoll])
+apply (fast elim!: eqpoll_sym)
+done
+
+lemma subset_Un_disjoint: "[| A \<subseteq> B Un C; A Int C = 0 |] ==> A \<subseteq> B"
+by blast
+
+
+lemma Int_empty:
+ "[| X \<in> Pow(A - Union(B) -C); T \<in> B; F \<subseteq> T |] ==> F Int X = 0"
+by blast
+
+
+(* ********************************************************************** *)
+(* equipollent subset (and finite) is the whole set *)
+(* ********************************************************************** *)
+
+
+lemma subset_imp_eq_lemma:
+ "m \<in> nat ==> \<forall>A B. A \<subseteq> B & m lepoll A & B lepoll m --> A=B"
+apply (induct_tac "m")
+apply (fast dest!: lepoll_0_is_0)
+apply (intro allI impI)
+apply (elim conjE)
+apply (rule succ_lepoll_imp_not_empty [THEN not_emptyE], assumption)
+apply (frule subsetD [THEN Diff_sing_lepoll], assumption+)
+apply (frule lepoll_Diff_sing)
+apply (erule allE impE)+
+apply (rule conjI)
+prefer 2 apply fast
+apply fast
+apply (blast elim: equalityE)
+done
+
+
+lemma subset_imp_eq: "[| A \<subseteq> B; m lepoll A; B lepoll m; m \<in> nat |] ==> A=B"
+by (blast dest!: subset_imp_eq_lemma)
+
+
+lemma bij_imp_arg_eq:
+ "[| f \<in> bij(a, {Y \<in> X. Y\<approx>succ(k)}); k \<in> nat; f`b \<subseteq> f`y; b<a; y<a |]
+ ==> b=y"
+apply (drule subset_imp_eq)
+apply (erule_tac [3] nat_succI)
+apply (unfold bij_def inj_def)
+apply (blast intro: eqpoll_sym eqpoll_imp_lepoll
+ dest: ltD apply_type)+
+done
+
+
+lemma ex_next_set:
+ "[| recfunAC16(f, h, y, a) \<subseteq> {X \<in> Pow(A) . X\<approx>succ(k #+ m)};
+ Card(a); ~ Finite(a); A\<approx>a;
+ k \<in> nat; m \<in> nat; y<a;
+ h \<in> bij(a, {Y \<in> Pow(A). Y\<approx>succ(k)});
+ ~ (\<exists>Y \<in> recfunAC16(f, h, y, a). h`y \<subseteq> Y) |]
+ ==> \<exists>X \<in> {Y \<in> Pow(A). Y\<approx>succ(k #+ m)}. h`y \<subseteq> X &
+ (\<forall>b<a. h`b \<subseteq> X -->
+ (\<forall>T \<in> recfunAC16(f, h, y, a). ~ h`b \<subseteq> T))"
+apply (erule_tac m1=m in dbl_Diff_eqpoll [THEN ex_subset_eqpoll, THEN bexE],
+ assumption+)
+apply (erule Card_is_Ord, assumption)
+apply (frule Un_in_Collect, (erule asm_rl nat_succI)+)
+apply (erule CollectE)
+apply (rule rev_bexI, simp)
+apply (rule conjI, blast)
+apply (intro ballI impI oallI notI)
+apply (drule subset_Un_disjoint, rule Int_empty, assumption+)
+apply (blast dest: bij_imp_arg_eq)
+done
+
+(* ********************************************************************** *)
+(* Lemma ex_next_Ord states that for any successor *)
+(* ordinal there is a number of the set satisfying certain properties *)
+(* ********************************************************************** *)
+
+lemma ex_next_Ord:
+ "[| recfunAC16(f, h, y, a) \<subseteq> {X \<in> Pow(A) . X\<approx>succ(k #+ m)};
+ Card(a); ~ Finite(a); A\<approx>a;
+ k \<in> nat; m \<in> nat; y<a;
+ h \<in> bij(a, {Y \<in> Pow(A). Y\<approx>succ(k)});
+ f \<in> bij(a, {Y \<in> Pow(A). Y\<approx>succ(k #+ m)});
+ ~ (\<exists>Y \<in> recfunAC16(f, h, y, a). h`y \<subseteq> Y) |]
+ ==> \<exists>c<a. h`y \<subseteq> f`c &
+ (\<forall>b<a. h`b \<subseteq> f`c -->
+ (\<forall>T \<in> recfunAC16(f, h, y, a). ~ h`b \<subseteq> T))"
+apply (drule ex_next_set, assumption+)
+apply (erule bexE)
+apply (rule oexI)
+apply (subst right_inverse_bij, blast, assumption+)
+apply (blast intro: bij_converse_bij bij_is_fun [THEN apply_type] ltI
+ Card_is_Ord)
+done
+
+
+(* ********************************************************************** *)
+(* Lemma simplifying assumptions *)
+(* ********************************************************************** *)
+
+lemma lemma8:
+ "[| \<forall>x<a. x<j | (\<exists>xa \<in> F(j). P(x, xa))
+ --> (\<exists>! Y. Y \<in> F(j) & P(x, Y)); F(j) \<subseteq> X;
+ L \<in> X; P(j, L) & (\<forall>x<a. P(x, L) --> (\<forall>xa \<in> F(j). ~P(x, xa))) |]
+ ==> F(j) Un {L} \<subseteq> X &
+ (\<forall>x<a. x\<le>j | (\<exists>xa \<in> (F(j) Un {L}). P(x, xa)) -->
+ (\<exists>! Y. Y \<in> (F(j) Un {L}) & P(x, Y)))"
+apply (rule conjI)
+apply (fast intro!: singleton_subsetI)
+apply (rule oallI)
+apply (blast elim!: leE oallE)
+done
+
+(* ********************************************************************** *)
+(* The main part of the proof: inductive proof of the property of T_gamma *)
+(* lemma main_induct *)
+(* ********************************************************************** *)
+
+lemma main_induct:
+ "[| b < a; f \<in> bij(a, {Y \<in> Pow(A) . Y\<approx>succ(k #+ m)});
+ h \<in> bij(a, {Y \<in> Pow(A) . Y\<approx>succ(k)});
+ ~Finite(a); Card(a); A\<approx>a; k \<in> nat; m \<in> nat |]
+ ==> recfunAC16(f, h, b, a) \<subseteq> {X \<in> Pow(A) . X\<approx>succ(k #+ m)} &
+ (\<forall>x<a. x < b | (\<exists>Y \<in> recfunAC16(f, h, b, a). h ` x \<subseteq> Y) -->
+ (\<exists>! Y. Y \<in> recfunAC16(f, h, b, a) & h ` x \<subseteq> Y))"
+apply (erule lt_induct)
+apply (frule lt_Ord)
+apply (erule Ord_cases)
+(* case 0 *)
+apply (simp add: recfunAC16_0)
+(* case Limit *)
+prefer 2 apply (simp add: recfunAC16_Limit)
+ apply (rule lemma5, assumption+)
+ apply (blast dest!: recfunAC16_mono)
+(* case succ *)
+apply clarify
+apply (erule lemma6 [THEN conjE], assumption)
+apply (simp (no_asm_simp) split del: split_if add: recfunAC16_succ)
+apply (rule conjI [THEN split_if [THEN iffD2]])
+ apply (simp, erule lemma7, assumption)
+apply (rule impI)
+apply (rule ex_next_Ord [THEN oexE],
+ assumption+, rule le_refl [THEN lt_trans], assumption+)
+apply (erule lemma8, assumption)
+ apply (rule bij_is_fun [THEN apply_type], assumption)
+ apply (erule Least_le [THEN lt_trans2, THEN ltD])
+ apply (erule lt_Ord)
+ apply (erule succ_leI)
+apply (erule LeastI)
+apply (erule lt_Ord)
+done
+
+(* ********************************************************************** *)
+(* Lemma to simplify the inductive proof *)
+(* - the desired property is a consequence of the inductive assumption *)
+(* ********************************************************************** *)
+
+lemma lemma_simp_induct:
+ "[| \<forall>b. b<a --> F(b) \<subseteq> S & (\<forall>x<a. (x<b | (\<exists>Y \<in> F(b). f`x \<subseteq> Y))
+ --> (\<exists>! Y. Y \<in> F(b) & f`x \<subseteq> Y));
+ f \<in> a->f``(a); Limit(a);
+ \<forall>i j. i\<le>j --> F(i) \<subseteq> F(j) |]
+ ==> (\<Union>j<a. F(j)) \<subseteq> S &
+ (\<forall>x \<in> f``a. \<exists>! Y. Y \<in> (\<Union>j<a. F(j)) & x \<subseteq> Y)"
+apply (rule conjI)
+apply (rule subsetI)
+apply (erule OUN_E, blast)
+apply (rule ballI)
+apply (erule imageE)
+apply (drule ltI, erule Limit_is_Ord)
+apply (drule Limit_has_succ, assumption)
+apply (frule_tac x1="succ(xa)" in spec [THEN mp], assumption);
+apply (erule conjE)
+apply (drule ospec)
+(** LEVEL 10 **)
+apply (erule leI [THEN succ_leE])
+apply (erule impE)
+apply (fast elim!: leI [THEN succ_leE, THEN lt_Ord, THEN le_refl])
+apply (drule apply_equality, assumption)
+apply (elim conjE ex1E)
+(** LEVEL 15 **)
+apply (rule ex1I, blast)
+apply (elim conjE OUN_E)
+apply (erule_tac i="succ(xa)" and j=aa
+ in Ord_linear_le [OF lt_Ord lt_Ord], assumption)
+prefer 2
+apply (drule spec [THEN spec, THEN mp, THEN subsetD], assumption+, blast)
+(** LEVEL 20 **)
+apply (drule_tac x1="aa" in spec [THEN mp], assumption)
+apply (frule succ_leE)
+apply (drule spec [THEN spec, THEN mp, THEN subsetD], assumption+, blast)
+done
+
+(* ********************************************************************** *)
+(* The target theorem *)
+(* ********************************************************************** *)
+
+theorem WO2_AC16: "[| WO2; 0<m; k \<in> nat; m \<in> nat |] ==> AC16(k #+ m,k)"
+apply (unfold AC16_def)
+apply (rule allI)
+apply (rule impI)
+apply (frule WO2_infinite_subsets_eqpoll_X, assumption+)
+apply (frule_tac n="k #+ m" in WO2_infinite_subsets_eqpoll_X, simp)
+apply simp
+apply (frule WO2_imp_ex_Card)
+apply (elim exE conjE)
+apply (drule eqpoll_trans [THEN eqpoll_sym,
+ THEN eqpoll_def [THEN def_imp_iff, THEN iffD1]],
+ assumption)
+apply (drule eqpoll_trans [THEN eqpoll_sym,
+ THEN eqpoll_def [THEN def_imp_iff, THEN iffD1]],
+ assumption+)
+apply (elim exE)
+apply (rename_tac h)
+apply (rule_tac x = "\<Union>j<a. recfunAC16 (h,f,j,a) " in exI)
+apply (rule_tac P="%z. ?Y & (\<forall>x \<in> z. ?Z (x))"
+ in bij_is_surj [THEN surj_image_eq, THEN subst], assumption)
+apply (rule lemma_simp_induct)
+apply (blast del: conjI notI
+ intro!: main_induct eqpoll_imp_lepoll [THEN lepoll_infinite] )
+apply (blast intro: bij_is_fun [THEN surj_image, THEN surj_is_fun])
+apply (erule eqpoll_imp_lepoll [THEN lepoll_infinite,
+ THEN infinite_Card_is_InfCard,
+ THEN InfCard_is_Limit],
+ assumption+)
+apply (blast dest!: recfunAC16_mono)
+done
+
+end
--- a/src/ZF/AC/WO6_WO1.ML Wed Jan 16 15:04:37 2002 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,538 +0,0 @@
-(* Title: ZF/AC/WO6_WO1.ML
- ID: $Id$
- Author: Krzysztof Grabczewski
-
- Proofs needed to state that formulations WO1,...,WO6 are all equivalent.
- The only hard one is WO6 ==> WO1.
-
- Every proof (except WO6 ==> WO1 and WO1 ==> WO2) are described as "clear"
- by Rubin & Rubin (page 2).
- They refer reader to a book by Gödel to see the proof WO1 ==> WO2.
- Fortunately order types made this proof also very easy.
-*)
-
-(* ********************************************************************** *)
-
-Goalw WO_defs "WO2 ==> WO3";
-by (Fast_tac 1);
-qed "WO2_WO3";
-
-(* ********************************************************************** *)
-
-Goalw (eqpoll_def::WO_defs) "WO3 ==> WO1";
-by (fast_tac (claset() addSEs [bij_is_inj RS well_ord_rvimage,
- well_ord_Memrel RS well_ord_subset]) 1);
-qed "WO3_WO1";
-
-(* ********************************************************************** *)
-
-Goalw (eqpoll_def::WO_defs) "WO1 ==> WO2";
-by (fast_tac (claset() addSIs [Ord_ordertype, ordermap_bij]) 1);
-qed "WO1_WO2";
-
-(* ********************************************************************** *)
-
-Goal "f \\<in> A->B ==> (\\<lambda>x \\<in> A. {f`x}): A -> {{b}. b \\<in> B}";
-by (fast_tac (claset() addSIs [lam_type, apply_type]) 1);
-qed "lam_sets";
-
-Goalw [surj_def] "f \\<in> surj(A,B) ==> (\\<Union>a \\<in> A. {f`a}) = B";
-by (fast_tac (claset() addSEs [apply_type]) 1);
-qed "surj_imp_eq_";
-
-Goal "[| f \\<in> surj(A,B); Ord(A) |] ==> (\\<Union>a<A. {f`a}) = B";
-by (fast_tac (claset() addSDs [surj_imp_eq_]
- addSIs [ltI] addSEs [ltE]) 1);
-qed "surj_imp_eq";
-
-Goalw WO_defs "WO1 ==> WO4(1)";
-by (rtac allI 1);
-by (eres_inst_tac [("x","A")] allE 1);
-by (etac exE 1);
-by (REPEAT (resolve_tac [exI, conjI] 1));
-by (etac Ord_ordertype 1);
-by (rtac conjI 1);
-by (eresolve_tac [ordermap_bij RS bij_converse_bij RS bij_is_fun RS
- lam_sets RS domain_of_fun] 1);
-by (asm_simp_tac (simpset() addsimps [singleton_eqpoll_1 RS eqpoll_imp_lepoll,
- Ord_ordertype RSN (2, ordermap_bij RS bij_converse_bij RS
- bij_is_surj RS surj_imp_eq)]) 1);
-qed "WO1_WO4";
-
-(* ********************************************************************** *)
-
-Goalw WO_defs "[| m le n; WO4(m) |] ==> WO4(n)";
-by (blast_tac (claset() addSDs [spec]
- addIs [le_imp_lepoll RSN (2, lepoll_trans)]) 1);
-qed "WO4_mono";
-
-(* ********************************************************************** *)
-
-Goalw WO_defs "[| m \\<in> nat; 1 le m; WO4(m) |] ==> WO5";
-by (Blast_tac 1);
-qed "WO4_WO5";
-
-(* ********************************************************************** *)
-
-Goalw WO_defs "WO5 ==> WO6";
-by (Blast_tac 1);
-qed "WO5_WO6";
-
-
-(* **********************************************************************
- The proof of "WO6 ==> WO1". Simplified by L C Paulson.
-
- From the book "Equivalents of the Axiom of Choice" by Rubin & Rubin,
- pages 2-5
-************************************************************************* *)
-
-goal OrderType.thy
- "!!i j k. [| k < i++j; Ord(i); Ord(j) |] ==> \
-\ k < i | (~ k<i & k = i ++ (k--i) & (k--i)<j)";
-by (res_inst_tac [("i","k"),("j","i")] Ord_linear2 1);
-by (dtac odiff_lt_mono2 4 THEN assume_tac 4);
-by (asm_full_simp_tac
- (simpset() addsimps [oadd_odiff_inverse, odiff_oadd_inverse]) 4);
-by (safe_tac (claset() addSEs [lt_Ord]));
-qed "lt_oadd_odiff_disj";
-
-(*The corresponding elimination rule*)
-val lt_oadd_odiff_cases = rule_by_tactic Safe_tac
- (lt_oadd_odiff_disj RS disjE);
-
-(* ********************************************************************** *)
-(* The most complicated part of the proof - lemma ii - p. 2-4 *)
-(* ********************************************************************** *)
-
-(* ********************************************************************** *)
-(* some properties of relation uu(beta, gamma, delta) - p. 2 *)
-(* ********************************************************************** *)
-
-Goalw [uu_def] "domain(uu(f,b,g,d)) \\<subseteq> f`b";
-by (Blast_tac 1);
-qed "domain_uu_subset";
-
-Goal "\\<forall>b<a. f`b lepoll m ==> \
-\ \\<forall>b<a. \\<forall>g<a. \\<forall>d<a. domain(uu(f,b,g,d)) lepoll m";
-by (fast_tac (claset() addSEs
- [domain_uu_subset RS subset_imp_lepoll RS lepoll_trans]) 1);
-qed "quant_domain_uu_lepoll_m";
-
-Goalw [uu_def] "uu(f,b,g,d) \\<subseteq> f`b * f`g";
-by (Blast_tac 1);
-qed "uu_subset1";
-
-Goalw [uu_def] "uu(f,b,g,d) \\<subseteq> f`d";
-by (Blast_tac 1);
-qed "uu_subset2";
-
-Goal "[| \\<forall>b<a. f`b lepoll m; d<a |] ==> uu(f,b,g,d) lepoll m";
-by (fast_tac (claset()
- addSEs [uu_subset2 RS subset_imp_lepoll RS lepoll_trans]) 1);
-qed "uu_lepoll_m";
-
-(* ********************************************************************** *)
-(* Two cases for lemma ii *)
-(* ********************************************************************** *)
-Goalw [lesspoll_def]
- "\\<forall>b<a. \\<forall>g<a. \\<forall>d<a. u(f,b,g,d) lepoll m \
-\ ==> (\\<forall>b<a. f`b \\<noteq> 0 --> \
-\ (\\<exists>g<a. \\<exists>d<a. u(f,b,g,d) \\<noteq> 0 & u(f,b,g,d) lesspoll m)) \
-\ | (\\<exists>b<a. f`b \\<noteq> 0 & (\\<forall>g<a. \\<forall>d<a. u(f,b,g,d) \\<noteq> 0 --> \
-\ u(f,b,g,d) eqpoll m))";
-by (Asm_simp_tac 1);
-by (blast_tac (claset() delrules [equalityI]) 1);
-qed "cases";
-
-(* ********************************************************************** *)
-(* Lemmas used in both cases *)
-(* ********************************************************************** *)
-Goal "Ord(a) ==> (\\<Union>b<a++a. C(b)) = (\\<Union>b<a. C(b) Un C(a++b))";
-by (fast_tac (claset() addSIs [equalityI] addIs [ltI]
- addSDs [lt_oadd_disj]
- addSEs [lt_oadd1, oadd_lt_mono2]) 1);
-qed "UN_oadd";
-
-
-(* ********************************************************************** *)
-(* Case 1 \\<in> lemmas *)
-(* ********************************************************************** *)
-
-Goalw [vv1_def] "vv1(f,m,b) \\<subseteq> f`b";
-by (rtac (LetI RS LetI) 1);
-by (simp_tac (simpset() addsimps [domain_uu_subset]) 1);
-qed "vv1_subset";
-
-(* ********************************************************************** *)
-(* Case 1 \\<in> Union of images is the whole "y" *)
-(* ********************************************************************** *)
-Goalw [gg1_def]
- "!! a f y. [| Ord(a); m \\<in> nat |] ==> \
-\ (\\<Union>b<a++a. gg1(f,a,m)`b) = (\\<Union>b<a. f`b)";
-by (asm_simp_tac
- (simpset() addsimps [UN_oadd, lt_oadd1,
- oadd_le_self RS le_imp_not_lt, lt_Ord,
- odiff_oadd_inverse, ltD,
- vv1_subset RS Diff_partition, ww1_def]) 1);
-qed "UN_gg1_eq";
-
-Goal "domain(gg1(f,a,m)) = a++a";
-by (simp_tac (simpset() addsimps [lam_funtype RS domain_of_fun, gg1_def]) 1);
-qed "domain_gg1";
-
-(* ********************************************************************** *)
-(* every value of defined function is less than or equipollent to m *)
-(* ********************************************************************** *)
-Goal "[| P(a, b); Ord(a); Ord(b); \
-\ Least_a = (LEAST a. \\<exists>x. Ord(x) & P(a, x)) |] \
-\ ==> P(Least_a, LEAST b. P(Least_a, b))";
-by (etac ssubst 1);
-by (res_inst_tac [("Q","%z. P(z, LEAST b. P(z, b))")] LeastI2 1);
-by (REPEAT (fast_tac (claset() addSEs [LeastI]) 1));
-qed "nested_LeastI";
-
-bind_thm ("nested_Least_instance",
- inst "P"
- "%g d. domain(uu(f,b,g,d)) \\<noteq> 0 & domain(uu(f,b,g,d)) lepoll m"
- nested_LeastI);
-
-Goalw [gg1_def]
- "!!a. [| Ord(a); m \\<in> nat; \
-\ \\<forall>b<a. f`b \\<noteq>0 --> \
-\ (\\<exists>g<a. \\<exists>d<a. domain(uu(f,b,g,d)) \\<noteq> 0 & \
-\ domain(uu(f,b,g,d)) lepoll m); \
-\ \\<forall>b<a. f`b lepoll succ(m); b<a++a \
-\ |] ==> gg1(f,a,m)`b lepoll m";
-by (Asm_simp_tac 1);
-by (safe_tac (claset() addSEs [lt_oadd_odiff_cases]));
-(*Case b<a \\<in> show vv1(f,m,b) lepoll m *)
-by (asm_simp_tac (simpset() addsimps [vv1_def, Let_def]) 1);
-by (fast_tac (claset() addIs [nested_Least_instance RS conjunct2]
- addSEs [lt_Ord]
- addSIs [empty_lepollI]) 1);
-(*Case a le b \\<in> show ww1(f,m,b--a) lepoll m *)
-by (asm_simp_tac (simpset() addsimps [ww1_def]) 1);
-by (excluded_middle_tac "f`(b--a) = 0" 1);
-by (asm_simp_tac (simpset() addsimps [empty_lepollI]) 2);
-by (rtac Diff_lepoll 1);
-by (Blast_tac 1);
-by (rtac vv1_subset 1);
-by (dtac (ospec RS mp) 1);
-by (REPEAT (eresolve_tac [asm_rl, oexE, conjE] 1));
-by (asm_simp_tac (simpset()
- addsimps [vv1_def, Let_def, lt_Ord,
- nested_Least_instance RS conjunct1]) 1);
-qed "gg1_lepoll_m";
-
-(* ********************************************************************** *)
-(* Case 2 \\<in> lemmas *)
-(* ********************************************************************** *)
-
-(* ********************************************************************** *)
-(* Case 2 \\<in> vv2_subset *)
-(* ********************************************************************** *)
-
-Goalw [uu_def] "[| b<a; g<a; f`b\\<noteq>0; f`g\\<noteq>0; \
-\ y*y \\<subseteq> y; (\\<Union>b<a. f`b)=y \
-\ |] ==> \\<exists>d<a. uu(f,b,g,d) \\<noteq> 0";
-by (fast_tac (claset() addSIs [not_emptyI]
- addSDs [SigmaI RSN (2, subsetD)]
- addSEs [not_emptyE]) 1);
-qed "ex_d_uu_not_empty";
-
-Goal "[| b<a; g<a; f`b\\<noteq>0; f`g\\<noteq>0; \
-\ y*y \\<subseteq> y; (\\<Union>b<a. f`b)=y |] \
-\ ==> uu(f,b,g,LEAST d. (uu(f,b,g,d) \\<noteq> 0)) \\<noteq> 0";
-by (dtac ex_d_uu_not_empty 1 THEN REPEAT (assume_tac 1));
-by (fast_tac (claset() addSEs [LeastI, lt_Ord]) 1);
-qed "uu_not_empty";
-
-Goal "[| r \\<subseteq> A*B; r\\<noteq>0 |] ==> domain(r)\\<noteq>0";
-by (Blast_tac 1);
-qed "not_empty_rel_imp_domain";
-
-Goal "[| b<a; g<a; f`b\\<noteq>0; f`g\\<noteq>0; \
-\ y*y \\<subseteq> y; (\\<Union>b<a. f`b)=y |] \
-\ ==> (LEAST d. uu(f,b,g,d) \\<noteq> 0) < a";
-by (eresolve_tac [ex_d_uu_not_empty RS oexE] 1
- THEN REPEAT (assume_tac 1));
-by (resolve_tac [Least_le RS lt_trans1] 1
- THEN (REPEAT (ares_tac [lt_Ord] 1)));
-qed "Least_uu_not_empty_lt_a";
-
-Goal "[| B \\<subseteq> A; a\\<notin>B |] ==> B \\<subseteq> A-{a}";
-by (Blast_tac 1);
-qed "subset_Diff_sing";
-
-(*Could this be proved more directly?*)
-Goal "[| A lepoll m; m lepoll B; B \\<subseteq> A; m \\<in> nat |] ==> A=B";
-by (etac natE 1);
-by (fast_tac (claset() addSDs [lepoll_0_is_0] addSIs [equalityI]) 1);
-by (safe_tac (claset() addSIs [equalityI]));
-by (rtac ccontr 1);
-by (etac (subset_Diff_sing RS subset_imp_lepoll
- RSN (2, Diff_sing_lepoll RSN (3, lepoll_trans RS lepoll_trans)) RS
- succ_lepoll_natE) 1
- THEN REPEAT (assume_tac 1));
-qed "supset_lepoll_imp_eq";
-
-Goal "[| \\<forall>g<a. \\<forall>d<a. domain(uu(f, b, g, d))\\<noteq>0 --> \
-\ domain(uu(f, b, g, d)) eqpoll succ(m); \
-\ \\<forall>b<a. f`b lepoll succ(m); y*y \\<subseteq> y; \
-\ (\\<Union>b<a. f`b)=y; b<a; g<a; d<a; \
-\ f`b\\<noteq>0; f`g\\<noteq>0; m \\<in> nat; s \\<in> f`b \
-\ |] ==> uu(f, b, g, LEAST d. uu(f,b,g,d)\\<noteq>0) \\<in> f`b -> f`g";
-by (dres_inst_tac [("x2","g")] (ospec RS ospec RS mp) 1);
-by (rtac ([uu_subset1, uu_not_empty] MRS not_empty_rel_imp_domain) 3);
-by (rtac Least_uu_not_empty_lt_a 2 THEN TRYALL assume_tac);
-by (resolve_tac [eqpoll_sym RS eqpoll_imp_lepoll RS
- (Least_uu_not_empty_lt_a RSN (2, uu_lepoll_m) RSN (2,
- uu_subset1 RSN (4, rel_is_fun)))] 1
- THEN TRYALL assume_tac);
-by (rtac (eqpoll_sym RS eqpoll_imp_lepoll RSN (2, supset_lepoll_imp_eq)) 1);
-by (REPEAT_FIRST assume_tac);
-by (REPEAT (fast_tac (claset() addSIs [domain_uu_subset]) 1));
-qed "uu_Least_is_fun";
-
-Goalw [vv2_def]
- "!!a. [| \\<forall>g<a. \\<forall>d<a. domain(uu(f, b, g, d))\\<noteq>0 --> \
-\ domain(uu(f, b, g, d)) eqpoll succ(m); \
-\ \\<forall>b<a. f`b lepoll succ(m); y*y \\<subseteq> y; \
-\ (\\<Union>b<a. f`b)=y; b<a; g<a; m \\<in> nat; s \\<in> f`b \
-\ |] ==> vv2(f,b,g,s) \\<subseteq> f`g";
-by (split_tac [split_if] 1);
-by Safe_tac;
-by (etac (uu_Least_is_fun RS apply_type) 1);
-by (REPEAT_SOME (fast_tac (claset() addSIs [not_emptyI, singleton_subsetI])));
-qed "vv2_subset";
-
-(* ********************************************************************** *)
-(* Case 2 \\<in> Union of images is the whole "y" *)
-(* ********************************************************************** *)
-Goalw [gg2_def]
- "!!a. [| \\<forall>g<a. \\<forall>d<a. domain(uu(f,b,g,d)) \\<noteq> 0 --> \
-\ domain(uu(f,b,g,d)) eqpoll succ(m); \
-\ \\<forall>b<a. f`b lepoll succ(m); y*y \\<subseteq> y; \
-\ (\\<Union>b<a. f`b)=y; Ord(a); m \\<in> nat; s \\<in> f`b; b<a \
-\ |] ==> (\\<Union>g<a++a. gg2(f,a,b,s) ` g) = y";
-by (dtac sym 1);
-by (asm_simp_tac
- (simpset() addsimps [UN_oadd, lt_oadd1,
- oadd_le_self RS le_imp_not_lt, lt_Ord,
- odiff_oadd_inverse, ww2_def,
- vv2_subset RS Diff_partition]) 1);
-qed "UN_gg2_eq";
-
-Goal "domain(gg2(f,a,b,s)) = a++a";
-by (simp_tac (simpset() addsimps [lam_funtype RS domain_of_fun, gg2_def]) 1);
-qed "domain_gg2";
-
-(* ********************************************************************** *)
-(* every value of defined function is less than or equipollent to m *)
-(* ********************************************************************** *)
-
-Goalw [vv2_def] "[| m \\<in> nat; m\\<noteq>0 |] ==> vv2(f,b,g,s) lepoll m";
-by (asm_simp_tac (simpset() addsimps [empty_lepollI]) 1);
-by (fast_tac (claset()
- addSDs [le_imp_subset RS subset_imp_lepoll RS lepoll_0_is_0]
- addSIs [singleton_eqpoll_1 RS eqpoll_imp_lepoll RS lepoll_trans,
- not_lt_imp_le RS le_imp_subset RS subset_imp_lepoll,
- nat_into_Ord, nat_1I]) 1);
-qed "vv2_lepoll";
-
-Goalw [ww2_def]
- "[| \\<forall>b<a. f`b lepoll succ(m); g<a; m \\<in> nat; vv2(f,b,g,d) \\<subseteq> f`g |] \
-\ ==> ww2(f,b,g,d) lepoll m";
-by (excluded_middle_tac "f`g = 0" 1);
-by (asm_simp_tac (simpset() addsimps [empty_lepollI]) 2);
-by (dtac ospec 1 THEN (assume_tac 1));
-by (rtac Diff_lepoll 1 THEN (TRYALL assume_tac));
-by (asm_simp_tac (simpset() addsimps [vv2_def, not_emptyI]) 1);
-qed "ww2_lepoll";
-
-Goalw [gg2_def]
- "!!a. [| \\<forall>g<a. \\<forall>d<a. domain(uu(f,b,g,d)) \\<noteq> 0 --> \
-\ domain(uu(f,b,g,d)) eqpoll succ(m); \
-\ \\<forall>b<a. f`b lepoll succ(m); y*y \\<subseteq> y; \
-\ (\\<Union>b<a. f`b)=y; b<a; s \\<in> f`b; m \\<in> nat; m\\<noteq> 0; g<a++a \
-\ |] ==> gg2(f,a,b,s) ` g lepoll m";
-by (Asm_simp_tac 1);
-by (safe_tac (claset() addSEs [lt_oadd_odiff_cases, lt_Ord2]));
-by (asm_simp_tac (simpset() addsimps [vv2_lepoll]) 1);
-by (asm_simp_tac (simpset() addsimps [ww2_lepoll, vv2_subset]) 1);
-qed "gg2_lepoll_m";
-
-(* ********************************************************************** *)
-(* lemma ii *)
-(* ********************************************************************** *)
-Goalw [NN_def] "[| succ(m) \\<in> NN(y); y*y \\<subseteq> y; m \\<in> nat; m\\<noteq>0 |] ==> m \\<in> NN(y)";
-by (REPEAT (eresolve_tac [CollectE, exE, conjE] 1));
-by (resolve_tac [quant_domain_uu_lepoll_m RS cases RS disjE] 1
- THEN (assume_tac 1));
-(* case 1 *)
-by (asm_full_simp_tac (simpset() addsimps [lesspoll_succ_iff]) 1);
-by (res_inst_tac [("x","a++a")] exI 1);
-by (fast_tac (claset() addSIs [Ord_oadd, domain_gg1, UN_gg1_eq,
- gg1_lepoll_m]) 1);
-(* case 2 *)
-by (REPEAT (eresolve_tac [oexE, conjE] 1));
-by (res_inst_tac [("A","f`?B")] not_emptyE 1 THEN (assume_tac 1));
-by (rtac CollectI 1);
-by (etac succ_natD 1);
-by (res_inst_tac [("x","a++a")] exI 1);
-by (res_inst_tac [("x","gg2(f,a,b,x)")] exI 1);
-(*Calling fast_tac might get rid of the res_inst_tac calls, but it
- is just too slow.*)
-by (asm_simp_tac (simpset() addsimps
- [Ord_oadd, domain_gg2, UN_gg2_eq, gg2_lepoll_m]) 1);
-qed "lemma_ii";
-
-
-(* ********************************************************************** *)
-(* lemma iv - p. 4 \\<in> *)
-(* For every set x there is a set y such that x Un (y * y) \\<subseteq> y *)
-(* ********************************************************************** *)
-
-(* the quantifier \\<forall>looks inelegant but makes the proofs shorter *)
-(* (used only in the following two lemmas) *)
-
-Goal "\\<forall>n \\<in> nat. rec(n, x, %k r. r Un r*r) \\<subseteq> \
-\ rec(succ(n), x, %k r. r Un r*r)";
-by (fast_tac (claset() addIs [rec_succ RS ssubst]) 1);
-qed "z_n_subset_z_succ_n";
-
-Goal "[| \\<forall>n \\<in> nat. f(n)<=f(succ(n)); n le m; n \\<in> nat; m \\<in> nat |] \
-\ ==> f(n)<=f(m)";
-by (eres_inst_tac [("P","n le m")] rev_mp 1);
-by (res_inst_tac [("P","%z. n le z --> f(n) \\<subseteq> f(z)")] nat_induct 1);
-by (REPEAT (fast_tac le_cs 1));
-qed "le_subsets";
-
-Goal "[| n le m; m \\<in> nat |] ==> \
-\ rec(n, x, %k r. r Un r*r) \\<subseteq> rec(m, x, %k r. r Un r*r)";
-by (resolve_tac [z_n_subset_z_succ_n RS le_subsets] 1
- THEN (TRYALL assume_tac));
-by (eresolve_tac [Ord_nat RSN (2, ltI) RSN (2, lt_trans1) RS ltD] 1
- THEN (assume_tac 1));
-qed "le_imp_rec_subset";
-
-Goal "\\<exists>y. x Un y*y \\<subseteq> y";
-by (res_inst_tac [("x","\\<Union>n \\<in> nat. rec(n, x, %k r. r Un r*r)")] exI 1);
-by Safe_tac;
-by (rtac (nat_0I RS UN_I) 1);
-by (Asm_simp_tac 1);
-by (res_inst_tac [("a","succ(n Un na)")] UN_I 1);
-by (eresolve_tac [Un_nat_type RS nat_succI] 1 THEN (assume_tac 1));
-by (fast_tac (ZF_cs addIs [le_imp_rec_subset RS subsetD]
- addSIs [Un_upper1_le, Un_upper2_le, Un_nat_type]
- addSEs [nat_into_Ord] addss (simpset())) 1);
-qed "lemma_iv";
-
-(* ********************************************************************** *)
-(* Rubin & Rubin wrote \\<in> *)
-(* "It follows from (ii) and mathematical induction that if y*y \\<subseteq> y then *)
-(* y can be well-ordered" *)
-
-(* In fact we have to prove \\<in> *)
-(* * WO6 ==> NN(y) \\<noteq> 0 *)
-(* * reverse induction which lets us infer that 1 \\<in> NN(y) *)
-(* * 1 \\<in> NN(y) ==> y can be well-ordered *)
-(* ********************************************************************** *)
-
-(* ********************************************************************** *)
-(* WO6 ==> NN(y) \\<noteq> 0 *)
-(* ********************************************************************** *)
-
-Goalw [WO6_def, NN_def] "WO6 ==> NN(y) \\<noteq> 0";
-by (fast_tac ZF_cs 1); (*SLOW if current claset is used*)
-qed "WO6_imp_NN_not_empty";
-
-(* ********************************************************************** *)
-(* 1 \\<in> NN(y) ==> y can be well-ordered *)
-(* ********************************************************************** *)
-
-Goal "[| (\\<Union>b<a. f`b)=y; x \\<in> y; \\<forall>b<a. f`b lepoll 1; Ord(a) |] \
-\ ==> \\<exists>c<a. f`c = {x}";
-by (fast_tac (claset() addSEs [lepoll_1_is_sing]) 1);
-val lemma1 = result();
-
-Goal "[| (\\<Union>b<a. f`b)=y; x \\<in> y; \\<forall>b<a. f`b lepoll 1; Ord(a) |] \
-\ ==> f` (LEAST i. f`i = {x}) = {x}";
-by (dtac lemma1 1 THEN REPEAT (assume_tac 1));
-by (fast_tac (claset() addSEs [lt_Ord] addIs [LeastI]) 1);
-val lemma2 = result();
-
-Goalw [NN_def] "1 \\<in> NN(y) ==> \\<exists>a f. Ord(a) & f \\<in> inj(y, a)";
-by (etac CollectE 1);
-by (REPEAT (eresolve_tac [exE, conjE] 1));
-by (res_inst_tac [("x","a")] exI 1);
-by (res_inst_tac [("x","\\<lambda>x \\<in> y. LEAST i. f`i = {x}")] exI 1);
-by (rtac conjI 1 THEN (assume_tac 1));
-by (res_inst_tac [("d","%i. THE x. x \\<in> f`i")] lam_injective 1);
-by (dtac lemma1 1 THEN REPEAT (assume_tac 1));
-by (fast_tac (claset() addSEs [Least_le RS lt_trans1 RS ltD, lt_Ord]) 1);
-by (resolve_tac [lemma2 RS ssubst] 1 THEN REPEAT (assume_tac 1));
-by (Blast_tac 1);
-qed "NN_imp_ex_inj";
-
-Goal "[| y*y \\<subseteq> y; 1 \\<in> NN(y) |] ==> \\<exists>r. well_ord(y, r)";
-by (dtac NN_imp_ex_inj 1);
-by (fast_tac (claset() addSEs [well_ord_Memrel RSN (2, well_ord_rvimage)]) 1);
-qed "y_well_ord";
-
-(* ********************************************************************** *)
-(* reverse induction which lets us infer that 1 \\<in> NN(y) *)
-(* ********************************************************************** *)
-
-val [prem1, prem2] = goal thy
- "[| n \\<in> nat; !!m. [| m \\<in> nat; m\\<noteq>0; P(succ(m)) |] ==> P(m) |] \
-\ ==> n\\<noteq>0 --> P(n) --> P(1)";
-by (rtac (prem1 RS nat_induct) 1);
-by (Blast_tac 1);
-by (excluded_middle_tac "x=0" 1);
-by (Blast_tac 2);
-by (fast_tac (claset() addSIs [prem2]) 1);
-qed "rev_induct_lemma";
-
-val prems =
-Goal "[| P(n); n \\<in> nat; n\\<noteq>0; \
-\ !!m. [| m \\<in> nat; m\\<noteq>0; P(succ(m)) |] ==> P(m) |] \
-\ ==> P(1)";
-by (resolve_tac [rev_induct_lemma RS impE] 1);
-by (etac impE 4 THEN (assume_tac 5));
-by (REPEAT (ares_tac prems 1));
-qed "rev_induct";
-
-Goalw [NN_def] "n \\<in> NN(y) ==> n \\<in> nat";
-by (etac CollectD1 1);
-qed "NN_into_nat";
-
-Goal "[| n \\<in> NN(y); y*y \\<subseteq> y; n\\<noteq>0 |] ==> 1 \\<in> NN(y)";
-by (rtac rev_induct 1 THEN REPEAT (ares_tac [NN_into_nat] 1));
-by (rtac lemma_ii 1 THEN REPEAT (assume_tac 1));
-val lemma3 = result();
-
-(* ********************************************************************** *)
-(* Main theorem "WO6 ==> WO1" *)
-(* ********************************************************************** *)
-
-(* another helpful lemma *)
-Goalw [NN_def] "0 \\<in> NN(y) ==> y=0";
-by (fast_tac (claset() addSIs [equalityI]
- addSDs [lepoll_0_is_0] addEs [subst]) 1);
-qed "NN_y_0";
-
-Goalw [WO1_def] "WO6 ==> WO1";
-by (rtac allI 1);
-by (excluded_middle_tac "A=0" 1);
-by (fast_tac (claset() addSIs [well_ord_Memrel, nat_0I RS nat_into_Ord]) 2);
-by (res_inst_tac [("x1","A")] (lemma_iv RS revcut_rl) 1);
-by (etac exE 1);
-by (dtac WO6_imp_NN_not_empty 1);
-by (eresolve_tac [Un_subset_iff RS iffD1 RS conjE] 1);
-by (eres_inst_tac [("A","NN(y)")] not_emptyE 1);
-by (ftac y_well_ord 1);
-by (fast_tac (claset() addEs [well_ord_subset]) 2);
-by (fast_tac (claset() addSIs [lemma3] addSDs [NN_y_0] addSEs [not_emptyE]) 1);
-qed "WO6_imp_WO1";
-
--- a/src/ZF/AC/WO6_WO1.thy Wed Jan 16 15:04:37 2002 +0100
+++ b/src/ZF/AC/WO6_WO1.thy Wed Jan 16 17:52:06 2002 +0100
@@ -2,49 +2,532 @@
ID: $Id$
Author: Krzysztof Grabczewski
-The proof of "WO6 ==> WO1".
+Proofs needed to state that formulations WO1,...,WO6 are all equivalent.
+The only hard one is WO6 ==> WO1.
-From the book "Equivalents of the Axiom of Choice" by Rubin & Rubin,
-pages 2-5
+Every proof (except WO6 ==> WO1 and WO1 ==> WO2) are described as "clear"
+by Rubin & Rubin (page 2).
+They refer reader to a book by Gödel to see the proof WO1 ==> WO2.
+Fortunately order types made this proof also very easy.
*)
-WO6_WO1 = "rel_is_fun" + AC_Equiv + Let +
+theory WO6_WO1 = Cardinal_aux:
-consts
+constdefs
(* Auxiliary definitions used in proof *)
- NN :: i => i
- uu :: [i, i, i, i] => i
- vv1, ww1, gg1 :: [i, i, i] => i
- vv2, ww2, gg2 :: [i, i, i, i] => i
+ NN :: "i => i"
+ "NN(y) == {m \<in> nat. \<exists>a. \<exists>f. Ord(a) & domain(f)=a &
+ (\<Union>b<a. f`b) = y & (\<forall>b<a. f`b \<lesssim> m)}"
+
+ uu :: "[i, i, i, i] => i"
+ "uu(f, beta, gamma, delta) == (f`beta * f`gamma) Int f`delta"
+
+ (** Definitions for case 1 **)
+ vv1 :: "[i, i, i] => i"
+ "vv1(f,m,b) ==
+ let g = LEAST g. (\<exists>d. Ord(d) & (domain(uu(f,b,g,d)) \<noteq> 0 &
+ domain(uu(f,b,g,d)) \<lesssim> m));
+ d = LEAST d. domain(uu(f,b,g,d)) \<noteq> 0 &
+ domain(uu(f,b,g,d)) \<lesssim> m
+ in if f`b \<noteq> 0 then domain(uu(f,b,g,d)) else 0"
+
+ ww1 :: "[i, i, i] => i"
+ "ww1(f,m,b) == f`b - vv1(f,m,b)"
+
+ gg1 :: "[i, i, i] => i"
+ "gg1(f,a,m) == \<lambda>b \<in> a++a. if b<a then vv1(f,m,b) else ww1(f,m,b--a)"
+
+ (** Definitions for case 2 **)
+ vv2 :: "[i, i, i, i] => i"
+ "vv2(f,b,g,s) ==
+ if f`g \<noteq> 0 then {uu(f, b, g, LEAST d. uu(f,b,g,d) \<noteq> 0)`s} else 0"
+
+ ww2 :: "[i, i, i, i] => i"
+ "ww2(f,b,g,s) == f`g - vv2(f,b,g,s)"
+
+ gg2 :: "[i, i, i, i] => i"
+ "gg2(f,a,b,s) ==
+ \<lambda>g \<in> a++a. if g<a then vv2(f,b,g,s) else ww2(f,b,g--a,s)"
+
+
+lemma WO2_WO3: "WO2 ==> WO3"
+by (unfold WO2_def WO3_def, fast)
+
+(* ********************************************************************** *)
+
+lemma WO3_WO1: "WO3 ==> WO1"
+apply (unfold eqpoll_def WO1_def WO3_def)
+apply (intro allI)
+apply (drule_tac x=A in spec)
+apply (blast intro: bij_is_inj well_ord_rvimage
+ well_ord_Memrel [THEN well_ord_subset])
+done
+
+(* ********************************************************************** *)
+
+lemma WO1_WO2: "WO1 ==> WO2"
+apply (unfold eqpoll_def WO1_def WO2_def)
+apply (blast intro!: Ord_ordertype ordermap_bij)
+done
+
+(* ********************************************************************** *)
+
+lemma lam_sets: "f \<in> A->B ==> (\<lambda>x \<in> A. {f`x}): A -> {{b}. b \<in> B}"
+by (fast intro!: lam_type apply_type)
+
+lemma surj_imp_eq_: "f \<in> surj(A,B) ==> (\<Union>a \<in> A. {f`a}) = B"
+apply (unfold surj_def)
+apply (fast elim!: apply_type)
+done
+
+lemma surj_imp_eq: "[| f \<in> surj(A,B); Ord(A) |] ==> (\<Union>a<A. {f`a}) = B"
+by (fast dest!: surj_imp_eq_ intro!: ltI elim!: ltE)
+
+lemma WO1_WO4: "WO1 ==> WO4(1)"
+apply (unfold WO1_def WO4_def)
+apply (rule allI)
+apply (erule_tac x = "A" in allE)
+apply (erule exE)
+apply (intro exI conjI)
+apply (erule Ord_ordertype)
+apply (erule ordermap_bij [THEN bij_converse_bij, THEN bij_is_fun, THEN lam_sets, THEN domain_of_fun])
+apply (simp_all add: singleton_eqpoll_1 eqpoll_imp_lepoll Ord_ordertype
+ ordermap_bij [THEN bij_converse_bij, THEN bij_is_surj, THEN surj_imp_eq])
+done
+
+(* ********************************************************************** *)
+
+lemma WO4_mono: "[| m\<le>n; WO4(m) |] ==> WO4(n)"
+apply (unfold WO4_def)
+apply (blast dest!: spec intro: lepoll_trans [OF _ le_imp_lepoll])
+done
+
+(* ********************************************************************** *)
+
+lemma WO4_WO5: "[| m \<in> nat; 1\<le>m; WO4(m) |] ==> WO5"
+by (unfold WO4_def WO5_def, blast)
+
+(* ********************************************************************** *)
+
+lemma WO5_WO6: "WO5 ==> WO6"
+by (unfold WO4_def WO5_def WO6_def, blast)
+
+
+(* **********************************************************************
+ The proof of "WO6 ==> WO1". Simplified by L C Paulson.
+
+ From the book "Equivalents of the Axiom of Choice" by Rubin & Rubin,
+ pages 2-5
+************************************************************************* *)
+
+lemma lt_oadd_odiff_disj:
+ "[| k < i++j; Ord(i); Ord(j) |]
+ ==> k < i | (~ k<i & k = i ++ (k--i) & (k--i)<j)"
+apply (rule_tac i = "k" and j = "i" in Ord_linear2)
+prefer 4
+ apply (drule odiff_lt_mono2, assumption)
+ apply (simp add: oadd_odiff_inverse odiff_oadd_inverse)
+apply (auto elim!: lt_Ord)
+done
+
+
+(* ********************************************************************** *)
+(* The most complicated part of the proof - lemma ii - p. 2-4 *)
+(* ********************************************************************** *)
+
+(* ********************************************************************** *)
+(* some properties of relation uu(beta, gamma, delta) - p. 2 *)
+(* ********************************************************************** *)
-defs
+lemma domain_uu_subset: "domain(uu(f,b,g,d)) \<subseteq> f`b"
+by (unfold uu_def, blast)
+
+lemma quant_domain_uu_lepoll_m:
+ "\<forall>b<a. f`b \<lesssim> m ==> \<forall>b<a. \<forall>g<a. \<forall>d<a. domain(uu(f,b,g,d)) \<lesssim> m"
+by (blast intro: domain_uu_subset [THEN subset_imp_lepoll] lepoll_trans)
+
+lemma uu_subset1: "uu(f,b,g,d) \<subseteq> f`b * f`g"
+by (unfold uu_def, blast)
+
+lemma uu_subset2: "uu(f,b,g,d) \<subseteq> f`d"
+by (unfold uu_def, blast)
+
+lemma uu_lepoll_m: "[| \<forall>b<a. f`b \<lesssim> m; d<a |] ==> uu(f,b,g,d) \<lesssim> m"
+by (blast intro: uu_subset2 [THEN subset_imp_lepoll] lepoll_trans)
+
+(* ********************************************************************** *)
+(* Two cases for lemma ii *)
+(* ********************************************************************** *)
+lemma cases:
+ "\<forall>b<a. \<forall>g<a. \<forall>d<a. u(f,b,g,d) \<lesssim> m
+ ==> (\<forall>b<a. f`b \<noteq> 0 -->
+ (\<exists>g<a. \<exists>d<a. u(f,b,g,d) \<noteq> 0 & u(f,b,g,d) \<prec> m))
+ | (\<exists>b<a. f`b \<noteq> 0 & (\<forall>g<a. \<forall>d<a. u(f,b,g,d) \<noteq> 0 -->
+ u(f,b,g,d) \<approx> m))"
+apply (unfold lesspoll_def)
+apply (blast del: equalityI)
+done
+
+(* ********************************************************************** *)
+(* Lemmas used in both cases *)
+(* ********************************************************************** *)
+lemma UN_oadd: "Ord(a) ==> (\<Union>b<a++a. C(b)) = (\<Union>b<a. C(b) Un C(a++b))"
+by (blast intro: ltI lt_oadd1 oadd_lt_mono2 dest!: lt_oadd_disj)
+
+
+(* ********************************************************************** *)
+(* Case 1: lemmas *)
+(* ********************************************************************** *)
+
+lemma vv1_subset: "vv1(f,m,b) \<subseteq> f`b"
+by (simp add: vv1_def Let_def domain_uu_subset)
+
+(* ********************************************************************** *)
+(* Case 1: Union of images is the whole "y" *)
+(* ********************************************************************** *)
+lemma UN_gg1_eq:
+ "[| Ord(a); m \<in> nat |] ==> (\<Union>b<a++a. gg1(f,a,m)`b) = (\<Union>b<a. f`b)"
+by (simp add: gg1_def UN_oadd lt_oadd1 oadd_le_self [THEN le_imp_not_lt]
+ lt_Ord odiff_oadd_inverse ltD vv1_subset [THEN Diff_partition]
+ ww1_def)
+
+lemma domain_gg1: "domain(gg1(f,a,m)) = a++a"
+by (simp add: lam_funtype [THEN domain_of_fun] gg1_def)
- NN_def "NN(y) == {m \\<in> nat. \\<exists>a. \\<exists>f. Ord(a) & domain(f)=a &
- (\\<Union>b<a. f`b) = y & (\\<forall>b<a. f`b lepoll m)}"
+(* ********************************************************************** *)
+(* every value of defined function is less than or equipollent to m *)
+(* ********************************************************************** *)
+lemma nested_LeastI:
+ "[| P(a, b); Ord(a); Ord(b);
+ Least_a = (LEAST a. \<exists>x. Ord(x) & P(a, x)) |]
+ ==> P(Least_a, LEAST b. P(Least_a, b))"
+apply (erule ssubst)
+apply (rule_tac Q = "%z. P (z, LEAST b. P (z, b))" in LeastI2)
+apply (fast elim!: LeastI)+
+done
+
+lemmas nested_Least_instance =
+ nested_LeastI [of "%g d. domain(uu(f,b,g,d)) \<noteq> 0 &
+ domain(uu(f,b,g,d)) \<lesssim> m",
+ standard] (*generalizes the Variables!*)
- uu_def "uu(f, beta, gamma, delta) == (f`beta * f`gamma) Int f`delta"
+lemma gg1_lepoll_m:
+ "[| Ord(a); m \<in> nat;
+ \<forall>b<a. f`b \<noteq>0 -->
+ (\<exists>g<a. \<exists>d<a. domain(uu(f,b,g,d)) \<noteq> 0 &
+ domain(uu(f,b,g,d)) \<lesssim> m);
+ \<forall>b<a. f`b \<lesssim> succ(m); b<a++a |]
+ ==> gg1(f,a,m)`b \<lesssim> m"
+apply (unfold gg1_def, simp)
+apply (safe dest!: lt_oadd_odiff_disj)
+(*Case b<a \<in> show vv1(f,m,b) \<lesssim> m *)
+apply (simp add: vv1_def Let_def)
+apply (fast intro: nested_Least_instance [THEN conjunct2]
+ elim!: lt_Ord intro!: empty_lepollI)
+(*Case a\<le>b \<in> show ww1(f,m,b--a) \<lesssim> m *)
+apply (simp add: ww1_def)
+apply (case_tac "f` (b--a) = 0", simp add: empty_lepollI)
+apply (rule Diff_lepoll, blast)
+apply (rule vv1_subset)
+apply (drule ospec [THEN mp], assumption+)
+apply (elim oexE conjE)
+apply (simp add: vv1_def Let_def lt_Ord nested_Least_instance [THEN conjunct1])
+done
+
+(* ********************************************************************** *)
+(* Case 2: lemmas *)
+(* ********************************************************************** *)
- (*Definitions for case 1*)
+(* ********************************************************************** *)
+(* Case 2: vv2_subset *)
+(* ********************************************************************** *)
+
+lemma ex_d_uu_not_empty:
+ "[| b<a; g<a; f`b\<noteq>0; f`g\<noteq>0;
+ y*y \<subseteq> y; (\<Union>b<a. f`b)=y |]
+ ==> \<exists>d<a. uu(f,b,g,d) \<noteq> 0"
+by (unfold uu_def, blast)
+
+lemma uu_not_empty:
+ "[| b<a; g<a; f`b\<noteq>0; f`g\<noteq>0; y*y \<subseteq> y; (\<Union>b<a. f`b)=y |]
+ ==> uu(f,b,g,LEAST d. (uu(f,b,g,d) \<noteq> 0)) \<noteq> 0"
+apply (drule ex_d_uu_not_empty, assumption+)
+apply (fast elim!: LeastI lt_Ord)
+done
+
+lemma not_empty_rel_imp_domain: "[| r \<subseteq> A*B; r\<noteq>0 |] ==> domain(r)\<noteq>0"
+by blast
+
+lemma Least_uu_not_empty_lt_a:
+ "[| b<a; g<a; f`b\<noteq>0; f`g\<noteq>0; y*y \<subseteq> y; (\<Union>b<a. f`b)=y |]
+ ==> (LEAST d. uu(f,b,g,d) \<noteq> 0) < a"
+apply (erule ex_d_uu_not_empty [THEN oexE], assumption+)
+apply (blast intro: Least_le [THEN lt_trans1] lt_Ord)
+done
+
+lemma subset_Diff_sing: "[| B \<subseteq> A; a\<notin>B |] ==> B \<subseteq> A-{a}"
+by blast
- vv1_def "vv1(f,m,b) ==
- let g = LEAST g. (\\<exists>d. Ord(d) & (domain(uu(f,b,g,d)) \\<noteq> 0 &
- domain(uu(f,b,g,d)) lepoll m));
- d = LEAST d. domain(uu(f,b,g,d)) \\<noteq> 0 &
- domain(uu(f,b,g,d)) lepoll m
- in if f`b \\<noteq> 0 then domain(uu(f,b,g,d)) else 0"
+(*Could this be proved more directly?*)
+lemma supset_lepoll_imp_eq:
+ "[| A \<lesssim> m; m \<lesssim> B; B \<subseteq> A; m \<in> nat |] ==> A=B"
+apply (erule natE)
+apply (fast dest!: lepoll_0_is_0 intro!: equalityI)
+apply (safe intro!: equalityI)
+apply (rule ccontr)
+apply (rule succ_lepoll_natE)
+ apply (erule lepoll_trans)
+ apply (rule lepoll_trans)
+ apply (erule subset_Diff_sing [THEN subset_imp_lepoll], assumption)
+ apply (rule Diff_sing_lepoll, assumption+)
+done
+
+lemma uu_Least_is_fun:
+ "[| \<forall>g<a. \<forall>d<a. domain(uu(f, b, g, d))\<noteq>0 -->
+ domain(uu(f, b, g, d)) \<approx> succ(m);
+ \<forall>b<a. f`b \<lesssim> succ(m); y*y \<subseteq> y;
+ (\<Union>b<a. f`b)=y; b<a; g<a; d<a;
+ f`b\<noteq>0; f`g\<noteq>0; m \<in> nat; s \<in> f`b |]
+ ==> uu(f, b, g, LEAST d. uu(f,b,g,d)\<noteq>0) \<in> f`b -> f`g"
+apply (drule_tac x2=g in ospec [THEN ospec, THEN mp])
+ apply (rule_tac [3] not_empty_rel_imp_domain [OF uu_subset1 uu_not_empty])
+ apply (rule_tac [2] Least_uu_not_empty_lt_a, assumption+)
+apply (rule rel_is_fun)
+ apply (erule eqpoll_sym [THEN eqpoll_imp_lepoll])
+ apply (erule uu_lepoll_m)
+ apply (rule Least_uu_not_empty_lt_a, assumption+)
+apply (rule uu_subset1)
+apply (rule supset_lepoll_imp_eq [OF _ eqpoll_sym [THEN eqpoll_imp_lepoll]])
+apply (fast intro!: domain_uu_subset)+
+done
+
+lemma vv2_subset:
+ "[| \<forall>g<a. \<forall>d<a. domain(uu(f, b, g, d))\<noteq>0 -->
+ domain(uu(f, b, g, d)) \<approx> succ(m);
+ \<forall>b<a. f`b \<lesssim> succ(m); y*y \<subseteq> y;
+ (\<Union>b<a. f`b)=y; b<a; g<a; m \<in> nat; s \<in> f`b |]
+ ==> vv2(f,b,g,s) \<subseteq> f`g"
+apply (simp add: vv2_def)
+apply (blast intro: uu_Least_is_fun [THEN apply_type])
+done
+
+(* ********************************************************************** *)
+(* Case 2: Union of images is the whole "y" *)
+(* ********************************************************************** *)
+lemma UN_gg2_eq:
+ "[| \<forall>g<a. \<forall>d<a. domain(uu(f,b,g,d)) \<noteq> 0 -->
+ domain(uu(f,b,g,d)) \<approx> succ(m);
+ \<forall>b<a. f`b \<lesssim> succ(m); y*y \<subseteq> y;
+ (\<Union>b<a. f`b)=y; Ord(a); m \<in> nat; s \<in> f`b; b<a |]
+ ==> (\<Union>g<a++a. gg2(f,a,b,s) ` g) = y"
+apply (unfold gg2_def)
+apply (drule sym)
+apply (simp add: UN_oadd lt_oadd1 oadd_le_self [THEN le_imp_not_lt]
+ lt_Ord odiff_oadd_inverse ww2_def
+ vv2_subset [THEN Diff_partition])
+done
+
+lemma domain_gg2: "domain(gg2(f,a,b,s)) = a++a"
+by (simp add: lam_funtype [THEN domain_of_fun] gg2_def)
+
- ww1_def "ww1(f,m,b) == f`b - vv1(f,m,b)"
+(* ********************************************************************** *)
+(* every value of defined function is less than or equipollent to m *)
+(* ********************************************************************** *)
+
+lemma vv2_lepoll: "[| m \<in> nat; m\<noteq>0 |] ==> vv2(f,b,g,s) \<lesssim> m"
+apply (unfold vv2_def)
+apply (simp add: empty_lepollI)
+apply (fast dest!: le_imp_subset [THEN subset_imp_lepoll, THEN lepoll_0_is_0]
+ intro!: singleton_eqpoll_1 [THEN eqpoll_imp_lepoll, THEN lepoll_trans]
+ not_lt_imp_le [THEN le_imp_subset, THEN subset_imp_lepoll]
+ nat_into_Ord nat_1I)
+done
+
+lemma ww2_lepoll:
+ "[| \<forall>b<a. f`b \<lesssim> succ(m); g<a; m \<in> nat; vv2(f,b,g,d) \<subseteq> f`g |]
+ ==> ww2(f,b,g,d) \<lesssim> m"
+apply (unfold ww2_def)
+apply (case_tac "f`g = 0")
+apply (simp add: empty_lepollI)
+apply (drule ospec, assumption)
+apply (rule Diff_lepoll, assumption+)
+apply (simp add: vv2_def not_emptyI)
+done
+
+lemma gg2_lepoll_m:
+ "[| \<forall>g<a. \<forall>d<a. domain(uu(f,b,g,d)) \<noteq> 0 -->
+ domain(uu(f,b,g,d)) \<approx> succ(m);
+ \<forall>b<a. f`b \<lesssim> succ(m); y*y \<subseteq> y;
+ (\<Union>b<a. f`b)=y; b<a; s \<in> f`b; m \<in> nat; m\<noteq> 0; g<a++a |]
+ ==> gg2(f,a,b,s) ` g \<lesssim> m"
+apply (unfold gg2_def, simp)
+apply (safe elim!: lt_Ord2 dest!: lt_oadd_odiff_disj)
+ apply (simp add: vv2_lepoll)
+apply (simp add: ww2_lepoll vv2_subset)
+done
+
+(* ********************************************************************** *)
+(* lemma ii *)
+(* ********************************************************************** *)
+lemma lemma_ii: "[| succ(m) \<in> NN(y); y*y \<subseteq> y; m \<in> nat; m\<noteq>0 |] ==> m \<in> NN(y)"
+apply (unfold NN_def)
+apply (elim CollectE exE conjE)
+apply (rule quant_domain_uu_lepoll_m [THEN cases, THEN disjE], assumption)
+(* case 1 *)
+apply (simp add: lesspoll_succ_iff)
+apply (rule_tac x = "a++a" in exI)
+apply (fast intro!: Ord_oadd domain_gg1 UN_gg1_eq gg1_lepoll_m)
+(* case 2 *)
+apply (elim oexE conjE)
+apply (rule_tac A = "f`?B" in not_emptyE, assumption)
+apply (rule CollectI)
+apply (erule succ_natD)
+apply (rule_tac x = "a++a" in exI)
+apply (rule_tac x = "gg2 (f,a,b,x) " in exI)
+(*Calling fast_tac might get rid of the res_inst_tac calls, but it
+ is just too slow.*)
+apply (simp add: Ord_oadd domain_gg2 UN_gg2_eq gg2_lepoll_m)
+done
+
+
+(* ********************************************************************** *)
+(* lemma iv - p. 4: *)
+(* For every set x there is a set y such that x Un (y * y) \<subseteq> y *)
+(* ********************************************************************** *)
+
+
+(* The leading \<forall>-quantifier looks odd but makes the proofs shorter
+ (used only in the following two lemmas) *)
- 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)"
-
- (*Definitions for case 2*)
+lemma z_n_subset_z_succ_n:
+ "\<forall>n \<in> nat. rec(n, x, %k r. r Un r*r) \<subseteq> rec(succ(n), x, %k r. r Un r*r)"
+by (fast intro: rec_succ [THEN ssubst])
+
+lemma le_subsets:
+ "[| \<forall>n \<in> nat. f(n)<=f(succ(n)); n\<le>m; n \<in> nat; m \<in> nat |]
+ ==> f(n)<=f(m)"
+apply (erule_tac P = "n\<le>m" in rev_mp)
+apply (rule_tac P = "%z. n\<le>z --> f (n) \<subseteq> f (z) " in nat_induct)
+apply (auto simp add: le_iff)
+done
+
+lemma le_imp_rec_subset:
+ "[| n\<le>m; m \<in> nat |]
+ ==> rec(n, x, %k r. r Un r*r) \<subseteq> rec(m, x, %k r. r Un r*r)"
+apply (rule z_n_subset_z_succ_n [THEN le_subsets])
+apply (blast intro: lt_nat_in_nat)+
+done
+
+lemma lemma_iv: "\<exists>y. x Un y*y \<subseteq> y"
+apply (rule_tac x = "\<Union>n \<in> nat. rec (n, x, %k r. r Un r*r) " in exI)
+apply safe
+apply (rule nat_0I [THEN UN_I], simp)
+apply (rule_tac a = "succ (n Un na) " in UN_I)
+apply (erule Un_nat_type [THEN nat_succI], assumption)
+apply (auto intro: le_imp_rec_subset [THEN subsetD]
+ intro!: Un_upper1_le Un_upper2_le Un_nat_type
+ elim!: nat_into_Ord)
+done
- vv2_def "vv2(f,b,g,s) ==
- if f`g \\<noteq> 0 then {uu(f, b, g, LEAST d. uu(f,b,g,d) \\<noteq> 0)`s} else 0"
+(* ********************************************************************** *)
+(* Rubin & Rubin wrote, *)
+(* "It follows from (ii) and mathematical induction that if y*y \<subseteq> y then *)
+(* y can be well-ordered" *)
+
+(* In fact we have to prove *)
+(* * WO6 ==> NN(y) \<noteq> 0 *)
+(* * reverse induction which lets us infer that 1 \<in> NN(y) *)
+(* * 1 \<in> NN(y) ==> y can be well-ordered *)
+(* ********************************************************************** *)
+
+(* ********************************************************************** *)
+(* WO6 ==> NN(y) \<noteq> 0 *)
+(* ********************************************************************** *)
+
+lemma WO6_imp_NN_not_empty: "WO6 ==> NN(y) \<noteq> 0"
+apply (unfold WO6_def NN_def, clarify)
+apply blast
+done
+
+(* ********************************************************************** *)
+(* 1 \<in> NN(y) ==> y can be well-ordered *)
+(* ********************************************************************** *)
+
+lemma lemma1:
+ "[| (\<Union>b<a. f`b)=y; x \<in> y; \<forall>b<a. f`b \<lesssim> 1; Ord(a) |] ==> \<exists>c<a. f`c = {x}"
+by (fast elim!: lepoll_1_is_sing)
+
+lemma lemma2:
+ "[| (\<Union>b<a. f`b)=y; x \<in> y; \<forall>b<a. f`b \<lesssim> 1; Ord(a) |]
+ ==> f` (LEAST i. f`i = {x}) = {x}"
+apply (drule lemma1, assumption+)
+apply (fast elim!: lt_Ord intro: LeastI)
+done
- ww2_def "ww2(f,b,g,s) == f`g - vv2(f,b,g,s)"
+lemma NN_imp_ex_inj: "1 \<in> NN(y) ==> \<exists>a f. Ord(a) & f \<in> inj(y, a)"
+apply (unfold NN_def)
+apply (elim CollectE exE conjE)
+apply (rule_tac x = "a" in exI)
+apply (rule_tac x = "\<lambda>x \<in> y. LEAST i. f`i = {x}" in exI)
+apply (rule conjI, assumption)
+apply (rule_tac d = "%i. THE x. x \<in> f`i" in lam_injective)
+apply (drule lemma1, assumption+)
+apply (fast elim!: Least_le [THEN lt_trans1, THEN ltD] lt_Ord)
+apply (rule lemma2 [THEN ssubst], assumption+, blast)
+done
+
+lemma y_well_ord: "[| y*y \<subseteq> y; 1 \<in> NN(y) |] ==> \<exists>r. well_ord(y, r)"
+apply (drule NN_imp_ex_inj)
+apply (fast elim!: well_ord_rvimage [OF _ well_ord_Memrel])
+done
+
+(* ********************************************************************** *)
+(* reverse induction which lets us infer that 1 \<in> NN(y) *)
+(* ********************************************************************** *)
+
+lemma rev_induct_lemma [rule_format]:
+ "[| n \<in> nat; !!m. [| m \<in> nat; m\<noteq>0; P(succ(m)) |] ==> P(m) |]
+ ==> n\<noteq>0 --> P(n) --> P(1)"
+by (erule nat_induct, blast+)
+
+lemma rev_induct:
+ "[| n \<in> nat; P(n); n\<noteq>0;
+ !!m. [| m \<in> nat; m\<noteq>0; P(succ(m)) |] ==> P(m) |]
+ ==> P(1)"
+by (rule rev_induct_lemma, blast+)
- gg2_def "gg2(f,a,b,s) ==
- \\<lambda>g \\<in> a++a. if g<a then vv2(f,b,g,s) else ww2(f,b,g--a,s)"
-
+lemma NN_into_nat: "n \<in> NN(y) ==> n \<in> nat"
+by (simp add: NN_def)
+
+lemma lemma3: "[| n \<in> NN(y); y*y \<subseteq> y; n\<noteq>0 |] ==> 1 \<in> NN(y)"
+apply (rule rev_induct [OF NN_into_nat], assumption+)
+apply (rule lemma_ii, assumption+)
+done
+
+(* ********************************************************************** *)
+(* Main theorem "WO6 ==> WO1" *)
+(* ********************************************************************** *)
+
+(* another helpful lemma *)
+lemma NN_y_0: "0 \<in> NN(y) ==> y=0"
+apply (unfold NN_def)
+apply (fast intro!: equalityI dest!: lepoll_0_is_0 elim: subst)
+done
+
+lemma WO6_imp_WO1: "WO6 ==> WO1"
+apply (unfold WO1_def)
+apply (rule allI)
+apply (case_tac "A=0")
+apply (fast intro!: well_ord_Memrel nat_0I [THEN nat_into_Ord])
+apply (rule_tac x1 = "A" in lemma_iv [THEN revcut_rl])
+apply (erule exE)
+apply (drule WO6_imp_NN_not_empty)
+apply (erule Un_subset_iff [THEN iffD1, THEN conjE])
+apply (erule_tac A = "NN (y) " in not_emptyE)
+apply (frule y_well_ord)
+ apply (fast intro!: lemma3 dest!: NN_y_0 elim!: not_emptyE)
+apply (fast elim: well_ord_subset)
+done
+
end
--- a/src/ZF/AC/WO_AC.ML Wed Jan 16 15:04:37 2002 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,20 +0,0 @@
-(* Title: ZF/AC/WO_AC.ML
- ID: $Id$
- Author: Krzysztof Grabczewski
-
-Lemmas used in the proofs like WO? ==> AC?
-*)
-
-Goal "[| well_ord(Union(A),r); 0\\<notin>A; B \\<in> A |] \
-\ ==> (THE b. first(b,B,r)) \\<in> B";
-by (fast_tac (claset() addSEs [well_ord_imp_ex1_first RS theI RS
- (first_def RS def_imp_iff RS iffD1 RS conjunct1)]) 1);
-qed "first_in_B";
-
-Goal "[| well_ord(Union(A), R); 0\\<notin>A |] ==> \\<exists>f. f:(\\<Pi>X \\<in> A. X)";
-by (fast_tac (claset() addSEs [first_in_B] addSIs [lam_type]) 1);
-qed "ex_choice_fun";
-
-Goal "well_ord(A, R) ==> \\<exists>f. f:(\\<Pi>X \\<in> Pow(A)-{0}. X)";
-by (fast_tac (claset() addSEs [well_ord_subset RS ex_choice_fun]) 1);
-qed "ex_choice_fun_Pow";
--- a/src/ZF/AC/WO_AC.thy Wed Jan 16 15:04:37 2002 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,3 +0,0 @@
-(*Dummy theory to document dependencies *)
-
-WO_AC = Order
--- a/src/ZF/AC/recfunAC16.ML Wed Jan 16 15:04:37 2002 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,65 +0,0 @@
-(* Title: ZF/AC/recfunAC16.ML
- ID: $Id$
- Author: Krzysztof Grabczewski
-
-Properties of the recursive definition used in the proof of WO2 ==> AC16
-*)
-
-(* ********************************************************************** *)
-(* Basic properties of recfunAC16 *)
-(* ********************************************************************** *)
-
-Goalw [recfunAC16_def] "recfunAC16(f,fa,0,a) = 0";
-by (rtac transrec2_0 1);
-qed "recfunAC16_0";
-
-Goalw [recfunAC16_def]
- "recfunAC16(f,fa,succ(i),a) = \
-\ (if (\\<exists>y \\<in> recfunAC16(f,fa,i,a). fa ` i \\<subseteq> y) then recfunAC16(f,fa,i,a) \
-\ else recfunAC16(f,fa,i,a) Un \
-\ {f ` (LEAST j. fa ` i \\<subseteq> f ` j & \
-\ (\\<forall>b<a. (fa`b \\<subseteq> f`j \
-\ --> (\\<forall>t \\<in> recfunAC16(f,fa,i,a). ~ fa`b \\<subseteq> t))))})";
-by (rtac transrec2_succ 1);
-qed "recfunAC16_succ";
-
-Goalw [recfunAC16_def] "Limit(i) \
-\ ==> recfunAC16(f,fa,i,a) = (\\<Union>j<i. recfunAC16(f,fa,j,a))";
-by (etac transrec2_Limit 1);
-qed "recfunAC16_Limit";
-
-(* ********************************************************************** *)
-(* Monotonicity of transrec2 *)
-(* ********************************************************************** *)
-
-val [prem1, prem2] = goal thy
- "[| !!g r. r \\<subseteq> B(g,r); Ord(i) |] \
-\ ==> j<i --> transrec2(j, 0, B) \\<subseteq> transrec2(i, 0, B)";
-by (resolve_tac [prem2 RS trans_induct] 1);
-by (rtac Ord_cases 1 THEN (REPEAT (assume_tac 1)));
-by (Fast_tac 1);
-by (Asm_simp_tac 1);
-by (fast_tac (FOL_cs addSIs [succI1, prem1]
- addSEs [ballE, leE, prem1 RSN (2, subset_trans)]) 1);
-by (fast_tac (claset() addIs [OUN_I, ltI]
- addSEs [Limit_has_succ RS ltE, succI1 RSN (2, Ord_in_Ord) RS le_refl,
- transrec2_Limit RS ssubst]) 1);
-qed "transrec2_mono_lemma";
-
-val [prem1, prem2] = goal thy "[| !!g r. r \\<subseteq> B(g,r); j le i |] \
-\ ==> transrec2(j, 0, B) \\<subseteq> transrec2(i, 0, B)";
-by (resolve_tac [prem2 RS leE] 1);
-by (resolve_tac [transrec2_mono_lemma RS impE] 1);
-by (TRYALL (fast_tac (claset() addSIs [prem1, prem2, lt_Ord2])));
-qed "transrec2_mono";
-
-(* ********************************************************************** *)
-(* Monotonicity of recfunAC16 *)
-(* ********************************************************************** *)
-
-Goalw [recfunAC16_def]
- "!!i. i le j ==> recfunAC16(f, g, i, a) \\<subseteq> recfunAC16(f, g, j, a)";
-by (rtac transrec2_mono 1);
-by (REPEAT (fast_tac (claset() addIs [split_if RS iffD2]) 1));
-qed "recfunAC16_mono";
-
--- a/src/ZF/AC/recfunAC16.thy Wed Jan 16 15:04:37 2002 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,19 +0,0 @@
-(* Title: ZF/AC/recfunAC16.thy
- ID: $Id$
- Author: Krzysztof Grabczewski
-
-A recursive definition used in the proof of WO2 ==> AC16
-*)
-
-recfunAC16 = Cardinal + Epsilon +
-
-constdefs
- recfunAC16 :: [i, i, i, i] => i
-
- "recfunAC16(f,fa,i,a) ==
- transrec2(i, 0,
- %g r. if(\\<exists>y \\<in> r. fa`g \\<subseteq> y, r,
- r Un {f`(LEAST i. fa`g \\<subseteq> f`i &
- (\\<forall>b<a. (fa`b \\<subseteq> f`i --> (\\<forall>t \\<in> r. ~ fa`b \\<subseteq> t))))}))"
-
-end
--- a/src/ZF/AC/rel_is_fun.ML Wed Jan 16 15:04:37 2002 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,42 +0,0 @@
-(* Title: ZF/AC/rel_is_fun.ML
- ID: $Id$
- Author: Krzysztof Grabczewski
-
-Lemmas needed to state when a finite relation is a function.
-
-The criteria are cardinalities of the relation and its domain.
-Used in WO6WO1.ML
-*)
-
-(*Using AC we could trivially prove, for all u, domain(u) lepoll u*)
-goalw Cardinal.thy [lepoll_def]
- "!!m. [| m \\<in> nat; u lepoll m |] ==> domain(u) lepoll m";
-by (etac exE 1);
-by (res_inst_tac [("x",
- "\\<lambda>x \\<in> domain(u). LEAST i. \\<exists>y. <x,y> \\<in> u & f`<x,y> = i")] exI 1);
-by (res_inst_tac [("d","%y. fst(converse(f)`y)")] lam_injective 1);
-by (fast_tac (claset() addIs [LeastI2, nat_into_Ord RS Ord_in_Ord,
- inj_is_fun RS apply_type]) 1);
-by (etac domainE 1);
-by (forward_tac [inj_is_fun RS apply_type] 1 THEN (atac 1));
-by (rtac LeastI2 1);
-by (auto_tac (claset() addSEs [nat_into_Ord RS Ord_in_Ord],
- simpset()));
-qed "lepoll_m_imp_domain_lepoll_m";
-
-goalw Cardinal.thy [function_def]
- "!!r. [| succ(m) lepoll domain(r); r lepoll succ(m); m \\<in> nat |] ==> \
-\ function(r)";
-by Safe_tac;
-by (resolve_tac [excluded_middle RS disjE] 1 THEN (atac 2));
-by (fast_tac (claset() addSEs [lepoll_trans RS succ_lepoll_natE,
- Diff_sing_lepoll RSN (2, lepoll_m_imp_domain_lepoll_m)]
- addEs [not_sym RSN (2, domain_Diff_eq) RS subst]) 1);
-qed "rel_domain_ex1";
-
-goal Cardinal.thy
- "!!r. [| succ(m) lepoll domain(r); r lepoll succ(m); m \\<in> nat; \
-\ r \\<subseteq> A*B; A=domain(r) |] ==> r \\<in> A->B";
-by (hyp_subst_tac 1);
-by (asm_simp_tac (simpset() addsimps [Pi_iff, rel_domain_ex1]) 1);
-qed "rel_is_fun";
--- a/src/ZF/AC/rel_is_fun.thy Wed Jan 16 15:04:37 2002 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,1 +0,0 @@
-rel_is_fun = Cardinal
--- a/src/ZF/CardinalArith.thy Wed Jan 16 15:04:37 2002 +0100
+++ b/src/ZF/CardinalArith.thy Wed Jan 16 17:52:06 2002 +0100
@@ -102,4 +102,60 @@
"(!!x. x:A ==> Card(K(x))) ==> Card(UN x<A. K(x))"
by (simp add: OUnion_def Card_0)
+lemma n_lesspoll_nat: "n \<in> nat ==> n \<prec> nat"
+apply (unfold lesspoll_def)
+apply (rule conjI)
+apply (erule OrdmemD [THEN subset_imp_lepoll], rule Ord_nat)
+apply (rule notI)
+apply (erule eqpollE)
+apply (rule succ_lepoll_natE)
+apply (blast intro: nat_succI [THEN OrdmemD, THEN subset_imp_lepoll]
+ lepoll_trans, assumption);
+done
+
+lemma in_Card_imp_lesspoll: "[| Card(K); b \<in> K |] ==> b \<prec> K"
+apply (unfold lesspoll_def)
+apply (simp add: Card_iff_initial)
+apply (fast intro!: le_imp_lepoll ltI leI)
+done
+
+lemma succ_lepoll_imp_not_empty: "succ(x) \<lesssim> y ==> y \<noteq> 0"
+by (fast dest!: lepoll_0_is_0)
+
+lemma eqpoll_succ_imp_not_empty: "x \<approx> succ(n) ==> x \<noteq> 0"
+by (fast elim!: eqpoll_sym [THEN eqpoll_0_is_0, THEN succ_neq_0])
+
+lemma Finite_Fin_lemma [rule_format]:
+ "n \<in> nat ==> \<forall>A. (A\<approx>n & A \<subseteq> X) --> A \<in> Fin(X)"
+apply (induct_tac "n")
+apply (rule allI)
+apply (fast intro!: Fin.emptyI dest!: eqpoll_imp_lepoll [THEN lepoll_0_is_0])
+apply (rule allI)
+apply (rule impI)
+apply (erule conjE)
+apply (rule eqpoll_succ_imp_not_empty [THEN not_emptyE], (assumption))
+apply (frule Diff_sing_eqpoll, (assumption))
+apply (erule allE)
+apply (erule impE, fast)
+apply (drule subsetD, (assumption))
+apply (drule Fin.consI, (assumption))
+apply (simp add: cons_Diff)
+done
+
+lemma Finite_Fin: "[| Finite(A); A \<subseteq> X |] ==> A \<in> Fin(X)"
+by (unfold Finite_def, blast intro: Finite_Fin_lemma)
+
+lemma lesspoll_lemma:
+ "[| ~ A \<prec> B; C \<prec> B |] ==> A - C \<noteq> 0"
+apply (unfold lesspoll_def)
+apply (fast dest!: Diff_eq_0_iff [THEN iffD1, THEN subset_imp_lepoll]
+ intro!: eqpollI elim: notE
+ elim!: eqpollE lepoll_trans)
+done
+
+lemma eqpoll_imp_Finite_iff: "A \<approx> B ==> Finite(A) <-> Finite(B)"
+apply (unfold Finite_def)
+apply (blast intro: eqpoll_trans eqpoll_sym)
+done
+
end
--- a/src/ZF/IsaMakefile Wed Jan 16 15:04:37 2002 +0100
+++ b/src/ZF/IsaMakefile Wed Jan 16 17:52:06 2002 +0100
@@ -58,16 +58,11 @@
ZF-AC: ZF $(LOG)/ZF-AC.gz
$(LOG)/ZF-AC.gz: $(OUT)/ZF \
- AC/AC15_WO6.ML AC/AC15_WO6.thy AC/AC16_WO4.ML AC/AC16_WO4.thy \
- AC/AC16_lemmas.ML AC/AC16_lemmas.thy AC/AC17_AC1.ML AC/AC17_AC1.thy \
- AC/AC18_AC19.ML AC/AC18_AC19.thy AC/AC1_WO2.ML \
- AC/AC1_WO2.thy AC/AC7_AC9.ML AC/AC_Equiv.ML \
- AC/AC_Equiv.thy AC/Cardinal_aux.ML AC/Cardinal_aux.thy AC/DC.ML \
- AC/DC.thy AC/DC_lemmas.ML AC/DC_lemmas.thy AC/HH.ML AC/HH.thy \
- AC/Hartog.ML AC/Hartog.thy AC/ROOT.ML AC/WO1_AC.ML AC/WO1_AC.thy \
- AC/WO1_WO7.ML AC/WO1_WO7.thy AC/WO2_AC16.ML \
- AC/WO2_AC16.thy AC/WO6_WO1.ML AC/WO6_WO1.thy AC/WO_AC.ML AC/WO_AC.thy \
- AC/recfunAC16.ML AC/recfunAC16.thy AC/rel_is_fun.ML AC/rel_is_fun.thy
+ AC/ROOT.ML AC/AC15_WO6.thy AC/AC16_WO4.thy \
+ AC/AC16_lemmas.thy AC/AC17_AC1.thy AC/AC18_AC19.thy AC/AC7_AC9.thy \
+ AC/AC_Equiv.thy AC/Cardinal_aux.thy \
+ AC/DC.thy AC/HH.thy AC/Hartog.thy AC/WO1_AC.thy AC/WO1_WO7.thy \
+ AC/WO2_AC16.thy AC/WO6_WO1.thy
@$(ISATOOL) usedir $(OUT)/ZF AC
--- a/src/ZF/Main.thy Wed Jan 16 15:04:37 2002 +0100
+++ b/src/ZF/Main.thy Wed Jan 16 17:52:06 2002 +0100
@@ -57,4 +57,15 @@
(Limit(K) --> f(K) = (UN j<K. f(j)))"
by (simp add: transrec2_Limit)
+(* belongs to theory CardinalArith *)
+
+lemma InfCard_square_eqpoll: "InfCard(K) \<Longrightarrow> K \<times> K \<approx> K"
+apply (rule well_ord_InfCard_square_eq);
+ apply (erule InfCard_is_Card [THEN Card_is_Ord, THEN well_ord_Memrel]);
+apply (simp add: InfCard_is_Card [THEN Card_cardinal_eq]);
+done
+
+lemma Inf_Card_is_InfCard: "[| ~Finite(i); Card(i) |] ==> InfCard(i)"
+by (simp add: InfCard_def Card_is_Ord [THEN nat_le_infinite_Ord])
+
end