Isar version of AC
authorpaulson
Wed Jan 16 17:52:06 2002 +0100 (2002-01-16)
changeset 12776249600a63ba9
parent 12775 1748c16c2df3
child 12777 70b2651af635
Isar version of AC
src/ZF/AC/AC15_WO6.ML
src/ZF/AC/AC15_WO6.thy
src/ZF/AC/AC16_WO4.ML
src/ZF/AC/AC16_WO4.thy
src/ZF/AC/AC16_lemmas.ML
src/ZF/AC/AC16_lemmas.thy
src/ZF/AC/AC17_AC1.ML
src/ZF/AC/AC17_AC1.thy
src/ZF/AC/AC18_AC19.ML
src/ZF/AC/AC18_AC19.thy
src/ZF/AC/AC1_WO2.ML
src/ZF/AC/AC1_WO2.thy
src/ZF/AC/AC7_AC9.ML
src/ZF/AC/AC_Equiv.ML
src/ZF/AC/AC_Equiv.thy
src/ZF/AC/Cardinal_aux.ML
src/ZF/AC/Cardinal_aux.thy
src/ZF/AC/DC.ML
src/ZF/AC/DC.thy
src/ZF/AC/DC_lemmas.ML
src/ZF/AC/DC_lemmas.thy
src/ZF/AC/HH.ML
src/ZF/AC/HH.thy
src/ZF/AC/Hartog.ML
src/ZF/AC/Hartog.thy
src/ZF/AC/ROOT.ML
src/ZF/AC/WO1_AC.ML
src/ZF/AC/WO1_AC.thy
src/ZF/AC/WO1_WO7.ML
src/ZF/AC/WO1_WO7.thy
src/ZF/AC/WO2_AC16.ML
src/ZF/AC/WO2_AC16.thy
src/ZF/AC/WO6_WO1.ML
src/ZF/AC/WO6_WO1.thy
src/ZF/AC/WO_AC.ML
src/ZF/AC/WO_AC.thy
src/ZF/AC/recfunAC16.ML
src/ZF/AC/recfunAC16.thy
src/ZF/AC/rel_is_fun.ML
src/ZF/AC/rel_is_fun.thy
src/ZF/CardinalArith.thy
src/ZF/IsaMakefile
src/ZF/Main.thy
     1.1 --- a/src/ZF/AC/AC15_WO6.ML	Wed Jan 16 15:04:37 2002 +0100
     1.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.3 @@ -1,292 +0,0 @@
     1.4 -(*  Title:      ZF/AC/AC15_WO6.ML
     1.5 -    ID:         $Id$
     1.6 -    Author:     Krzysztof Grabczewski
     1.7 -
     1.8 -The proofs needed to state that AC10, ..., AC15 are equivalent to the rest.
     1.9 -We need the following:
    1.10 -
    1.11 -WO1 ==> AC10(n) ==> AC11 ==> AC12 ==> AC15 ==> WO6
    1.12 -
    1.13 -In order to add the formulations AC13 and AC14 we need:
    1.14 -
    1.15 -AC10(succ(n)) ==> AC13(n) ==> AC14 ==> AC15
    1.16 -
    1.17 -or
    1.18 -
    1.19 -AC1 ==> AC13(1);  AC13(m) ==> AC13(n) ==> AC14 ==> AC15    (m le n)
    1.20 -
    1.21 -So we don't have to prove all implications of both cases.
    1.22 -Moreover we don't need to prove AC13(1) ==> AC1 and AC11 ==> AC14 as
    1.23 -Rubin & Rubin do.
    1.24 -*)
    1.25 -
    1.26 -(* ********************************************************************** *)
    1.27 -(* Lemmas used in the proofs in which the conclusion is AC13, AC14        *)
    1.28 -(* or AC15                                                                *)
    1.29 -(*  - cons_times_nat_not_Finite                                           *)
    1.30 -(*  - ex_fun_AC13_AC15                                                    *)
    1.31 -(* ********************************************************************** *)
    1.32 -
    1.33 -Goalw [lepoll_def] "A\\<noteq>0 ==> B lepoll A*B";
    1.34 -by (etac not_emptyE 1);
    1.35 -by (res_inst_tac [("x","\\<lambda>z \\<in> B. <x,z>")] exI 1);
    1.36 -by (fast_tac (claset() addSIs [snd_conv, lam_injective]) 1);
    1.37 -qed "lepoll_Sigma";
    1.38 -
    1.39 -Goal "0\\<notin>A ==> \\<forall>B \\<in> {cons(0,x*nat). x \\<in> A}. ~Finite(B)";
    1.40 -by (rtac ballI 1);
    1.41 -by (etac RepFunE 1);
    1.42 -by (hyp_subst_tac 1);
    1.43 -by (rtac notI 1);
    1.44 -by (dresolve_tac [subset_consI RS subset_imp_lepoll RS lepoll_Finite] 1);
    1.45 -by (resolve_tac [lepoll_Sigma RS lepoll_Finite RS (nat_not_Finite RS notE)] 1
    1.46 -        THEN (assume_tac 2));
    1.47 -by (Fast_tac 1);
    1.48 -qed "cons_times_nat_not_Finite";
    1.49 -
    1.50 -Goal "[| Union(C)=A; a \\<in> A |] ==> \\<exists>B \\<in> C. a \\<in> B & B \\<subseteq> A";
    1.51 -by (Fast_tac 1);
    1.52 -val lemma1 = result();
    1.53 -
    1.54 -Goalw [pairwise_disjoint_def]
    1.55 -        "[| pairwise_disjoint(A); B \\<in> A; C \\<in> A; a \\<in> B; a \\<in> C |] ==> B=C";
    1.56 -by (dtac IntI 1 THEN (assume_tac 1));
    1.57 -by (dres_inst_tac [("A","B Int C")] not_emptyI 1);
    1.58 -by (Fast_tac 1);
    1.59 -val lemma2 = result();
    1.60 -
    1.61 -Goalw [sets_of_size_between_def]
    1.62 -        "\\<forall>B \\<in> {cons(0, x*nat). x \\<in> A}. pairwise_disjoint(f`B) &  \
    1.63 -\               sets_of_size_between(f`B, 2, n) & Union(f`B)=B  \
    1.64 -\       ==> \\<forall>B \\<in> A. \\<exists>! u. u \\<in> f`cons(0, B*nat) & u \\<subseteq> cons(0, B*nat) &  \
    1.65 -\               0 \\<in> u & 2 lepoll u & u lepoll n";
    1.66 -by (rtac ballI 1);
    1.67 -by (etac ballE 1);
    1.68 -by (Fast_tac 2);
    1.69 -by (REPEAT (etac conjE 1));
    1.70 -by (dresolve_tac [consI1 RSN (2, lemma1)] 1);
    1.71 -by (etac bexE 1);
    1.72 -by (rtac ex1I 1);
    1.73 -by (Fast_tac 1);
    1.74 -by (REPEAT (etac conjE 1));
    1.75 -by (rtac lemma2 1 THEN (REPEAT (assume_tac 1)));
    1.76 -val lemma3 = result();
    1.77 -
    1.78 -Goalw [lepoll_def] "[| A lepoll i; Ord(i) |] ==> {P(a). a \\<in> A} lepoll i";
    1.79 -by (etac exE 1);
    1.80 -by (res_inst_tac
    1.81 -        [("x", "\\<lambda>x \\<in> RepFun(A, P). LEAST j. \\<exists>a \\<in> A. x=P(a) & f`a=j")] exI 1);
    1.82 -by (res_inst_tac [("d", "%y. P(converse(f)`y)")] lam_injective 1);
    1.83 -by (etac RepFunE 1);
    1.84 -by (forward_tac [inj_is_fun RS apply_type] 1 THEN (assume_tac 1));
    1.85 -by (fast_tac (claset() addIs [LeastI2]
    1.86 -                addSEs [Ord_in_Ord, inj_is_fun RS apply_type]) 1);
    1.87 -by (etac RepFunE 1);
    1.88 -by (rtac LeastI2 1);
    1.89 -by (Fast_tac 1);
    1.90 -by (fast_tac (claset() addSEs [Ord_in_Ord, inj_is_fun RS apply_type]) 1);
    1.91 -by (fast_tac (claset() addEs [sym, left_inverse RS ssubst]) 1);
    1.92 -val lemma4 = result();
    1.93 -
    1.94 -Goal "[| n \\<in> nat; B \\<in> A; u(B) \\<subseteq> cons(0, B*nat); 0 \\<in> u(B); 2 lepoll u(B);  \
    1.95 -\       u(B) lepoll succ(n) |]  \
    1.96 -\       ==> (\\<lambda>x \\<in> A. {fst(x). x \\<in> u(x)-{0}})`B \\<noteq> 0 &  \
    1.97 -\               (\\<lambda>x \\<in> A. {fst(x). x \\<in> u(x)-{0}})`B \\<subseteq> B &  \
    1.98 -\               (\\<lambda>x \\<in> A. {fst(x). x \\<in> u(x)-{0}})`B lepoll n";
    1.99 -by (Asm_simp_tac 1);
   1.100 -by (rtac conjI 1);
   1.101 -by (fast_tac (empty_cs addSDs [RepFun_eq_0_iff RS iffD1]
   1.102 -                addDs [lepoll_Diff_sing]
   1.103 -                addEs [lepoll_trans RS succ_lepoll_natE, ssubst]
   1.104 -                addSIs [notI, lepoll_refl, nat_0I]) 1);
   1.105 -by (rtac conjI 1);
   1.106 -by (fast_tac (claset() addSIs [fst_type] addSEs [consE]) 1);
   1.107 -by (fast_tac (claset() addSEs [equalityE,
   1.108 -                Diff_lepoll RS (nat_into_Ord RSN (2, lemma4))]) 1);
   1.109 -val lemma5 = result();
   1.110 -
   1.111 -Goal "[| \\<exists>f. \\<forall>B \\<in> {cons(0, x*nat). x \\<in> A}.  \
   1.112 -\               pairwise_disjoint(f`B) &  \
   1.113 -\               sets_of_size_between(f`B, 2, succ(n)) &  \
   1.114 -\               Union(f`B)=B; n \\<in> nat |]  \
   1.115 -\       ==> \\<exists>f. \\<forall>B \\<in> A. f`B \\<noteq> 0 & f`B \\<subseteq> B & f`B lepoll n";
   1.116 -by (fast_tac (empty_cs addSDs [lemma3, theI] addDs [bspec]
   1.117 -                addSEs [exE, conjE]
   1.118 -                addIs [exI, ballI, lemma5]) 1);
   1.119 -qed "ex_fun_AC13_AC15";
   1.120 -
   1.121 -(* ********************************************************************** *)
   1.122 -(* The target proofs                                                      *)
   1.123 -(* ********************************************************************** *)
   1.124 -
   1.125 -(* ********************************************************************** *)
   1.126 -(* AC10(n) ==> AC11                                                       *)
   1.127 -(* ********************************************************************** *)
   1.128 -
   1.129 -Goalw AC_defs "[| n \\<in> nat; 1 le n; AC10(n) |] ==> AC11";
   1.130 -by (rtac bexI 1 THEN (assume_tac 2));
   1.131 -by (Fast_tac 1);
   1.132 -qed "AC10_AC11";
   1.133 -
   1.134 -(* ********************************************************************** *)
   1.135 -(* AC11 ==> AC12                                                          *)
   1.136 -(* ********************************************************************** *)
   1.137 -
   1.138 -Goalw AC_defs "AC11 ==> AC12";
   1.139 -by (fast_tac (FOL_cs addSEs [bexE] addIs [bexI]) 1);
   1.140 -qed "AC11_AC12";
   1.141 -
   1.142 -(* ********************************************************************** *)
   1.143 -(* AC12 ==> AC15                                                          *)
   1.144 -(* ********************************************************************** *)
   1.145 -
   1.146 -Goalw AC_defs "AC12 ==> AC15";
   1.147 -by Safe_tac;
   1.148 -by (etac allE 1);
   1.149 -by (etac impE 1);
   1.150 -by (etac cons_times_nat_not_Finite 1);
   1.151 -by (fast_tac (claset() addSIs [ex_fun_AC13_AC15]) 1);
   1.152 -qed "AC12_AC15";
   1.153 -
   1.154 -(* ********************************************************************** *)
   1.155 -(* AC15 ==> WO6                                                           *)
   1.156 -(* ********************************************************************** *)
   1.157 -
   1.158 -Goal "Ord(x) ==> (\\<Union>a<x. F(a)) = (\\<Union>a \\<in> x. F(a))";
   1.159 -by (fast_tac (claset() addSIs [ltI] addSDs [ltD]) 1);
   1.160 -qed "OUN_eq_UN";
   1.161 -
   1.162 -val [prem] = goal thy "\\<forall>x \\<in> Pow(A)-{0}. f`x\\<noteq>0 & f`x \\<subseteq> x & f`x lepoll m ==>  \
   1.163 -\       (\\<Union>i<LEAST x. HH(f,A,x)={A}. HH(f,A,i)) = A";
   1.164 -by (simp_tac (simpset() addsimps [Ord_Least RS OUN_eq_UN]) 1);
   1.165 -by (rtac equalityI 1);
   1.166 -by (fast_tac (claset() addSDs [less_Least_subset_x]) 1);
   1.167 -by (fast_tac (claset() addSDs [prem RS bspec]
   1.168 -                addSIs [f_subsets_imp_UN_HH_eq_x RS (Diff_eq_0_iff RS iffD1)]) 1);
   1.169 -val lemma1 = result();
   1.170 -
   1.171 -val [prem] = goal thy "\\<forall>x \\<in> Pow(A)-{0}. f`x\\<noteq>0 & f`x \\<subseteq> x & f`x lepoll m ==>  \
   1.172 -\       \\<forall>x<LEAST x. HH(f,A,x)={A}. HH(f,A,x) lepoll m";
   1.173 -by (rtac oallI 1);
   1.174 -by (dresolve_tac [ltD RS less_Least_subset_x] 1);
   1.175 -by (ftac HH_subset_imp_eq 1);
   1.176 -by (etac ssubst 1);
   1.177 -by (fast_tac (claset() addIs [prem RS ballE]
   1.178 -                addSDs [HH_subset_x_imp_subset_Diff_UN RS not_emptyI2]) 1);
   1.179 -val lemma2 = result();
   1.180 -
   1.181 -Goalw [AC15_def, WO6_def] "AC15 ==> WO6";
   1.182 -by (rtac allI 1);
   1.183 -by (eres_inst_tac [("x","Pow(A)-{0}")] allE 1);
   1.184 -by (etac impE 1);
   1.185 -by (Fast_tac 1);
   1.186 -by (REPEAT (eresolve_tac [bexE,conjE,exE] 1));
   1.187 -by (rtac bexI 1 THEN (assume_tac 2));
   1.188 -by (rtac conjI 1 THEN (assume_tac 1));
   1.189 -by (res_inst_tac [("x","LEAST i. HH(f,A,i)={A}")] exI 1);
   1.190 -by (res_inst_tac [("x","\\<lambda>j \\<in> (LEAST i. HH(f,A,i)={A}). HH(f,A,j)")] exI 1);
   1.191 -by (Asm_full_simp_tac 1);
   1.192 -by (fast_tac (claset() addSIs [Ord_Least, lam_type RS domain_of_fun]
   1.193 -                addSEs [less_Least_subset_x, lemma1, lemma2]) 1);
   1.194 -qed "AC15_WO6";
   1.195 -
   1.196 -
   1.197 -(* ********************************************************************** *)
   1.198 -(* The proof needed in the first case, not in the second                  *)
   1.199 -(* ********************************************************************** *)
   1.200 -
   1.201 -(* ********************************************************************** *)
   1.202 -(* AC10(n) ==> AC13(n-1)  if 2 le n                                       *)
   1.203 -(*                                                                        *)
   1.204 -(* Because of the change to the formal definition of AC10(n) we prove     *)
   1.205 -(* the following obviously equivalent theorem \\<in>                           *)
   1.206 -(* AC10(n) implies AC13(n) for (1 le n)                                   *)
   1.207 -(* ********************************************************************** *)
   1.208 -
   1.209 -Goalw AC_defs "[| n \\<in> nat; 1 le n; AC10(n) |] ==> AC13(n)";
   1.210 -by Safe_tac;
   1.211 -by (fast_tac (empty_cs addSEs [allE, cons_times_nat_not_Finite RSN (2, impE),
   1.212 -                                ex_fun_AC13_AC15]) 1);
   1.213 -qed "AC10_AC13";
   1.214 -
   1.215 -(* ********************************************************************** *)
   1.216 -(* The proofs needed in the second case, not in the first                 *)
   1.217 -(* ********************************************************************** *)
   1.218 -
   1.219 -(* ********************************************************************** *)
   1.220 -(* AC1 ==> AC13(1)                                                        *)
   1.221 -(* ********************************************************************** *)
   1.222 -
   1.223 -Goalw AC_defs "AC1 ==> AC13(1)";
   1.224 -by (rtac allI 1);
   1.225 -by (etac allE 1);
   1.226 -by (rtac impI 1);
   1.227 -by (mp_tac 1);
   1.228 -by (etac exE 1);
   1.229 -by (res_inst_tac [("x","\\<lambda>x \\<in> A. {f`x}")] exI 1);
   1.230 -by (asm_simp_tac (simpset() addsimps
   1.231 -		  [singleton_eqpoll_1 RS eqpoll_imp_lepoll,
   1.232 -		   singletonI RS not_emptyI]) 1);
   1.233 -qed "AC1_AC13";
   1.234 -
   1.235 -(* ********************************************************************** *)
   1.236 -(* AC13(m) ==> AC13(n) for m \\<subseteq> n                                         *)
   1.237 -(* ********************************************************************** *)
   1.238 -
   1.239 -Goalw AC_defs "[| m le n; AC13(m) |] ==> AC13(n)";
   1.240 -by (dtac le_imp_lepoll 1);
   1.241 -by (fast_tac (claset() addSEs [lepoll_trans]) 1);
   1.242 -qed "AC13_mono";
   1.243 -
   1.244 -(* ********************************************************************** *)
   1.245 -(* The proofs necessary for both cases                                    *)
   1.246 -(* ********************************************************************** *)
   1.247 -
   1.248 -(* ********************************************************************** *)
   1.249 -(* AC13(n) ==> AC14  if 1 \\<subseteq> n                                            *)
   1.250 -(* ********************************************************************** *)
   1.251 -
   1.252 -Goalw AC_defs "[| n \\<in> nat; 1 le n; AC13(n) |] ==> AC14";
   1.253 -by (fast_tac (FOL_cs addIs [bexI]) 1);
   1.254 -qed "AC13_AC14";
   1.255 -
   1.256 -(* ********************************************************************** *)
   1.257 -(* AC14 ==> AC15                                                          *)
   1.258 -(* ********************************************************************** *)
   1.259 -
   1.260 -Goalw AC_defs "AC14 ==> AC15";
   1.261 -by (Fast_tac 1);
   1.262 -qed "AC14_AC15";
   1.263 -
   1.264 -(* ********************************************************************** *)
   1.265 -(* The redundant proofs; however cited by Rubin & Rubin                   *)
   1.266 -(* ********************************************************************** *)
   1.267 -
   1.268 -(* ********************************************************************** *)
   1.269 -(* AC13(1) ==> AC1                                                        *)
   1.270 -(* ********************************************************************** *)
   1.271 -
   1.272 -Goal "[| A\\<noteq>0; A lepoll 1 |] ==> \\<exists>a. A={a}";
   1.273 -by (fast_tac (claset() addSEs [not_emptyE, lepoll_1_is_sing]) 1);
   1.274 -qed "lemma_aux";
   1.275 -
   1.276 -Goal "\\<forall>B \\<in> A. f(B)\\<noteq>0 & f(B)<=B & f(B) lepoll 1  \
   1.277 -\     ==> (\\<lambda>x \\<in> A. THE y. f(x)={y}) \\<in> (\\<Pi>X \\<in> A. X)";
   1.278 -by (rtac lam_type 1);
   1.279 -by (dtac bspec 1 THEN (assume_tac 1));
   1.280 -by (REPEAT (etac conjE 1));
   1.281 -by (eresolve_tac [lemma_aux RS exE] 1 THEN (assume_tac 1));
   1.282 -by (asm_full_simp_tac (simpset() addsimps [the_element]) 1);
   1.283 -val lemma = result();
   1.284 -
   1.285 -Goalw AC_defs "AC13(1) ==> AC1";
   1.286 -by (fast_tac (claset() addSEs [lemma]) 1);
   1.287 -qed "AC13_AC1";
   1.288 -
   1.289 -(* ********************************************************************** *)
   1.290 -(* AC11 ==> AC14                                                          *)
   1.291 -(* ********************************************************************** *)
   1.292 -
   1.293 -Goalw [AC11_def, AC14_def] "AC11 ==> AC14";
   1.294 -by (fast_tac (claset() addSIs [AC10_AC13]) 1);
   1.295 -qed "AC11_AC14";
     2.1 --- a/src/ZF/AC/AC15_WO6.thy	Wed Jan 16 15:04:37 2002 +0100
     2.2 +++ b/src/ZF/AC/AC15_WO6.thy	Wed Jan 16 17:52:06 2002 +0100
     2.3 @@ -1,3 +1,290 @@
     2.4 -(*Dummy theory to document dependencies *)
     2.5 +(*  Title:      ZF/AC/AC15_WO6.thy
     2.6 +    ID:         $Id$
     2.7 +    Author:     Krzysztof Grabczewski
     2.8 +
     2.9 +The proofs needed to state that AC10, ..., AC15 are equivalent to the rest.
    2.10 +We need the following:
    2.11 +
    2.12 +WO1 ==> AC10(n) ==> AC11 ==> AC12 ==> AC15 ==> WO6
    2.13 +
    2.14 +In order to add the formulations AC13 and AC14 we need:
    2.15 +
    2.16 +AC10(succ(n)) ==> AC13(n) ==> AC14 ==> AC15
    2.17 +
    2.18 +or
    2.19 +
    2.20 +AC1 ==> AC13(1);  AC13(m) ==> AC13(n) ==> AC14 ==> AC15    (m\<le>n)
    2.21 +
    2.22 +So we don't have to prove all implications of both cases.
    2.23 +Moreover we don't need to prove AC13(1) ==> AC1 and AC11 ==> AC14 as
    2.24 +Rubin & Rubin do.
    2.25 +*)
    2.26 +
    2.27 +theory AC15_WO6 = HH + Cardinal_aux:
    2.28 +
    2.29 +
    2.30 +(* ********************************************************************** *)
    2.31 +(* Lemmas used in the proofs in which the conclusion is AC13, AC14        *)
    2.32 +(* or AC15                                                                *)
    2.33 +(*  - cons_times_nat_not_Finite                                           *)
    2.34 +(*  - ex_fun_AC13_AC15                                                    *)
    2.35 +(* ********************************************************************** *)
    2.36 +
    2.37 +lemma lepoll_Sigma: "A\<noteq>0 ==> B \<lesssim> A*B"
    2.38 +apply (unfold lepoll_def)
    2.39 +apply (erule not_emptyE)
    2.40 +apply (rule_tac x = "\<lambda>z \<in> B. <x,z>" in exI)
    2.41 +apply (fast intro!: snd_conv lam_injective)
    2.42 +done
    2.43 +
    2.44 +lemma cons_times_nat_not_Finite:
    2.45 +     "0\<notin>A ==> \<forall>B \<in> {cons(0,x*nat). x \<in> A}. ~Finite(B)"
    2.46 +apply clarify 
    2.47 +apply (drule subset_consI [THEN subset_imp_lepoll, THEN lepoll_Finite])
    2.48 +apply (rule nat_not_Finite [THEN notE] )
    2.49 +apply (subgoal_tac "x ~= 0")
    2.50 +apply (blast intro: lepoll_Sigma [THEN lepoll_Finite] , blast) 
    2.51 +done
    2.52 +
    2.53 +lemma lemma1: "[| Union(C)=A; a \<in> A |] ==> \<exists>B \<in> C. a \<in> B & B \<subseteq> A"
    2.54 +by fast
    2.55 +
    2.56 +lemma lemma2: 
    2.57 +        "[| pairwise_disjoint(A); B \<in> A; C \<in> A; a \<in> B; a \<in> C |] ==> B=C"
    2.58 +by (unfold pairwise_disjoint_def, blast) 
    2.59 +
    2.60 +lemma lemma3: 
    2.61 +        "\<forall>B \<in> {cons(0, x*nat). x \<in> A}. pairwise_disjoint(f`B) &   
    2.62 +                sets_of_size_between(f`B, 2, n) & Union(f`B)=B   
    2.63 +        ==> \<forall>B \<in> A. \<exists>! u. u \<in> f`cons(0, B*nat) & u \<subseteq> cons(0, B*nat) &   
    2.64 +                0 \<in> u & 2 \<lesssim> u & u \<lesssim> n"
    2.65 +apply (unfold sets_of_size_between_def)
    2.66 +apply (rule ballI)
    2.67 +apply (erule ballE)
    2.68 +prefer 2 apply blast 
    2.69 +apply (blast dest: lemma1 intro!: lemma2) 
    2.70 +done
    2.71 +
    2.72 +lemma lemma4: "[| A \<lesssim> i; Ord(i) |] ==> {P(a). a \<in> A} \<lesssim> i"
    2.73 +apply (unfold lepoll_def)
    2.74 +apply (erule exE)
    2.75 +apply (rule_tac x = "\<lambda>x \<in> RepFun(A,P). LEAST j. \<exists>a\<in>A. x=P(a) & f`a=j" 
    2.76 +       in exI)
    2.77 +apply (rule_tac d = "%y. P (converse (f) `y) " in lam_injective)
    2.78 +apply (erule RepFunE)
    2.79 +apply (frule inj_is_fun [THEN apply_type], assumption)
    2.80 +apply (fast intro: LeastI2 elim!: Ord_in_Ord inj_is_fun [THEN apply_type])
    2.81 +apply (erule RepFunE)
    2.82 +apply (rule LeastI2)
    2.83 +  apply fast
    2.84 + apply (fast elim!: Ord_in_Ord inj_is_fun [THEN apply_type])
    2.85 +apply (fast elim: sym left_inverse [THEN ssubst])
    2.86 +done
    2.87 +
    2.88 +lemma lemma5_1:
    2.89 +     "[| B \<in> A; 2 \<lesssim> u(B) |] ==> (\<lambda>x \<in> A. {fst(x). x \<in> u(x)-{0}})`B \<noteq> 0"
    2.90 +apply simp
    2.91 +apply (fast dest: lepoll_Diff_sing 
    2.92 +            elim: lepoll_trans [THEN succ_lepoll_natE] ssubst
    2.93 +            intro!: lepoll_refl)
    2.94 +done
    2.95 +
    2.96 +lemma lemma5_2:
    2.97 +     "[|  B \<in> A; u(B) \<subseteq> cons(0, B*nat) |]   
    2.98 +      ==> (\<lambda>x \<in> A. {fst(x). x \<in> u(x)-{0}})`B \<subseteq> B"
    2.99 +apply auto 
   2.100 +done
   2.101 +
   2.102 +lemma lemma5_3:
   2.103 +     "[| n \<in> nat; B \<in> A; 0 \<in> u(B); u(B) \<lesssim> succ(n) |]   
   2.104 +      ==> (\<lambda>x \<in> A. {fst(x). x \<in> u(x)-{0}})`B \<lesssim> n"
   2.105 +apply simp
   2.106 +apply (fast elim!: Diff_lepoll [THEN lemma4 [OF _ nat_into_Ord]])
   2.107 +done
   2.108 +
   2.109 +lemma ex_fun_AC13_AC15:
   2.110 +     "[| \<forall>B \<in> {cons(0, x*nat). x \<in> A}.   
   2.111 +                pairwise_disjoint(f`B) &   
   2.112 +                sets_of_size_between(f`B, 2, succ(n)) & Union(f`B)=B; 
   2.113 +         n \<in> nat |]   
   2.114 +      ==> \<exists>f. \<forall>B \<in> A. f`B \<noteq> 0 & f`B \<subseteq> B & f`B \<lesssim> n"
   2.115 +by (fast del: subsetI notI
   2.116 +	 dest!: lemma3 theI intro!: lemma5_1 lemma5_2 lemma5_3)
   2.117 +
   2.118 +
   2.119 +(* ********************************************************************** *)
   2.120 +(* The target proofs                                                      *)
   2.121 +(* ********************************************************************** *)
   2.122 +
   2.123 +(* ********************************************************************** *)
   2.124 +(* AC10(n) ==> AC11                                                       *)
   2.125 +(* ********************************************************************** *)
   2.126 +
   2.127 +lemma AC10_AC11: "[| n \<in> nat; 1\<le>n; AC10(n) |] ==> AC11"
   2.128 +by (unfold AC10_def AC11_def, blast)
   2.129 +
   2.130 +(* ********************************************************************** *)
   2.131 +(* AC11 ==> AC12                                                          *)
   2.132 +(* ********************************************************************** *)
   2.133 +
   2.134 +lemma AC11_AC12: "AC11 ==> AC12"
   2.135 +by (unfold AC10_def AC11_def AC11_def AC12_def, blast)
   2.136 +
   2.137 +(* ********************************************************************** *)
   2.138 +(* AC12 ==> AC15                                                          *)
   2.139 +(* ********************************************************************** *)
   2.140 +
   2.141 +lemma AC12_AC15: "AC12 ==> AC15"
   2.142 +apply (unfold AC12_def AC15_def)
   2.143 +apply (blast del: ballI 
   2.144 +             intro!: cons_times_nat_not_Finite ex_fun_AC13_AC15)
   2.145 +done
   2.146  
   2.147 -AC15_WO6 = HH
   2.148 +(* ********************************************************************** *)
   2.149 +(* AC15 ==> WO6                                                           *)
   2.150 +(* ********************************************************************** *)
   2.151 +
   2.152 +lemma OUN_eq_UN: "Ord(x) ==> (\<Union>a<x. F(a)) = (\<Union>a \<in> x. F(a))"
   2.153 +by (fast intro!: ltI dest!: ltD)
   2.154 +
   2.155 +lemma lemma1:
   2.156 +     "\<forall>x \<in> Pow(A)-{0}. f`x\<noteq>0 & f`x \<subseteq> x & f`x \<lesssim> m 
   2.157 +      ==> (\<Union>i<LEAST x. HH(f,A,x)={A}. HH(f,A,i)) = A"
   2.158 +apply (simp add: Ord_Least [THEN OUN_eq_UN])
   2.159 +apply (rule equalityI)
   2.160 +apply (fast dest!: less_Least_subset_x)
   2.161 +apply (blast del: subsetI 
   2.162 +           intro!: f_subsets_imp_UN_HH_eq_x [THEN Diff_eq_0_iff [THEN iffD1]])
   2.163 +done
   2.164 +
   2.165 +lemma lemma2:
   2.166 +     "\<forall>x \<in> Pow(A)-{0}. f`x\<noteq>0 & f`x \<subseteq> x & f`x \<lesssim> m 
   2.167 +      ==> \<forall>x < (LEAST x. HH(f,A,x)={A}). HH(f,A,x) \<lesssim> m"
   2.168 +apply (rule oallI)
   2.169 +apply (drule ltD [THEN less_Least_subset_x])
   2.170 +apply (frule HH_subset_imp_eq)
   2.171 +apply (erule ssubst)
   2.172 +apply (blast dest!: HH_subset_x_imp_subset_Diff_UN [THEN not_emptyI2])
   2.173 +	(*but can't use del: DiffE despite the obvious conflictc*)
   2.174 +done
   2.175 +
   2.176 +lemma AC15_WO6: "AC15 ==> WO6"
   2.177 +apply (unfold AC15_def WO6_def)
   2.178 +apply (rule allI)
   2.179 +apply (erule_tac x = "Pow (A) -{0}" in allE)
   2.180 +apply (erule impE, fast)
   2.181 +apply (elim bexE conjE exE)
   2.182 +apply (rule bexI)
   2.183 +apply (rule conjI, assumption)
   2.184 +apply (rule_tac x = "LEAST i. HH (f,A,i) ={A}" in exI)
   2.185 +apply (rule_tac x = "\<lambda>j \<in> (LEAST i. HH (f,A,i) ={A}) . HH (f,A,j) " in exI)
   2.186 +apply simp
   2.187 +apply (fast intro!: Ord_Least lam_type [THEN domain_of_fun]
   2.188 +            elim!: less_Least_subset_x lemma1 lemma2, assumption); 
   2.189 +done
   2.190 +
   2.191 +
   2.192 +(* ********************************************************************** *)
   2.193 +(* The proof needed in the first case, not in the second                  *)
   2.194 +(* ********************************************************************** *)
   2.195 +
   2.196 +(* ********************************************************************** *)
   2.197 +(* AC10(n) ==> AC13(n-1)  if 2\<le>n                                       *)
   2.198 +(*                                                                        *)
   2.199 +(* Because of the change to the formal definition of AC10(n) we prove     *)
   2.200 +(* the following obviously equivalent theorem \<in>                           *)
   2.201 +(* AC10(n) implies AC13(n) for (1\<le>n)                                   *)
   2.202 +(* ********************************************************************** *)
   2.203 +
   2.204 +lemma AC10_AC13: "[| n \<in> nat; 1\<le>n; AC10(n) |] ==> AC13(n)"
   2.205 +apply (unfold AC10_def AC13_def, safe)
   2.206 +apply (erule allE) 
   2.207 +apply (erule impE [OF _ cons_times_nat_not_Finite], assumption); 
   2.208 +apply (fast elim!: impE [OF _ cons_times_nat_not_Finite] 
   2.209 +            dest!: ex_fun_AC13_AC15)
   2.210 +done
   2.211 +
   2.212 +(* ********************************************************************** *)
   2.213 +(* The proofs needed in the second case, not in the first                 *)
   2.214 +(* ********************************************************************** *)
   2.215 +
   2.216 +(* ********************************************************************** *)
   2.217 +(* AC1 ==> AC13(1)                                                        *)
   2.218 +(* ********************************************************************** *)
   2.219 +
   2.220 +lemma AC1_AC13: "AC1 ==> AC13(1)"
   2.221 +apply (unfold AC1_def AC13_def)
   2.222 +apply (rule allI)
   2.223 +apply (erule allE)
   2.224 +apply (rule impI)
   2.225 +apply (drule mp, assumption) 
   2.226 +apply (elim exE)
   2.227 +apply (rule_tac x = "\<lambda>x \<in> A. {f`x}" in exI)
   2.228 +apply (simp add: singleton_eqpoll_1 [THEN eqpoll_imp_lepoll])
   2.229 +done
   2.230 +
   2.231 +(* ********************************************************************** *)
   2.232 +(* AC13(m) ==> AC13(n) for m \<subseteq> n                                         *)
   2.233 +(* ********************************************************************** *)
   2.234 +
   2.235 +lemma AC13_mono: "[| m\<le>n; AC13(m) |] ==> AC13(n)"
   2.236 +apply (unfold AC13_def)
   2.237 +apply (drule le_imp_lepoll)
   2.238 +apply (fast elim!: lepoll_trans)
   2.239 +done
   2.240 +
   2.241 +(* ********************************************************************** *)
   2.242 +(* The proofs necessary for both cases                                    *)
   2.243 +(* ********************************************************************** *)
   2.244 +
   2.245 +(* ********************************************************************** *)
   2.246 +(* AC13(n) ==> AC14  if 1 \<subseteq> n                                            *)
   2.247 +(* ********************************************************************** *)
   2.248 +
   2.249 +lemma AC13_AC14: "[| n \<in> nat; 1\<le>n; AC13(n) |] ==> AC14"
   2.250 +by (unfold AC13_def AC14_def, auto)
   2.251 +
   2.252 +(* ********************************************************************** *)
   2.253 +(* AC14 ==> AC15                                                          *)
   2.254 +(* ********************************************************************** *)
   2.255 +
   2.256 +lemma AC14_AC15: "AC14 ==> AC15"
   2.257 +by (unfold AC13_def AC14_def AC15_def, fast)
   2.258 +
   2.259 +(* ********************************************************************** *)
   2.260 +(* The redundant proofs; however cited by Rubin & Rubin                   *)
   2.261 +(* ********************************************************************** *)
   2.262 +
   2.263 +(* ********************************************************************** *)
   2.264 +(* AC13(1) ==> AC1                                                        *)
   2.265 +(* ********************************************************************** *)
   2.266 +
   2.267 +lemma lemma_aux: "[| A\<noteq>0; A \<lesssim> 1 |] ==> \<exists>a. A={a}"
   2.268 +by (fast elim!: not_emptyE lepoll_1_is_sing)
   2.269 +
   2.270 +lemma AC13_AC1_lemma:
   2.271 +     "\<forall>B \<in> A. f(B)\<noteq>0 & f(B)<=B & f(B) \<lesssim> 1   
   2.272 +      ==> (\<lambda>x \<in> A. THE y. f(x)={y}) \<in> (\<Pi>X \<in> A. X)"
   2.273 +apply (rule lam_type)
   2.274 +apply (drule bspec, assumption)
   2.275 +apply (elim conjE)
   2.276 +apply (erule lemma_aux [THEN exE], assumption)
   2.277 +apply (simp add: the_element)
   2.278 +done
   2.279 +
   2.280 +lemma AC13_AC1: "AC13(1) ==> AC1"
   2.281 +apply (unfold AC13_def AC1_def)
   2.282 +apply (fast elim!: AC13_AC1_lemma)
   2.283 +done
   2.284 +
   2.285 +(* ********************************************************************** *)
   2.286 +(* AC11 ==> AC14                                                          *)
   2.287 +(* ********************************************************************** *)
   2.288 +
   2.289 +lemma AC11_AC14: "AC11 ==> AC14"
   2.290 +apply (unfold AC11_def AC14_def)
   2.291 +apply (fast intro!: AC10_AC13)
   2.292 +done
   2.293 +
   2.294 +end
   2.295 +
     3.1 --- a/src/ZF/AC/AC16_WO4.ML	Wed Jan 16 15:04:37 2002 +0100
     3.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     3.3 @@ -1,611 +0,0 @@
     3.4 -(*  Title:      ZF/AC/AC16_WO4.ML
     3.5 -    ID:         $Id$
     3.6 -    Author:     Krzysztof Grabczewski
     3.7 -
     3.8 -  The proof of AC16(n, k) ==> WO4(n-k)
     3.9 -*)
    3.10 -
    3.11 -(* ********************************************************************** *)
    3.12 -(* The case of finite set                                                 *)
    3.13 -(* ********************************************************************** *)
    3.14 -
    3.15 -Goalw [Finite_def] "[| Finite(A); 0<m; m \\<in> nat |] ==>  \
    3.16 -\       \\<exists>a f. Ord(a) & domain(f) = a &  \
    3.17 -\               (\\<Union>b<a. f`b) = A & (\\<forall>b<a. f`b lepoll m)";
    3.18 -by (etac bexE 1);
    3.19 -by (dresolve_tac [eqpoll_sym RS (eqpoll_def RS def_imp_iff RS iffD1)] 1);
    3.20 -by (etac exE 1);
    3.21 -by (res_inst_tac [("x","n")] exI 1);
    3.22 -by (res_inst_tac [("x","\\<lambda>i \\<in> n. {f`i}")] exI 1);
    3.23 -by (Asm_full_simp_tac 1);
    3.24 -by (rewrite_goals_tac [bij_def, surj_def]);
    3.25 -by (fast_tac (claset() addSIs [ltI, nat_into_Ord, lam_funtype RS domain_of_fun,
    3.26 -        equalityI, singleton_eqpoll_1 RS eqpoll_imp_lepoll RS lepoll_trans,
    3.27 -        nat_1_lepoll_iff RS iffD2]
    3.28 -        addSEs [apply_type, ltE]) 1);
    3.29 -val lemma1 = result();
    3.30 -
    3.31 -(* ********************************************************************** *)
    3.32 -(* The case of infinite set                                               *)
    3.33 -(* ********************************************************************** *)
    3.34 -
    3.35 -(* well_ord(x,r) ==> well_ord({{y,z}. y \\<in> x}, Something(x,z))  **)
    3.36 -bind_thm ("well_ord_paired", (paired_bij RS bij_is_inj RS well_ord_rvimage));
    3.37 -
    3.38 -Goal "[| A lepoll B; ~ A lepoll C |] ==> ~ B lepoll C";
    3.39 -by (fast_tac (claset() addEs [notE, lepoll_trans]) 1);
    3.40 -qed "lepoll_trans1";
    3.41 -
    3.42 -(* ********************************************************************** *)
    3.43 -(* There exists a well ordered set y such that ...                        *)
    3.44 -(* ********************************************************************** *)
    3.45 -
    3.46 -val lepoll_paired = paired_eqpoll RS eqpoll_sym RS eqpoll_imp_lepoll;
    3.47 -
    3.48 -Goal "\\<exists>y R. well_ord(y,R) & x Int y = 0 & ~y lepoll z & ~Finite(y)";
    3.49 -by (res_inst_tac [("x","{{a,x}. a \\<in> nat Un Hartog(z)}")] exI 1);
    3.50 -by (resolve_tac [transfer thy Ord_nat RS well_ord_Memrel RS
    3.51 -		 (Ord_Hartog RS
    3.52 -		  well_ord_Memrel RSN (2, well_ord_Un)) RS exE] 1);
    3.53 -by (fast_tac 
    3.54 -    (claset() addSIs [Ord_Hartog, well_ord_Memrel, well_ord_paired,
    3.55 -		      HartogI RSN (2, lepoll_trans1),
    3.56 -		 subset_imp_lepoll RS (lepoll_paired RSN (2, lepoll_trans))]
    3.57 -              addSEs [nat_not_Finite RS notE] addEs [mem_asym]
    3.58 -	      addSDs [Un_upper1 RS subset_imp_lepoll RS lepoll_Finite,
    3.59 -		      lepoll_paired RS lepoll_Finite]) 1);
    3.60 -val lemma2 = result();
    3.61 -
    3.62 -Goal "~Finite(B) ==> ~Finite(A Un B)";
    3.63 -by (blast_tac (claset() addIs [subset_Finite]) 1);
    3.64 -qed "infinite_Un";
    3.65 -
    3.66 -(* ********************************************************************** *)
    3.67 -(* There is a v \\<in> s(u) such that k lepoll x Int y (in our case succ(k))    *)
    3.68 -(* The idea of the proof is the following \\<in>                               *)
    3.69 -(* Suppose not, i.e. every element of s(u) has exactly k-1 elements of y   *)
    3.70 -(* Thence y is less than or equipollent to {v \\<in> Pow(x). v eqpoll n#-k}      *)
    3.71 -(*   We have obtained this result in two steps \\<in>                          *)
    3.72 -(*   1. y is less than or equipollent to {v \\<in> s(u). a \\<subseteq> v}                  *)
    3.73 -(*      where a is certain k-2 element subset of y                        *)
    3.74 -(*   2. {v \\<in> s(u). a \\<subseteq> v} is less than or equipollent                       *)
    3.75 -(*      to {v \\<in> Pow(x). v eqpoll n-k}                                       *)
    3.76 -(* ********************************************************************** *)
    3.77 -
    3.78 -(*Proof simplified by LCP*)
    3.79 -Goal "[| ~(\\<exists>x \\<in> A. f`x=y); f \\<in> inj(A, B); y \\<in> B |]  \
    3.80 -\     ==> (\\<lambda>a \\<in> succ(A). if(a=A, y, f`a)) \\<in> inj(succ(A), B)";
    3.81 -by (res_inst_tac [("d","%z. if(z=y, A, converse(f)`z)")] lam_injective 1);
    3.82 -by (force_tac (claset(), simpset() addsimps [inj_is_fun RS apply_type]) 1);
    3.83 -(*this preliminary simplification prevents looping somehow*)
    3.84 -by (Asm_simp_tac 1);  
    3.85 -by (force_tac (claset(), simpset() addsimps []) 1);  
    3.86 -qed "succ_not_lepoll_lemma";
    3.87 -
    3.88 -Goalw [lepoll_def, eqpoll_def, bij_def, surj_def]
    3.89 -        "[| ~A eqpoll B; A lepoll B |] ==> succ(A) lepoll B";
    3.90 -by (fast_tac (claset() addSEs [succ_not_lepoll_lemma, inj_is_fun]) 1);
    3.91 -qed "succ_not_lepoll_imp_eqpoll";
    3.92 -
    3.93 -
    3.94 -(* ********************************************************************** *)
    3.95 -(* There is a k-2 element subset of y                                     *)
    3.96 -(* ********************************************************************** *)
    3.97 -
    3.98 -val ordertype_eqpoll =
    3.99 -        ordermap_bij RS (exI RS (eqpoll_def RS def_imp_iff RS iffD2));
   3.100 -
   3.101 -Goal "[| a \\<subseteq> y; b \\<in> y-a; u \\<in> x |] ==> cons(b, cons(u, a)) \\<in> Pow(x Un y)";
   3.102 -by (Fast_tac 1);
   3.103 -qed "cons_cons_subset";
   3.104 -
   3.105 -Goal "[| a eqpoll k; a \\<subseteq> y; b \\<in> y-a; u \\<in> x; x Int y = 0 |]   \
   3.106 -\     ==> cons(b, cons(u, a)) eqpoll succ(succ(k))";
   3.107 -by (fast_tac (claset() addSIs [cons_eqpoll_succ]) 1);
   3.108 -qed "cons_cons_eqpoll";
   3.109 -
   3.110 -Goal "[| succ(k) eqpoll A; k eqpoll B; B \\<subseteq> A; a \\<in> A-B; k \\<in> nat |]   \
   3.111 -\     ==> A = cons(a, B)";
   3.112 -by (rtac equalityI 1);
   3.113 -by (Fast_tac 2);
   3.114 -by (resolve_tac [Diff_eq_0_iff RS iffD1] 1);
   3.115 -by (rtac equals0I 1);
   3.116 -by (dresolve_tac [eqpoll_sym RS eqpoll_imp_lepoll] 1);
   3.117 -by (dresolve_tac [eqpoll_sym RS cons_eqpoll_succ] 1);
   3.118 -by (Fast_tac 1);
   3.119 -by (dtac cons_eqpoll_succ 1);
   3.120 -by (Fast_tac 1);
   3.121 -by (fast_tac 
   3.122 -    (claset() 
   3.123 -        addSEs [[eqpoll_sym RS eqpoll_imp_lepoll, subset_imp_lepoll] MRS
   3.124 -        (lepoll_trans RS lepoll_trans) RS succ_lepoll_natE]) 1);
   3.125 -qed "set_eq_cons";
   3.126 -
   3.127 -Goal "[| cons(x,a) = cons(y,a); x\\<notin> a |] ==> x = y ";
   3.128 -by (fast_tac (claset() addSEs [equalityE]) 1);
   3.129 -qed "cons_eqE";
   3.130 -
   3.131 -Goal "A = B ==> A Int C = B Int C";
   3.132 -by (Asm_simp_tac 1);
   3.133 -qed "eq_imp_Int_eq";
   3.134 -
   3.135 -(* ********************************************************************** *)
   3.136 -(* some arithmetic                                                        *)
   3.137 -(* ********************************************************************** *)
   3.138 -
   3.139 -Goal "[| k \\<in> nat; m \\<in> nat |] ==>  \
   3.140 -\       \\<forall>A B. A eqpoll k #+ m & k lepoll B & B \\<subseteq> A --> A-B lepoll m";
   3.141 -by (induct_tac "k" 1);
   3.142 -by (asm_simp_tac (simpset() addsimps [add_0]) 1);
   3.143 -by (fast_tac (claset() addIs [eqpoll_imp_lepoll RS
   3.144 -        (Diff_subset RS subset_imp_lepoll RS lepoll_trans)]) 1);
   3.145 -by (REPEAT (resolve_tac [allI,impI] 1));
   3.146 -by (resolve_tac [succ_lepoll_imp_not_empty RS not_emptyE] 1);
   3.147 -by (Fast_tac 1);
   3.148 -by (eres_inst_tac [("x","A - {xa}")] allE 1);
   3.149 -by (eres_inst_tac [("x","B - {xa}")] allE 1);
   3.150 -by (etac impE 1);
   3.151 -by (asm_full_simp_tac (simpset() addsimps [add_succ]) 1);
   3.152 -by (fast_tac (claset() addSIs [Diff_sing_eqpoll, lepoll_Diff_sing]) 1);
   3.153 -by (res_inst_tac [("P","%z. z lepoll m")] subst 1 THEN (assume_tac 2));
   3.154 -by (Fast_tac 1);
   3.155 -qed "eqpoll_sum_imp_Diff_lepoll_lemma";
   3.156 -
   3.157 -Goal "[| A eqpoll succ(k #+ m); B \\<subseteq> A; succ(k) lepoll B;  k \\<in> nat; m \\<in> nat |]  \
   3.158 -\     ==> A-B lepoll m";
   3.159 -by (dresolve_tac [add_succ RS ssubst] 1);
   3.160 -by (dresolve_tac [nat_succI RS eqpoll_sum_imp_Diff_lepoll_lemma] 1
   3.161 -        THEN (REPEAT (assume_tac 1)));
   3.162 -by (Fast_tac 1);
   3.163 -qed "eqpoll_sum_imp_Diff_lepoll";
   3.164 -
   3.165 -(* ********************************************************************** *)
   3.166 -(* similar properties for eqpoll                                          *)
   3.167 -(* ********************************************************************** *)
   3.168 -
   3.169 -Goal "[| k \\<in> nat; m \\<in> nat |] ==>  \
   3.170 -\       \\<forall>A B. A eqpoll k #+ m & k eqpoll B & B \\<subseteq> A --> A-B eqpoll m";
   3.171 -by (induct_tac "k" 1);
   3.172 -by (fast_tac (claset() addSDs [eqpoll_sym RS eqpoll_imp_lepoll RS lepoll_0_is_0]
   3.173 -        addss (simpset() addsimps [add_0])) 1);
   3.174 -by (REPEAT (resolve_tac [allI,impI] 1));
   3.175 -by (resolve_tac [succ_lepoll_imp_not_empty RS not_emptyE] 1);
   3.176 -by (fast_tac (claset() addSEs [eqpoll_imp_lepoll]) 1);
   3.177 -by (eres_inst_tac [("x","A - {xa}")] allE 1);
   3.178 -by (eres_inst_tac [("x","B - {xa}")] allE 1);
   3.179 -by (etac impE 1);
   3.180 -by (fast_tac (claset() addSIs [Diff_sing_eqpoll,
   3.181 -        eqpoll_sym RSN (2, Diff_sing_eqpoll) RS eqpoll_sym]
   3.182 -        addss (simpset() addsimps [add_succ])) 1);
   3.183 -by (res_inst_tac [("P","%z. z eqpoll m")] subst 1 THEN (assume_tac 2));
   3.184 -by (Fast_tac 1);
   3.185 -qed "eqpoll_sum_imp_Diff_eqpoll_lemma";
   3.186 -
   3.187 -Goal "[| A eqpoll succ(k #+ m); B \\<subseteq> A; succ(k) eqpoll B; k \\<in> nat; m \\<in> nat |]  \
   3.188 -\     ==> A-B eqpoll m";
   3.189 -by (dresolve_tac [add_succ RS ssubst] 1);
   3.190 -by (dresolve_tac [nat_succI RS eqpoll_sum_imp_Diff_eqpoll_lemma] 1
   3.191 -        THEN (REPEAT (assume_tac 1)));
   3.192 -by (Fast_tac 1);
   3.193 -qed "eqpoll_sum_imp_Diff_eqpoll";
   3.194 -
   3.195 -
   3.196 -(* ********************************************************************** *)
   3.197 -(* LL can be well ordered                                                 *)
   3.198 -(* ********************************************************************** *)
   3.199 -
   3.200 -Goal "{x \\<in> Pow(X). x lepoll 0} = {0}";
   3.201 -by (fast_tac (claset() addSDs [lepoll_0_is_0] addSIs [lepoll_refl]) 1);
   3.202 -qed "subsets_lepoll_0_eq_unit";
   3.203 -
   3.204 -Goal "n \\<in> nat ==> {z \\<in> Pow(y). z lepoll succ(n)} =  \
   3.205 -\               {z \\<in> Pow(y). z lepoll n} Un {z \\<in> Pow(y). z eqpoll succ(n)}";
   3.206 -by (fast_tac (claset() addIs [le_refl, leI, le_imp_lepoll]
   3.207 -                addSDs [lepoll_succ_disj]
   3.208 -                addSEs [nat_into_Ord, lepoll_trans, eqpoll_imp_lepoll]) 1);
   3.209 -qed "subsets_lepoll_succ";
   3.210 -
   3.211 -Goal "n \\<in> nat ==> {z \\<in> Pow(y). z lepoll n} Int {z \\<in> Pow(y). z eqpoll succ(n)} = 0";
   3.212 -by (fast_tac (claset() addSEs [eqpoll_sym RS eqpoll_imp_lepoll 
   3.213 -                RS lepoll_trans RS succ_lepoll_natE]
   3.214 -                addSIs [equals0I]) 1);
   3.215 -qed "Int_empty";
   3.216 -
   3.217 -
   3.218 -Open_locale "AC16"; 
   3.219 -
   3.220 -val all_ex = thm "all_ex";
   3.221 -val disjoint = thm "disjoint";
   3.222 -val includes = thm "includes";
   3.223 -val WO_R = thm "WO_R";
   3.224 -val k_def = thm "k_def";
   3.225 -val lnat = thm "lnat";
   3.226 -val mnat = thm "mnat";
   3.227 -val mpos = thm "mpos";
   3.228 -val Infinite = thm "Infinite";
   3.229 -val noLepoll = thm "noLepoll";
   3.230 -
   3.231 -val LL_def = thm "LL_def";
   3.232 -val MM_def = thm "MM_def";
   3.233 -val GG_def = thm "GG_def";
   3.234 -val s_def = thm "s_def";
   3.235 -
   3.236 -Addsimps [disjoint, WO_R, lnat, mnat, mpos, Infinite];
   3.237 -AddSIs [disjoint, WO_R, lnat, mnat, mpos];
   3.238 -
   3.239 -Goalw [k_def] "k \\<in> nat";
   3.240 -by Auto_tac;
   3.241 -qed "knat";
   3.242 -Addsimps [knat];  AddSIs [knat];
   3.243 -
   3.244 -AddSIs [Infinite];   (*if notI is removed!*)
   3.245 -AddSEs [Infinite RS notE];
   3.246 -
   3.247 -AddEs [[disjoint, IntI] MRS (equals0D RS notE)];
   3.248 -
   3.249 -(*use k = succ(l) *)
   3.250 -val includes_l = simplify (FOL_ss addsimps [k_def]) includes;
   3.251 -val all_ex_l = simplify (FOL_ss addsimps [k_def]) all_ex;
   3.252 -
   3.253 -(* ********************************************************************** *)
   3.254 -(*   1. y is less than or equipollent to {v \\<in> s(u). a \\<subseteq> v}                  *)
   3.255 -(*      where a is certain k-2 element subset of y                        *)
   3.256 -(* ********************************************************************** *)
   3.257 -
   3.258 -Goal "[| l eqpoll a; a \\<subseteq> y |] ==> y - a eqpoll y";
   3.259 -by (cut_facts_tac [WO_R, Infinite, lnat] 1);
   3.260 -by (fast_tac (empty_cs addIs [lesspoll_trans1]
   3.261 -        addSIs [Card_cardinal, Diff_lesspoll_eqpoll_Card RS eqpoll_trans,
   3.262 -                Card_cardinal RS Card_is_Ord RS nat_le_infinite_Ord
   3.263 -                RS le_imp_lepoll]
   3.264 -        addSEs [well_ord_cardinal_eqpoll,
   3.265 -                well_ord_cardinal_eqpoll RS eqpoll_sym,
   3.266 -                eqpoll_sym RS eqpoll_imp_lepoll,
   3.267 -                n_lesspoll_nat RS lesspoll_trans2,
   3.268 -                well_ord_cardinal_eqpoll RS eqpoll_sym RS eqpoll_imp_lepoll
   3.269 -                RS lepoll_infinite]) 1);
   3.270 -qed "Diff_Finite_eqpoll";
   3.271 -
   3.272 -Goalw [s_def] "s(u) \\<subseteq> t_n";
   3.273 -by (Fast_tac 1);
   3.274 -qed "s_subset";
   3.275 -
   3.276 -Goalw [s_def, succ_def, k_def]
   3.277 -      "[| w \\<in> t_n; cons(b,cons(u,a)) \\<subseteq> w; a \\<subseteq> y; b \\<in> y-a; l eqpoll a  \
   3.278 -\      |] ==> w \\<in> s(u)";
   3.279 -by (fast_tac (claset() addDs [eqpoll_imp_lepoll RS cons_lepoll_cong]
   3.280 -                addSEs [subset_imp_lepoll RSN (2, lepoll_trans)]) 1);
   3.281 -qed "sI";
   3.282 -
   3.283 -Goalw [s_def] "v \\<in> s(u) ==> u \\<in> v";
   3.284 -by (Fast_tac 1);
   3.285 -qed "in_s_imp_u_in";
   3.286 -
   3.287 -
   3.288 -Goal "[| l eqpoll a;  a \\<subseteq> y;  b \\<in> y - a;  u \\<in> x |]  \
   3.289 -\     ==> \\<exists>! c. c \\<in> s(u) & a \\<subseteq> c & b \\<in> c";
   3.290 -by (rtac (all_ex_l RS ballE) 1);
   3.291 -by (blast_tac (claset() delrules [PowI]
   3.292 -		        addSIs [cons_cons_subset,
   3.293 -				eqpoll_sym RS cons_cons_eqpoll]) 2);
   3.294 -by (etac ex1E 1);
   3.295 -by (res_inst_tac [("a","w")] ex1I 1);
   3.296 -by (blast_tac (claset() addIs [sI]) 1);
   3.297 -by (etac allE 1);
   3.298 -by (etac impE 1);
   3.299 -by (assume_tac 2);
   3.300 -by (fast_tac (claset() addSEs [s_subset RS subsetD, in_s_imp_u_in]) 1);
   3.301 -qed "ex1_superset_a";
   3.302 -
   3.303 -Goal "[| \\<forall>v \\<in> s(u). succ(l) eqpoll v Int y;  \
   3.304 -\        l eqpoll a;  a \\<subseteq> y;  b \\<in> y - a;  u \\<in> x |]   \
   3.305 -\     ==> (THE c. c \\<in> s(u) & a \\<subseteq> c & b \\<in> c)  \
   3.306 -\              Int y = cons(b, a)";
   3.307 -by (forward_tac [ex1_superset_a RS theI] 1 THEN REPEAT (assume_tac 1));
   3.308 -by (rtac set_eq_cons 1);
   3.309 -by (REPEAT (Fast_tac 1));
   3.310 -qed "the_eq_cons";
   3.311 -
   3.312 -Goal "[| \\<forall>v \\<in> s(u). succ(l) eqpoll v Int y;  \
   3.313 -\        l eqpoll a;  a \\<subseteq> y;  u \\<in> x |]  \
   3.314 -\     ==> y lepoll {v \\<in> s(u). a \\<subseteq> v}";
   3.315 -by (resolve_tac [Diff_Finite_eqpoll RS eqpoll_sym RS 
   3.316 -		 eqpoll_imp_lepoll RS lepoll_trans] 1
   3.317 -    THEN REPEAT (Fast_tac 1));
   3.318 -by (res_inst_tac 
   3.319 -     [("f3", "\\<lambda>b \\<in> y-a. THE c. c \\<in> s(u) & a \\<subseteq> c & b \\<in> c")]
   3.320 -     (exI RS (lepoll_def RS def_imp_iff RS iffD2)) 1);
   3.321 -by (simp_tac (simpset() addsimps [inj_def]) 1);
   3.322 -by (rtac conjI 1);
   3.323 -by (rtac lam_type 1);
   3.324 -by (forward_tac [ex1_superset_a RS theI] 1 THEN REPEAT (Fast_tac 1));
   3.325 -by (Asm_simp_tac 1);
   3.326 -by (Clarify_tac 1);
   3.327 -by (rtac cons_eqE 1);
   3.328 -by (Fast_tac 2);
   3.329 -by (dres_inst_tac [("A","THE c. ?P(c)"), ("C","y")] eq_imp_Int_eq 1);
   3.330 -by (asm_full_simp_tac (simpset() addsimps [the_eq_cons]) 1);
   3.331 -qed "y_lepoll_subset_s";
   3.332 -
   3.333 -
   3.334 -(* ********************************************************************** *)
   3.335 -(* back to the second part                                                *)
   3.336 -(* ********************************************************************** *)
   3.337 -
   3.338 -Goal "w \\<subseteq> x Un y ==> w Int (x - {u}) = w - cons(u, w Int y)";
   3.339 -by (Fast_tac 1);
   3.340 -qed "w_Int_eq_w_Diff";
   3.341 -
   3.342 -Goal "[| w \\<in> {v \\<in> s(u). a \\<subseteq> v};  \
   3.343 -\        l eqpoll a;  u \\<in> x;  \
   3.344 -\        \\<forall>v \\<in> s(u). succ(l) eqpoll v Int y  \
   3.345 -\     |] ==> w Int (x - {u}) eqpoll m";
   3.346 -by (etac CollectE 1);
   3.347 -by (stac w_Int_eq_w_Diff 1);
   3.348 -by (fast_tac (claset() addSDs [s_subset RS subsetD,
   3.349 -			       includes_l RS subsetD]) 1);
   3.350 -by (fast_tac (claset() addSDs [bspec]
   3.351 -        addDs [s_subset RS subsetD, includes_l RS subsetD]
   3.352 -        addSEs [eqpoll_sym RS cons_eqpoll_succ RS eqpoll_sym, in_s_imp_u_in]
   3.353 -        addSIs [eqpoll_sum_imp_Diff_eqpoll]) 1);
   3.354 -qed "w_Int_eqpoll_m";
   3.355 -
   3.356 -(* ********************************************************************** *)
   3.357 -(*   2. {v \\<in> s(u). a \\<subseteq> v} is less than or equipollent                       *)
   3.358 -(*      to {v \\<in> Pow(x). v eqpoll n-k}                                       *)
   3.359 -(* ********************************************************************** *)
   3.360 -
   3.361 -Goal "x eqpoll m ==> x \\<noteq> 0";
   3.362 -by (cut_facts_tac [mpos] 1);
   3.363 -by (fast_tac (claset() addSEs [zero_lt_natE]
   3.364 -		       addSDs [eqpoll_succ_imp_not_empty]) 1);
   3.365 -qed "eqpoll_m_not_empty";
   3.366 -
   3.367 -Goal "[| z \\<in> xa Int (x - {u}); l eqpoll a; a \\<subseteq> y; u \\<in> x |]  \
   3.368 -\     ==> \\<exists>! w. w \\<in> t_n & cons(z, cons(u, a)) \\<subseteq> w";
   3.369 -by (rtac (all_ex RS bspec) 1);
   3.370 -by (rewtac k_def);
   3.371 -by (fast_tac (claset() addSIs [cons_eqpoll_succ] addEs [eqpoll_sym]) 1);
   3.372 -qed "cons_cons_in";
   3.373 -
   3.374 -Goal "[| \\<forall>v \\<in> s(u). succ(l) eqpoll v Int y;  \
   3.375 -\        a \\<subseteq> y; l eqpoll a; u \\<in> x |]  \
   3.376 -\     ==> {v \\<in> s(u). a \\<subseteq> v} lepoll {v \\<in> Pow(x). v eqpoll m}";
   3.377 -by (res_inst_tac [("f3","\\<lambda>w \\<in> {v \\<in> s(u). a \\<subseteq> v}. w Int (x - {u})")] 
   3.378 -        (exI RS (lepoll_def RS def_imp_iff RS iffD2)) 1);
   3.379 -by (simp_tac (simpset() addsimps [inj_def]) 1);
   3.380 -by (rtac conjI 1);
   3.381 -by (rtac lam_type 1);
   3.382 -by (rtac CollectI 1);
   3.383 -by (Fast_tac 1);
   3.384 -by (rtac w_Int_eqpoll_m 1 THEN REPEAT (assume_tac 1));
   3.385 -by (REPEAT (resolve_tac [ballI, impI] 1));
   3.386 -(** LEVEL 8 **)
   3.387 -by (resolve_tac [w_Int_eqpoll_m RS eqpoll_m_not_empty RS not_emptyE] 1);
   3.388 -by (EVERY (map Blast_tac [4,3,2,1]));
   3.389 -by (dresolve_tac [equalityD1 RS subsetD] 1 THEN (assume_tac 1));
   3.390 -by (ftac cons_cons_in 1 THEN REPEAT (assume_tac 1));
   3.391 -by (etac ex1_two_eq 1);
   3.392 -by (REPEAT (blast_tac
   3.393 -	    (claset() addDs [s_subset RS subsetD, in_s_imp_u_in]) 1));
   3.394 -qed "subset_s_lepoll_w";
   3.395 -
   3.396 -
   3.397 -(* ********************************************************************** *)
   3.398 -(* well_ord_subsets_lepoll_n                                              *)
   3.399 -(* ********************************************************************** *)
   3.400 -
   3.401 -Goal "n \\<in> nat ==> \\<exists>S. well_ord({z \\<in> Pow(y) . z eqpoll succ(n)}, S)";
   3.402 -by (resolve_tac [WO_R RS well_ord_infinite_subsets_eqpoll_X
   3.403 -		 RS (eqpoll_def RS def_imp_iff RS iffD1) RS exE] 1);
   3.404 -by (REPEAT (fast_tac (claset() addIs [bij_is_inj RS well_ord_rvimage]) 1));
   3.405 -qed "well_ord_subsets_eqpoll_n";
   3.406 -
   3.407 -Goal "n \\<in> nat ==> \\<exists>R. well_ord({z \\<in> Pow(y). z lepoll n}, R)";
   3.408 -by (induct_tac "n" 1);
   3.409 -by (force_tac (claset() addSIs [well_ord_unit],
   3.410 -	       simpset() addsimps [subsets_lepoll_0_eq_unit]) 1);
   3.411 -by (etac exE 1);
   3.412 -by (resolve_tac [well_ord_subsets_eqpoll_n RS exE] 1 THEN assume_tac 1);
   3.413 -by (asm_simp_tac (simpset() addsimps [subsets_lepoll_succ]) 1);
   3.414 -by (dtac well_ord_radd 1 THEN (assume_tac 1));
   3.415 -by (eresolve_tac [Int_empty RS disj_Un_eqpoll_sum RS 
   3.416 -                (eqpoll_def RS def_imp_iff RS iffD1) RS exE] 1);
   3.417 -by (fast_tac (claset() addSEs [bij_is_inj RS well_ord_rvimage]) 1);
   3.418 -qed "well_ord_subsets_lepoll_n";
   3.419 -
   3.420 -
   3.421 -Goalw [LL_def, MM_def] "LL \\<subseteq> {z \\<in> Pow(y). z lepoll succ(k #+ m)}";
   3.422 -by (cut_facts_tac [includes] 1);
   3.423 -by (fast_tac (claset() addIs [subset_imp_lepoll 
   3.424 -			      RS (eqpoll_imp_lepoll
   3.425 -				  RSN (2, lepoll_trans))]) 1);
   3.426 -qed "LL_subset";
   3.427 -
   3.428 -Goal "\\<exists>S. well_ord(LL,S)";
   3.429 -by (rtac (well_ord_subsets_lepoll_n RS exE) 1);
   3.430 -by (blast_tac (claset() addIs [LL_subset RSN (2, well_ord_subset)]) 2);
   3.431 -by Auto_tac;
   3.432 -qed "well_ord_LL";
   3.433 -
   3.434 -(* ********************************************************************** *)
   3.435 -(* every element of LL is a contained in exactly one element of MM        *)
   3.436 -(* ********************************************************************** *)
   3.437 -
   3.438 -Goalw [MM_def, LL_def] "v \\<in> LL ==> \\<exists>! w. w \\<in> MM & v \\<subseteq> w";
   3.439 -by Safe_tac;
   3.440 -by (Fast_tac 1);
   3.441 -by (resolve_tac [lepoll_imp_eqpoll_subset RS exE] 1 THEN (assume_tac 1));
   3.442 -by (res_inst_tac [("x","x")] (all_ex RS ballE) 1);
   3.443 -by (fast_tac (claset() addSEs [eqpoll_sym]) 2);
   3.444 -by (Blast_tac 1);
   3.445 -qed "unique_superset_in_MM";
   3.446 -
   3.447 -val unique_superset1 = unique_superset_in_MM RS theI RS conjunct1;
   3.448 -val unique_superset2 = unique_superset_in_MM RS the_equality2;
   3.449 -
   3.450 -
   3.451 -(* ********************************************************************** *)
   3.452 -(* The function GG satisfies the conditions of WO4                        *)
   3.453 -(* ********************************************************************** *)
   3.454 -
   3.455 -(* ********************************************************************** *)
   3.456 -(* The union of appropriate values is the whole x                         *)
   3.457 -(* ********************************************************************** *)
   3.458 -
   3.459 -Goalw [LL_def] "w \\<in> MM ==> w Int y \\<in> LL";
   3.460 -by (Fast_tac 1);
   3.461 -qed "Int_in_LL";
   3.462 -
   3.463 -Goalw [LL_def] 
   3.464 -     "v \\<in> LL ==> v = (THE x. x \\<in> MM & v \\<subseteq> x) Int y";
   3.465 -by (Clarify_tac 1);
   3.466 -by (stac unique_superset2 1);
   3.467 -by (auto_tac (claset(), simpset() addsimps [Int_in_LL]));
   3.468 -qed "in_LL_eq_Int";
   3.469 -
   3.470 -Goal "v \\<in> LL ==> (THE x. x \\<in> MM & v \\<subseteq> x) \\<subseteq> x Un y";
   3.471 -by (dtac unique_superset1 1);
   3.472 -by (rewtac MM_def);
   3.473 -by (fast_tac (claset() addSDs [unique_superset1, includes RS subsetD]) 1);
   3.474 -qed "the_in_MM_subset";
   3.475 -
   3.476 -Goalw [GG_def] "v \\<in> LL ==> GG ` v \\<subseteq> x";
   3.477 -by (ftac the_in_MM_subset 1);
   3.478 -by (ftac in_LL_eq_Int 1); 
   3.479 -by (force_tac (claset() addEs [equalityE], simpset()) 1);
   3.480 -qed "GG_subset";
   3.481 -
   3.482 -
   3.483 -Goal "n \\<in> nat ==> \\<exists>z. z \\<subseteq> y & n eqpoll z";
   3.484 -by (etac nat_lepoll_imp_ex_eqpoll_n 1);
   3.485 -by (resolve_tac [ordertype_eqpoll RS eqpoll_sym RS eqpoll_imp_lepoll
   3.486 -        RSN (2, lepoll_trans)] 1);
   3.487 -by (rtac WO_R 2);
   3.488 -by (fast_tac 
   3.489 -    (claset() delrules [notI]
   3.490 -              addSIs [nat_le_infinite_Ord RS le_imp_lepoll]
   3.491 -	      addIs [Ord_ordertype, 
   3.492 -		     ordertype_eqpoll RS eqpoll_imp_lepoll
   3.493 -		     RS lepoll_infinite]) 1);
   3.494 -qed "ex_subset_eqpoll_n";
   3.495 -
   3.496 -
   3.497 -Goal "u \\<in> x ==> \\<exists>v \\<in> s(u). succ(k) lepoll v Int y";
   3.498 -by (rtac ccontr 1);
   3.499 -by (subgoal_tac "\\<forall>v \\<in> s(u). k eqpoll v Int y" 1);
   3.500 -by (full_simp_tac (simpset() addsimps [s_def]) 2);
   3.501 -by (blast_tac (claset() addIs [succ_not_lepoll_imp_eqpoll]) 2);
   3.502 -by (rewtac k_def);
   3.503 -by (cut_facts_tac [all_ex, includes, lnat] 1);
   3.504 -by (rtac (ex_subset_eqpoll_n RS exE) 1 THEN assume_tac 1);
   3.505 -by (rtac (noLepoll RS notE) 1);
   3.506 -by (blast_tac (claset() addIs
   3.507 -	   [[y_lepoll_subset_s, subset_s_lepoll_w] MRS lepoll_trans]) 1);
   3.508 -qed "exists_proper_in_s";
   3.509 -
   3.510 -Goal "u \\<in> x ==> \\<exists>w \\<in> MM. u \\<in> w";
   3.511 -by (eresolve_tac [exists_proper_in_s RS bexE] 1);
   3.512 -by (rewrite_goals_tac [MM_def, s_def]);
   3.513 -by (Fast_tac 1);
   3.514 -qed "exists_in_MM";
   3.515 -
   3.516 -Goal "u \\<in> x ==> \\<exists>w \\<in> LL. u \\<in> GG`w";
   3.517 -by (rtac (exists_in_MM RS bexE) 1);
   3.518 -by (assume_tac 1);
   3.519 -by (rtac bexI 1);
   3.520 -by (etac Int_in_LL 2);
   3.521 -by (rewtac GG_def);
   3.522 -by (asm_simp_tac (simpset() addsimps [Int_in_LL]) 1);
   3.523 -by (stac unique_superset2 1);
   3.524 -by (REPEAT (fast_tac (claset() addSEs [Int_in_LL]) 1));
   3.525 -qed "exists_in_LL";
   3.526 -
   3.527 -
   3.528 -Goal "well_ord(LL,S) ==>      \
   3.529 -\     (\\<Union>b<ordertype(LL,S). GG ` (converse(ordermap(LL,S)) ` b)) = x";
   3.530 -by (rtac equalityI 1);
   3.531 -by (rtac subsetI 1);
   3.532 -by (etac OUN_E 1);
   3.533 -by (resolve_tac [GG_subset RS subsetD] 1);
   3.534 -by (assume_tac 2);
   3.535 -by (blast_tac (claset() addIs [ordermap_bij RS bij_converse_bij RS
   3.536 -			       bij_is_fun RS apply_type, ltD]) 1);
   3.537 -by (rtac subsetI 1);
   3.538 -by (eresolve_tac [exists_in_LL RS bexE] 1);
   3.539 -by (force_tac (claset() addIs [Ord_ordertype RSN (2, ltI),
   3.540 -			       ordermap_type RS apply_type],
   3.541 -        simpset() addsimps [ordermap_bij RS bij_is_inj RS left_inverse]) 1);
   3.542 -qed "OUN_eq_x";
   3.543 -
   3.544 -(* ********************************************************************** *)
   3.545 -(* Every element of the family is less than or equipollent to n-k (m)     *)
   3.546 -(* ********************************************************************** *)
   3.547 -
   3.548 -Goalw [MM_def] "w \\<in> MM ==> w eqpoll succ(k #+ m)";
   3.549 -by (fast_tac (claset() addDs [includes RS subsetD]) 1);
   3.550 -qed "in_MM_eqpoll_n";
   3.551 -
   3.552 -Goalw [LL_def, MM_def] "w \\<in> LL ==> succ(k) lepoll w";
   3.553 -by (Fast_tac 1);
   3.554 -qed "in_LL_eqpoll_n";
   3.555 -
   3.556 -val in_LL = in_LL_eq_Int RS equalityD1 RS (Int_lower1 RSN (2, subset_trans));
   3.557 -
   3.558 -Goalw [GG_def] 
   3.559 -      "well_ord(LL,S) ==>      \
   3.560 -\      \\<forall>b<ordertype(LL,S). GG ` (converse(ordermap(LL,S)) ` b) lepoll m";
   3.561 -by (rtac oallI 1);
   3.562 -by (asm_simp_tac 
   3.563 -    (simpset() addsimps [ltD,
   3.564 -			 ordermap_bij RS bij_converse_bij RS
   3.565 -			 bij_is_fun RS apply_type]) 1);
   3.566 -by (cut_facts_tac [includes] 1);
   3.567 -by (rtac eqpoll_sum_imp_Diff_lepoll 1);
   3.568 -by (REPEAT
   3.569 -    (fast_tac (claset() delrules [subsetI]
   3.570 -		        addSDs [ltD]
   3.571 -			addSIs [eqpoll_sum_imp_Diff_lepoll, in_LL_eqpoll_n]
   3.572 -			addIs [unique_superset1 RS in_MM_eqpoll_n, in_LL,
   3.573 -			       ordermap_bij RS bij_converse_bij RS 
   3.574 -			       bij_is_fun RS apply_type]) 1 ));
   3.575 -qed "all_in_lepoll_m";
   3.576 -
   3.577 -
   3.578 -Goal "\\<exists>a f. Ord(a) & domain(f) = a &  \
   3.579 -\             (\\<Union>b<a. f ` b) = x & (\\<forall>b<a. f ` b lepoll m)";
   3.580 -by (resolve_tac [well_ord_LL RS exE] 1 THEN REPEAT (assume_tac 1));
   3.581 -by (rename_tac "S" 1);
   3.582 -by (res_inst_tac [("x","ordertype(LL,S)")] exI 1);
   3.583 -by (res_inst_tac [("x",
   3.584 -        "\\<lambda>b \\<in> ordertype(LL,S). GG ` (converse(ordermap(LL,S)) ` b)")] 
   3.585 -    exI 1);
   3.586 -by (Simp_tac 1);
   3.587 -by (REPEAT (ares_tac [conjI, lam_funtype RS domain_of_fun,
   3.588 -		      Ord_ordertype, 
   3.589 -		      all_in_lepoll_m, OUN_eq_x] 1));
   3.590 -qed "conclusion";
   3.591 -
   3.592 -Close_locale "AC16";
   3.593 -
   3.594 -
   3.595 -
   3.596 -(* ********************************************************************** *)
   3.597 -(* The main theorem AC16(n, k) ==> WO4(n-k)                               *)
   3.598 -(* ********************************************************************** *)
   3.599 -
   3.600 -Goalw [AC16_def,WO4_def]
   3.601 -        "[| AC16(k #+ m, k); 0 < k; 0 < m; k \\<in> nat; m \\<in> nat |] ==> WO4(m)";
   3.602 -by (rtac allI 1);
   3.603 -by (case_tac "Finite(A)" 1);
   3.604 -by (rtac lemma1 1 THEN REPEAT (assume_tac 1));
   3.605 -by (cut_facts_tac [lemma2] 1);
   3.606 -by (REPEAT (eresolve_tac [exE, conjE] 1));
   3.607 -by (eres_inst_tac [("x","A Un y")] allE 1);
   3.608 -by (ftac infinite_Un 1 THEN (mp_tac 1));
   3.609 -by (etac zero_lt_natE 1); 
   3.610 -by (assume_tac 1);
   3.611 -by (Clarify_tac 1);
   3.612 -by (DEPTH_SOLVE (ares_tac [export conclusion] 1));
   3.613 -qed "AC16_WO4";
   3.614 -
     4.1 --- a/src/ZF/AC/AC16_WO4.thy	Wed Jan 16 15:04:37 2002 +0100
     4.2 +++ b/src/ZF/AC/AC16_WO4.thy	Wed Jan 16 17:52:06 2002 +0100
     4.3 @@ -2,40 +2,575 @@
     4.4      ID:         $Id$
     4.5      Author:     Krzysztof Grabczewski
     4.6  
     4.7 -Tidied using locales by LCP
     4.8 +The proof of AC16(n, k) ==> WO4(n-k)
     4.9 +
    4.10 +Tidied (using locales) by LCP
    4.11  *)
    4.12  
    4.13 -AC16_WO4 = OrderType + AC16_lemmas + Cardinal_aux +
    4.14 +theory AC16_WO4 = AC16_lemmas:
    4.15 +
    4.16 +(* ********************************************************************** *)
    4.17 +(* The case of finite set                                                 *)
    4.18 +(* ********************************************************************** *)
    4.19 +
    4.20 +lemma lemma1:
    4.21 +     "[| Finite(A); 0<m; m \<in> nat |] 
    4.22 +      ==> \<exists>a f. Ord(a) & domain(f) = a &   
    4.23 +                (\<Union>b<a. f`b) = A & (\<forall>b<a. f`b \<lesssim> m)"
    4.24 +apply (unfold Finite_def)
    4.25 +apply (erule bexE)
    4.26 +apply (drule eqpoll_sym [THEN eqpoll_def [THEN def_imp_iff, THEN iffD1]])
    4.27 +apply (erule exE)
    4.28 +apply (rule_tac x = "n" in exI)
    4.29 +apply (rule_tac x = "\<lambda>i \<in> n. {f`i}" in exI, simp)
    4.30 +apply (unfold bij_def surj_def)
    4.31 +apply (fast intro!: ltI nat_into_Ord lam_funtype [THEN domain_of_fun] 
    4.32 +               singleton_eqpoll_1 [THEN eqpoll_imp_lepoll, THEN lepoll_trans] 
    4.33 +                    nat_1_lepoll_iff [THEN iffD2]
    4.34 +          elim!: apply_type ltE)
    4.35 +done
    4.36 +
    4.37 +(* ********************************************************************** *)
    4.38 +(* The case of infinite set                                               *)
    4.39 +(* ********************************************************************** *)
    4.40 +
    4.41 +(* well_ord(x,r) ==> well_ord({{y,z}. y \<in> x}, Something(x,z))  **)
    4.42 +lemmas well_ord_paired = paired_bij [THEN bij_is_inj, THEN well_ord_rvimage]
    4.43 +
    4.44 +lemma lepoll_trans1: "[| A \<lesssim> B; ~ A \<lesssim> C |] ==> ~ B \<lesssim> C"
    4.45 +by (blast intro: lepoll_trans)
    4.46 +
    4.47 +(* ********************************************************************** *)
    4.48 +(* There exists a well ordered set y such that ...                        *)
    4.49 +(* ********************************************************************** *)
    4.50 +
    4.51 +lemmas lepoll_paired = paired_eqpoll [THEN eqpoll_sym, THEN eqpoll_imp_lepoll];
    4.52 +
    4.53 +lemma lemma2: "\<exists>y R. well_ord(y,R) & x Int y = 0 & ~y \<lesssim> z & ~Finite(y)"
    4.54 +apply (rule_tac x = "{{a,x}. a \<in> nat Un Hartog (z) }" in exI)
    4.55 +apply (rule well_ord_Un [OF Ord_nat [THEN well_ord_Memrel] 
    4.56 +                         Ord_Hartog [THEN well_ord_Memrel], THEN exE])
    4.57 +apply (blast intro!: Ord_Hartog well_ord_Memrel well_ord_paired
    4.58 +                      lepoll_trans1 [OF _ not_Hartog_lepoll_self]
    4.59 +                      lepoll_trans [OF subset_imp_lepoll lepoll_paired]
    4.60 +       elim!: nat_not_Finite [THEN notE]
    4.61 +       elim: mem_asym 
    4.62 +       dest!: Un_upper1 [THEN subset_imp_lepoll, THEN lepoll_Finite]
    4.63 +              lepoll_paired [THEN lepoll_Finite])
    4.64 +done
    4.65 +
    4.66 +lemma infinite_Un: "~Finite(B) ==> ~Finite(A Un B)"
    4.67 +by (blast intro: subset_Finite)
    4.68 +
    4.69 +(* ********************************************************************** *)
    4.70 +(* There is a v \<in> s(u) such that k \<lesssim> x Int y (in our case succ(k))    *)
    4.71 +(* The idea of the proof is the following \<in>                               *)
    4.72 +(* Suppose not, i.e. every element of s(u) has exactly k-1 elements of y   *)
    4.73 +(* Thence y is less than or equipollent to {v \<in> Pow(x). v \<approx> n#-k}      *)
    4.74 +(*   We have obtained this result in two steps \<in>                          *)
    4.75 +(*   1. y is less than or equipollent to {v \<in> s(u). a \<subseteq> v}                  *)
    4.76 +(*      where a is certain k-2 element subset of y                        *)
    4.77 +(*   2. {v \<in> s(u). a \<subseteq> v} is less than or equipollent                       *)
    4.78 +(*      to {v \<in> Pow(x). v \<approx> n-k}                                       *)
    4.79 +(* ********************************************************************** *)
    4.80 +
    4.81 +(*Proof simplified by LCP*)
    4.82 +lemma succ_not_lepoll_lemma:
    4.83 +     "[| ~(\<exists>x \<in> A. f`x=y); f \<in> inj(A, B); y \<in> B |]   
    4.84 +      ==> (\<lambda>a \<in> succ(A). if(a=A, y, f`a)) \<in> inj(succ(A), B)"
    4.85 +apply (rule_tac d = "%z. if (z=y, A, converse (f) `z) " in lam_injective)
    4.86 +apply (force simp add: inj_is_fun [THEN apply_type])
    4.87 +(*this preliminary simplification prevents looping somehow*)
    4.88 +apply (simp (no_asm_simp))
    4.89 +apply force
    4.90 +done
    4.91 +
    4.92 +lemma succ_not_lepoll_imp_eqpoll: "[| ~A \<approx> B; A \<lesssim> B |] ==> succ(A) \<lesssim> B"
    4.93 +apply (unfold lepoll_def eqpoll_def bij_def surj_def)
    4.94 +apply (fast elim!: succ_not_lepoll_lemma inj_is_fun)
    4.95 +done
    4.96 +
    4.97 +
    4.98 +(* ********************************************************************** *)
    4.99 +(* There is a k-2 element subset of y                                     *)
   4.100 +(* ********************************************************************** *)
   4.101 +
   4.102 +lemmas ordertype_eqpoll =
   4.103 +       ordermap_bij [THEN exI [THEN eqpoll_def [THEN def_imp_iff, THEN iffD2]]]
   4.104 +
   4.105 +lemma cons_cons_subset:
   4.106 +     "[| a \<subseteq> y; b \<in> y-a; u \<in> x |] ==> cons(b, cons(u, a)) \<in> Pow(x Un y)"
   4.107 +by fast
   4.108 +
   4.109 +lemma cons_cons_eqpoll:
   4.110 +     "[| a \<approx> k; a \<subseteq> y; b \<in> y-a; u \<in> x; x Int y = 0 |]    
   4.111 +      ==> cons(b, cons(u, a)) \<approx> succ(succ(k))"
   4.112 +by (fast intro!: cons_eqpoll_succ)
   4.113 +
   4.114 +lemma set_eq_cons:
   4.115 +     "[| succ(k) \<approx> A; k \<approx> B; B \<subseteq> A; a \<in> A-B; k \<in> nat |] ==> A = cons(a, B)"
   4.116 +apply (rule equalityI)
   4.117 +prefer 2 apply fast
   4.118 +apply (rule Diff_eq_0_iff [THEN iffD1])
   4.119 +apply (rule equals0I)
   4.120 +apply (drule eqpoll_sym [THEN eqpoll_imp_lepoll])
   4.121 +apply (drule eqpoll_sym [THEN cons_eqpoll_succ], fast)
   4.122 +apply (drule cons_eqpoll_succ, fast)
   4.123 +apply (fast elim!: lepoll_trans [THEN lepoll_trans, THEN succ_lepoll_natE,
   4.124 +         OF eqpoll_sym [THEN eqpoll_imp_lepoll] subset_imp_lepoll])
   4.125 +done
   4.126 +
   4.127 +lemma cons_eqE: "[| cons(x,a) = cons(y,a); x \<notin> a |] ==> x = y "
   4.128 +by (fast elim!: equalityE)
   4.129 +
   4.130 +lemma eq_imp_Int_eq: "A = B ==> A Int C = B Int C"
   4.131 +by blast
   4.132 +
   4.133 +(* ********************************************************************** *)
   4.134 +(* some arithmetic                                                        *)
   4.135 +(* ********************************************************************** *)
   4.136 +
   4.137 +lemma eqpoll_sum_imp_Diff_lepoll_lemma [rule_format]:
   4.138 +     "[| k \<in> nat; m \<in> nat |] 
   4.139 +      ==> \<forall>A B. A \<approx> k #+ m & k \<lesssim> B & B \<subseteq> A --> A-B \<lesssim> m"
   4.140 +apply (induct_tac "k")
   4.141 +apply (simp add: add_0)
   4.142 +apply (blast intro: eqpoll_imp_lepoll lepoll_trans
   4.143 +                    Diff_subset [THEN subset_imp_lepoll])
   4.144 +apply (intro allI impI)
   4.145 +apply (rule succ_lepoll_imp_not_empty [THEN not_emptyE], fast)
   4.146 +apply (erule_tac x = "A - {xa}" in allE)
   4.147 +apply (erule_tac x = "B - {xa}" in allE)
   4.148 +apply (erule impE)
   4.149 +apply (simp add: add_succ)
   4.150 +apply (fast intro!: Diff_sing_eqpoll lepoll_Diff_sing) 
   4.151 +apply (subgoal_tac "A - {xa} - (B - {xa}) = A - B", simp); 
   4.152 +apply blast 
   4.153 +done
   4.154 +
   4.155 +lemma eqpoll_sum_imp_Diff_lepoll:
   4.156 +     "[| A \<approx> succ(k #+ m); B \<subseteq> A; succ(k) \<lesssim> B;  k \<in> nat; m \<in> nat |]   
   4.157 +      ==> A-B \<lesssim> m"
   4.158 +apply (simp only: add_succ [symmetric]) 
   4.159 +apply (blast intro: eqpoll_sum_imp_Diff_lepoll_lemma) 
   4.160 +done
   4.161 +
   4.162 +(* ********************************************************************** *)
   4.163 +(* similar properties for \<approx>                                          *)
   4.164 +(* ********************************************************************** *)
   4.165 +
   4.166 +lemma eqpoll_sum_imp_Diff_eqpoll_lemma [rule_format]:
   4.167 +     "[| k \<in> nat; m \<in> nat |] 
   4.168 +      ==> \<forall>A B. A \<approx> k #+ m & k \<approx> B & B \<subseteq> A --> A-B \<approx> m"
   4.169 +apply (induct_tac "k")
   4.170 +apply (force dest!: eqpoll_sym [THEN eqpoll_imp_lepoll, THEN lepoll_0_is_0])
   4.171 +apply (intro allI impI)
   4.172 +apply (rule succ_lepoll_imp_not_empty [THEN not_emptyE])
   4.173 +apply (fast elim!: eqpoll_imp_lepoll)
   4.174 +apply (erule_tac x = "A - {xa}" in allE)
   4.175 +apply (erule_tac x = "B - {xa}" in allE)
   4.176 +apply (erule impE)
   4.177 +apply (force intro: eqpoll_sym intro!: Diff_sing_eqpoll)
   4.178 +apply (subgoal_tac "A - {xa} - (B - {xa}) = A - B", simp); 
   4.179 +apply blast 
   4.180 +done
   4.181 +
   4.182 +lemma eqpoll_sum_imp_Diff_eqpoll:
   4.183 +     "[| A \<approx> succ(k #+ m); B \<subseteq> A; succ(k) \<approx> B; k \<in> nat; m \<in> nat |]   
   4.184 +      ==> A-B \<approx> m"
   4.185 +apply (simp only: add_succ [symmetric]) 
   4.186 +apply (blast intro: eqpoll_sum_imp_Diff_eqpoll_lemma) 
   4.187 +done
   4.188 +
   4.189 +
   4.190 +(* ********************************************************************** *)
   4.191 +(* LL can be well ordered                                                 *)
   4.192 +(* ********************************************************************** *)
   4.193 +
   4.194 +lemma subsets_lepoll_0_eq_unit: "{x \<in> Pow(X). x \<lesssim> 0} = {0}"
   4.195 +by (fast dest!: lepoll_0_is_0 intro!: lepoll_refl)
   4.196 +
   4.197 +lemma subsets_lepoll_succ:
   4.198 +     "n \<in> nat ==> {z \<in> Pow(y). z \<lesssim> succ(n)} =   
   4.199 +                  {z \<in> Pow(y). z \<lesssim> n} Un {z \<in> Pow(y). z \<approx> succ(n)}"
   4.200 +by (blast intro: leI le_imp_lepoll nat_into_Ord 
   4.201 +                    lepoll_trans eqpoll_imp_lepoll
   4.202 +          dest!: lepoll_succ_disj)
   4.203 +
   4.204 +lemma Int_empty:
   4.205 +     "n \<in> nat ==> {z \<in> Pow(y). z \<lesssim> n} Int {z \<in> Pow(y). z \<approx> succ(n)} = 0"
   4.206 +by (blast intro: eqpoll_sym [THEN eqpoll_imp_lepoll, THEN lepoll_trans] 
   4.207 +                 succ_lepoll_natE)
   4.208 +
   4.209  
   4.210  locale AC16 =
   4.211 -  fixes 
   4.212 -    x	:: i
   4.213 -    y	:: i
   4.214 -    k	:: i
   4.215 -    l   :: i
   4.216 -    m	:: i
   4.217 -    t_n	:: i
   4.218 -    R	:: i
   4.219 -    MM  :: i
   4.220 -    LL  :: i
   4.221 -    GG  :: i
   4.222 -    s   :: i=>i
   4.223 -  assumes
   4.224 -    all_ex    "\\<forall>z \\<in> {z \\<in> Pow(x Un y) . z eqpoll succ(k)}.
   4.225 -	         \\<exists>! w. w \\<in> t_n & z \\<subseteq> w "
   4.226 -    disjoint  "x Int y = 0"
   4.227 -    includes  "t_n \\<subseteq> {v \\<in> Pow(x Un y). v eqpoll succ(k #+ m)}"
   4.228 -    WO_R      "well_ord(y,R)"
   4.229 -    lnat      "l \\<in> nat"
   4.230 -    mnat      "m \\<in> nat"
   4.231 -    mpos      "0<m"
   4.232 -    Infinite  "~ Finite(y)"
   4.233 -    noLepoll  "~ y lepoll {v \\<in> Pow(x). v eqpoll m}"
   4.234 -  defines
   4.235 -    k_def     "k   == succ(l)"
   4.236 -    MM_def    "MM  == {v \\<in> t_n. succ(k) lepoll v Int y}"
   4.237 -    LL_def    "LL  == {v Int y. v \\<in> MM}"
   4.238 -    GG_def    "GG  == \\<lambda>v \\<in> LL. (THE w. w \\<in> MM & v \\<subseteq> w) - v"
   4.239 -    s_def     "s(u) == {v \\<in> t_n. u \\<in> v & k lepoll v Int y}"
   4.240 +  fixes x and y and k and l and m and t_n and R and MM and LL and GG and s 
   4.241 +  defines k_def:     "k   == succ(l)"
   4.242 +      and MM_def:    "MM  == {v \<in> t_n. succ(k) \<lesssim> v Int y}"
   4.243 +      and LL_def:    "LL  == {v Int y. v \<in> MM}"
   4.244 +      and GG_def:    "GG  == \<lambda>v \<in> LL. (THE w. w \<in> MM & v \<subseteq> w) - v"
   4.245 +      and s_def:     "s(u) == {v \<in> t_n. u \<in> v & k \<lesssim> v Int y}"
   4.246 +  assumes all_ex:    "\<forall>z \<in> {z \<in> Pow(x Un y) . z \<approx> succ(k)}.
   4.247 +	               \<exists>! w. w \<in> t_n & z \<subseteq> w "
   4.248 +    and disjoint[iff]:  "x Int y = 0"
   4.249 +    and includes:  "t_n \<subseteq> {v \<in> Pow(x Un y). v \<approx> succ(k #+ m)}"
   4.250 +    and WO_R[iff]:      "well_ord(y,R)"
   4.251 +    and lnat[iff]:      "l \<in> nat"
   4.252 +    and mnat[iff]:      "m \<in> nat"
   4.253 +    and mpos[iff]:      "0<m"
   4.254 +    and Infinite[iff]:  "~ Finite(y)"
   4.255 +    and noLepoll:  "~ y \<lesssim> {v \<in> Pow(x). v \<approx> m}"
   4.256 +
   4.257 +lemma (in AC16) knat [iff]: "k \<in> nat"
   4.258 +by (simp add: k_def)
   4.259 +
   4.260 +
   4.261 +(* ********************************************************************** *)
   4.262 +(*   1. y is less than or equipollent to {v \<in> s(u). a \<subseteq> v}                *)
   4.263 +(*      where a is certain k-2 element subset of y                        *)
   4.264 +(* ********************************************************************** *)
   4.265 +
   4.266 +lemma (in AC16) Diff_Finite_eqpoll: "[| l \<approx> a; a \<subseteq> y |] ==> y - a \<approx> y"
   4.267 +apply (insert WO_R Infinite lnat)
   4.268 +apply (rule eqpoll_trans) 
   4.269 +apply (rule Diff_lesspoll_eqpoll_Card) 
   4.270 +apply (erule well_ord_cardinal_eqpoll [THEN eqpoll_sym])
   4.271 +apply (blast intro: lesspoll_trans1
   4.272 +            intro!: Card_cardinal  
   4.273 +                    Card_cardinal [THEN Card_is_Ord, THEN nat_le_infinite_Ord,
   4.274 +                                   THEN le_imp_lepoll] 
   4.275 +            dest: well_ord_cardinal_eqpoll 
   4.276 +		   eqpoll_sym  eqpoll_imp_lepoll
   4.277 +                   n_lesspoll_nat [THEN lesspoll_trans2]
   4.278 +                   well_ord_cardinal_eqpoll [THEN eqpoll_sym, 
   4.279 +                          THEN eqpoll_imp_lepoll, THEN lepoll_infinite])+
   4.280 +done
   4.281 +
   4.282 +
   4.283 +lemma (in AC16) s_subset: "s(u) \<subseteq> t_n"
   4.284 +by (unfold s_def, blast)
   4.285 +
   4.286 +lemma (in AC16) sI: 
   4.287 +      "[| w \<in> t_n; cons(b,cons(u,a)) \<subseteq> w; a \<subseteq> y; b \<in> y-a; l \<approx> a |] 
   4.288 +       ==> w \<in> s(u)"
   4.289 +apply (unfold s_def succ_def k_def)
   4.290 +apply (blast intro!: eqpoll_imp_lepoll [THEN cons_lepoll_cong]
   4.291 +             intro: subset_imp_lepoll lepoll_trans)
   4.292 +done
   4.293 +
   4.294 +lemma (in AC16) in_s_imp_u_in: "v \<in> s(u) ==> u \<in> v"
   4.295 +by (unfold s_def, blast)
   4.296 +
   4.297 +
   4.298 +lemma (in AC16) ex1_superset_a:
   4.299 +     "[| l \<approx> a;  a \<subseteq> y;  b \<in> y - a;  u \<in> x |]   
   4.300 +      ==> \<exists>! c. c \<in> s(u) & a \<subseteq> c & b \<in> c"
   4.301 +apply (rule all_ex [simplified k_def, THEN ballE])
   4.302 + apply (erule ex1E)
   4.303 + apply (rule_tac a = "w" in ex1I, blast intro: sI)
   4.304 + apply (blast dest: s_subset [THEN subsetD] in_s_imp_u_in)
   4.305 +apply (blast del: PowI 
   4.306 +             intro!: cons_cons_subset eqpoll_sym [THEN cons_cons_eqpoll])
   4.307 +done
   4.308 +
   4.309 +lemma (in AC16) the_eq_cons:
   4.310 +     "[| \<forall>v \<in> s(u). succ(l) \<approx> v Int y;   
   4.311 +         l \<approx> a;  a \<subseteq> y;  b \<in> y - a;  u \<in> x |]    
   4.312 +      ==> (THE c. c \<in> s(u) & a \<subseteq> c & b \<in> c) Int y = cons(b, a)"
   4.313 +apply (frule ex1_superset_a [THEN theI], assumption+)
   4.314 +apply (rule set_eq_cons)
   4.315 +apply (fast+)
   4.316 +done
   4.317 +
   4.318 +lemma (in AC16) y_lepoll_subset_s:
   4.319 +     "[| \<forall>v \<in> s(u). succ(l) \<approx> v Int y;   
   4.320 +         l \<approx> a;  a \<subseteq> y;  u \<in> x |]   
   4.321 +      ==> y \<lesssim> {v \<in> s(u). a \<subseteq> v}"
   4.322 +apply (rule Diff_Finite_eqpoll [THEN eqpoll_sym, THEN eqpoll_imp_lepoll, 
   4.323 +                                THEN lepoll_trans],  fast+)
   4.324 +apply (rule_tac  f3 = "\<lambda>b \<in> y-a. THE c. c \<in> s (u) & a \<subseteq> c & b \<in> c" 
   4.325 +        in exI [THEN lepoll_def [THEN def_imp_iff, THEN iffD2]])
   4.326 +apply (simp add: inj_def)
   4.327 +apply (rule conjI)
   4.328 +apply (rule lam_type)
   4.329 +apply (frule ex1_superset_a [THEN theI], fast+, clarify)
   4.330 +apply (rule cons_eqE [of _ a])
   4.331 +apply (drule_tac A = "THE c. ?P (c) " and C = "y" in eq_imp_Int_eq)
   4.332 +apply (simp_all add: the_eq_cons)
   4.333 +done
   4.334 +
   4.335 +
   4.336 +(* ********************************************************************** *)
   4.337 +(* back to the second part                                                *)
   4.338 +(* ********************************************************************** *)
   4.339 +
   4.340 +
   4.341 +(*relies on the disjointness of x, y*)
   4.342 +lemma (in AC16) x_imp_not_y [dest]: "a \<in> x ==> a \<notin> y"
   4.343 +by (blast dest:  disjoint [THEN equalityD1, THEN subsetD, OF IntI])
   4.344 +
   4.345 +lemma (in AC16) w_Int_eq_w_Diff:
   4.346 +     "w \<subseteq> x Un y ==> w Int (x - {u}) = w - cons(u, w Int y)" 
   4.347 +by blast
   4.348 +
   4.349 +lemma (in AC16) w_Int_eqpoll_m:
   4.350 +     "[| w \<in> {v \<in> s(u). a \<subseteq> v};   
   4.351 +         l \<approx> a;  u \<in> x;   
   4.352 +         \<forall>v \<in> s(u). succ(l) \<approx> v Int y |] 
   4.353 +      ==> w Int (x - {u}) \<approx> m"
   4.354 +apply (erule CollectE)
   4.355 +apply (subst w_Int_eq_w_Diff)
   4.356 +apply (fast dest!: s_subset [THEN subsetD] 
   4.357 +                   includes [simplified k_def, THEN subsetD])
   4.358 +apply (blast dest: s_subset [THEN subsetD] 
   4.359 +                   includes [simplified k_def, THEN subsetD] 
   4.360 +             dest: eqpoll_sym [THEN cons_eqpoll_succ, THEN eqpoll_sym] 
   4.361 +                   in_s_imp_u_in
   4.362 +            intro!: eqpoll_sum_imp_Diff_eqpoll)
   4.363 +done
   4.364 +
   4.365 +
   4.366 +(* ********************************************************************** *)
   4.367 +(*   2. {v \<in> s(u). a \<subseteq> v} is less than or equipollent                       *)
   4.368 +(*      to {v \<in> Pow(x). v \<approx> n-k}                                       *)
   4.369 +(* ********************************************************************** *)
   4.370 +
   4.371 +lemma (in AC16) eqpoll_m_not_empty: "a \<approx> m ==> a \<noteq> 0"
   4.372 +apply (insert mpos)
   4.373 +apply (fast elim!: zero_lt_natE dest!: eqpoll_succ_imp_not_empty)
   4.374 +done
   4.375 +
   4.376 +lemma (in AC16) cons_cons_in:
   4.377 +     "[| z \<in> xa Int (x - {u}); l \<approx> a; a \<subseteq> y; u \<in> x |]   
   4.378 +      ==> \<exists>! w. w \<in> t_n & cons(z, cons(u, a)) \<subseteq> w"
   4.379 +apply (rule all_ex [THEN bspec])
   4.380 +apply (unfold k_def)
   4.381 +apply (fast intro!: cons_eqpoll_succ elim: eqpoll_sym)
   4.382 +done
   4.383 +
   4.384 +lemma (in AC16) subset_s_lepoll_w:
   4.385 +     "[| \<forall>v \<in> s(u). succ(l) \<approx> v Int y; a \<subseteq> y; l \<approx> a; u \<in> x |]   
   4.386 +      ==> {v \<in> s(u). a \<subseteq> v} \<lesssim> {v \<in> Pow(x). v \<approx> m}"
   4.387 +apply (rule_tac f3 = "\<lambda>w \<in> {v \<in> s (u) . a \<subseteq> v}. w Int (x - {u})" 
   4.388 +       in exI [THEN lepoll_def [THEN def_imp_iff, THEN iffD2]])
   4.389 +apply (simp add: inj_def)
   4.390 +apply (intro conjI lam_type CollectI)
   4.391 +  apply fast
   4.392 + apply (blast intro: w_Int_eqpoll_m) 
   4.393 +apply (intro ballI impI)
   4.394 +(** LEVEL 8 **)
   4.395 +apply (rule w_Int_eqpoll_m [THEN eqpoll_m_not_empty, THEN not_emptyE])
   4.396 +apply (blast, assumption+)
   4.397 +apply (drule equalityD1 [THEN subsetD], (assumption))
   4.398 +apply (frule cons_cons_in, assumption+)
   4.399 +apply (blast dest: ex1_two_eq intro: s_subset [THEN subsetD] in_s_imp_u_in)+
   4.400 +done
   4.401 +
   4.402 +
   4.403 +(* ********************************************************************** *)
   4.404 +(* well_ord_subsets_lepoll_n                                              *)
   4.405 +(* ********************************************************************** *)
   4.406 +
   4.407 +lemma (in AC16) well_ord_subsets_eqpoll_n:
   4.408 +     "n \<in> nat ==> \<exists>S. well_ord({z \<in> Pow(y) . z \<approx> succ(n)}, S)"
   4.409 +apply (rule WO_R [THEN well_ord_infinite_subsets_eqpoll_X,
   4.410 +                  THEN eqpoll_def [THEN def_imp_iff, THEN iffD1], THEN exE])
   4.411 +apply (fast intro: bij_is_inj [THEN well_ord_rvimage])+
   4.412 +done
   4.413 +
   4.414 +lemma (in AC16) well_ord_subsets_lepoll_n:
   4.415 +     "n \<in> nat ==> \<exists>R. well_ord({z \<in> Pow(y). z \<lesssim> n}, R)"
   4.416 +apply (induct_tac "n")
   4.417 +apply (force intro!: well_ord_unit simp add: subsets_lepoll_0_eq_unit)
   4.418 +apply (erule exE)
   4.419 +apply (rule well_ord_subsets_eqpoll_n [THEN exE], assumption)
   4.420 +apply (simp add: subsets_lepoll_succ)
   4.421 +apply (drule well_ord_radd, (assumption))
   4.422 +apply (erule Int_empty [THEN disj_Un_eqpoll_sum,
   4.423 +                  THEN eqpoll_def [THEN def_imp_iff, THEN iffD1], THEN exE])
   4.424 +apply (fast elim!: bij_is_inj [THEN well_ord_rvimage])
   4.425 +done
   4.426 +
   4.427 +
   4.428 +lemma (in AC16) LL_subset: "LL \<subseteq> {z \<in> Pow(y). z \<lesssim> succ(k #+ m)}"
   4.429 +apply (unfold LL_def MM_def)
   4.430 +apply (insert includes)
   4.431 +apply (blast intro: subset_imp_lepoll eqpoll_imp_lepoll lepoll_trans)
   4.432 +done
   4.433 +
   4.434 +lemma (in AC16) well_ord_LL: "\<exists>S. well_ord(LL,S)"
   4.435 +apply (rule well_ord_subsets_lepoll_n [THEN exE, of "succ(k#+m)"])
   4.436 +apply simp 
   4.437 +apply (blast intro: well_ord_subset [OF _ LL_subset])
   4.438 +done
   4.439 +
   4.440 +(* ********************************************************************** *)
   4.441 +(* every element of LL is a contained in exactly one element of MM        *)
   4.442 +(* ********************************************************************** *)
   4.443 +
   4.444 +lemma (in AC16) unique_superset_in_MM:
   4.445 +     "v \<in> LL ==> \<exists>! w. w \<in> MM & v \<subseteq> w"
   4.446 +apply (unfold MM_def LL_def, safe)
   4.447 +apply fast
   4.448 +apply (rule lepoll_imp_eqpoll_subset [THEN exE], (assumption))
   4.449 +apply (rule_tac x = "x" in all_ex [THEN ballE]) 
   4.450 +apply (blast intro: eqpoll_sym)+
   4.451 +done
   4.452 +
   4.453 +
   4.454 +(* ********************************************************************** *)
   4.455 +(* The function GG satisfies the conditions of WO4                        *)
   4.456 +(* ********************************************************************** *)
   4.457 +
   4.458 +(* ********************************************************************** *)
   4.459 +(* The union of appropriate values is the whole x                         *)
   4.460 +(* ********************************************************************** *)
   4.461 +
   4.462 +lemma (in AC16) Int_in_LL: "w \<in> MM ==> w Int y \<in> LL"
   4.463 +by (unfold LL_def, fast)
   4.464 +
   4.465 +lemma (in AC16) in_LL_eq_Int: 
   4.466 +     "v \<in> LL ==> v = (THE x. x \<in> MM & v \<subseteq> x) Int y"
   4.467 +apply (unfold LL_def, clarify)
   4.468 +apply (subst unique_superset_in_MM [THEN the_equality2])
   4.469 +apply (auto simp add: Int_in_LL)
   4.470 +done
   4.471 +
   4.472 +lemma (in AC16) unique_superset1: "a \<in> LL \<Longrightarrow> (THE x. x \<in> MM \<and> a \<subseteq> x) \<in> MM"
   4.473 +by (erule unique_superset_in_MM [THEN theI, THEN conjunct1]); 
   4.474 +
   4.475 +lemma (in AC16) the_in_MM_subset:
   4.476 +     "v \<in> LL ==> (THE x. x \<in> MM & v \<subseteq> x) \<subseteq> x Un y"
   4.477 +apply (drule unique_superset1)
   4.478 +apply (unfold MM_def)
   4.479 +apply (fast dest!: unique_superset1 includes [THEN subsetD])
   4.480 +done
   4.481 +
   4.482 +lemma (in AC16) GG_subset: "v \<in> LL ==> GG ` v \<subseteq> x"
   4.483 +apply (unfold GG_def)
   4.484 +apply (frule the_in_MM_subset)
   4.485 +apply (frule in_LL_eq_Int)
   4.486 +apply (force elim: equalityE)
   4.487 +done
   4.488 +
   4.489 +lemma (in AC16) nat_lepoll_ordertype: "nat \<lesssim> ordertype(y, R)"
   4.490 +apply (rule nat_le_infinite_Ord [THEN le_imp_lepoll]) 
   4.491 + apply (rule Ord_ordertype [OF WO_R]) 
   4.492 +apply (rule ordertype_eqpoll [THEN eqpoll_imp_lepoll, THEN lepoll_infinite]) 
   4.493 + apply (rule WO_R) 
   4.494 +apply (rule Infinite) 
   4.495 +done
   4.496 +
   4.497 +lemma (in AC16) ex_subset_eqpoll_n: "n \<in> nat ==> \<exists>z. z \<subseteq> y & n \<approx> z"
   4.498 +apply (erule nat_lepoll_imp_ex_eqpoll_n)
   4.499 +apply (rule lepoll_trans [OF nat_lepoll_ordertype]) 
   4.500 +apply (rule ordertype_eqpoll [THEN eqpoll_sym, THEN eqpoll_imp_lepoll]) 
   4.501 +apply (rule WO_R) 
   4.502 +done
   4.503 +
   4.504 +
   4.505 +lemma (in AC16) exists_proper_in_s: "u \<in> x ==> \<exists>v \<in> s(u). succ(k) \<lesssim> v Int y"
   4.506 +apply (rule ccontr)
   4.507 +apply (subgoal_tac "\<forall>v \<in> s (u) . k \<approx> v Int y")
   4.508 +prefer 2 apply (simp add: s_def, blast intro: succ_not_lepoll_imp_eqpoll)
   4.509 +apply (unfold k_def)
   4.510 +apply (insert all_ex includes lnat)
   4.511 +apply (rule ex_subset_eqpoll_n [THEN exE], assumption)
   4.512 +apply (rule noLepoll [THEN notE])
   4.513 +apply (blast intro: lepoll_trans [OF y_lepoll_subset_s subset_s_lepoll_w])
   4.514 +done
   4.515 +
   4.516 +lemma (in AC16) exists_in_MM: "u \<in> x ==> \<exists>w \<in> MM. u \<in> w"
   4.517 +apply (erule exists_proper_in_s [THEN bexE])
   4.518 +apply (unfold MM_def s_def, fast)
   4.519 +done
   4.520 +
   4.521 +lemma (in AC16) exists_in_LL: "u \<in> x ==> \<exists>w \<in> LL. u \<in> GG`w"
   4.522 +apply (rule exists_in_MM [THEN bexE], assumption)
   4.523 +apply (rule bexI)
   4.524 +apply (erule_tac [2] Int_in_LL)
   4.525 +apply (unfold GG_def)
   4.526 +apply (simp add: Int_in_LL)
   4.527 +apply (subst unique_superset_in_MM [THEN the_equality2])
   4.528 +apply (fast elim!: Int_in_LL)+
   4.529 +done
   4.530 +
   4.531 +lemma (in AC16) OUN_eq_x: "well_ord(LL,S) ==>       
   4.532 +      (\<Union>b<ordertype(LL,S). GG ` (converse(ordermap(LL,S)) ` b)) = x"
   4.533 +apply (rule equalityI)
   4.534 +apply (rule subsetI)
   4.535 +apply (erule OUN_E)
   4.536 +apply (rule GG_subset [THEN subsetD])
   4.537 +prefer 2 apply assumption
   4.538 +apply (blast intro: ltD  ordermap_bij [THEN bij_converse_bij, THEN bij_is_fun,
   4.539 +                                       THEN apply_type])
   4.540 +apply (rule subsetI)
   4.541 +apply (erule exists_in_LL [THEN bexE])
   4.542 +apply (force intro: ltI [OF _ Ord_ordertype]
   4.543 +                    ordermap_type [THEN apply_type]
   4.544 +             simp add: ordermap_bij [THEN bij_is_inj, THEN left_inverse])
   4.545 +done
   4.546 +
   4.547 +(* ********************************************************************** *)
   4.548 +(* Every element of the family is less than or equipollent to n-k (m)     *)
   4.549 +(* ********************************************************************** *)
   4.550 +
   4.551 +lemma (in AC16) in_MM_eqpoll_n: "w \<in> MM ==> w \<approx> succ(k #+ m)"
   4.552 +apply (unfold MM_def)
   4.553 +apply (fast dest: includes [THEN subsetD])
   4.554 +done
   4.555 +
   4.556 +lemma (in AC16) in_LL_eqpoll_n: "w \<in> LL ==> succ(k) \<lesssim> w"
   4.557 +by (unfold LL_def MM_def, fast)
   4.558 +
   4.559 +lemma (in AC16) in_LL: "w \<in> LL ==> w \<subseteq> (THE x. x \<in> MM \<and> w \<subseteq> x)"
   4.560 +by (erule subset_trans [OF in_LL_eq_Int [THEN equalityD1] Int_lower1])
   4.561 +
   4.562 +lemma (in AC16) all_in_lepoll_m: 
   4.563 +      "well_ord(LL,S) ==>       
   4.564 +       \<forall>b<ordertype(LL,S). GG ` (converse(ordermap(LL,S)) ` b) \<lesssim> m"
   4.565 +apply (unfold GG_def)
   4.566 +apply (rule oallI)
   4.567 +apply (simp add: ltD ordermap_bij [THEN bij_converse_bij, THEN bij_is_fun, THEN apply_type])
   4.568 +apply (insert includes)
   4.569 +apply (rule eqpoll_sum_imp_Diff_lepoll)
   4.570 +apply (blast del: subsetI
   4.571 +	     dest!: ltD 
   4.572 +	     intro!: eqpoll_sum_imp_Diff_lepoll in_LL_eqpoll_n
   4.573 +	     intro: in_LL   unique_superset1 [THEN in_MM_eqpoll_n] 
   4.574 +                    ordermap_bij [THEN bij_converse_bij, THEN bij_is_fun, 
   4.575 +                                  THEN apply_type])+
   4.576 +done
   4.577 +
   4.578 +lemma (in AC16) conclusion:
   4.579 +     "\<exists>a f. Ord(a) & domain(f) = a & (\<Union>b<a. f ` b) = x & (\<forall>b<a. f ` b \<lesssim> m)"
   4.580 +apply (rule well_ord_LL [THEN exE])
   4.581 +apply (rename_tac S)
   4.582 +apply (rule_tac x = "ordertype (LL,S)" in exI)
   4.583 +apply (rule_tac x = "\<lambda>b \<in> ordertype(LL,S). 
   4.584 +                      GG ` (converse (ordermap (LL,S)) ` b)"  in exI)
   4.585 +apply simp
   4.586 +apply (blast intro: lam_funtype [THEN domain_of_fun] 
   4.587 +                    Ord_ordertype  OUN_eq_x  all_in_lepoll_m [THEN ospec])
   4.588 +done
   4.589 +
   4.590 +
   4.591 +(* ********************************************************************** *)
   4.592 +(* The main theorem AC16(n, k) ==> WO4(n-k)                               *)
   4.593 +(* ********************************************************************** *)
   4.594 +
   4.595 +theorem AC16_WO4: 
   4.596 +     "[| AC16(k #+ m, k); 0 < k; 0 < m; k \<in> nat; m \<in> nat |] ==> WO4(m)"
   4.597 +apply (unfold AC16_def WO4_def)
   4.598 +apply (rule allI)
   4.599 +apply (case_tac "Finite (A)")
   4.600 +apply (rule lemma1, assumption+)
   4.601 +apply (cut_tac lemma2)
   4.602 +apply (elim exE conjE)
   4.603 +apply (erule_tac x = "A Un y" in allE)
   4.604 +apply (frule infinite_Un, drule mp, assumption)
   4.605 +apply (erule zero_lt_natE, assumption, clarify)
   4.606 +apply (blast intro: AC16.conclusion) 
   4.607 +done
   4.608  
   4.609  end
     5.1 --- a/src/ZF/AC/AC16_lemmas.ML	Wed Jan 16 15:04:37 2002 +0100
     5.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     5.3 @@ -1,275 +0,0 @@
     5.4 -(*  Title:      ZF/AC/AC16_lemmas.ML
     5.5 -    ID:         $Id$
     5.6 -    Author:     Krzysztof Grabczewski
     5.7 -
     5.8 -Lemmas used in the proofs concerning AC16
     5.9 -*)
    5.10 -
    5.11 -Goal "a\\<notin>A ==> cons(a,A)-{a}=A";
    5.12 -by (Fast_tac 1);
    5.13 -qed "cons_Diff_eq";
    5.14 -
    5.15 -Goalw [lepoll_def] "1 lepoll X <-> (\\<exists>x. x \\<in> X)";
    5.16 -by (rtac iffI 1);
    5.17 -by (fast_tac (claset() addIs [inj_is_fun RS apply_type]) 1);
    5.18 -by (etac exE 1);
    5.19 -by (res_inst_tac [("x","\\<lambda>a \\<in> 1. x")] exI 1);
    5.20 -by (fast_tac (claset() addSIs [lam_injective]) 1);
    5.21 -qed "nat_1_lepoll_iff";
    5.22 -
    5.23 -Goal "X eqpoll 1 <-> (\\<exists>x. X={x})";
    5.24 -by (rtac iffI 1);
    5.25 -by (etac eqpollE 1);
    5.26 -by (dresolve_tac [nat_1_lepoll_iff RS iffD1] 1);
    5.27 -by (fast_tac (claset() addSIs [lepoll_1_is_sing]) 1);
    5.28 -by (fast_tac (claset() addSIs [singleton_eqpoll_1]) 1);
    5.29 -qed "eqpoll_1_iff_singleton";
    5.30 -
    5.31 -Goalw [succ_def] "[| x eqpoll n; y\\<notin>x |] ==> cons(y,x) eqpoll succ(n)";
    5.32 -by (fast_tac (claset() addSEs [cons_eqpoll_cong, mem_irrefl]) 1);
    5.33 -qed "cons_eqpoll_succ";
    5.34 -
    5.35 -Goal "{Y \\<in> Pow(X). Y eqpoll 1} = {{x}. x \\<in> X}";
    5.36 -by (rtac equalityI 1);
    5.37 -by (rtac subsetI 1);
    5.38 -by (etac CollectE 1);
    5.39 -by (dresolve_tac [eqpoll_1_iff_singleton RS iffD1] 1);
    5.40 -by (fast_tac (claset() addSIs [RepFunI]) 1);
    5.41 -by (rtac subsetI 1);
    5.42 -by (etac RepFunE 1);
    5.43 -by (rtac CollectI 1);
    5.44 -by (Fast_tac 1);
    5.45 -by (fast_tac (claset() addSIs [singleton_eqpoll_1]) 1);
    5.46 -qed "subsets_eqpoll_1_eq";
    5.47 -
    5.48 -Goalw [eqpoll_def, bij_def] "X eqpoll {{x}. x \\<in> X}";
    5.49 -by (res_inst_tac [("x","\\<lambda>x \\<in> X. {x}")] exI 1);
    5.50 -by (rtac IntI 1);
    5.51 -by (rewrite_goals_tac [inj_def, surj_def]);
    5.52 -by (Asm_full_simp_tac 1);
    5.53 -by (fast_tac (claset() addSIs [lam_type, RepFunI] 
    5.54 -                addIs [singleton_eq_iff RS iffD1]) 1);
    5.55 -by (Asm_full_simp_tac 1);
    5.56 -by (fast_tac (claset() addSIs [lam_type]) 1);
    5.57 -qed "eqpoll_RepFun_sing";
    5.58 -
    5.59 -Goal "{Y \\<in> Pow(X). Y eqpoll 1} eqpoll X";
    5.60 -by (resolve_tac [subsets_eqpoll_1_eq RS ssubst] 1);
    5.61 -by (resolve_tac [eqpoll_RepFun_sing RS eqpoll_sym] 1);
    5.62 -qed "subsets_eqpoll_1_eqpoll";
    5.63 -
    5.64 -Goal "[| InfCard(x); y \\<in> Pow(x); y eqpoll succ(z) |]  \
    5.65 -\               ==> (LEAST i. i \\<in> y) \\<in> y";
    5.66 -by (eresolve_tac [eqpoll_sym RS eqpoll_imp_lepoll RS 
    5.67 -                succ_lepoll_imp_not_empty RS not_emptyE] 1);
    5.68 -by (fast_tac (claset() addIs [LeastI]
    5.69 -        addSDs [InfCard_is_Card RS Card_is_Ord, PowD RS subsetD]
    5.70 -        addEs [Ord_in_Ord]) 1);
    5.71 -qed "InfCard_Least_in";
    5.72 -
    5.73 -Goalw [lepoll_def] "[| InfCard(x); n \\<in> nat |] ==>  \
    5.74 -\       {y \\<in> Pow(x). y eqpoll succ(succ(n))} lepoll  \
    5.75 -\       x*{y \\<in> Pow(x). y eqpoll succ(n)}";
    5.76 -by (res_inst_tac [("x","\\<lambda>y \\<in> {y \\<in> Pow(x). y eqpoll succ(succ(n))}. \
    5.77 -\               <LEAST i. i \\<in> y, y-{LEAST i. i \\<in> y}>")] exI 1);
    5.78 -by (res_inst_tac [("d","%z. cons(fst(z),snd(z))")] lam_injective 1);
    5.79 -by (rtac SigmaI 1);
    5.80 -by (etac CollectE 1);
    5.81 -by (Asm_full_simp_tac 3);
    5.82 -by (rtac equalityI 3);
    5.83 -by (Fast_tac 4);
    5.84 -by (rtac subsetI 3);
    5.85 -by (etac consE 3);
    5.86 -by (Fast_tac 4);
    5.87 -by (rtac CollectI 2);
    5.88 -by (Fast_tac 2);
    5.89 -by (resolve_tac [PowD RS subsetD] 1 THEN (assume_tac 1));
    5.90 -by (REPEAT (fast_tac (claset() addSIs [Diff_sing_eqpoll]
    5.91 -                addIs [InfCard_Least_in]) 1));
    5.92 -qed "subsets_lepoll_lemma1";
    5.93 -
    5.94 -val prems = goal thy "(!!y. y \\<in> z ==> Ord(y)) ==> z \\<subseteq> succ(Union(z))";
    5.95 -by (rtac subsetI 1);
    5.96 -by (res_inst_tac [("Q","\\<forall>y \\<in> z. y \\<subseteq> x")] (excluded_middle RS disjE) 1);
    5.97 -by (Fast_tac 2);
    5.98 -by (etac swap 1);
    5.99 -by (rtac ballI 1);
   5.100 -by (rtac Ord_linear_le 1);
   5.101 -by (dtac le_imp_subset 3 THEN (assume_tac 3));
   5.102 -by (fast_tac (claset() addDs prems) 1);
   5.103 -by (fast_tac (claset() addDs prems) 1);
   5.104 -by (fast_tac (claset() addSEs [leE,ltE]) 1);
   5.105 -qed "set_of_Ord_succ_Union";
   5.106 -
   5.107 -Goal "j \\<subseteq> i ==> i \\<notin> j";
   5.108 -by (fast_tac (claset() addSEs [mem_irrefl]) 1);
   5.109 -qed "subset_not_mem";
   5.110 -
   5.111 -val prems = goal thy "(!!y. y \\<in> z ==> Ord(y)) ==> succ(Union(z)) \\<notin> z";
   5.112 -by (resolve_tac [set_of_Ord_succ_Union RS subset_not_mem] 1);
   5.113 -by (eresolve_tac prems 1);
   5.114 -qed "succ_Union_not_mem";
   5.115 -
   5.116 -Goal "Union(cons(succ(Union(z)),z)) = succ(Union(z))";
   5.117 -by (Fast_tac 1);
   5.118 -qed "Union_cons_eq_succ_Union";
   5.119 -
   5.120 -Goal "[| Ord(i); Ord(j) |] ==> i Un j = i | i Un j = j";
   5.121 -by (fast_tac (claset() addSDs [le_imp_subset] addEs [Ord_linear_le]) 1);
   5.122 -qed "Un_Ord_disj";
   5.123 -
   5.124 -Goal "x \\<in> X ==> Union(X) = x Un Union(X-{x})";
   5.125 -by (Fast_tac 1);
   5.126 -qed "Union_eq_Un";
   5.127 -
   5.128 -Goal "n \\<in> nat ==>  \
   5.129 -\       \\<forall>z. (\\<forall>y \\<in> z. Ord(y)) & z eqpoll n & z\\<noteq>0 --> Union(z) \\<in> z";
   5.130 -by (induct_tac "n" 1);
   5.131 -by (fast_tac (claset() addSDs [eqpoll_imp_lepoll RS lepoll_0_is_0]) 1);
   5.132 -by (REPEAT (resolve_tac [allI, impI] 1));
   5.133 -by (etac natE 1);
   5.134 -by (fast_tac (claset() addSDs [eqpoll_1_iff_singleton RS iffD1]
   5.135 -        addSIs [Union_singleton]) 1);
   5.136 -by (hyp_subst_tac 1);
   5.137 -by (REPEAT (eresolve_tac [conjE, not_emptyE] 1));
   5.138 -by (eres_inst_tac [("x","z-{xb}")] allE 1);
   5.139 -by (etac impE 1);
   5.140 -by (fast_tac (claset() addSEs [Diff_sing_eqpoll,
   5.141 -                Diff_sing_eqpoll RS eqpoll_succ_imp_not_empty]) 1);
   5.142 -by (resolve_tac [Union_eq_Un RSN (2, subst_elem)] 1 THEN (assume_tac 2));
   5.143 -by (ftac bspec 1 THEN (assume_tac 1));
   5.144 -by (dresolve_tac [Diff_subset RS subsetD RSN (2, bspec)] 1 THEN (assume_tac 1));
   5.145 -by (dtac Un_Ord_disj 1 THEN (assume_tac 1));
   5.146 -by (etac DiffE 1);
   5.147 -by (etac disjE 1);
   5.148 -by (etac subst_elem 1 THEN (assume_tac 1));
   5.149 -by (rtac subst_elem 1 THEN (TRYALL assume_tac));
   5.150 -qed "Union_in_lemma";
   5.151 -
   5.152 -Goal "[| \\<forall>x \\<in> z. Ord(x); z eqpoll n; z\\<noteq>0; n \\<in> nat |]  \
   5.153 -\               ==> Union(z) \\<in> z";
   5.154 -by (dtac Union_in_lemma 1);
   5.155 -by (fast_tac FOL_cs 1);
   5.156 -qed "Union_in";
   5.157 -
   5.158 -Goal "[| InfCard(x); z \\<in> Pow(x); z eqpoll n; n \\<in> nat |]  \
   5.159 -\               ==> succ(Union(z)) \\<in> x";
   5.160 -by (resolve_tac [Limit_has_succ RS ltE] 1 THEN (assume_tac 3));
   5.161 -by (etac InfCard_is_Limit 1);
   5.162 -by (excluded_middle_tac "z=0" 1);
   5.163 -by (fast_tac (claset() addSIs [InfCard_is_Limit RS Limit_has_0]
   5.164 -                      addss (simpset())) 2);
   5.165 -by (resolve_tac
   5.166 -        [PowD RS subsetD RS (InfCard_is_Card RS Card_is_Ord RSN (2, ltI))] 1
   5.167 -        THEN (TRYALL assume_tac));
   5.168 -by (fast_tac (claset() addSIs [Union_in]
   5.169 -                      addSEs [PowD RS subsetD RSN 
   5.170 -		 (2, InfCard_is_Card RS Card_is_Ord RS Ord_in_Ord)]) 1);
   5.171 -qed "succ_Union_in_x";
   5.172 -
   5.173 -Goalw [lepoll_def] "[| InfCard(x); n \\<in> nat |] ==>  \
   5.174 -\       {y \\<in> Pow(x). y eqpoll succ(n)} lepoll  \
   5.175 -\       {y \\<in> Pow(x). y eqpoll succ(succ(n))}";
   5.176 -by (res_inst_tac [("x","\\<lambda>z \\<in> {y \\<in> Pow(x). y eqpoll succ(n)}.  \
   5.177 -\       cons(succ(Union(z)), z)")] exI 1);
   5.178 -by (res_inst_tac [("d","%z. z-{Union(z)}")] lam_injective 1);
   5.179 -by (resolve_tac [Union_cons_eq_succ_Union RS ssubst] 2);
   5.180 -by (rtac cons_Diff_eq 2);
   5.181 -by (fast_tac (claset() addSDs [InfCard_is_Card RS Card_is_Ord]
   5.182 -        addEs [Ord_in_Ord] addSIs [succ_Union_not_mem]) 2);
   5.183 -by (rtac CollectI 1);
   5.184 -by (fast_tac (claset() addSEs [cons_eqpoll_succ] 
   5.185 -                    addSIs [succ_Union_not_mem] 
   5.186 -                    addSDs [InfCard_is_Card RS Card_is_Ord] 
   5.187 -                    addEs  [Ord_in_Ord]) 2);
   5.188 -by (fast_tac (claset() addSIs [succ_Union_in_x]) 1);
   5.189 -qed "succ_lepoll_succ_succ";
   5.190 -
   5.191 -Goal "[| InfCard(X); n \\<in> nat |]  \
   5.192 -\       ==> {Y \\<in> Pow(X). Y eqpoll succ(n)} eqpoll X";
   5.193 -by (induct_tac "n" 1);
   5.194 -by (rtac subsets_eqpoll_1_eqpoll 1);
   5.195 -by (rtac eqpollI 1);
   5.196 -by (resolve_tac [subsets_lepoll_lemma1 RS lepoll_trans] 1 
   5.197 -        THEN (REPEAT (assume_tac 1)));
   5.198 -by (resolve_tac [InfCard_is_Card RS Card_is_Ord RS well_ord_Memrel RS
   5.199 -                well_ord_InfCard_square_eq RS eqpoll_imp_lepoll
   5.200 -                RSN (2, lepoll_trans)] 1 THEN (assume_tac 2));
   5.201 -by (resolve_tac [InfCard_is_Card RS Card_cardinal_eq RS ssubst] 2 
   5.202 -        THEN (REPEAT (assume_tac 2)));
   5.203 -by (eresolve_tac [eqpoll_refl RS prod_eqpoll_cong RS eqpoll_imp_lepoll] 1);
   5.204 -by (fast_tac (claset() addEs [eqpoll_sym RS eqpoll_imp_lepoll RS lepoll_trans]
   5.205 -        addSIs [succ_lepoll_succ_succ]) 1);
   5.206 -qed "subsets_eqpoll_X";
   5.207 -
   5.208 -Goalw [surj_def] "[| f \\<in> surj(A,B); y \\<subseteq> B |]  \
   5.209 -\       ==> f``(converse(f)``y) = y";
   5.210 -by (fast_tac (claset() addDs [apply_equality2]
   5.211 -	              addEs [apply_iff RS iffD2]) 1);
   5.212 -qed "image_vimage_eq";
   5.213 -
   5.214 -Goal "[| f \\<in> inj(A,B); y \\<subseteq> A |] ==> converse(f)``(f``y) = y";
   5.215 -by (fast_tac (claset() addSEs [inj_is_fun RS apply_Pair]
   5.216 -                addDs [inj_equality]) 1);
   5.217 -qed "vimage_image_eq";
   5.218 -
   5.219 -Goalw [eqpoll_def] "A eqpoll B  \
   5.220 -\       ==> {Y \\<in> Pow(A). Y eqpoll n} eqpoll {Y \\<in> Pow(B). Y eqpoll n}";
   5.221 -by (etac exE 1);
   5.222 -by (res_inst_tac [("x","\\<lambda>X \\<in> {Y \\<in> Pow(A). \\<exists>f. f \\<in> bij(Y, n)}. f``X")] exI 1);
   5.223 -by (res_inst_tac [("d","%Z. converse(f)``Z")] lam_bijective 1);
   5.224 -by (fast_tac (claset()
   5.225 -        addSIs [bij_is_inj RS restrict_bij RS bij_converse_bij RS comp_bij] 
   5.226 -        addSEs [bij_is_fun RS fun_is_rel RS image_subset RS PowI]) 1);
   5.227 -by (fast_tac (claset() addSIs [bij_converse_bij RS bij_is_inj RS restrict_bij
   5.228 -                        RS bij_converse_bij RS comp_bij] 
   5.229 -                    addSEs [bij_converse_bij RS bij_is_fun RS fun_is_rel
   5.230 -                        RS image_subset RS PowI]) 1);
   5.231 -by (fast_tac (claset() addSEs [bij_is_inj RS vimage_image_eq]) 1);
   5.232 -by (fast_tac (claset() addSEs [bij_is_surj RS image_vimage_eq]) 1);
   5.233 -qed "subsets_eqpoll";
   5.234 -
   5.235 -Goalw [WO2_def] "WO2 ==> \\<exists>a. Card(a) & X eqpoll a";
   5.236 -by (REPEAT (eresolve_tac [allE,exE,conjE] 1));
   5.237 -by (fast_tac (claset() addSEs [well_ord_Memrel RS well_ord_cardinal_eqpoll RS
   5.238 -                (eqpoll_sym RSN (2, eqpoll_trans)) RS eqpoll_sym]
   5.239 -                addSIs [Card_cardinal]) 1);
   5.240 -qed "WO2_imp_ex_Card";
   5.241 -
   5.242 -Goal "[| X lepoll Y; ~Finite(X) |] ==> ~Finite(Y)";
   5.243 -by (fast_tac (empty_cs addEs [notE, lepoll_Finite] addSIs [notI]) 1); 
   5.244 -qed "lepoll_infinite";
   5.245 -
   5.246 -Goalw [InfCard_def] "[| ~Finite(X); Card(X) |] ==> InfCard(X)";
   5.247 -by (fast_tac (claset() addSEs [Card_is_Ord RS nat_le_infinite_Ord]) 1);
   5.248 -qed "infinite_Card_is_InfCard";
   5.249 -
   5.250 -Goal "[| WO2; n \\<in> nat; ~Finite(X) |]  \
   5.251 -\       ==> {Y \\<in> Pow(X). Y eqpoll succ(n)} eqpoll X";
   5.252 -by (dtac WO2_imp_ex_Card 1);
   5.253 -by (REPEAT (eresolve_tac [allE,exE,conjE] 1));
   5.254 -by (forward_tac [eqpoll_imp_lepoll RS lepoll_infinite] 1 THEN (assume_tac 1));
   5.255 -by (dtac infinite_Card_is_InfCard 1 THEN (assume_tac 1));
   5.256 -by (resolve_tac [eqpoll_trans RS eqpoll_trans] 1);
   5.257 -by (etac subsets_eqpoll 1);
   5.258 -by (etac subsets_eqpoll_X 1 THEN (assume_tac 1));
   5.259 -by (etac eqpoll_sym 1);
   5.260 -qed "WO2_infinite_subsets_eqpoll_X";
   5.261 -
   5.262 -Goal "well_ord(X,R) ==> \\<exists>a. Card(a) & X eqpoll a";
   5.263 -by (fast_tac (claset() addSEs [well_ord_cardinal_eqpoll RS eqpoll_sym]
   5.264 -                addSIs [Card_cardinal]) 1);
   5.265 -qed "well_ord_imp_ex_Card";
   5.266 -
   5.267 -Goal "[| well_ord(X,R); n \\<in> nat; ~Finite(X) |]  \
   5.268 -\               ==> {Y \\<in> Pow(X). Y eqpoll succ(n)} eqpoll X";
   5.269 -by (dtac well_ord_imp_ex_Card 1);
   5.270 -by (REPEAT (eresolve_tac [allE,exE,conjE] 1));
   5.271 -by (forward_tac [eqpoll_imp_lepoll RS lepoll_infinite] 1 THEN (assume_tac 1));
   5.272 -by (dtac infinite_Card_is_InfCard 1 THEN (assume_tac 1));
   5.273 -by (resolve_tac [eqpoll_trans RS eqpoll_trans] 1);
   5.274 -by (etac subsets_eqpoll 1);
   5.275 -by (etac subsets_eqpoll_X 1 THEN (assume_tac 1));
   5.276 -by (etac eqpoll_sym 1);
   5.277 -qed "well_ord_infinite_subsets_eqpoll_X";
   5.278 -
     6.1 --- a/src/ZF/AC/AC16_lemmas.thy	Wed Jan 16 15:04:37 2002 +0100
     6.2 +++ b/src/ZF/AC/AC16_lemmas.thy	Wed Jan 16 17:52:06 2002 +0100
     6.3 @@ -1,3 +1,244 @@
     6.4 -(*Dummy theory to document dependencies *)
     6.5 +(*  Title:      ZF/AC/AC16_lemmas.thy
     6.6 +    ID:         $Id$
     6.7 +    Author:     Krzysztof Grabczewski
     6.8 +
     6.9 +Lemmas used in the proofs concerning AC16
    6.10 +*)
    6.11 +
    6.12 +theory AC16_lemmas = AC_Equiv + Hartog + Cardinal_aux:
    6.13 +
    6.14 +lemma cons_Diff_eq: "a\<notin>A ==> cons(a,A)-{a}=A"
    6.15 +by fast
    6.16 +
    6.17 +lemma nat_1_lepoll_iff: "1\<lesssim>X <-> (\<exists>x. x \<in> X)"
    6.18 +apply (unfold lepoll_def)
    6.19 +apply (rule iffI)
    6.20 +apply (fast intro: inj_is_fun [THEN apply_type])
    6.21 +apply (erule exE)
    6.22 +apply (rule_tac x = "\<lambda>a \<in> 1. x" in exI)
    6.23 +apply (fast intro!: lam_injective)
    6.24 +done
    6.25 +
    6.26 +lemma eqpoll_1_iff_singleton: "X\<approx>1 <-> (\<exists>x. X={x})"
    6.27 +apply (rule iffI)
    6.28 +apply (erule eqpollE)
    6.29 +apply (drule nat_1_lepoll_iff [THEN iffD1])
    6.30 +apply (fast intro!: lepoll_1_is_sing)
    6.31 +apply (fast intro!: singleton_eqpoll_1)
    6.32 +done
    6.33 +
    6.34 +lemma cons_eqpoll_succ: "[| x\<approx>n; y\<notin>x |] ==> cons(y,x)\<approx>succ(n)"
    6.35 +apply (unfold succ_def)
    6.36 +apply (fast elim!: cons_eqpoll_cong mem_irrefl)
    6.37 +done
    6.38 +
    6.39 +lemma subsets_eqpoll_1_eq: "{Y \<in> Pow(X). Y\<approx>1} = {{x}. x \<in> X}"
    6.40 +apply (rule equalityI)
    6.41 +apply (rule subsetI)
    6.42 +apply (erule CollectE)
    6.43 +apply (drule eqpoll_1_iff_singleton [THEN iffD1])
    6.44 +apply (fast intro!: RepFunI)
    6.45 +apply (rule subsetI)
    6.46 +apply (erule RepFunE)
    6.47 +apply (rule CollectI)
    6.48 +apply fast
    6.49 +apply (fast intro!: singleton_eqpoll_1)
    6.50 +done
    6.51 +
    6.52 +lemma eqpoll_RepFun_sing: "X\<approx>{{x}. x \<in> X}"
    6.53 +apply (unfold eqpoll_def bij_def)
    6.54 +apply (rule_tac x = "\<lambda>x \<in> X. {x}" in exI)
    6.55 +apply (rule IntI)
    6.56 +apply (unfold inj_def surj_def)
    6.57 +apply simp
    6.58 +apply (fast intro!: lam_type RepFunI intro: singleton_eq_iff [THEN iffD1])
    6.59 +apply simp
    6.60 +apply (fast intro!: lam_type)
    6.61 +done
    6.62 +
    6.63 +lemma subsets_eqpoll_1_eqpoll: "{Y \<in> Pow(X). Y\<approx>1}\<approx>X"
    6.64 +apply (rule subsets_eqpoll_1_eq [THEN ssubst])
    6.65 +apply (rule eqpoll_RepFun_sing [THEN eqpoll_sym])
    6.66 +done
    6.67 +
    6.68 +lemma InfCard_Least_in:
    6.69 +     "[| InfCard(x); y \<subseteq> x; y \<approx> succ(z) |] ==> (LEAST i. i \<in> y) \<in> y"
    6.70 +apply (erule eqpoll_sym [THEN eqpoll_imp_lepoll, 
    6.71 +                         THEN succ_lepoll_imp_not_empty, THEN not_emptyE])
    6.72 +apply (fast intro: LeastI 
    6.73 +            dest!: InfCard_is_Card [THEN Card_is_Ord] 
    6.74 +            elim: Ord_in_Ord)
    6.75 +done
    6.76 +
    6.77 +lemma subsets_lepoll_lemma1:
    6.78 +     "[| InfCard(x); n \<in> nat |] 
    6.79 +      ==> {y \<in> Pow(x). y\<approx>succ(succ(n))} \<lesssim> x*{y \<in> Pow(x). y\<approx>succ(n)}"
    6.80 +apply (unfold lepoll_def)
    6.81 +apply (rule_tac x = "\<lambda>y \<in> {y \<in> Pow(x) . y\<approx>succ (succ (n))}. 
    6.82 +                      <LEAST i. i \<in> y, y-{LEAST i. i \<in> y}>" in exI)
    6.83 +apply (rule_tac d = "%z. cons (fst(z), snd(z))" in lam_injective);
    6.84 + apply (blast intro!: Diff_sing_eqpoll intro: InfCard_Least_in);
    6.85 +apply (simp, blast intro: InfCard_Least_in);
    6.86 +done
    6.87 +
    6.88 +lemma set_of_Ord_succ_Union: "(\<forall>y \<in> z. Ord(y)) ==> z \<subseteq> succ(Union(z))"
    6.89 +apply (rule subsetI)
    6.90 +apply (case_tac "\<forall>y \<in> z. y \<subseteq> x", blast );
    6.91 +apply (simp, erule bexE); 
    6.92 +apply (rule_tac i=xa and j=x in Ord_linear_le)
    6.93 +apply (blast dest: le_imp_subset elim: leE ltE)+
    6.94 +done
    6.95 +
    6.96 +lemma subset_not_mem: "j \<subseteq> i ==> i \<notin> j"
    6.97 +by (fast elim!: mem_irrefl)
    6.98 +
    6.99 +lemma succ_Union_not_mem:
   6.100 +     "(!!y. y \<in> z ==> Ord(y)) ==> succ(Union(z)) \<notin> z"
   6.101 +apply (rule set_of_Ord_succ_Union [THEN subset_not_mem]);
   6.102 +apply blast
   6.103 +done
   6.104 +
   6.105 +lemma Union_cons_eq_succ_Union:
   6.106 +     "Union(cons(succ(Union(z)),z)) = succ(Union(z))"
   6.107 +by fast
   6.108 +
   6.109 +lemma Un_Ord_disj: "[| Ord(i); Ord(j) |] ==> i Un j = i | i Un j = j"
   6.110 +by (fast dest!: le_imp_subset elim: Ord_linear_le)
   6.111 +
   6.112 +lemma Union_eq_Un: "x \<in> X ==> Union(X) = x Un Union(X-{x})"
   6.113 +by fast
   6.114  
   6.115 -AC16_lemmas = AC_Equiv + Hartog
   6.116 +lemma Union_in_lemma [rule_format]:
   6.117 +     "n \<in> nat ==> \<forall>z. (\<forall>y \<in> z. Ord(y)) & z\<approx>n & z\<noteq>0 --> Union(z) \<in> z"
   6.118 +apply (induct_tac "n")
   6.119 +apply (fast dest!: eqpoll_imp_lepoll [THEN lepoll_0_is_0])
   6.120 +apply (intro allI impI)
   6.121 +apply (erule natE)
   6.122 +apply (fast dest!: eqpoll_1_iff_singleton [THEN iffD1]
   6.123 +            intro!: Union_singleton)
   6.124 +apply (clarify ); 
   6.125 +apply (elim not_emptyE)
   6.126 +apply (erule_tac x = "z-{xb}" in allE)
   6.127 +apply (erule impE)
   6.128 +apply (fast elim!: Diff_sing_eqpoll
   6.129 +                   Diff_sing_eqpoll [THEN eqpoll_succ_imp_not_empty])
   6.130 +apply (subgoal_tac "xb \<union> \<Union>(z - {xb}) \<in> z");
   6.131 +apply (simp add: Union_eq_Un [symmetric]);
   6.132 +apply (frule bspec, assumption)
   6.133 +apply (drule bspec); 
   6.134 +apply (erule Diff_subset [THEN subsetD]);
   6.135 +apply (drule Un_Ord_disj, assumption)
   6.136 +apply (auto ); 
   6.137 +done
   6.138 +
   6.139 +lemma Union_in: "[| \<forall>x \<in> z. Ord(x); z\<approx>n; z\<noteq>0; n \<in> nat |] ==> Union(z) \<in> z"
   6.140 +apply (blast intro: Union_in_lemma); 
   6.141 +done
   6.142 +
   6.143 +lemma succ_Union_in_x:
   6.144 +     "[| InfCard(x); z \<in> Pow(x); z\<approx>n; n \<in> nat |] ==> succ(Union(z)) \<in> x"
   6.145 +apply (rule Limit_has_succ [THEN ltE]);
   6.146 +prefer 3 apply assumption
   6.147 +apply (erule InfCard_is_Limit)
   6.148 +apply (case_tac "z=0");
   6.149 +apply (simp, fast intro!: InfCard_is_Limit [THEN Limit_has_0]);
   6.150 +apply (rule ltI [OF PowD [THEN subsetD] InfCard_is_Card [THEN Card_is_Ord]]);
   6.151 +apply assumption; 
   6.152 +apply (blast intro: Union_in
   6.153 +                    InfCard_is_Card [THEN Card_is_Ord, THEN Ord_in_Ord])+
   6.154 +done
   6.155 +
   6.156 +lemma succ_lepoll_succ_succ:
   6.157 +     "[| InfCard(x); n \<in> nat |] 
   6.158 +      ==> {y \<in> Pow(x). y\<approx>succ(n)} \<lesssim> {y \<in> Pow(x). y\<approx>succ(succ(n))}"
   6.159 +apply (unfold lepoll_def);
   6.160 +apply (rule_tac x = "\<lambda>z \<in> {y\<in>Pow(x). y\<approx>succ(n)}. cons(succ(Union(z)), z)" 
   6.161 +       in exI)
   6.162 +apply (rule_tac d = "%z. z-{Union (z) }" in lam_injective)
   6.163 +apply (blast intro!: succ_Union_in_x succ_Union_not_mem
   6.164 +             intro: cons_eqpoll_succ Ord_in_Ord
   6.165 +             dest!: InfCard_is_Card [THEN Card_is_Ord])
   6.166 +apply (simp only: Union_cons_eq_succ_Union); 
   6.167 +apply (rule cons_Diff_eq);
   6.168 +apply (fast dest!: InfCard_is_Card [THEN Card_is_Ord]
   6.169 +            elim: Ord_in_Ord 
   6.170 +            intro!: succ_Union_not_mem);
   6.171 +done
   6.172 +
   6.173 +lemma subsets_eqpoll_X:
   6.174 +     "[| InfCard(X); n \<in> nat |] ==> {Y \<in> Pow(X). Y\<approx>succ(n)} \<approx> X"
   6.175 +apply (induct_tac "n")
   6.176 +apply (rule subsets_eqpoll_1_eqpoll)
   6.177 +apply (rule eqpollI)
   6.178 +apply (rule subsets_lepoll_lemma1 [THEN lepoll_trans], assumption+);
   6.179 +apply (rule eqpoll_trans [THEN eqpoll_imp_lepoll]); 
   6.180 + apply (erule eqpoll_refl [THEN prod_eqpoll_cong]);
   6.181 +apply (erule InfCard_square_eqpoll)
   6.182 +apply (fast elim: eqpoll_sym [THEN eqpoll_imp_lepoll, THEN lepoll_trans] 
   6.183 +            intro!: succ_lepoll_succ_succ)
   6.184 +done
   6.185 +
   6.186 +lemma image_vimage_eq:
   6.187 +     "[| f \<in> surj(A,B); y \<subseteq> B |] ==> f``(converse(f)``y) = y"
   6.188 +apply (unfold surj_def)
   6.189 +apply (fast dest: apply_equality2 elim: apply_iff [THEN iffD2])
   6.190 +done
   6.191 +
   6.192 +lemma vimage_image_eq: "[| f \<in> inj(A,B); y \<subseteq> A |] ==> converse(f)``(f``y) = y"
   6.193 +apply (fast elim!: inj_is_fun [THEN apply_Pair] dest: inj_equality)
   6.194 +done
   6.195 +
   6.196 +lemma subsets_eqpoll:
   6.197 +     "A\<approx>B ==> {Y \<in> Pow(A). Y\<approx>n}\<approx>{Y \<in> Pow(B). Y\<approx>n}"
   6.198 +apply (unfold eqpoll_def)
   6.199 +apply (erule exE)
   6.200 +apply (rule_tac x = "\<lambda>X \<in> {Y \<in> Pow (A) . \<exists>f. f \<in> bij (Y, n) }. f``X" in exI)
   6.201 +apply (rule_tac d = "%Z. converse (f) ``Z" in lam_bijective)
   6.202 +apply (fast intro!: bij_is_inj [THEN restrict_bij, THEN bij_converse_bij, 
   6.203 +                                THEN comp_bij] 
   6.204 +            elim!: bij_is_fun [THEN fun_is_rel, THEN image_subset])
   6.205 +apply (blast intro!:  bij_is_inj [THEN restrict_bij] 
   6.206 +                      comp_bij bij_converse_bij
   6.207 +                      bij_is_fun [THEN fun_is_rel, THEN image_subset])
   6.208 +apply (fast elim!: bij_is_inj [THEN vimage_image_eq])
   6.209 +apply (fast elim!: bij_is_surj [THEN image_vimage_eq])
   6.210 +done
   6.211 +
   6.212 +lemma WO2_imp_ex_Card: "WO2 ==> \<exists>a. Card(a) & X\<approx>a"
   6.213 +apply (unfold WO2_def)
   6.214 +apply (drule spec [of _ X])
   6.215 +apply (blast intro: Card_cardinal eqpoll_trans
   6.216 +          well_ord_Memrel [THEN well_ord_cardinal_eqpoll, THEN eqpoll_sym])
   6.217 +done
   6.218 +
   6.219 +lemma lepoll_infinite: "[| X\<lesssim>Y; ~Finite(X) |] ==> ~Finite(Y)"
   6.220 +by (blast intro: lepoll_Finite)
   6.221 +
   6.222 +lemma infinite_Card_is_InfCard: "[| ~Finite(X); Card(X) |] ==> InfCard(X)"
   6.223 +apply (unfold InfCard_def)
   6.224 +apply (fast elim!: Card_is_Ord [THEN nat_le_infinite_Ord])
   6.225 +done
   6.226 +
   6.227 +lemma WO2_infinite_subsets_eqpoll_X: "[| WO2; n \<in> nat; ~Finite(X) |]   
   6.228 +        ==> {Y \<in> Pow(X). Y\<approx>succ(n)}\<approx>X"
   6.229 +apply (drule WO2_imp_ex_Card)
   6.230 +apply (elim allE exE conjE);
   6.231 +apply (frule eqpoll_imp_lepoll [THEN lepoll_infinite], assumption)
   6.232 +apply (drule infinite_Card_is_InfCard, assumption)
   6.233 +apply (blast intro: subsets_eqpoll subsets_eqpoll_X eqpoll_sym eqpoll_trans); 
   6.234 +done
   6.235 +
   6.236 +lemma well_ord_imp_ex_Card: "well_ord(X,R) ==> \<exists>a. Card(a) & X\<approx>a"
   6.237 +by (fast elim!: well_ord_cardinal_eqpoll [THEN eqpoll_sym] 
   6.238 +         intro!: Card_cardinal)
   6.239 +
   6.240 +lemma well_ord_infinite_subsets_eqpoll_X:
   6.241 +     "[| well_ord(X,R); n \<in> nat; ~Finite(X) |] ==> {Y \<in> Pow(X). Y\<approx>succ(n)}\<approx>X"
   6.242 +apply (drule well_ord_imp_ex_Card)
   6.243 +apply (elim allE exE conjE)
   6.244 +apply (frule eqpoll_imp_lepoll [THEN lepoll_infinite], assumption)
   6.245 +apply (drule infinite_Card_is_InfCard, assumption)
   6.246 +apply (blast intro: subsets_eqpoll subsets_eqpoll_X eqpoll_sym eqpoll_trans); 
   6.247 +done
   6.248 +
   6.249 +end
     7.1 --- a/src/ZF/AC/AC17_AC1.ML	Wed Jan 16 15:04:37 2002 +0100
     7.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     7.3 @@ -1,310 +0,0 @@
     7.4 -(*  Title:      ZF/AC/AC1_AC17.ML
     7.5 -    ID:         $Id$
     7.6 -    Author:     Krzysztof Grabczewski
     7.7 -
     7.8 -The equivalence of AC0, AC1 and AC17
     7.9 -
    7.10 -Also, the proofs needed to show that each of AC2, AC3, ..., AC6 is equivalent
    7.11 -to AC0 and AC1.
    7.12 -*)
    7.13 -
    7.14 -
    7.15 -(** AC0 is equivalent to AC1.  
    7.16 -    AC0 comes from Suppes, AC1 from Rubin & Rubin **)
    7.17 -
    7.18 -Goal "[| f:(\\<Pi>X \\<in> A. X); D \\<subseteq> A |] ==> \\<exists>g. g:(\\<Pi>X \\<in> D. X)";
    7.19 -by (fast_tac (claset() addSIs [restrict_type, apply_type]) 1);
    7.20 -val lemma1 = result();
    7.21 -
    7.22 -Goalw AC_defs "AC0 ==> AC1"; 
    7.23 -by (blast_tac (claset() addIs [lemma1]) 1); 
    7.24 -qed "AC0_AC1";
    7.25 -
    7.26 -Goalw AC_defs "AC1 ==> AC0";
    7.27 -by (Blast_tac 1); 
    7.28 -qed "AC1_AC0";
    7.29 -
    7.30 -
    7.31 -(**** The proof of AC1 ==> AC17 ****)
    7.32 -
    7.33 -Goal "f \\<in> (\\<Pi>X \\<in> Pow(A) - {0}. X) ==> f \\<in> (Pow(A) - {0} -> A)";
    7.34 -by (rtac Pi_type 1 THEN (assume_tac 1));
    7.35 -by (dtac apply_type 1 THEN (assume_tac 1));
    7.36 -by (Fast_tac 1);
    7.37 -val lemma1 = result();
    7.38 -
    7.39 -Goalw AC_defs "AC1 ==> AC17";
    7.40 -by (rtac allI 1);
    7.41 -by (rtac ballI 1);
    7.42 -by (eres_inst_tac [("x","Pow(A)-{0}")] allE 1);
    7.43 -by (etac impE 1);
    7.44 -by (Fast_tac 1);
    7.45 -by (etac exE 1);
    7.46 -by (rtac bexI 1);
    7.47 -by (etac lemma1 2);
    7.48 -by (rtac apply_type 1 THEN (assume_tac 1));
    7.49 -by (fast_tac (claset() addSDs [lemma1] addSEs [apply_type]) 1);
    7.50 -qed "AC1_AC17";
    7.51 -
    7.52 -
    7.53 -(**** The proof of AC17 ==> AC1 ****)
    7.54 -
    7.55 -(* *********************************************************************** *)
    7.56 -(* more properties of HH                                                   *)
    7.57 -(* *********************************************************************** *)
    7.58 -
    7.59 -Goal "[| x - (\\<Union>j \\<in> LEAST i. HH(\\<lambda>X \\<in> Pow(x)-{0}. {f`X}, x, i) = {x}. \
    7.60 -\       HH(\\<lambda>X \\<in> Pow(x)-{0}. {f`X}, x, j)) = 0;  \
    7.61 -\       f \\<in> Pow(x)-{0} -> x |]  \
    7.62 -\       ==> \\<exists>r. well_ord(x,r)";
    7.63 -by (rtac exI 1);
    7.64 -by (eresolve_tac [[bij_Least_HH_x RS bij_converse_bij RS bij_is_inj,
    7.65 -                Ord_Least RS well_ord_Memrel] MRS well_ord_rvimage] 1);
    7.66 -by (assume_tac 1);
    7.67 -qed "UN_eq_imp_well_ord";
    7.68 -
    7.69 -(* *********************************************************************** *)
    7.70 -(* theorems closer to the proof                                            *)
    7.71 -(* *********************************************************************** *)
    7.72 -
    7.73 -Goalw AC_defs "~AC1 ==>  \
    7.74 -\               \\<exists>A. \\<forall>f \\<in> Pow(A)-{0} -> A. \\<exists>u \\<in> Pow(A)-{0}. f`u \\<notin> u";
    7.75 -by (etac swap 1);
    7.76 -by (rtac allI 1);
    7.77 -by (etac swap 1);
    7.78 -by (res_inst_tac [("x","Union(A)")] exI 1);
    7.79 -by (rtac ballI 1);
    7.80 -by (etac swap 1);
    7.81 -by (rtac impI 1);
    7.82 -by (fast_tac (claset() addSIs [restrict_type]) 1);
    7.83 -qed "not_AC1_imp_ex";
    7.84 -
    7.85 -Goal "[| \\<forall>f \\<in> Pow(x) - {0} -> x. \\<exists>u \\<in> Pow(x) - {0}. f`u\\<notin>u;  \
    7.86 -\       \\<exists>f \\<in> Pow(x)-{0}->x. \
    7.87 -\       x - (\\<Union>a \\<in> (LEAST i. HH(\\<lambda>X \\<in> Pow(x)-{0}. {f`X},x,i)={x}).  \
    7.88 -\       HH(\\<lambda>X \\<in> Pow(x)-{0}. {f`X},x,a)) = 0 |] \
    7.89 -\       ==> P";
    7.90 -by (etac bexE 1);
    7.91 -by (eresolve_tac [UN_eq_imp_well_ord RS exE] 1 THEN (assume_tac 1));
    7.92 -by (eresolve_tac [ex_choice_fun_Pow RS exE] 1);
    7.93 -by (etac ballE 1);
    7.94 -by (fast_tac (FOL_cs addEs [bexE, notE, apply_type]) 1);
    7.95 -by (etac notE 1);
    7.96 -by (rtac Pi_type 1 THEN (assume_tac 1));
    7.97 -by (resolve_tac [apply_type RSN (2, subsetD)] 1 THEN TRYALL assume_tac);
    7.98 -by (Fast_tac 1);
    7.99 -val lemma1 = result();
   7.100 -
   7.101 -Goal "~ (\\<exists>f \\<in> Pow(x)-{0}->x. x - F(f) = 0)  \
   7.102 -\       ==> (\\<lambda>f \\<in> Pow(x)-{0}->x. x - F(f))  \
   7.103 -\               \\<in> (Pow(x) -{0} -> x) -> Pow(x) - {0}";
   7.104 -by (fast_tac (claset() addSIs [lam_type] addSDs [Diff_eq_0_iff RS iffD1]) 1);
   7.105 -val lemma2 = result();
   7.106 -
   7.107 -Goal "[| f`Z \\<in> Z; Z \\<in> Pow(x)-{0} |] ==>  \
   7.108 -\       (\\<lambda>X \\<in> Pow(x)-{0}. {f`X})`Z \\<in> Pow(Z)-{0}";
   7.109 -by Auto_tac;
   7.110 -val lemma3 = result();
   7.111 -
   7.112 -Goal "\\<exists>f \\<in> F. f`((\\<lambda>f \\<in> F. Q(f))`f) \\<in> (\\<lambda>f \\<in> F. Q(f))`f  \
   7.113 -\       ==> \\<exists>f \\<in> F. f`Q(f) \\<in> Q(f)";
   7.114 -by (Asm_full_simp_tac 1);
   7.115 -val lemma4 = result();
   7.116 -
   7.117 -Goalw [AC17_def] "AC17 ==> AC1";
   7.118 -by (rtac classical 1);
   7.119 -by (eresolve_tac [not_AC1_imp_ex RS exE] 1);
   7.120 -by (excluded_middle_tac
   7.121 -        "\\<exists>f \\<in> Pow(x)-{0}->x. \
   7.122 -\       x - (\\<Union>a \\<in> (LEAST i. HH(\\<lambda>X \\<in> Pow(x)-{0}. {f`X},x,i)={x}).  \
   7.123 -\       HH(\\<lambda>X \\<in> Pow(x)-{0}. {f`X},x,a)) = 0" 1);
   7.124 -by (etac lemma1 2 THEN (assume_tac 2));
   7.125 -by (dtac lemma2 1);
   7.126 -by (etac allE 1);
   7.127 -by (dtac bspec 1 THEN (assume_tac 1));
   7.128 -by (dtac lemma4 1);
   7.129 -by (etac bexE 1);
   7.130 -by (dtac apply_type 1 THEN (assume_tac 1));
   7.131 -by (dresolve_tac [beta RS sym RSN (2, subst_elem)] 1);
   7.132 -by (assume_tac 1);
   7.133 -by (dtac lemma3 1 THEN (assume_tac 1));
   7.134 -by (fast_tac (claset() addSDs [HH_Least_eq_x RS sym RSN (2, subst_elem),
   7.135 -                f_subset_imp_HH_subset] addSEs [mem_irrefl]) 1);
   7.136 -qed "AC17_AC1";
   7.137 -
   7.138 -
   7.139 -(* **********************************************************************
   7.140 -    AC1 ==> AC2 ==> AC1
   7.141 -    AC1 ==> AC4 ==> AC3 ==> AC1
   7.142 -    AC4 ==> AC5 ==> AC4
   7.143 -    AC1 <-> AC6
   7.144 -************************************************************************* *)
   7.145 -
   7.146 -(* ********************************************************************** *)
   7.147 -(* AC1 ==> AC2                                                            *)
   7.148 -(* ********************************************************************** *)
   7.149 -
   7.150 -Goal "[| f:(\\<Pi>X \\<in> A. X);  B \\<in> A;  0\\<notin>A |] ==> {f`B} \\<subseteq> B Int {f`C. C \\<in> A}";
   7.151 -by (fast_tac (claset() addSEs [apply_type]) 1);
   7.152 -val lemma1 = result();
   7.153 -
   7.154 -Goalw [pairwise_disjoint_def]
   7.155 -        "[| pairwise_disjoint(A); B \\<in> A; C \\<in> A; D \\<in> B; D \\<in> C |] ==> f`B = f`C";
   7.156 -by (Fast_tac 1);
   7.157 -val lemma2 = result();
   7.158 -
   7.159 -Goalw AC_defs "AC1 ==> AC2"; 
   7.160 -by (rtac allI 1);
   7.161 -by (rtac impI 1);
   7.162 -by (REPEAT (eresolve_tac [asm_rl,conjE,allE,exE,impE] 1));
   7.163 -by (REPEAT (resolve_tac [exI,ballI,equalityI] 1));
   7.164 -by (rtac lemma1 2 THEN (REPEAT (assume_tac 2)));
   7.165 -by (fast_tac (claset() addSEs [lemma2] addEs [apply_type]) 1);
   7.166 -qed "AC1_AC2";
   7.167 -
   7.168 -
   7.169 -(* ********************************************************************** *)
   7.170 -(* AC2 ==> AC1                                                            *)
   7.171 -(* ********************************************************************** *)
   7.172 -
   7.173 -Goal "0\\<notin>A ==> 0 \\<notin> {B*{B}. B \\<in> A}";
   7.174 -by (fast_tac (claset() addSDs [sym RS (Sigma_empty_iff RS iffD1)]) 1);
   7.175 -val lemma1 = result();
   7.176 -
   7.177 -Goal "[| X*{X} Int C = {y}; X \\<in> A |]  \
   7.178 -\               ==> (THE y. X*{X} Int C = {y}): X*A";
   7.179 -by (rtac subst_elem 1);
   7.180 -by (fast_tac (claset() addSIs [the_equality]
   7.181 -                addSEs [sym RS trans RS (singleton_eq_iff RS iffD1)]) 2);
   7.182 -by (blast_tac (claset() addSEs [equalityE]) 1);
   7.183 -val lemma2 = result();
   7.184 -
   7.185 -Goal "\\<forall>D \\<in> {E*{E}. E \\<in> A}. \\<exists>y. D Int C = {y}  \
   7.186 -\     ==> (\\<lambda>x \\<in> A. fst(THE z. (x*{x} Int C = {z}))) \\<in> (\\<Pi>X \\<in> A. X)";
   7.187 -by (fast_tac (claset() addSEs [lemma2] 
   7.188 -                       addSIs [lam_type, RepFunI, fst_type]) 1);
   7.189 -val lemma3 = result();
   7.190 -
   7.191 -Goalw (AC_defs@AC_aux_defs) "AC2 ==> AC1";
   7.192 -by (REPEAT (resolve_tac [allI, impI] 1));
   7.193 -by (REPEAT (eresolve_tac [allE, impE] 1));
   7.194 -by (fast_tac (claset() addSEs [lemma3]) 2);
   7.195 -by (fast_tac (claset() addSIs [lemma1, equals0I]) 1);
   7.196 -qed "AC2_AC1";
   7.197 -
   7.198 -
   7.199 -(* ********************************************************************** *)
   7.200 -(* AC1 ==> AC4                                                            *)
   7.201 -(* ********************************************************************** *)
   7.202 -
   7.203 -Goal "0 \\<notin> {R``{x}. x \\<in> domain(R)}";
   7.204 -by (Blast_tac 1);
   7.205 -val lemma = result();
   7.206 -
   7.207 -Goalw AC_defs "AC1 ==> AC4";
   7.208 -by (REPEAT (resolve_tac [allI, impI] 1));
   7.209 -by (REPEAT (eresolve_tac [allE, lemma RSN (2, impE), exE] 1));
   7.210 -by (best_tac (claset() addSIs [lam_type] addSEs [apply_type]) 1);
   7.211 -qed "AC1_AC4";
   7.212 -
   7.213 -
   7.214 -(* ********************************************************************** *)
   7.215 -(* AC4 ==> AC3                                                            *)
   7.216 -(* ********************************************************************** *)
   7.217 -
   7.218 -Goal "f \\<in> A->B ==> (\\<Union>z \\<in> A. {z}*f`z) \\<subseteq> A*Union(B)";
   7.219 -by (fast_tac (claset() addSDs [apply_type]) 1);
   7.220 -val lemma1 = result();
   7.221 -
   7.222 -Goal "domain(\\<Union>z \\<in> A. {z}*f(z)) = {a \\<in> A. f(a)\\<noteq>0}";
   7.223 -by (Blast_tac 1);
   7.224 -val lemma2 = result();
   7.225 -
   7.226 -Goal "x \\<in> A ==> (\\<Union>z \\<in> A. {z}*f(z))``{x} = f(x)";
   7.227 -by (Fast_tac 1);
   7.228 -val lemma3 = result();
   7.229 -
   7.230 -Goalw AC_defs "AC4 ==> AC3";
   7.231 -by (REPEAT (resolve_tac [allI,ballI] 1));
   7.232 -by (REPEAT (eresolve_tac [allE,impE] 1));
   7.233 -by (etac lemma1 1);
   7.234 -by (asm_full_simp_tac (simpset() addsimps [lemma2, lemma3]
   7.235 -                                 addcongs [Pi_cong]) 1);
   7.236 -qed "AC4_AC3";
   7.237 -
   7.238 -(* ********************************************************************** *)
   7.239 -(* AC3 ==> AC1                                                            *)
   7.240 -(* ********************************************************************** *)
   7.241 -
   7.242 -Goal "b\\<notin>A ==> (\\<Pi>x \\<in> {a \\<in> A. id(A)`a\\<noteq>b}. id(A)`x) = (\\<Pi>x \\<in> A. x)";
   7.243 -by (asm_full_simp_tac (simpset() addsimps [id_def] addcongs [Pi_cong]) 1);
   7.244 -by (res_inst_tac [("b","A")] subst_context 1);
   7.245 -by (Fast_tac 1);
   7.246 -val lemma = result();
   7.247 -
   7.248 -Goalw AC_defs "AC3 ==> AC1";
   7.249 -by (fast_tac (claset() addSIs [id_type] addEs [lemma RS subst]) 1);
   7.250 -qed "AC3_AC1";
   7.251 -
   7.252 -(* ********************************************************************** *)
   7.253 -(* AC4 ==> AC5                                                            *)
   7.254 -(* ********************************************************************** *)
   7.255 -
   7.256 -Goalw (range_def::AC_defs) "AC4 ==> AC5";
   7.257 -by (REPEAT (resolve_tac [allI,ballI] 1));
   7.258 -by (REPEAT (eresolve_tac [allE,impE] 1));
   7.259 -by (eresolve_tac [fun_is_rel RS converse_type] 1);
   7.260 -by (etac exE 1);
   7.261 -by (rtac bexI 1);
   7.262 -by (rtac Pi_type 2 THEN (assume_tac 2));
   7.263 -by (fast_tac (claset() addSDs [apply_type]
   7.264 -        addSEs [fun_is_rel RS converse_type RS subsetD RS SigmaD2]) 2);
   7.265 -by (rtac ballI 1);
   7.266 -by (rtac apply_equality 1 THEN (assume_tac 2));
   7.267 -by (etac domainE 1);
   7.268 -by (ftac range_type 1 THEN (assume_tac 1));
   7.269 -by (fast_tac (claset() addDs [apply_equality]) 1);
   7.270 -qed "AC4_AC5";
   7.271 -
   7.272 -
   7.273 -(* ********************************************************************** *)
   7.274 -(* AC5 ==> AC4, Rubin & Rubin, p. 11                                      *)
   7.275 -(* ********************************************************************** *)
   7.276 -
   7.277 -Goal "R \\<subseteq> A*B ==> (\\<lambda>x \\<in> R. fst(x)) \\<in> R -> A";
   7.278 -by (fast_tac (claset() addSIs [lam_type, fst_type]) 1);
   7.279 -val lemma1 = result();
   7.280 -
   7.281 -Goalw [range_def] "R \\<subseteq> A*B ==> range(\\<lambda>x \\<in> R. fst(x)) = domain(R)";
   7.282 -by (force_tac (claset() addIs [lamI RS subst_elem] addSEs [lamE], 
   7.283 -	       simpset()) 1);
   7.284 -val lemma2 = result();
   7.285 -
   7.286 -Goal "[| \\<exists>f \\<in> A->C. P(f,domain(f)); A=B |] ==>  \\<exists>f \\<in> B->C. P(f,B)";
   7.287 -by (etac bexE 1);
   7.288 -by (ftac domain_of_fun 1);
   7.289 -by (Fast_tac 1);
   7.290 -val lemma3 = result();
   7.291 -
   7.292 -Goal "[| R \\<subseteq> A*B; g \\<in> C->R; \\<forall>x \\<in> C. (\\<lambda>z \\<in> R. fst(z))` (g`x) = x |] \
   7.293 -\               ==> (\\<lambda>x \\<in> C. snd(g`x)): (\\<Pi>x \\<in> C. R``{x})";
   7.294 -by (rtac lam_type 1);
   7.295 -by (force_tac (claset() addDs [apply_type], simpset()) 1);
   7.296 -val lemma4 = result();
   7.297 -
   7.298 -Goalw AC_defs "AC5 ==> AC4";
   7.299 -by (Clarify_tac 1);
   7.300 -by (REPEAT (eresolve_tac [allE,ballE] 1));
   7.301 -by (eresolve_tac [lemma1 RSN (2, notE)] 2 THEN (assume_tac 2));
   7.302 -by (dresolve_tac [lemma2 RSN (2, lemma3)] 1 THEN (assume_tac 1));
   7.303 -by (fast_tac (claset() addSEs [lemma4]) 1);
   7.304 -qed "AC5_AC4";
   7.305 -
   7.306 -
   7.307 -(* ********************************************************************** *)
   7.308 -(* AC1 <-> AC6                                                            *)
   7.309 -(* ********************************************************************** *)
   7.310 -
   7.311 -Goalw AC_defs "AC1 <-> AC6";
   7.312 -by (Blast_tac 1);
   7.313 -qed "AC1_iff_AC6";
     8.1 --- a/src/ZF/AC/AC17_AC1.thy	Wed Jan 16 15:04:37 2002 +0100
     8.2 +++ b/src/ZF/AC/AC17_AC1.thy	Wed Jan 16 17:52:06 2002 +0100
     8.3 @@ -1,3 +1,300 @@
     8.4 -(*Dummy theory to document dependencies *)
     8.5 +(*  Title:      ZF/AC/AC1_AC17.thy
     8.6 +    ID:         $Id$
     8.7 +    Author:     Krzysztof Grabczewski
     8.8 +
     8.9 +The equivalence of AC0, AC1 and AC17
    8.10 +
    8.11 +Also, the proofs needed to show that each of AC2, AC3, ..., AC6 is equivalent
    8.12 +to AC0 and AC1.
    8.13 +*)
    8.14 +
    8.15 +theory AC17_AC1 = HH:
    8.16 +
    8.17 +
    8.18 +(** AC0 is equivalent to AC1.  
    8.19 +    AC0 comes from Suppes, AC1 from Rubin & Rubin **)
    8.20 +
    8.21 +lemma AC0_AC1_lemma: "[| f:(\<Pi>X \<in> A. X); D \<subseteq> A |] ==> \<exists>g. g:(\<Pi>X \<in> D. X)"
    8.22 +by (fast intro!: restrict_type apply_type)
    8.23 +
    8.24 +lemma AC0_AC1: "AC0 ==> AC1"
    8.25 +apply (unfold AC0_def AC1_def)
    8.26 +apply (blast intro: AC0_AC1_lemma)
    8.27 +done
    8.28 +
    8.29 +lemma AC1_AC0: "AC1 ==> AC0"
    8.30 +by (unfold AC0_def AC1_def, blast)
    8.31 +
    8.32 +
    8.33 +(**** The proof of AC1 ==> AC17 ****)
    8.34 +
    8.35 +lemma AC1_AC17_lemma: "f \<in> (\<Pi>X \<in> Pow(A) - {0}. X) ==> f \<in> (Pow(A) - {0} -> A)"
    8.36 +apply (rule Pi_type, assumption)
    8.37 +apply (drule apply_type, assumption, fast)
    8.38 +done
    8.39 +
    8.40 +lemma AC1_AC17: "AC1 ==> AC17"
    8.41 +apply (unfold AC1_def AC17_def)
    8.42 +apply (rule allI)
    8.43 +apply (rule ballI)
    8.44 +apply (erule_tac x = "Pow (A) -{0}" in allE)
    8.45 +apply (erule impE, fast)
    8.46 +apply (erule exE)
    8.47 +apply (rule bexI)
    8.48 +apply (erule_tac [2] AC1_AC17_lemma)
    8.49 +apply (rule apply_type, assumption)
    8.50 +apply (fast dest!: AC1_AC17_lemma elim!: apply_type)
    8.51 +done
    8.52 +
    8.53 +
    8.54 +(**** The proof of AC17 ==> AC1 ****)
    8.55 +
    8.56 +(* *********************************************************************** *)
    8.57 +(* more properties of HH                                                   *)
    8.58 +(* *********************************************************************** *)
    8.59 +
    8.60 +lemma UN_eq_imp_well_ord:
    8.61 +     "[| x - (\<Union>j \<in> LEAST i. HH(\<lambda>X \<in> Pow(x)-{0}. {f`X}, x, i) = {x}.  
    8.62 +        HH(\<lambda>X \<in> Pow(x)-{0}. {f`X}, x, j)) = 0;   
    8.63 +        f \<in> Pow(x)-{0} -> x |]   
    8.64 +        ==> \<exists>r. well_ord(x,r)"
    8.65 +apply (rule exI)
    8.66 +apply (erule well_ord_rvimage 
    8.67 +        [OF bij_Least_HH_x [THEN bij_converse_bij, THEN bij_is_inj] 
    8.68 +            Ord_Least [THEN well_ord_Memrel]], assumption)
    8.69 +done
    8.70 +
    8.71 +(* *********************************************************************** *)
    8.72 +(* theorems closer to the proof                                            *)
    8.73 +(* *********************************************************************** *)
    8.74 +
    8.75 +lemma not_AC1_imp_ex:
    8.76 +     "~AC1 ==> \<exists>A. \<forall>f \<in> Pow(A)-{0} -> A. \<exists>u \<in> Pow(A)-{0}. f`u \<notin> u"
    8.77 +apply (unfold AC1_def)
    8.78 +apply (erule swap)
    8.79 +apply (rule allI)
    8.80 +apply (erule swap)
    8.81 +apply (rule_tac x = "Union (A)" in exI)
    8.82 +apply (blast intro: restrict_type)
    8.83 +done
    8.84 +
    8.85 +lemma lemma1:
    8.86 +     "[| \<forall>f \<in> Pow(x) - {0} -> x. \<exists>u \<in> Pow(x) - {0}. f`u\<notin>u;   
    8.87 +         \<exists>f \<in> Pow(x)-{0}->x.  
    8.88 +            x - (\<Union>a \<in> (LEAST i. HH(\<lambda>X \<in> Pow(x)-{0}. {f`X},x,i)={x}).   
    8.89 +            HH(\<lambda>X \<in> Pow(x)-{0}. {f`X},x,a)) = 0 |]  
    8.90 +        ==> P"
    8.91 +apply (erule bexE)
    8.92 +apply (erule UN_eq_imp_well_ord [THEN exE], assumption)
    8.93 +apply (erule ex_choice_fun_Pow [THEN exE])
    8.94 +apply (erule ballE) 
    8.95 +apply (fast intro: apply_type del: DiffE)
    8.96 +apply (erule notE)
    8.97 +apply (rule Pi_type, assumption)
    8.98 +apply (blast dest: apply_type) 
    8.99 +done
   8.100 +
   8.101 +lemma lemma2:
   8.102 +      "~ (\<exists>f \<in> Pow(x)-{0}->x. x - F(f) = 0)   
   8.103 +       ==> (\<lambda>f \<in> Pow(x)-{0}->x . x - F(f))   
   8.104 +           \<in> (Pow(x) -{0} -> x) -> Pow(x) - {0}"
   8.105 +by (fast intro!: lam_type dest!: Diff_eq_0_iff [THEN iffD1])
   8.106 +
   8.107 +lemma lemma3:
   8.108 +     "[| f`Z \<in> Z; Z \<in> Pow(x)-{0} |] 
   8.109 +      ==> (\<lambda>X \<in> Pow(x)-{0}. {f`X})`Z \<in> Pow(Z)-{0}"
   8.110 +by auto
   8.111 +
   8.112 +lemma lemma4:
   8.113 +     "\<exists>f \<in> F. f`((\<lambda>f \<in> F. Q(f))`f) \<in> (\<lambda>f \<in> F. Q(f))`f   
   8.114 +      ==> \<exists>f \<in> F. f`Q(f) \<in> Q(f)"
   8.115 +by simp
   8.116 +
   8.117 +lemma AC17_AC1: "AC17 ==> AC1"
   8.118 +apply (unfold AC17_def)
   8.119 +apply (rule classical)
   8.120 +apply (erule not_AC1_imp_ex [THEN exE])
   8.121 +apply (case_tac 
   8.122 +       "\<exists>f \<in> Pow(x)-{0} -> x. 
   8.123 +        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")
   8.124 +apply (erule lemma1, assumption)
   8.125 +apply (drule lemma2)
   8.126 +apply (erule allE)
   8.127 +apply (drule bspec, assumption)
   8.128 +apply (drule lemma4)
   8.129 +apply (erule bexE)
   8.130 +apply (drule apply_type, assumption)
   8.131 +apply (simp add: HH_Least_eq_x del: Diff_iff ) 
   8.132 +apply (drule lemma3, assumption) 
   8.133 +apply (fast dest!: subst_elem [OF _ HH_Least_eq_x [symmetric]]
   8.134 +                   f_subset_imp_HH_subset elim!: mem_irrefl)
   8.135 +done
   8.136 +
   8.137 +
   8.138 +(* **********************************************************************
   8.139 +    AC1 ==> AC2 ==> AC1
   8.140 +    AC1 ==> AC4 ==> AC3 ==> AC1
   8.141 +    AC4 ==> AC5 ==> AC4
   8.142 +    AC1 <-> AC6
   8.143 +************************************************************************* *)
   8.144 +
   8.145 +(* ********************************************************************** *)
   8.146 +(* AC1 ==> AC2                                                            *)
   8.147 +(* ********************************************************************** *)
   8.148 +
   8.149 +lemma lemma1:
   8.150 +     "[| f:(\<Pi>X \<in> A. X);  B \<in> A;  0\<notin>A |] ==> {f`B} \<subseteq> B Int {f`C. C \<in> A}"
   8.151 +by (fast elim!: apply_type)
   8.152  
   8.153 -AC17_AC1 = HH
   8.154 +lemma lemma2: 
   8.155 +        "[| pairwise_disjoint(A); B \<in> A; C \<in> A; D \<in> B; D \<in> C |] ==> f`B = f`C"
   8.156 +by (unfold pairwise_disjoint_def, fast)
   8.157 +
   8.158 +lemma AC1_AC2: "AC1 ==> AC2"
   8.159 +apply (unfold AC1_def AC2_def)
   8.160 +apply (rule allI)
   8.161 +apply (rule impI)  
   8.162 +apply (elim asm_rl conjE allE exE impE, assumption)
   8.163 +apply (intro exI ballI equalityI)
   8.164 +prefer 2 apply (rule lemma1, assumption+)
   8.165 +apply (fast elim!: lemma2 elim: apply_type)
   8.166 +done
   8.167 +
   8.168 +
   8.169 +(* ********************************************************************** *)
   8.170 +(* AC2 ==> AC1                                                            *)
   8.171 +(* ********************************************************************** *)
   8.172 +
   8.173 +lemma lemma1: "0\<notin>A ==> 0 \<notin> {B*{B}. B \<in> A}"
   8.174 +by (fast dest!: sym [THEN Sigma_empty_iff [THEN iffD1]])
   8.175 +
   8.176 +lemma lemma2: "[| X*{X} Int C = {y}; X \<in> A |]   
   8.177 +               ==> (THE y. X*{X} Int C = {y}): X*A"
   8.178 +apply (rule subst_elem [of y])
   8.179 +apply (blast elim!: equalityE)
   8.180 +apply (auto simp add: singleton_eq_iff) 
   8.181 +done
   8.182 +
   8.183 +lemma lemma3:
   8.184 +     "\<forall>D \<in> {E*{E}. E \<in> A}. \<exists>y. D Int C = {y}   
   8.185 +      ==> (\<lambda>x \<in> A. fst(THE z. (x*{x} Int C = {z}))) \<in> (\<Pi>X \<in> A. X)"
   8.186 +apply (rule lam_type)
   8.187 +apply (drule bspec, blast)
   8.188 +apply (blast intro: lemma2 fst_type)
   8.189 +done
   8.190 +
   8.191 +lemma AC2_AC1: "AC2 ==> AC1"
   8.192 +apply (unfold AC1_def AC2_def pairwise_disjoint_def)
   8.193 +apply (intro allI impI)
   8.194 +apply (elim allE impE)
   8.195 +prefer 2 apply (fast elim!: lemma3) 
   8.196 +apply (blast intro!: lemma1)
   8.197 +done
   8.198 +
   8.199 +
   8.200 +(* ********************************************************************** *)
   8.201 +(* AC1 ==> AC4                                                            *)
   8.202 +(* ********************************************************************** *)
   8.203 +
   8.204 +lemma empty_notin_images: "0 \<notin> {R``{x}. x \<in> domain(R)}"
   8.205 +by blast
   8.206 +
   8.207 +lemma AC1_AC4: "AC1 ==> AC4"
   8.208 +apply (unfold AC1_def AC4_def)
   8.209 +apply (intro allI impI)
   8.210 +apply (drule spec, drule mp [OF _ empty_notin_images]) 
   8.211 +apply (best intro!: lam_type elim!: apply_type)
   8.212 +done
   8.213 +
   8.214 +
   8.215 +(* ********************************************************************** *)
   8.216 +(* AC4 ==> AC3                                                            *)
   8.217 +(* ********************************************************************** *)
   8.218 +
   8.219 +lemma lemma1: "f \<in> A->B ==> (\<Union>z \<in> A. {z}*f`z) \<subseteq> A*Union(B)"
   8.220 +by (fast dest!: apply_type)
   8.221 +
   8.222 +lemma lemma2: "domain(\<Union>z \<in> A. {z}*f(z)) = {a \<in> A. f(a)\<noteq>0}"
   8.223 +by blast
   8.224 +
   8.225 +lemma lemma3: "x \<in> A ==> (\<Union>z \<in> A. {z}*f(z))``{x} = f(x)"
   8.226 +by fast
   8.227 +
   8.228 +lemma AC4_AC3: "AC4 ==> AC3"
   8.229 +apply (unfold AC3_def AC4_def)
   8.230 +apply (intro allI ballI)
   8.231 +apply (elim allE impE)
   8.232 +apply (erule lemma1)
   8.233 +apply (simp add: lemma2 lemma3 cong add: Pi_cong)
   8.234 +done
   8.235 +
   8.236 +(* ********************************************************************** *)
   8.237 +(* AC3 ==> AC1                                                            *)
   8.238 +(* ********************************************************************** *)
   8.239 +
   8.240 +lemma AC3_AC1_lemma:
   8.241 +     "b\<notin>A ==> (\<Pi>x \<in> {a \<in> A. id(A)`a\<noteq>b}. id(A)`x) = (\<Pi>x \<in> A. x)"
   8.242 +apply (simp add: id_def cong add: Pi_cong)
   8.243 +apply (rule_tac b = "A" in subst_context, fast)
   8.244 +done
   8.245 +
   8.246 +lemma AC3_AC1: "AC3 ==> AC1"
   8.247 +apply (unfold AC1_def AC3_def)
   8.248 +apply (fast intro!: id_type elim: AC3_AC1_lemma [THEN subst])
   8.249 +done
   8.250 +
   8.251 +(* ********************************************************************** *)
   8.252 +(* AC4 ==> AC5                                                            *)
   8.253 +(* ********************************************************************** *)
   8.254 +
   8.255 +lemma AC4_AC5: "AC4 ==> AC5"
   8.256 +apply (unfold range_def AC4_def AC5_def)
   8.257 +apply (intro allI ballI)
   8.258 +apply (elim allE impE)
   8.259 +apply (erule fun_is_rel [THEN converse_type])
   8.260 +apply (erule exE)
   8.261 +apply (rename_tac g)
   8.262 +apply (rule_tac x=g in bexI)
   8.263 +apply (blast dest: apply_equality range_type) 
   8.264 +apply (blast intro: Pi_type dest: apply_type fun_is_rel)
   8.265 +done
   8.266 +
   8.267 +
   8.268 +(* ********************************************************************** *)
   8.269 +(* AC5 ==> AC4, Rubin & Rubin, p. 11                                      *)
   8.270 +(* ********************************************************************** *)
   8.271 +
   8.272 +lemma lemma1: "R \<subseteq> A*B ==> (\<lambda>x \<in> R. fst(x)) \<in> R -> A"
   8.273 +by (fast intro!: lam_type fst_type)
   8.274 +
   8.275 +lemma lemma2: "R \<subseteq> A*B ==> range(\<lambda>x \<in> R. fst(x)) = domain(R)"
   8.276 +by (unfold lam_def, force)
   8.277 +
   8.278 +lemma lemma3: "[| \<exists>f \<in> A->C. P(f,domain(f)); A=B |] ==>  \<exists>f \<in> B->C. P(f,B)"
   8.279 +apply (erule bexE)
   8.280 +apply (frule domain_of_fun, fast)
   8.281 +done
   8.282 +
   8.283 +lemma lemma4: "[| R \<subseteq> A*B; g \<in> C->R; \<forall>x \<in> C. (\<lambda>z \<in> R. fst(z))` (g`x) = x |]  
   8.284 +                ==> (\<lambda>x \<in> C. snd(g`x)): (\<Pi>x \<in> C. R``{x})"
   8.285 +apply (rule lam_type)
   8.286 +apply (force dest: apply_type)
   8.287 +done
   8.288 +
   8.289 +lemma AC5_AC4: "AC5 ==> AC4"
   8.290 +apply (unfold AC4_def AC5_def, clarify)
   8.291 +apply (elim allE ballE)
   8.292 +apply (drule lemma3 [OF _ lemma2], assumption)
   8.293 +apply (fast elim!: lemma4)
   8.294 +apply (blast intro: lemma1) 
   8.295 +done
   8.296 +
   8.297 +
   8.298 +(* ********************************************************************** *)
   8.299 +(* AC1 <-> AC6                                                            *)
   8.300 +(* ********************************************************************** *)
   8.301 +
   8.302 +lemma AC1_iff_AC6: "AC1 <-> AC6"
   8.303 +by (unfold AC1_def AC6_def, blast)
   8.304 +
   8.305 +end
     9.1 --- a/src/ZF/AC/AC18_AC19.ML	Wed Jan 16 15:04:37 2002 +0100
     9.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     9.3 @@ -1,115 +0,0 @@
     9.4 -(*  Title:      ZF/AC/AC18_AC19.ML
     9.5 -    ID:         $Id$
     9.6 -    Author:     Krzysztof Grabczewski
     9.7 -
     9.8 -The proof of AC1 ==> AC18 ==> AC19 ==> AC1
     9.9 -*)
    9.10 -
    9.11 -(* ********************************************************************** *)
    9.12 -(* AC1 ==> AC18                                                           *)
    9.13 -(* ********************************************************************** *)
    9.14 -
    9.15 -Goal "[| f \\<in> (\\<Pi>b \\<in> {P(a). a \\<in> A}. b);  \\<forall>a \\<in> A. P(a)<=Q(a) |]  \
    9.16 -\     ==> (\\<lambda>a \\<in> A. f`P(a)) \\<in> (\\<Pi>a \\<in> A. Q(a))";
    9.17 -by (rtac lam_type 1);
    9.18 -by (dtac apply_type 1);
    9.19 -by Auto_tac;  
    9.20 -qed "PROD_subsets";
    9.21 -
    9.22 -Goal "[| \\<forall>A. 0 \\<notin> A --> (\\<exists>f. f \\<in> (\\<Pi>X \\<in> A. X)); A \\<noteq> 0 |] ==>  \
    9.23 -\  (\\<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))";
    9.24 -by (rtac subsetI 1);
    9.25 -by (eres_inst_tac [("x","{{b \\<in> B(a). x \\<in> X(a,b)}. a \\<in> A}")] allE 1);
    9.26 -by (etac impE 1);
    9.27 -by (Fast_tac 1);
    9.28 -by (etac exE 1);
    9.29 -by (rtac UN_I 1);
    9.30 -by (fast_tac (claset() addSEs [PROD_subsets]) 1);
    9.31 -by (Simp_tac 1);
    9.32 -by (fast_tac (claset() addSEs [not_emptyE] 
    9.33 -                       addDs [RepFunI RSN (2, apply_type)]) 1);
    9.34 -qed "lemma_AC18";
    9.35 -
    9.36 -val [prem] = goalw thy (AC18_def::AC_defs) "AC1 ==> AC18";
    9.37 -by (resolve_tac [prem RS revcut_rl] 1);
    9.38 -by (fast_tac (claset() addSEs [lemma_AC18, not_emptyE, apply_type]
    9.39 -                addSIs [equalityI, INT_I, UN_I]) 1);
    9.40 -qed "AC1_AC18";
    9.41 -
    9.42 -(* ********************************************************************** *)
    9.43 -(* AC18 ==> AC19                                                          *)
    9.44 -(* ********************************************************************** *)
    9.45 -
    9.46 -val [prem] = goalw thy [AC18_def, AC19_def] "AC18 ==> AC19";
    9.47 -by (rtac allI 1);
    9.48 -by (res_inst_tac [("B1","%x. x")] (forall_elim_vars 0 prem RS revcut_rl) 1);
    9.49 -by (Fast_tac 1);
    9.50 -qed "AC18_AC19";
    9.51 -
    9.52 -(* ********************************************************************** *)
    9.53 -(* AC19 ==> AC1                                                           *)
    9.54 -(* ********************************************************************** *)
    9.55 -
    9.56 -Goalw [u_def]
    9.57 -        "[| A \\<noteq> 0; 0 \\<notin> A |] ==> {u_(a). a \\<in> A} \\<noteq> 0 & 0 \\<notin> {u_(a). a \\<in> A}";
    9.58 -by (fast_tac (claset() addSIs [not_emptyI]
    9.59 -                addSEs [not_emptyE]
    9.60 -                addSDs [sym RS (RepFun_eq_0_iff RS iffD1)]) 1);
    9.61 -qed "RepRep_conj";
    9.62 -
    9.63 -Goal "[|c \\<in> a; x = c Un {0}; x \\<notin> a |] ==> x - {0} \\<in> a";
    9.64 -by (hyp_subst_tac 1);
    9.65 -by (rtac subst_elem 1 THEN (assume_tac 1));
    9.66 -by (rtac equalityI 1);
    9.67 -by (Fast_tac 1);
    9.68 -by (rtac subsetI 1);
    9.69 -by (excluded_middle_tac "x=0" 1);
    9.70 -by (Fast_tac 1);
    9.71 -by (fast_tac (claset() addEs [notE, subst_elem])  1);
    9.72 -val lemma1_1 = result();
    9.73 -
    9.74 -Goalw [u_def]
    9.75 -        "[| f`(u_(a)) \\<notin> a; f \\<in> (\\<Pi>B \\<in> {u_(a). a \\<in> A}. B); a \\<in> A |]  \
    9.76 -\               ==> f`(u_(a))-{0} \\<in> a";
    9.77 -by (fast_tac (claset() addSEs [lemma1_1] addSDs [apply_type]) 1);
    9.78 -val lemma1_2 = result();
    9.79 -
    9.80 -Goal  "\\<exists>f. f \\<in> (\\<Pi>B \\<in> {u_(a). a \\<in> A}. B) ==> \\<exists>f. f \\<in> (\\<Pi>B \\<in> A. B)";
    9.81 -by (etac exE 1);
    9.82 -by (res_inst_tac
    9.83 -        [("x","\\<lambda>a \\<in> A. if(f`(u_(a)) \\<in> a, f`(u_(a)), f`(u_(a))-{0})")] exI 1);
    9.84 -by (rtac lam_type 1);
    9.85 -by (split_tac [split_if] 1);
    9.86 -by (rtac conjI 1);
    9.87 -by (Fast_tac 1);
    9.88 -by (fast_tac (claset() addSEs [lemma1_2]) 1);
    9.89 -val lemma1 = result();
    9.90 -
    9.91 -Goalw [u_def] "a\\<noteq>0 ==> 0 \\<in> (\\<Union>b \\<in> u_(a). b)";
    9.92 -by (fast_tac (claset() addSEs [not_emptyE] addSIs [UN_I, RepFunI]) 1);
    9.93 -val lemma2_1 = result();
    9.94 -
    9.95 -Goal "[| A\\<noteq>0; 0\\<notin>A |] ==> (\\<Inter>x \\<in> {u_(a). a \\<in> A}. \\<Union>b \\<in> x. b) \\<noteq> 0";
    9.96 -by (etac not_emptyE 1);
    9.97 -by (res_inst_tac [("a","0")] not_emptyI 1);
    9.98 -by (fast_tac (claset() addSIs [lemma2_1]) 1);
    9.99 -val lemma2 = result();
   9.100 -
   9.101 -Goal "(\\<Union>f \\<in> F. P(f)) \\<noteq> 0 ==> F \\<noteq> 0";
   9.102 -by (fast_tac (claset() addSEs [not_emptyE]) 1);
   9.103 -val lemma3 = result();
   9.104 -
   9.105 -Goalw AC_defs "AC19 ==> AC1";
   9.106 -by (Clarify_tac 1);
   9.107 -by (case_tac "A=0" 1);
   9.108 -by (Force_tac 1);
   9.109 -by (eres_inst_tac [("x","{u_(a). a \\<in> A}")] allE 1);
   9.110 -by (etac impE 1);
   9.111 -by (etac RepRep_conj 1 THEN (assume_tac 1));
   9.112 -by (rtac lemma1 1);
   9.113 -by (dtac lemma2 1 THEN (assume_tac 1));
   9.114 -by (dres_inst_tac [("P","%x. x\\<noteq>0")] subst 1 THEN (assume_tac 1));
   9.115 -by (fast_tac (claset() addSEs [lemma3 RS not_emptyE]) 1);
   9.116 -qed "AC19_AC1";
   9.117 -
   9.118 -
    10.1 --- a/src/ZF/AC/AC18_AC19.thy	Wed Jan 16 15:04:37 2002 +0100
    10.2 +++ b/src/ZF/AC/AC18_AC19.thy	Wed Jan 16 17:52:06 2002 +0100
    10.3 @@ -2,17 +2,106 @@
    10.4      ID:         $Id$
    10.5      Author:     Krzysztof Grabczewski
    10.6  
    10.7 -Additional definition used in the proof AC19 ==> AC1 which is a part
    10.8 -of the chain AC1 ==> AC18 ==> AC19 ==> AC1
    10.9 +The proof of AC1 ==> AC18 ==> AC19 ==> AC1
   10.10  *)
   10.11  
   10.12 -AC18_AC19 = AC_Equiv +
   10.13 +theory AC18_AC19 = AC_Equiv:
   10.14 +
   10.15 +constdefs
   10.16 +  uu    :: "i => i"
   10.17 +    "uu(a) == {c Un {0}. c \<in> a}"
   10.18 +
   10.19 +
   10.20 +(* ********************************************************************** *)
   10.21 +(* AC1 ==> AC18                                                           *)
   10.22 +(* ********************************************************************** *)
   10.23 +
   10.24 +lemma PROD_subsets:
   10.25 +     "[| f \<in> (\<Pi>b \<in> {P(a). a \<in> A}. b);  \<forall>a \<in> A. P(a)<=Q(a) |]   
   10.26 +      ==> (\<lambda>a \<in> A. f`P(a)) \<in> (\<Pi>a \<in> A. Q(a))"
   10.27 +by (rule lam_type, drule apply_type, auto)
   10.28 +
   10.29 +lemma lemma_AC18:
   10.30 +     "[| \<forall>A. 0 \<notin> A --> (\<exists>f. f \<in> (\<Pi>X \<in> A. X)); A \<noteq> 0 |] 
   10.31 +      ==> (\<Inter>a \<in> A. \<Union>b \<in> B(a). X(a, b)) \<subseteq> 
   10.32 +          (\<Union>f \<in> \<Pi>a \<in> A. B(a). \<Inter>a \<in> A. X(a, f`a))"
   10.33 +apply (rule subsetI)
   10.34 +apply (erule_tac x = "{{b \<in> B (a) . x \<in> X (a,b) }. a \<in> A}" in allE)
   10.35 +apply (erule impE, fast)
   10.36 +apply (erule exE)
   10.37 +apply (rule UN_I)
   10.38 + apply (fast elim!: PROD_subsets)
   10.39 +apply (simp, fast elim!: not_emptyE dest: apply_type [OF _ RepFunI])
   10.40 +done
   10.41 +
   10.42 +lemma AC1_AC18: "AC1 ==> AC18"
   10.43 +apply (unfold AC1_def AC18_def)
   10.44 +apply (fast elim!: lemma_AC18 apply_type intro!: equalityI INT_I UN_I)
   10.45 +done
   10.46 +
   10.47 +(* ********************************************************************** *)
   10.48 +(* AC18 ==> AC19                                                          *)
   10.49 +(* ********************************************************************** *)
   10.50 +
   10.51 +text{*Hard to express because of the need for meta-quantifiers in AC18*}
   10.52 +lemma "AC18 ==> AC19"
   10.53 +proof -
   10.54 +  assume ac18 [unfolded AC18_def, norm_hhf]: AC18
   10.55 +  show AC19
   10.56 +    apply (unfold AC18_def AC19_def)
   10.57 +    apply (intro allI impI) 
   10.58 +    apply (rule ac18 [of _ "%x. x", THEN mp], blast) 
   10.59 +    done
   10.60 +qed
   10.61  
   10.62 -consts
   10.63 -  u_    :: i => i
   10.64 -  
   10.65 -defs
   10.66 +(* ********************************************************************** *)
   10.67 +(* AC19 ==> AC1                                                           *)
   10.68 +(* ********************************************************************** *)
   10.69 +
   10.70 +lemma RepRep_conj: 
   10.71 +        "[| A \<noteq> 0; 0 \<notin> A |] ==> {uu(a). a \<in> A} \<noteq> 0 & 0 \<notin> {uu(a). a \<in> A}"
   10.72 +apply (unfold uu_def, auto) 
   10.73 +apply (blast dest!: sym [THEN RepFun_eq_0_iff [THEN iffD1]])
   10.74 +done
   10.75 +
   10.76 +lemma lemma1_1: "[|c \<in> a; x = c Un {0}; x \<notin> a |] ==> x - {0} \<in> a"
   10.77 +apply clarify 
   10.78 +apply (rule subst_elem , (assumption))
   10.79 +apply (fast elim: notE subst_elem)
   10.80 +done
   10.81 +
   10.82 +lemma lemma1_2: 
   10.83 +        "[| f`(uu(a)) \<notin> a; f \<in> (\<Pi>B \<in> {uu(a). a \<in> A}. B); a \<in> A |]   
   10.84 +                ==> f`(uu(a))-{0} \<in> a"
   10.85 +apply (unfold uu_def, fast elim!: lemma1_1 dest!: apply_type)
   10.86 +done
   10.87  
   10.88 -  u_def "u_(a) == {c Un {0}. c \\<in> a}"
   10.89 +lemma lemma1: "\<exists>f. f \<in> (\<Pi>B \<in> {uu(a). a \<in> A}. B) ==> \<exists>f. f \<in> (\<Pi>B \<in> A. B)"
   10.90 +apply (erule exE)
   10.91 +apply (rule_tac x = "\<lambda>a\<in>A. if (f` (uu(a)) \<in> a, f` (uu(a)), f` (uu(a))-{0})" 
   10.92 +       in exI)
   10.93 +apply (rule lam_type) 
   10.94 +apply (simp add: lemma1_2)
   10.95 +done
   10.96 +
   10.97 +lemma lemma2_1: "a\<noteq>0 ==> 0 \<in> (\<Union>b \<in> uu(a). b)"
   10.98 +by (unfold uu_def, auto)
   10.99 +
  10.100 +lemma lemma2: "[| A\<noteq>0; 0\<notin>A |] ==> (\<Inter>x \<in> {uu(a). a \<in> A}. \<Union>b \<in> x. b) \<noteq> 0"
  10.101 +apply (erule not_emptyE) 
  10.102 +apply (rule_tac a = "0" in not_emptyI)
  10.103 +apply (fast intro!: lemma2_1)
  10.104 +done
  10.105 +
  10.106 +lemma AC19_AC1: "AC19 ==> AC1"
  10.107 +apply (unfold AC19_def AC1_def, clarify)
  10.108 +apply (case_tac "A=0", force)
  10.109 +apply (erule_tac x = "{uu (a) . a \<in> A}" in allE)
  10.110 +apply (erule impE)
  10.111 +apply (erule RepRep_conj , (assumption))
  10.112 +apply (rule lemma1)
  10.113 +apply (drule lemma2 , (assumption))
  10.114 +apply auto 
  10.115 +done
  10.116  
  10.117  end
    11.1 --- a/src/ZF/AC/AC1_WO2.ML	Wed Jan 16 15:04:37 2002 +0100
    11.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    11.3 @@ -1,22 +0,0 @@
    11.4 -(*  Title:      ZF/AC/AC1_WO2.ML
    11.5 -    ID:         $Id$
    11.6 -    Author:     Krzysztof Grabczewski
    11.7 -
    11.8 -The proof of AC1 ==> WO2
    11.9 -*)
   11.10 -
   11.11 -(*Establishing the existence of a bijection -- hence the need for uresult*)
   11.12 -val [prem] = goal thy "f \\<in> (\\<Pi>X \\<in> Pow(x) - {0}. X) ==>  \
   11.13 -\       ?g(f) \\<in> bij(x, LEAST i. HH(\\<lambda>X \\<in> Pow(x)-{0}. {f`X}, x, i) = {x})";
   11.14 -by (resolve_tac [bij_Least_HH_x RS bij_converse_bij] 1);
   11.15 -by (rtac f_subsets_imp_UN_HH_eq_x 1);
   11.16 -by (resolve_tac [lam_type RS apply_type] 1 THEN (assume_tac 2));
   11.17 -by (fast_tac (claset() addSDs [prem RS apply_type]) 1);
   11.18 -by (fast_tac (claset() addSIs [prem RS Pi_weaken_type]) 1);
   11.19 -val lemma1 = uresult() |> standard;
   11.20 -
   11.21 -Goalw [AC1_def, WO2_def, eqpoll_def] "AC1 ==> WO2";
   11.22 -by (rtac allI 1);
   11.23 -by (eres_inst_tac [("x","Pow(A)-{0}")] allE 1);
   11.24 -by (fast_tac (claset() addSDs [lemma1] addSIs [Ord_Least]) 1);
   11.25 -qed "AC1_WO2";
    12.1 --- a/src/ZF/AC/AC1_WO2.thy	Wed Jan 16 15:04:37 2002 +0100
    12.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    12.3 @@ -1,3 +0,0 @@
    12.4 -(*Dummy theory to document dependencies *)
    12.5 -
    12.6 -AC1_WO2 = HH
    13.1 --- a/src/ZF/AC/AC7_AC9.ML	Wed Jan 16 15:04:37 2002 +0100
    13.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    13.3 @@ -1,188 +0,0 @@
    13.4 -(*  Title:      ZF/AC/AC7-AC9.ML
    13.5 -    ID:         $Id$
    13.6 -    Author:     Krzysztof Grabczewski
    13.7 -
    13.8 -The proofs needed to state that AC7, AC8 and AC9 are equivalent to the previous
    13.9 -instances of AC.
   13.10 -*)
   13.11 -
   13.12 -(* ********************************************************************** *)
   13.13 -(* Lemmas used in the proofs AC7 ==> AC6 and AC9 ==> AC1                  *)
   13.14 -(*  - Sigma_fun_space_not0                                                *)
   13.15 -(*  - Sigma_fun_space_eqpoll                                              *)
   13.16 -(* ********************************************************************** *)
   13.17 -
   13.18 -Goal "[| 0\\<notin>A; B \\<in> A |] ==> (nat->Union(A)) * B \\<noteq> 0";
   13.19 -by (blast_tac (claset() addSDs [Sigma_empty_iff RS iffD1, 
   13.20 -				Union_empty_iff RS iffD1]) 1);
   13.21 -qed "Sigma_fun_space_not0";
   13.22 -
   13.23 -Goalw [inj_def]
   13.24 -        "C \\<in> A ==> (\\<lambda>g \\<in> (nat->Union(A))*C.  \
   13.25 -\               (\\<lambda>n \\<in> nat. if(n=0, snd(g), fst(g)`(n #- 1))))  \
   13.26 -\               \\<in> inj((nat->Union(A))*C, (nat->Union(A)) ) ";
   13.27 -by (rtac CollectI 1);
   13.28 -by (fast_tac (claset() addSIs [lam_type,RepFunI,if_type,snd_type,apply_type,
   13.29 -                                fst_type,diff_type,nat_succI,nat_0I]) 1);
   13.30 -by (REPEAT (resolve_tac [ballI, impI] 1));
   13.31 -by (Asm_full_simp_tac 1);
   13.32 -by (REPEAT (etac SigmaE 1));
   13.33 -by (REPEAT (hyp_subst_tac 1));
   13.34 -by (Asm_full_simp_tac 1);
   13.35 -by (rtac conjI 1);
   13.36 -by (dresolve_tac [nat_0I RSN (2, lam_eqE)] 2);
   13.37 -by (Asm_full_simp_tac 2);
   13.38 -by (rtac fun_extension 1 THEN  REPEAT (assume_tac 1));
   13.39 -by (dresolve_tac [nat_succI RSN (2, lam_eqE)] 1 THEN (assume_tac 1));
   13.40 -by (asm_full_simp_tac (simpset() addsimps [succ_not_0 RS if_not_P]) 1);
   13.41 -val lemma = result();
   13.42 -
   13.43 -Goal "[| C \\<in> A; 0\\<notin>A |] ==> (nat->Union(A)) * C eqpoll (nat->Union(A))";
   13.44 -by (rtac eqpollI 1);
   13.45 -by (fast_tac (claset() addSEs [prod_lepoll_self, not_sym RS not_emptyE,
   13.46 -                subst_elem] addEs [swap]) 2);
   13.47 -by (rewtac lepoll_def);
   13.48 -by (fast_tac (claset() addSIs [lemma]) 1);
   13.49 -qed "Sigma_fun_space_eqpoll";
   13.50 -
   13.51 -
   13.52 -(* ********************************************************************** *)
   13.53 -(* AC6 ==> AC7                                                            *)
   13.54 -(* ********************************************************************** *)
   13.55 -
   13.56 -Goalw AC_defs "AC6 ==> AC7";
   13.57 -by (Blast_tac 1);
   13.58 -qed "AC6_AC7";
   13.59 -
   13.60 -(* ********************************************************************** *)
   13.61 -(* AC7 ==> AC6, Rubin & Rubin p. 12, Theorem 2.8                          *)
   13.62 -(* The case of the empty family of sets added in order to complete        *)
   13.63 -(* the proof.                                                             *)
   13.64 -(* ********************************************************************** *)
   13.65 -
   13.66 -Goal "y \\<in> (\\<Pi>B \\<in> A. Y*B) ==> (\\<lambda>B \\<in> A. snd(y`B)): (\\<Pi>B \\<in> A. B)";
   13.67 -by (fast_tac (claset() addSIs [lam_type, snd_type, apply_type]) 1);
   13.68 -val lemma1_1 = result();
   13.69 -
   13.70 -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)";
   13.71 -by (fast_tac (claset() addSIs [lam_type, apply_type]) 1);
   13.72 -val lemma1_2 = result();
   13.73 -
   13.74 -Goal "(\\<Pi>B \\<in> {(nat->Union(A))*C. C \\<in> A}. B) \\<noteq> 0 ==> (\\<Pi>B \\<in> A. B) \\<noteq> 0";
   13.75 -by (fast_tac (claset() addSIs [equals0I,lemma1_1, lemma1_2]) 1);
   13.76 -val lemma1 = result();
   13.77 -
   13.78 -Goal "0 \\<notin> A ==> 0 \\<notin> {(nat -> Union(A)) * C. C \\<in> A}";
   13.79 -by (fast_tac (claset() addEs [Sigma_fun_space_not0 RS not_sym RS notE]) 1);
   13.80 -val lemma2 = result();
   13.81 -
   13.82 -Goalw AC_defs "AC7 ==> AC6";
   13.83 -by (rtac allI 1);
   13.84 -by (rtac impI 1);
   13.85 -by (case_tac "A=0" 1);
   13.86 -by (Asm_simp_tac 1);
   13.87 -by (rtac lemma1 1);
   13.88 -by (etac allE 1);
   13.89 -by (etac impE 1 THEN (assume_tac 2));
   13.90 -by (blast_tac (claset() addSIs [lemma2] 
   13.91 -                addIs [eqpoll_sym, eqpoll_trans, Sigma_fun_space_eqpoll]) 1); 
   13.92 -qed "AC7_AC6";
   13.93 -
   13.94 -
   13.95 -(* ********************************************************************** *)
   13.96 -(* AC1 ==> AC8                                                            *)
   13.97 -(* ********************************************************************** *)
   13.98 -
   13.99 -Goalw [eqpoll_def]
  13.100 -        "\\<forall>B \\<in> A. \\<exists>B1 B2. B=<B1,B2> & B1 eqpoll B2  \
  13.101 -\       ==> 0 \\<notin> { bij(fst(B),snd(B)). B \\<in> A }";
  13.102 -by Auto_tac;
  13.103 -val lemma1 = result();
  13.104 -
  13.105 -Goal "[| f \\<in> (\\<Pi>X \\<in> RepFun(A,p). X); D \\<in> A |] ==> (\\<lambda>x \\<in> A. f`p(x))`D \\<in> p(D)";
  13.106 -by (resolve_tac [beta RS ssubst] 1 THEN (assume_tac 1));
  13.107 -by (fast_tac (claset() addSEs [apply_type]) 1);
  13.108 -val lemma2 = result();
  13.109 -
  13.110 -Goalw AC_defs "AC1 ==> AC8";
  13.111 -by (Clarify_tac 1);
  13.112 -by (dtac lemma1 1);
  13.113 -by (fast_tac (claset() addSEs [lemma2]) 1);
  13.114 -qed "AC1_AC8";
  13.115 -
  13.116 -
  13.117 -(* ********************************************************************** *)
  13.118 -(* AC8 ==> AC9                                                            *)
  13.119 -(*  - this proof replaces the following two from Rubin & Rubin:           *)
  13.120 -(*    AC8 ==> AC1 and AC1 ==> AC9                                         *)
  13.121 -(* ********************************************************************** *)
  13.122 -
  13.123 -Goal "\\<forall>B1 \\<in> A. \\<forall>B2 \\<in> A. B1 eqpoll B2  \
  13.124 -\     ==> \\<forall>B \\<in> A*A. \\<exists>B1 B2. B=<B1,B2> & B1 eqpoll B2";
  13.125 -by (Fast_tac 1);
  13.126 -val lemma1 = result();
  13.127 -
  13.128 -Goal "f \\<in> bij(fst(<a,b>),snd(<a,b>)) ==> f \\<in> bij(a,b)";
  13.129 -by (Asm_full_simp_tac 1);
  13.130 -val lemma2 = result();
  13.131 -
  13.132 -Goalw AC_defs "AC8 ==> AC9";
  13.133 -by (rtac allI 1);
  13.134 -by (rtac impI 1);
  13.135 -by (etac allE 1);
  13.136 -by (etac impE 1);
  13.137 -by (etac lemma1 1);
  13.138 -by (fast_tac (claset() addSEs [lemma2]) 1);
  13.139 -qed "AC8_AC9";
  13.140 -
  13.141 -
  13.142 -(* ********************************************************************** *)
  13.143 -(* AC9 ==> AC1                                                            *)
  13.144 -(* The idea of this proof comes from "Equivalents of the Axiom of Choice" *)
  13.145 -(* by Rubin & Rubin. But (x * y) is not necessarily equipollent to        *)
  13.146 -(* (x * y) Un {0} when y is a set of total functions acting from nat to   *)
  13.147 -(* Union(A) -- therefore we have used the set (y * nat) instead of y.     *)
  13.148 -(* ********************************************************************** *)
  13.149 -
  13.150 -(* Rules nedded to prove lemma1 *)
  13.151 -val snd_lepoll_SigmaI = prod_lepoll_self RS 
  13.152 -        ((prod_commute_eqpoll RS eqpoll_imp_lepoll) RSN (2,lepoll_trans));
  13.153 -
  13.154 -
  13.155 -Goal "[|0 \\<notin> A; B \\<in> A|] ==> nat \\<lesssim> ((nat \\<rightarrow> Union(A)) \\<times> B) \\<times> nat";
  13.156 -by (blast_tac (claset() addDs [Sigma_fun_space_not0]
  13.157 -                        addIs [snd_lepoll_SigmaI]) 1);
  13.158 -qed "nat_lepoll_lemma";
  13.159 -
  13.160 -
  13.161 -Goal "[| 0\\<notin>A;  A\\<noteq>0;  \
  13.162 -\        C = {((nat->Union(A))*B)*nat. B \\<in> A}  Un \
  13.163 -\            {cons(0,((nat->Union(A))*B)*nat). B \\<in> A}; \
  13.164 -\        B1: C;  B2: C |]  \
  13.165 -\     ==> B1 eqpoll B2";
  13.166 -by (blast_tac
  13.167 -    (claset() delrules [eqpoll_refl]
  13.168 -	      addSIs [nat_lepoll_lemma, nat_cons_eqpoll RS eqpoll_trans, 
  13.169 -                      eqpoll_refl RSN (2, prod_eqpoll_cong)]
  13.170 -              addIs [eqpoll_trans, eqpoll_sym, Sigma_fun_space_eqpoll]) 1);
  13.171 -val lemma1 = result();
  13.172 -
  13.173 -Goal "\\<forall>B1 \\<in> {(F*B)*N. B \\<in> A} Un {cons(0,(F*B)*N). B \\<in> A}.  \
  13.174 -\     \\<forall>B2 \\<in> {(F*B)*N. B \\<in> A} Un {cons(0,(F*B)*N). B \\<in> A}.  \
  13.175 -\       f`<B1,B2> \\<in> bij(B1, B2)  \
  13.176 -\   ==> (\\<lambda>B \\<in> A. snd(fst((f`<cons(0,(F*B)*N),(F*B)*N>)`0))) \\<in> (\\<Pi>X \\<in> A. X)";
  13.177 -by (rtac lam_type 1);
  13.178 -by (rtac snd_type 1);
  13.179 -by (rtac fst_type 1);
  13.180 -by (resolve_tac [consI1 RSN (2, apply_type)] 1);
  13.181 -by (fast_tac (claset() addSIs [fun_weaken_type, bij_is_fun]) 1);
  13.182 -val lemma2 = result();
  13.183 -
  13.184 -Goalw AC_defs "AC9 ==> AC1";
  13.185 -by (rtac allI 1);
  13.186 -by (rtac impI 1);
  13.187 -by (etac allE 1);
  13.188 -by (case_tac "A=0" 1);
  13.189 -by (blast_tac (claset() addDs [lemma1,lemma2]) 2); 
  13.190 -by Auto_tac;  
  13.191 -qed "AC9_AC1";
    14.1 --- a/src/ZF/AC/AC_Equiv.ML	Wed Jan 16 15:04:37 2002 +0100
    14.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    14.3 @@ -1,126 +0,0 @@
    14.4 -(*  Title:      ZF/AC/AC_Equiv.ML
    14.5 -    ID:         $Id$
    14.6 -    Author:     Krzysztof Grabczewski
    14.7 -
    14.8 -*)
    14.9 -
   14.10 -val WO_defs = [WO1_def, WO2_def, WO3_def, WO4_def, WO5_def, WO6_def, WO8_def];
   14.11 - 
   14.12 -val AC_defs = [AC0_def, AC1_def, AC2_def, AC3_def, AC4_def, AC5_def, 
   14.13 -               AC6_def, AC7_def, AC8_def, AC9_def, AC10_def, AC11_def, 
   14.14 -               AC12_def, AC13_def, AC14_def, AC15_def, AC16_def, 
   14.15 -               AC17_def, AC18_def, AC19_def];
   14.16 - 
   14.17 -val AC_aux_defs = [pairwise_disjoint_def, sets_of_size_between_def];
   14.18 - 
   14.19 -
   14.20 -(* ********************************************************************** *)
   14.21 -(*             lemmas concerning FOL and pure ZF theory                   *)
   14.22 -(* ********************************************************************** *)
   14.23 -
   14.24 -(* used only in WO1_DC.ML *)
   14.25 -(*Note simpler proof*)
   14.26 -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";
   14.27 -by (asm_simp_tac (simpset() addsimps [image_fun]) 1);
   14.28 -qed "images_eq";
   14.29 -
   14.30 -(* used in \\<in> AC10-AC15.ML AC16WO4.ML WO6WO1.ML *)
   14.31 -(*I don't know where to put this one.*)
   14.32 -Goal
   14.33 -     "!!m A B. [| A lepoll succ(m); B \\<subseteq> A; B\\<noteq>0 |] ==> A-B lepoll m";
   14.34 -by (rtac not_emptyE 1 THEN (assume_tac 1));
   14.35 -by (ftac singleton_subsetI 1);
   14.36 -by (ftac subsetD 1 THEN (assume_tac 1));
   14.37 -by (res_inst_tac [("A2","A")] 
   14.38 -     (Diff_sing_lepoll RSN (2, subset_imp_lepoll RS lepoll_trans)) 1 
   14.39 -    THEN (REPEAT (assume_tac 2)));
   14.40 -by (Fast_tac 1);
   14.41 -qed "Diff_lepoll";
   14.42 -
   14.43 -(* ********************************************************************** *)
   14.44 -(*              lemmas concerning lepoll and eqpoll relations             *)
   14.45 -(* ********************************************************************** *)
   14.46 -
   14.47 -(* ********************************************************************** *)
   14.48 -(*                    Theorems concerning ordinals                        *)
   14.49 -(* ********************************************************************** *)
   14.50 -
   14.51 -(* lemma for ordertype_Int *)
   14.52 -goalw Cardinal.thy [rvimage_def] "rvimage(A,id(A),r) = r Int A*A";
   14.53 -by (rtac equalityI 1);
   14.54 -by Safe_tac;
   14.55 -by (dres_inst_tac [("P","%a. <id(A)`xb,a>:r")] (id_conv RS subst) 1
   14.56 -    THEN (assume_tac 1));
   14.57 -by (dres_inst_tac [("P","%a. <a,ya>:r")] (id_conv RS subst) 1
   14.58 -    THEN (REPEAT (assume_tac 1)));
   14.59 -by (fast_tac (claset() addIs [id_conv RS ssubst]) 1);
   14.60 -qed "rvimage_id";
   14.61 -
   14.62 -(* used only in Hartog.ML *)
   14.63 -goal Cardinal.thy
   14.64 -        "!!A r. well_ord(A,r) ==> ordertype(A, r Int A*A) = ordertype(A,r)";
   14.65 -by (res_inst_tac [("P","%a. ordertype(A,a)=ordertype(A,r)")] 
   14.66 -    (rvimage_id RS subst) 1);
   14.67 -by (eresolve_tac [id_bij RS bij_ordertype_vimage] 1);
   14.68 -qed "ordertype_Int";
   14.69 -
   14.70 -(* used only in AC16_lemmas.ML *)
   14.71 -Goalw [InfCard_def]
   14.72 -        "!!i. [| ~Finite(i); Card(i) |] ==> InfCard(i)";
   14.73 -by (asm_simp_tac (simpset() addsimps [Card_is_Ord RS nat_le_infinite_Ord]) 1);
   14.74 -qed "Inf_Card_is_InfCard";
   14.75 -
   14.76 -Goal "(THE z. {x}={z}) = x";
   14.77 -by (fast_tac (claset() addSEs [singleton_eq_iff RS iffD1 RS sym]) 1);
   14.78 -qed "the_element";
   14.79 -
   14.80 -Goal "(\\<lambda>x \\<in> A. {x}) \\<in> bij(A, {{x}. x \\<in> A})";
   14.81 -by (res_inst_tac [("d","%z. THE x. z={x}")] lam_bijective 1);
   14.82 -by (TRYALL (eresolve_tac [RepFunI, RepFunE]));
   14.83 -by (REPEAT (asm_full_simp_tac (simpset() addsimps [the_element]) 1));
   14.84 -qed "lam_sing_bij";
   14.85 -
   14.86 -val [major, minor] = Goalw [inj_def]
   14.87 -        "[| f \\<in> inj(A, B);  !!a. a \\<in> A ==> f`a \\<in> C |] ==> f \\<in> inj(A,C)";
   14.88 -by (fast_tac (claset() addSEs [minor]
   14.89 -        addSIs [major RS CollectD1 RS Pi_type, major RS CollectD2]) 1);
   14.90 -qed "inj_strengthen_type";
   14.91 -
   14.92 -Goalw [Finite_def] "~Finite(nat)";
   14.93 -by (fast_tac (claset() addSDs [eqpoll_imp_lepoll]
   14.94 -                addIs [Ord_nat RSN (2, ltI) RS lt_not_lepoll RS notE]) 1);
   14.95 -qed "nat_not_Finite";
   14.96 -
   14.97 -val le_imp_lepoll = le_imp_subset RS subset_imp_lepoll;
   14.98 -
   14.99 -(* ********************************************************************** *)
  14.100 -(* Another elimination rule for \\<exists>!                                       *)
  14.101 -(* ********************************************************************** *)
  14.102 -
  14.103 -Goal "[| \\<exists>! x. P(x); P(x); P(y) |] ==> x=y";
  14.104 -by (etac ex1E 1);
  14.105 -by (res_inst_tac [("b","xa")] (sym RSN (2, trans)) 1);
  14.106 -by (Fast_tac 1);
  14.107 -by (Fast_tac 1);
  14.108 -qed "ex1_two_eq";
  14.109 -
  14.110 -(* ********************************************************************** *)
  14.111 -(* image of a surjection                                                  *)
  14.112 -(* ********************************************************************** *)
  14.113 -
  14.114 -Goalw [surj_def] "f \\<in> surj(A, B) ==> f``A = B";
  14.115 -by (etac CollectE 1);
  14.116 -by (resolve_tac [subset_refl RSN (2, image_fun) RS ssubst] 1 
  14.117 -    THEN (assume_tac 1));
  14.118 -by (fast_tac (claset() addSEs [apply_type] addIs [equalityI]) 1);
  14.119 -qed "surj_image_eq";
  14.120 -
  14.121 -
  14.122 -Goal "succ(x) lepoll y ==> y \\<noteq> 0";
  14.123 -by (fast_tac (claset() addSDs [lepoll_0_is_0]) 1);
  14.124 -qed "succ_lepoll_imp_not_empty";
  14.125 -
  14.126 -Goal "x eqpoll succ(n) ==> x \\<noteq> 0";
  14.127 -by (fast_tac (claset() addSEs [eqpoll_sym RS eqpoll_0_is_0 RS succ_neq_0]) 1);
  14.128 -qed "eqpoll_succ_imp_not_empty";
  14.129 -
    15.1 --- a/src/ZF/AC/AC_Equiv.thy	Wed Jan 16 15:04:37 2002 +0100
    15.2 +++ b/src/ZF/AC/AC_Equiv.thy	Wed Jan 16 17:52:06 2002 +0100
    15.3 @@ -12,114 +12,231 @@
    15.4  but slightly changed.
    15.5  *)
    15.6  
    15.7 +theory AC_Equiv = Main: (*obviously not Main_ZFC*)
    15.8  
    15.9 -AC_Equiv = Main + (*obviously not Main_ZFC*)
   15.10 -
   15.11 -consts
   15.12 +constdefs
   15.13    
   15.14  (* Well Ordering Theorems *)
   15.15 -  WO1, WO2, WO3, WO5, WO6, WO7, WO8 :: o
   15.16 -  WO4                               :: i => o
   15.17 +  WO1 :: o
   15.18 +    "WO1 == \<forall>A. \<exists>R. well_ord(A,R)"
   15.19 +
   15.20 +  WO2 :: o
   15.21 +    "WO2 == \<forall>A. \<exists>a. Ord(a) & A\<approx>a"
   15.22  
   15.23 -(* Axioms of Choice *)  
   15.24 -  AC0, AC1, AC2, AC3, AC4, AC5, AC6, AC7, AC8, AC9,
   15.25 -  AC11, AC12, AC14, AC15, AC17, AC19 :: o
   15.26 -  AC10, AC13              :: i => o
   15.27 -  AC16                    :: [i, i] => o
   15.28 -  AC18                    :: prop       ("AC18")
   15.29 +  WO3 :: o
   15.30 +    "WO3 == \<forall>A. \<exists>a. Ord(a) & (\<exists>b. b \<subseteq> a & A\<approx>b)"
   15.31  
   15.32 -(* Auxiliary definitions used in definitions *)
   15.33 -  pairwise_disjoint       :: i => o
   15.34 -  sets_of_size_between    :: [i, i, i] => o
   15.35 +  WO4 :: "i => o"
   15.36 +    "WO4(m) == \<forall>A. \<exists>a f. Ord(a) & domain(f)=a &   
   15.37 +		         (\<Union>b<a. f`b) = A & (\<forall>b<a. f`b \<lesssim> m)"
   15.38  
   15.39 -defs
   15.40 -
   15.41 -(* Well Ordering Theorems *)
   15.42 +  WO5 :: o
   15.43 +    "WO5 == \<exists>m \<in> nat. 1\<le>m & WO4(m)"
   15.44  
   15.45 -  WO1_def "WO1 == \\<forall>A. \\<exists>R. well_ord(A,R)"
   15.46 -
   15.47 -  WO2_def "WO2 == \\<forall>A. \\<exists>a. Ord(a) & A eqpoll a"
   15.48 +  WO6 :: o
   15.49 +    "WO6 == \<forall>A. \<exists>m \<in> nat. 1\<le>m & (\<exists>a f. Ord(a) & domain(f)=a
   15.50 +		               & (\<Union>b<a. f`b) = A & (\<forall>b<a. f`b \<lesssim> m))"
   15.51  
   15.52 -  WO3_def "WO3 == \\<forall>A. \\<exists>a. Ord(a) & (\\<exists>b. b \\<subseteq> a & A eqpoll b)"
   15.53 -
   15.54 -  WO4_def "WO4(m) == \\<forall>A. \\<exists>a f. Ord(a) & domain(f)=a &   
   15.55 -                     (\\<Union>b<a. f`b) = A & (\\<forall>b<a. f`b lepoll m)"
   15.56 +  WO7 :: o
   15.57 +    "WO7 == \<forall>A. Finite(A) <-> (\<forall>R. well_ord(A,R) --> well_ord(A,converse(R)))"
   15.58  
   15.59 -  WO5_def "WO5 == \\<exists>m \\<in> nat. 1 le m & WO4(m)"
   15.60 +  WO8 :: o
   15.61 +    "WO8 == \<forall>A. (\<exists>f. f \<in> (\<Pi>X \<in> A. X)) --> (\<exists>R. well_ord(A,R))"
   15.62  
   15.63 -  WO6_def "WO6 == \\<forall>A. \\<exists>m \\<in> nat. 1 le m & (\\<exists>a f. Ord(a) & domain(f)=a   
   15.64 -                    & (\\<Union>b<a. f`b) = A & (\\<forall>b<a. f`b lepoll m))"
   15.65  
   15.66 -  WO7_def "WO7 == \\<forall>A. Finite(A) <-> (\\<forall>R. well_ord(A,R) -->   
   15.67 -                    well_ord(A,converse(R)))"
   15.68 +(* Auxiliary concepts needed below *)
   15.69 +  pairwise_disjoint :: "i => o"
   15.70 +    "pairwise_disjoint(A) == \<forall>A1 \<in> A. \<forall>A2 \<in> A. A1 Int A2 \<noteq> 0 --> A1=A2"
   15.71  
   15.72 -  WO8_def "WO8 == \\<forall>A. (\\<exists>f. f \\<in> (\\<Pi>X \\<in> A. X)) --> (\\<exists>R. well_ord(A,R))"
   15.73 +  sets_of_size_between :: "[i, i, i] => o"
   15.74 +    "sets_of_size_between(A,m,n) == \<forall>B \<in> A. m \<lesssim> B & B \<lesssim> n"
   15.75 +
   15.76  
   15.77  (* Axioms of Choice *)  
   15.78 +  AC0 :: o
   15.79 +    "AC0 == \<forall>A. \<exists>f. f \<in> (\<Pi>X \<in> Pow(A)-{0}. X)"
   15.80  
   15.81 -  AC0_def "AC0 == \\<forall>A. \\<exists>f. f \\<in> (\\<Pi>X \\<in> Pow(A)-{0}. X)"
   15.82 +  AC1 :: o
   15.83 +    "AC1 == \<forall>A. 0\<notin>A --> (\<exists>f. f \<in> (\<Pi>X \<in> A. X))"
   15.84 +
   15.85 +  AC2 :: o
   15.86 +    "AC2 == \<forall>A. 0\<notin>A & pairwise_disjoint(A)   
   15.87 +		   --> (\<exists>C. \<forall>B \<in> A. \<exists>y. B Int C = {y})"
   15.88 +  AC3 :: o
   15.89 +    "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)"
   15.90  
   15.91 -  AC1_def "AC1 == \\<forall>A. 0\\<notin>A --> (\\<exists>f. f \\<in> (\\<Pi>X \\<in> A. X))"
   15.92 +  AC4 :: o
   15.93 +    "AC4 == \<forall>R A B. (R \<subseteq> A*B --> (\<exists>f. f \<in> (\<Pi>x \<in> domain(R). R``{x})))"
   15.94 +
   15.95 +  AC5 :: o
   15.96 +    "AC5 == \<forall>A B. \<forall>f \<in> A->B. \<exists>g \<in> range(f)->A. \<forall>x \<in> domain(g). f`(g`x) = x"
   15.97 +
   15.98 +  AC6 :: o
   15.99 +    "AC6 == \<forall>A. 0\<notin>A --> (\<Pi>B \<in> A. B)\<noteq>0"
  15.100  
  15.101 -  AC2_def "AC2 == \\<forall>A. 0\\<notin>A & pairwise_disjoint(A)   
  15.102 -                    --> (\\<exists>C. \\<forall>B \\<in> A. \\<exists>y. B Int C = {y})"
  15.103 +  AC7 :: o
  15.104 +    "AC7 == \<forall>A. 0\<notin>A & (\<forall>B1 \<in> A. \<forall>B2 \<in> A. B1\<approx>B2) --> (\<Pi>B \<in> A. B) \<noteq> 0"
  15.105  
  15.106 -  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)"
  15.107 +  AC8 :: o
  15.108 +    "AC8 == \<forall>A. (\<forall>B \<in> A. \<exists>B1 B2. B=<B1,B2> & B1\<approx>B2)   
  15.109 +		   --> (\<exists>f. \<forall>B \<in> A. f`B \<in> bij(fst(B),snd(B)))"
  15.110 +
  15.111 +  AC9 :: o
  15.112 +    "AC9 == \<forall>A. (\<forall>B1 \<in> A. \<forall>B2 \<in> A. B1\<approx>B2) -->   
  15.113 +		   (\<exists>f. \<forall>B1 \<in> A. \<forall>B2 \<in> A. f`<B1,B2> \<in> bij(B1,B2))"
  15.114  
  15.115 -  AC4_def "AC4 == \\<forall>R A B. (R \\<subseteq> A*B --> (\\<exists>f. f \\<in> (\\<Pi>x \\<in> domain(R). R``{x})))"
  15.116 +  AC10 :: "i => o"
  15.117 +    "AC10(n) ==  \<forall>A. (\<forall>B \<in> A. ~Finite(B)) -->   
  15.118 +		   (\<exists>f. \<forall>B \<in> A. (pairwise_disjoint(f`B) &   
  15.119 +		   sets_of_size_between(f`B, 2, succ(n)) & Union(f`B)=B))"
  15.120  
  15.121 -  AC5_def "AC5 == \\<forall>A B. \\<forall>f \\<in> A->B. \\<exists>g \\<in> range(f)->A.   
  15.122 -                    \\<forall>x \\<in> domain(g). f`(g`x) = x"
  15.123 +  AC11 :: o
  15.124 +    "AC11 == \<exists>n \<in> nat. 1\<le>n & AC10(n)"
  15.125 +
  15.126 +  AC12 :: o
  15.127 +    "AC12 == \<forall>A. (\<forall>B \<in> A. ~Finite(B)) -->
  15.128 +  	         (\<exists>n \<in> nat. 1\<le>n & (\<exists>f. \<forall>B \<in> A. (pairwise_disjoint(f`B) &   
  15.129 +	              sets_of_size_between(f`B, 2, succ(n)) & Union(f`B)=B)))"
  15.130  
  15.131 -  AC6_def "AC6 == \\<forall>A. 0\\<notin>A --> (\\<Pi>B \\<in> A. B)\\<noteq>0"
  15.132 +  AC13 :: "i => o"
  15.133 +    "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)"
  15.134 +
  15.135 +  AC14 :: o
  15.136 +    "AC14 == \<exists>m \<in> nat. 1\<le>m & AC13(m)"
  15.137 +
  15.138 +  AC15 :: o
  15.139 +    "AC15 == \<forall>A. 0\<notin>A --> 
  15.140 +                 (\<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))"
  15.141  
  15.142 -  AC7_def "AC7 == \\<forall>A. 0\\<notin>A & (\\<forall>B1 \\<in> A. \\<forall>B2 \\<in> A. B1 eqpoll B2)   
  15.143 -                    --> (\\<Pi>B \\<in> A. B)\\<noteq>0"
  15.144 +  AC16 :: "[i, i] => o"
  15.145 +    "AC16(n, k)  == 
  15.146 +       \<forall>A. ~Finite(A) -->   
  15.147 +	   (\<exists>T. T \<subseteq> {X \<in> Pow(A). X\<approx>succ(n)} &   
  15.148 +	   (\<forall>X \<in> {X \<in> Pow(A). X\<approx>succ(k)}. \<exists>! Y. Y \<in> T & X \<subseteq> Y))"
  15.149  
  15.150 -  AC8_def "AC8 == \\<forall>A. (\\<forall>B \\<in> A. \\<exists>B1 B2. B=<B1,B2> & B1 eqpoll B2)   
  15.151 -                    --> (\\<exists>f. \\<forall>B \\<in> A. f`B \\<in> bij(fst(B),snd(B)))"
  15.152 +  AC17 :: o
  15.153 +    "AC17 == \<forall>A. \<forall>g \<in> (Pow(A)-{0} -> A) -> Pow(A)-{0}.   
  15.154 +		   \<exists>f \<in> Pow(A)-{0} -> A. f`(g`f) \<in> g`f"
  15.155  
  15.156 -  AC9_def "AC9 == \\<forall>A. (\\<forall>B1 \\<in> A. \\<forall>B2 \\<in> A. B1 eqpoll B2) -->   
  15.157 -                    (\\<exists>f. \\<forall>B1 \\<in> A. \\<forall>B2 \\<in> A. f`<B1,B2> \\<in> bij(B1,B2))"
  15.158 +  AC18 :: "prop" ("AC18")
  15.159 +    "AC18 == (!!X A B. A\<noteq>0 & (\<forall>a \<in> A. B(a) \<noteq> 0) -->   
  15.160 +		((\<Inter>a \<in> A. \<Union>b \<in> B(a). X(a,b)) =   
  15.161 +		(\<Union>f \<in> \<Pi>a \<in> A. B(a). \<Inter>a \<in> A. X(a, f`a))))"
  15.162 +  --"AC18 can be expressed only using meta-level quantification"
  15.163 +
  15.164 +  AC19 :: o
  15.165 +    "AC19 == \<forall>A. A\<noteq>0 & 0\<notin>A --> ((\<Inter>a \<in> A. \<Union>b \<in> a. b) =   
  15.166 +		   (\<Union>f \<in> (\<Pi>B \<in> A. B). \<Inter>a \<in> A. f`a))"
  15.167 +
  15.168 +
  15.169  
  15.170 -  AC10_def "AC10(n) ==  \\<forall>A. (\\<forall>B \\<in> A. ~Finite(B)) -->   
  15.171 -                    (\\<exists>f. \\<forall>B \\<in> A. (pairwise_disjoint(f`B) &   
  15.172 -                    sets_of_size_between(f`B, 2, succ(n)) & Union(f`B)=B))"
  15.173 +(* ********************************************************************** *)
  15.174 +(*                    Theorems concerning ordinals                        *)
  15.175 +(* ********************************************************************** *)
  15.176  
  15.177 -  AC11_def "AC11 == \\<exists>n \\<in> nat. 1 le n & AC10(n)"
  15.178 +(* lemma for ordertype_Int *)
  15.179 +lemma rvimage_id: "rvimage(A,id(A),r) = r Int A*A"
  15.180 +apply (unfold rvimage_def)
  15.181 +apply (rule equalityI, safe)
  15.182 +apply (drule_tac P = "%a. <id (A) `xb,a>:r" in id_conv [THEN subst],
  15.183 +       (assumption))
  15.184 +apply (drule_tac P = "%a. <a,ya>:r" in id_conv [THEN subst], (assumption+))
  15.185 +apply (fast intro: id_conv [THEN ssubst])
  15.186 +done
  15.187  
  15.188 -  AC12_def "AC12 == \\<forall>A. (\\<forall>B \\<in> A. ~Finite(B)) -->   
  15.189 -            (\\<exists>n \\<in> nat. 1 le n & (\\<exists>f. \\<forall>B \\<in> A. (pairwise_disjoint(f`B) &   
  15.190 -            sets_of_size_between(f`B, 2, succ(n)) & Union(f`B)=B)))"
  15.191 +(* used only in Hartog.ML *)
  15.192 +lemma ordertype_Int:
  15.193 +     "well_ord(A,r) ==> ordertype(A, r Int A*A) = ordertype(A,r)"
  15.194 +apply (rule_tac P = "%a. ordertype (A,a) =ordertype (A,r) " in rvimage_id [THEN subst])
  15.195 +apply (erule id_bij [THEN bij_ordertype_vimage])
  15.196 +done
  15.197 +
  15.198 +lemma the_element: "(THE z. {x}={z}) = x"
  15.199 +by (fast elim!: singleton_eq_iff [THEN iffD1, symmetric])
  15.200  
  15.201 -  AC13_def "AC13(m) == \\<forall>A. 0\\<notin>A --> (\\<exists>f. \\<forall>B \\<in> A. f`B\\<noteq>0 &   
  15.202 -                                          f`B \\<subseteq> B & f`B lepoll m)"
  15.203 +lemma lam_sing_bij: "(\<lambda>x \<in> A. {x}) \<in> bij(A, {{x}. x \<in> A})"
  15.204 +apply (rule_tac d = "%z. THE x. z={x}" in lam_bijective)
  15.205 +apply (auto simp add: the_element) 
  15.206 +done
  15.207 +
  15.208 +lemma inj_strengthen_type: 
  15.209 +     "[| f \<in> inj(A, B);  !!a. a \<in> A ==> f`a \<in> C |] ==> f \<in> inj(A,C)"
  15.210 +by (unfold inj_def, blast intro: Pi_type) 
  15.211 +
  15.212 +lemma nat_not_Finite: "~ Finite(nat)"
  15.213 +by (unfold Finite_def, blast dest: eqpoll_imp_lepoll ltI lt_not_lepoll)
  15.214  
  15.215 -  AC14_def "AC14 == \\<exists>m \\<in> nat. 1 le m & AC13(m)"
  15.216 +lemmas le_imp_lepoll = le_imp_subset [THEN subset_imp_lepoll]
  15.217 +
  15.218 +(* ********************************************************************** *)
  15.219 +(* Another elimination rule for \<exists>!                                       *)
  15.220 +(* ********************************************************************** *)
  15.221 +
  15.222 +lemma ex1_two_eq: "[| \<exists>! x. P(x); P(x); P(y) |] ==> x=y"
  15.223 +by blast
  15.224  
  15.225 -  AC15_def "AC15 == \\<forall>A. 0\\<notin>A --> (\\<exists>m \\<in> nat. 1 le m & (\\<exists>f. \\<forall>B \\<in> A.   
  15.226 -                                      f`B\\<noteq>0 & f`B \\<subseteq> B & f`B lepoll m))"
  15.227 +(* ********************************************************************** *)
  15.228 +(* image of a surjection                                                  *)
  15.229 +(* ********************************************************************** *)
  15.230  
  15.231 -  AC16_def "AC16(n, k)  == \\<forall>A. ~Finite(A) -->   
  15.232 -            (\\<exists>T. T \\<subseteq> {X \\<in> Pow(A). X eqpoll succ(n)} &   
  15.233 -            (\\<forall>X \\<in> {X \\<in> Pow(A). X eqpoll succ(k)}. \\<exists>! Y. Y \\<in> T & X \\<subseteq> Y))"
  15.234 +lemma surj_image_eq: "f \<in> surj(A, B) ==> f``A = B"
  15.235 +apply (unfold surj_def)
  15.236 +apply (erule CollectE)
  15.237 +apply (rule image_fun [THEN ssubst], (assumption), rule subset_refl)
  15.238 +apply (blast dest: apply_type) 
  15.239 +done
  15.240 +
  15.241 +
  15.242 +(* ********************************************************************** *)
  15.243 +(* Lemmas used in the proofs like WO? ==> AC?                             *)
  15.244 +(* ********************************************************************** *)
  15.245  
  15.246 -  AC17_def "AC17 == \\<forall>A. \\<forall>g \\<in> (Pow(A)-{0} -> A) -> Pow(A)-{0}.   
  15.247 -                    \\<exists>f \\<in> Pow(A)-{0} -> A. f`(g`f) \\<in> g`f"
  15.248 +lemma first_in_B:
  15.249 +     "[| well_ord(Union(A),r); 0\<notin>A; B \<in> A |] ==> (THE b. first(b,B,r)) \<in> B"
  15.250 +by (blast dest!: well_ord_imp_ex1_first
  15.251 +                    [THEN theI, THEN first_def [THEN def_imp_iff, THEN iffD1]])
  15.252 +
  15.253 +lemma ex_choice_fun: "[| well_ord(Union(A), R); 0\<notin>A |] ==> \<exists>f. f:(\<Pi>X \<in> A. X)"
  15.254 +by (fast elim!: first_in_B intro!: lam_type)
  15.255  
  15.256 -  AC18_def "AC18 == (!!X A B. A\\<noteq>0 & (\\<forall>a \\<in> A. B(a) \\<noteq> 0) -->   
  15.257 -                 ((\\<Inter>a \\<in> A. \\<Union>b \\<in> B(a). X(a,b)) =   
  15.258 -                 (\\<Union>f \\<in> \\<Pi>a \\<in> A. B(a). \\<Inter>a \\<in> A. X(a, f`a))))"
  15.259 +lemma ex_choice_fun_Pow: "well_ord(A, R) ==> \<exists>f. f:(\<Pi>X \<in> Pow(A)-{0}. X)"
  15.260 +by (fast elim!: well_ord_subset [THEN ex_choice_fun])
  15.261 +
  15.262  
  15.263 -  AC19_def "AC19 == \\<forall>A. A\\<noteq>0 & 0\\<notin>A --> ((\\<Inter>a \\<in> A. \\<Union>b \\<in> a. b) =   
  15.264 -                    (\\<Union>f \\<in> (\\<Pi>B \\<in> A. B). \\<Inter>a \\<in> A. f`a))"
  15.265 +(* ********************************************************************** *)
  15.266 +(* Lemmas needed to state when a finite relation is a function.           *)
  15.267 +(*     The criteria are cardinalities of the relation and its domain.     *)
  15.268 +(*     Used in WO6WO1.ML                                                  *)
  15.269 +(* ********************************************************************** *)
  15.270  
  15.271 -(* Auxiliary definitions used in the above definitions *)
  15.272 -
  15.273 -  pairwise_disjoint_def    "pairwise_disjoint(A)   
  15.274 -                            == \\<forall>A1 \\<in> A. \\<forall>A2 \\<in> A. A1 Int A2 \\<noteq> 0 --> A1=A2"
  15.275 +(*Using AC we could trivially prove, for all u, domain(u) \<lesssim> u*)
  15.276 +lemma lepoll_m_imp_domain_lepoll_m: 
  15.277 +     "[| m \<in> nat; u \<lesssim> m |] ==> domain(u) \<lesssim> m"
  15.278 +apply (unfold lepoll_def)
  15.279 +apply (erule exE)
  15.280 +apply (rule_tac x = "\<lambda>x \<in> domain(u). LEAST i. \<exists>y. <x,y> \<in> u & f`<x,y> = i" 
  15.281 +       in exI)
  15.282 +apply (rule_tac d = "%y. fst (converse(f) ` y) " in lam_injective)
  15.283 +apply (fast intro: LeastI2 nat_into_Ord [THEN Ord_in_Ord] 
  15.284 +                           inj_is_fun [THEN apply_type])
  15.285 +apply (erule domainE)
  15.286 +apply (frule inj_is_fun [THEN apply_type], (assumption))
  15.287 +apply (rule LeastI2)
  15.288 +apply (auto elim!: nat_into_Ord [THEN Ord_in_Ord])
  15.289 +done
  15.290  
  15.291 -  sets_of_size_between_def "sets_of_size_between(A,m,n)   
  15.292 -                            == \\<forall>B \\<in> A. m lepoll B & B lepoll n"
  15.293 -  
  15.294 +lemma rel_domain_ex1: 
  15.295 +    "[| succ(m) \<lesssim> domain(r); r \<lesssim> succ(m); m \<in> nat |] ==> function(r)"
  15.296 +apply (unfold function_def, safe)
  15.297 +apply (rule ccontr) 
  15.298 +apply (fast elim!: lepoll_trans [THEN succ_lepoll_natE] 
  15.299 +                   lepoll_m_imp_domain_lepoll_m [OF _ Diff_sing_lepoll]
  15.300 +            elim: domain_Diff_eq [OF _ not_sym, THEN subst])
  15.301 +done
  15.302 +
  15.303 +lemma rel_is_fun:
  15.304 +     "[| succ(m) \<lesssim> domain(r);  r \<lesssim> succ(m);  m \<in> nat;   
  15.305 +         r \<subseteq> A*B; A=domain(r) |] ==> r \<in> A->B"
  15.306 +by (simp add: Pi_iff rel_domain_ex1)
  15.307 +
  15.308  end
    16.1 --- a/src/ZF/AC/Cardinal_aux.ML	Wed Jan 16 15:04:37 2002 +0100
    16.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    16.3 @@ -1,209 +0,0 @@
    16.4 -(*  Title:      ZF/AC/Cardinal_aux.ML
    16.5 -    ID:         $Id$
    16.6 -    Author:     Krzysztof Grabczewski
    16.7 -
    16.8 -Auxiliary lemmas concerning cardinalities
    16.9 -*)
   16.10 -
   16.11 -(* ********************************************************************** *)
   16.12 -(* Lemmas involving ordinals and cardinalities used in the proofs         *)
   16.13 -(* concerning AC16 and DC                                                 *)
   16.14 -(* ********************************************************************** *)
   16.15 -
   16.16 -(* j=|A| *)
   16.17 -Goal "[| A lepoll i; Ord(i) |] ==> \\<exists>j. j le i & A eqpoll j";
   16.18 -by (blast_tac (claset() addSIs [lepoll_cardinal_le, well_ord_Memrel,
   16.19 -				well_ord_cardinal_eqpoll RS eqpoll_sym]
   16.20 -                        addDs [lepoll_well_ord]) 1);
   16.21 -qed "lepoll_imp_ex_le_eqpoll";
   16.22 -
   16.23 -(* j=|A| *)
   16.24 -Goalw [lesspoll_def]
   16.25 -    "[| A lesspoll i; Ord(i) |] ==> \\<exists>j. j<i & A eqpoll j";
   16.26 -by (blast_tac (claset() addSDs [lepoll_imp_ex_le_eqpoll] addSEs [leE]) 1);
   16.27 -qed "lesspoll_imp_ex_lt_eqpoll";
   16.28 -
   16.29 -Goalw [InfCard_def] "[| ~Finite(i); Ord(i) |] ==> InfCard(|i|)";
   16.30 -by (rtac conjI 1);
   16.31 -by (rtac Card_cardinal 1);
   16.32 -by (resolve_tac [Card_nat RS (Card_def RS def_imp_iff RS iffD1 RS ssubst)] 1);
   16.33 -by (resolve_tac [nat_le_infinite_Ord RS le_imp_lepoll
   16.34 -        RSN (2, well_ord_Memrel RS well_ord_lepoll_imp_Card_le)] 1 
   16.35 -    THEN REPEAT (assume_tac 1));
   16.36 -qed "Inf_Ord_imp_InfCard_cardinal";
   16.37 -
   16.38 -Goal "[| A eqpoll i; B eqpoll i; ~Finite(i); Ord(i) |]  \
   16.39 -\               ==> A Un B eqpoll i";
   16.40 -by (rtac eqpollI 1);
   16.41 -by (eresolve_tac [subset_imp_lepoll RSN (2, eqpoll_sym RS eqpoll_imp_lepoll
   16.42 -        RS  lepoll_trans)] 2);
   16.43 -by (Fast_tac 2);
   16.44 -by (resolve_tac [Un_lepoll_sum RS lepoll_trans] 1);
   16.45 -by (resolve_tac [lepoll_imp_sum_lepoll_prod RS lepoll_trans] 1);
   16.46 -by (eresolve_tac [eqpoll_sym RSN (2, eqpoll_trans) RS eqpoll_imp_lepoll] 1
   16.47 -        THEN (assume_tac 1));
   16.48 -by (resolve_tac [nat_le_infinite_Ord RS le_imp_lepoll RS 
   16.49 -        (Ord_nat RS (nat_2I RS OrdmemD) RS subset_imp_lepoll RS lepoll_trans)
   16.50 -        RS (eqpoll_sym RS eqpoll_imp_lepoll RSN (2, lepoll_trans))] 1 
   16.51 -    THEN (REPEAT (assume_tac 1)));
   16.52 -by (eresolve_tac [prod_eqpoll_cong RS eqpoll_imp_lepoll RS lepoll_trans] 1 
   16.53 -    THEN (assume_tac 1));
   16.54 -by (resolve_tac [Inf_Ord_imp_InfCard_cardinal RSN (2, well_ord_Memrel RS 
   16.55 -        well_ord_InfCard_square_eq) RS eqpoll_imp_lepoll] 1 
   16.56 -    THEN REPEAT (assume_tac 1));
   16.57 -qed "Un_eqpoll_Inf_Ord";
   16.58 -
   16.59 -
   16.60 -Goal "?f \\<in> bij({{y,z}. y \\<in> x}, x)";
   16.61 -by (rtac RepFun_bijective 1);
   16.62 -by (simp_tac (simpset() addsimps [doubleton_eq_iff]) 1);
   16.63 -by (Blast_tac 1);
   16.64 -qed "paired_bij";
   16.65 -
   16.66 -Goalw [eqpoll_def] "{{y,z}. y \\<in> x} eqpoll x";
   16.67 -by (fast_tac (claset() addSIs [paired_bij]) 1);
   16.68 -qed "paired_eqpoll";
   16.69 -
   16.70 -Goal "\\<exists>B. B eqpoll A & B Int C = 0";
   16.71 -by (fast_tac (claset() addSIs [paired_eqpoll, equals0I] addEs [mem_asym]) 1);
   16.72 -qed "ex_eqpoll_disjoint";
   16.73 -
   16.74 -Goal "[| A lepoll i; B lepoll i; ~Finite(i); Ord(i) |]  \
   16.75 -\               ==> A Un B lepoll i";
   16.76 -by (res_inst_tac [("A1","i"), ("C1","i")] (ex_eqpoll_disjoint RS exE) 1);
   16.77 -by (etac conjE 1);
   16.78 -by (dresolve_tac [eqpoll_sym RS eqpoll_imp_lepoll RSN (2, lepoll_trans)] 1);
   16.79 -by (assume_tac 1);
   16.80 -by (resolve_tac [Un_lepoll_Un RS lepoll_trans] 1 THEN (REPEAT (assume_tac 1)));
   16.81 -by (eresolve_tac [eqpoll_refl RSN (2, Un_eqpoll_Inf_Ord) RS
   16.82 -        eqpoll_imp_lepoll] 1
   16.83 -        THEN (REPEAT (assume_tac 1)));
   16.84 -qed "Un_lepoll_Inf_Ord";
   16.85 -
   16.86 -Goal "[| P(i); i \\<in> j; Ord(j) |] ==> (LEAST i. P(i)) \\<in> j";
   16.87 -by (eresolve_tac [Least_le RS leE] 1);
   16.88 -by (etac Ord_in_Ord 1 THEN (assume_tac 1));
   16.89 -by (etac ltE 1);
   16.90 -by (fast_tac (claset() addDs [OrdmemD]) 1);
   16.91 -by (etac subst_elem 1 THEN (assume_tac 1));
   16.92 -qed "Least_in_Ord";
   16.93 -
   16.94 -Goal "[| well_ord(x,r); y \\<subseteq> x; y lepoll succ(n); n \\<in> nat |]  \
   16.95 -\       ==> y-{THE b. first(b,y,r)} lepoll n";
   16.96 -by (res_inst_tac [("Q","y=0")] (excluded_middle RS disjE) 1);
   16.97 -by (fast_tac (claset() addSIs [Diff_sing_lepoll, the_first_in]) 1);
   16.98 -by (res_inst_tac [("b","y-{THE b. first(b, y, r)}")] subst 1);
   16.99 -by (rtac empty_lepollI 2);
  16.100 -by (Fast_tac 1);
  16.101 -qed "Diff_first_lepoll";
  16.102 -
  16.103 -Goal "(\\<Union>x \\<in> X. P(x)) \\<subseteq> (\\<Union>x \\<in> X. P(x)-Q(x)) Un (\\<Union>x \\<in> X. Q(x))";
  16.104 -by (Fast_tac 1);
  16.105 -qed "UN_subset_split";
  16.106 -
  16.107 -Goalw [lepoll_def] "Ord(a) ==> (\\<Union>x \\<in> a. {P(x)}) lepoll a";
  16.108 -by (res_inst_tac [("x","\\<lambda>z \\<in> (\\<Union>x \\<in> a. {P(x)}). (LEAST i. P(i)=z)")] exI 1);
  16.109 -by (res_inst_tac [("d","%z. P(z)")] lam_injective 1);
  16.110 -by (fast_tac (claset() addSIs [Least_in_Ord]) 1);
  16.111 -by (fast_tac (claset() addIs [LeastI] addSEs [Ord_in_Ord]) 1);
  16.112 -qed "UN_sing_lepoll";
  16.113 -
  16.114 -Goal "[| well_ord(T, R); ~Finite(a); Ord(a); n \\<in> nat |] ==>  \
  16.115 -\       \\<forall>f. (\\<forall>b \\<in> a. f`b lepoll n & f`b \\<subseteq> T) --> (\\<Union>b \\<in> a. f`b) lepoll a";
  16.116 -by (induct_tac "n" 1);
  16.117 -by (rtac allI 1);
  16.118 -by (rtac impI 1);
  16.119 -by (res_inst_tac [("b","\\<Union>b \\<in> a. f`b")] subst 1);
  16.120 -by (rtac empty_lepollI 2);
  16.121 -by (resolve_tac [equals0I RS sym] 1);
  16.122 -by (REPEAT (eresolve_tac [UN_E, allE] 1));
  16.123 -by (fast_tac (claset() addDs [lepoll_0_is_0 RS subst]) 1);
  16.124 -by (rtac allI 1);
  16.125 -by (rtac impI 1);
  16.126 -by (eres_inst_tac [("x","\\<lambda>x \\<in> a. f`x - {THE b. first(b,f`x,R)}")] allE 1);
  16.127 -by (etac impE 1);
  16.128 -by (Asm_full_simp_tac 1);
  16.129 -by (fast_tac (claset() addSIs [Diff_first_lepoll]) 1);
  16.130 -by (Asm_full_simp_tac 1);
  16.131 -by (resolve_tac [UN_subset_split RS subset_imp_lepoll RS lepoll_trans] 1);
  16.132 -by (rtac Un_lepoll_Inf_Ord 1 THEN (REPEAT_FIRST assume_tac));
  16.133 -by (etac UN_sing_lepoll 1);
  16.134 -qed "UN_fun_lepoll_lemma";
  16.135 -
  16.136 -Goal "[| \\<forall>b \\<in> a. f`b lepoll n & f`b \\<subseteq> T; well_ord(T, R);  \
  16.137 -\       ~Finite(a); Ord(a); n \\<in> nat |] ==> (\\<Union>b \\<in> a. f`b) lepoll a";
  16.138 -by (eresolve_tac [UN_fun_lepoll_lemma RS allE] 1 THEN (REPEAT (assume_tac 1)));
  16.139 -by (Fast_tac 1);
  16.140 -qed "UN_fun_lepoll";
  16.141 -
  16.142 -Goal "[| \\<forall>b \\<in> a. F(b) lepoll n & F(b) \\<subseteq> T; well_ord(T, R);  \
  16.143 -\       ~Finite(a); Ord(a); n \\<in> nat |] ==> (\\<Union>b \\<in> a. F(b)) lepoll a";
  16.144 -by (rtac impE 1 THEN (assume_tac 3));
  16.145 -by (res_inst_tac [("f","\\<lambda>b \\<in> a. F(b)")] (UN_fun_lepoll) 2 
  16.146 -        THEN (TRYALL assume_tac));
  16.147 -by Auto_tac;
  16.148 -qed "UN_lepoll";
  16.149 -
  16.150 -Goal "Ord(a) ==> (\\<Union>b \\<in> a. F(b)) = (\\<Union>b \\<in> a. F(b) - (\\<Union>c \\<in> b. F(c)))";
  16.151 -by (rtac equalityI 1);
  16.152 -by (Fast_tac 2);
  16.153 -by (rtac subsetI 1);
  16.154 -by (etac UN_E 1);
  16.155 -by (rtac UN_I 1);
  16.156 -by (res_inst_tac [("P","%z. x \\<in> F(z)")] Least_in_Ord 1 THEN (REPEAT (assume_tac 1)));
  16.157 -by (rtac DiffI 1);
  16.158 -by (resolve_tac [Ord_in_Ord RSN (2, LeastI)] 1 THEN (REPEAT (assume_tac 1)));
  16.159 -by (rtac notI 1);
  16.160 -by (etac UN_E 1);
  16.161 -by (eres_inst_tac [("P","%z. x \\<in> F(z)"),("i","c")] less_LeastE 1);
  16.162 -by (eresolve_tac [Ord_Least RSN (2, ltI)] 1);
  16.163 -qed "UN_eq_UN_Diffs";
  16.164 -
  16.165 -Goalw [lepoll_def, eqpoll_def]
  16.166 -     "a lepoll X ==> \\<exists>Y. Y \\<subseteq> X & a eqpoll Y";
  16.167 -by (etac exE 1);
  16.168 -by (forward_tac [subset_refl RSN (2, restrict_bij)] 1);
  16.169 -by (res_inst_tac [("x","f``a")] exI 1);
  16.170 -by (fast_tac (claset() addSEs [inj_is_fun RS fun_is_rel RS image_subset]) 1);
  16.171 -qed "lepoll_imp_eqpoll_subset";
  16.172 -
  16.173 -(* ********************************************************************** *)
  16.174 -(* Diff_lesspoll_eqpoll_Card                                              *)
  16.175 -(* ********************************************************************** *)
  16.176 -
  16.177 -Goal "[| A\\<approx>a; ~Finite(a); Card(a); B lesspoll a; A-B lesspoll a |] ==> P";
  16.178 -by (REPEAT (eresolve_tac [lesspoll_imp_ex_lt_eqpoll RS exE,
  16.179 -        Card_is_Ord, conjE] 1));
  16.180 -by (forw_inst_tac [("j","xa")] ([lt_Ord, lt_Ord] MRS Un_upper1_le) 1
  16.181 -        THEN (assume_tac 1));
  16.182 -by (forw_inst_tac [("j","xa")] ([lt_Ord, lt_Ord] MRS Un_upper2_le) 1
  16.183 -        THEN (assume_tac 1));
  16.184 -by (dtac Un_least_lt 1 THEN (assume_tac 1));
  16.185 -by (dresolve_tac [le_imp_lepoll RSN
  16.186 -        (2, eqpoll_imp_lepoll RS lepoll_trans)] 1
  16.187 -        THEN (assume_tac 1));
  16.188 -by (dresolve_tac [le_imp_lepoll RSN
  16.189 -        (2, eqpoll_imp_lepoll RS lepoll_trans)] 1
  16.190 -        THEN (assume_tac 1));
  16.191 -by (res_inst_tac [("Q","Finite(x Un xa)")] (excluded_middle RS disjE) 1);
  16.192 -by (dresolve_tac [[lepoll_Finite, lepoll_Finite] MRS Finite_Un] 2
  16.193 -        THEN (REPEAT (assume_tac 2)));
  16.194 -by (dresolve_tac [subset_Un_Diff RS subset_imp_lepoll RS lepoll_Finite] 2);
  16.195 -by (fast_tac (claset()
  16.196 -        addDs [eqpoll_sym RS eqpoll_imp_lepoll RS lepoll_Finite]) 2);
  16.197 -by (dresolve_tac [ Un_lepoll_Inf_Ord] 1 THEN (REPEAT (assume_tac 1)));
  16.198 -by (fast_tac (claset() addSEs [ltE, Ord_in_Ord]) 1);
  16.199 -by (dresolve_tac [subset_Un_Diff RS subset_imp_lepoll RS lepoll_trans RS
  16.200 -         (lt_Card_imp_lesspoll RSN (2, lesspoll_trans1))] 1
  16.201 -        THEN (TRYALL assume_tac));
  16.202 -by (fast_tac (claset() addSDs [lesspoll_def RS def_imp_iff RS iffD1]) 1);
  16.203 -qed "Diff_lesspoll_eqpoll_Card_lemma";
  16.204 -
  16.205 -Goal "[| A eqpoll a; ~Finite(a); Card(a); B lesspoll a |]  \
  16.206 -\       ==> A - B eqpoll a";
  16.207 -by (rtac swap 1 THEN (Fast_tac 1));
  16.208 -by (rtac Diff_lesspoll_eqpoll_Card_lemma 1 THEN (REPEAT (assume_tac 1)));
  16.209 -by (fast_tac (claset() addSIs [lesspoll_def RS def_imp_iff RS iffD2,
  16.210 -        subset_imp_lepoll RS (eqpoll_imp_lepoll RSN (2, lepoll_trans))]) 1);
  16.211 -qed "Diff_lesspoll_eqpoll_Card";
  16.212 -
    17.1 --- a/src/ZF/AC/Cardinal_aux.thy	Wed Jan 16 15:04:37 2002 +0100
    17.2 +++ b/src/ZF/AC/Cardinal_aux.thy	Wed Jan 16 17:52:06 2002 +0100
    17.3 @@ -1,3 +1,212 @@
    17.4 -(*Dummy theory to document dependencies *)
    17.5 +(*  Title:      ZF/AC/Cardinal_aux.thy
    17.6 +    ID:         $Id$
    17.7 +    Author:     Krzysztof Grabczewski
    17.8 +
    17.9 +Auxiliary lemmas concerning cardinalities
   17.10 +*)
   17.11 +
   17.12 +theory Cardinal_aux = AC_Equiv:
   17.13 +
   17.14 +lemma Diff_lepoll: "[| A \<lesssim> succ(m); B \<subseteq> A; B\<noteq>0 |] ==> A-B \<lesssim> m"
   17.15 +apply (rule not_emptyE, (assumption))
   17.16 +apply (blast intro: lepoll_trans [OF subset_imp_lepoll Diff_sing_lepoll])
   17.17 +done
   17.18 +
   17.19 +
   17.20 +(* ********************************************************************** *)
   17.21 +(* Lemmas involving ordinals and cardinalities used in the proofs         *)
   17.22 +(* concerning AC16 and DC                                                 *)
   17.23 +(* ********************************************************************** *)
   17.24 +
   17.25 +
   17.26 +(* j=|A| *)
   17.27 +lemma lepoll_imp_ex_le_eqpoll:
   17.28 +     "[| A \<lesssim> i; Ord(i) |] ==> \<exists>j. j le i & A \<approx> j"
   17.29 +by (blast intro!: lepoll_cardinal_le well_ord_Memrel 
   17.30 +                  well_ord_cardinal_eqpoll [THEN eqpoll_sym]
   17.31 +          dest: lepoll_well_ord);
   17.32 +
   17.33 +(* j=|A| *)
   17.34 +lemma lesspoll_imp_ex_lt_eqpoll: 
   17.35 +     "[| A \<prec> i; Ord(i) |] ==> \<exists>j. j<i & A \<approx> j"
   17.36 +by (unfold lesspoll_def, blast dest!: lepoll_imp_ex_le_eqpoll elim!: leE)
   17.37 +
   17.38 +lemma Inf_Ord_imp_InfCard_cardinal: "[| ~Finite(i); Ord(i) |] ==> InfCard(|i|)"
   17.39 +apply (unfold InfCard_def)
   17.40 +apply (rule conjI)
   17.41 +apply (rule Card_cardinal)
   17.42 +apply (rule Card_nat 
   17.43 +            [THEN Card_def [THEN def_imp_iff, THEN iffD1, THEN ssubst]])
   17.44 +  -- "rewriting would loop!"
   17.45 +apply (rule well_ord_Memrel [THEN well_ord_lepoll_imp_Card_le], assumption) 
   17.46 +apply (rule nat_le_infinite_Ord [THEN le_imp_lepoll], assumption+)
   17.47 +done
   17.48 +
   17.49 +text{*An alternative and more general proof goes like this: A and B are both
   17.50 +well-ordered (because they are injected into an ordinal), either A lepoll B
   17.51 +or B lepoll A.  Also both are equipollent to their cardinalities, so
   17.52 +(if A and B are infinite) then A Un B lepoll |A|+|B| = max(|A|,|B|) lepoll i.
   17.53 +In fact, the correctly strengthened version of this theorem appears below.*}
   17.54 +lemma Un_lepoll_Inf_Ord_weak:
   17.55 +     "[|A \<approx> i; B \<approx> i; \<not> Finite(i); Ord(i)|] ==> A \<union> B \<lesssim> i"
   17.56 +apply (rule Un_lepoll_sum [THEN lepoll_trans])
   17.57 +apply (rule lepoll_imp_sum_lepoll_prod [THEN lepoll_trans])
   17.58 +apply (erule eqpoll_trans [THEN eqpoll_imp_lepoll]) 
   17.59 +apply (erule eqpoll_sym) 
   17.60 +apply (rule subset_imp_lepoll [THEN lepoll_trans, THEN lepoll_trans]) 
   17.61 +apply (rule nat_2I [THEN OrdmemD], rule Ord_nat) 
   17.62 +apply (rule nat_le_infinite_Ord [THEN le_imp_lepoll], assumption+) 
   17.63 +apply (erule eqpoll_sym [THEN eqpoll_imp_lepoll]) 
   17.64 +apply (erule prod_eqpoll_cong [THEN eqpoll_imp_lepoll, THEN lepoll_trans],
   17.65 +       assumption)
   17.66 +apply (rule eqpoll_imp_lepoll) 
   17.67 +apply (rule well_ord_Memrel [THEN well_ord_InfCard_square_eq], assumption) 
   17.68 +apply (rule Inf_Ord_imp_InfCard_cardinal, assumption+) 
   17.69 +done
   17.70 +
   17.71 +lemma Un_eqpoll_Inf_Ord:
   17.72 +     "[| A \<approx> i; B \<approx> i; ~Finite(i); Ord(i) |] ==> A Un B \<approx> i"
   17.73 +apply (rule eqpollI)
   17.74 +apply (blast intro: Un_lepoll_Inf_Ord_weak) 
   17.75 +apply (erule eqpoll_sym [THEN eqpoll_imp_lepoll, THEN lepoll_trans]) 
   17.76 +apply (rule Un_upper1 [THEN subset_imp_lepoll]) 
   17.77 +done
   17.78 +
   17.79 +lemma paired_bij: "?f \<in> bij({{y,z}. y \<in> x}, x)"
   17.80 +apply (rule RepFun_bijective)
   17.81 +apply (simp add: doubleton_eq_iff, blast)
   17.82 +done
   17.83 +
   17.84 +lemma paired_eqpoll: "{{y,z}. y \<in> x} \<approx> x"
   17.85 +by (unfold eqpoll_def, fast intro!: paired_bij)
   17.86 +
   17.87 +lemma ex_eqpoll_disjoint: "\<exists>B. B \<approx> A & B Int C = 0"
   17.88 +by (fast intro!: paired_eqpoll equals0I elim: mem_asym)
   17.89 +
   17.90 +(*Finally we reach this result.  Surely there's a simpler proof, as sketched
   17.91 +  above?*)
   17.92 +lemma Un_lepoll_Inf_Ord:
   17.93 +     "[| A \<lesssim> i; B \<lesssim> i; ~Finite(i); Ord(i) |] ==> A Un B \<lesssim> i"
   17.94 +apply (rule_tac A1 = "i" and C1 = "i" in ex_eqpoll_disjoint [THEN exE])
   17.95 +apply (erule conjE)
   17.96 +apply (drule lepoll_trans) 
   17.97 +apply (erule eqpoll_sym [THEN eqpoll_imp_lepoll])
   17.98 +apply (rule Un_lepoll_Un [THEN lepoll_trans], (assumption+))
   17.99 +apply (blast intro: eqpoll_refl Un_eqpoll_Inf_Ord eqpoll_imp_lepoll) 
  17.100 +done
  17.101 +
  17.102 +lemma Least_in_Ord: "[| P(i); i \<in> j; Ord(j) |] ==> (LEAST i. P(i)) \<in> j"
  17.103 +apply (erule Least_le [THEN leE])
  17.104 +apply (erule Ord_in_Ord, assumption)
  17.105 +apply (erule ltE)
  17.106 +apply (fast dest: OrdmemD)
  17.107 +apply (erule subst_elem, assumption)
  17.108 +done
  17.109  
  17.110 -Cardinal_aux = AC_Equiv
  17.111 +lemma Diff_first_lepoll:
  17.112 +     "[| well_ord(x,r); y \<subseteq> x; y \<lesssim> succ(n); n \<in> nat |] 
  17.113 +      ==> y - {THE b. first(b,y,r)} \<lesssim> n"
  17.114 +apply (case_tac "y=0", simp add: empty_lepollI) 
  17.115 +apply (fast intro!: Diff_sing_lepoll the_first_in)
  17.116 +done
  17.117 +
  17.118 +lemma UN_subset_split:
  17.119 +     "(\<Union>x \<in> X. P(x)) \<subseteq> (\<Union>x \<in> X. P(x)-Q(x)) Un (\<Union>x \<in> X. Q(x))"
  17.120 +by blast
  17.121 +
  17.122 +lemma UN_sing_lepoll: "Ord(a) ==> (\<Union>x \<in> a. {P(x)}) \<lesssim> a"
  17.123 +apply (unfold lepoll_def)
  17.124 +apply (rule_tac x = "\<lambda>z \<in> (\<Union>x \<in> a. {P (x) }) . (LEAST i. P (i) =z) " in exI)
  17.125 +apply (rule_tac d = "%z. P (z) " in lam_injective)
  17.126 +apply (fast intro!: Least_in_Ord)
  17.127 +apply (fast intro: LeastI elim!: Ord_in_Ord)
  17.128 +done
  17.129 +
  17.130 +lemma UN_fun_lepoll_lemma [rule_format]:
  17.131 +     "[| well_ord(T, R); ~Finite(a); Ord(a); n \<in> nat |] 
  17.132 +      ==> \<forall>f. (\<forall>b \<in> a. f`b \<lesssim> n & f`b \<subseteq> T) --> (\<Union>b \<in> a. f`b) \<lesssim> a"
  17.133 +apply (induct_tac "n")
  17.134 +apply (rule allI)
  17.135 +apply (rule impI)
  17.136 +apply (rule_tac b = "\<Union>b \<in> a. f`b" in subst)
  17.137 +apply (rule_tac [2] empty_lepollI)
  17.138 +apply (rule equals0I [symmetric], clarify) 
  17.139 +apply (fast dest: lepoll_0_is_0 [THEN subst])
  17.140 +apply (rule allI)
  17.141 +apply (rule impI)
  17.142 +apply (erule_tac x = "\<lambda>x \<in> a. f`x - {THE b. first (b,f`x,R) }" in allE)
  17.143 +apply (erule impE, simp)
  17.144 +apply (fast intro!: Diff_first_lepoll, simp)
  17.145 +apply (rule UN_subset_split [THEN subset_imp_lepoll, THEN lepoll_trans])
  17.146 +apply (fast intro: Un_lepoll_Inf_Ord UN_sing_lepoll) 
  17.147 +done
  17.148 +
  17.149 +lemma UN_fun_lepoll:
  17.150 +     "[| \<forall>b \<in> a. f`b \<lesssim> n & f`b \<subseteq> T; well_ord(T, R);   
  17.151 +         ~Finite(a); Ord(a); n \<in> nat |] ==> (\<Union>b \<in> a. f`b) \<lesssim> a"
  17.152 +by (blast intro: UN_fun_lepoll_lemma); 
  17.153 +
  17.154 +lemma UN_lepoll:
  17.155 +     "[| \<forall>b \<in> a. F(b) \<lesssim> n & F(b) \<subseteq> T; well_ord(T, R);   
  17.156 +         ~Finite(a); Ord(a); n \<in> nat |] 
  17.157 +      ==> (\<Union>b \<in> a. F(b)) \<lesssim> a"
  17.158 +apply (rule rev_mp) 
  17.159 +apply (rule_tac f="\<lambda>b \<in> a. F (b)" in UN_fun_lepoll);
  17.160 +apply auto
  17.161 +done
  17.162 +
  17.163 +lemma UN_eq_UN_Diffs:
  17.164 +     "Ord(a) ==> (\<Union>b \<in> a. F(b)) = (\<Union>b \<in> a. F(b) - (\<Union>c \<in> b. F(c)))"
  17.165 +apply (rule equalityI)
  17.166 + prefer 2 apply fast
  17.167 +apply (rule subsetI)
  17.168 +apply (erule UN_E)
  17.169 +apply (rule UN_I)
  17.170 + apply (rule_tac P = "%z. x \<in> F (z) " in Least_in_Ord, (assumption+))
  17.171 +apply (rule DiffI, best intro: Ord_in_Ord LeastI, clarify)
  17.172 +apply (erule_tac P = "%z. x \<in> F (z) " and i = "c" in less_LeastE)
  17.173 +apply (blast intro: Ord_Least ltI)
  17.174 +done
  17.175 +
  17.176 +lemma lepoll_imp_eqpoll_subset: 
  17.177 +     "a \<lesssim> X ==> \<exists>Y. Y \<subseteq> X & a \<approx> Y"
  17.178 +apply (unfold lepoll_def eqpoll_def, clarify) 
  17.179 +apply (blast intro: restrict_bij
  17.180 +             dest: inj_is_fun [THEN fun_is_rel, THEN image_subset]) 
  17.181 +done
  17.182 +
  17.183 +(* ********************************************************************** *)
  17.184 +(* Diff_lesspoll_eqpoll_Card                                              *)
  17.185 +(* ********************************************************************** *)
  17.186 +
  17.187 +lemma Diff_lesspoll_eqpoll_Card_lemma:
  17.188 +     "[| A\<approx>a; ~Finite(a); Card(a); B \<prec> a; A-B \<prec> a |] ==> P"
  17.189 +apply (elim lesspoll_imp_ex_lt_eqpoll [THEN exE] Card_is_Ord conjE)
  17.190 +apply (frule_tac j=xa in Un_upper1_le [OF lt_Ord lt_Ord], assumption)
  17.191 +apply (frule_tac j=xa in Un_upper2_le [OF lt_Ord lt_Ord], assumption)
  17.192 +apply (drule Un_least_lt, assumption)
  17.193 +apply (drule eqpoll_imp_lepoll [THEN lepoll_trans], 
  17.194 +       rule le_imp_lepoll, assumption)+
  17.195 +apply (case_tac "Finite(x Un xa)");
  17.196 +txt{*finite case*}
  17.197 + apply (drule Finite_Un [OF lepoll_Finite lepoll_Finite], assumption+) 
  17.198 + apply (drule subset_Un_Diff [THEN subset_imp_lepoll, THEN lepoll_Finite])
  17.199 + apply (fast dest: eqpoll_sym [THEN eqpoll_imp_lepoll, THEN lepoll_Finite])
  17.200 +txt{*infinite case*}
  17.201 +apply (drule Un_lepoll_Inf_Ord, (assumption+))
  17.202 +apply (blast intro: le_Ord2) 
  17.203 +apply (drule lesspoll_trans1 
  17.204 +             [OF subset_Un_Diff [THEN subset_imp_lepoll, THEN lepoll_trans] 
  17.205 +                 lt_Card_imp_lesspoll], assumption+)
  17.206 +apply (simp add: lesspoll_def) 
  17.207 +done
  17.208 +
  17.209 +lemma Diff_lesspoll_eqpoll_Card:
  17.210 +     "[| A \<approx> a; ~Finite(a); Card(a); B \<prec> a |] ==> A - B \<approx> a"
  17.211 +apply (rule ccontr)
  17.212 +apply (rule Diff_lesspoll_eqpoll_Card_lemma, (assumption+))
  17.213 +apply (blast intro: lesspoll_def [THEN def_imp_iff, THEN iffD2] 
  17.214 +                    subset_imp_lepoll eqpoll_imp_lepoll lepoll_trans)
  17.215 +done
  17.216 +
  17.217 +end
    18.1 --- a/src/ZF/AC/DC.ML	Wed Jan 16 15:04:37 2002 +0100
    18.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    18.3 @@ -1,533 +0,0 @@
    18.4 -(*  Title:      ZF/AC/DC.ML
    18.5 -    ID:  $Id$
    18.6 -    Author:     Krzysztof Grabczewski
    18.7 -
    18.8 -The proofs concerning the Axiom of Dependent Choice
    18.9 -*)
   18.10 -
   18.11 -(* ********************************************************************** *)
   18.12 -(* DC ==> DC(omega)                                                       *)
   18.13 -(*                                                                        *)
   18.14 -(* The scheme of the proof:                                               *)
   18.15 -(*                                                                        *)
   18.16 -(* Assume DC. Let R and X satisfy the premise of DC(omega).               *)
   18.17 -(*                                                                        *)
   18.18 -(* Define XX and RR as follows:                                           *)
   18.19 -(*                                                                        *)
   18.20 -(*       XX = (\\<Union>n \\<in> nat. {f \\<in> n->X. \\<forall>k \\<in> n. <f``k, f`k> \\<in> R})              *)
   18.21 -(*       f RR g iff domain(g)=succ(domain(f)) &                           *)
   18.22 -(*              restrict(g, domain(f)) = f                                *)
   18.23 -(*                                                                        *)
   18.24 -(* Then RR satisfies the hypotheses of DC.                                *)
   18.25 -(* So applying DC:                                                        *)
   18.26 -(*                                                                        *)
   18.27 -(*       \\<exists>f \\<in> nat->XX. \\<forall>n \\<in> nat. f`n RR f`succ(n)                        *)
   18.28 -(*                                                                        *)
   18.29 -(* Thence                                                                 *)
   18.30 -(*                                                                        *)
   18.31 -(*       ff = {<n, f`succ(n)`n>. n \\<in> nat}                                   *)
   18.32 -(*                                                                        *)
   18.33 -(* is the desired function.                                               *)
   18.34 -(*                                                                        *)
   18.35 -(* ********************************************************************** *)
   18.36 -
   18.37 -Open_locale "DC0_imp";
   18.38 -
   18.39 -val all_ex = thm "all_ex";
   18.40 -val XX_def = thm "XX_def";
   18.41 -val RR_def = thm "RR_def";
   18.42 -
   18.43 -Goalw [RR_def] "RR \\<subseteq> XX*XX";
   18.44 -by (Fast_tac 1);
   18.45 -qed "lemma1_1";
   18.46 -
   18.47 -Goalw [RR_def, XX_def] "RR \\<noteq> 0";
   18.48 -by (rtac (all_ex RS ballE) 1);
   18.49 -by (eresolve_tac [empty_subsetI RS PowI RSN (2, notE)] 2);
   18.50 -by (eresolve_tac [nat_0I RS n_lesspoll_nat RSN (2, impE)] 1);
   18.51 -by (etac bexE 1);
   18.52 -by (res_inst_tac [("a","<0, {<0, x>}>")] not_emptyI 1);
   18.53 -by (rtac CollectI 1);
   18.54 -by (rtac SigmaI 1);
   18.55 -by (rtac (nat_0I RS UN_I) 1);
   18.56 -by (asm_simp_tac (simpset() addsimps [nat_0I RS UN_I]) 1);
   18.57 -by (rtac (nat_1I RS UN_I) 1);
   18.58 -by (asm_simp_tac (simpset() addsimps [singleton_0]) 2);
   18.59 -by (force_tac (claset() addSIs [singleton_fun RS Pi_type],
   18.60 -	       simpset() addsimps [singleton_0 RS sym]) 1);
   18.61 -qed "lemma1_2";
   18.62 -
   18.63 -Goalw [RR_def, XX_def] "range(RR) \\<subseteq> domain(RR)";
   18.64 -by (rtac range_subset_domain 1);
   18.65 -by (Blast_tac 2);
   18.66 -by (Clarify_tac 1);
   18.67 -by (forward_tac [fun_is_rel RS image_subset RS PowI RS (all_ex RS bspec)] 1);
   18.68 -by (eresolve_tac [[nat_into_Ord RSN (2, image_Ord_lepoll), n_lesspoll_nat]
   18.69 -        MRS lesspoll_trans1 RSN (2, impE)] 1
   18.70 -        THEN REPEAT (assume_tac 1));
   18.71 -by (etac bexE 1);
   18.72 -by (res_inst_tac [("x","cons(<n,x>, g)")] exI 1);
   18.73 -by (rtac CollectI 1);
   18.74 -by (force_tac (claset() addSEs [cons_fun_type2],
   18.75 -	       simpset() addsimps [cons_image_n, cons_val_n, 
   18.76 -				   cons_image_k, cons_val_k]) 1);
   18.77 -by (asm_full_simp_tac (simpset()
   18.78 -        addsimps [domain_of_fun, succ_def, restrict_cons_eq]) 1);
   18.79 -qed "lemma1_3";
   18.80 -
   18.81 -
   18.82 -Goal "[| \\<forall>n \\<in> nat. <f`n, f`succ(n)> \\<in> RR;  f \\<in> nat -> XX;  n \\<in> nat |]  \
   18.83 -\     ==> \\<exists>k \\<in> nat. f`succ(n) \\<in> k -> X & n \\<in> k  \
   18.84 -\                 & <f`succ(n)``n, f`succ(n)`n> \\<in> R";
   18.85 -by (induct_tac "n" 1);
   18.86 -by (dresolve_tac [nat_1I RSN (2, apply_type)] 1);
   18.87 -by (dresolve_tac [nat_0I RSN (2, bspec)] 1);
   18.88 -by (asm_full_simp_tac (simpset() addsimps [XX_def]) 1);
   18.89 -by Safe_tac;
   18.90 -by (rtac bexI 1 THEN (assume_tac 2));
   18.91 -by (best_tac (claset() addIs [ltD]
   18.92 -                        addSEs [nat_0_le RS leE]
   18.93 -			addEs [sym RS trans RS succ_neq_0, domain_of_fun]
   18.94 -	       addss (simpset() addsimps [RR_def])) 1);
   18.95 -(** LEVEL 7, other subgoal **)
   18.96 -by (dresolve_tac [nat_succI RSN (2, bspec)] 1 THEN (assume_tac 1));
   18.97 -by (subgoal_tac "f ` succ(succ(x)) \\<in> succ(k)->X" 1);
   18.98 -by (dresolve_tac [nat_succI RS nat_succI RSN (2, apply_type)] 1
   18.99 -        THEN (assume_tac 1));
  18.100 -by (full_simp_tac (simpset() addsimps [XX_def,RR_def]) 1);
  18.101 -by Safe_tac;
  18.102 -by (forw_inst_tac [("a","succ(k)")] (domain_of_fun RS sym RS trans) 1 THEN
  18.103 -    (assume_tac 1));
  18.104 -by (forw_inst_tac [("a","xa")] (domain_of_fun RS sym RS trans) 1 THEN
  18.105 -    (assume_tac 1));
  18.106 -by (fast_tac (claset() addSEs [nat_into_Ord RS succ_in_succ]
  18.107 -        addSDs [nat_into_Ord RS succ_in_succ RSN (2, bspec)]) 1);
  18.108 -by (dtac domain_of_fun 1);
  18.109 -by (full_simp_tac (simpset() addsimps [XX_def,RR_def]) 1);
  18.110 -by (deepen_tac (claset() addDs [domain_of_fun RS sym RS trans]) 0 1);
  18.111 -qed "lemma2";
  18.112 -
  18.113 -Goal "[| \\<forall>n \\<in> nat. <f`n, f`succ(n)> \\<in> RR;  f \\<in> nat -> XX;  m \\<in> nat |]  \
  18.114 -\     ==>  {f`succ(x)`x. x \\<in> m} = {f`succ(m)`x. x \\<in> m}";
  18.115 -by (subgoal_tac "\\<forall>x \\<in> m. f`succ(m)`x = f`succ(x)`x" 1);
  18.116 -by (Asm_full_simp_tac 1);
  18.117 -by (induct_tac "m" 1);
  18.118 -by (Fast_tac 1);
  18.119 -by (rtac ballI 1);
  18.120 -by (etac succE 1);
  18.121 -by (rtac restrict_eq_imp_val_eq 1);
  18.122 -by (dresolve_tac [nat_succI RSN (2, bspec)] 1 THEN (assume_tac 1));
  18.123 -by (asm_full_simp_tac (simpset() addsimps [RR_def]) 1);
  18.124 -by (dtac lemma2 1 THEN REPEAT (assume_tac 1));
  18.125 -by (fast_tac (claset() addSDs [domain_of_fun]) 1);
  18.126 -by (dres_inst_tac [("x","xa")] bspec 1 THEN (assume_tac 1));
  18.127 -by (eresolve_tac [sym RS trans RS sym] 1);
  18.128 -by (resolve_tac [restrict_eq_imp_val_eq RS sym] 1);
  18.129 -by (dresolve_tac [nat_succI RSN (2, bspec)] 1 THEN (assume_tac 1));
  18.130 -by (asm_full_simp_tac (simpset() addsimps [RR_def]) 1);
  18.131 -by (dtac lemma2 1 THEN REPEAT (assume_tac 1));
  18.132 -by (blast_tac (claset() addSDs [domain_of_fun]
  18.133 -                        addIs [nat_into_Ord RSN (2, OrdmemD) RS subsetD]) 1);
  18.134 -qed "lemma3_1";
  18.135 -
  18.136 -Goal "[| \\<forall>n \\<in> nat. <f`n, f`succ(n)> \\<in> RR;  f \\<in> nat -> XX;  m \\<in> nat |] \
  18.137 -\     ==> (\\<lambda>x \\<in> nat. f`succ(x)`x) `` m = f`succ(m)``m";
  18.138 -by (etac natE 1);
  18.139 -by (Asm_simp_tac 1);
  18.140 -by (stac image_lam 1);
  18.141 -by (fast_tac (claset() addSEs [[nat_succI, Ord_nat] MRS OrdmemD]) 1);
  18.142 -by (stac lemma3_1 1 THEN REPEAT (assume_tac 1));
  18.143 -by (Fast_tac 1);
  18.144 -by (fast_tac (claset() addSDs [lemma2]
  18.145 -		       addSEs [nat_into_Ord RSN (2, OrdmemD) RSN 
  18.146 -                            (2, image_fun RS sym)]) 1);
  18.147 -qed "lemma3";
  18.148 -
  18.149 -Close_locale "DC0_imp";
  18.150 -
  18.151 -Goalw [DC_def, DC0_def] "DC0 ==> DC(nat)";
  18.152 -by (Clarify_tac 1);
  18.153 -by (REPEAT (etac allE 1));
  18.154 -by (etac impE 1);
  18.155 -   (*these three results comprise Lemma 1*)
  18.156 -by (blast_tac (claset() addSIs (map export [lemma1_1, lemma1_2, lemma1_3])) 1);
  18.157 -by (etac bexE 1);
  18.158 -by (res_inst_tac [("x","\\<lambda>n \\<in> nat. f`succ(n)`n")] bexI 1);
  18.159 -by (fast_tac (claset() addSIs [lam_type] addSDs [export lemma2]
  18.160 -                       addSEs [fun_weaken_type, apply_type]) 2);
  18.161 -by (rtac oallI 1);
  18.162 -by (forward_tac [ltD RSN (3, export lemma2)] 1
  18.163 -        THEN assume_tac 2);
  18.164 -by (fast_tac (claset() addSEs [fun_weaken_type]) 1);
  18.165 -(** LEVEL 10: last subgoal **)
  18.166 -by (stac (ltD RSN (3, export lemma3)) 1);
  18.167 -by (Force_tac 4);
  18.168 -by (assume_tac 3);
  18.169 -by (assume_tac 1);
  18.170 -by (fast_tac (claset() addSEs [fun_weaken_type]) 1);
  18.171 -qed "DC0_imp_DC_nat";
  18.172 -
  18.173 -
  18.174 -(* ************************************************************************
  18.175 -   DC(omega) ==> DC                                                       
  18.176 -                                                                          
  18.177 -   The scheme of the proof:                                               
  18.178 -                                                                          
  18.179 -   Assume DC(omega). Let R and x satisfy the premise of DC.               
  18.180 -                                                                          
  18.181 -   Define XX and RR as follows:                                           
  18.182 -                                                                          
  18.183 -    XX = (\\<Union>n \\<in> nat. {f \\<in> succ(n)->domain(R). \\<forall>k \\<in> n. <f`k, f`succ(k)> \\<in> R})
  18.184 -
  18.185 -    RR = {<z1,z2>:Fin(XX)*XX. 
  18.186 -           (domain(z2)=succ(\\<Union>f \\<in> z1. domain(f)) &
  18.187 -	    (\\<forall>f \\<in> z1. restrict(z2, domain(f)) = f)) |      
  18.188 -	   (~ (\\<exists>g \\<in> XX. domain(g)=succ(\\<Union>f \\<in> z1. domain(f)) &
  18.189 -	                (\\<forall>f \\<in> z1. restrict(g, domain(f)) = f)) &           
  18.190 -	    z2={<0,x>})}                                          
  18.191 -                                                                          
  18.192 -   Then XX and RR satisfy the hypotheses of DC(omega).                    
  18.193 -   So applying DC:                                                        
  18.194 -                                                                          
  18.195 -         \\<exists>f \\<in> nat->XX. \\<forall>n \\<in> nat. f``n RR f`n                             
  18.196 -                                                                          
  18.197 -   Thence                                                                 
  18.198 -                                                                          
  18.199 -         ff = {<n, f`n`n>. n \\<in> nat}                                         
  18.200 -                                                                          
  18.201 -   is the desired function.                                               
  18.202 -                                                                          
  18.203 -************************************************************************* *)
  18.204 -
  18.205 -Goal "n \\<in> nat ==> \\<forall>A. (A eqpoll n & A \\<subseteq> X) --> A \\<in> Fin(X)";
  18.206 -by (induct_tac "n" 1);
  18.207 -by (rtac allI 1);
  18.208 -by (fast_tac (claset() addSIs [Fin.emptyI]
  18.209 -        addSDs [eqpoll_imp_lepoll RS lepoll_0_is_0]) 1);
  18.210 -by (rtac allI 1);
  18.211 -by (rtac impI 1);
  18.212 -by (etac conjE 1);
  18.213 -by (resolve_tac [eqpoll_succ_imp_not_empty RS not_emptyE] 1
  18.214 -        THEN (assume_tac 1));
  18.215 -by (ftac Diff_sing_eqpoll 1 THEN (assume_tac 1));
  18.216 -by (etac allE 1);
  18.217 -by (etac impE 1);
  18.218 -by (Fast_tac 1);
  18.219 -by (dtac subsetD 1 THEN (assume_tac 1));
  18.220 -by (dresolve_tac [Fin.consI] 1 THEN (assume_tac 1));
  18.221 -by (asm_full_simp_tac (simpset() addsimps [cons_Diff]) 1);
  18.222 -qed "Finite_Fin_lemma";
  18.223 -
  18.224 -Goalw [Finite_def] "[| Finite(A); A \\<subseteq> X |] ==> A \\<in> Fin(X)";
  18.225 -by (etac bexE 1);
  18.226 -by (dtac Finite_Fin_lemma 1);
  18.227 -by (etac allE 1);
  18.228 -by (etac impE 1);
  18.229 -by (assume_tac 2);
  18.230 -by (Fast_tac 1);
  18.231 -qed "Finite_Fin";
  18.232 -
  18.233 -Goal
  18.234 - "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})";
  18.235 -by (rtac (nat_0I RS UN_I) 1);
  18.236 -by (fast_tac (claset() addSIs [singleton_fun RS Pi_type]
  18.237 -        addss (simpset() addsimps [singleton_0 RS sym])) 1);
  18.238 -qed "singleton_in_funs";
  18.239 -
  18.240 -
  18.241 -Open_locale "imp_DC0";
  18.242 -
  18.243 -val XX_def = thm "XX_def";
  18.244 -val RR_def = thm "RR_def";
  18.245 -val allRR_def = thm "allRR_def";
  18.246 -
  18.247 -Goal "[| range(R) \\<subseteq> domain(R);  x \\<in> domain(R) |]  \
  18.248 -\     ==> RR \\<subseteq> Pow(XX)*XX &  \
  18.249 -\            (\\<forall>Y \\<in> Pow(XX). Y lesspoll nat --> (\\<exists>x \\<in> XX. <Y,x>:RR))";
  18.250 -by (rtac conjI 1);
  18.251 -by (force_tac (claset() addSDs [FinD RS PowI], 
  18.252 -	       simpset() addsimps [RR_def]) 1); 
  18.253 -by (rtac (impI RS ballI) 1);
  18.254 -by (dresolve_tac [[lesspoll_nat_is_Finite, PowD] MRS Finite_Fin] 1
  18.255 -        THEN (assume_tac 1));
  18.256 -by (excluded_middle_tac "\\<exists>g \\<in> XX. domain(g)=succ(\\<Union>f \\<in> Y. domain(f))  \
  18.257 -\       & (\\<forall>f \\<in> Y. restrict(g, domain(f)) = f)" 1);
  18.258 -by (fast_tac (claset() addss (simpset() addsimps [RR_def])) 2); 
  18.259 -by (safe_tac (claset() delrules [domainE]));
  18.260 -by (rewrite_goals_tac [XX_def,RR_def]);
  18.261 -by (swap_res_tac [bexI] 1 THEN etac singleton_in_funs 2);
  18.262 -by (asm_full_simp_tac (simpset() addsimps [nat_0I  RSN (2, bexI), 
  18.263 -					   cons_fun_type2]) 1);
  18.264 -qed "lemma4";
  18.265 -
  18.266 -Goal "[| f \\<in> nat->X; n \\<in> nat |] ==>  \
  18.267 -\       (\\<Union>x \\<in> f``succ(n). P(x)) =  P(f`n) Un (\\<Union>x \\<in> f``n. P(x))";
  18.268 -by (asm_full_simp_tac (simpset()
  18.269 -        addsimps [Ord_nat RSN (2, OrdmemD) RSN (2, image_fun),
  18.270 -        [nat_succI, Ord_nat] MRS OrdmemD RSN (2, image_fun)]) 1);
  18.271 -qed "UN_image_succ_eq";
  18.272 -
  18.273 -Goal "[| (\\<Union>x \\<in> f``n. P(x)) = y; P(f`n) = succ(y);  \
  18.274 -\        f \\<in> nat -> X; n \\<in> nat |] ==> (\\<Union>x \\<in> f``succ(n). P(x)) = succ(y)";
  18.275 -by (asm_full_simp_tac (simpset() addsimps [UN_image_succ_eq]) 1);
  18.276 -by (Fast_tac 1);
  18.277 -qed "UN_image_succ_eq_succ";
  18.278 -
  18.279 -Goal "[| f \\<in> succ(n) -> D;  n \\<in> nat;  \
  18.280 -\        domain(f)=succ(x); x=y |] ==> f`y \\<in> D";
  18.281 -by (fast_tac (claset() addEs [apply_type]
  18.282 -	      addSDs [[sym, domain_of_fun] MRS trans]) 1);
  18.283 -qed "apply_domain_type";
  18.284 -
  18.285 -Goal "[| f \\<in> nat -> X; n \\<in> nat |] ==> f``succ(n) = cons(f`n, f``n)";
  18.286 -by (asm_full_simp_tac (simpset()
  18.287 -        addsimps [nat_succI, Ord_nat RSN (2, OrdmemD), image_fun]) 1);
  18.288 -qed "image_fun_succ";
  18.289 -
  18.290 -Goalw [XX_def] "[| domain(f`n) = succ(u); f \\<in> nat -> XX;  u=k;  n \\<in> nat |]   \
  18.291 -\               ==> f`n \\<in> succ(k) -> domain(R)";
  18.292 -by (dtac apply_type 1 THEN (assume_tac 1));
  18.293 -by (fast_tac (claset() addEs [domain_eq_imp_fun_type]) 1);
  18.294 -qed "f_n_type";
  18.295 -
  18.296 -Goalw [XX_def]
  18.297 -     "[| f \\<in> nat -> XX;  domain(f`n) = succ(k);  n \\<in> nat |]  \
  18.298 -\     ==> \\<forall>i \\<in> k. <f`n`i, f`n`succ(i)> \\<in> R";
  18.299 -by (dtac apply_type 1 THEN (assume_tac 1));
  18.300 -by (etac UN_E 1);
  18.301 -by (etac CollectE 1);
  18.302 -by (dresolve_tac [domain_of_fun RS sym RS trans] 1 THEN (assume_tac 1));
  18.303 -by (Asm_full_simp_tac 1);
  18.304 -qed "f_n_pairs_in_R";
  18.305 -
  18.306 -Goalw [restrict_def]
  18.307 -     "[| restrict(f, domain(x))=x;  f \\<in> n->X;  domain(x) \\<subseteq> n |]  \
  18.308 -\     ==> restrict(cons(<n, y>, f), domain(x)) = x";
  18.309 -by (eresolve_tac [sym RS trans RS sym] 1);
  18.310 -by (rtac fun_extension 1);
  18.311 -by (fast_tac (claset() addSIs [lam_type]) 1);
  18.312 -by (fast_tac (claset() addSIs [lam_type]) 1);
  18.313 -by (asm_full_simp_tac (simpset() addsimps [subsetD RS cons_val_k]) 1);
  18.314 -qed "restrict_cons_eq_restrict";
  18.315 -
  18.316 -Goal "[| \\<forall>x \\<in> f``n. restrict(f`n, domain(x))=x;  \
  18.317 -\        f \\<in> nat -> XX;  \
  18.318 -\        n \\<in> nat;  domain(f`n) = succ(n);  \
  18.319 -\        (\\<Union>x \\<in> f``n. domain(x)) \\<subseteq> n |] \
  18.320 -\     ==> \\<forall>x \\<in> f``succ(n). restrict(cons(<succ(n),y>, f`n), domain(x)) = x";
  18.321 -by (rtac ballI 1);
  18.322 -by (asm_full_simp_tac (simpset() addsimps [image_fun_succ]) 1);
  18.323 -by (dtac f_n_type 1 THEN REPEAT (ares_tac [refl] 1));
  18.324 -by (etac disjE 1);
  18.325 -by (asm_full_simp_tac (simpset() addsimps [domain_of_fun,restrict_cons_eq]) 1);
  18.326 -by (dtac bspec 1 THEN (assume_tac 1));
  18.327 -by (fast_tac (claset() addSEs [restrict_cons_eq_restrict]) 1);
  18.328 -qed "all_in_image_restrict_eq";
  18.329 -
  18.330 -Goalw [RR_def, allRR_def]
  18.331 -     "[| \\<forall>b<nat. <f``b, f`b> \\<in> RR;  \
  18.332 -\        f \\<in> nat -> XX; range(R) \\<subseteq> domain(R); x \\<in> domain(R)|]   \
  18.333 -\     ==> allRR";
  18.334 -by (rtac oallI 1);
  18.335 -by (dtac ltD 1);
  18.336 -by (etac nat_induct 1);
  18.337 -by (dresolve_tac [[nat_0I, Ord_nat] MRS ltI RSN (2, ospec)] 1);
  18.338 -by (fast_tac (FOL_cs addss
  18.339 -              (simpset() addsimps [singleton_fun RS domain_of_fun,
  18.340 -                                  singleton_0, singleton_in_funs])) 1);
  18.341 -(*induction step*) (** LEVEL 5 **)
  18.342 -by (full_simp_tac (*prevent simplification of ~\\<exists>to \\<forall>~*)
  18.343 -		  (FOL_ss addsimps [separation, split]) 1);
  18.344 -by (dresolve_tac [[nat_succI, Ord_nat] MRS ltI RSN (2, ospec)] 1
  18.345 -        THEN (assume_tac 1));
  18.346 -by (REPEAT (eresolve_tac [conjE, disjE] 1));
  18.347 -by (force_tac (FOL_cs addSEs [trans, subst_context]
  18.348 -                     addSIs [UN_image_succ_eq_succ], simpset()) 1);
  18.349 -by (etac conjE 1);
  18.350 -by (etac notE 1);
  18.351 -by (asm_lr_simp_tac (simpset() addsimps [XX_def, UN_image_succ_eq_succ]) 1);
  18.352 -(** LEVEL 12 **)
  18.353 -by (REPEAT (eresolve_tac [conjE, bexE] 1));
  18.354 -by (dtac apply_domain_type 1 THEN REPEAT (assume_tac 1));
  18.355 -by (etac domainE 1);
  18.356 -by (etac domainE 1);
  18.357 -by (forward_tac [export f_n_type] 1 THEN REPEAT (assume_tac 1));
  18.358 -by (rtac bexI 1);
  18.359 -by (etac nat_succI 2);
  18.360 -by (res_inst_tac [("x","cons(<succ(xa), ya>, f`xa)")] bexI 1);
  18.361 -by (rtac conjI 1);
  18.362 -by (fast_tac (FOL_cs
  18.363 -        addEs [subst_context RSN (2, trans) RS domain_cons_eq_succ,
  18.364 -	       subst_context, export all_in_image_restrict_eq, 
  18.365 -	       trans, equalityD1]) 2);
  18.366 -by (eresolve_tac [rangeI RSN (2, subsetD) RSN (2, cons_fun_type2)] 2
  18.367 -        THEN REPEAT (assume_tac 2));
  18.368 -by (rtac ballI 1);
  18.369 -by (etac succE 1);
  18.370 -(** LEVEL 25 **)
  18.371 -by (EVERY [dtac (domain_of_fun RSN (2, export f_n_pairs_in_R)) 2,
  18.372 -  REPEAT (assume_tac 2), dtac bspec 2, assume_tac 2]);
  18.373 -by (asm_full_simp_tac (simpset()
  18.374 -        addsimps [nat_into_Ord RS succ_in_succ, succI2, cons_val_k]) 2);
  18.375 -by (asm_full_simp_tac (simpset() addsimps [cons_val_n, cons_val_k]) 1);
  18.376 -qed "simplify_recursion";
  18.377 -
  18.378 -
  18.379 -Goalw [allRR_def]
  18.380 -     "[| allRR; f \\<in> nat -> XX; range(R) \\<subseteq> domain(R); x \\<in> domain(R); n \\<in> nat |]   \
  18.381 -\     ==> f`n \\<in> succ(n) -> domain(R) & (\\<forall>i \\<in> n. <f`n`i, f`n`succ(i)>:R)";
  18.382 -by (dtac ospec 1);
  18.383 -by (eresolve_tac [Ord_nat RSN (2, ltI)] 1);
  18.384 -by (etac CollectE 1);
  18.385 -by (Asm_full_simp_tac 1);
  18.386 -by (rtac conjI 1);
  18.387 -by (fast_tac (FOL_cs addSEs [conjE, f_n_pairs_in_R, trans, subst_context]) 2);
  18.388 -by (rewtac XX_def);
  18.389 -by (fast_tac (claset()
  18.390 -        addSEs [trans RS domain_eq_imp_fun_type, subst_context]) 1);
  18.391 -qed "lemma2";
  18.392 -
  18.393 -Goal "[| allRR;  f \\<in> nat -> XX;  n \\<in> nat;  range(R) \\<subseteq> domain(R);  x \\<in> domain(R)  \
  18.394 -\       |] ==> f`n`n = f`succ(n)`n";
  18.395 -by (forward_tac [lemma2 RS conjunct1 RS domain_of_fun] 1
  18.396 -        THEN REPEAT (assume_tac 1));
  18.397 -by (rewtac allRR_def);
  18.398 -by (dresolve_tac [[nat_succI, Ord_nat] MRS ltI RSN (2, ospec)] 1
  18.399 -        THEN (assume_tac 1));
  18.400 -by (Asm_full_simp_tac 1);
  18.401 -by (REPEAT (etac conjE 1));
  18.402 -by (etac ballE 1);
  18.403 -by (eresolve_tac [restrict_eq_imp_val_eq RS sym] 1);
  18.404 -by (fast_tac (claset() addSEs [ssubst]) 1);
  18.405 -by (asm_full_simp_tac (simpset()
  18.406 -        addsimps [[nat_succI, Ord_nat] MRS OrdmemD RSN (2, image_fun)]) 1);
  18.407 -qed "lemma3";
  18.408 -
  18.409 -Close_locale "imp_DC0";
  18.410 -
  18.411 -
  18.412 -Goalw [DC_def, DC0_def] "DC(nat) ==> DC0";
  18.413 -by (REPEAT (resolve_tac [allI, impI] 1));
  18.414 -by (REPEAT (eresolve_tac [asm_rl, conjE, ex_in_domain RS exE, allE] 1));
  18.415 -by (eresolve_tac [export lemma4 RSN (2, impE)] 1
  18.416 -        THEN REPEAT (assume_tac 1));
  18.417 -by (etac bexE 1);
  18.418 -by (dresolve_tac [export simplify_recursion] 1
  18.419 -        THEN REPEAT (assume_tac 1));
  18.420 -by (res_inst_tac [("x","\\<lambda>n \\<in> nat. f`n`n")] bexI 1);
  18.421 -by (rtac lam_type 2);
  18.422 -by (eresolve_tac [[export lemma2 RS conjunct1, succI1] MRS apply_type] 2
  18.423 -        THEN REPEAT (assume_tac 2));
  18.424 -by (rtac ballI 1);
  18.425 -by (forward_tac [export (nat_succI RSN (5,lemma2)) RS conjunct2] 1
  18.426 -        THEN REPEAT (assume_tac 1));
  18.427 -by (dresolve_tac [export lemma3] 1 THEN REPEAT (assume_tac 1));
  18.428 -by (asm_full_simp_tac (simpset() addsimps [nat_succI]) 1);
  18.429 -qed "DC_nat_imp_DC0";
  18.430 -
  18.431 -(* ********************************************************************** *)
  18.432 -(* \\<forall>K. Card(K) --> DC(K) ==> WO3                                       *)
  18.433 -(* ********************************************************************** *)
  18.434 -
  18.435 -Goalw [lesspoll_def]
  18.436 -        "[| ~ A lesspoll B; C lesspoll B |] ==> A - C \\<noteq> 0";
  18.437 -by (fast_tac (claset() addSDs [Diff_eq_0_iff RS iffD1 RS subset_imp_lepoll]
  18.438 -        addSIs [eqpollI] addEs [notE] addSEs [eqpollE, lepoll_trans]) 1);
  18.439 -qed "lesspoll_lemma";
  18.440 -
  18.441 -val [f_type, Ord_a, not_eq] = goalw thy [inj_def]
  18.442 -        "[| f \\<in> a->X; Ord(a); (!!b c. [| b<c; c \\<in> a |] ==> f`b\\<noteq>f`c) |]   \
  18.443 -\        ==> f \\<in> inj(a, X)";
  18.444 -by (resolve_tac [f_type RS CollectI] 1);
  18.445 -by (REPEAT (resolve_tac [ballI,impI] 1));
  18.446 -by (resolve_tac [Ord_a RS Ord_in_Ord RS Ord_linear_lt] 1
  18.447 -        THEN (assume_tac 1));
  18.448 -by (eres_inst_tac [("j","x")] (Ord_a RS Ord_in_Ord) 1);
  18.449 -by (REPEAT (fast_tac (claset() addDs [not_eq, not_eq RS not_sym]) 1));
  18.450 -qed "fun_Ord_inj";
  18.451 -
  18.452 -Goal "[| f \\<in> X->Y; A \\<subseteq> X; a \\<in> A |] ==> f`a \\<in> f``A";
  18.453 -by (fast_tac (claset() addSEs [image_fun RS ssubst]) 1);
  18.454 -qed "value_in_image";
  18.455 -
  18.456 -Goalw [DC_def, WO3_def] "\\<forall>K. Card(K) --> DC(K) ==> WO3";
  18.457 -by (rtac allI 1);
  18.458 -by (excluded_middle_tac "A lesspoll Hartog(A)" 1);
  18.459 -by (fast_tac (claset() addSDs [lesspoll_imp_ex_lt_eqpoll]
  18.460 -        addSIs [Ord_Hartog, leI RS le_imp_subset]) 2);
  18.461 -by (REPEAT (eresolve_tac [allE, impE] 1));
  18.462 -by (rtac Card_Hartog 1);
  18.463 -by (eres_inst_tac [("x","A")] allE 1);
  18.464 -by (eres_inst_tac [("x","{<z1,z2>:Pow(A)*A . z1  \
  18.465 -\               lesspoll Hartog(A) & z2 \\<notin> z1}")] allE 1);
  18.466 -by (Asm_full_simp_tac 1);
  18.467 -by (etac impE 1);
  18.468 -by (fast_tac (claset() addEs [lesspoll_lemma RS not_emptyE]) 1);
  18.469 -by (etac bexE 1);
  18.470 -by (resolve_tac [exI RS (lepoll_def RS (def_imp_iff RS iffD2))
  18.471 -        RS (HartogI RS notE)] 1);
  18.472 -by (resolve_tac [Ord_Hartog RSN (2, fun_Ord_inj)] 1 THEN (assume_tac 1));
  18.473 -by (dresolve_tac [Ord_Hartog RSN (2, OrdmemD) RSN (2,
  18.474 -        ltD RSN (3, value_in_image))] 1 
  18.475 -        THEN REPEAT (assume_tac 1));
  18.476 -by (force_tac (claset() addSDs [Ord_Hartog RSN (2, ltI) RSN (2, ospec)], 
  18.477 -	       simpset()) 1);
  18.478 -qed "DC_WO3";
  18.479 -
  18.480 -(* ********************************************************************** *)
  18.481 -(* WO1 ==> \\<forall>K. Card(K) --> DC(K)                                       *)
  18.482 -(* ********************************************************************** *)
  18.483 -
  18.484 -Goal "[| Ord(a); b \\<in> a |] ==> (\\<lambda>x \\<in> a. P(x))``b = (\\<lambda>x \\<in> b. P(x))``b";
  18.485 -by (rtac images_eq 1);
  18.486 -by (REPEAT (fast_tac (claset() addSEs [RepFunI, OrdmemD]
  18.487 -        addSIs [lam_type]) 2));
  18.488 -by (rtac ballI 1);
  18.489 -by (dresolve_tac [OrdmemD RS subsetD] 1
  18.490 -        THEN REPEAT (assume_tac 1));
  18.491 -by (Asm_full_simp_tac 1);
  18.492 -qed "lam_images_eq";
  18.493 -
  18.494 -Goalw [lesspoll_def] "[| Card(K); b \\<in> K |] ==> b lesspoll K";
  18.495 -by (asm_full_simp_tac (simpset() addsimps [Card_iff_initial]) 1);
  18.496 -by (fast_tac (claset() addSIs [le_imp_lepoll, ltI, leI]) 1);
  18.497 -qed "in_Card_imp_lesspoll";
  18.498 -
  18.499 -Goal "(\\<lambda>b \\<in> a. P(b)) \\<in> a -> {P(b). b \\<in> a}";
  18.500 -by (fast_tac (claset() addSIs [lam_type, RepFunI]) 1);
  18.501 -qed "lam_type_RepFun";
  18.502 -
  18.503 -Goal "[| \\<forall>Y \\<in> Pow(X). Y lesspoll K --> (\\<exists>x \\<in> X. <Y, x> \\<in> R);  \
  18.504 -\        b \\<in> K; Z \\<in> Pow(X); Z lesspoll K |]  \
  18.505 -\     ==> {x \\<in> X. <Z,x> \\<in> R} \\<noteq> 0";
  18.506 -by (Blast_tac 1);
  18.507 -qed "lemmaX";
  18.508 -
  18.509 -Goal "[| Card(K); well_ord(X,Q);  \
  18.510 -\       \\<forall>Y \\<in> Pow(X). Y lesspoll K --> (\\<exists>x \\<in> X. <Y, x> \\<in> R); b \\<in> K |]  \
  18.511 -\       ==> ff(b, X, Q, R) \\<in> {x \\<in> X. <(\\<lambda>c \\<in> b. ff(c, X, Q, R))``b, x> \\<in> R}";
  18.512 -by (res_inst_tac [("P","b \\<in> K")] impE 1 THEN TRYALL assume_tac);
  18.513 -by (res_inst_tac [("i","b")] (Card_is_Ord RS Ord_in_Ord RS trans_induct) 1
  18.514 -        THEN REPEAT (assume_tac 1));
  18.515 -by (rtac impI 1);
  18.516 -by (resolve_tac [ff_def RS def_transrec RS ssubst] 1);
  18.517 -by (etac the_first_in 1);
  18.518 -by (Fast_tac 1);
  18.519 -by (asm_full_simp_tac (simpset()
  18.520 -        addsimps [[lam_type_RepFun, subset_refl] MRS image_fun]) 1);
  18.521 -by (etac lemmaX 1 THEN assume_tac 1);
  18.522 -by (blast_tac (claset() addIs [Card_is_Ord RSN (2, OrdmemD) RS subsetD]) 1);
  18.523 -by (blast_tac (claset() addIs [lesspoll_trans1, in_Card_imp_lesspoll, 
  18.524 -                               RepFun_lepoll]) 1); 
  18.525 -qed "lemma";
  18.526 -
  18.527 -Goalw [DC_def, WO1_def] "WO1 ==> \\<forall>K. Card(K) --> DC(K)";
  18.528 -by (REPEAT (resolve_tac [allI,impI] 1));
  18.529 -by (REPEAT (eresolve_tac [allE,exE,conjE] 1));
  18.530 -by (res_inst_tac [("x","\\<lambda>b \\<in> K. ff(b, X, Ra, R)")] bexI 1);
  18.531 -by (rtac lam_type 2);
  18.532 -by (resolve_tac [lemma RS CollectD1] 2 THEN REPEAT (assume_tac 2));
  18.533 -by (asm_full_simp_tac (simpset()
  18.534 -        addsimps [[Card_is_Ord, ltD] MRS lam_images_eq]) 1);
  18.535 -by (fast_tac (claset() addSEs [ltE, lemma RS CollectD2]) 1);
  18.536 -qed "WO1_DC_Card";
    19.1 --- a/src/ZF/AC/DC.thy	Wed Jan 16 15:04:37 2002 +0100
    19.2 +++ b/src/ZF/AC/DC.thy	Wed Jan 16 17:52:06 2002 +0100
    19.3 @@ -2,69 +2,578 @@
    19.4      ID:         $Id$
    19.5      Author:     Krzysztof Grabczewski
    19.6  
    19.7 -Theory file for the proofs concernind the Axiom of Dependent Choice
    19.8 +The proofs concerning the Axiom of Dependent Choice
    19.9  *)
   19.10  
   19.11 -DC  =  AC_Equiv + Hartog + Cardinal_aux + DC_lemmas + 
   19.12 +theory DC = AC_Equiv + Hartog + Cardinal_aux:
   19.13 +
   19.14 +lemma RepFun_lepoll: "Ord(a) ==> {P(b). b \<in> a} \<lesssim> a"
   19.15 +apply (unfold lepoll_def)
   19.16 +apply (rule_tac x = "\<lambda>z \<in> RepFun (a,P) . LEAST i. z=P (i) " in exI)
   19.17 +apply (rule_tac d="%z. P (z)" in lam_injective)
   19.18 + apply (fast intro!: Least_in_Ord)
   19.19 +apply (rule sym) 
   19.20 +apply (fast intro: LeastI Ord_in_Ord) 
   19.21 +done
   19.22  
   19.23 -consts
   19.24 +text{*Trivial in the presence of AC, but here we need a wellordering of X*}
   19.25 +lemma image_Ord_lepoll: "[| f \<in> X->Y; Ord(X) |] ==> f``X \<lesssim> X"
   19.26 +apply (unfold lepoll_def)
   19.27 +apply (rule_tac x = "\<lambda>x \<in> f``X. LEAST y. f`y = x" in exI)
   19.28 +apply (rule_tac d = "%z. f`z" in lam_injective)
   19.29 +apply (fast intro!: Least_in_Ord apply_equality, clarify) 
   19.30 +apply (rule LeastI) 
   19.31 + apply (erule apply_equality, assumption+) 
   19.32 +apply (blast intro: Ord_in_Ord)
   19.33 +done
   19.34  
   19.35 -  DC  :: i => o
   19.36 -  DC0 :: o
   19.37 -  ff  :: [i, i, i, i] => i
   19.38 +lemma range_subset_domain: 
   19.39 +      "[| R \<subseteq> X*X;   !!g. g \<in> X ==> \<exists>u. <g,u> \<in> R |] 
   19.40 +       ==> range(R) \<subseteq> domain(R)"
   19.41 +by (blast ); 
   19.42 +
   19.43 +lemma cons_fun_type: "g \<in> n->X ==> cons(<n,x>, g) \<in> succ(n) -> cons(x, X)"
   19.44 +apply (unfold succ_def)
   19.45 +apply (fast intro!: fun_extend elim!: mem_irrefl)
   19.46 +done
   19.47  
   19.48 -rules
   19.49 +lemma cons_fun_type2:
   19.50 +     "[| g \<in> n->X; x \<in> X |] ==> cons(<n,x>, g) \<in> succ(n) -> X"
   19.51 +by (erule cons_absorb [THEN subst], erule cons_fun_type)
   19.52 +
   19.53 +lemma cons_image_n: "n \<in> nat ==> cons(<n,x>, g)``n = g``n"
   19.54 +by (fast elim!: mem_irrefl)
   19.55 +
   19.56 +lemma cons_val_n: "g \<in> n->X ==> cons(<n,x>, g)`n = x"
   19.57 +by (fast intro!: apply_equality elim!: cons_fun_type)
   19.58 +
   19.59 +lemma cons_image_k: "k \<in> n ==> cons(<n,x>, g)``k = g``k"
   19.60 +by (fast elim: mem_asym)
   19.61  
   19.62 -  DC_def  "DC(a) ==
   19.63 -	     \\<forall>X R. R \\<subseteq> Pow(X)*X &
   19.64 -             (\\<forall>Y \\<in> Pow(X). Y lesspoll a --> (\\<exists>x \\<in> X. <Y,x> \\<in> R)) 
   19.65 -             --> (\\<exists>f \\<in> a->X. \\<forall>b<a. <f``b,f`b> \\<in> R)"
   19.66 +lemma cons_val_k: "[| k \<in> n; g \<in> n->X |] ==> cons(<n,x>, g)`k = g`k"
   19.67 +by (fast intro!: apply_equality consI2 elim!: cons_fun_type apply_Pair)
   19.68 +
   19.69 +lemma domain_cons_eq_succ: "domain(f)=x ==> domain(cons(<x,y>, f)) = succ(x)"
   19.70 +by (simp add: domain_cons succ_def)
   19.71 +
   19.72 +lemma restrict_cons_eq: "g \<in> n->X ==> restrict(cons(<n,x>, g), n) = g"
   19.73 +apply (unfold restrict_def)
   19.74 +apply (rule fun_extension)
   19.75 +apply (rule lam_type)
   19.76 +apply (erule cons_fun_type [THEN apply_type])
   19.77 +apply (erule succI2, assumption)
   19.78 +apply (simp add: cons_val_k)
   19.79 +done
   19.80 +
   19.81 +lemma succ_in_succ: "[| Ord(k); i \<in> k |] ==> succ(i) \<in> succ(k)"
   19.82 +apply (rule Ord_linear [of "succ(i)" "succ(k)", THEN disjE])
   19.83 +apply (fast elim: Ord_in_Ord mem_irrefl mem_asym)+
   19.84 +done
   19.85  
   19.86 -  DC0_def "DC0 == \\<forall>A B R. R \\<subseteq> A*B & R\\<noteq>0 & range(R) \\<subseteq> domain(R) 
   19.87 -                  --> (\\<exists>f \\<in> nat->domain(R). \\<forall>n \\<in> nat. <f`n,f`succ(n)>:R)"
   19.88 +lemma restrict_eq_imp_val_eq: 
   19.89 +      "[| restrict(f, domain(g)) = g; x \<in> domain(g) |] ==> f`x = g`x"
   19.90 +apply (unfold restrict_def) 
   19.91 +apply (erule subst, simp)
   19.92 +done
   19.93 +
   19.94 +lemma domain_eq_imp_fun_type: "[| domain(f)=A; f \<in> B->C |] ==> f \<in> A->C"
   19.95 +by (frule domain_of_fun, fast)
   19.96 +
   19.97 +lemma ex_in_domain: "[| R \<subseteq> A * B; R \<noteq> 0 |] ==> \<exists>x. x \<in> domain(R)"
   19.98 +by (fast elim!: not_emptyE)
   19.99 +
  19.100  
  19.101 -  ff_def  "ff(b, X, Q, R) ==
  19.102 -	   transrec(b, %c r. THE x. first(x, {x \\<in> X. <r``c, x> \\<in> R}, Q))"
  19.103 -  
  19.104 +constdefs
  19.105 +
  19.106 +  DC  :: "i => o"
  19.107 +    "DC(a) == \<forall>X R. R \<subseteq> Pow(X)*X  &
  19.108 +		    (\<forall>Y \<in> Pow(X). Y \<prec> a --> (\<exists>x \<in> X. <Y,x> \<in> R)) 
  19.109 +		    --> (\<exists>f \<in> a->X. \<forall>b<a. <f``b,f`b> \<in> R)"
  19.110 +
  19.111 +  DC0 :: o
  19.112 +    "DC0 == \<forall>A B R. R \<subseteq> A*B & R\<noteq>0 & range(R) \<subseteq> domain(R) 
  19.113 +                    --> (\<exists>f \<in> nat->domain(R). \<forall>n \<in> nat. <f`n,f`succ(n)>:R)"
  19.114 +
  19.115 +  ff  :: "[i, i, i, i] => i"
  19.116 +    "ff(b, X, Q, R) ==
  19.117 +	   transrec(b, %c r. THE x. first(x, {x \<in> X. <r``c, x> \<in> R}, Q))"
  19.118 +
  19.119  
  19.120  locale DC0_imp =
  19.121 -  fixes 
  19.122 -    XX	:: i
  19.123 -    RR	:: i
  19.124 -    X	:: i
  19.125 -    R	:: i
  19.126 +  fixes XX and RR and X and R
  19.127 +
  19.128 +  assumes all_ex: "\<forall>Y \<in> Pow(X). Y \<prec> nat --> (\<exists>x \<in> X. <Y, x> \<in> R)"
  19.129 +
  19.130 +  defines XX_def: "XX == (\<Union>n \<in> nat. {f \<in> n->X. \<forall>k \<in> n. <f``k, f`k> \<in> R})"
  19.131 +     and RR_def:  "RR == {<z1,z2>:XX*XX. domain(z2)=succ(domain(z1))  
  19.132 +                                       & restrict(z2, domain(z1)) = z1}"
  19.133 +
  19.134 +
  19.135 +(* ********************************************************************** *)
  19.136 +(* DC ==> DC(omega)                                                       *)
  19.137 +(*                                                                        *)
  19.138 +(* The scheme of the proof:                                               *)
  19.139 +(*                                                                        *)
  19.140 +(* Assume DC. Let R and X satisfy the premise of DC(omega).               *)
  19.141 +(*                                                                        *)
  19.142 +(* Define XX and RR as follows:                                           *)
  19.143 +(*                                                                        *)
  19.144 +(*       XX = (\<Union>n \<in> nat. {f \<in> n->X. \<forall>k \<in> n. <f``k, f`k> \<in> R})           *)
  19.145 +(*       f RR g iff domain(g)=succ(domain(f)) &                           *)
  19.146 +(*              restrict(g, domain(f)) = f                                *)
  19.147 +(*                                                                        *)
  19.148 +(* Then RR satisfies the hypotheses of DC.                                *)
  19.149 +(* So applying DC:                                                        *)
  19.150 +(*                                                                        *)
  19.151 +(*       \<exists>f \<in> nat->XX. \<forall>n \<in> nat. f`n RR f`succ(n)                        *)
  19.152 +(*                                                                        *)
  19.153 +(* Thence                                                                 *)
  19.154 +(*                                                                        *)
  19.155 +(*       ff = {<n, f`succ(n)`n>. n \<in> nat}                                 *)
  19.156 +(*                                                                        *)
  19.157 +(* is the desired function.                                               *)
  19.158 +(*                                                                        *)
  19.159 +(* ********************************************************************** *)
  19.160 +
  19.161 +lemma (in DC0_imp) lemma1_1: "RR \<subseteq> XX*XX"
  19.162 +by (unfold RR_def, fast)
  19.163 +
  19.164 +lemma (in DC0_imp) lemma1_2: "RR \<noteq> 0"
  19.165 +apply (unfold RR_def XX_def)
  19.166 +apply (rule all_ex [THEN ballE])
  19.167 +apply (erule_tac [2] notE [OF _ empty_subsetI [THEN PowI]])
  19.168 +apply (erule_tac impE [OF _ nat_0I [THEN n_lesspoll_nat]])
  19.169 +apply (erule bexE)
  19.170 +apply (rule_tac a = "<0, {<0, x>}>" in not_emptyI)
  19.171 +apply (rule CollectI)
  19.172 +apply (rule SigmaI)
  19.173 +apply (rule nat_0I [THEN UN_I])
  19.174 +apply (simp (no_asm_simp) add: nat_0I [THEN UN_I])
  19.175 +apply (rule nat_1I [THEN UN_I])
  19.176 +apply (force intro!: singleton_fun [THEN Pi_type]
  19.177 +             simp add: singleton_0 [symmetric])
  19.178 +apply (simp add: singleton_0)
  19.179 +done
  19.180 +
  19.181 +lemma (in DC0_imp) lemma1_3: "range(RR) \<subseteq> domain(RR)"
  19.182 +apply (unfold RR_def XX_def)
  19.183 +apply (rule range_subset_domain, blast, clarify)
  19.184 +apply (frule fun_is_rel [THEN image_subset, THEN PowI, 
  19.185 +                         THEN all_ex [THEN bspec]])
  19.186 +apply (erule impE[OF _ lesspoll_trans1[OF image_Ord_lepoll 
  19.187 +                                          [OF _ nat_into_Ord] n_lesspoll_nat]],
  19.188 +       assumption+)
  19.189 +apply (erule bexE)
  19.190 +apply (rule_tac x = "cons (<n,x>, g) " in exI)
  19.191 +apply (rule CollectI)
  19.192 +apply (force elim!: cons_fun_type2 
  19.193 +             simp add: cons_image_n cons_val_n cons_image_k cons_val_k)
  19.194 +apply (simp add: domain_of_fun succ_def restrict_cons_eq)
  19.195 +done
  19.196  
  19.197 -  assumes
  19.198 -    all_ex    "\\<forall>Y \\<in> Pow(X). Y lesspoll nat --> (\\<exists>x \\<in> X. <Y, x> \\<in> R)"
  19.199 +lemma (in DC0_imp) lemma2:
  19.200 +     "[| \<forall>n \<in> nat. <f`n, f`succ(n)> \<in> RR;  f \<in> nat -> XX;  n \<in> nat |]   
  19.201 +      ==> \<exists>k \<in> nat. f`succ(n) \<in> k -> X & n \<in> k   
  19.202 +                  & <f`succ(n)``n, f`succ(n)`n> \<in> R"
  19.203 +apply (induct_tac "n")
  19.204 +apply (drule apply_type [OF _ nat_1I])
  19.205 +apply (drule bspec [OF _ nat_0I])
  19.206 +apply (simp add: XX_def, safe)
  19.207 +apply (rule rev_bexI, assumption)
  19.208 +apply (subgoal_tac "0 \<in> x", force)
  19.209 +apply (force simp add: RR_def
  19.210 +	     intro: ltD elim!: nat_0_le [THEN leE])
  19.211 +(** LEVEL 7, other subgoal **)
  19.212 +apply (drule bspec [OF _ nat_succI], assumption)
  19.213 +apply (subgoal_tac "f ` succ (succ (x)) \<in> succ (k) ->X")
  19.214 +apply (drule apply_type [OF _ nat_succI [THEN nat_succI]], assumption)
  19.215 +apply (simp (no_asm_use) add: XX_def RR_def)
  19.216 +apply safe
  19.217 +apply (frule_tac a="succ(k)" in domain_of_fun [symmetric, THEN trans], 
  19.218 +       assumption)
  19.219 +apply (frule_tac a="xa" in domain_of_fun [symmetric, THEN trans], 
  19.220 +       assumption)
  19.221 +apply (fast elim!: nat_into_Ord [THEN succ_in_succ] 
  19.222 +            dest!: bspec [OF _ nat_into_Ord [THEN succ_in_succ]])
  19.223 +apply (drule domain_of_fun)
  19.224 +apply (simp add: XX_def RR_def, clarify) 
  19.225 +apply (blast dest: domain_of_fun [symmetric, THEN trans] )
  19.226 +done
  19.227 +
  19.228 +lemma (in DC0_imp) lemma3_1:
  19.229 +     "[| \<forall>n \<in> nat. <f`n, f`succ(n)> \<in> RR;  f \<in> nat -> XX;  m \<in> nat |]   
  19.230 +      ==>  {f`succ(x)`x. x \<in> m} = {f`succ(m)`x. x \<in> m}"
  19.231 +apply (subgoal_tac "\<forall>x \<in> m. f`succ (m) `x = f`succ (x) `x")
  19.232 +apply simp
  19.233 +apply (induct_tac "m", blast)
  19.234 +apply (rule ballI)
  19.235 +apply (erule succE)
  19.236 + apply (rule restrict_eq_imp_val_eq)
  19.237 +  apply (drule bspec [OF _ nat_succI], assumption)
  19.238 +  apply (simp add: RR_def)
  19.239 + apply (drule lemma2, assumption+)
  19.240 + apply (fast dest!: domain_of_fun)
  19.241 +apply (drule_tac x = "xa" in bspec, assumption)
  19.242 +apply (erule sym [THEN trans, symmetric])
  19.243 +apply (rule restrict_eq_imp_val_eq [symmetric])
  19.244 + apply (drule bspec [OF _ nat_succI], assumption)
  19.245 + apply (simp add: RR_def)
  19.246 +apply (drule lemma2, assumption+)
  19.247 +apply (blast dest!: domain_of_fun 
  19.248 +             intro: nat_into_Ord OrdmemD [THEN subsetD])
  19.249 +done
  19.250  
  19.251 -  defines
  19.252 -    XX_def    "XX == (\\<Union>n \\<in> nat. {f \\<in> n->X. \\<forall>k \\<in> n. <f``k, f`k> \\<in> R})"
  19.253 -    RR_def    "RR == {<z1,z2>:XX*XX. domain(z2)=succ(domain(z1))  
  19.254 -                                  & restrict(z2, domain(z1)) = z1}"
  19.255 +lemma (in DC0_imp) lemma3:
  19.256 +     "[| \<forall>n \<in> nat. <f`n, f`succ(n)> \<in> RR;  f \<in> nat -> XX;  m \<in> nat |]  
  19.257 +      ==> (\<lambda>x \<in> nat. f`succ(x)`x) `` m = f`succ(m)``m"
  19.258 +apply (erule natE, simp)
  19.259 +apply (subst image_lam)
  19.260 + apply (fast elim!: OrdmemD [OF nat_succI Ord_nat])
  19.261 +apply (subst lemma3_1, assumption+)
  19.262 + apply fast
  19.263 +apply (fast dest!: lemma2 
  19.264 +            elim!: image_fun [symmetric, OF _ OrdmemD [OF _ nat_into_Ord]])
  19.265 +done
  19.266 +
  19.267 +
  19.268 +theorem DC0_imp_DC_nat: "DC0 ==> DC(nat)"
  19.269 +apply (unfold DC_def DC0_def, clarify)
  19.270 +apply (elim allE)
  19.271 +apply (erule impE)
  19.272 +   (*these three results comprise Lemma 1*)
  19.273 +apply (blast intro!: DC0_imp.lemma1_1 DC0_imp.lemma1_2 DC0_imp.lemma1_3)
  19.274 +apply (erule bexE)
  19.275 +apply (rule_tac x = "\<lambda>n \<in> nat. f`succ (n) `n" in rev_bexI)
  19.276 + apply (rule lam_type, blast dest!: DC0_imp.lemma2 intro: fun_weaken_type)
  19.277 +apply (rule oallI)
  19.278 +apply (frule DC0_imp.lemma2, assumption)
  19.279 +  apply (blast intro: fun_weaken_type)
  19.280 + apply (erule ltD) 
  19.281 +(** LEVEL 11: last subgoal **)
  19.282 +apply (subst DC0_imp.lemma3, assumption+) 
  19.283 +  apply (fast elim!: fun_weaken_type)
  19.284 + apply (erule ltD, force) 
  19.285 +done
  19.286 +
  19.287 +
  19.288 +(* ************************************************************************
  19.289 +   DC(omega) ==> DC                                                       
  19.290 +                                                                          
  19.291 +   The scheme of the proof:                                               
  19.292 +                                                                          
  19.293 +   Assume DC(omega). Let R and x satisfy the premise of DC.               
  19.294 +                                                                          
  19.295 +   Define XX and RR as follows:                                           
  19.296 +                                                                          
  19.297 +    XX = (\<Union>n \<in> nat. {f \<in> succ(n)->domain(R). \<forall>k \<in> n. <f`k, f`succ(k)> \<in> R})
  19.298 +
  19.299 +    RR = {<z1,z2>:Fin(XX)*XX. 
  19.300 +           (domain(z2)=succ(\<Union>f \<in> z1. domain(f)) &
  19.301 +	    (\<forall>f \<in> z1. restrict(z2, domain(f)) = f)) |      
  19.302 +	   (~ (\<exists>g \<in> XX. domain(g)=succ(\<Union>f \<in> z1. domain(f)) &
  19.303 +	                (\<forall>f \<in> z1. restrict(g, domain(f)) = f)) &           
  19.304 +	    z2={<0,x>})}                                          
  19.305 +                                                                          
  19.306 +   Then XX and RR satisfy the hypotheses of DC(omega).                    
  19.307 +   So applying DC:                                                        
  19.308 +                                                                          
  19.309 +         \<exists>f \<in> nat->XX. \<forall>n \<in> nat. f``n RR f`n                             
  19.310 +                                                                          
  19.311 +   Thence                                                                 
  19.312 +                                                                          
  19.313 +         ff = {<n, f`n`n>. n \<in> nat}                                         
  19.314 +                                                                          
  19.315 +   is the desired function.                                               
  19.316 +                                                                          
  19.317 +************************************************************************* *)
  19.318 +
  19.319 +lemma singleton_in_funs: 
  19.320 + "x \<in> X ==> {<0,x>} \<in> 
  19.321 +            (\<Union>n \<in> nat. {f \<in> succ(n)->X. \<forall>k \<in> n. <f`k, f`succ(k)> \<in> R})"
  19.322 +apply (rule nat_0I [THEN UN_I])
  19.323 +apply (force simp add: singleton_0 [symmetric]
  19.324 +	     intro!: singleton_fun [THEN Pi_type])
  19.325 +done
  19.326  
  19.327  
  19.328  locale imp_DC0 =
  19.329 -  fixes 
  19.330 -    XX	:: i
  19.331 -    RR	:: i
  19.332 -    x	:: i
  19.333 -    R	:: i
  19.334 -    f	:: i
  19.335 -    allRR :: o
  19.336 +  fixes XX and RR and x and R and f and allRR
  19.337 +  defines XX_def: "XX == (\<Union>n \<in> nat.
  19.338 +		      {f \<in> succ(n)->domain(R). \<forall>k \<in> n. <f`k, f`succ(k)> \<in> R})"
  19.339 +      and RR_def:
  19.340 +	 "RR == {<z1,z2>:Fin(XX)*XX. 
  19.341 +		  (domain(z2)=succ(\<Union>f \<in> z1. domain(f))  
  19.342 +		    & (\<forall>f \<in> z1. restrict(z2, domain(f)) = f))
  19.343 +		  | (~ (\<exists>g \<in> XX. domain(g)=succ(\<Union>f \<in> z1. domain(f))  
  19.344 +		     & (\<forall>f \<in> z1. restrict(g, domain(f)) = f)) & z2={<0,x>})}"
  19.345 +      and allRR_def:
  19.346 +	"allRR == \<forall>b<nat.
  19.347 +		   <f``b, f`b> \<in>  
  19.348 +		    {<z1,z2>\<in>Fin(XX)*XX. (domain(z2)=succ(\<Union>f \<in> z1. domain(f))
  19.349 +				    & (\<Union>f \<in> z1. domain(f)) = b  
  19.350 +				    & (\<forall>f \<in> z1. restrict(z2,domain(f)) = f))}"
  19.351 +
  19.352 +lemma (in imp_DC0) lemma4:
  19.353 +     "[| range(R) \<subseteq> domain(R);  x \<in> domain(R) |]   
  19.354 +      ==> RR \<subseteq> Pow(XX)*XX &   
  19.355 +             (\<forall>Y \<in> Pow(XX). Y \<prec> nat --> (\<exists>x \<in> XX. <Y,x>:RR))"
  19.356 +apply (rule conjI)
  19.357 +apply (force dest!: FinD [THEN PowI] simp add: RR_def)
  19.358 +apply (rule impI [THEN ballI])
  19.359 +apply (drule Finite_Fin [OF lesspoll_nat_is_Finite PowD], assumption)
  19.360 +apply (case_tac
  19.361 +       "\<exists>g \<in> XX. domain (g) =
  19.362 +             succ(\<Union>f \<in> Y. domain(f)) & (\<forall>f\<in>Y. restrict(g, domain(f)) = f)")
  19.363 +apply (simp add: RR_def, blast)
  19.364 +apply (safe del: domainE)
  19.365 +apply (unfold XX_def RR_def)
  19.366 +apply (rule rev_bexI, erule singleton_in_funs)
  19.367 +apply (simp add: nat_0I [THEN rev_bexI] cons_fun_type2)
  19.368 +done
  19.369 +
  19.370 +lemma (in imp_DC0) UN_image_succ_eq:
  19.371 +     "[| f \<in> nat->X; n \<in> nat |] 
  19.372 +      ==> (\<Union>x \<in> f``succ(n). P(x)) =  P(f`n) Un (\<Union>x \<in> f``n. P(x))"
  19.373 +by (simp add: image_fun OrdmemD) 
  19.374 +
  19.375 +lemma (in imp_DC0) UN_image_succ_eq_succ:
  19.376 +     "[| (\<Union>x \<in> f``n. P(x)) = y; P(f`n) = succ(y);   
  19.377 +         f \<in> nat -> X; n \<in> nat |] ==> (\<Union>x \<in> f``succ(n). P(x)) = succ(y)"
  19.378 +by (simp add: UN_image_succ_eq, blast)
  19.379 +
  19.380 +lemma (in imp_DC0) apply_domain_type:
  19.381 +     "[| h \<in> succ(n) -> D;  n \<in> nat; domain(h)=succ(y) |] ==> h`y \<in> D"
  19.382 +by (fast elim: apply_type dest!: trans [OF sym domain_of_fun])
  19.383 +
  19.384 +lemma (in imp_DC0) image_fun_succ:
  19.385 +     "[| h \<in> nat -> X; n \<in> nat |] ==> h``succ(n) = cons(h`n, h``n)"
  19.386 +by (simp add: image_fun OrdmemD) 
  19.387 +
  19.388 +lemma (in imp_DC0) f_n_type:
  19.389 +     "[| domain(f`n) = succ(k); f \<in> nat -> XX;  n \<in> nat |]    
  19.390 +      ==> f`n \<in> succ(k) -> domain(R)"
  19.391 +apply (unfold XX_def)
  19.392 +apply (drule apply_type, assumption)
  19.393 +apply (fast elim: domain_eq_imp_fun_type)
  19.394 +done
  19.395 +
  19.396 +lemma (in imp_DC0) f_n_pairs_in_R [rule_format]: 
  19.397 +     "[| h \<in> nat -> XX;  domain(h`n) = succ(k);  n \<in> nat |]   
  19.398 +      ==> \<forall>i \<in> k. <h`n`i, h`n`succ(i)> \<in> R"
  19.399 +apply (unfold XX_def)
  19.400 +apply (drule apply_type, assumption)
  19.401 +apply (elim UN_E CollectE)
  19.402 +apply (drule domain_of_fun [symmetric, THEN trans], assumption)
  19.403 +apply simp
  19.404 +done
  19.405 +
  19.406 +lemma (in imp_DC0) restrict_cons_eq_restrict: 
  19.407 +     "[| restrict(h, domain(u))=u;  h \<in> n->X;  domain(u) \<subseteq> n |]   
  19.408 +      ==> restrict(cons(<n, y>, h), domain(u)) = u"
  19.409 +apply (unfold restrict_def)
  19.410 +apply (erule sym [THEN trans, symmetric])
  19.411 +apply (rule fun_extension)
  19.412 +apply (fast intro!: lam_type)
  19.413 +apply (fast intro!: lam_type)
  19.414 +apply (simp add: subsetD [THEN cons_val_k])
  19.415 +done
  19.416 +
  19.417 +lemma (in imp_DC0) all_in_image_restrict_eq:
  19.418 +     "[| \<forall>x \<in> f``n. restrict(f`n, domain(x))=x;   
  19.419 +         f \<in> nat -> XX;   
  19.420 +         n \<in> nat;  domain(f`n) = succ(n);   
  19.421 +         (\<Union>x \<in> f``n. domain(x)) \<subseteq> n |]  
  19.422 +      ==> \<forall>x \<in> f``succ(n). restrict(cons(<succ(n),y>, f`n), domain(x)) = x"
  19.423 +apply (rule ballI)
  19.424 +apply (simp add: image_fun_succ)
  19.425 +apply (drule f_n_type, assumption+)
  19.426 +apply (erule disjE)
  19.427 + apply (simp add: domain_of_fun restrict_cons_eq) 
  19.428 +apply (blast intro!: restrict_cons_eq_restrict)
  19.429 +done
  19.430 +
  19.431 +lemma (in imp_DC0) simplify_recursion: 
  19.432 +     "[| \<forall>b<nat. <f``b, f`b> \<in> RR;   
  19.433 +         f \<in> nat -> XX; range(R) \<subseteq> domain(R); x \<in> domain(R)|]    
  19.434 +      ==> allRR"
  19.435 +apply (unfold RR_def allRR_def)
  19.436 +apply (rule oallI, drule ltD)
  19.437 +apply (erule nat_induct)
  19.438 +apply (drule_tac x="0" in ospec, blast intro: Limit_has_0) 
  19.439 +apply (force simp add: singleton_fun [THEN domain_of_fun] singleton_in_funs) 
  19.440 +(*induction step*) (** LEVEL 5 **)
  19.441 +(*prevent simplification of ~\<exists> to \<forall>~ *)
  19.442 +apply (simp only: separation split)
  19.443 +apply (drule_tac x="succ(xa)" in ospec, blast intro: ltI);
  19.444 +apply (elim conjE disjE)
  19.445 +apply (force elim!: trans subst_context
  19.446 +             intro!: UN_image_succ_eq_succ)
  19.447 +apply (erule notE)
  19.448 +apply (simp add: XX_def UN_image_succ_eq_succ)
  19.449 +apply (elim conjE bexE)
  19.450 +apply (drule apply_domain_type, assumption+)
  19.451 +apply (erule domainE)+
  19.452 +apply (frule f_n_type)
  19.453 +apply (simp add: XX_def, assumption+)
  19.454 +apply (rule rev_bexI, erule nat_succI)
  19.455 +apply (rule_tac x = "cons (<succ (xa), ya>, f`xa) " in bexI)
  19.456 +prefer 2 apply (blast intro: cons_fun_type2) 
  19.457 +apply (rule conjI)
  19.458 +prefer 2 apply (fast del: ballI subsetI
  19.459 +		 elim: trans [OF _ subst_context, THEN domain_cons_eq_succ]
  19.460 +		       subst_context
  19.461 +		       all_in_image_restrict_eq [simplified XX_def]
  19.462 +		       trans equalityD1)
  19.463 +(*one remaining subgoal*)
  19.464 +apply (rule ballI)
  19.465 +apply (erule succE)
  19.466 +(** LEVEL 25 **)
  19.467 + apply (simp add: cons_val_n cons_val_k)
  19.468 +(*assumption+ will not perform the required backtracking!*)
  19.469 +apply (drule f_n_pairs_in_R [simplified XX_def, OF _ domain_of_fun], 
  19.470 +       assumption, assumption, assumption)
  19.471 +apply (simp add: nat_into_Ord [THEN succ_in_succ] succI2 cons_val_k)
  19.472 +done
  19.473 +
  19.474  
  19.475 -  defines
  19.476 -    XX_def    "XX == (\\<Union>n \\<in> nat.
  19.477 -		      {f \\<in> succ(n)->domain(R). \\<forall>k \\<in> n. <f`k, f`succ(k)> \\<in> R})"
  19.478 -    RR_def
  19.479 -     "RR == {<z1,z2>:Fin(XX)*XX. 
  19.480 -              (domain(z2)=succ(\\<Union>f \\<in> z1. domain(f))  
  19.481 -                & (\\<forall>f \\<in> z1. restrict(z2, domain(f)) = f))
  19.482 -	      | (~ (\\<exists>g \\<in> XX. domain(g)=succ(\\<Union>f \\<in> z1. domain(f))  
  19.483 -                 & (\\<forall>f \\<in> z1. restrict(g, domain(f)) = f)) & z2={<0,x>})}"
  19.484 -    allRR_def
  19.485 -     "allRR == \\<forall>b<nat.
  19.486 -                <f``b, f`b> \\<in>  
  19.487 -                 {<z1,z2>:Fin(XX)*XX. (domain(z2)=succ(\\<Union>f \\<in> z1. domain(f))  
  19.488 -                                    & (\\<Union>f \\<in> z1. domain(f)) = b  
  19.489 -                                    & (\\<forall>f \\<in> z1. restrict(z2,domain(f)) = f))}"
  19.490 +lemma (in imp_DC0) lemma2: 
  19.491 +     "[| allRR; f \<in> nat->XX; range(R) \<subseteq> domain(R); x \<in> domain(R); n \<in> nat |]
  19.492 +      ==> f`n \<in> succ(n) -> domain(R) & (\<forall>i \<in> n. <f`n`i, f`n`succ(i)>:R)"
  19.493 +apply (unfold allRR_def)
  19.494 +apply (drule ospec)
  19.495 +apply (erule ltI [OF _ Ord_nat])
  19.496 +apply (erule CollectE, simp)
  19.497 +apply (rule conjI)
  19.498 +prefer 2 apply (fast elim!: f_n_pairs_in_R trans subst_context)
  19.499 +apply (unfold XX_def)
  19.500 +apply (fast elim!: trans [THEN domain_eq_imp_fun_type] subst_context)
  19.501 +done
  19.502 +
  19.503 +lemma (in imp_DC0) lemma3:
  19.504 +     "[| allRR; f \<in> nat->XX; n\<in>nat; range(R) \<subseteq> domain(R);  x \<in> domain(R) |]
  19.505 +      ==> f`n`n = f`succ(n)`n"
  19.506 +apply (frule lemma2 [THEN conjunct1, THEN domain_of_fun], assumption+)
  19.507 +apply (unfold allRR_def)
  19.508 +apply (drule ospec) 
  19.509 +apply (drule ltI [OF nat_succI Ord_nat], assumption)
  19.510 +apply simp
  19.511 +apply (elim conjE ballE)
  19.512 +apply (erule restrict_eq_imp_val_eq [symmetric], force) 
  19.513 +apply (simp add: image_fun OrdmemD) 
  19.514 +done
  19.515 +
  19.516 +
  19.517 +theorem DC_nat_imp_DC0: "DC(nat) ==> DC0"
  19.518 +apply (unfold DC_def DC0_def)
  19.519 +apply (intro allI impI)
  19.520 +apply (erule asm_rl conjE ex_in_domain [THEN exE] allE)+
  19.521 +apply (erule impE [OF _ imp_DC0.lemma4], assumption+)
  19.522 +apply (erule bexE)
  19.523 +apply (drule imp_DC0.simplify_recursion, assumption+)
  19.524 +apply (rule_tac x = "\<lambda>n \<in> nat. f`n`n" in bexI)
  19.525 +apply (rule_tac [2] lam_type)
  19.526 +apply (erule_tac [2] apply_type [OF imp_DC0.lemma2 [THEN conjunct1] succI1])
  19.527 +apply (rule ballI)
  19.528 +apply (frule_tac n="succ(n)" in imp_DC0.lemma2, 
  19.529 +       (assumption|erule nat_succI)+)
  19.530 +apply (drule imp_DC0.lemma3, auto)
  19.531 +done
  19.532 +
  19.533 +(* ********************************************************************** *)
  19.534 +(* \<forall>K. Card(K) --> DC(K) ==> WO3                                       *)
  19.535 +(* ********************************************************************** *)
  19.536 +
  19.537 +lemma fun_Ord_inj:
  19.538 +      "[| f \<in> a->X;  Ord(a); 
  19.539 +          !!b c. [| b<c; c \<in> a |] ==> f`b\<noteq>f`c |]    
  19.540 +       ==> f \<in> inj(a, X)"
  19.541 +apply (unfold inj_def, simp) 
  19.542 +apply (intro ballI impI)
  19.543 +apply (rule_tac j=x in Ord_in_Ord [THEN Ord_linear_lt], assumption+)
  19.544 +apply (blast intro: Ord_in_Ord, auto) 
  19.545 +apply (atomize, blast dest: not_sym) 
  19.546 +done
  19.547 +
  19.548 +lemma value_in_image: "[| f \<in> X->Y; A \<subseteq> X; a \<in> A |] ==> f`a \<in> f``A"
  19.549 +by (fast elim!: image_fun [THEN ssubst]);
  19.550 +
  19.551 +theorem DC_WO3: "(\<forall>K. Card(K) --> DC(K)) ==> WO3"
  19.552 +apply (unfold DC_def WO3_def)
  19.553 +apply (rule allI)
  19.554 +apply (case_tac "A \<prec> Hartog (A)");
  19.555 +apply (fast dest!: lesspoll_imp_ex_lt_eqpoll 
  19.556 +            intro!: Ord_Hartog leI [THEN le_imp_subset])
  19.557 +apply (erule allE impE)+
  19.558 +apply (rule Card_Hartog)
  19.559 +apply (erule_tac x = "A" in allE)
  19.560 +apply (erule_tac x = "{<z1,z2> \<in> Pow (A) *A . z1 \<prec> Hartog (A) & z2 \<notin> z1}" 
  19.561 +                 in allE)
  19.562 +apply simp
  19.563 +apply (erule impE, fast elim: lesspoll_lemma [THEN not_emptyE])
  19.564 +apply (erule bexE)
  19.565 +apply (rule Hartog_lepoll_selfE) 
  19.566 +apply (rule lepoll_def [THEN def_imp_iff, THEN iffD2])
  19.567 +apply (rule exI, rule fun_Ord_inj, assumption, rule Ord_Hartog)
  19.568 +apply (drule value_in_image) 
  19.569 +apply (drule OrdmemD, rule Ord_Hartog, assumption+, erule ltD) 
  19.570 +apply (drule ospec)
  19.571 +apply (blast intro: ltI Ord_Hartog, force) 
  19.572 +done
  19.573 +
  19.574 +(* ********************************************************************** *)
  19.575 +(* WO1 ==> \<forall>K. Card(K) --> DC(K)                                       *)
  19.576 +(* ********************************************************************** *)
  19.577 +
  19.578 +lemma images_eq:
  19.579 +     "[| \<forall>x \<in> A. f`x=g`x; f \<in> Df->Cf; g \<in> Dg->Cg; A \<subseteq> Df; A \<subseteq> Dg |] 
  19.580 +      ==> f``A = g``A"
  19.581 +apply (simp (no_asm_simp) add: image_fun)
  19.582 +done
  19.583 +
  19.584 +lemma lam_images_eq:
  19.585 +     "[| Ord(a); b \<in> a |] ==> (\<lambda>x \<in> a. h(x))``b = (\<lambda>x \<in> b. h(x))``b"
  19.586 +apply (rule images_eq)
  19.587 +    apply (rule ballI)
  19.588 +    apply (drule OrdmemD [THEN subsetD], assumption+)
  19.589 +    apply simp
  19.590 +   apply (fast elim!: RepFunI OrdmemD intro!: lam_type)+
  19.591 +done
  19.592 +
  19.593 +lemma lam_type_RepFun: "(\<lambda>b \<in> a. h(b)) \<in> a -> {h(b). b \<in> a}"
  19.594 +by (fast intro!: lam_type RepFunI)
  19.595 +
  19.596 +lemma lemmaX:
  19.597 +     "[| \<forall>Y \<in> Pow(X). Y \<prec> K --> (\<exists>x \<in> X. <Y, x> \<in> R);   
  19.598 +         b \<in> K; Z \<in> Pow(X); Z \<prec> K |]   
  19.599 +      ==> {x \<in> X. <Z,x> \<in> R} \<noteq> 0"
  19.600 +by blast
  19.601 +
  19.602 +
  19.603 +lemma WO1_DC_lemma:
  19.604 +     "[| Card(K); well_ord(X,Q);   
  19.605 +         \<forall>Y \<in> Pow(X). Y \<prec> K --> (\<exists>x \<in> X. <Y, x> \<in> R); b \<in> K |]   
  19.606 +      ==> ff(b, X, Q, R) \<in> {x \<in> X. <(\<lambda>c \<in> b. ff(c, X, Q, R))``b, x> \<in> R}"
  19.607 +apply (rule_tac P = "b \<in> K" in impE, (erule_tac [2] asm_rl)+)
  19.608 +apply (rule_tac i=b in Card_is_Ord [THEN Ord_in_Ord, THEN trans_induct], 
  19.609 +       assumption+)
  19.610 +apply (rule impI)
  19.611 +apply (rule ff_def [THEN def_transrec, THEN ssubst])
  19.612 +apply (erule the_first_in, fast)
  19.613 +apply (simp add: image_fun [OF lam_type_RepFun subset_refl])
  19.614 +apply (erule lemmaX, assumption)
  19.615 + apply (blast intro: Card_is_Ord OrdmemD [THEN subsetD])
  19.616 +apply (blast intro: lesspoll_trans1 in_Card_imp_lesspoll RepFun_lepoll)
  19.617 +done
  19.618 +
  19.619 +theorem WO1_DC_Card: "WO1 ==> \<forall>K. Card(K) --> DC(K)"
  19.620 +apply (unfold DC_def WO1_def)
  19.621 +apply (rule allI impI)+
  19.622 +apply (erule allE exE conjE)+
  19.623 +apply (rule_tac x = "\<lambda>b \<in> K. ff (b, X, Ra, R) " in bexI)
  19.624 + apply (simp add: lam_images_eq [OF Card_is_Ord ltD])
  19.625 + apply (fast elim!: ltE WO1_DC_lemma [THEN CollectD2])
  19.626 +apply (rule_tac lam_type)
  19.627 +apply (rule WO1_DC_lemma [THEN CollectD1], assumption+)
  19.628 +done
  19.629 +
  19.630  end
    20.1 --- a/src/ZF/AC/DC_lemmas.ML	Wed Jan 16 15:04:37 2002 +0100
    20.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    20.3 @@ -1,105 +0,0 @@
    20.4 -(*  Title:      ZF/AC/DC_lemmas.ML
    20.5 -    ID:         $Id$
    20.6 -    Author:     Krzysztof Grabczewski
    20.7 -
    20.8 -More general lemmas used in the proofs concerning DC
    20.9 -
   20.10 -*)
   20.11 -
   20.12 -val [prem] = goalw thy [lepoll_def]
   20.13 -        "Ord(a) ==> {P(b). b \\<in> a} lepoll a";
   20.14 -by (res_inst_tac [("x","\\<lambda>z \\<in> RepFun(a,P). LEAST i. z=P(i)")] exI 1);
   20.15 -by (res_inst_tac [("d","%z. P(z)")] (sym RSN (2, lam_injective)) 1);
   20.16 -by (fast_tac (claset() addSIs [Least_in_Ord, prem]) 1);
   20.17 -by (REPEAT (eresolve_tac [RepFunE, LeastI, prem RS Ord_in_Ord] 1));
   20.18 -qed "RepFun_lepoll";
   20.19 -
   20.20 -Goalw [lesspoll_def] "n \\<in> nat ==> n lesspoll nat";
   20.21 -by (rtac conjI 1);
   20.22 -by (eresolve_tac [Ord_nat RSN (2, OrdmemD) RS subset_imp_lepoll] 1);
   20.23 -by (rtac notI 1);
   20.24 -by (etac eqpollE 1);
   20.25 -by (rtac succ_lepoll_natE 1 THEN (assume_tac 2));
   20.26 -by (eresolve_tac [nat_succI RS (Ord_nat RSN (2, OrdmemD) RS
   20.27 -        subset_imp_lepoll) RS lepoll_trans] 1
   20.28 -        THEN (assume_tac 1));
   20.29 -qed "n_lesspoll_nat";
   20.30 -
   20.31 -Goalw [lepoll_def]
   20.32 -        "[| f \\<in> X->Y; Ord(X) |] ==> f``X lepoll X";
   20.33 -by (res_inst_tac [("x","\\<lambda>x \\<in> f``X. LEAST y. f`y = x")] exI 1);
   20.34 -by (res_inst_tac [("d","%z. f`z")] lam_injective 1);
   20.35 -by (fast_tac (claset() addSIs [Least_in_Ord, apply_equality]) 1);
   20.36 -by (fast_tac (claset() addSEs [Ord_in_Ord] addSIs [LeastI, apply_equality]) 1);
   20.37 -qed "image_Ord_lepoll";
   20.38 -
   20.39 -val [major, minor] = goal thy
   20.40 -        "[| (!!g. g \\<in> X ==> \\<exists>u. <g,u>:R); R \\<subseteq> X*X  \
   20.41 -\       |] ==> range(R) \\<subseteq> domain(R)";
   20.42 -by (rtac subsetI 1);
   20.43 -by (etac rangeE 1);
   20.44 -by (dresolve_tac [minor RS subsetD RS SigmaD2 RS major] 1);
   20.45 -by (Fast_tac 1);
   20.46 -qed "range_subset_domain";
   20.47 -
   20.48 -val prems = goal thy "!!k. k \\<in> n ==> k\\<noteq>n";
   20.49 -by (fast_tac (claset() addSEs [mem_irrefl]) 1);
   20.50 -qed "mem_not_eq";
   20.51 -
   20.52 -Goalw [succ_def] "g \\<in> n->X ==> cons(<n,x>, g) \\<in> succ(n) -> cons(x, X)";
   20.53 -by (fast_tac (claset() addSIs [fun_extend] addSEs [mem_irrefl]) 1);
   20.54 -qed "cons_fun_type";
   20.55 -
   20.56 -Goal "[| g \\<in> n->X; x \\<in> X |] ==> cons(<n,x>, g) \\<in> succ(n) -> X";
   20.57 -by (etac (cons_absorb RS subst) 1 THEN etac cons_fun_type 1);
   20.58 -qed "cons_fun_type2";
   20.59 -
   20.60 -Goal "n \\<in> nat ==> cons(<n,x>, g)``n = g``n";
   20.61 -by (fast_tac (claset() addSEs [mem_irrefl]) 1);
   20.62 -qed "cons_image_n";
   20.63 -
   20.64 -Goal "g \\<in> n->X ==> cons(<n,x>, g)`n = x";
   20.65 -by (fast_tac (claset() addSIs [apply_equality] addSEs [cons_fun_type]) 1);
   20.66 -qed "cons_val_n";
   20.67 -
   20.68 -Goal "k \\<in> n ==> cons(<n,x>, g)``k = g``k";
   20.69 -by (fast_tac (claset() addEs [mem_asym]) 1);
   20.70 -qed "cons_image_k";
   20.71 -
   20.72 -Goal "[| k \\<in> n; g \\<in> n->X |] ==> cons(<n,x>, g)`k = g`k";
   20.73 -by (fast_tac (claset() addSIs [apply_equality, consI2] addSEs [cons_fun_type, apply_Pair]) 1);
   20.74 -qed "cons_val_k";
   20.75 -
   20.76 -Goal "domain(f)=x ==> domain(cons(<x,y>, f)) = succ(x)";
   20.77 -by (asm_full_simp_tac (simpset() addsimps [domain_cons, succ_def]) 1);
   20.78 -qed "domain_cons_eq_succ";
   20.79 -
   20.80 -Goalw [restrict_def] "g \\<in> n->X ==> restrict(cons(<n,x>, g), n)=g";
   20.81 -by (rtac fun_extension 1);
   20.82 -by (rtac lam_type 1);
   20.83 -by (eresolve_tac [cons_fun_type RS apply_type] 1);
   20.84 -by (etac succI2 1);
   20.85 -by (assume_tac 1);
   20.86 -by (asm_full_simp_tac (simpset() addsimps [cons_val_k]) 1);
   20.87 -qed "restrict_cons_eq";
   20.88 -
   20.89 -Goal "[| Ord(k); i \\<in> k |] ==> succ(i) \\<in> succ(k)";
   20.90 -by (resolve_tac [Ord_linear RS disjE] 1 THEN (assume_tac 3));
   20.91 -by (REPEAT (fast_tac (claset() addEs [Ord_in_Ord, mem_irrefl, mem_asym]) 1));
   20.92 -qed "succ_in_succ";
   20.93 -
   20.94 -Goalw [restrict_def]
   20.95 -        "[| restrict(f, domain(g)) = g; x \\<in> domain(g) |] ==> f`x = g`x";
   20.96 -by (etac subst 1);
   20.97 -by (Asm_full_simp_tac 1);
   20.98 -qed "restrict_eq_imp_val_eq";
   20.99 -
  20.100 -Goal "[| domain(f)=A; f \\<in> B->C |] ==> f \\<in> A->C";
  20.101 -by (ftac domain_of_fun 1);
  20.102 -by (Fast_tac 1);
  20.103 -qed "domain_eq_imp_fun_type";
  20.104 -
  20.105 -Goal "[| R \\<subseteq> A * B; R \\<noteq> 0 |] ==> \\<exists>x. x \\<in> domain(R)";
  20.106 -by (fast_tac (claset() addSEs [not_emptyE]) 1);
  20.107 -qed "ex_in_domain";
  20.108 -
    21.1 --- a/src/ZF/AC/DC_lemmas.thy	Wed Jan 16 15:04:37 2002 +0100
    21.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    21.3 @@ -1,3 +0,0 @@
    21.4 -(*Dummy theory to document dependencies *)
    21.5 -
    21.6 -DC_lemmas = AC_Equiv + Cardinal_aux
    22.1 --- a/src/ZF/AC/HH.ML	Wed Jan 16 15:04:37 2002 +0100
    22.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    22.3 @@ -1,212 +0,0 @@
    22.4 -(*  Title:      ZF/AC/HH.ML
    22.5 -    ID:         $Id$
    22.6 -    Author:     Krzysztof Grabczewski
    22.7 -
    22.8 -Some properties of the recursive definition of HH used in the proofs of
    22.9 -  AC17 ==> AC1
   22.10 -  AC1 ==> WO2
   22.11 -  AC15 ==> WO6
   22.12 -*)
   22.13 -
   22.14 -(* ********************************************************************** *)
   22.15 -(* Lemmas useful in each of the three proofs                              *)
   22.16 -(* ********************************************************************** *)
   22.17 -
   22.18 -Goal "HH(f,x,a) =  \
   22.19 -\       (let z = x - (\\<Union>b \\<in> a. HH(f,x,b))  \
   22.20 -\       in  if(f`z \\<in> Pow(z)-{0}, f`z, {x}))";
   22.21 -by (resolve_tac [HH_def RS def_transrec RS trans] 1);
   22.22 -by (Simp_tac 1);
   22.23 -qed "HH_def_satisfies_eq";
   22.24 -
   22.25 -Goal "HH(f,x,a) \\<in> Pow(x)-{0} | HH(f,x,a)={x}";
   22.26 -by (resolve_tac [HH_def_satisfies_eq RS ssubst] 1);
   22.27 -by (simp_tac (simpset() addsimps [Let_def, Diff_subset RS PowI]) 1);
   22.28 -by (Fast_tac 1);
   22.29 -qed "HH_values";
   22.30 -
   22.31 -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))";
   22.32 -by (Fast_tac 1);
   22.33 -qed "subset_imp_Diff_eq";
   22.34 -
   22.35 -Goal "[| c \\<in> a-b; b<a |] ==> c=b | b<c & c<a";
   22.36 -by (etac ltE 1);
   22.37 -by (dtac Ord_linear 1);
   22.38 -by (fast_tac (claset() addSIs [ltI] addIs [Ord_in_Ord]) 2);
   22.39 -by (fast_tac (claset() addEs [Ord_in_Ord]) 1);
   22.40 -qed "Ord_DiffE";
   22.41 -
   22.42 -val prems = goal thy "(!!y. y \\<in> A ==> P(y) = {x}) ==> x - (\\<Union>y \\<in> A. P(y)) = x";
   22.43 -by (asm_full_simp_tac (simpset() addsimps prems) 1);
   22.44 -by (fast_tac (claset() addSDs [prem] addSEs [mem_irrefl]) 1);
   22.45 -qed "Diff_UN_eq_self";
   22.46 -
   22.47 -Goal "x - (\\<Union>b \\<in> a. HH(f,x,b)) = x - (\\<Union>b \\<in> a1. HH(f,x,b))  \
   22.48 -\               ==> HH(f,x,a) = HH(f,x,a1)";
   22.49 -by (resolve_tac [HH_def_satisfies_eq RS
   22.50 -                (HH_def_satisfies_eq RS sym RSN (3, trans RS trans))] 1);
   22.51 -by (etac subst_context 1);
   22.52 -qed "HH_eq";
   22.53 -
   22.54 -Goal "[| HH(f,x,b)={x}; b<a |] ==> HH(f,x,a)={x}";
   22.55 -by (res_inst_tac [("P","b<a")] impE 1 THEN REPEAT (assume_tac 2));
   22.56 -by (eresolve_tac [lt_Ord2 RS trans_induct] 1);
   22.57 -by (rtac impI 1);
   22.58 -by (resolve_tac [HH_eq RS trans] 1 THEN (assume_tac 2));
   22.59 -by (resolve_tac [leI RS le_imp_subset RS subset_imp_Diff_eq RS ssubst] 1
   22.60 -        THEN (assume_tac 1));
   22.61 -by (res_inst_tac [("t","%z. z-?X")] subst_context 1);
   22.62 -by (rtac Diff_UN_eq_self 1);
   22.63 -by (dtac Ord_DiffE 1 THEN (assume_tac 1));
   22.64 -by (fast_tac (claset() addEs [ltE]) 1);
   22.65 -qed "HH_is_x_gt_too";
   22.66 -
   22.67 -Goal "[| HH(f,x,a) \\<in> Pow(x)-{0}; b<a |] ==> HH(f,x,b) \\<in> Pow(x)-{0}";
   22.68 -by (resolve_tac [HH_values RS disjE] 1 THEN (assume_tac 1));
   22.69 -by (dtac HH_is_x_gt_too 1 THEN (assume_tac 1));
   22.70 -by (dtac subst 1 THEN (assume_tac 1));
   22.71 -by (fast_tac (claset() addSEs [mem_irrefl]) 1);
   22.72 -qed "HH_subset_x_lt_too";
   22.73 -
   22.74 -Goal "HH(f,x,a) \\<in> Pow(x)-{0}   \
   22.75 -\               ==> HH(f,x,a) \\<in> Pow(x - (\\<Union>b \\<in> a. HH(f,x,b)))-{0}";
   22.76 -by (dresolve_tac [HH_def_satisfies_eq RS subst] 1);
   22.77 -by (resolve_tac [HH_def_satisfies_eq RS ssubst] 1);
   22.78 -by (asm_full_simp_tac (simpset() addsimps [Let_def, Diff_subset RS PowI]) 1);
   22.79 -by (dresolve_tac [split_if RS iffD1] 1);
   22.80 -by (Simp_tac 1);
   22.81 -by (fast_tac (subset_cs addSEs [mem_irrefl]) 1);
   22.82 -qed "HH_subset_x_imp_subset_Diff_UN";
   22.83 -
   22.84 -Goal "[| HH(f,x,v)=HH(f,x,w); HH(f,x,v): Pow(x)-{0}; v \\<in> w |] ==> P";
   22.85 -by (forw_inst_tac [("P","%y. y \\<in> Pow(x)-{0}")] subst 1 THEN (assume_tac 1));
   22.86 -by (dres_inst_tac [("a","w")] HH_subset_x_imp_subset_Diff_UN 1);
   22.87 -by (dtac subst_elem 1 THEN (assume_tac 1));
   22.88 -by (fast_tac (claset() addSIs [singleton_iff RS iffD2, equals0I]) 1);
   22.89 -qed "HH_eq_arg_lt";
   22.90 -
   22.91 -Goal "[| HH(f,x,v)=HH(f,x,w); HH(f,x,w): Pow(x)-{0};  \
   22.92 -\               Ord(v); Ord(w) |] ==> v=w";
   22.93 -by (res_inst_tac [("j","w")] Ord_linear_lt 1 THEN TRYALL assume_tac);
   22.94 -by (resolve_tac [sym RS (ltD RSN (3, HH_eq_arg_lt))] 2
   22.95 -        THEN REPEAT (assume_tac 2));
   22.96 -by (dtac subst_elem 1 THEN (assume_tac 1));
   22.97 -by (fast_tac (FOL_cs addDs [ltD] addSEs [HH_eq_arg_lt]) 1);
   22.98 -qed "HH_eq_imp_arg_eq";
   22.99 -
  22.100 -Goalw [lepoll_def, inj_def]
  22.101 -        "[| HH(f, x, i) \\<in> Pow(x)-{0}; Ord(i) |] ==> i lepoll Pow(x)-{0}";
  22.102 -by (res_inst_tac [("x","\\<lambda>j \\<in> i. HH(f, x, j)")] exI 1);
  22.103 -by (Asm_simp_tac 1);
  22.104 -by (fast_tac (FOL_cs addSEs [HH_eq_imp_arg_eq, Ord_in_Ord, HH_subset_x_lt_too]
  22.105 -                addSIs [lam_type, ballI, ltI] addIs [bexI]) 1);
  22.106 -qed "HH_subset_x_imp_lepoll";
  22.107 -
  22.108 -Goal "HH(f, x, Hartog(Pow(x)-{0})) = {x}";
  22.109 -by (resolve_tac [HH_values RS disjE] 1 THEN (assume_tac 2));
  22.110 -by (fast_tac (FOL_cs addSDs [HH_subset_x_imp_lepoll]
  22.111 -                addSIs [Ord_Hartog] addSEs [HartogE]) 1);
  22.112 -qed "HH_Hartog_is_x";
  22.113 -
  22.114 -Goal "HH(f, x, LEAST i. HH(f, x, i) = {x}) = {x}";
  22.115 -by (fast_tac (claset() addSIs [Ord_Hartog, HH_Hartog_is_x, LeastI]) 1);
  22.116 -qed "HH_Least_eq_x";
  22.117 -
  22.118 -Goal "a \\<in> (LEAST i. HH(f,x,i)={x}) ==> HH(f,x,a) \\<in> Pow(x)-{0}";
  22.119 -by (resolve_tac [HH_values RS disjE] 1 THEN (assume_tac 1));
  22.120 -by (rtac less_LeastE 1);
  22.121 -by (eresolve_tac [Ord_Least RSN (2, ltI)] 2);
  22.122 -by (assume_tac 1);
  22.123 -qed "less_Least_subset_x";
  22.124 -
  22.125 -(* ********************************************************************** *)
  22.126 -(* Lemmas used in the proofs of AC1 ==> WO2 and AC17 ==> AC1              *)
  22.127 -(* ********************************************************************** *)
  22.128 -
  22.129 -Goalw [inj_def]
  22.130 -        "(\\<lambda>a \\<in> (LEAST i. HH(f,x,i)={x}). HH(f,x,a))  \
  22.131 -\        \\<in> inj(LEAST i. HH(f,x,i)={x}, Pow(x)-{0})";
  22.132 -by (Asm_full_simp_tac 1);
  22.133 -by (fast_tac (claset()  addSIs [lam_type] addDs [less_Least_subset_x]
  22.134 -                addSEs [HH_eq_imp_arg_eq, Ord_Least RS Ord_in_Ord]) 1);
  22.135 -qed "lam_Least_HH_inj_Pow";
  22.136 -
  22.137 -Goal "\\<forall>a \\<in> (LEAST i. HH(f,x,i)={x}). \\<exists>z \\<in> x. HH(f,x,a) = {z}  \
  22.138 -\               ==> (\\<lambda>a \\<in> (LEAST i. HH(f,x,i)={x}). HH(f,x,a))  \
  22.139 -\                       \\<in> inj(LEAST i. HH(f,x,i)={x}, {{y}. y \\<in> x})";
  22.140 -by (resolve_tac [lam_Least_HH_inj_Pow RS inj_strengthen_type] 1);
  22.141 -by (Asm_full_simp_tac 1);
  22.142 -qed "lam_Least_HH_inj";
  22.143 -
  22.144 -Goalw [surj_def]
  22.145 -        "[| x - (\\<Union>a \\<in> A. F(a)) = 0;  \
  22.146 -\               \\<forall>a \\<in> A. \\<exists>z \\<in> x. F(a) = {z} |]  \
  22.147 -\               ==> (\\<lambda>a \\<in> A. F(a)) \\<in> surj(A, {{y}. y \\<in> x})";
  22.148 -by (asm_full_simp_tac (simpset() addsimps [lam_type, Diff_eq_0_iff]) 1);
  22.149 -by Safe_tac;
  22.150 -by (set_mp_tac 1);
  22.151 -by (deepen_tac (claset() addSIs [bexI] addSEs [equalityE]) 4 1);
  22.152 -qed "lam_surj_sing";
  22.153 -
  22.154 -Goal "y \\<in> Pow(x)-{0} ==> x \\<noteq> 0";
  22.155 -by Auto_tac;
  22.156 -qed "not_emptyI2";
  22.157 -
  22.158 -Goal "f`(x - (\\<Union>j \\<in> i. HH(f,x,j))): Pow(x - (\\<Union>j \\<in> i. HH(f,x,j)))-{0}  \
  22.159 -\       ==> HH(f, x, i) \\<in> Pow(x) - {0}";
  22.160 -by (resolve_tac [HH_def_satisfies_eq RS ssubst] 1);
  22.161 -by (asm_full_simp_tac (simpset() addsimps [Let_def, Diff_subset RS PowI,
  22.162 -                not_emptyI2 RS if_P]) 1);
  22.163 -by (Fast_tac 1);
  22.164 -qed "f_subset_imp_HH_subset";
  22.165 -
  22.166 -val [prem] = goal thy "(!!z. z \\<in> Pow(x)-{0} ==> f`z \\<in> Pow(z)-{0}) ==>  \
  22.167 -\       x - (\\<Union>j \\<in> (LEAST i. HH(f,x,i)={x}). HH(f,x,j)) = 0";
  22.168 -by (excluded_middle_tac "?P \\<in> {0}" 1);
  22.169 -by (Fast_tac 2);
  22.170 -by (dresolve_tac [Diff_subset RS PowI RS DiffI RS prem RS
  22.171 -                f_subset_imp_HH_subset] 1);
  22.172 -by (fast_tac (claset() addSDs [HH_Least_eq_x RS sym RSN (2, subst_elem)]
  22.173 -                addSEs [mem_irrefl]) 1);
  22.174 -qed "f_subsets_imp_UN_HH_eq_x";
  22.175 -
  22.176 -Goal "HH(f,x,i)=f`(x - (\\<Union>j \\<in> i. HH(f,x,j))) | HH(f,x,i)={x}";
  22.177 -by (resolve_tac [HH_def_satisfies_eq RS ssubst] 1);
  22.178 -by (simp_tac (simpset() addsimps [Let_def, Diff_subset RS PowI]) 1);
  22.179 -qed "HH_values2";
  22.180 -
  22.181 -Goal "HH(f,x,i): Pow(x)-{0} ==> HH(f,x,i)=f`(x - (\\<Union>j \\<in> i. HH(f,x,j)))";
  22.182 -by (resolve_tac [HH_values2 RS disjE] 1 THEN (assume_tac 1));
  22.183 -by (fast_tac (claset() addSEs [equalityE, mem_irrefl]
  22.184 -        addSDs [singleton_subsetD]) 1);
  22.185 -qed "HH_subset_imp_eq";
  22.186 -
  22.187 -Goal "[| f \\<in> (Pow(x)-{0}) -> {{z}. z \\<in> x};  \
  22.188 -\       a \\<in> (LEAST i. HH(f,x,i)={x}) |] ==> \\<exists>z \\<in> x. HH(f,x,a) = {z}";
  22.189 -by (dtac less_Least_subset_x 1);
  22.190 -by (ftac HH_subset_imp_eq 1);
  22.191 -by (dtac apply_type 1);
  22.192 -by (resolve_tac [Diff_subset RS PowI RS DiffI] 1);
  22.193 -by (fast_tac 
  22.194 -    (claset() addSDs [HH_subset_x_imp_subset_Diff_UN RS not_emptyI2]) 1);
  22.195 -by (fast_tac (claset() addss (simpset())) 1);
  22.196 -qed "f_sing_imp_HH_sing";
  22.197 -
  22.198 -Goalw [bij_def] 
  22.199 -        "[| x - (\\<Union>j \\<in> (LEAST i. HH(f,x,i)={x}). HH(f,x,j)) = 0;  \
  22.200 -\       f \\<in> (Pow(x)-{0}) -> {{z}. z \\<in> x} |]  \
  22.201 -\       ==> (\\<lambda>a \\<in> (LEAST i. HH(f,x,i)={x}). HH(f,x,a))  \
  22.202 -\                       \\<in> bij(LEAST i. HH(f,x,i)={x}, {{y}. y \\<in> x})";
  22.203 -by (fast_tac (claset() addSIs [lam_Least_HH_inj, lam_surj_sing,
  22.204 -                              f_sing_imp_HH_sing]) 1);
  22.205 -qed "f_sing_lam_bij";
  22.206 -
  22.207 -Goal "f \\<in> (\\<Pi>X \\<in> Pow(x)-{0}. F(X))  \
  22.208 -\       ==> (\\<lambda>X \\<in> Pow(x)-{0}. {f`X}) \\<in> (\\<Pi>X \\<in> Pow(x)-{0}. {{z}. z \\<in> F(X)})";
  22.209 -by (fast_tac (FOL_cs addSIs [lam_type, RepFun_eqI, singleton_eq_iff RS iffD2]
  22.210 -                     addDs [apply_type]) 1);
  22.211 -qed "lam_singI";
  22.212 -
  22.213 -val bij_Least_HH_x = 
  22.214 -    (lam_singI RSN (2, [f_sing_lam_bij, lam_sing_bij RS bij_converse_bij]
  22.215 -                    MRS comp_bij)) |> standard;
    23.1 --- a/src/ZF/AC/HH.thy	Wed Jan 16 15:04:37 2002 +0100
    23.2 +++ b/src/ZF/AC/HH.thy	Wed Jan 16 17:52:06 2002 +0100
    23.3 @@ -2,22 +2,255 @@
    23.4      ID:         $Id$
    23.5      Author:     Krzysztof Grabczewski
    23.6  
    23.7 -The theory file for the proofs of
    23.8 +Some properties of the recursive definition of HH used in the proofs of
    23.9    AC17 ==> AC1
   23.10    AC1 ==> WO2
   23.11    AC15 ==> WO6
   23.12  *)
   23.13  
   23.14 -HH = AC_Equiv + Hartog + WO_AC + Let +
   23.15 +theory HH = AC_Equiv + Hartog:
   23.16  
   23.17 -consts
   23.18 +constdefs
   23.19   
   23.20 -  HH                      :: [i, i, i] => i
   23.21 +  HH :: "[i, i, i] => i"
   23.22 +    "HH(f,x,a) == transrec(a, %b r. let z = x - (\<Union>c \<in> b. r`c)
   23.23 +                                    in  if f`z \<in> Pow(z)-{0} then f`z else {x})"
   23.24 +
   23.25 +
   23.26 +(* ********************************************************************** *)
   23.27 +(* Lemmas useful in each of the three proofs                              *)
   23.28 +(* ********************************************************************** *)
   23.29 +
   23.30 +lemma HH_def_satisfies_eq:
   23.31 +     "HH(f,x,a) = (let z = x - (\<Union>b \<in> a. HH(f,x,b))   
   23.32 +                   in  if f`z \<in> Pow(z)-{0} then f`z else {x})"
   23.33 +by (rule HH_def [THEN def_transrec, THEN trans], simp)
   23.34 +
   23.35 +lemma HH_values: "HH(f,x,a) \<in> Pow(x)-{0} | HH(f,x,a)={x}"
   23.36 +apply (rule HH_def_satisfies_eq [THEN ssubst])
   23.37 +apply (simp add: Let_def Diff_subset [THEN PowI], fast)
   23.38 +done
   23.39 +
   23.40 +lemma subset_imp_Diff_eq:
   23.41 +     "B \<subseteq> A ==> X-(\<Union>a \<in> A. P(a)) = X-(\<Union>a \<in> A-B. P(a))-(\<Union>b \<in> B. P(b))"
   23.42 +by fast
   23.43 +
   23.44 +lemma Ord_DiffE: "[| c \<in> a-b; b<a |] ==> c=b | b<c & c<a"
   23.45 +apply (erule ltE)
   23.46 +apply (drule Ord_linear [of _ c])
   23.47 +apply (fast elim: Ord_in_Ord)
   23.48 +apply (fast intro!: ltI intro: Ord_in_Ord)
   23.49 +done
   23.50 +
   23.51 +lemma Diff_UN_eq_self:
   23.52 +     "(!!y. y \<in> A ==> P(y) = {x}) ==> x - (\<Union>y \<in> A. P(y)) = x" 
   23.53 +apply (simp, fast elim!: mem_irrefl)
   23.54 +done
   23.55 +
   23.56 +lemma HH_eq: "x - (\<Union>b \<in> a. HH(f,x,b)) = x - (\<Union>b \<in> a1. HH(f,x,b))   
   23.57 +              ==> HH(f,x,a) = HH(f,x,a1)"
   23.58 +apply (subst HH_def_satisfies_eq) 
   23.59 +apply (rule HH_def_satisfies_eq [THEN trans], simp) 
   23.60 +done
   23.61 +
   23.62 +lemma HH_is_x_gt_too: "[| HH(f,x,b)={x}; b<a |] ==> HH(f,x,a)={x}"
   23.63 +apply (rule_tac P = "b<a" in impE)
   23.64 +prefer 2 apply assumption+
   23.65 +apply (erule lt_Ord2 [THEN trans_induct])
   23.66 +apply (rule impI)
   23.67 +apply (rule HH_eq [THEN trans])
   23.68 +prefer 2 apply assumption+
   23.69 +apply (rule leI [THEN le_imp_subset, THEN subset_imp_Diff_eq, THEN ssubst], 
   23.70 +       assumption)
   23.71 +apply (rule_tac t = "%z. z-?X" in subst_context)
   23.72 +apply (rule Diff_UN_eq_self)
   23.73 +apply (drule Ord_DiffE, assumption) 
   23.74 +apply (fast elim: ltE, auto) 
   23.75 +done
   23.76 +
   23.77 +lemma HH_subset_x_lt_too:
   23.78 +     "[| HH(f,x,a) \<in> Pow(x)-{0}; b<a |] ==> HH(f,x,b) \<in> Pow(x)-{0}"
   23.79 +apply (rule HH_values [THEN disjE], assumption)
   23.80 +apply (drule HH_is_x_gt_too, assumption)
   23.81 +apply (drule subst, assumption)
   23.82 +apply (fast elim!: mem_irrefl)
   23.83 +done
   23.84 +
   23.85 +lemma HH_subset_x_imp_subset_Diff_UN:
   23.86 +    "HH(f,x,a) \<in> Pow(x)-{0} ==> HH(f,x,a) \<in> Pow(x - (\<Union>b \<in> a. HH(f,x,b)))-{0}"
   23.87 +apply (drule HH_def_satisfies_eq [THEN subst])
   23.88 +apply (rule HH_def_satisfies_eq [THEN ssubst])
   23.89 +apply (simp add: Let_def Diff_subset [THEN PowI])
   23.90 +apply (drule split_if [THEN iffD1])
   23.91 +apply (fast elim!: mem_irrefl)
   23.92 +done
   23.93 +
   23.94 +lemma HH_eq_arg_lt:
   23.95 +     "[| HH(f,x,v)=HH(f,x,w); HH(f,x,v) \<in> Pow(x)-{0}; v \<in> w |] ==> P"
   23.96 +apply (frule_tac P = "%y. y \<in> Pow (x) -{0}" in subst, assumption)
   23.97 +apply (drule_tac a = "w" in HH_subset_x_imp_subset_Diff_UN)
   23.98 +apply (drule subst_elem, assumption)
   23.99 +apply (fast intro!: singleton_iff [THEN iffD2] equals0I)
  23.100 +done
  23.101 +
  23.102 +lemma HH_eq_imp_arg_eq:
  23.103 +  "[| HH(f,x,v)=HH(f,x,w); HH(f,x,w) \<in> Pow(x)-{0}; Ord(v); Ord(w) |] ==> v=w"
  23.104 +apply (rule_tac j = "w" in Ord_linear_lt)
  23.105 +apply (simp_all (no_asm_simp))
  23.106 + apply (drule subst_elem, assumption) 
  23.107 + apply (blast dest: ltD HH_eq_arg_lt)
  23.108 +apply (blast dest: HH_eq_arg_lt [OF sym] ltD) 
  23.109 +done
  23.110 +
  23.111 +lemma HH_subset_x_imp_lepoll: 
  23.112 +     "[| HH(f, x, i) \<in> Pow(x)-{0}; Ord(i) |] ==> i lepoll Pow(x)-{0}"
  23.113 +apply (unfold lepoll_def inj_def)
  23.114 +apply (rule_tac x = "\<lambda>j \<in> i. HH (f, x, j) " in exI)
  23.115 +apply (simp (no_asm_simp))
  23.116 +apply (fast del: DiffE
  23.117 +	    elim!: HH_eq_imp_arg_eq Ord_in_Ord HH_subset_x_lt_too 
  23.118 +            intro!: lam_type ballI ltI intro: bexI)
  23.119 +done
  23.120 +
  23.121 +lemma HH_Hartog_is_x: "HH(f, x, Hartog(Pow(x)-{0})) = {x}"
  23.122 +apply (rule HH_values [THEN disjE])
  23.123 +prefer 2 apply assumption 
  23.124 +apply (fast del: DiffE
  23.125 +            intro!: Ord_Hartog 
  23.126 +	    dest!: HH_subset_x_imp_lepoll 
  23.127 +            elim!: Hartog_lepoll_selfE)
  23.128 +done
  23.129 +
  23.130 +lemma HH_Least_eq_x: "HH(f, x, LEAST i. HH(f, x, i) = {x}) = {x}"
  23.131 +by (fast intro!: Ord_Hartog HH_Hartog_is_x LeastI)
  23.132 +
  23.133 +lemma less_Least_subset_x:
  23.134 +     "a \<in> (LEAST i. HH(f,x,i)={x}) ==> HH(f,x,a) \<in> Pow(x)-{0}"
  23.135 +apply (rule HH_values [THEN disjE], assumption)
  23.136 +apply (rule less_LeastE)
  23.137 +apply (erule_tac [2] ltI [OF _ Ord_Least], assumption)
  23.138 +done
  23.139  
  23.140 -defs
  23.141 +(* ********************************************************************** *)
  23.142 +(* Lemmas used in the proofs of AC1 ==> WO2 and AC17 ==> AC1              *)
  23.143 +(* ********************************************************************** *)
  23.144 +
  23.145 +lemma lam_Least_HH_inj_Pow: 
  23.146 +        "(\<lambda>a \<in> (LEAST i. HH(f,x,i)={x}). HH(f,x,a))   
  23.147 +         \<in> inj(LEAST i. HH(f,x,i)={x}, Pow(x)-{0})"
  23.148 +apply (unfold inj_def, simp)
  23.149 +apply (fast intro!: lam_type dest: less_Least_subset_x 
  23.150 +            elim!: HH_eq_imp_arg_eq Ord_Least [THEN Ord_in_Ord])
  23.151 +done
  23.152 +
  23.153 +lemma lam_Least_HH_inj:
  23.154 +     "\<forall>a \<in> (LEAST i. HH(f,x,i)={x}). \<exists>z \<in> x. HH(f,x,a) = {z}   
  23.155 +      ==> (\<lambda>a \<in> (LEAST i. HH(f,x,i)={x}). HH(f,x,a))   
  23.156 +          \<in> inj(LEAST i. HH(f,x,i)={x}, {{y}. y \<in> x})"
  23.157 +by (rule lam_Least_HH_inj_Pow [THEN inj_strengthen_type], simp)
  23.158 +
  23.159 +lemma lam_surj_sing: 
  23.160 +        "[| x - (\<Union>a \<in> A. F(a)) = 0;  \<forall>a \<in> A. \<exists>z \<in> x. F(a) = {z} |]   
  23.161 +         ==> (\<lambda>a \<in> A. F(a)) \<in> surj(A, {{y}. y \<in> x})"
  23.162 +apply (simp add: surj_def lam_type Diff_eq_0_iff)
  23.163 +apply (blast elim: equalityE) 
  23.164 +done
  23.165 +
  23.166 +lemma not_emptyI2: "y \<in> Pow(x)-{0} ==> x \<noteq> 0"
  23.167 +by auto
  23.168 +
  23.169 +lemma f_subset_imp_HH_subset:
  23.170 +     "f`(x - (\<Union>j \<in> i. HH(f,x,j))) \<in> Pow(x - (\<Union>j \<in> i. HH(f,x,j)))-{0}   
  23.171 +      ==> HH(f, x, i) \<in> Pow(x) - {0}"
  23.172 +apply (rule HH_def_satisfies_eq [THEN ssubst])
  23.173 +apply (simp add: Let_def Diff_subset [THEN PowI] not_emptyI2 [THEN if_P], fast)
  23.174 +done
  23.175 +
  23.176 +lemma f_subsets_imp_UN_HH_eq_x:
  23.177 +     "\<forall>z \<in> Pow(x)-{0}. f`z \<in> Pow(z)-{0}
  23.178 +      ==> x - (\<Union>j \<in> (LEAST i. HH(f,x,i)={x}). HH(f,x,j)) = 0"
  23.179 +apply (case_tac "?P \<in> {0}", fast)
  23.180 +apply (drule Diff_subset [THEN PowI, THEN DiffI])
  23.181 +apply (drule bspec, assumption) 
  23.182 +apply (drule f_subset_imp_HH_subset) 
  23.183 +apply (blast dest!: subst_elem [OF _ HH_Least_eq_x [symmetric]] 
  23.184 +             elim!: mem_irrefl)
  23.185 +done
  23.186 +
  23.187 +lemma HH_values2: "HH(f,x,i) = f`(x - (\<Union>j \<in> i. HH(f,x,j))) | HH(f,x,i)={x}"
  23.188 +apply (rule HH_def_satisfies_eq [THEN ssubst])
  23.189 +apply (simp add: Let_def Diff_subset [THEN PowI])
  23.190 +done
  23.191 +
  23.192 +lemma HH_subset_imp_eq:
  23.193 +     "HH(f,x,i): Pow(x)-{0} ==> HH(f,x,i)=f`(x - (\<Union>j \<in> i. HH(f,x,j)))"
  23.194 +apply (rule HH_values2 [THEN disjE], assumption)
  23.195 +apply (fast elim!: equalityE mem_irrefl dest!: singleton_subsetD)
  23.196 +done
  23.197  
  23.198 -  HH_def  "HH(f,x,a) == transrec(a, %b r. let z = x - (\\<Union>c \\<in> b. r`c)
  23.199 -                        in  if(f`z \\<in> Pow(z)-{0}, f`z, {x}))"
  23.200 +lemma f_sing_imp_HH_sing:
  23.201 +     "[| f \<in> (Pow(x)-{0}) -> {{z}. z \<in> x};   
  23.202 +         a \<in> (LEAST i. HH(f,x,i)={x}) |] ==> \<exists>z \<in> x. HH(f,x,a) = {z}"
  23.203 +apply (drule less_Least_subset_x)
  23.204 +apply (frule HH_subset_imp_eq)
  23.205 +apply (drule apply_type)
  23.206 +apply (rule Diff_subset [THEN PowI, THEN DiffI])
  23.207 +apply (fast dest!: HH_subset_x_imp_subset_Diff_UN [THEN not_emptyI2], force) 
  23.208 +done
  23.209 +
  23.210 +lemma f_sing_lam_bij: 
  23.211 +     "[| x - (\<Union>j \<in> (LEAST i. HH(f,x,i)={x}). HH(f,x,j)) = 0;   
  23.212 +         f \<in> (Pow(x)-{0}) -> {{z}. z \<in> x} |]   
  23.213 +      ==> (\<lambda>a \<in> (LEAST i. HH(f,x,i)={x}). HH(f,x,a))   
  23.214 +          \<in> bij(LEAST i. HH(f,x,i)={x}, {{y}. y \<in> x})"
  23.215 +apply (unfold bij_def)
  23.216 +apply (fast intro!: lam_Least_HH_inj lam_surj_sing f_sing_imp_HH_sing)
  23.217 +done
  23.218 +
  23.219 +lemma lam_singI:
  23.220 +     "f \<in> (\<Pi>X \<in> Pow(x)-{0}. F(X))   
  23.221 +      ==> (\<lambda>X \<in> Pow(x)-{0}. {f`X}) \<in> (\<Pi>X \<in> Pow(x)-{0}. {{z}. z \<in> F(X)})"
  23.222 +by (fast del: DiffI DiffE
  23.223 +	    intro!: lam_type singleton_eq_iff [THEN iffD2] dest: apply_type)
  23.224 +
  23.225 +(*FIXME: both uses have the form ...[THEN bij_converse_bij], so 
  23.226 +  simplification is needed!*)
  23.227 +lemmas bij_Least_HH_x =  
  23.228 +    comp_bij [OF f_sing_lam_bij [OF _ lam_singI] 
  23.229 +              lam_sing_bij [THEN bij_converse_bij], standard]
  23.230 +
  23.231 +
  23.232 +(* ********************************************************************** *)
  23.233 +(*                     The proof of AC1 ==> WO2                           *)
  23.234 +(* ********************************************************************** *)
  23.235 +
  23.236 +(*Establishing the existence of a bijection, namely
  23.237 +converse
  23.238 + (converse(\<lambda>x\<in>x. {x}) O
  23.239 +  Lambda
  23.240 +   (LEAST i. HH(\<lambda>X\<in>Pow(x) - {0}. {f ` X}, x, i) = {x},
  23.241 +    HH(\<lambda>X\<in>Pow(x) - {0}. {f ` X}, x)))
  23.242 +Perhaps it could be simplified. *)
  23.243 +
  23.244 +lemma bijection:
  23.245 +     "f \<in> (\<Pi>X \<in> Pow(x) - {0}. X) 
  23.246 +      ==> \<exists>g. g \<in> bij(x, LEAST i. HH(\<lambda>X \<in> Pow(x)-{0}. {f`X}, x, i) = {x})"
  23.247 +apply (rule exI) 
  23.248 +apply (rule bij_Least_HH_x [THEN bij_converse_bij])
  23.249 +apply (rule f_subsets_imp_UN_HH_eq_x)
  23.250 +apply (intro ballI apply_type) 
  23.251 +apply (fast intro: lam_type apply_type del: DiffE)
  23.252 +apply assumption; 
  23.253 +apply (fast intro: Pi_weaken_type)
  23.254 +done
  23.255 +
  23.256 +lemma AC1_WO2: "AC1 ==> WO2"
  23.257 +apply (unfold AC1_def WO2_def eqpoll_def)
  23.258 +apply (intro allI) 
  23.259 +apply (drule_tac x = "Pow(A) - {0}" in spec) 
  23.260 +apply (blast dest: bijection)
  23.261 +done
  23.262  
  23.263  end
  23.264  
  23.265 +
    24.1 --- a/src/ZF/AC/Hartog.ML	Wed Jan 16 15:04:37 2002 +0100
    24.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    24.3 @@ -1,82 +0,0 @@
    24.4 -(*  Title:      ZF/AC/Hartog.ML
    24.5 -    ID:         $Id$
    24.6 -    Author:     Krzysztof Grabczewski
    24.7 -
    24.8 -  Some proofs on the Hartogs function.
    24.9 -*)
   24.10 -
   24.11 -Goal "\\<forall>a. Ord(a) --> a \\<in> X ==> P";
   24.12 -by (res_inst_tac [("X1","{y \\<in> X. Ord(y)}")] (ON_class RS revcut_rl) 1);
   24.13 -by (Fast_tac 1);
   24.14 -qed "Ords_in_set";
   24.15 -
   24.16 -Goalw [lepoll_def] "[| Ord(a); a lepoll X |] ==>  \
   24.17 -\               \\<exists>Y. Y \\<subseteq> X & (\\<exists>R. well_ord(Y,R) & ordertype(Y,R)=a)";
   24.18 -by (etac exE 1);
   24.19 -by (REPEAT (resolve_tac [exI, conjI] 1));
   24.20 -by (eresolve_tac [inj_is_fun RS fun_is_rel RS image_subset] 1);
   24.21 -by (rtac exI 1);
   24.22 -by (rtac conjI 1);
   24.23 -by (eresolve_tac [well_ord_Memrel RSN (2, subset_refl RSN (2, 
   24.24 -        restrict_bij RS bij_converse_bij) RS bij_is_inj RS well_ord_rvimage)] 1
   24.25 -        THEN (assume_tac 1));
   24.26 -by (resolve_tac [subset_refl RSN (2, restrict_bij RS bij_converse_bij) RS
   24.27 -        (well_ord_Memrel RSN (2, bij_ordertype_vimage)) RS 
   24.28 -        (ordertype_Memrel RSN (2, trans))] 1
   24.29 -        THEN (REPEAT (assume_tac 1)));
   24.30 -qed "Ord_lepoll_imp_ex_well_ord";
   24.31 -
   24.32 -Goal "[| Ord(a); a lepoll X |] ==>  \
   24.33 -\               \\<exists>Y. Y \\<subseteq> X & (\\<exists>R. R \\<subseteq> X*X & ordertype(Y,R)=a)";
   24.34 -by (dtac Ord_lepoll_imp_ex_well_ord 1 THEN (assume_tac 1));
   24.35 -by Safe_tac;
   24.36 -by (REPEAT (ares_tac [exI, conjI] 1));
   24.37 -by (etac ordertype_Int 2);
   24.38 -by (Fast_tac 1);
   24.39 -qed "Ord_lepoll_imp_eq_ordertype";
   24.40 -
   24.41 -Goal "\\<forall>a. Ord(a) --> a lepoll X ==>  \
   24.42 -\       \\<forall>a. Ord(a) -->  \
   24.43 -\       a:{a. Z \\<in> Pow(X)*Pow(X*X), \\<exists>Y R. Z=<Y,R> & ordertype(Y,R)=a}";
   24.44 -by (REPEAT (resolve_tac [allI,impI] 1));
   24.45 -by (REPEAT (eresolve_tac [allE, impE] 1));
   24.46 -by (assume_tac 1);
   24.47 -by (dtac Ord_lepoll_imp_eq_ordertype 1 THEN (assume_tac 1));
   24.48 -by (fast_tac (claset() addSIs [ReplaceI] addEs [sym]) 1);
   24.49 -qed "Ords_lepoll_set_lemma";
   24.50 -
   24.51 -Goal "\\<forall>a. Ord(a) --> a lepoll X ==> P";
   24.52 -by (eresolve_tac [Ords_lepoll_set_lemma RS Ords_in_set] 1);
   24.53 -qed "Ords_lepoll_set";
   24.54 -
   24.55 -Goal "\\<exists>a. Ord(a) & ~a lepoll X";
   24.56 -by (rtac swap 1);
   24.57 -by (Fast_tac 1);
   24.58 -by (rtac Ords_lepoll_set 1);
   24.59 -by (Fast_tac 1);
   24.60 -qed "ex_Ord_not_lepoll";
   24.61 -
   24.62 -Goalw [Hartog_def] "~ Hartog(A) lepoll A";
   24.63 -by (resolve_tac [ex_Ord_not_lepoll RS exE] 1);
   24.64 -by (rtac LeastI 1);
   24.65 -by (REPEAT (Fast_tac 1));
   24.66 -qed "HartogI";
   24.67 -
   24.68 -val HartogE = HartogI RS notE;
   24.69 -
   24.70 -Goalw [Hartog_def] "Ord(Hartog(A))";
   24.71 -by (rtac Ord_Least 1);
   24.72 -qed "Ord_Hartog";
   24.73 -
   24.74 -Goalw [Hartog_def] "[| i < Hartog(A); ~ i lepoll A |] ==> P";
   24.75 -by (fast_tac (claset() addEs [less_LeastE]) 1);
   24.76 -qed "less_HartogE1";
   24.77 -
   24.78 -Goal "[| i < Hartog(A); i eqpoll Hartog(A) |] ==> P";
   24.79 -by (fast_tac (claset() addEs [less_HartogE1, eqpoll_sym RS eqpoll_imp_lepoll
   24.80 -                RS lepoll_trans RS HartogE]) 1);
   24.81 -qed "less_HartogE";
   24.82 -
   24.83 -Goal "Card(Hartog(A))";
   24.84 -by (fast_tac (claset() addSIs [CardI, Ord_Hartog] addEs [less_HartogE]) 1);
   24.85 -qed "Card_Hartog";
    25.1 --- a/src/ZF/AC/Hartog.thy	Wed Jan 16 15:04:37 2002 +0100
    25.2 +++ b/src/ZF/AC/Hartog.thy	Wed Jan 16 17:52:06 2002 +0100
    25.3 @@ -5,14 +5,79 @@
    25.4  Hartog's function.
    25.5  *)
    25.6  
    25.7 -Hartog = Cardinal +
    25.8 +theory Hartog = AC_Equiv:
    25.9 +
   25.10 +constdefs
   25.11 +  Hartog :: "i => i"
   25.12 +   "Hartog(X) == LEAST i. ~ i \<lesssim> X"
   25.13 +
   25.14 +lemma Ords_in_set: "\<forall>a. Ord(a) --> a \<in> X ==> P"
   25.15 +apply (rule_tac X1 = "{y \<in> X. Ord (y) }" in ON_class [THEN revcut_rl])
   25.16 +apply fast
   25.17 +done
   25.18  
   25.19 -consts
   25.20 +lemma Ord_lepoll_imp_ex_well_ord:
   25.21 +     "[| Ord(a); a \<lesssim> X |] 
   25.22 +      ==> \<exists>Y. Y \<subseteq> X & (\<exists>R. well_ord(Y,R) & ordertype(Y,R)=a)"
   25.23 +apply (unfold lepoll_def)
   25.24 +apply (erule exE)
   25.25 +apply (intro exI conjI)
   25.26 +  apply (erule inj_is_fun [THEN fun_is_rel, THEN image_subset])
   25.27 + apply (rule well_ord_rvimage [OF bij_is_inj well_ord_Memrel]) 
   25.28 +  apply (erule restrict_bij [THEN bij_converse_bij]) 
   25.29 +apply (rule subset_refl, assumption); 
   25.30 +apply (rule trans) 
   25.31 +apply (rule bij_ordertype_vimage) 
   25.32 +apply (erule restrict_bij [THEN bij_converse_bij]) 
   25.33 +apply (rule subset_refl) 
   25.34 +apply (erule well_ord_Memrel) 
   25.35 +apply (erule ordertype_Memrel) 
   25.36 +done
   25.37 +
   25.38 +lemma Ord_lepoll_imp_eq_ordertype:
   25.39 +     "[| Ord(a); a \<lesssim> X |] ==> \<exists>Y. Y \<subseteq> X & (\<exists>R. R \<subseteq> X*X & ordertype(Y,R)=a)"
   25.40 +apply (drule Ord_lepoll_imp_ex_well_ord, (assumption))
   25.41 +apply clarify
   25.42 +apply (intro exI conjI)
   25.43 +apply (erule_tac [3] ordertype_Int, auto) 
   25.44 +done
   25.45  
   25.46 -  Hartog :: i => i
   25.47 +lemma Ords_lepoll_set_lemma:
   25.48 +     "(\<forall>a. Ord(a) --> a \<lesssim> X) ==>   
   25.49 +       \<forall>a. Ord(a) -->   
   25.50 +        a \<in> {b. Z \<in> Pow(X)*Pow(X*X), \<exists>Y R. Z=<Y,R> & ordertype(Y,R)=b}"
   25.51 +apply (intro allI impI)
   25.52 +apply (elim allE impE, assumption)
   25.53 +apply (blast dest!: Ord_lepoll_imp_eq_ordertype intro: sym) 
   25.54 +done
   25.55 +
   25.56 +lemma Ords_lepoll_set: "\<forall>a. Ord(a) --> a \<lesssim> X ==> P"
   25.57 +by (erule Ords_lepoll_set_lemma [THEN Ords_in_set])
   25.58 +
   25.59 +lemma ex_Ord_not_lepoll: "\<exists>a. Ord(a) & ~a \<lesssim> X"
   25.60 +apply (rule ccontr)
   25.61 +apply (best intro: Ords_lepoll_set) 
   25.62 +done
   25.63  
   25.64 -defs
   25.65 +lemma not_Hartog_lepoll_self: "~ Hartog(A) \<lesssim> A"
   25.66 +apply (unfold Hartog_def)
   25.67 +apply (rule ex_Ord_not_lepoll [THEN exE])
   25.68 +apply (rule LeastI, auto) 
   25.69 +done
   25.70 +
   25.71 +lemmas Hartog_lepoll_selfE = not_Hartog_lepoll_self [THEN notE, standard]
   25.72  
   25.73 -  Hartog_def "Hartog(X) == LEAST i. ~i lepoll X"
   25.74 +lemma Ord_Hartog: "Ord(Hartog(A))"
   25.75 +by (unfold Hartog_def, rule Ord_Least)
   25.76 +
   25.77 +lemma less_HartogE1: "[| i < Hartog(A); ~ i \<lesssim> A |] ==> P"
   25.78 +by (unfold Hartog_def, fast elim: less_LeastE)
   25.79 +
   25.80 +lemma less_HartogE: "[| i < Hartog(A); i \<approx> Hartog(A) |] ==> P"
   25.81 +by (blast intro: less_HartogE1 eqpoll_sym eqpoll_imp_lepoll 
   25.82 +                 lepoll_trans [THEN Hartog_lepoll_selfE]);
   25.83 +
   25.84 +lemma Card_Hartog: "Card(Hartog(A))"
   25.85 +by (fast intro!: CardI Ord_Hartog elim: less_HartogE)
   25.86  
   25.87  end
    26.1 --- a/src/ZF/AC/ROOT.ML	Wed Jan 16 15:04:37 2002 +0100
    26.2 +++ b/src/ZF/AC/ROOT.ML	Wed Jan 16 17:52:06 2002 +0100
    26.3 @@ -6,15 +6,12 @@
    26.4  Executes the proofs of the AC-equivalences, due to Krzysztof Grabczewski
    26.5  *)
    26.6  
    26.7 -time_use_thy "AC_Equiv";
    26.8 -
    26.9  time_use_thy "WO6_WO1";
   26.10  time_use_thy "WO1_WO7";
   26.11  
   26.12 -time_use     "AC7_AC9.ML";
   26.13 +time_use_thy "AC7_AC9";
   26.14  
   26.15  time_use_thy "WO1_AC";
   26.16 -time_use_thy "AC1_WO2";
   26.17  
   26.18  time_use_thy "AC15_WO6";
   26.19  
    27.1 --- a/src/ZF/AC/WO1_AC.ML	Wed Jan 16 15:04:37 2002 +0100
    27.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    27.3 @@ -1,111 +0,0 @@
    27.4 -(*  Title:      ZF/AC/WO1_AC.ML
    27.5 -    ID:         $Id$
    27.6 -    Author:     Krzysztof Grabczewski
    27.7 -
    27.8 -The proofs of WO1 ==> AC1 and WO1 ==> AC10(n) for n >= 1
    27.9 -
   27.10 -The latter proof is referred to as clear by the Rubins.
   27.11 -However it seems to be quite complicated.
   27.12 -The formal proof presented below is a mechanisation of the proof 
   27.13 -by Lawrence C. Paulson which is the following:
   27.14 -
   27.15 -Assume WO1.  Let s be a set of infinite sets.
   27.16 - 
   27.17 -Suppose x \\<in> s.  Then x is equipollent to |x| (by WO1), an infinite cardinal; 
   27.18 -call it K.  Since K = K |+| K = |K+K| (by InfCard_cdouble_eq) there is an 
   27.19 -isomorphism h \\<in> bij(K+K, x).  (Here + means disjoint sum.)
   27.20 - 
   27.21 -So there is a partition of x into 2-element sets, namely
   27.22 - 
   27.23 -        {{h(Inl(i)), h(Inr(i))} . i \\<in> K}
   27.24 - 
   27.25 -So for all x \\<in> s the desired partition exists.  By AC1 (which follows from WO1) 
   27.26 -there exists a function f that chooses a partition for each x \\<in> s.  Therefore we 
   27.27 -have AC10(2).
   27.28 -
   27.29 -*)
   27.30 -
   27.31 -(* ********************************************************************** *)
   27.32 -(* WO1 ==> AC1                                                            *)
   27.33 -(* ********************************************************************** *)
   27.34 -
   27.35 -Goalw [AC1_def, WO1_def] "WO1 ==> AC1";
   27.36 -by (fast_tac (claset() addSEs [ex_choice_fun]) 1);
   27.37 -qed "WO1_AC1";
   27.38 -
   27.39 -(* ********************************************************************** *)
   27.40 -(* WO1 ==> AC10(n) (n >= 1)                                               *)
   27.41 -(* ********************************************************************** *)
   27.42 -
   27.43 -Goalw [WO1_def] "[| WO1; \\<forall>B \\<in> A. \\<exists>C \\<in> D(B). P(C,B) |]  \
   27.44 -\               ==> \\<exists>f. \\<forall>B \\<in> A. P(f`B,B)";
   27.45 -by (eres_inst_tac [("x","Union({{C \\<in> D(B). P(C,B)}. B \\<in> A})")] allE 1);
   27.46 -by (etac exE 1);
   27.47 -by (dtac ex_choice_fun 1);
   27.48 -by (Fast_tac 1);
   27.49 -by (etac exE 1);
   27.50 -by (res_inst_tac [("x","\\<lambda>x \\<in> A. f`{C \\<in> D(x). P(C,x)}")] exI 1);
   27.51 -by (Asm_full_simp_tac 1);
   27.52 -by (blast_tac (claset() addSDs [RepFunI RSN (2, apply_type)]) 1);
   27.53 -val lemma1 = result();
   27.54 -
   27.55 -Goalw [WO1_def] "[| ~Finite(B); WO1 |] ==> |B| + |B| eqpoll  B";
   27.56 -by (rtac eqpoll_trans 1);
   27.57 -by (fast_tac (claset() addSEs [well_ord_cardinal_eqpoll]) 2);
   27.58 -by (resolve_tac [eqpoll_sym RS eqpoll_trans] 1);
   27.59 -by (fast_tac (claset() addSEs [well_ord_cardinal_eqpoll]) 1);
   27.60 -by (fold_tac [cadd_def]);
   27.61 -by (resolve_tac [Card_cardinal RSN (2, Inf_Card_is_InfCard) RS 
   27.62 -		 InfCard_cdouble_eq RS ssubst] 1);
   27.63 -by (rtac eqpoll_refl 2);
   27.64 -by (rtac notI 1);
   27.65 -by (etac notE 1);
   27.66 -by (resolve_tac [eqpoll_sym RS eqpoll_imp_lepoll RS lepoll_Finite] 1
   27.67 -        THEN (assume_tac 2));
   27.68 -by (fast_tac (claset() addSEs [well_ord_cardinal_eqpoll]) 1);
   27.69 -val lemma2_1 = result();
   27.70 -
   27.71 -Goal "f \\<in> bij(D+D, B) ==> {{f`Inl(i), f`Inr(i)}. i \\<in> D} \\<in> Pow(Pow(B))";
   27.72 -by (fast_tac (claset() addSEs [bij_is_fun RS apply_type]) 1);
   27.73 -val lemma2_2 = result();
   27.74 -
   27.75 -Goal "[| f \\<in> inj(A,B); f`a = f`b; a \\<in> A; b \\<in> A |] ==> a=b";
   27.76 -by (rtac inj_equality 1);
   27.77 -by (TRYALL (fast_tac (claset() addSEs [inj_is_fun RS apply_Pair] addEs [subst])));
   27.78 -val lemma = result();
   27.79 -
   27.80 -Goalw AC_aux_defs
   27.81 -        "f \\<in> bij(D+D, B) ==> pairwise_disjoint({{f`Inl(i), f`Inr(i)}. i \\<in> D})";
   27.82 -by (blast_tac (claset() addDs [bij_is_inj RS lemma]) 1);
   27.83 -val lemma2_3 = result();
   27.84 -
   27.85 -val [major, minor] = goalw thy AC_aux_defs 
   27.86 -        "[| f \\<in> bij(D+D, B); 1 le n |] ==>  \
   27.87 -\       sets_of_size_between({{f`Inl(i), f`Inr(i)}. i \\<in> D}, 2, succ(n))";
   27.88 -by (rewtac succ_def);
   27.89 -by (fast_tac (claset() 
   27.90 -        addSIs [cons_lepoll_cong, minor, lepoll_refl] 
   27.91 -        addIs [singleton_eqpoll_1 RS eqpoll_imp_lepoll RS lepoll_trans,
   27.92 -                le_imp_subset RS subset_imp_lepoll]
   27.93 -        addDs [major RS bij_is_inj RS lemma]
   27.94 -        addSEs [mem_irrefl]) 1);
   27.95 -val lemma2_4 = result();
   27.96 -
   27.97 -Goalw [bij_def, surj_def]
   27.98 -        "f \\<in> bij(D+D, B) ==> Union({{f`Inl(i), f`Inr(i)}. i \\<in> D})=B";
   27.99 -by (fast_tac (claset() addSEs [inj_is_fun RS apply_type]) 1);
  27.100 -val lemma2_5 = result();
  27.101 -
  27.102 -Goal "[| WO1; ~Finite(B); 1 le n  |]  \
  27.103 -\       ==> \\<exists>C \\<in> Pow(Pow(B)). pairwise_disjoint(C) &  \
  27.104 -\               sets_of_size_between(C, 2, succ(n)) &  \
  27.105 -\               Union(C)=B";
  27.106 -by (eresolve_tac [lemma2_1 RS (eqpoll_def RS def_imp_iff RS iffD1 RS exE)] 1
  27.107 -        THEN (assume_tac 1));
  27.108 -by (fast_tac (FOL_cs addSIs [bexI]
  27.109 -                addSEs [lemma2_2, lemma2_3, lemma2_4, lemma2_5]) 1);
  27.110 -val lemma2 = result();
  27.111 -
  27.112 -Goalw AC_defs "[| WO1; 1 le n |] ==> AC10(n)";
  27.113 -by (fast_tac (claset() addSIs [lemma1] addSEs [lemma2]) 1);
  27.114 -qed "WO1_AC10";
    28.1 --- a/src/ZF/AC/WO1_AC.thy	Wed Jan 16 15:04:37 2002 +0100
    28.2 +++ b/src/ZF/AC/WO1_AC.thy	Wed Jan 16 17:52:06 2002 +0100
    28.3 @@ -1,3 +1,105 @@
    28.4 -(*Dummy theory to document dependencies *)
    28.5 +(*  Title:      ZF/AC/WO1_AC.thy
    28.6 +    ID:         $Id$
    28.7 +    Author:     Krzysztof Grabczewski
    28.8 +
    28.9 +The proofs of WO1 ==> AC1 and WO1 ==> AC10(n) for n >= 1
   28.10 +
   28.11 +The latter proof is referred to as clear by the Rubins.
   28.12 +However it seems to be quite complicated.
   28.13 +The formal proof presented below is a mechanisation of the proof 
   28.14 +by Lawrence C. Paulson which is the following:
   28.15 +
   28.16 +Assume WO1.  Let s be a set of infinite sets.
   28.17 + 
   28.18 +Suppose x \<in> s.  Then x is equipollent to |x| (by WO1), an infinite cardinal
   28.19 +call it K.  Since K = K |+| K = |K+K| (by InfCard_cdouble_eq) there is an 
   28.20 +isomorphism h \<in> bij(K+K, x).  (Here + means disjoint sum.)
   28.21 + 
   28.22 +So there is a partition of x into 2-element sets, namely
   28.23 + 
   28.24 +        {{h(Inl(i)), h(Inr(i))} . i \<in> K}
   28.25 + 
   28.26 +So for all x \<in> s the desired partition exists.  By AC1 (which follows from WO1) 
   28.27 +there exists a function f that chooses a partition for each x \<in> s.  Therefore we 
   28.28 +have AC10(2).
   28.29 +
   28.30 +*)
   28.31 +
   28.32 +theory WO1_AC = AC_Equiv:
   28.33 +
   28.34 +(* ********************************************************************** *)
   28.35 +(* WO1 ==> AC1                                                            *)
   28.36 +(* ********************************************************************** *)
   28.37 +
   28.38 +theorem WO1_AC1: "WO1 ==> AC1"
   28.39 +by (unfold AC1_def WO1_def, fast elim!: ex_choice_fun)
   28.40 +
   28.41 +(* ********************************************************************** *)
   28.42 +(* WO1 ==> AC10(n) (n >= 1)                                               *)
   28.43 +(* ********************************************************************** *)
   28.44 +
   28.45 +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)"
   28.46 +apply (unfold WO1_def)
   28.47 +apply (erule_tac x = "Union ({{C \<in> D (B) . P (C,B) }. B \<in> A}) " in allE)
   28.48 +apply (erule exE, drule ex_choice_fun, fast)
   28.49 +apply (erule exE)
   28.50 +apply (rule_tac x = "\<lambda>x \<in> A. f`{C \<in> D (x) . P (C,x) }" in exI)
   28.51 +apply (simp, blast dest!: apply_type [OF _ RepFunI])
   28.52 +done
   28.53  
   28.54 -WO1_AC = AC_Equiv + WO_AC
   28.55 +lemma lemma2_1: "[| ~Finite(B); WO1 |] ==> |B| + |B| \<approx>  B"
   28.56 +apply (unfold WO1_def)
   28.57 +apply (rule eqpoll_trans)
   28.58 +prefer 2 apply (fast elim!: well_ord_cardinal_eqpoll)
   28.59 +apply (rule eqpoll_sym [THEN eqpoll_trans])
   28.60 +apply (fast elim!: well_ord_cardinal_eqpoll)
   28.61 +apply (drule spec [of _ B]) 
   28.62 +apply (clarify dest!: eqpoll_imp_Finite_iff [OF well_ord_cardinal_eqpoll]) 
   28.63 +apply (simp add: cadd_def [symmetric] 
   28.64 +            eqpoll_refl InfCard_cdouble_eq Card_cardinal Inf_Card_is_InfCard) 
   28.65 +done
   28.66 +
   28.67 +lemma lemma2_2:
   28.68 +     "f \<in> bij(D+D, B) ==> {{f`Inl(i), f`Inr(i)}. i \<in> D} \<in> Pow(Pow(B))"
   28.69 +by (fast elim!: bij_is_fun [THEN apply_type])
   28.70 +
   28.71 +
   28.72 +lemma lemma2_3: 
   28.73 +        "f \<in> bij(D+D, B) ==> pairwise_disjoint({{f`Inl(i), f`Inr(i)}. i \<in> D})"
   28.74 +apply (unfold pairwise_disjoint_def)
   28.75 +apply (blast dest: bij_is_inj [THEN inj_apply_equality])
   28.76 +done
   28.77 +
   28.78 +lemma lemma2_4:
   28.79 +     "[| f \<in> bij(D+D, B); 1\<le>n |] 
   28.80 +      ==> sets_of_size_between({{f`Inl(i), f`Inr(i)}. i \<in> D}, 2, succ(n))"
   28.81 +apply (simp (no_asm_simp) add: sets_of_size_between_def succ_def)
   28.82 +apply (blast intro!: cons_lepoll_cong 
   28.83 +            intro: singleton_eqpoll_1 [THEN eqpoll_imp_lepoll]  
   28.84 +                   le_imp_subset [THEN subset_imp_lepoll]  lepoll_trans 
   28.85 +            dest: bij_is_inj [THEN inj_apply_equality] elim!: mem_irrefl)
   28.86 +done
   28.87 +
   28.88 +lemma lemma2_5: 
   28.89 +     "f \<in> bij(D+D, B) ==> Union({{f`Inl(i), f`Inr(i)}. i \<in> D})=B"
   28.90 +apply (unfold bij_def surj_def)
   28.91 +apply (fast elim!: inj_is_fun [THEN apply_type])
   28.92 +done
   28.93 +
   28.94 +lemma lemma2:
   28.95 +     "[| WO1; ~Finite(B); 1\<le>n  |]   
   28.96 +      ==> \<exists>C \<in> Pow(Pow(B)). pairwise_disjoint(C) &   
   28.97 +                sets_of_size_between(C, 2, succ(n)) &   
   28.98 +                Union(C)=B"
   28.99 +apply (drule lemma2_1 [THEN eqpoll_def [THEN def_imp_iff, THEN iffD1]], 
  28.100 +       assumption)
  28.101 +apply (blast intro!: lemma2_2 lemma2_3 lemma2_4 lemma2_5)
  28.102 +done
  28.103 +
  28.104 +theorem WO1_AC10: "[| WO1; 1\<le>n |] ==> AC10(n)"
  28.105 +apply (unfold AC10_def)
  28.106 +apply (fast intro!: lemma1 elim!: lemma2)
  28.107 +done
  28.108 +
  28.109 +end
  28.110 +
    29.1 --- a/src/ZF/AC/WO1_WO7.ML	Wed Jan 16 15:04:37 2002 +0100
    29.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    29.3 @@ -1,115 +0,0 @@
    29.4 -(*  Title:      ZF/AC/WO1_WO7.ML
    29.5 -    ID:         $Id$
    29.6 -    Author:     Krzysztof Grabczewski
    29.7 -
    29.8 -WO7 <-> LEMMA <-> WO1 (Rubin & Rubin p. 5)
    29.9 -LEMMA is the sentence denoted by (**)
   29.10 -
   29.11 -Also, WO1 <-> WO8
   29.12 -*)
   29.13 -
   29.14 -(* ********************************************************************** *)
   29.15 -(* It is easy to see, that WO7 is equivallent to (**)                     *)
   29.16 -(* ********************************************************************** *)
   29.17 -
   29.18 -Goalw [WO7_def, LEMMA_def] 
   29.19 -  "WO7 <-> LEMMA";
   29.20 -by (fast_tac (claset() addSEs [Finite_well_ord_converse]) 1);
   29.21 -qed "WO7_iff_LEMMA";
   29.22 -
   29.23 -(* ********************************************************************** *)
   29.24 -(* It is also easy to show that LEMMA implies WO1.                        *)
   29.25 -(* ********************************************************************** *)
   29.26 -
   29.27 -Goalw [WO1_def, LEMMA_def] "LEMMA ==> WO1";
   29.28 -by (rtac allI 1);
   29.29 -by (etac allE 1);
   29.30 -by (excluded_middle_tac "Finite(A)" 1);
   29.31 -by (Fast_tac 1);
   29.32 -by (rewrite_goals_tac [Finite_def, eqpoll_def]);
   29.33 -by (fast_tac (claset() addSIs [[bij_is_inj, nat_implies_well_ord] MRS
   29.34 -                                 well_ord_rvimage]) 1);
   29.35 -qed "LEMMA_imp_WO1";
   29.36 -
   29.37 -(* ********************************************************************** *)
   29.38 -(* The Rubins' proof of the other implication is contained within the     *)
   29.39 -(* following sentence \\<in>                                                   *)
   29.40 -(* "... each infinite ordinal is well ordered by < but not by >."         *)
   29.41 -(* This statement can be proved by the following two theorems.            *)
   29.42 -(* But moreover we need to show similar property for any well ordered     *)
   29.43 -(* infinite set. It is not very difficult thanks to Isabelle order types  *)
   29.44 -(* We show that if a set is well ordered by some relation and by its     *)
   29.45 -(* converse, then apropriate order type is well ordered by the converse   *)
   29.46 -(* of it's membership relation, which in connection with the previous     *)
   29.47 -(* gives the conclusion.                                                  *)
   29.48 -(* ********************************************************************** *)
   29.49 -
   29.50 -Goalw [wf_on_def, wf_def] 
   29.51 -    "[| Ord(a); ~Finite(a) |] ==> ~wf[a](converse(Memrel(a)))";
   29.52 -by (dresolve_tac [nat_le_infinite_Ord RS le_imp_subset] 1 
   29.53 -    THEN (assume_tac 1));
   29.54 -by (rtac notI 1);
   29.55 -by (eres_inst_tac [("x","nat")] allE 1);
   29.56 -by (Blast_tac 1);
   29.57 -qed "converse_Memrel_not_wf_on";
   29.58 -
   29.59 -Goalw [well_ord_def] 
   29.60 -    "[| Ord(a); ~Finite(a) |] ==> ~well_ord(a,converse(Memrel(a)))";
   29.61 -by (fast_tac (claset() addSDs [converse_Memrel_not_wf_on]) 1);
   29.62 -qed "converse_Memrel_not_well_ord";
   29.63 -
   29.64 -Goal "[| well_ord(A,r); well_ord(A,converse(r)) |]  \
   29.65 -\       ==> well_ord(ordertype(A,r), converse(Memrel(ordertype(A, r))))";
   29.66 -by (rtac ([ordertype_ord_iso RS ord_iso_sym RS ord_iso_rvimage_eq, 
   29.67 -                Memrel_type RS (subset_Int_iff RS iffD1)] 
   29.68 -                MRS trans RS subst) 1
   29.69 -        THEN (assume_tac 1));
   29.70 -by (rtac (rvimage_converse RS subst) 1);
   29.71 -by (etac (ordertype_ord_iso RS ord_iso_sym RS ord_iso_is_bij RS
   29.72 -                bij_is_inj RS well_ord_rvimage) 1
   29.73 -        THEN (assume_tac 1));
   29.74 -qed "well_ord_converse_Memrel";
   29.75 -
   29.76 -Goalw [WO1_def, LEMMA_def] "WO1 ==> LEMMA";
   29.77 -by (REPEAT (resolve_tac [allI,impI] 1));
   29.78 -by (REPEAT (eresolve_tac [allE,exE] 1));
   29.79 -by (REPEAT (ares_tac [exI,conjI,notI] 1));
   29.80 -by (ftac well_ord_converse_Memrel 1 THEN (assume_tac 1));
   29.81 -by (forward_tac [Ord_ordertype RS converse_Memrel_not_well_ord] 1);
   29.82 -by (contr_tac 2);
   29.83 -by (fast_tac (empty_cs addSEs [ordertype_ord_iso RS ord_iso_is_bij RS 
   29.84 -                bij_is_inj RS (exI RS (lepoll_def RS def_imp_iff RS iffD2))
   29.85 -                RS lepoll_Finite]
   29.86 -                addSIs [notI] addEs [notE]) 1);
   29.87 -qed "WO1_imp_LEMMA";
   29.88 -
   29.89 -
   29.90 -Goal "WO1 <-> WO7";
   29.91 -by (simp_tac (simpset() addsimps [WO7_iff_LEMMA]) 1);
   29.92 -by (blast_tac (claset() addIs [LEMMA_imp_WO1, WO1_imp_LEMMA]) 1);
   29.93 -qed "WO1_iff_WO7";
   29.94 -
   29.95 -
   29.96 -
   29.97 -(* ********************************************************************** *)
   29.98 -
   29.99 -(*            The proof of WO8 <-> WO1 (Rubin & Rubin p. 6)               *)
  29.100 -
  29.101 -(* ********************************************************************** *)
  29.102 -
  29.103 -Goalw WO_defs "WO1 ==> WO8";
  29.104 -by (Fast_tac 1);
  29.105 -qed "WO1_WO8";
  29.106 -
  29.107 -
  29.108 -(* The proof of "WO8 ==> WO1" - faithful image of Rubin & Rubin's proof   *)
  29.109 -Goalw WO_defs "WO8 ==> WO1";
  29.110 -by (rtac allI 1);
  29.111 -by (eres_inst_tac [("x","{{x}. x \\<in> A}")] allE 1);
  29.112 -by (etac impE 1);
  29.113 -by (fast_tac (claset() addSEs [lam_sing_bij RS bij_is_inj RS
  29.114 -                        well_ord_rvimage]) 2);
  29.115 -by (res_inst_tac [("x","\\<lambda>a \\<in> {{x}. x \\<in> A}. THE x. a={x}")] exI 1);
  29.116 -by (force_tac (claset() addSIs [lam_type],
  29.117 -               simpset() addsimps [singleton_eq_iff, the_equality]) 1);
  29.118 -qed "WO8_WO1";
    30.1 --- a/src/ZF/AC/WO1_WO7.thy	Wed Jan 16 15:04:37 2002 +0100
    30.2 +++ b/src/ZF/AC/WO1_WO7.thy	Wed Jan 16 17:52:06 2002 +0100
    30.3 @@ -5,13 +5,110 @@
    30.4  
    30.5  WO7 <-> LEMMA <-> WO1 (Rubin & Rubin p. 5)
    30.6  LEMMA is the sentence denoted by (**)
    30.7 +
    30.8 +Also, WO1 <-> WO8
    30.9  *)
   30.10  
   30.11 -WO1_WO7 = AC_Equiv +
   30.12 +theory WO1_WO7 = AC_Equiv:
   30.13  
   30.14  constdefs
   30.15    LEMMA :: o
   30.16      "LEMMA ==
   30.17 -     \\<forall>X. ~Finite(X) --> (\\<exists>R. well_ord(X,R) & ~well_ord(X,converse(R)))"
   30.18 +     \<forall>X. ~Finite(X) --> (\<exists>R. well_ord(X,R) & ~well_ord(X,converse(R)))"
   30.19 +
   30.20 +(* ********************************************************************** *)
   30.21 +(* It is easy to see that WO7 is equivalent to (**)                       *)
   30.22 +(* ********************************************************************** *)
   30.23 +
   30.24 +lemma WO7_iff_LEMMA: "WO7 <-> LEMMA"
   30.25 +apply (unfold WO7_def LEMMA_def)
   30.26 +apply (blast intro: Finite_well_ord_converse)
   30.27 +done
   30.28 +
   30.29 +(* ********************************************************************** *)
   30.30 +(* It is also easy to show that LEMMA implies WO1.                        *)
   30.31 +(* ********************************************************************** *)
   30.32 +
   30.33 +lemma LEMMA_imp_WO1: "LEMMA ==> WO1"
   30.34 +apply (unfold WO1_def LEMMA_def Finite_def eqpoll_def)
   30.35 +apply (blast intro!: well_ord_rvimage [OF bij_is_inj nat_implies_well_ord])
   30.36 +done
   30.37 +
   30.38 +(* ********************************************************************** *)
   30.39 +(* The Rubins' proof of the other implication is contained within the     *)
   30.40 +(* following sentence \<in>                                                   *)
   30.41 +(* "... each infinite ordinal is well ordered by < but not by >."         *)
   30.42 +(* This statement can be proved by the following two theorems.            *)
   30.43 +(* But moreover we need to show similar property for any well ordered     *)
   30.44 +(* infinite set. It is not very difficult thanks to Isabelle order types  *)
   30.45 +(* We show that if a set is well ordered by some relation and by its     *)
   30.46 +(* converse, then apropriate order type is well ordered by the converse   *)
   30.47 +(* of it's membership relation, which in connection with the previous     *)
   30.48 +(* gives the conclusion.                                                  *)
   30.49 +(* ********************************************************************** *)
   30.50 +
   30.51 +lemma converse_Memrel_not_wf_on: 
   30.52 +    "[| Ord(a); ~Finite(a) |] ==> ~wf[a](converse(Memrel(a)))"
   30.53 +apply (unfold wf_on_def wf_def)
   30.54 +apply (drule nat_le_infinite_Ord [THEN le_imp_subset], (assumption))
   30.55 +apply (rule notI)
   30.56 +apply (erule_tac x = "nat" in allE, blast)
   30.57 +done
   30.58 +
   30.59 +lemma converse_Memrel_not_well_ord: 
   30.60 +    "[| Ord(a); ~Finite(a) |] ==> ~well_ord(a,converse(Memrel(a)))"
   30.61 +apply (unfold well_ord_def)
   30.62 +apply (blast dest: converse_Memrel_not_wf_on)
   30.63 +done
   30.64 +
   30.65 +lemma well_ord_rvimage_ordertype:
   30.66 +     "well_ord(A,r) \<Longrightarrow>
   30.67 +       rvimage (ordertype(A,r), converse(ordermap(A,r)),r) =
   30.68 +       Memrel(ordertype(A,r))" 
   30.69 +by (blast intro: ordertype_ord_iso [THEN ord_iso_sym] ord_iso_rvimage_eq
   30.70 +             Memrel_type [THEN subset_Int_iff [THEN iffD1]] trans)
   30.71 +
   30.72 +lemma well_ord_converse_Memrel:
   30.73 +     "[| well_ord(A,r); well_ord(A,converse(r)) |]   
   30.74 +      ==> well_ord(ordertype(A,r), converse(Memrel(ordertype(A,r))))" 
   30.75 +apply (subst well_ord_rvimage_ordertype [symmetric], assumption) 
   30.76 +apply (rule rvimage_converse [THEN subst])
   30.77 +apply (blast intro: ordertype_ord_iso ord_iso_sym ord_iso_is_bij
   30.78 +                    bij_is_inj well_ord_rvimage)
   30.79 +done
   30.80 +
   30.81 +lemma WO1_imp_LEMMA: "WO1 ==> LEMMA"
   30.82 +apply (unfold WO1_def LEMMA_def, clarify) 
   30.83 +apply (blast dest: well_ord_converse_Memrel
   30.84 +                   Ord_ordertype [THEN converse_Memrel_not_well_ord]
   30.85 +	     intro: ordertype_ord_iso ord_iso_is_bij bij_is_inj lepoll_Finite
   30.86 +                    lepoll_def [THEN def_imp_iff, THEN iffD2] )
   30.87 +done
   30.88 +
   30.89 +lemma WO1_iff_WO7: "WO1 <-> WO7"
   30.90 +apply (simp add: WO7_iff_LEMMA)
   30.91 +apply (blast intro: LEMMA_imp_WO1 WO1_imp_LEMMA)
   30.92 +done
   30.93 +
   30.94 +
   30.95 +
   30.96 +(* ********************************************************************** *)
   30.97 +(*            The proof of WO8 <-> WO1 (Rubin & Rubin p. 6)               *)
   30.98 +(* ********************************************************************** *)
   30.99 +
  30.100 +lemma WO1_WO8: "WO1 ==> WO8"
  30.101 +by (unfold WO1_def WO8_def, fast)
  30.102 +
  30.103 +
  30.104 +(* The implication "WO8 ==> WO1": a faithful image of Rubin & Rubin's proof*)
  30.105 +lemma WO8_WO1: "WO8 ==> WO1"
  30.106 +apply (unfold WO1_def WO8_def)
  30.107 +apply (rule allI)
  30.108 +apply (erule_tac x = "{{x}. x \<in> A}" in allE)
  30.109 +apply (erule impE)
  30.110 + apply (rule_tac x = "\<lambda>a \<in> {{x}. x \<in> A}. THE x. a={x}" in exI)
  30.111 + apply (force intro!: lam_type simp add: singleton_eq_iff the_equality)
  30.112 +apply (blast intro: lam_sing_bij bij_is_inj well_ord_rvimage)
  30.113 +done
  30.114  
  30.115  end
    31.1 --- a/src/ZF/AC/WO2_AC16.ML	Wed Jan 16 15:04:37 2002 +0100
    31.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    31.3 @@ -1,591 +0,0 @@
    31.4 -(*  Title:      ZF/AC/WO2_AC16.ML
    31.5 -    ID:         $Id$
    31.6 -    Author:     Krzysztof Grabczewski
    31.7 -
    31.8 -  The proof of WO2 ==> AC16(k #+ m, k)
    31.9 -  
   31.10 -  The main part of the proof is the inductive reasoning concerning
   31.11 -  properties of constructed family T_gamma.
   31.12 -  The proof deals with three cases for ordinals: 0, succ and limit ordinal.
   31.13 -  The first instance is trivial, the third not difficult, but the second
   31.14 -  is very complicated requiring many lemmas.
   31.15 -  We also need to prove that at any stage gamma the set 
   31.16 -  (s - Union(...) - k_gamma)   (Rubin & Rubin page 15)
   31.17 -  contains m distinct elements (in fact is equipollent to s)
   31.18 -*)
   31.19 -
   31.20 -(* ********************************************************************** *)
   31.21 -(* case of limit ordinal                                                  *)
   31.22 -(* ********************************************************************** *)
   31.23 -
   31.24 -
   31.25 -Goal "[| \\<forall>y<x. \\<forall>z<a. z<y | (\\<exists>Y \\<in> F(y). f(z)<=Y)  \
   31.26 -\               --> (\\<exists>! Y. Y \\<in> F(y) & f(z)<=Y);  \
   31.27 -\               \\<forall>i j. i le j --> F(i) \\<subseteq> F(j); j le i; i<x; z<a;  \
   31.28 -\               V \\<in> F(i); f(z)<=V; W \\<in> F(j); f(z)<=W |]  \
   31.29 -\               ==> V = W";
   31.30 -by (REPEAT (eresolve_tac [asm_rl, allE, impE] 1));
   31.31 -by (dtac subsetD 1 THEN (assume_tac 1));
   31.32 -by (REPEAT (dtac ospec 1 THEN (assume_tac 1)));
   31.33 -by (eresolve_tac [disjI2 RSN (2, impE)] 1);
   31.34 -by (fast_tac (FOL_cs addSIs [bexI]) 1);
   31.35 -by (etac ex1_two_eq 1 THEN (REPEAT (ares_tac [conjI] 1)));
   31.36 -val lemma3_1 = result();
   31.37 -
   31.38 -
   31.39 -Goal "[| \\<forall>y<x. \\<forall>z<a. z<y | (\\<exists>Y \\<in> F(y). f(z)<=Y)  \
   31.40 -\               --> (\\<exists>! Y. Y \\<in> F(y) & f(z)<=Y);  \
   31.41 -\               \\<forall>i j. i le j --> F(i) \\<subseteq> F(j); i<x; j<x; z<a;  \
   31.42 -\               V \\<in> F(i); f(z)<=V; W \\<in> F(j); f(z)<=W |]  \
   31.43 -\               ==> V = W";
   31.44 -by (res_inst_tac [("j","j")] ([lt_Ord, lt_Ord] MRS Ord_linear_le) 1
   31.45 -    THEN (REPEAT (assume_tac 1)));
   31.46 -by (eresolve_tac [lemma3_1 RS sym] 1 THEN (REPEAT (assume_tac 1)));
   31.47 -by (etac lemma3_1 1 THEN (REPEAT (assume_tac 1)));
   31.48 -val lemma3 = result();
   31.49 -
   31.50 -
   31.51 -Goal "[| \\<forall>y<x. F(y) \\<subseteq> X &  \
   31.52 -\               (\\<forall>x<a. x < y | (\\<exists>Y \\<in> F(y). fa(x) \\<subseteq> Y) -->  \
   31.53 -\                       (\\<exists>! Y. Y \\<in> F(y) & fa(x) \\<subseteq> Y)); x < a |]  \
   31.54 -\               ==> \\<forall>y<x. \\<forall>z<a. z < y | (\\<exists>Y \\<in> F(y). fa(z) \\<subseteq> Y) -->  \
   31.55 -\                       (\\<exists>! Y. Y \\<in> F(y) & fa(z) \\<subseteq> Y)";
   31.56 -by (REPEAT (resolve_tac [oallI, impI] 1));
   31.57 -by (dtac ospec 1 THEN (assume_tac 1));
   31.58 -by (fast_tac (FOL_cs addSEs [oallE]) 1);
   31.59 -val lemma4 = result();
   31.60 -
   31.61 -
   31.62 -Goal "[| \\<forall>y<x. F(y) \\<subseteq> X &  \
   31.63 -\               (\\<forall>x<a. x < y | (\\<exists>Y \\<in> F(y). fa(x) \\<subseteq> Y) -->  \
   31.64 -\                       (\\<exists>! Y. Y \\<in> F(y) & fa(x) \\<subseteq> Y)); \
   31.65 -\               x < a; Limit(x); \\<forall>i j. i le j --> F(i) \\<subseteq> F(j) |]  \
   31.66 -\               ==> (\\<Union>x<x. F(x)) \\<subseteq> X &  \
   31.67 -\               (\\<forall>xa<a. xa < x | (\\<exists>x \\<in> \\<Union>x<x. F(x). fa(xa) \\<subseteq> x)  \
   31.68 -\               --> (\\<exists>! Y. Y \\<in> (\\<Union>x<x. F(x)) & fa(xa) \\<subseteq> Y))";
   31.69 -by (rtac conjI 1);
   31.70 -by (rtac subsetI 1);
   31.71 -by (etac OUN_E 1);
   31.72 -by (dtac ospec 1 THEN (assume_tac 1));
   31.73 -by (Fast_tac 1);
   31.74 -by (dtac lemma4 1 THEN (assume_tac 1));
   31.75 -by (rtac oallI 1);
   31.76 -by (rtac impI 1);
   31.77 -by (etac disjE 1);
   31.78 -by (forward_tac [Limit_has_succ RSN (2, ospec)] 1 THEN (REPEAT (assume_tac 1)));
   31.79 -by (dres_inst_tac [("A","a"),("x","xa")] ospec 1 THEN (assume_tac 1));
   31.80 -by (eresolve_tac [lt_Ord RS le_refl RSN (2, disjI1 RSN (2, impE))] 1
   31.81 -        THEN (assume_tac 1));
   31.82 -by (REPEAT (eresolve_tac [ex1E, conjE] 1));
   31.83 -by (rtac ex1I 1);
   31.84 -by (rtac conjI 1 THEN (assume_tac 2));
   31.85 -by (eresolve_tac [Limit_has_succ RS OUN_I] 1 THEN (TRYALL assume_tac));
   31.86 -by (REPEAT (eresolve_tac [conjE, OUN_E] 1));
   31.87 -by (etac lemma3 1 THEN (TRYALL assume_tac));
   31.88 -by (etac Limit_has_succ 1 THEN (assume_tac 1));
   31.89 -by (etac bexE 1);
   31.90 -by (rtac ex1I 1);
   31.91 -by (etac conjI 1 THEN (assume_tac 1));
   31.92 -by (REPEAT (eresolve_tac [conjE, OUN_E] 1));
   31.93 -by (etac lemma3 1 THEN (TRYALL assume_tac));
   31.94 -val lemma5 = result();
   31.95 -
   31.96 -(* ********************************************************************** *)
   31.97 -(* case of successor ordinal                                              *)
   31.98 -(* ********************************************************************** *)
   31.99 -
  31.100 -(*
  31.101 -  First quite complicated proof of the fact used in the recursive construction
  31.102 -  of the family T_gamma (WO2 ==> AC16(k #+ m, k)) - the fact that at any stage
  31.103 -  gamma the set (s - Union(...) - k_gamma) is equipollent to s
  31.104 -  (Rubin & Rubin page 15).
  31.105 -*)
  31.106 -
  31.107 -(* ********************************************************************** *)
  31.108 -(* dbl_Diff_eqpoll_Card                                                   *)
  31.109 -(* ********************************************************************** *)
  31.110 -
  31.111 -
  31.112 -Goal "[| A eqpoll a; Card(a); ~Finite(a); B lesspoll a;  \
  31.113 -\       C lesspoll a |] ==> A - B - C eqpoll a";
  31.114 -by (rtac Diff_lesspoll_eqpoll_Card 1 THEN (REPEAT (assume_tac 1)));
  31.115 -by (rtac Diff_lesspoll_eqpoll_Card 1 THEN (REPEAT (assume_tac 1)));
  31.116 -qed "dbl_Diff_eqpoll_Card";
  31.117 -
  31.118 -(* ********************************************************************** *)
  31.119 -(* Case of finite ordinals                                                *)
  31.120 -(* ********************************************************************** *)
  31.121 -
  31.122 -
  31.123 -Goalw [lesspoll_def]
  31.124 -        "[| Finite(X); ~Finite(a); Ord(a) |] ==> X lesspoll a";
  31.125 -by (rtac conjI 1);
  31.126 -by (dresolve_tac [nat_le_infinite_Ord RS le_imp_lepoll] 1
  31.127 -        THEN (assume_tac 1));
  31.128 -by (rewtac Finite_def);
  31.129 -by (fast_tac (claset() addSEs [eqpoll_sym RS eqpoll_trans]) 2);
  31.130 -by (rtac lepoll_trans 1 THEN (assume_tac 2));
  31.131 -by (fast_tac (claset() addSEs [Ord_nat RSN (2, ltI) RS leI RS le_imp_subset RS 
  31.132 -        subset_imp_lepoll RSN (2, eqpoll_imp_lepoll RS lepoll_trans)]) 1);
  31.133 -qed "Finite_lesspoll_infinite_Ord";
  31.134 -
  31.135 -Goal "[| \\<forall>x \\<in> X. x lepoll n & x \\<subseteq> T; well_ord(T, R); X lepoll b;  \
  31.136 -\       b<a; ~Finite(a); Card(a); n \\<in> nat |]  \
  31.137 -\       ==> Union(X) lesspoll a";
  31.138 -by (excluded_middle_tac "Finite(X)" 1);
  31.139 -by (resolve_tac [Card_is_Ord RSN (3, Finite_lesspoll_infinite_Ord)] 2
  31.140 -        THEN (REPEAT (assume_tac 3)));
  31.141 -by (fast_tac (claset() addSEs [lepoll_nat_imp_Finite]
  31.142 -                addSIs [Finite_Union]) 2);
  31.143 -by (dresolve_tac [lt_Ord RSN (2, lepoll_imp_ex_le_eqpoll)] 1 THEN (assume_tac 1));
  31.144 -by (REPEAT (eresolve_tac [exE, conjE] 1));
  31.145 -by (forward_tac [eqpoll_imp_lepoll RS lepoll_infinite] 1 THEN (assume_tac 1));
  31.146 -by (eresolve_tac [eqpoll_sym RS (eqpoll_def RS def_imp_iff RS iffD1) RS
  31.147 -                exE] 1);
  31.148 -by (forward_tac [bij_is_surj RS surj_image_eq] 1);
  31.149 -by (dresolve_tac [[bij_is_fun, subset_refl] MRS image_fun] 1);
  31.150 -by (dresolve_tac [sym RS trans] 1 THEN (assume_tac 1));
  31.151 -by (blast_tac (claset() addIs [lesspoll_trans1, UN_lepoll, lt_Ord, 
  31.152 -                               lt_trans1 RSN (2, lt_Card_imp_lesspoll)]) 1); 
  31.153 -qed "Union_lesspoll";
  31.154 -
  31.155 -(* ********************************************************************** *)
  31.156 -(* recfunAC16_lepoll_index                                                *)
  31.157 -(* ********************************************************************** *)
  31.158 -
  31.159 -
  31.160 -Goal "A Un {a} = cons(a, A)";
  31.161 -by (Fast_tac 1);
  31.162 -qed "Un_sing_eq_cons";
  31.163 -
  31.164 -
  31.165 -Goal "A lepoll B ==> A Un {a} lepoll succ(B)";
  31.166 -by (asm_simp_tac (simpset() addsimps [Un_sing_eq_cons, succ_def]) 1);
  31.167 -by (eresolve_tac [mem_not_refl RSN (2, cons_lepoll_cong)] 1);
  31.168 -qed "Un_lepoll_succ";
  31.169 -
  31.170 -
  31.171 -Goal "Ord(a) ==> F(a) - (\\<Union>b<succ(a). F(b)) = 0";
  31.172 -by (fast_tac (claset() addSIs [OUN_I, le_refl]) 1);
  31.173 -qed "Diff_UN_succ_empty";
  31.174 -
  31.175 -
  31.176 -Goal "Ord(a) ==> F(a) Un X - (\\<Union>b<succ(a). F(b)) \\<subseteq> X";
  31.177 -by (fast_tac (claset() addSIs [OUN_I, le_refl]) 1);
  31.178 -qed "Diff_UN_succ_subset";
  31.179 -
  31.180 -
  31.181 -Goal "Ord(x) ==>  \
  31.182 -\       recfunAC16(f, g, x, a) - (\\<Union>i<x. recfunAC16(f, g, i, a)) lepoll 1";
  31.183 -by (etac Ord_cases 1);
  31.184 -by (asm_simp_tac (simpset() addsimps [recfunAC16_0,
  31.185 -				      empty_subsetI RS subset_imp_lepoll]) 1);
  31.186 -by (asm_simp_tac (simpset() addsimps [recfunAC16_Limit, Diff_cancel, 
  31.187 -				      empty_subsetI RS subset_imp_lepoll]) 2);
  31.188 -by (asm_simp_tac (simpset() addsimps [recfunAC16_succ]) 1);
  31.189 -by (rtac conjI 1);
  31.190 -by (fast_tac (claset() addSIs [empty_subsetI RS subset_imp_lepoll]
  31.191 -                      addSEs [Diff_UN_succ_empty RS ssubst]) 1);
  31.192 -by (fast_tac (claset() addSEs [Diff_UN_succ_subset RS subset_imp_lepoll RS
  31.193 -        (singleton_eqpoll_1 RS eqpoll_imp_lepoll RSN (2, lepoll_trans))]) 1);
  31.194 -qed "recfunAC16_Diff_lepoll_1";
  31.195 -
  31.196 -
  31.197 -Goal "[| z \\<in> F(x); Ord(x) |]  \
  31.198 -\       ==> z \\<in> F(LEAST i. z \\<in> F(i)) - (\\<Union>j<(LEAST i. z \\<in> F(i)). F(j))";
  31.199 -by (fast_tac (claset() addEs [less_LeastE] addSEs [OUN_E, LeastI]) 1);
  31.200 -qed "in_Least_Diff";
  31.201 -
  31.202 -
  31.203 -Goal "[| (LEAST i. w \\<in> F(i)) = (LEAST i. z \\<in> F(i));  \
  31.204 -\       w \\<in> (\\<Union>i<a. F(i)); z \\<in> (\\<Union>i<a. F(i)) |]  \
  31.205 -\       ==> \\<exists>b<a. w \\<in> (F(b) - (\\<Union>c<b. F(c))) & z \\<in> (F(b) - (\\<Union>c<b. F(c)))";
  31.206 -by (REPEAT (etac OUN_E 1));
  31.207 -by (dresolve_tac [lt_Ord RSN (2, in_Least_Diff)] 1 THEN (assume_tac 1));
  31.208 -by (forward_tac [lt_Ord RSN (2, in_Least_Diff)] 1 THEN (assume_tac 1));
  31.209 -by (rtac oexI 1);
  31.210 -by (rtac conjI 1 THEN (assume_tac 2));
  31.211 -by (etac subst 1 THEN (assume_tac 1));
  31.212 -by (eresolve_tac [lt_Ord RSN (2, Least_le) RS lt_trans1] 1
  31.213 -        THEN (REPEAT (assume_tac 1)));
  31.214 -qed "Least_eq_imp_ex";
  31.215 -
  31.216 -
  31.217 -Goal "[| A lepoll 1; a \\<in> A; b \\<in> A |] ==> a=b";
  31.218 -by (fast_tac (claset() addSDs [lepoll_1_is_sing]) 1);
  31.219 -qed "two_in_lepoll_1";
  31.220 -
  31.221 -
  31.222 -Goal "[| \\<forall>i<a. F(i)-(\\<Union>j<i. F(j)) lepoll 1; Limit(a) |]  \
  31.223 -\       ==> (\\<Union>x<a. F(x)) lepoll a";
  31.224 -by (resolve_tac [lepoll_def RS (def_imp_iff RS iffD2)] 1);
  31.225 -by (res_inst_tac [("x","\\<lambda>z \\<in> (\\<Union>x<a. F(x)). LEAST i. z \\<in> F(i)")] exI 1);
  31.226 -by (rewtac inj_def);
  31.227 -by (rtac CollectI 1);
  31.228 -by (rtac lam_type 1);
  31.229 -by (etac OUN_E 1);
  31.230 -by (etac Least_in_Ord 1);
  31.231 -by (etac ltD 1);
  31.232 -by (etac lt_Ord2 1);
  31.233 -by (rtac ballI 1);
  31.234 -by (rtac ballI 1);
  31.235 -by (Asm_simp_tac 1);
  31.236 -by (rtac impI 1);
  31.237 -by (dtac Least_eq_imp_ex 1 THEN (REPEAT (assume_tac 1)));
  31.238 -by (fast_tac (claset() addSEs [two_in_lepoll_1]) 1);
  31.239 -qed "UN_lepoll_index";
  31.240 -
  31.241 -
  31.242 -Goal "Ord(y) ==> recfunAC16(f, fa, y, a) lepoll y";
  31.243 -by (etac trans_induct 1);
  31.244 -by (etac Ord_cases 1);
  31.245 -by (asm_simp_tac (simpset() addsimps [recfunAC16_0, lepoll_refl]) 1);
  31.246 -by (asm_simp_tac (simpset() addsimps [recfunAC16_succ]) 1);
  31.247 -by (fast_tac (claset() 
  31.248 -        addSDs [succI1 RSN (2, bspec)]
  31.249 -        addSEs [subset_succI RS subset_imp_lepoll RSN (2, lepoll_trans),
  31.250 -                Un_lepoll_succ]) 1);
  31.251 -by (asm_simp_tac (simpset() addsimps [recfunAC16_Limit]) 1);
  31.252 -by (fast_tac (claset() addSEs [lt_Ord RS recfunAC16_Diff_lepoll_1]
  31.253 -                       addSIs [UN_lepoll_index]) 1);
  31.254 -qed "recfunAC16_lepoll_index";
  31.255 -
  31.256 -
  31.257 -Goal "[| recfunAC16(f,g,y,a) \\<subseteq> {X \\<in> Pow(A). X eqpoll n};  \
  31.258 -\        A eqpoll a;  y<a;  ~Finite(a);  Card(a);  n \\<in> nat |]  \
  31.259 -\     ==> Union(recfunAC16(f,g,y,a)) lesspoll a";
  31.260 -by (eresolve_tac [eqpoll_def RS def_imp_iff RS iffD1 RS exE] 1);
  31.261 -by (rtac Union_lesspoll 1 THEN (TRYALL assume_tac));
  31.262 -by (eresolve_tac [lt_Ord RS recfunAC16_lepoll_index] 3);
  31.263 -by (eresolve_tac [[bij_is_inj, Card_is_Ord RS well_ord_Memrel] MRS
  31.264 -		  well_ord_rvimage] 2 
  31.265 -    THEN (assume_tac 2));
  31.266 -by (fast_tac (claset() addSEs [eqpoll_imp_lepoll]) 1);
  31.267 -qed "Union_recfunAC16_lesspoll";
  31.268 -
  31.269 -
  31.270 -Goal "[| recfunAC16(f, fa, y, a) \\<subseteq> {X \\<in> Pow(A) . X eqpoll succ(k #+ m)};  \
  31.271 -\       Card(a); ~ Finite(a); A eqpoll a;  \
  31.272 -\       k \\<in> nat;  y<a;  \
  31.273 -\       fa \\<in> bij(a, {Y \\<in> Pow(A). Y eqpoll succ(k)}) |]  \
  31.274 -\       ==> A - Union(recfunAC16(f, fa, y, a)) - fa`y eqpoll a";
  31.275 -by (rtac dbl_Diff_eqpoll_Card 1 THEN (TRYALL assume_tac));
  31.276 -by (rtac Union_recfunAC16_lesspoll 1 THEN (REPEAT (assume_tac 1)));
  31.277 -by (Simp_tac 1);
  31.278 -by (resolve_tac [nat_succI RSN 
  31.279 -		 (2, bexI RS (Finite_def RS def_imp_iff RS iffD2)) RS 
  31.280 -		 (Card_is_Ord RSN (3, Finite_lesspoll_infinite_Ord))] 1
  31.281 -        THEN (TRYALL assume_tac));
  31.282 -by (eresolve_tac [ltD RSN (2, bij_is_fun RS apply_type) RS CollectE] 1
  31.283 -        THEN (TRYALL assume_tac));
  31.284 -qed "dbl_Diff_eqpoll";
  31.285 -
  31.286 -(* back to the proof *)
  31.287 -
  31.288 -val disj_Un_eqpoll_nat_sum = 
  31.289 -    [disj_Un_eqpoll_sum, sum_eqpoll_cong, nat_sum_eqpoll_sum] MRS 
  31.290 -    (eqpoll_trans RS eqpoll_trans) |> standard;
  31.291 -
  31.292 -
  31.293 -Goal "[| x \\<in> Pow(A - B - fa`i); x eqpoll m;  \
  31.294 -\       fa \\<in> bij(a, {x \\<in> Pow(A) . x eqpoll k}); i<a; k \\<in> nat; m \\<in> nat |]  \
  31.295 -\       ==> fa ` i Un x \\<in> {x \\<in> Pow(A) . x eqpoll k #+ m}";
  31.296 -by (rtac CollectI 1);
  31.297 -by (fast_tac (claset() 
  31.298 -        addSEs [ltD RSN (2, bij_is_fun RS apply_type RS CollectE)]) 1);
  31.299 -by (rtac disj_Un_eqpoll_nat_sum 1
  31.300 -        THEN (TRYALL assume_tac));
  31.301 -by (fast_tac (claset() addSIs [equals0I]) 1);
  31.302 -by (eresolve_tac [ltD RSN (2, bij_is_fun RS apply_type RS CollectE)] 1
  31.303 -        THEN (REPEAT (assume_tac 1)));
  31.304 -qed "Un_in_Collect";
  31.305 -
  31.306 -(* ********************************************************************** *)
  31.307 -(* Lemmas simplifying assumptions                                         *)
  31.308 -(* ********************************************************************** *)
  31.309 -
  31.310 -
  31.311 -Goal "[| \\<forall>y<succ(j). F(y)<=X & (\\<forall>x<a. x<y | P(x,y)  \
  31.312 -\       --> Q(x,y)); succ(j)<a |]  \
  31.313 -\       ==> F(j)<=X & (\\<forall>x<a. x<j | P(x,j) --> Q(x,j))";
  31.314 -by (dtac ospec 1);
  31.315 -by (resolve_tac [lt_Ord RS (succI1 RS ltI RS lt_Ord RS le_refl)] 1
  31.316 -        THEN (REPEAT (assume_tac 1)));
  31.317 -val lemma6 = result();
  31.318 -
  31.319 -
  31.320 -Goal "[| \\<forall>x<a. x<j | P(x,j) --> Q(x,j);  succ(j)<a |]  \
  31.321 -\     ==> P(j,j) --> (\\<forall>x<a. x le j | P(x,j) --> Q(x,j))";
  31.322 -by (fast_tac (claset() addSEs [leE]) 1);
  31.323 -val lemma7 = result();
  31.324 -
  31.325 -(* ********************************************************************** *)
  31.326 -(* Lemmas needded to prove ex_next_set which means that for any successor *)
  31.327 -(* ordinal there is a set satisfying certain properties                   *)
  31.328 -(* ********************************************************************** *)
  31.329 -
  31.330 -
  31.331 -Goal "[| A eqpoll a; ~ Finite(a); Ord(a); m \\<in> nat |]  \
  31.332 -\       ==> \\<exists>X \\<in> Pow(A). X eqpoll m";
  31.333 -by (eresolve_tac [Ord_nat RSN (2, ltI) RS 
  31.334 -                (nat_le_infinite_Ord RSN (2, lt_trans2)) RS 
  31.335 -                leI RS le_imp_lepoll RS 
  31.336 -                ((eqpoll_sym RS eqpoll_imp_lepoll) RSN (2, lepoll_trans)) RS 
  31.337 -                lepoll_imp_eqpoll_subset RS exE] 1 
  31.338 -        THEN REPEAT (assume_tac 1));
  31.339 -by (fast_tac (claset() addSEs [eqpoll_sym]) 1);
  31.340 -qed "ex_subset_eqpoll";
  31.341 -
  31.342 -
  31.343 -Goal "[| A \\<subseteq> B Un C; A Int C = 0 |] ==> A \\<subseteq> B";
  31.344 -by (Blast_tac 1);
  31.345 -qed "subset_Un_disjoint";
  31.346 -
  31.347 -
  31.348 -Goal "[| X \\<in> Pow(A - Union(B) -C); T \\<in> B; F \\<subseteq> T |] ==> F Int X = 0";
  31.349 -by (Blast_tac 1);
  31.350 -qed "Int_empty";
  31.351 -
  31.352 -(* ********************************************************************** *)
  31.353 -(* equipollent subset (and finite) is the whole set                       *)
  31.354 -(* ********************************************************************** *)
  31.355 -
  31.356 -
  31.357 -Goal "[| A \\<subseteq> B; a \\<in> A; A - {a} = B - {a} |] ==> A = B";
  31.358 -by (fast_tac (claset() addSEs [equalityE]) 1);
  31.359 -qed "Diffs_eq_imp_eq";
  31.360 -
  31.361 -
  31.362 -Goal "m \\<in> nat ==> \\<forall>A B. A \\<subseteq> B & m lepoll A & B lepoll m --> A=B";
  31.363 -by (induct_tac "m" 1);
  31.364 -by (fast_tac (claset() addSDs [lepoll_0_is_0]) 1);
  31.365 -by (REPEAT (resolve_tac [allI, impI] 1));
  31.366 -by (REPEAT (etac conjE 1));
  31.367 -by (resolve_tac [succ_lepoll_imp_not_empty RS not_emptyE] 1
  31.368 -        THEN (assume_tac 1));
  31.369 -by (forward_tac [subsetD RS Diff_sing_lepoll] 1
  31.370 -        THEN REPEAT (assume_tac 1));
  31.371 -by (ftac lepoll_Diff_sing 1);
  31.372 -by (REPEAT (eresolve_tac [allE, impE] 1));
  31.373 -by (rtac conjI 1);
  31.374 -by (Fast_tac 2);
  31.375 -by (Fast_tac 1);
  31.376 -by (etac Diffs_eq_imp_eq 1
  31.377 -        THEN REPEAT (assume_tac 1));
  31.378 -qed "subset_imp_eq_lemma";
  31.379 -
  31.380 -
  31.381 -Goal "[| A \\<subseteq> B; m lepoll A; B lepoll m; m \\<in> nat |] ==> A=B";
  31.382 -by (fast_tac (FOL_cs addSDs [subset_imp_eq_lemma]) 1);
  31.383 -qed "subset_imp_eq";
  31.384 -
  31.385 -
  31.386 -Goal "[| f \\<in> bij(a, {Y \\<in> X. Y eqpoll succ(k)}); k \\<in> nat; f`b \\<subseteq> f`y; b<a;  \
  31.387 -\       y<a |] ==> b=y";
  31.388 -by (dtac subset_imp_eq 1);
  31.389 -by (etac nat_succI 3);
  31.390 -by (fast_tac (claset() addSEs [bij_is_fun RS (ltD RSN (2, apply_type)) RS
  31.391 -                CollectE, eqpoll_sym RS eqpoll_imp_lepoll]) 1);
  31.392 -by (fast_tac (claset() addSEs [bij_is_fun RS (ltD RSN (2, apply_type)) RS
  31.393 -        CollectE, eqpoll_imp_lepoll]) 1);
  31.394 -by (rewrite_goals_tac [bij_def, inj_def]);
  31.395 -by (fast_tac (claset() addSDs [ltD]) 1);
  31.396 -qed "bij_imp_arg_eq";
  31.397 -
  31.398 -
  31.399 -Goal "[| recfunAC16(f, fa, y, a) \\<subseteq> {X \\<in> Pow(A) . X eqpoll succ(k #+ m)};  \
  31.400 -\       Card(a); ~ Finite(a); A eqpoll a;  \
  31.401 -\       k \\<in> nat; m \\<in> nat; y<a;  \
  31.402 -\       fa \\<in> bij(a, {Y \\<in> Pow(A). Y eqpoll succ(k)});  \
  31.403 -\       ~ (\\<exists>Y \\<in> recfunAC16(f, fa, y, a). fa`y \\<subseteq> Y) |]  \
  31.404 -\       ==> \\<exists>X \\<in> {Y \\<in> Pow(A). Y eqpoll succ(k #+ m)}. fa`y \\<subseteq> X &  \
  31.405 -\               (\\<forall>b<a. fa`b \\<subseteq> X -->  \
  31.406 -\               (\\<forall>T \\<in> recfunAC16(f, fa, y, a). ~ fa`b \\<subseteq> T))";
  31.407 -by (eresolve_tac [dbl_Diff_eqpoll RS ex_subset_eqpoll RS bexE] 1
  31.408 -        THEN REPEAT (assume_tac 1));
  31.409 -by (etac Card_is_Ord 1);
  31.410 -by (ftac Un_in_Collect 2 THEN REPEAT (assume_tac 2));
  31.411 -by (etac CollectE 4);
  31.412 -by (rtac bexI 4);
  31.413 -by (rtac CollectI 5);
  31.414 -by (assume_tac 5);
  31.415 -by (eresolve_tac [add_succ RS subst] 5);
  31.416 -by (assume_tac 1);
  31.417 -by (etac nat_succI 1);
  31.418 -by (assume_tac 1);
  31.419 -by (rtac conjI 1);
  31.420 -by (Fast_tac 1);
  31.421 -by (REPEAT (resolve_tac [ballI, impI, oallI, notI] 1));
  31.422 -by (dresolve_tac [Int_empty RSN (2, subset_Un_disjoint)] 1
  31.423 -        THEN REPEAT (assume_tac 1));
  31.424 -by (dtac bij_imp_arg_eq 1 THEN REPEAT (assume_tac 1));
  31.425 -by (hyp_subst_tac 1);
  31.426 -by (eresolve_tac [bexI RSN (2, notE)] 1 THEN TRYALL assume_tac);
  31.427 -qed "ex_next_set";
  31.428 -
  31.429 -(* ********************************************************************** *)
  31.430 -(* Lemma ex_next_Ord states that for any successor                        *)
  31.431 -(* ordinal there is a number of the set satisfying certain properties     *)
  31.432 -(* ********************************************************************** *)
  31.433 -
  31.434 -
  31.435 -Goal "[| recfunAC16(f, fa, y, a) \\<subseteq> {X \\<in> Pow(A) . X eqpoll succ(k #+ m)};  \
  31.436 -\       Card(a); ~ Finite(a); A eqpoll a;  \
  31.437 -\       k \\<in> nat; m \\<in> nat; y<a;  \
  31.438 -\       fa \\<in> bij(a, {Y \\<in> Pow(A). Y eqpoll succ(k)});  \
  31.439 -\       f \\<in> bij(a, {Y \\<in> Pow(A). Y eqpoll succ(k #+ m)});  \
  31.440 -\       ~ (\\<exists>Y \\<in> recfunAC16(f, fa, y, a). fa`y \\<subseteq> Y) |]  \
  31.441 -\       ==> \\<exists>c<a. fa`y \\<subseteq> f`c &  \
  31.442 -\               (\\<forall>b<a. fa`b \\<subseteq> f`c -->  \
  31.443 -\               (\\<forall>T \\<in> recfunAC16(f, fa, y, a). ~ fa`b \\<subseteq> T))";
  31.444 -by (dtac ex_next_set 1 THEN REPEAT (assume_tac 1));
  31.445 -by (etac bexE 1);
  31.446 -by (resolve_tac [bij_converse_bij RS bij_is_fun RS apply_type RS ltI RSN
  31.447 -        (2, oexI)] 1);
  31.448 -by (resolve_tac [right_inverse_bij RS ssubst] 1
  31.449 -        THEN REPEAT (ares_tac [Card_is_Ord] 1));
  31.450 -qed "ex_next_Ord";
  31.451 -
  31.452 -
  31.453 -Goal "[| \\<exists>! Y. Y \\<in> Z & P(Y); ~P(W) |] ==> \\<exists>! Y. Y \\<in> (Z Un {W}) & P(Y)";
  31.454 -by (Fast_tac 1);
  31.455 -qed "ex1_in_Un_sing";
  31.456 -
  31.457 -(* ********************************************************************** *)
  31.458 -(* Lemma simplifying assumptions                                          *)
  31.459 -(* ********************************************************************** *)
  31.460 -
  31.461 -
  31.462 -Goal "[| \\<forall>x<a. x<j | (\\<exists>xa \\<in> F(j). P(x, xa))  \
  31.463 -\       --> (\\<exists>! Y. Y \\<in> F(j) & P(x, Y)); F(j) \\<subseteq> X;  \
  31.464 -\       L \\<in> X; P(j, L) & (\\<forall>x<a. P(x, L) --> (\\<forall>xa \\<in> F(j). ~P(x, xa))) |]  \
  31.465 -\       ==> F(j) Un {L} \\<subseteq> X &  \
  31.466 -\       (\\<forall>x<a. x le j | (\\<exists>xa \\<in> (F(j) Un {L}). P(x, xa)) -->  \
  31.467 -\               (\\<exists>! Y. Y \\<in> (F(j) Un {L}) & P(x, Y)))";
  31.468 -by (rtac conjI 1);
  31.469 -by (fast_tac (claset() addSIs [singleton_subsetI]) 1);
  31.470 -by (rtac oallI 1);
  31.471 -by (etac oallE 1 THEN (contr_tac 2));
  31.472 -by (blast_tac (claset() addSEs [leE]) 1);
  31.473 -val lemma8 = result();
  31.474 -
  31.475 -(* ********************************************************************** *)
  31.476 -(* The main part of the proof: inductive proof of the property of T_gamma *)
  31.477 -(* lemma main_induct                                                      *)
  31.478 -(* ********************************************************************** *)
  31.479 -
  31.480 -
  31.481 -Goal "[| b < a; f \\<in> bij(a, {Y \\<in> Pow(A) . Y eqpoll succ(k #+ m)});  \
  31.482 -\       fa \\<in> bij(a, {Y \\<in> Pow(A) . Y eqpoll succ(k)});  \
  31.483 -\       ~Finite(a); Card(a); A eqpoll a; k \\<in> nat; m \\<in> nat |]  \
  31.484 -\       ==> recfunAC16(f, fa, b, a) \\<subseteq> {X \\<in> Pow(A) . X eqpoll succ(k #+ m)} &  \
  31.485 -\       (\\<forall>x<a. x < b | (\\<exists>Y \\<in> recfunAC16(f, fa, b, a). fa ` x \\<subseteq> Y) -->  \
  31.486 -\       (\\<exists>! Y. Y \\<in> recfunAC16(f, fa, b, a) & fa ` x \\<subseteq> Y))";
  31.487 -by (etac lt_induct 1);
  31.488 -by (ftac lt_Ord 1);
  31.489 -by (etac Ord_cases 1);
  31.490 -(* case 0 *)
  31.491 -by (asm_simp_tac (simpset() addsimps [recfunAC16_0]) 1);
  31.492 -(* case Limit *)
  31.493 -by (asm_simp_tac (simpset() addsimps [recfunAC16_Limit]) 2);
  31.494 -by (rtac lemma5 2 THEN (REPEAT (assume_tac 2)));
  31.495 -by (fast_tac (FOL_cs addSEs [recfunAC16_mono]) 2);
  31.496 -(* case succ *)
  31.497 -by (hyp_subst_tac 1);
  31.498 -by (eresolve_tac [lemma6 RS conjE] 1 THEN (assume_tac 1));
  31.499 -by (asm_simp_tac (simpset() delsplits [split_if]
  31.500 -			    addsimps [recfunAC16_succ]) 1);
  31.501 -by (resolve_tac [conjI RS (split_if RS iffD2)] 1);
  31.502 -by (Asm_simp_tac 1);
  31.503 -by (etac lemma7 1 THEN  assume_tac 1);
  31.504 -by (rtac impI 1);
  31.505 -by (resolve_tac [ex_next_Ord RS oexE] 1 
  31.506 -    THEN REPEAT (ares_tac [le_refl RS lt_trans] 1));
  31.507 -by (etac lemma8 1 THEN (assume_tac 1));
  31.508 -by (resolve_tac [bij_is_fun RS apply_type] 1 THEN (assume_tac 1));
  31.509 -by (eresolve_tac [Least_le RS lt_trans2 RS ltD] 1 
  31.510 -        THEN REPEAT (ares_tac [lt_Ord, succ_leI] 1));
  31.511 -by (rtac (lt_Ord RSN (2, LeastI)) 1 THEN REPEAT (assume_tac 1));
  31.512 -qed "main_induct";
  31.513 -
  31.514 -(* ********************************************************************** *)
  31.515 -(* Lemma to simplify the inductive proof                                  *)
  31.516 -(*   - the desired property is a consequence of the inductive assumption  *)
  31.517 -(* ********************************************************************** *)
  31.518 -
  31.519 -val [prem1, prem2, prem3, prem4] = goal thy
  31.520 -        "[| (!!b. b<a ==> F(b) \\<subseteq> S & (\\<forall>x<a. (x<b | (\\<exists>Y \\<in> F(b). f`x \\<subseteq> Y)) \
  31.521 -\       --> (\\<exists>! Y. Y \\<in> F(b) & f`x \\<subseteq> Y)));  \
  31.522 -\       f \\<in> a->f``(a); Limit(a); (!!i j. i le j ==> F(i) \\<subseteq> F(j)) |]  \
  31.523 -\       ==> (\\<Union>j<a. F(j)) \\<subseteq> S &  \
  31.524 -\       (\\<forall>x \\<in> f``a. \\<exists>! Y. Y \\<in> (\\<Union>j<a. F(j)) & x \\<subseteq> Y)";
  31.525 -by (rtac conjI 1);
  31.526 -by (rtac subsetI 1);
  31.527 -by (etac OUN_E 1);
  31.528 -by (dtac prem1 1);
  31.529 -by (Fast_tac 1);
  31.530 -(** LEVEL 5 **)
  31.531 -by (rtac ballI 1);
  31.532 -by (etac imageE 1);
  31.533 -by (dresolve_tac [prem3 RS Limit_is_Ord RSN (2, ltI) RS
  31.534 -        (prem3 RS Limit_has_succ)] 1);
  31.535 -by (ftac prem1 1);
  31.536 -by (etac conjE 1);
  31.537 -(** LEVEL 10 **)
  31.538 -by (dresolve_tac [leI RS succ_leE RSN (2, ospec)] 1 THEN (assume_tac 1));
  31.539 -by (etac impE 1);
  31.540 -by (fast_tac (claset() addSEs [leI RS succ_leE RS lt_Ord RS le_refl]) 1);
  31.541 -by (dresolve_tac [prem2 RSN (2, apply_equality)] 1);
  31.542 -by (REPEAT (eresolve_tac [conjE, ex1E] 1));
  31.543 -(** LEVEL 15 **)
  31.544 -by (rtac ex1I 1);
  31.545 -by (fast_tac (claset() addSIs [OUN_I]) 1);
  31.546 -by (REPEAT (eresolve_tac [conjE, OUN_E] 1));
  31.547 -by (eresolve_tac [lt_Ord RSN (2, lt_Ord RS Ord_linear_le)] 1 
  31.548 -    THEN assume_tac 1);
  31.549 -by (dresolve_tac [prem4 RS subsetD] 2 THEN (assume_tac 2));
  31.550 -(** LEVEL 20 **)
  31.551 -by (fast_tac FOL_cs 2);
  31.552 -by (ftac prem1 1);
  31.553 -by (ftac succ_leE 1);
  31.554 -by (dresolve_tac [prem4 RS subsetD] 1 THEN (assume_tac 1));
  31.555 -by (etac conjE 1);
  31.556 -(** LEVEL 25 **)
  31.557 -by (dresolve_tac [lt_trans RSN (2, ospec)] 1 THEN (TRYALL assume_tac));
  31.558 -by (dresolve_tac [disjI1 RSN (2, mp)] 1 THEN (assume_tac 1));
  31.559 -by (etac ex1_two_eq 1);
  31.560 -by (REPEAT (Fast_tac 1));
  31.561 -qed "lemma_simp_induct";
  31.562 -
  31.563 -(* ********************************************************************** *)
  31.564 -(* The target theorem                                                     *)
  31.565 -(* ********************************************************************** *)
  31.566 -
  31.567 -
  31.568 -Goalw [AC16_def] "[| WO2; 0<m; k \\<in> nat; m \\<in> nat |] ==> AC16(k #+ m,k)";
  31.569 -by (rtac allI 1);
  31.570 -by (rtac impI 1);
  31.571 -by (ftac WO2_infinite_subsets_eqpoll_X 1 
  31.572 -    THEN (REPEAT (assume_tac 1)));
  31.573 -by (forw_inst_tac [("n","k #+ m")] (WO2_infinite_subsets_eqpoll_X) 1
  31.574 -        THEN (REPEAT (ares_tac [add_type] 1)));
  31.575 -by (ftac WO2_imp_ex_Card 1);
  31.576 -by (REPEAT (eresolve_tac [exE,conjE] 1));
  31.577 -by (dresolve_tac [eqpoll_trans RS eqpoll_sym RS (eqpoll_def RS
  31.578 -        def_imp_iff RS iffD1)] 1 THEN (assume_tac 1));
  31.579 -by (dresolve_tac [eqpoll_trans RS eqpoll_sym RS (eqpoll_def RS
  31.580 -        def_imp_iff RS iffD1)] 1 THEN (assume_tac 1));
  31.581 -by (REPEAT (etac exE 1));
  31.582 -by (res_inst_tac [("x","\\<Union>j<a. recfunAC16(fa,f,j,a)")] exI 1);
  31.583 -by (res_inst_tac [("P","%z. ?Y & (\\<forall>x \\<in> z. ?Z(x))")] 
  31.584 -        (bij_is_surj RS surj_image_eq RS subst) 1
  31.585 -        THEN (assume_tac 1));
  31.586 -by (rtac lemma_simp_induct 1);
  31.587 -by (eresolve_tac [bij_is_fun RS surj_image RS surj_is_fun] 2);
  31.588 -by (eresolve_tac [eqpoll_imp_lepoll RS lepoll_infinite RS
  31.589 -        infinite_Card_is_InfCard RS InfCard_is_Limit] 2 
  31.590 -        THEN REPEAT (assume_tac 2));
  31.591 -by (etac recfunAC16_mono 2);
  31.592 -by (rtac main_induct 1 
  31.593 -        THEN REPEAT (ares_tac [eqpoll_imp_lepoll RS lepoll_infinite] 1));
  31.594 -qed "WO2_AC16";
    32.1 --- a/src/ZF/AC/WO2_AC16.thy	Wed Jan 16 15:04:37 2002 +0100
    32.2 +++ b/src/ZF/AC/WO2_AC16.thy	Wed Jan 16 17:52:06 2002 +0100
    32.3 @@ -1,3 +1,588 @@
    32.4 -(*Dummy theory to document dependencies *)
    32.5 +(*  Title:      ZF/AC/WO2_AC16.thy
    32.6 +    ID:         $Id$
    32.7 +    Author:     Krzysztof Grabczewski
    32.8 +
    32.9 +  The proof of WO2 ==> AC16(k #+ m, k)
   32.10 +  
   32.11 +  The main part of the proof is the inductive reasoning concerning
   32.12 +  properties of constructed family T_gamma.
   32.13 +  The proof deals with three cases for ordinals: 0, succ and limit ordinal.
   32.14 +  The first instance is trivial, the third not difficult, but the second
   32.15 +  is very complicated requiring many lemmas.
   32.16 +  We also need to prove that at any stage gamma the set 
   32.17 +  (s - Union(...) - k_gamma)   (Rubin & Rubin page 15)
   32.18 +  contains m distinct elements (in fact is equipollent to s)
   32.19 +*)
   32.20 +
   32.21 +theory WO2_AC16 = AC_Equiv + AC16_lemmas + Cardinal_aux:
   32.22 +
   32.23 +(**** A recursive definition used in the proof of WO2 ==> AC16 ****)
   32.24 +
   32.25 +constdefs
   32.26 +  recfunAC16 :: "[i,i,i,i] => i"
   32.27 +    "recfunAC16(f,h,i,a) == 
   32.28 +         transrec2(i, 0, 
   32.29 +              %g r. if (\<exists>y \<in> r. h`g \<subseteq> y) then r
   32.30 +                    else r Un {f`(LEAST i. h`g \<subseteq> f`i & 
   32.31 +                         (\<forall>b<a. (h`b \<subseteq> f`i --> (\<forall>t \<in> r. ~ h`b \<subseteq> t))))})"
   32.32 +
   32.33 +(* ********************************************************************** *)
   32.34 +(* Basic properties of recfunAC16                                         *)
   32.35 +(* ********************************************************************** *)
   32.36 +
   32.37 +lemma recfunAC16_0: "recfunAC16(f,h,0,a) = 0"
   32.38 +apply (simp add: recfunAC16_def);
   32.39 +done
   32.40 +
   32.41 +lemma recfunAC16_succ: 
   32.42 +     "recfunAC16(f,h,succ(i),a) =   
   32.43 +      (if (\<exists>y \<in> recfunAC16(f,h,i,a). h ` i \<subseteq> y) then recfunAC16(f,h,i,a)  
   32.44 +       else recfunAC16(f,h,i,a) Un  
   32.45 +            {f ` (LEAST j. h ` i \<subseteq> f ` j &   
   32.46 +             (\<for