0

1 
(* Title: ZF/ex/misc


2 
ID: $Id$


3 
Author: Lawrence C Paulson, Cambridge University Computer Laboratory


4 
Copyright 1993 University of Cambridge


5 


6 
Miscellaneous examples for ZermeloFraenkel Set Theory


7 
Cantor's Theorem; SchroederBernstein Theorem; Composition of homomorphisms...


8 
*)


9 


10 
writeln"ZF/ex/misc";


11 


12 


13 
(*Example 12 (credited to Peter Andrews) from


14 
W. Bledsoe. A Maximal Method for Set Variables in Automatic Theoremproving.


15 
In: J. Hayes and D. Michie and L. Mikulich, eds. Machine Intelligence 9.


16 
Ellis Horwood, 53100 (1979). *)


17 
goal ZF.thy "(ALL F. {x}: F > {y}:F) > (ALL A. x:A > y:A)";


18 
by (best_tac ZF_cs 1);


19 
result();


20 


21 


22 
(*** Cantor's Theorem: There is no surjection from a set to its powerset. ***)


23 


24 
val cantor_cs = FOL_cs (*precisely the rules needed for the proof*)


25 
addSIs [ballI, CollectI, PowI, subsetI] addIs [bexI]


26 
addSEs [CollectE, equalityCE];


27 


28 
(*The search is undirected and similar proof attempts fail*)


29 
goal ZF.thy "ALL f: A>Pow(A). EX S: Pow(A). ALL x:A. ~ f`x = S";


30 
by (best_tac cantor_cs 1);


31 
result();


32 


33 
(*This form displays the diagonal term, {x: A . ~ x: f`x} *)


34 
val [prem] = goal ZF.thy


35 
"f: A>Pow(A) ==> (ALL x:A. ~ f`x = ?S) & ?S: Pow(A)";


36 
by (best_tac cantor_cs 1);


37 
result();


38 


39 
(*yet another version...*)


40 
goalw Perm.thy [surj_def] "~ f : surj(A,Pow(A))";


41 
by (safe_tac ZF_cs);


42 
by (etac ballE 1);


43 
by (best_tac (cantor_cs addSEs [bexE]) 1);


44 
by (fast_tac ZF_cs 1);


45 
result();


46 


47 


48 
(**** The SchroederBernstein Theorem  see Davey & Priestly, page 106 ****)


49 


50 
val SB_thy = merge_theories (Fixedpt.thy, Perm.thy);


51 


52 
(** Lemma: Banach's Decomposition Theorem **)


53 


54 
goal SB_thy "bnd_mono(X, %W. X  g``(Y  f``W))";


55 
by (rtac bnd_monoI 1);


56 
by (REPEAT (ares_tac [Diff_subset, subset_refl, Diff_mono, image_mono] 1));


57 
val decomp_bnd_mono = result();


58 


59 
val [gfun] = goal SB_thy


60 
"g: Y>X ==> \


61 
\ g``(Y  f`` lfp(X, %W. X  g``(Y  f``W))) = \


62 
\ X  lfp(X, %W. X  g``(Y  f``W)) ";


63 
by (res_inst_tac [("P", "%u. ?v = Xu")]


64 
(decomp_bnd_mono RS lfp_Tarski RS ssubst) 1);


65 
by (SIMP_TAC (ZF_ss addrews [subset_refl, double_complement, Diff_subset,


66 
gfun RS fun_is_rel RS image_subset]) 1);


67 
val Banach_last_equation = result();


68 


69 
val prems = goal SB_thy


70 
"[ f: X>Y; g: Y>X ] ==> \


71 
\ EX XA XB YA YB. (XA Int XB = 0) & (XA Un XB = X) & \


72 
\ (YA Int YB = 0) & (YA Un YB = Y) & \


73 
\ f``XA=YA & g``YB=XB";


74 
by (REPEAT


75 
(FIRSTGOAL


76 
(resolve_tac [refl, exI, conjI, Diff_disjoint, Diff_partition])));


77 
by (rtac Banach_last_equation 3);


78 
by (REPEAT (resolve_tac (prems@[fun_is_rel, image_subset, lfp_subset]) 1));


79 
val decomposition = result();


80 


81 
val prems = goal SB_thy


82 
"[ f: inj(X,Y); g: inj(Y,X) ] ==> EX h. h: bij(X,Y)";


83 
by (cut_facts_tac prems 1);


84 
by (cut_facts_tac [(prems RL [inj_is_fun]) MRS decomposition] 1);


85 
by (fast_tac (ZF_cs addSIs [restrict_bij,bij_disjoint_Un]


86 
addIs [bij_converse_bij]) 1);


87 
(* The instantiation of exI to "restrict(f,XA) Un converse(restrict(g,YB))"


88 
is forced by the context!! *)


89 
val schroeder_bernstein = result();


90 


91 


92 
(*** Composition of homomorphisms is a homomorphism ***)


93 


94 
(*Given as a challenge problem in


95 
R. Boyer et al.,


96 
Set Theory in FirstOrder Logic: Clauses for G\"odel's Axioms,


97 
JAR 2 (1986), 287327


98 
*)


99 


100 
val hom_ss = (*collecting the relevant lemmas*)


101 
ZF_ss addrews [comp_func,comp_func_apply,SigmaI,apply_type]


102 
addcongs (mk_congs Perm.thy ["op O"]);


103 


104 
(*This version uses a super application of SIMP_TAC; it is SLOW


105 
Expressing the goal by > instead of ==> would make it slower still*)


106 
val [hom_eq] = goal Perm.thy


107 
"(ALL A f B g. hom(A,f,B,g) = \


108 
\ {H: A>B. f:A*A>A & g:B*B>B & \


109 
\ (ALL x:A. ALL y:A. H`(f`<x,y>) = g`<H`x,H`y>)}) ==> \


110 
\ J : hom(A,f,B,g) & K : hom(B,g,C,h) > \


111 
\ (K O J) : hom(A,f,C,h)";


112 
by (SIMP_TAC (hom_ss setauto K(fast_tac prop_cs) addrews [hom_eq]) 1);


113 
val comp_homs = result();


114 


115 
(*This version uses metalevel rewriting, safe_tac and ASM_SIMP_TAC*)


116 
val [hom_def] = goal Perm.thy


117 
"(!! A f B g. hom(A,f,B,g) == \


118 
\ {H: A>B. f:A*A>A & g:B*B>B & \


119 
\ (ALL x:A. ALL y:A. H`(f`<x,y>) = g`<H`x,H`y>)}) ==> \


120 
\ J : hom(A,f,B,g) & K : hom(B,g,C,h) > \


121 
\ (K O J) : hom(A,f,C,h)";


122 
by (rewtac hom_def);


123 
by (safe_tac ZF_cs);


124 
by (ASM_SIMP_TAC hom_ss 1);


125 
by (ASM_SIMP_TAC hom_ss 1);


126 
val comp_homs = result();


127 


128 


129 
(** A characterization of functions, suggested by Tobias Nipkow **)


130 


131 
goalw ZF.thy [Pi_def]


132 
"r: domain(r)>B <> r <= domain(r)*B & (ALL X. r `` (r `` X) <= X)";


133 
by (safe_tac ZF_cs);


134 
by (fast_tac (ZF_cs addSDs [bspec RS ex1_equalsE]) 1);


135 
by (eres_inst_tac [("x", "{y}")] allE 1);


136 
by (fast_tac ZF_cs 1);


137 
result();


138 


139 


140 
(**** From D Pastre. Automatic theorem proving in set theory.


141 
Artificial Intelligence, 10:127, 1978.


142 
These examples require forward reasoning! ****)


143 


144 
(*reduce the clauses to units by type checking  beware of nontermination*)


145 
fun forw_typechk tyrls [] = []


146 
 forw_typechk tyrls clauses =


147 
let val (units, others) = partition (has_fewer_prems 1) clauses


148 
in gen_union eq_thm (units, forw_typechk tyrls (tyrls RL others))


149 
end;


150 


151 
(*A crude form of forward reasoning*)


152 
fun forw_iterate tyrls rls facts 0 = facts


153 
 forw_iterate tyrls rls facts n =


154 
let val facts' =


155 
gen_union eq_thm (forw_typechk (tyrls@facts) (facts RL rls), facts);


156 
in forw_iterate tyrls rls facts' (n1) end;


157 


158 
val pastre_rls =


159 
[comp_mem_injD1, comp_mem_surjD1, comp_mem_injD2, comp_mem_surjD2];


160 


161 
fun pastre_facts (fact1::fact2::fact3::prems) =


162 
forw_iterate (prems @ [comp_surj, comp_inj, comp_func])


163 
pastre_rls [fact1,fact2,fact3] 4;


164 


165 
val prems = goalw Perm.thy [bij_def]


166 
"[ (h O g O f): inj(A,A); \


167 
\ (f O h O g): surj(B,B); \


168 
\ (g O f O h): surj(C,C); \


169 
\ f: A>B; g: B>C; h: C>A ] ==> h: bij(C,A)";


170 
by (REPEAT (resolve_tac (IntI :: pastre_facts prems) 1));


171 
val pastre1 = result();


172 


173 
val prems = goalw Perm.thy [bij_def]


174 
"[ (h O g O f): surj(A,A); \


175 
\ (f O h O g): inj(B,B); \


176 
\ (g O f O h): surj(C,C); \


177 
\ f: A>B; g: B>C; h: C>A ] ==> h: bij(C,A)";


