src/HOL/Isar_Examples/Mutilated_Checkerboard.thy
changeset 37671 fa53d267dab3
parent 35416 d8d7d1b785af
child 40880 be44a567ed28
--- a/src/HOL/Isar_Examples/Mutilated_Checkerboard.thy	Thu Jul 01 14:32:57 2010 +0200
+++ b/src/HOL/Isar_Examples/Mutilated_Checkerboard.thy	Thu Jul 01 18:31:46 2010 +0200
@@ -9,27 +9,26 @@
 imports Main
 begin
 
-text {*
- The Mutilated Checker Board Problem, formalized inductively.  See
- \cite{paulson-mutilated-board} and
- \url{http://isabelle.in.tum.de/library/HOL/Induct/Mutil.html} for the
- original tactic script version.
-*}
+text {* The Mutilated Checker Board Problem, formalized inductively.
+  See \cite{paulson-mutilated-board} and
+  \url{http://isabelle.in.tum.de/library/HOL/Induct/Mutil.html} for
+  the original tactic script version. *}
 
 subsection {* Tilings *}
 
-inductive_set
-  tiling :: "'a set set => 'a set set"
+inductive_set tiling :: "'a set set => 'a set set"
   for A :: "'a set set"
-  where
-    empty: "{} : tiling A"
-  | Un: "a : A ==> t : tiling A ==> a <= - t ==> a Un t : tiling A"
+where
+  empty: "{} : tiling A"
+| Un: "a : A ==> t : tiling A ==> a <= - t ==> a Un t : tiling A"
 
 
 text "The union of two disjoint tilings is a tiling."
 
 lemma tiling_Un:
-  assumes "t : tiling A" and "u : tiling A" and "t Int u = {}"
+  assumes "t : tiling A"
+    and "u : tiling A"
+    and "t Int u = {}"
   shows "t Un u : tiling A"
 proof -
   let ?T = "tiling A"
@@ -60,8 +59,8 @@
 
 subsection {* Basic properties of ``below'' *}
 
-definition below :: "nat => nat set" where
-  "below n == {i. i < n}"
+definition below :: "nat => nat set"
+  where "below n = {i. i < n}"
 
 lemma below_less_iff [iff]: "(i: below k) = (i < k)"
   by (simp add: below_def)
@@ -74,8 +73,8 @@
   by (simp add: below_def less_Suc_eq) blast
 
 lemma Sigma_Suc2:
-    "m = n + 2 ==> A <*> below m =
-      (A <*> {n}) Un (A <*> {n + 1}) Un (A <*> below n)"
+  "m = n + 2 ==> A <*> below m =
+    (A <*> {n}) Un (A <*> {n + 1}) Un (A <*> below n)"
   by (auto simp add: below_def)
 
 lemmas Sigma_Suc = Sigma_Suc1 Sigma_Suc2
@@ -83,27 +82,26 @@
 
 subsection {* Basic properties of ``evnodd'' *}
 
-definition evnodd :: "(nat * nat) set => nat => (nat * nat) set" where
-  "evnodd A b == A Int {(i, j). (i + j) mod 2 = b}"
+definition evnodd :: "(nat * nat) set => nat => (nat * nat) set"
+  where "evnodd A b = A Int {(i, j). (i + j) mod 2 = b}"
 
-lemma evnodd_iff:
-    "(i, j): evnodd A b = ((i, j): A  & (i + j) mod 2 = b)"
+lemma evnodd_iff: "(i, j): evnodd A b = ((i, j): A  & (i + j) mod 2 = b)"
   by (simp add: evnodd_def)
 
 lemma evnodd_subset: "evnodd A b <= A"
-  by (unfold evnodd_def, rule Int_lower1)
+  unfolding evnodd_def by (rule Int_lower1)
 
 lemma evnoddD: "x : evnodd A b ==> x : A"
-  by (rule subsetD, rule evnodd_subset)
+  by (rule subsetD) (rule evnodd_subset)
 
 lemma evnodd_finite: "finite A ==> finite (evnodd A b)"
-  by (rule finite_subset, rule evnodd_subset)
+  by (rule finite_subset) (rule evnodd_subset)
 
 lemma evnodd_Un: "evnodd (A Un B) b = evnodd A b Un evnodd B b"
-  by (unfold evnodd_def) blast
+  unfolding evnodd_def by blast
 
 lemma evnodd_Diff: "evnodd (A - B) b = evnodd A b - evnodd B b"
-  by (unfold evnodd_def) blast
+  unfolding evnodd_def by blast
 
 lemma evnodd_empty: "evnodd {} b = {}"
   by (simp add: evnodd_def)
@@ -116,11 +114,10 @@
 
 subsection {* Dominoes *}
 
-inductive_set
-  domino :: "(nat * nat) set set"
-  where
-    horiz: "{(i, j), (i, j + 1)} : domino"
-  | vertl: "{(i, j), (i + 1, j)} : domino"
+inductive_set domino :: "(nat * nat) set set"
+where
+  horiz: "{(i, j), (i, j + 1)} : domino"
+| vertl: "{(i, j), (i + 1, j)} : domino"
 
 lemma dominoes_tile_row:
   "{i} <*> below (2 * n) : tiling domino"
@@ -165,9 +162,10 @@
 qed
 
 lemma domino_singleton:
-  assumes d: "d : domino" and "b < 2"
+  assumes "d : domino"
+    and "b < 2"
   shows "EX i j. evnodd d b = {(i, j)}"  (is "?P d")
-  using d
+  using assms
 proof induct
   from `b < 2` have b_cases: "b = 0 | b = 1" by arith
   fix i j
@@ -177,9 +175,9 @@
 qed
 
 lemma domino_finite:
-  assumes d: "d: domino"
+  assumes "d: domino"
   shows "finite d"
-  using d
+  using assms
 proof induct
   fix i j :: nat
   show "finite {(i, j), (i, j + 1)}" by (intro finite.intros)
@@ -245,8 +243,9 @@
 
 subsection {* Main theorem *}
 
-definition mutilated_board :: "nat => nat => (nat * nat) set" where
-  "mutilated_board m n ==
+definition mutilated_board :: "nat => nat => (nat * nat) set"
+where
+  "mutilated_board m n =
     below (2 * (m + 1)) <*> below (2 * (n + 1))
       - {(0, 0)} - {(2 * m + 1, 2 * n + 1)}"
 
@@ -256,7 +255,7 @@
   let ?t = "below (2 * (m + 1)) <*> below (2 * (n + 1))"
   let ?t' = "?t - {(0, 0)}"
   let ?t'' = "?t' - {(2 * m + 1, 2 * n + 1)}"
-
+  
   show "?t'' ~: ?T"
   proof
     have t: "?t : ?T" by (rule dominoes_tile_matrix)