src/ZF/ex/ramsey.ML
author lcp
Tue Aug 16 18:58:42 1994 +0200 (1994-08-16)
changeset 532 851df239ac8b
parent 38 4433428596f9
permissions -rw-r--r--
ZF/Makefile,ROOT.ML, ZF/ex/Integ.thy: updated for EquivClass
clasohm@0
     1
(*  Title: 	ZF/ex/ramsey.ML
clasohm@0
     2
    ID:         $Id$
clasohm@0
     3
    Author: 	Lawrence C Paulson, Cambridge University Computer Laboratory
clasohm@0
     4
    Copyright   1992  University of Cambridge
clasohm@0
     5
clasohm@0
     6
Ramsey's Theorem (finite exponent 2 version)
clasohm@0
     7
clasohm@0
     8
Based upon the article
clasohm@0
     9
    D Basin and M Kaufmann,
clasohm@0
    10
    The Boyer-Moore Prover and Nuprl: An Experimental Comparison.
clasohm@0
    11
    In G Huet and G Plotkin, editors, Logical Frameworks.
clasohm@0
    12
    (CUP, 1991), pages 89--119
clasohm@0
    13
clasohm@0
    14
See also
clasohm@0
    15
    M Kaufmann,
clasohm@0
    16
    An example in NQTHM: Ramsey's Theorem
clasohm@0
    17
    Internal Note, Computational Logic, Inc., Austin, Texas 78703
clasohm@0
    18
    Available from the author: kaufmann@cli.com
clasohm@0
    19
*)
clasohm@0
    20
clasohm@0
    21
open Ramsey;
clasohm@0
    22
clasohm@0
    23
(*** Cliques and Independent sets ***)
clasohm@0
    24
clasohm@0
    25
goalw Ramsey.thy [Clique_def] "Clique(0,V,E)";
clasohm@0
    26
by (fast_tac ZF_cs 1);
clasohm@0
    27
val Clique0 = result();
clasohm@0
    28
clasohm@0
    29
goalw Ramsey.thy [Clique_def]
clasohm@0
    30
    "!!C V E. [| Clique(C,V',E);  V'<=V |] ==> Clique(C,V,E)";
clasohm@0
    31
by (fast_tac ZF_cs 1);
clasohm@0
    32
val Clique_superset = result();
clasohm@0
    33
clasohm@0
    34
goalw Ramsey.thy [Indept_def] "Indept(0,V,E)";
clasohm@0
    35
by (fast_tac ZF_cs 1);
clasohm@0
    36
val Indept0 = result();
clasohm@0
    37
clasohm@0
    38
val prems = goalw Ramsey.thy [Indept_def]
clasohm@0
    39
    "!!I V E. [| Indept(I,V',E);  V'<=V |] ==> Indept(I,V,E)";
clasohm@0
    40
by (fast_tac ZF_cs 1);
clasohm@0
    41
val Indept_superset = result();
clasohm@0
    42
clasohm@0
    43
(*** Atleast ***)
clasohm@0
    44
clasohm@0
    45
goalw Ramsey.thy [Atleast_def,inj_def] "Atleast(0,A)";
clasohm@0
    46
by (fast_tac (ZF_cs addIs [PiI]) 1);
clasohm@0
    47
val Atleast0 = result();
clasohm@0
    48
clasohm@0
    49
val [major] = goalw Ramsey.thy [Atleast_def]
clasohm@0
    50
    "Atleast(succ(m),A) ==> EX x:A. Atleast(m, A-{x})";
clasohm@0
    51
by (rtac (major RS exE) 1);
clasohm@0
    52
by (rtac bexI 1);
clasohm@0
    53
by (etac (inj_is_fun RS apply_type) 2);
clasohm@0
    54
by (rtac succI1 2);
clasohm@0
    55
by (rtac exI 1);
clasohm@0
    56
by (etac inj_succ_restrict 1);
clasohm@0
    57
val Atleast_succD = result();
clasohm@0
    58
clasohm@0
    59
val major::prems = goalw Ramsey.thy [Atleast_def]
clasohm@0
    60
    "[| Atleast(n,A);  A<=B |] ==> Atleast(n,B)";
clasohm@0
    61
by (rtac (major RS exE) 1);
clasohm@0
    62
by (rtac exI 1);
clasohm@0
    63
by (etac inj_weaken_type 1);
clasohm@0
    64
by (resolve_tac prems 1);
clasohm@0
    65
