src/ZF/WF.ML
changeset 12884 5d18148e9059
parent 9907 473a6604da94
child 12891 92af5c3a10fb
equal deleted inserted replaced
12883:3f86b73d592d 12884:5d18148e9059
    56 
    56 
    57 (*If r allows well-founded induction over A then wf[A](r)
    57 (*If r allows well-founded induction over A then wf[A](r)
    58   Premise is equivalent to 
    58   Premise is equivalent to 
    59   !!B. ALL x:A. (ALL y. <y,x>: r --> y:B) --> x:B ==> A<=B  *)
    59   !!B. ALL x:A. (ALL y. <y,x>: r --> y:B) --> x:B ==> A<=B  *)
    60 val [prem] = Goal
    60 val [prem] = Goal
    61     "[| !!y B. [| ALL x:A. (ALL y:A. <y,x>:r --> y:B) --> x:B;   y:A  \
    61     "[| !!y B. [| ALL x:A. (ALL y:A. <y,x>:r --> y:B) --> x:B;   y:A |]   \
    62 \              |] ==> y:B |] \
    62 \              ==> y:B |] \
    63 \    ==>  wf[A](r)";
    63 \    ==>  wf[A](r)";
    64 by (rtac wf_onI 1);
    64 by (rtac wf_onI 1);
    65 by (res_inst_tac [ ("c", "u") ] (prem RS DiffE) 1);
    65 by (res_inst_tac [ ("c", "u") ] (prem RS DiffE) 1);
    66 by (contr_tac 3);
    66 by (contr_tac 3);
    67 by (Blast_tac 2);
    67 by (Blast_tac 2);
   120            REPEAT (ares_tac prems i)];
   120            REPEAT (ares_tac prems i)];
   121 
   121 
   122 (*If r allows well-founded induction then wf(r)*)
   122 (*If r allows well-founded induction then wf(r)*)
   123 val [subs,indhyp] = Goal
   123 val [subs,indhyp] = Goal
   124     "[| field(r)<=A;  \
   124     "[| field(r)<=A;  \
   125 \       !!y B. [| ALL x:A. (ALL y:A. <y,x>:r --> y:B) --> x:B;   y:A  \
   125 \       !!y B. [| ALL x:A. (ALL y:A. <y,x>:r --> y:B) --> x:B;  y:A|]  \
   126 \              |] ==> y:B |] \
   126 \              ==> y:B |] \
   127 \    ==>  wf(r)";
   127 \    ==>  wf(r)";
   128 by (rtac ([wf_onI2, subs] MRS (wf_on_subset_A RS wf_on_field_imp_wf)) 1);
   128 by (rtac ([wf_onI2, subs] MRS (wf_on_subset_A RS wf_on_field_imp_wf)) 1);
   129 by (REPEAT (ares_tac [indhyp] 1));
   129 by (REPEAT (ares_tac [indhyp] 1));
   130 qed "wfI";
   130 qed "wfI";
   131 
   131 
   210     "[| is_recfun(r,a,H,f); <x,a>:r |] ==> f`x = H(x, restrict(f,r-``{x}))";
   210     "[| is_recfun(r,a,H,f); <x,a>:r |] ==> f`x = H(x, restrict(f,r-``{x}))";
   211 by (res_inst_tac [("P", "%x.?t(x) = (?u::i)")] (isrec RS ssubst) 1);
   211 by (res_inst_tac [("P", "%x.?t(x) = (?u::i)")] (isrec RS ssubst) 1);
   212 by (rtac (rel RS underI RS beta) 1);
   212 by (rtac (rel RS underI RS beta) 1);
   213 qed "apply_recfun";
   213 qed "apply_recfun";
   214 
   214 
   215 (*eresolve_tac transD solves <a,b>:r using transitivity AT MOST ONCE
       
   216   spec RS mp  instantiates induction hypotheses*)
       
   217 fun indhyp_tac hyps =
       
   218     resolve_tac (TrueI::refl::reflexive_thm::hyps) ORELSE' 
       
   219     (cut_facts_tac hyps THEN'
       
   220        DEPTH_SOLVE_1 o (ares_tac [TrueI, ballI] ORELSE'
       
   221                         eresolve_tac [underD, transD, spec RS mp]));
       
   222 
       
   223 (*** NOTE! some simplifications need a different solver!! ***)
       
   224 val wf_super_ss = simpset() setSolver (mk_solver "WF" indhyp_tac);
       
   225 
       
   226 Goalw [is_recfun_def]
   215 Goalw [is_recfun_def]
   227     "[| wf(r);  trans(r);  is_recfun(r,a,H,f);  is_recfun(r,b,H,g) |] ==> \
   216     "[| wf(r);  trans(r);  is_recfun(r,a,H,f);  is_recfun(r,b,H,g) |] ==> \
   228 \    <x,a>:r --> <x,b>:r --> f`x=g`x";
   217 \    <x,a>:r --> <x,b>:r --> f`x=g`x";
   229 by (wf_ind_tac "x" [] 1);
   218 by (wf_ind_tac "x" [] 1);
   230 by (REPEAT (rtac impI 1 ORELSE etac ssubst 1));
   219 by (REPEAT (rtac impI 1 ORELSE etac ssubst 1));
   231 by (rewtac restrict_def);
   220 by (asm_simp_tac (simpset() addsimps [vimage_singleton_iff, restrict_def]) 1); 
   232 by (asm_simp_tac (wf_super_ss addsimps [vimage_singleton_iff]) 1);
   221 by (subgoal_tac "ALL y. y : r-``{x1} --> f`y = g`y" 1);
       
   222  by (Asm_simp_tac 1);
       
   223 by (blast_tac (claset() addDs [transD]) 1); 
   233 qed_spec_mp "is_recfun_equal";
   224 qed_spec_mp "is_recfun_equal";
   234 
   225 
   235 val prems as [wfr,transr,recf,recg,_] = goal (the_context ())
   226 Goal "[| wf(r);  trans(r);       \
   236     "[| wf(r);  trans(r);       \
   227 \        is_recfun(r,a,H,f);  is_recfun(r,b,H,g);  <b,a>:r |]  \
   237 \       is_recfun(r,a,H,f);  is_recfun(r,b,H,g);  <b,a>:r |] ==> \
   228 \     ==> restrict(f, r-``{b}) = g";
   238 \    restrict(f, r-``{b}) = g";
       
   239 by (cut_facts_tac prems 1);
       
   240 by (rtac (consI1 RS restrict_type RS fun_extension) 1);
   229 by (rtac (consI1 RS restrict_type RS fun_extension) 1);
   241 by (etac is_recfun_type 1);
   230 by (etac is_recfun_type 1);
   242 by (ALLGOALS
   231 by (asm_full_simp_tac (simpset() addsimps [vimage_singleton_iff]) 1);
   243     (asm_simp_tac (wf_super_ss addsimps
   232 by (blast_tac (claset() addDs [transD]
   244                    [ [wfr,transr,recf,recg] MRS is_recfun_equal ])));
   233 			addIs [is_recfun_equal]) 1);
   245 qed "is_recfun_cut";
   234 qed "is_recfun_cut";
   246 
   235 
   247 (*** Main Existence Lemma ***)
   236 (*** Main Existence Lemma ***)
   248 
   237 
   249 Goal "[| wf(r); trans(r); is_recfun(r,a,H,f); is_recfun(r,a,H,g) |]  ==>  f=g";
   238 Goal "[| wf(r); trans(r); is_recfun(r,a,H,f); is_recfun(r,a,H,g) |]  ==>  f=g";
   267 by (rewrite_goals_tac [is_recfun_def, wftrec_def]);
   256 by (rewrite_goals_tac [is_recfun_def, wftrec_def]);
   268 (*Applying the substitution: must keep the quantified assumption!!*)
   257 (*Applying the substitution: must keep the quantified assumption!!*)
   269 by (REPEAT (dtac underD 1 ORELSE resolve_tac [refl, lam_cong] 1));
   258 by (REPEAT (dtac underD 1 ORELSE resolve_tac [refl, lam_cong] 1));
   270 by (fold_tac [is_recfun_def]);
   259 by (fold_tac [is_recfun_def]);
   271 by (rtac (consI1 RS restrict_type RSN (2,fun_extension) RS subst_context) 1);
   260 by (rtac (consI1 RS restrict_type RSN (2,fun_extension) RS subst_context) 1);
   272 by (rtac is_recfun_type 1);
   261  by (blast_tac (claset() addIs [is_recfun_type]) 1);
   273 by (ALLGOALS
   262 by (ftac (spec RS mp) 1 THEN assume_tac 1);
   274     (asm_simp_tac
   263 by (subgoal_tac "<xa,a1> : r" 1);
   275      (wf_super_ss addsimps [underI RS beta, apply_recfun, is_recfun_cut])));
   264 by (dres_inst_tac [("x1","xa")] (spec RS mp) 1 THEN assume_tac 1);
       
   265 by (asm_full_simp_tac
       
   266      (simpset() addsimps [vimage_singleton_iff, underI RS beta, apply_recfun, 
       
   267                           is_recfun_cut]) 1);
       
   268 by (blast_tac (claset() addDs [transD]) 1);
   276 qed "unfold_the_recfun";
   269 qed "unfold_the_recfun";
   277 
   270 
   278 
   271 
   279 (*** Unfolding wftrec ***)
   272 (*** Unfolding wftrec ***)
   280 
   273 
   329 \        wfrec[A](r,a,H) = H(a, lam x: (r-``{a}) Int A. wfrec[A](r,x,H))";
   322 \        wfrec[A](r,a,H) = H(a, lam x: (r-``{a}) Int A. wfrec[A](r,x,H))";
   330 by (etac (wfrec RS trans) 1);
   323 by (etac (wfrec RS trans) 1);
   331 by (asm_simp_tac (simpset() addsimps [vimage_Int_square, cons_subset_iff]) 1);
   324 by (asm_simp_tac (simpset() addsimps [vimage_Int_square, cons_subset_iff]) 1);
   332 qed "wfrec_on";
   325 qed "wfrec_on";
   333 
   326 
   334 (*----------------------------------------------------------------------------
   327 (*Minimal-element characterization of well-foundedness*)
   335  * Minimal-element characterization of well-foundedness
   328 Goalw [wf_def] 
   336  *---------------------------------------------------------------------------*)
   329      "wf(r) <-> (ALL Q x. x:Q --> (EX z:Q. ALL y. <y,z>:r --> y~:Q))";
   337 
   330 by (Blast_tac 1);
   338 Goalw [wf_def] "wf(r) ==> x:Q --> (EX z:Q. ALL y. <y,z>:r --> y~:Q)";
       
   339 by (dtac spec 1);
       
   340 by (Blast_tac 1);
       
   341 val lemma1 = result();
       
   342 
       
   343 Goalw [wf_def]
       
   344      "(ALL Q x. x:Q --> (EX z:Q. ALL y. <y,z>:r --> y~:Q)) ==> wf(r)";
       
   345 by (Clarify_tac 1);
       
   346 by (Blast_tac 1);
       
   347 val lemma2 = result();
       
   348 
       
   349 Goal "wf(r) <-> (ALL Q x. x:Q --> (EX z:Q. ALL y. <y,z>:r --> y~:Q))";
       
   350 by (blast_tac (claset() addSIs [lemma1, lemma2]) 1);
       
   351 qed "wf_eq_minimal";
   331 qed "wf_eq_minimal";
   352 
   332