src/ZF/ex/Ramsey.ML
changeset 4091 771b1f6422a8
parent 2469 b50b8c0eec01
child 4152 451104c223e2
equal deleted inserted replaced
4090:9f1eaab75e8c 4091:771b1f6422a8
    46 by (Fast_tac 1);
    46 by (Fast_tac 1);
    47 qed "Atleast0";
    47 qed "Atleast0";
    48 
    48 
    49 goalw Ramsey.thy [Atleast_def]
    49 goalw Ramsey.thy [Atleast_def]
    50     "!!m A. Atleast(succ(m),A) ==> EX x:A. Atleast(m, A-{x})";
    50     "!!m A. Atleast(succ(m),A) ==> EX x:A. Atleast(m, A-{x})";
    51 by (fast_tac (!claset addEs [inj_is_fun RS apply_type, inj_succ_restrict]) 1);
    51 by (fast_tac (claset() addEs [inj_is_fun RS apply_type, inj_succ_restrict]) 1);
    52 qed "Atleast_succD";
    52 qed "Atleast_succD";
    53 
    53 
    54 goalw Ramsey.thy [Atleast_def]
    54 goalw Ramsey.thy [Atleast_def]
    55     "!!n A. [| Atleast(n,A);  A<=B |] ==> Atleast(n,B)";
    55     "!!n A. [| Atleast(n,A);  A<=B |] ==> Atleast(n,B)";
    56 by (fast_tac (!claset addEs [inj_weaken_type]) 1);
    56 by (fast_tac (claset() addEs [inj_weaken_type]) 1);
    57 qed "Atleast_superset";
    57 qed "Atleast_superset";
    58 
    58 
    59 goalw Ramsey.thy [Atleast_def,succ_def]
    59 goalw Ramsey.thy [Atleast_def,succ_def]
    60     "!!m. [| Atleast(m,B);  b~: B |] ==> Atleast(succ(m), cons(b,B))";
    60     "!!m. [| Atleast(m,B);  b~: B |] ==> Atleast(succ(m), cons(b,B))";
    61 by (etac exE 1);
    61 by (etac exE 1);
    79 val prems = goal Ramsey.thy
    79 val prems = goal Ramsey.thy
    80     "m: nat ==> \
    80     "m: nat ==> \
    81 \    ALL n: nat. ALL A B. Atleast((m#+n) #- succ(0), A Un B) -->   \
    81 \    ALL n: nat. ALL A B. Atleast((m#+n) #- succ(0), A Un B) -->   \
    82 \                         Atleast(m,A) | Atleast(n,B)";
    82 \                         Atleast(m,A) | Atleast(n,B)";
    83 by (nat_ind_tac "m" prems 1);
    83 by (nat_ind_tac "m" prems 1);
    84 by (fast_tac (!claset addSIs [Atleast0]) 1);
    84 by (fast_tac (claset() addSIs [Atleast0]) 1);
    85 by (Asm_simp_tac 1);
    85 by (Asm_simp_tac 1);
    86 by (rtac ballI 1);
    86 by (rtac ballI 1);
    87 by (rename_tac "n" 1);          (*simplifier does NOT preserve bound names!*)
    87 by (rename_tac "n" 1);          (*simplifier does NOT preserve bound names!*)
    88 by (nat_ind_tac "n" [] 1);
    88 by (nat_ind_tac "n" [] 1);
    89 by (fast_tac (!claset addSIs [Atleast0]) 1);
    89 by (fast_tac (claset() addSIs [Atleast0]) 1);
    90 by (asm_simp_tac (!simpset addsimps [add_succ_right]) 1);
    90 by (asm_simp_tac (simpset() addsimps [add_succ_right]) 1);
    91 by (safe_tac (!claset));
    91 by (safe_tac (claset()));
    92 by (etac (Atleast_succD RS bexE) 1);
    92 by (etac (Atleast_succD RS bexE) 1);
    93 by (etac UnE 1);
    93 by (etac UnE 1);
    94 (**case x:B.  Instantiate the 'ALL A B' induction hypothesis. **)
    94 (**case x:B.  Instantiate the 'ALL A B' induction hypothesis. **)
    95 by (dres_inst_tac [("x1","A"), ("x","B-{x}")] (spec RS spec) 2);
    95 by (dres_inst_tac [("x1","A"), ("x","B-{x}")] (spec RS spec) 2);
    96 by (etac (mp RS disjE) 2);
    96 by (etac (mp RS disjE) 2);
   104 by (etac nat_succI 1);
   104 by (etac nat_succI 1);
   105 by (etac (mp RS disjE) 1);
   105 by (etac (mp RS disjE) 1);
   106 (*cases Atleast(succ(m1),A) and Atleast(succ(n1),B)*)
   106 (*cases Atleast(succ(m1),A) and Atleast(succ(n1),B)*)
   107 by (REPEAT (eresolve_tac [asm_rl, Atleast_Diff_succI, notE] 2));
   107 by (REPEAT (eresolve_tac [asm_rl, Atleast_Diff_succI, notE] 2));
   108 (*proving the condition*)
   108 (*proving the condition*)
   109 by (asm_simp_tac (!simpset addsimps [add_succ_right]) 1);
   109 by (asm_simp_tac (simpset() addsimps [add_succ_right]) 1);
   110 by (etac Atleast_superset 1 THEN Fast_tac 1);
   110 by (etac Atleast_superset 1 THEN Fast_tac 1);
   111 qed "pigeon2_lemma";
   111 qed "pigeon2_lemma";
   112 
   112 
   113 (* [| m:nat;  n:nat;  Atleast(m #+ n #- succ(0), A Un B) |] ==> 
   113 (* [| m:nat;  n:nat;  Atleast(m #+ n #- succ(0), A Un B) |] ==> 
   114    Atleast(m,A) | Atleast(n,B) *)
   114    Atleast(m,A) | Atleast(n,B) *)
   118 (**** Ramsey's Theorem ****)
   118 (**** Ramsey's Theorem ****)
   119 
   119 
   120 (** Base cases of induction; they now admit ANY Ramsey number **)
   120 (** Base cases of induction; they now admit ANY Ramsey number **)
   121 
   121 
   122 goalw Ramsey.thy [Ramsey_def] "Ramsey(n,0,j)";
   122 goalw Ramsey.thy [Ramsey_def] "Ramsey(n,0,j)";
   123 by (fast_tac (!claset addIs [Clique0,Atleast0]) 1);
   123 by (fast_tac (claset() addIs [Clique0,Atleast0]) 1);
   124 qed "Ramsey0j";
   124 qed "Ramsey0j";
   125 
   125 
   126 goalw Ramsey.thy [Ramsey_def] "Ramsey(n,i,0)";
   126 goalw Ramsey.thy [Ramsey_def] "Ramsey(n,i,0)";
   127 by (fast_tac (!claset addIs [Indept0,Atleast0]) 1);
   127 by (fast_tac (claset() addIs [Indept0,Atleast0]) 1);
   128 qed "Ramseyi0";
   128 qed "Ramseyi0";
   129 
   129 
   130 (** Lemmas for induction step **)
   130 (** Lemmas for induction step **)
   131 
   131 
   132 (*The use of succ(m) here, rather than #-succ(0), simplifies the proof of 
   132 (*The use of succ(m) here, rather than #-succ(0), simplifies the proof of 
   133   Ramsey_step_lemma.*)
   133   Ramsey_step_lemma.*)
   134 val prems = goal Ramsey.thy
   134 val prems = goal Ramsey.thy
   135     "[| Atleast(m #+ n, A);  m: nat;  n: nat |] ==> \
   135     "[| Atleast(m #+ n, A);  m: nat;  n: nat |] ==> \
   136 \    Atleast(succ(m), {x:A. ~P(x)}) | Atleast(n, {x:A. P(x)})";
   136 \    Atleast(succ(m), {x:A. ~P(x)}) | Atleast(n, {x:A. P(x)})";
   137 by (rtac (nat_succI RS pigeon2) 1);
   137 by (rtac (nat_succI RS pigeon2) 1);
   138 by (simp_tac (!simpset addsimps prems) 3);
   138 by (simp_tac (simpset() addsimps prems) 3);
   139 by (rtac Atleast_superset 3);
   139 by (rtac Atleast_superset 3);
   140 by (REPEAT (resolve_tac prems 1));
   140 by (REPEAT (resolve_tac prems 1));
   141 by (Fast_tac 1);
   141 by (Fast_tac 1);
   142 qed "Atleast_partition";
   142 qed "Atleast_partition";
   143 
   143 
   145 val prems = goalw Ramsey.thy [Symmetric_def,Indept_def]
   145 val prems = goalw Ramsey.thy [Symmetric_def,Indept_def]
   146     "[| Symmetric(E);  Indept(I, {z: V-{a}. <a,z> ~: E}, E);  a: V;  \
   146     "[| Symmetric(E);  Indept(I, {z: V-{a}. <a,z> ~: E}, E);  a: V;  \
   147 \       Atleast(j,I) |] ==>   \
   147 \       Atleast(j,I) |] ==>   \
   148 \    Indept(cons(a,I), V, E) & Atleast(succ(j), cons(a,I))";
   148 \    Indept(cons(a,I), V, E) & Atleast(succ(j), cons(a,I))";
   149 by (cut_facts_tac prems 1);
   149 by (cut_facts_tac prems 1);
   150 by (fast_tac (!claset addSEs [Atleast_succI]) 1);  (*34 secs*)
   150 by (fast_tac (claset() addSEs [Atleast_succI]) 1);  (*34 secs*)
   151 qed "Indept_succ";
   151 qed "Indept_succ";
   152 
   152 
   153 val prems = goalw Ramsey.thy [Symmetric_def,Clique_def]
   153 val prems = goalw Ramsey.thy [Symmetric_def,Clique_def]
   154     "[| Symmetric(E);  Clique(C, {z: V-{a}. <a,z>:E}, E);  a: V;  \
   154     "[| Symmetric(E);  Clique(C, {z: V-{a}. <a,z>:E}, E);  a: V;  \
   155 \       Atleast(j,C) |] ==>   \
   155 \       Atleast(j,C) |] ==>   \
   156 \    Clique(cons(a,C), V, E) & Atleast(succ(j), cons(a,C))";
   156 \    Clique(cons(a,C), V, E) & Atleast(succ(j), cons(a,C))";
   157 by (cut_facts_tac prems 1);
   157 by (cut_facts_tac prems 1);
   158 by (fast_tac (!claset addSEs [Atleast_succI]) 1);  (*41 secs*)
   158 by (fast_tac (claset() addSEs [Atleast_succI]) 1);  (*41 secs*)
   159 qed "Clique_succ";
   159 qed "Clique_succ";
   160 
   160 
   161 (** Induction step **)
   161 (** Induction step **)
   162 
   162 
   163 (*Published proofs gloss over the need for Ramsey numbers to be POSITIVE.*)
   163 (*Published proofs gloss over the need for Ramsey numbers to be POSITIVE.*)
   164 val ram1::ram2::prems = goalw Ramsey.thy [Ramsey_def] 
   164 val ram1::ram2::prems = goalw Ramsey.thy [Ramsey_def] 
   165    "[| Ramsey(succ(m), succ(i), j);  Ramsey(n, i, succ(j));  \
   165    "[| Ramsey(succ(m), succ(i), j);  Ramsey(n, i, succ(j));  \
   166 \      m: nat;  n: nat |] ==> \
   166 \      m: nat;  n: nat |] ==> \
   167 \   Ramsey(succ(m#+n), succ(i), succ(j))";
   167 \   Ramsey(succ(m#+n), succ(i), succ(j))";
   168 by (safe_tac (!claset));
   168 by (safe_tac (claset()));
   169 by (etac (Atleast_succD RS bexE) 1);
   169 by (etac (Atleast_succD RS bexE) 1);
   170 by (eres_inst_tac [("P1","%z.<x,z>:E")] (Atleast_partition RS disjE) 1);
   170 by (eres_inst_tac [("P1","%z.<x,z>:E")] (Atleast_partition RS disjE) 1);
   171 by (REPEAT (resolve_tac prems 1));
   171 by (REPEAT (resolve_tac prems 1));
   172 (*case m*)
   172 (*case m*)
   173 by (rtac (ram1 RS spec RS spec RS mp RS disjE) 1);
   173 by (rtac (ram1 RS spec RS spec RS mp RS disjE) 1);
   174 by (Fast_tac 1);
   174 by (Fast_tac 1);
   175 by (fast_tac (!claset addEs [Clique_superset]) 1); (*easy -- given a Clique*)
   175 by (fast_tac (claset() addEs [Clique_superset]) 1); (*easy -- given a Clique*)
   176 by (safe_tac (!claset));
   176 by (safe_tac (claset()));
   177 by (eresolve_tac (swapify [exI]) 1);             (*ignore main EX quantifier*)
   177 by (eresolve_tac (swapify [exI]) 1);             (*ignore main EX quantifier*)
   178 by (REPEAT (ares_tac [Indept_succ] 1));          (*make a bigger Indept*)
   178 by (REPEAT (ares_tac [Indept_succ] 1));          (*make a bigger Indept*)
   179 (*case n*)
   179 (*case n*)
   180 by (rtac (ram2 RS spec RS spec RS mp RS disjE) 1);
   180 by (rtac (ram2 RS spec RS spec RS mp RS disjE) 1);
   181 by (Fast_tac 1);
   181 by (Fast_tac 1);
   182 by (safe_tac (!claset));
   182 by (safe_tac (claset()));
   183 by (rtac exI 1);
   183 by (rtac exI 1);
   184 by (REPEAT (ares_tac [Clique_succ] 1));          (*make a bigger Clique*)
   184 by (REPEAT (ares_tac [Clique_succ] 1));          (*make a bigger Clique*)
   185 by (fast_tac (!claset addEs [Indept_superset]) 1); (*easy -- given an Indept*)
   185 by (fast_tac (claset() addEs [Indept_superset]) 1); (*easy -- given an Indept*)
   186 qed "Ramsey_step_lemma";
   186 qed "Ramsey_step_lemma";
   187 
   187 
   188 
   188 
   189 (** The actual proof **)
   189 (** The actual proof **)
   190 
   190 
   191 (*Again, the induction requires Ramsey numbers to be positive.*)
   191 (*Again, the induction requires Ramsey numbers to be positive.*)
   192 val prems = goal Ramsey.thy
   192 val prems = goal Ramsey.thy
   193     "i: nat ==> ALL j: nat. EX n:nat. Ramsey(succ(n), i, j)";
   193     "i: nat ==> ALL j: nat. EX n:nat. Ramsey(succ(n), i, j)";
   194 by (nat_ind_tac "i" prems 1);
   194 by (nat_ind_tac "i" prems 1);
   195 by (fast_tac (!claset addSIs [Ramsey0j]) 1);
   195 by (fast_tac (claset() addSIs [Ramsey0j]) 1);
   196 by (rtac ballI 1);
   196 by (rtac ballI 1);
   197 by (nat_ind_tac "j" [] 1);
   197 by (nat_ind_tac "j" [] 1);
   198 by (fast_tac (!claset addSIs [Ramseyi0]) 1);
   198 by (fast_tac (claset() addSIs [Ramseyi0]) 1);
   199 by (fast_tac (!claset addSDs [bspec]
   199 by (fast_tac (claset() addSDs [bspec]
   200 		      addSIs [nat_succI,add_type,Ramsey_step_lemma]) 1);
   200 		      addSIs [nat_succI,add_type,Ramsey_step_lemma]) 1);
   201 qed "ramsey_lemma";
   201 qed "ramsey_lemma";
   202 
   202 
   203 (*Final statement in a tidy form, without succ(...) *)
   203 (*Final statement in a tidy form, without succ(...) *)
   204 goal Ramsey.thy "!!i j. [| i: nat;  j: nat |] ==> EX n:nat. Ramsey(n,i,j)";
   204 goal Ramsey.thy "!!i j. [| i: nat;  j: nat |] ==> EX n:nat. Ramsey(n,i,j)";
   205 by (best_tac (!claset addDs [ramsey_lemma] addSIs [nat_succI]) 1);
   205 by (best_tac (claset() addDs [ramsey_lemma] addSIs [nat_succI]) 1);
   206 qed "ramsey";
   206 qed "ramsey";
   207 
   207 
   208 (*Compute Ramsey numbers according to proof above -- which, actually,
   208 (*Compute Ramsey numbers according to proof above -- which, actually,
   209   does not constrain the base case values at all!*)
   209   does not constrain the base case values at all!*)
   210 fun ram 0 j = 1
   210 fun ram 0 j = 1