author | berghofe |
Fri, 16 Jul 1999 14:03:03 +0200 | |
changeset 7018 | ae18bb3075c3 |
parent 5628 | 15b7f12ad919 |
child 7401 | e355f626b2f9 |
permissions | -rw-r--r-- |
3423 | 1 |
(* Title: HOL/Induct/Mutil |
3120
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
2 |
ID: $Id$ |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
3 |
Author: Lawrence C Paulson, Cambridge University Computer Laboratory |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
4 |
Copyright 1996 University of Cambridge |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
5 |
|
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
6 |
The Mutilated Chess Board Problem, formalized inductively |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
7 |
*) |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
8 |
|
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
9 |
Addsimps tiling.intrs; |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
10 |
|
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
11 |
(** The union of two disjoint tilings is a tiling **) |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
12 |
|
5490 | 13 |
Goal "t: tiling A ==> u: tiling A --> t Int u = {} --> t Un u : tiling A"; |
3120
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
14 |
by (etac tiling.induct 1); |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
15 |
by (Simp_tac 1); |
4089 | 16 |
by (simp_tac (simpset() addsimps [Un_assoc]) 1); |
17 |
by (blast_tac (claset() addIs tiling.intrs) 1); |
|
3120
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
18 |
qed_spec_mp "tiling_UnI"; |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
19 |
|
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
20 |
|
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
21 |
(*** Chess boards ***) |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
22 |
|
5069 | 23 |
Goalw [below_def] "(i: below k) = (i<k)"; |
3120
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
24 |
by (Blast_tac 1); |
3423 | 25 |
qed "below_less_iff"; |
26 |
AddIffs [below_less_iff]; |
|
3120
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
27 |
|
5069 | 28 |
Goalw [below_def] "below 0 = {}"; |
3423 | 29 |
by (Simp_tac 1); |
30 |
qed "below_0"; |
|
31 |
Addsimps [below_0]; |
|
3120
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
32 |
|
5069 | 33 |
Goalw [below_def] |
3423 | 34 |
"below(Suc n) Times B = ({n} Times B) Un ((below n) Times B)"; |
4089 | 35 |
by (simp_tac (simpset() addsimps [less_Suc_eq]) 1); |
3120
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
36 |
by (Blast_tac 1); |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
37 |
qed "Sigma_Suc1"; |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
38 |
|
5069 | 39 |
Goalw [below_def] |
3423 | 40 |
"A Times below(Suc n) = (A Times {n}) Un (A Times (below n))"; |
4089 | 41 |
by (simp_tac (simpset() addsimps [less_Suc_eq]) 1); |
3120
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
42 |
by (Blast_tac 1); |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
43 |
qed "Sigma_Suc2"; |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
44 |
|
5069 | 45 |
Goal "{i} Times below(n+n) : tiling domino"; |
5184 | 46 |
by (induct_tac "n" 1); |
4089 | 47 |
by (ALLGOALS (asm_simp_tac (simpset() addsimps [Un_assoc RS sym, Sigma_Suc2]))); |
3120
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
48 |
by (resolve_tac tiling.intrs 1); |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
49 |
by (assume_tac 2); |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
50 |
by (subgoal_tac (*seems the easiest way of turning one to the other*) |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
51 |
"({i} Times {Suc(n+n)}) Un ({i} Times {n+n}) = \ |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
52 |
\ {(i, n+n), (i, Suc(n+n))}" 1); |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
53 |
by (Blast_tac 2); |
4089 | 54 |
by (asm_simp_tac (simpset() addsimps [domino.horiz]) 1); |
4477
b3e5857d8d99
New Auto_tac (by Oheimb), and new syntax (without parens), and expandshort
paulson
parents:
4387
diff
changeset
|
55 |
by Auto_tac; |
3120
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
56 |
qed "dominoes_tile_row"; |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
57 |
|
5069 | 58 |
Goal "(below m) Times below(n+n) : tiling domino"; |
5184 | 59 |
by (induct_tac "m" 1); |
4089 | 60 |
by (ALLGOALS (asm_simp_tac (simpset() addsimps [Sigma_Suc1]))); |
61 |
by (blast_tac (claset() addSIs [tiling_UnI, dominoes_tile_row] |
|
5490 | 62 |
addSEs [below_less_iff RS iffD1 RS less_irrefl]) 1); |
3120
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
63 |
qed "dominoes_tile_matrix"; |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
64 |
|
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
65 |
|
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
66 |
(*** Basic properties of evnodd ***) |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
67 |
|
5069 | 68 |
Goalw [evnodd_def] "(i,j): evnodd A b = ((i,j): A & (i+j) mod 2 = b)"; |
3120
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
69 |
by (Simp_tac 1); |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
70 |
qed "evnodd_iff"; |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
71 |
|
5069 | 72 |
Goalw [evnodd_def] "evnodd A b <= A"; |
3120
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
73 |
by (rtac Int_lower1 1); |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
74 |
qed "evnodd_subset"; |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
75 |
|
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
76 |
(* finite X ==> finite(evnodd X b) *) |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
77 |
bind_thm("finite_evnodd", evnodd_subset RS finite_subset); |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
78 |
|
5069 | 79 |
Goalw [evnodd_def] "evnodd (A Un B) b = evnodd A b Un evnodd B b"; |
3120
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
80 |
by (Blast_tac 1); |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
81 |
qed "evnodd_Un"; |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
82 |
|
5069 | 83 |
Goalw [evnodd_def] "evnodd (A - B) b = evnodd A b - evnodd B b"; |
3120
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
84 |
by (Blast_tac 1); |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
85 |
qed "evnodd_Diff"; |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
86 |
|
5069 | 87 |
Goalw [evnodd_def] "evnodd {} b = {}"; |
3120
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
88 |
by (Simp_tac 1); |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
89 |
qed "evnodd_empty"; |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
90 |
|
5069 | 91 |
Goalw [evnodd_def] |
3120
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
92 |
"evnodd (insert (i,j) C) b = \ |
3423 | 93 |
\ (if (i+j) mod 2 = b then insert (i,j) (evnodd C b) else evnodd C b)"; |
4686 | 94 |
by (Simp_tac 1); |
3718 | 95 |
by (Blast_tac 1); |
3120
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
96 |
qed "evnodd_insert"; |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
97 |
|
3423 | 98 |
Addsimps [finite_evnodd, evnodd_Un, evnodd_Diff, evnodd_empty, evnodd_insert]; |
99 |
||
3120
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
100 |
|
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
101 |
(*** Dominoes ***) |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
102 |
|
5143
b94cd208f073
Removal of leading "\!\!..." from most Goal commands
paulson
parents:
5069
diff
changeset
|
103 |
Goal "[| d:domino; b<2 |] ==> EX i j. evnodd d b = {(i,j)}"; |
3120
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
104 |
by (eresolve_tac [domino.elim] 1); |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
105 |
by (res_inst_tac [("k1", "i+j")] (mod2_cases RS disjE) 2); |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
106 |
by (res_inst_tac [("k1", "i+j")] (mod2_cases RS disjE) 1); |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
107 |
by (REPEAT_FIRST assume_tac); |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
108 |
(*Four similar cases: case (i+j) mod 2 = b, 2#-b, ...*) |
4686 | 109 |
by (REPEAT (asm_full_simp_tac (simpset() addsimps [less_Suc_eq, mod_Suc]) 1 |
3120
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
110 |
THEN Blast_tac 1)); |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
111 |
qed "domino_singleton"; |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
112 |
|
5143
b94cd208f073
Removal of leading "\!\!..." from most Goal commands
paulson
parents:
5069
diff
changeset
|
113 |
Goal "d:domino ==> finite d"; |
4089 | 114 |
by (blast_tac (claset() addSEs [domino.elim]) 1); |
3120
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
115 |
qed "domino_finite"; |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
116 |
|
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
117 |
|
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
118 |
(*** Tilings of dominoes ***) |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
119 |
|
5143
b94cd208f073
Removal of leading "\!\!..." from most Goal commands
paulson
parents:
5069
diff
changeset
|
120 |
Goal "t:tiling domino ==> finite t"; |
3120
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
121 |
by (eresolve_tac [tiling.induct] 1); |
3414
804c8a178a7f
Modified a few defs and proofs because of the changes to theory Finite.thy.
nipkow
parents:
3357
diff
changeset
|
122 |
by (rtac Finites.emptyI 1); |
4089 | 123 |
by (blast_tac (claset() addSIs [finite_UnI] addIs [domino_finite]) 1); |
3120
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
124 |
qed "tiling_domino_finite"; |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
125 |
|
5143
b94cd208f073
Removal of leading "\!\!..." from most Goal commands
paulson
parents:
5069
diff
changeset
|
126 |
Goal "t: tiling domino ==> card(evnodd t 0) = card(evnodd t 1)"; |
3120
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
127 |
by (eresolve_tac [tiling.induct] 1); |
4089 | 128 |
by (simp_tac (simpset() addsimps [evnodd_def]) 1); |
3120
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
129 |
by (res_inst_tac [("b1","0")] (domino_singleton RS exE) 1); |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
130 |
by (Simp_tac 2 THEN assume_tac 1); |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
131 |
by (res_inst_tac [("b1","1")] (domino_singleton RS exE) 1); |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
132 |
by (Simp_tac 2 THEN assume_tac 1); |
3718 | 133 |
by (Clarify_tac 1); |
5143
b94cd208f073
Removal of leading "\!\!..." from most Goal commands
paulson
parents:
5069
diff
changeset
|
134 |
by (subgoal_tac "ALL p b. p : evnodd a b --> p ~: evnodd t b" 1); |
4089 | 135 |
by (asm_simp_tac (simpset() addsimps [tiling_domino_finite]) 1); |
4387 | 136 |
by (blast_tac (claset() addSDs [evnodd_subset RS subsetD] |
137 |
addEs [equalityE]) 1); |
|
3120
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
138 |
qed "tiling_domino_0_1"; |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
139 |
|
4387 | 140 |
(*Final argument is surprisingly complex. Note the use of small simpsets |
141 |
to avoid moving Sucs, etc.*) |
|
5143
b94cd208f073
Removal of leading "\!\!..." from most Goal commands
paulson
parents:
5069
diff
changeset
|
142 |
Goal "[| t = below(Suc m + Suc m) Times below(Suc n + Suc n); \ |
5419 | 143 |
\ t' = t - {(0,0)} - {(Suc(m+m), Suc(n+n))} \ |
144 |
\ |] ==> t' ~: tiling domino"; |
|
3120
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
145 |
by (rtac notI 1); |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
146 |
by (subgoal_tac "card(evnodd t' 0) < card(evnodd t' 1)" 1); |
4387 | 147 |
by (asm_full_simp_tac (HOL_ss addsimps [less_not_refl, tiling_domino_0_1]) 1); |
3120
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
148 |
by (subgoal_tac "t : tiling domino" 1); |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
149 |
by (asm_simp_tac (HOL_ss addsimps [dominoes_tile_matrix]) 2); |
4387 | 150 |
by (asm_full_simp_tac (simpset() |
151 |
addsimps [mod_less, tiling_domino_0_1 RS sym]) 1); |
|
152 |
(*Cardinality is smaller because of the two elements fewer*) |
|
3120
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
153 |
by (rtac less_trans 1); |
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
154 |
by (REPEAT |
5628 | 155 |
(rtac card_Diff1_less 1 |
4089 | 156 |
THEN asm_simp_tac (simpset() addsimps [tiling_domino_finite]) 1 |
157 |
THEN asm_simp_tac (simpset() addsimps [mod_less, evnodd_iff]) 1)); |
|
3120
c58423c20740
New directory to contain examples of (co)inductive definitions
paulson
parents:
diff
changeset
|
158 |
qed "mutil_not_tiling"; |