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