val Atleast_superset = result();
clasohm@0
    66
clasohm@0
    67
val prems = goalw Ramsey.thy [Atleast_def,succ_def]
lcp@38
    68
    "[| Atleast(m,B);  b~: B |] ==> Atleast(succ(m), cons(b,B))";
clasohm@0
    69
by (cut_facts_tac prems 1);
clasohm@0
    70
by (etac exE 1);
clasohm@0
    71
by (rtac exI 1);
clasohm@0
    72
by (etac inj_extend 1);
clasohm@0
    73
by (rtac mem_not_refl 1);
clasohm@0
    74
by (assume_tac 1);
clasohm@0
    75
val Atleast_succI = result();
clasohm@0
    76
clasohm@0
    77
val prems = goal Ramsey.thy
clasohm@0
    78
    "[| Atleast(m, B-{x});  x: B |] ==> Atleast(succ(m), B)";
clasohm@0
    79
by (cut_facts_tac prems 1);
clasohm@0
    80
by (etac (Atleast_succI RS Atleast_superset) 1);
clasohm@0
    81
by (fast_tac ZF_cs 1);
clasohm@0
    82
by (fast_tac ZF_cs 1);
clasohm@0
    83
val Atleast_Diff_succI = result();
clasohm@0
    84
clasohm@0
    85
(*** Main Cardinality Lemma ***)
clasohm@0
    86
clasohm@0
    87
(*The #-succ(0) strengthens the original theorem statement, but precisely
clasohm@0
    88
  the same proof could be used!!*)
clasohm@0
    89
val prems = goal Ramsey.thy
clasohm@0
    90
    "m: nat ==> \
clasohm@0
    91
