74 lemma Sigma_Suc1: |
74 lemma Sigma_Suc1: |
75 "m = n + 1 ==> below m <*> B = ({n} <*> B) Un (below n <*> B)" |
75 "m = n + 1 ==> below m <*> B = ({n} <*> B) Un (below n <*> B)" |
76 by (simp add: below_def less_Suc_eq) blast |
76 by (simp add: below_def less_Suc_eq) blast |
77 |
77 |
78 lemma Sigma_Suc2: |
78 lemma Sigma_Suc2: |
79 "m = n + # 2 ==> A <*> below m = |
79 "m = n + 2 ==> A <*> below m = |
80 (A <*> {n}) Un (A <*> {n + 1}) Un (A <*> below n)" |
80 (A <*> {n}) Un (A <*> {n + 1}) Un (A <*> below n)" |
81 by (auto simp add: below_def) arith |
81 by (auto simp add: below_def) arith |
82 |
82 |
83 lemmas Sigma_Suc = Sigma_Suc1 Sigma_Suc2 |
83 lemmas Sigma_Suc = Sigma_Suc1 Sigma_Suc2 |
84 |
84 |
85 |
85 |
86 subsection {* Basic properties of ``evnodd'' *} |
86 subsection {* Basic properties of ``evnodd'' *} |
87 |
87 |
88 constdefs |
88 constdefs |
89 evnodd :: "(nat * nat) set => nat => (nat * nat) set" |
89 evnodd :: "(nat * nat) set => nat => (nat * nat) set" |
90 "evnodd A b == A Int {(i, j). (i + j) mod # 2 = b}" |
90 "evnodd A b == A Int {(i, j). (i + j) mod 2 = b}" |
91 |
91 |
92 lemma evnodd_iff: |
92 lemma evnodd_iff: |
93 "(i, j): evnodd A b = ((i, j): A & (i + j) mod # 2 = b)" |
93 "(i, j): evnodd A b = ((i, j): A & (i + j) mod 2 = b)" |
94 by (simp add: evnodd_def) |
94 by (simp add: evnodd_def) |
95 |
95 |
96 lemma evnodd_subset: "evnodd A b <= A" |
96 lemma evnodd_subset: "evnodd A b <= A" |
97 by (unfold evnodd_def, rule Int_lower1) |
97 by (unfold evnodd_def, rule Int_lower1) |
98 |
98 |
110 |
110 |
111 lemma evnodd_empty: "evnodd {} b = {}" |
111 lemma evnodd_empty: "evnodd {} b = {}" |
112 by (simp add: evnodd_def) |
112 by (simp add: evnodd_def) |
113 |
113 |
114 lemma evnodd_insert: "evnodd (insert (i, j) C) b = |
114 lemma evnodd_insert: "evnodd (insert (i, j) C) b = |
115 (if (i + j) mod # 2 = b |
115 (if (i + j) mod 2 = b |
116 then insert (i, j) (evnodd C b) else evnodd C b)" |
116 then insert (i, j) (evnodd C b) else evnodd C b)" |
117 by (simp add: evnodd_def) blast |
117 by (simp add: evnodd_def) blast |
118 |
118 |
119 |
119 |
120 subsection {* Dominoes *} |
120 subsection {* Dominoes *} |
126 intros |
126 intros |
127 horiz: "{(i, j), (i, j + 1)} : domino" |
127 horiz: "{(i, j), (i, j + 1)} : domino" |
128 vertl: "{(i, j), (i + 1, j)} : domino" |
128 vertl: "{(i, j), (i + 1, j)} : domino" |
129 |
129 |
130 lemma dominoes_tile_row: |
130 lemma dominoes_tile_row: |
131 "{i} <*> below (# 2 * n) : tiling domino" |
131 "{i} <*> below (2 * n) : tiling domino" |
132 (is "?P n" is "?B n : ?T") |
132 (is "?P n" is "?B n : ?T") |
133 proof (induct n) |
133 proof (induct n) |
134 show "?P 0" by (simp add: below_0 tiling.empty) |
134 show "?P 0" by (simp add: below_0 tiling.empty) |
135 |
135 |
136 fix n assume hyp: "?P n" |
136 fix n assume hyp: "?P n" |
137 let ?a = "{i} <*> {# 2 * n + 1} Un {i} <*> {# 2 * n}" |
137 let ?a = "{i} <*> {2 * n + 1} Un {i} <*> {2 * n}" |
138 |
138 |
139 have "?B (Suc n) = ?a Un ?B n" |
139 have "?B (Suc n) = ?a Un ?B n" |
140 by (auto simp add: Sigma_Suc Un_assoc) |
140 by (auto simp add: Sigma_Suc Un_assoc) |
141 also have "... : ?T" |
141 also have "... : ?T" |
142 proof (rule tiling.Un) |
142 proof (rule tiling.Un) |
143 have "{(i, # 2 * n), (i, # 2 * n + 1)} : domino" |
143 have "{(i, 2 * n), (i, 2 * n + 1)} : domino" |
144 by (rule domino.horiz) |
144 by (rule domino.horiz) |
145 also have "{(i, # 2 * n), (i, # 2 * n + 1)} = ?a" by blast |
145 also have "{(i, 2 * n), (i, 2 * n + 1)} = ?a" by blast |
146 finally show "... : domino" . |
146 finally show "... : domino" . |
147 from hyp show "?B n : ?T" . |
147 from hyp show "?B n : ?T" . |
148 show "?a <= - ?B n" by blast |
148 show "?a <= - ?B n" by blast |
149 qed |
149 qed |
150 finally show "?P (Suc n)" . |
150 finally show "?P (Suc n)" . |
151 qed |
151 qed |
152 |
152 |
153 lemma dominoes_tile_matrix: |
153 lemma dominoes_tile_matrix: |
154 "below m <*> below (# 2 * n) : tiling domino" |
154 "below m <*> below (2 * n) : tiling domino" |
155 (is "?P m" is "?B m : ?T") |
155 (is "?P m" is "?B m : ?T") |
156 proof (induct m) |
156 proof (induct m) |
157 show "?P 0" by (simp add: below_0 tiling.empty) |
157 show "?P 0" by (simp add: below_0 tiling.empty) |
158 |
158 |
159 fix m assume hyp: "?P m" |
159 fix m assume hyp: "?P m" |
160 let ?t = "{m} <*> below (# 2 * n)" |
160 let ?t = "{m} <*> below (2 * n)" |
161 |
161 |
162 have "?B (Suc m) = ?t Un ?B m" by (simp add: Sigma_Suc) |
162 have "?B (Suc m) = ?t Un ?B m" by (simp add: Sigma_Suc) |
163 also have "... : ?T" |
163 also have "... : ?T" |
164 proof (rule tiling_Un) |
164 proof (rule tiling_Un) |
165 show "?t : ?T" by (rule dominoes_tile_row) |
165 show "?t : ?T" by (rule dominoes_tile_row) |
225 assume "a : domino" and "t : ?T" |
225 assume "a : domino" and "t : ?T" |
226 and hyp: "card (?e t 0) = card (?e t 1)" |
226 and hyp: "card (?e t 0) = card (?e t 1)" |
227 and at: "a <= - t" |
227 and at: "a <= - t" |
228 |
228 |
229 have card_suc: |
229 have card_suc: |
230 "!!b. b < # 2 ==> card (?e (a Un t) b) = Suc (card (?e t b))" |
230 "!!b. b < 2 ==> card (?e (a Un t) b) = Suc (card (?e t b))" |
231 proof - |
231 proof - |
232 fix b :: nat assume "b < # 2" |
232 fix b :: nat assume "b < 2" |
233 have "?e (a Un t) b = ?e a b Un ?e t b" by (rule evnodd_Un) |
233 have "?e (a Un t) b = ?e a b Un ?e t b" by (rule evnodd_Un) |
234 also obtain i j where e: "?e a b = {(i, j)}" |
234 also obtain i j where e: "?e a b = {(i, j)}" |
235 proof - |
235 proof - |
236 have "EX i j. ?e a b = {(i, j)}" by (rule domino_singleton) |
236 have "EX i j. ?e a b = {(i, j)}" by (rule domino_singleton) |
237 thus ?thesis by (blast intro: that) |
237 thus ?thesis by (blast intro: that) |
258 subsection {* Main theorem *} |
258 subsection {* Main theorem *} |
259 |
259 |
260 constdefs |
260 constdefs |
261 mutilated_board :: "nat => nat => (nat * nat) set" |
261 mutilated_board :: "nat => nat => (nat * nat) set" |
262 "mutilated_board m n == |
262 "mutilated_board m n == |
263 below (# 2 * (m + 1)) <*> below (# 2 * (n + 1)) |
263 below (2 * (m + 1)) <*> below (2 * (n + 1)) |
264 - {(0, 0)} - {(# 2 * m + 1, # 2 * n + 1)}" |
264 - {(0, 0)} - {(2 * m + 1, 2 * n + 1)}" |
265 |
265 |
266 theorem mutil_not_tiling: "mutilated_board m n ~: tiling domino" |
266 theorem mutil_not_tiling: "mutilated_board m n ~: tiling domino" |
267 proof (unfold mutilated_board_def) |
267 proof (unfold mutilated_board_def) |
268 let ?T = "tiling domino" |
268 let ?T = "tiling domino" |
269 let ?t = "below (# 2 * (m + 1)) <*> below (# 2 * (n + 1))" |
269 let ?t = "below (2 * (m + 1)) <*> below (2 * (n + 1))" |
270 let ?t' = "?t - {(0, 0)}" |
270 let ?t' = "?t - {(0, 0)}" |
271 let ?t'' = "?t' - {(# 2 * m + 1, # 2 * n + 1)}" |
271 let ?t'' = "?t' - {(2 * m + 1, 2 * n + 1)}" |
272 |
272 |
273 show "?t'' ~: ?T" |
273 show "?t'' ~: ?T" |
274 proof |
274 proof |
275 have t: "?t : ?T" by (rule dominoes_tile_matrix) |
275 have t: "?t : ?T" by (rule dominoes_tile_matrix) |
276 assume t'': "?t'' : ?T" |
276 assume t'': "?t'' : ?T" |
280 by (rule evnodd_finite, rule tiling_domino_finite, rule t) |
280 by (rule evnodd_finite, rule tiling_domino_finite, rule t) |
281 |
281 |
282 note [simp] = evnodd_iff evnodd_empty evnodd_insert evnodd_Diff |
282 note [simp] = evnodd_iff evnodd_empty evnodd_insert evnodd_Diff |
283 have "card (?e ?t'' 0) < card (?e ?t' 0)" |
283 have "card (?e ?t'' 0) < card (?e ?t' 0)" |
284 proof - |
284 proof - |
285 have "card (?e ?t' 0 - {(# 2 * m + 1, # 2 * n + 1)}) |
285 have "card (?e ?t' 0 - {(2 * m + 1, 2 * n + 1)}) |
286 < card (?e ?t' 0)" |
286 < card (?e ?t' 0)" |
287 proof (rule card_Diff1_less) |
287 proof (rule card_Diff1_less) |
288 from _ fin show "finite (?e ?t' 0)" |
288 from _ fin show "finite (?e ?t' 0)" |
289 by (rule finite_subset) auto |
289 by (rule finite_subset) auto |
290 show "(# 2 * m + 1, # 2 * n + 1) : ?e ?t' 0" by simp |
290 show "(2 * m + 1, 2 * n + 1) : ?e ?t' 0" by simp |
291 qed |
291 qed |
292 thus ?thesis by simp |
292 thus ?thesis by simp |
293 qed |
293 qed |
294 also have "... < card (?e ?t 0)" |
294 also have "... < card (?e ?t 0)" |
295 proof - |
295 proof - |