178 
by (REPEAT (resolve_tac (IntI :: pastre_facts prems) 1));


179 
val pastre2 = result();


180 


181 
val prems = goalw Perm.thy [bij_def]


182 
"[ (h O g O f): surj(A,A); \


183 
\ (f O h O g): surj(B,B); \


184 
\ (g O f O h): inj(C,C); \


185 
\ f: A>B; g: B>C; h: C>A ] ==> h: bij(C,A)";


186 
by (REPEAT (resolve_tac (IntI :: pastre_facts prems) 1));


187 
val pastre3 = result();


188 


189 
val prems = goalw Perm.thy [bij_def]


190 
"[ (h O g O f): surj(A,A); \


191 
\ (f O h O g): inj(B,B); \


192 
\ (g O f O h): inj(C,C); \


193 
\ f: A>B; g: B>C; h: C>A ] ==> h: bij(C,A)";


194 
by (REPEAT (resolve_tac (IntI :: pastre_facts prems) 1));


195 
val pastre4 = result();


196 


197 
val prems = goalw Perm.thy [bij_def]


198 
"[ (h O g O f): inj(A,A); \


199 
\ (f O h O g): surj(B,B); \


200 
\ (g O f O h): inj(C,C); \


201 
\ f: A>B; g: B>C; h: C>A ] ==> h: bij(C,A)";


202 
by (REPEAT (resolve_tac (IntI :: pastre_facts prems) 1));


203 
val pastre5 = result();


204 


205 
val prems = goalw Perm.thy [bij_def]


206 
"[ (h O g O f): inj(A,A); \


207 
\ (f O h O g): inj(B,B); \


208 
\ (g O f O h): surj(C,C); \


209 
\ f: A>B; g: B>C; h: C>A ] ==> h: bij(C,A)";


210 
by (REPEAT (resolve_tac (IntI :: pastre_facts prems) 1));


211 
val pastre6 = result();


212 


213 
writeln"Reached end of file.";
