src/ZF/ex/misc.ML
author clasohm
Thu Sep 16 12:20:38 1993 +0200 (1993-09-16)
changeset 0 a5a9c433f639
child 7 268f93ab3bc4
permissions -rw-r--r--
Initial revision
     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 Zermelo-Fraenkel Set Theory 
     7 Cantor's Theorem; Schroeder-Bernstein 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 Theorem-proving.
    15  In: J. Hayes and D. Michie and L. Mikulich, eds.  Machine Intelligence 9.
    16  Ellis Horwood, 53-100 (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 Schroeder-Bernstein 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 = X-u")] 
    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 First-Order Logic: Clauses for G\"odel's Axioms,
    97   JAR 2 (1986), 287-327 
    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 meta-level 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:1--27, 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' (n-1)  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.";