1621
|
1 |
(* Title: HOL/ex/Mutil
|
|
2 |
ID: $Id$
|
|
3 |
Author: Lawrence C Paulson, Cambridge University Computer Laboratory
|
|
4 |
Copyright 1996 University of Cambridge
|
|
5 |
|
|
6 |
The Mutilated Checkerboard Problem, formalized inductively
|
|
7 |
*)
|
|
8 |
|
|
9 |
open Mutil;
|
|
10 |
|
|
11 |
(*SHOULD NOT BE NECESSARY!*)
|
|
12 |
Addsimps [ball_rew,mem_Sigma_iff];
|
|
13 |
|
|
14 |
(** Basic properties of evnodd **)
|
|
15 |
|
|
16 |
goalw thy [evnodd_def]
|
|
17 |
"(i,j): evnodd A b = ((i,j): A & (i+j) mod 2 = b)";
|
|
18 |
by (Simp_tac 1);
|
|
19 |
qed "evnodd_iff";
|
|
20 |
|
|
21 |
goalw thy [evnodd_def] "evnodd A b <= A";
|
|
22 |
by (rtac Int_lower1 1);
|
|
23 |
qed "evnodd_subset";
|
|
24 |
|
|
25 |
(* finite X ==> finite(evnodd X b) *)
|
|
26 |
bind_thm("finite_evnodd", evnodd_subset RS finite_subset);
|
|
27 |
|
|
28 |
goalw thy [evnodd_def] "evnodd (A Un B) b = evnodd A b Un evnodd B b";
|
|
29 |
by (fast_tac eq_cs 1);
|
|
30 |
qed "evnodd_Un";
|
|
31 |
|
|
32 |
goalw thy [evnodd_def] "evnodd (A - B) b = evnodd A b - evnodd B b";
|
|
33 |
by (fast_tac eq_cs 1);
|
|
34 |
qed "evnodd_Diff";
|
|
35 |
|
|
36 |
goalw thy [evnodd_def]
|
|
37 |
"evnodd (insert (i,j) C) b = \
|
|
38 |
\ (if (i+j) mod 2 = b then insert (i,j) (evnodd C b) else evnodd C b)";
|
|
39 |
by (asm_full_simp_tac (!simpset addsimps [evnodd_def]
|
|
40 |
setloop (split_tac [expand_if] THEN' step_tac eq_cs)) 1);
|
|
41 |
qed "evnodd_insert";
|
|
42 |
|
|
43 |
goalw thy [evnodd_def] "evnodd {} b = {}";
|
|
44 |
by (Simp_tac 1);
|
|
45 |
qed "evnodd_empty";
|
|
46 |
|
|
47 |
|
|
48 |
(*** Dominoes ***)
|
|
49 |
|
|
50 |
goal thy "!!d. d:domino ==> finite d";
|
|
51 |
by (fast_tac (set_cs addSIs [finite_insertI, finite_emptyI] addEs [domino.elim]) 1);
|
|
52 |
qed "domino_finite";
|
|
53 |
|
|
54 |
goal thy "!!d. [| d:domino; b<2 |] ==> EX i' j'. evnodd d b = {(i',j')}";
|
|
55 |
by (eresolve_tac [domino.elim] 1);
|
|
56 |
by (res_inst_tac [("k1", "i+j")] (mod2_cases RS disjE) 2);
|
|
57 |
by (res_inst_tac [("k1", "i+j")] (mod2_cases RS disjE) 1);
|
|
58 |
by (REPEAT_FIRST assume_tac);
|
|
59 |
(*Four similar cases: case (i+j) mod 2 = b, 2#-b, ...*)
|
|
60 |
by (REPEAT (asm_simp_tac (!simpset addsimps
|
1626
|
61 |
[evnodd_insert, evnodd_empty, mod_Suc]
|
1621
|
62 |
setloop split_tac [expand_if]) 1
|
|
63 |
THEN fast_tac less_cs 1));
|
|
64 |
qed "domino_singleton";
|
|
65 |
|
|
66 |
|
|
67 |
(*** Tilings ***)
|
|
68 |
|
|
69 |
(** The union of two disjoint tilings is a tiling **)
|
|
70 |
|
|
71 |
goal thy "!!t. t: tiling A ==> \
|
1633
|
72 |
\ u: tiling A --> t Int u = {} --> t Un u : tiling A";
|
1621
|
73 |
by (etac tiling.induct 1);
|
|
74 |
by (simp_tac (!simpset addsimps tiling.intrs) 1);
|
1633
|
75 |
by (fast_tac (set_cs addIs tiling.intrs
|
|
76 |
addss (HOL_ss addsimps [Un_assoc,
|
|
77 |
subset_empty_iff RS sym])) 1);
|
|
78 |
bind_thm ("tiling_UnI", result() RS mp RS mp);
|
1621
|
79 |
|
|
80 |
goal thy "!!t. t:tiling domino ==> finite t";
|
|
81 |
by (eresolve_tac [tiling.induct] 1);
|
|
82 |
by (rtac finite_emptyI 1);
|
|
83 |
by (fast_tac (set_cs addIs [domino_finite, finite_UnI]) 1);
|
|
84 |
qed "tiling_domino_finite";
|
|
85 |
|
|
86 |
goal thy "!!t. t: tiling domino ==> card(evnodd t 0) = card(evnodd t 1)";
|
|
87 |
by (eresolve_tac [tiling.induct] 1);
|
|
88 |
by (simp_tac (!simpset addsimps [evnodd_def]) 1);
|
|
89 |
by (res_inst_tac [("b1","0")] (domino_singleton RS exE) 1);
|
|
90 |
by (Simp_tac 2 THEN assume_tac 1);
|
|
91 |
by (res_inst_tac [("b1","1")] (domino_singleton RS exE) 1);
|
|
92 |
by (Simp_tac 2 THEN assume_tac 1);
|
|
93 |
by (step_tac HOL_cs 1);
|
|
94 |
by (subgoal_tac "ALL p b. p : evnodd a b --> p ~: evnodd ta b" 1);
|
|
95 |
by (asm_simp_tac (!simpset addsimps [evnodd_Un, Un_insert_left,
|
|
96 |
tiling_domino_finite,
|
|
97 |
evnodd_subset RS finite_subset,
|
|
98 |
card_insert_disjoint]) 1);
|
|
99 |
by (fast_tac (set_cs addSDs [evnodd_subset RS subsetD] addEs [equalityE]) 1);
|
|
100 |
qed "tiling_domino_0_1";
|
|
101 |
|
|
102 |
|
|
103 |
val [below_0, below_Suc] = nat_recs below_def;
|
|
104 |
Addsimps [below_0];
|
1626
|
105 |
(*below_Suc should NOT be added, or Sigma_Suc1,2 cannot be used*)
|
1621
|
106 |
|
|
107 |
goal thy "(i: below k) = (i<k)";
|
|
108 |
by (res_inst_tac [("x", "i")] spec 1);
|
|
109 |
by (nat_ind_tac "k" 1);
|
|
110 |
by (Simp_tac 1);
|
|
111 |
by (asm_simp_tac (!simpset addsimps [below_Suc]) 1);
|
|
112 |
by (fast_tac set_cs 1);
|
|
113 |
qed "below_less_iff";
|
|
114 |
|
1642
|
115 |
goal thy "(below (Suc n)) Times B = ({n} Times B) Un ((below n) Times B)";
|
1621
|
116 |
by (simp_tac (!simpset addsimps [below_Suc]) 1);
|
|
117 |
by (fast_tac (prod_cs addIs [equalityI]) 1);
|
|
118 |
qed "Sigma_Suc1";
|
|
119 |
|
1642
|
120 |
goal thy "A Times (below (Suc n)) = (A Times {n}) Un (A Times (below n))";
|
1621
|
121 |
by (simp_tac (!simpset addsimps [below_Suc]) 1);
|
|
122 |
by (fast_tac (prod_cs addIs [equalityI]) 1);
|
|
123 |
qed "Sigma_Suc2";
|
|
124 |
|
1642
|
125 |
goal thy "{i} Times (below (n + n)) : tiling domino";
|
1621
|
126 |
by (nat_ind_tac "n" 1);
|
|
127 |
by (simp_tac (!simpset addsimps tiling.intrs) 1);
|
|
128 |
by (asm_simp_tac (!simpset addsimps [Un_assoc RS sym, Sigma_Suc2]) 1);
|
|
129 |
by (resolve_tac tiling.intrs 1);
|
|
130 |
by (assume_tac 2);
|
|
131 |
by (subgoal_tac (*seems the easiest way of turning one to the other*)
|
1642
|
132 |
"({i} Times {Suc(n1+n1)}) Un ({i} Times {n1+n1}) = \
|
1621
|
133 |
\ {(i, n1+n1), (i, Suc(n1+n1))}" 1);
|
|
134 |
by (fast_tac (prod_cs addIs [equalityI]) 2);
|
|
135 |
by (asm_simp_tac (!simpset addsimps [domino.horiz]) 1);
|
|
136 |
by (fast_tac (prod_cs addIs [equalityI, lessI] addEs [less_irrefl, less_asym]
|
|
137 |
addDs [below_less_iff RS iffD1]) 1);
|
|
138 |
qed "dominoes_tile_row";
|
|
139 |
|
1642
|
140 |
goal thy "(below m) Times (below (n + n)) : tiling domino";
|
1621
|
141 |
by (nat_ind_tac "m" 1);
|
|
142 |
by (simp_tac (!simpset addsimps (below_0::tiling.intrs)) 1);
|
|
143 |
by (asm_simp_tac (!simpset addsimps [Sigma_Suc1]) 1);
|
|
144 |
by (fast_tac (prod_cs addIs [equalityI, tiling_UnI, dominoes_tile_row]
|
|
145 |
addEs [below_less_iff RS iffD1 RS less_irrefl]) 1);
|
|
146 |
qed "dominoes_tile_matrix";
|
|
147 |
|
|
148 |
|
1642
|
149 |
goal thy "!!m n. [| t = (below (Suc m + Suc m)) Times \
|
|
150 |
\ (below (Suc n + Suc n)); \
|
1621
|
151 |
\ t' = t - {(0,0)} - {(Suc(m+m), Suc(n+n))} \
|
|
152 |
\ |] ==> t' ~: tiling domino";
|
|
153 |
by (rtac notI 1);
|
|
154 |
by (dtac tiling_domino_0_1 1);
|
|
155 |
by (subgoal_tac "card(evnodd t' 0) < card(evnodd t' 1)" 1);
|
|
156 |
by (Asm_full_simp_tac 1);
|
|
157 |
by (subgoal_tac "t : tiling domino" 1);
|
|
158 |
(*Requires a small simpset that won't move the Suc applications*)
|
|
159 |
by (asm_simp_tac (HOL_ss addsimps [dominoes_tile_matrix]) 2);
|
|
160 |
by (subgoal_tac "(m+m)+(n+n) = (m+n)+(m+n)" 1);
|
|
161 |
by (asm_simp_tac (!simpset addsimps add_ac) 2);
|
|
162 |
by (asm_full_simp_tac
|
|
163 |
(!simpset addsimps [evnodd_Diff, evnodd_insert, evnodd_empty,
|
|
164 |
mod_less, tiling_domino_0_1 RS sym]) 1);
|
|
165 |
by (rtac less_trans 1);
|
|
166 |
by (REPEAT
|
|
167 |
(rtac card_Diff 1
|
|
168 |
THEN
|
|
169 |
asm_simp_tac (!simpset addsimps [tiling_domino_finite, finite_evnodd]) 1
|
|
170 |
THEN
|
|
171 |
asm_simp_tac (!simpset addsimps [mod_less, evnodd_iff, below_less_iff]) 1));
|
|
172 |
qed "mutil_not_tiling";
|
|
173 |
|