\    ALL n: nat. ALL A B. Atleast((m#+n) #- succ(0), A Un B) -->   \
clasohm@0
    92
\                         Atleast(m,A) | Atleast(n,B)";
clasohm@0
    93
by (nat_ind_tac "m" prems 1);
clasohm@0
    94
by (fast_tac (ZF_cs addSIs [Atleast0]) 1);
lcp@7
    95
by (asm_simp_tac arith_ss 1);
clasohm@0
    96
by (rtac ballI 1);
lcp@7
    97
by (rename_tac "n" 1);		(*simplifier does NOT preserve bound names!*)
clasohm@0
    98
by (nat_ind_tac "n" [] 1);
clasohm@0
    99
by (fast_tac (ZF_cs addSIs [Atleast0]) 1);
lcp@7
   100
by (asm_simp_tac (arith_ss addsimps [add_succ_right]) 1);
clasohm@0
   101
by (safe_tac ZF_cs);
clasohm@0
   102
by (etac (Atleast_succD RS bexE) 1);
clasohm@0
   103
by (etac UnE 1);
clasohm@0
   104
(**case x:B.  Instantiate the 'ALL A B' induction hypothesis. **)
clasohm@0
   105
by (dres_inst_tac [("x1","A"), ("x","B-{x}")] (spec RS spec) 2);
clasohm@0
   106
by (etac (mp RS disjE) 2);
clasohm@0
   107
(*cases Atleast(succ(m1),A) and Atleast(succ(n1),B)*)
clasohm@0
   108
by (REPEAT (eresolve_tac [asm_rl, notE, Atleast_Diff_succI] 3));
clasohm@0
   109
(*proving the condition*)
clasohm@0
   110
by (etac Atleast_superset 2 THEN fast_tac ZF_cs 2);
clasohm@0
   111
(**case x:A.  Instantiate the 'ALL n:nat. ALL A B' induction hypothesis. **)
clasohm@0
   112
by (dres_inst_tac [("x2","succ(n1)"), ("x1","A-{x}"), ("x","B")] 
clasohm@0
   113
    (bspec RS spec RS spec) 1);
clasohm@0
   114
by (etac nat_succI 1);
clasohm@0
   115
by (etac (mp RS disjE) 1);
clasohm@0
   116
(*cases Atleast(succ(m1),A) and Atleast(succ(n1),B)*)
clasohm@0
   117
by (REPEAT (eresolve_tac [asm_rl, Atleast_Diff_succI, notE] 2));
clasohm@0
   118
(*proving the condition*)
lcp@7
   119
by (asm_simp_tac (arith_ss addsimps [add_succ_right]) 1);
clasohm@0
   120
by (etac Atleast_superset 1 THEN fast_tac ZF_cs 1);
clasohm@0
   121
val pigeon2_lemma = result();
clasohm@0
   122
clasohm@0
   123
(* [| m:nat;  n:nat;  Atleast(m #+ n #- succ(0), A Un B) |] ==> 
clasohm@0
   124
   Atleast(m,A) | Atleast(n,B) *)
clasohm@0
   125
val pigeon2 = standard (pigeon2_lemma RS bspec RS spec RS spec RS mp);
clasohm@0
   126
clasohm@0
   127
clasohm@0
   128
(**** Ramsey's Theorem ****)
clasohm@0
   129
clasohm@0
   130
(** Base cases of induction; they now admit ANY Ramsey number **)
clasohm@0
   131
clasohm@0
   132
goalw Ramsey.thy [Ramsey_def] "Ramsey(n,0,j)";
clasohm@0
   133
by (fast_tac (ZF_cs addIs [Clique0,Atleast0]) 1);
clasohm@0
   134
val Ramsey0j = result();
clasohm@0
   135
clasohm@0
   136
goalw Ramsey.thy [Ramsey_def] "Ramsey(n,i,0)";
clasohm@0
   137
by (fast_tac (ZF_cs addIs [Indept0,Atleast0]) 1);
clasohm@0
   138
val Ramseyi0 = result();
clasohm@0
   139
clasohm@0
   140
(** Lemmas for induction step **)
clasohm@0
   141
clasohm@0
   142
(*The use of succ(m) here, rather than #-succ(0), simplifies the proof of 
clasohm@0
   143
  Ramsey_step_lemma.*)
clasohm@0
   144
val prems = goal Ramsey.thy
clasohm@0
   145
    "[| Atleast(m #+ n, A);  m: nat;  n: nat |] ==> \
clasohm@0
   146
\    Atleast(succ(m), {x:A. ~P(x)}) | Atleast(n, {x:A. P(x)})";
clasohm@0
   147
by (rtac (nat_succI RS pigeon2) 1);
lcp@7
   148
by (simp_tac (arith_ss addsimps prems) 3);
clasohm@0
   149
by (rtac Atleast_superset 3);
clasohm@0
   150
by (REPEAT (resolve_tac prems 1));
clasohm@0
   151
by (fast_tac ZF_cs 1);
clasohm@0
   152
val Atleast_partition = result();
clasohm@0
   153
clasohm@0
   154
(*For the Atleast part, proves ~(a:I) from the second premise!*)
clasohm@0
   155
val prems = goalw Ramsey.thy [Symmetric_def,Indept_def]
lcp@38
   156
    "[| Symmetric(E);  Indept(I, {z: V-{a}. <a,z> ~: E}, E);  a: V;  \
clasohm@0
   157
\       Atleast(j,I) |] ==>   \
clasohm@0
   158
\    Indept(cons(a,I), V, E) & Atleast(succ(j), cons(a,I))";
clasohm@0
   159
by (cut_facts_tac prems 1);
clasohm@0
   160
by (fast_tac (ZF_cs addSEs [Atleast_succI]) 1);	 (*34 secs*)
clasohm@0
   161
val Indept_succ = result();
clasohm@0
   162
clasohm@0
   163
val prems = goalw Ramsey.thy [Symmetric_def,Clique_def]
clasohm@0
   164
    "[| Symmetric(E);  Clique(C, {z: V-{a}. <a,z>:E}, E);  a: V;  \
clasohm@0
   165
\       Atleast(j,C) |] ==>   \
clasohm@0
   166
\    Clique(cons(a,C), V, E) & Atleast(succ(j), cons(a,C))";
clasohm@0
   167
by (cut_facts_tac prems 1);
clasohm@0
   168
by (fast_tac (ZF_cs addSEs [Atleast_succI]) 1);  (*41 secs*)
clasohm@0
   169
val Clique_succ = result();
clasohm@0
   170
clasohm@0
   171
(** Induction step **)
clasohm@0
   172
clasohm@0
   173
(*Published proofs gloss over the need for Ramsey numbers to be POSITIVE.*)
clasohm@0
   174
val ram1::ram2::prems = goalw Ramsey.thy [Ramsey_def] 
clasohm@0
   175
   "[| Ramsey(succ(m), succ(i), j);  Ramsey(n, i, succ(j));  \
clasohm@0
   176
\      m: nat;  n: nat |] ==> \
clasohm@0
   177
\   Ramsey(succ(m#+n), succ(i), succ(j))";
clasohm@0
   178
by (safe_tac ZF_cs);
clasohm@0
   179
by (etac (Atleast_succD RS bexE) 1);
clasohm@0
   180
by (eres_inst_tac [("P1","%z.<x,z>:E")] (Atleast_partition RS disjE) 1);
clasohm@0
   181
by (REPEAT (resolve_tac prems 1));
clasohm@0
   182
(*case m*)
clasohm@0
   183
by (rtac (ram1 RS spec RS spec RS mp RS disjE) 1);
clasohm@0
   184
by (fast_tac ZF_cs 1);
clasohm@0
   185
by (fast_tac (ZF_cs addEs [Clique_superset]) 1); (*easy -- given a Clique*)
clasohm@0
   186
by (safe_tac ZF_cs);
clasohm@0
   187
by (eresolve_tac (swapify [exI]) 1);		 (*ignore main EX quantifier*)
clasohm@0
   188
by (REPEAT (ares_tac [Indept_succ] 1));  	 (*make a bigger Indept*)
clasohm@0
   189
(*case n*)
clasohm@0
   190
by (rtac (ram2 RS spec RS spec RS mp RS disjE) 1);
clasohm@0
   191
by (fast_tac ZF_cs 1);
clasohm@0
   192
by (safe_tac ZF_cs);
clasohm@0
   193
by (rtac exI 1);
clasohm@0
   194
by (REPEAT (ares_tac [Clique_succ] 1));  	 (*make a bigger Clique*)
clasohm@0
   195
by (fast_tac (ZF_cs addEs [Indept_superset]) 1); (*easy -- given an Indept*)
clasohm@0
   196
val Ramsey_step_lemma = result();
clasohm@0
   197
clasohm@0
   198
clasohm@0
   199
(** The actual proof **)
clasohm@0
   200
clasohm@0
   201
(*Again, the induction requires Ramsey numbers to be positive.*)
clasohm@0
   202
val prems = goal Ramsey.thy
clasohm@0
   203
    "i: nat ==> ALL j: nat. EX n:nat. Ramsey(succ(n), i, j)";
clasohm@0
   204
by (nat_ind_tac "i" prems 1);
clasohm@0
   205
by (fast_tac (ZF_cs addSIs [nat_0I,Ramsey0j]) 1);
clasohm@0
   206
by (rtac ballI 1);
clasohm@0
   207
by (nat_ind_tac "j" [] 1);
clasohm@0
   208
by (fast_tac (ZF_cs addSIs [nat_0I,Ramseyi0]) 1);
clasohm@0
   209
by (dres_inst_tac [("x","succ(j1)")] bspec 1);
clasohm@0
   210
by (REPEAT (eresolve_tac [nat_succI,bexE] 1));
clasohm@0
   211
by (rtac bexI 1);
clasohm@0
   212
by (rtac Ramsey_step_lemma 1);
clasohm@0
   213
by (REPEAT (ares_tac [nat_succI,add_type] 1));
clasohm@0
   214
val ramsey_lemma = result();
clasohm@0
   215
clasohm@0
   216
(*Final statement in a tidy form, without succ(...) *)
clasohm@0
   217
val prems = goal Ramsey.thy
clasohm@0
   218
    "[| i: nat;  j: nat |] ==> EX n:nat. Ramsey(n,i,j)";
clasohm@0
   219
by (rtac (ramsey_lemma RS bspec RS bexE) 1);
clasohm@0
   220
by (etac bexI 3);
clasohm@0
   221
by (REPEAT (ares_tac (prems@[nat_succI]) 1));
clasohm@0
   222
val ramsey = result();
clasohm@0
   223
clasohm@0
   224
(*Computer Ramsey numbers according to proof above -- which, actually,
clasohm@0
   225
  does not constrain the base case values at all!*)
clasohm@0
   226
fun ram 0 j = 1
clasohm@0
   227
  | ram i 0 = 1
clasohm@0
   228
  | ram i j = ram (i-1) j + ram i (j-1);
clasohm@0
   229
clasohm@0
   230
(*Previous proof gave the following Ramsey numbers, which are smaller than
clasohm@0
   231
  those above by one!*)
clasohm@0
   232
fun ram' 0 j = 0
clasohm@0
   233
  | ram' i 0 = 0
clasohm@0
   234
  | ram' i j = ram' (i-1) j + ram' i (j-1) + 1;