Rearrangement and polishing to look for for publication
authorpaulson
Thu, 25 Apr 1996 12:45:14 +0200
changeset 1684 3eaf3ab53082
parent 1683 a5bcaf5894f3
child 1685 801032ed5959
Rearrangement and polishing to look for for publication
src/HOL/ex/Mutil.ML
src/HOL/ex/Mutil.thy
--- a/src/HOL/ex/Mutil.ML	Thu Apr 25 11:48:13 1996 +0200
+++ b/src/HOL/ex/Mutil.ML	Thu Apr 25 12:45:14 1996 +0200
@@ -3,18 +3,73 @@
     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     Copyright   1996  University of Cambridge
 
-The Mutilated Checkerboard Problem, formalized inductively
+The Mutilated Chess Board Problem, formalized inductively
 *)
 
 open Mutil;
 
-(*SHOULD NOT BE NECESSARY!*)
-Addsimps [ball_rew,mem_Sigma_iff];
+Addsimps tiling.intrs;
+
+(** The union of two disjoint tilings is a tiling **)
+
+goal thy "!!t. t: tiling A ==> \
+\              u: tiling A --> t Int u = {} --> t Un u : tiling A";
+by (etac tiling.induct 1);
+by (Simp_tac 1);
+by (fast_tac (set_cs addIs tiling.intrs
+	             addss (HOL_ss addsimps [Un_assoc,
+					     subset_empty_iff RS sym])) 1);
+bind_thm ("tiling_UnI", result() RS mp RS mp);
+
+
+(*** Chess boards ***)
+
+val [below_0, below_Suc] = nat_recs below_def;
+Addsimps [below_0];
+(*below_Suc should NOT be added, or Sigma_Suc1,2 cannot be used*)
+
+goal thy "(i: below k) = (i<k)";
+by (res_inst_tac [("x", "i")] spec 1);
+by (nat_ind_tac "k" 1);
+by (ALLGOALS (asm_simp_tac (!simpset addsimps [below_Suc, less_Suc_eq])));
+by (fast_tac set_cs 1);
+qed "below_less_iff";
 
-(** Basic properties of evnodd **)
+goal thy "below(Suc n) Times B = ({n} Times B) Un ((below n) Times B)";
+by (simp_tac (!simpset addsimps [below_Suc]) 1);
+by (fast_tac (prod_cs addIs [equalityI]) 1);
+qed "Sigma_Suc1";
+
+goal thy "A Times below(Suc n) = (A Times {n}) Un (A Times (below n))";
+by (simp_tac (!simpset addsimps [below_Suc]) 1);
+by (fast_tac (prod_cs addIs [equalityI]) 1);
+qed "Sigma_Suc2";
 
-goalw thy [evnodd_def]
-    "(i,j): evnodd A b = ((i,j): A  &  (i+j) mod 2 = b)";
+goal thy "{i} Times below(n + n) : tiling domino";
+by (nat_ind_tac "n" 1);
+by (ALLGOALS (asm_simp_tac (!simpset addsimps [Un_assoc RS sym, Sigma_Suc2])));
+by (resolve_tac tiling.intrs 1);
+by (assume_tac 2);
+by (subgoal_tac    (*seems the easiest way of turning one to the other*)
+    "({i} Times {Suc(n1+n1)}) Un ({i} Times {n1+n1}) = \
+\    {(i, n1+n1), (i, Suc(n1+n1))}" 1);
+by (fast_tac (prod_cs addIs [equalityI]) 2);
+by (asm_simp_tac (!simpset addsimps [domino.horiz]) 1);
+by (fast_tac (prod_cs addIs [equalityI, lessI] addEs [less_irrefl, less_asym]
+                      addDs [below_less_iff RS iffD1]) 1);
+qed "dominoes_tile_row";
+
+goal thy "(below m) Times below(n + n) : tiling domino";
+by (nat_ind_tac "m" 1);
+by (ALLGOALS (asm_simp_tac (!simpset addsimps [Sigma_Suc1])));
+by (fast_tac (prod_cs addIs [equalityI, tiling_UnI, dominoes_tile_row] 
+                      addEs [below_less_iff RS iffD1 RS less_irrefl]) 1);
+qed "dominoes_tile_matrix";
+
+
+(*** Basic properties of evnodd ***)
+
+goalw thy [evnodd_def] "(i,j): evnodd A b = ((i,j): A  &  (i+j) mod 2 = b)";
 by (Simp_tac 1);
 qed "evnodd_iff";
 
@@ -33,6 +88,10 @@
 by (fast_tac eq_cs 1);
 qed "evnodd_Diff";
 
+goalw thy [evnodd_def] "evnodd {} b = {}";
+by (Simp_tac 1);
+qed "evnodd_empty";
+
 goalw thy [evnodd_def]
     "evnodd (insert (i,j) C) b = \
 \    (if (i+j) mod 2 = b then insert (i,j) (evnodd C b) else evnodd C b)";
@@ -40,18 +99,10 @@
              setloop (split_tac [expand_if] THEN' step_tac eq_cs)) 1);
 qed "evnodd_insert";
 
-goalw thy [evnodd_def] "evnodd {} b = {}";
-by (Simp_tac 1);
-qed "evnodd_empty";
-
 
 (*** Dominoes ***)
 
-goal thy "!!d. d:domino ==> finite d";
-by (fast_tac (set_cs addSIs [finite_insertI, finite_emptyI] addEs [domino.elim]) 1);
-qed "domino_finite";
-
-goal thy "!!d. [| d:domino; b<2 |] ==> EX i' j'. evnodd d b = {(i',j')}";
+goal thy "!!d. [| d:domino; b<2 |] ==> EX i j. evnodd d b = {(i,j)}";
 by (eresolve_tac [domino.elim] 1);
 by (res_inst_tac [("k1", "i+j")] (mod2_cases RS disjE) 2);
 by (res_inst_tac [("k1", "i+j")] (mod2_cases RS disjE) 1);
@@ -63,19 +114,13 @@
            THEN fast_tac less_cs 1));
 qed "domino_singleton";
 
-
-(*** Tilings ***)
-
-(** The union of two disjoint tilings is a tiling **)
+goal thy "!!d. d:domino ==> finite d";
+by (fast_tac (set_cs addSIs [finite_insertI, finite_emptyI] 
+                     addEs [domino.elim]) 1);
+qed "domino_finite";
 
-goal thy "!!t. t: tiling A ==> \
-\              u: tiling A --> t Int u = {} --> t Un u : tiling A";
-by (etac tiling.induct 1);
-by (simp_tac (!simpset addsimps tiling.intrs) 1);
-by (fast_tac (set_cs addIs tiling.intrs
-	             addss (HOL_ss addsimps [Un_assoc,
-					     subset_empty_iff RS sym])) 1);
-bind_thm ("tiling_UnI", result() RS mp RS mp);
+
+(*** Tilings of dominoes ***)
 
 goal thy "!!t. t:tiling domino ==> finite t";
 by (eresolve_tac [tiling.induct] 1);
@@ -99,56 +144,8 @@
 by (fast_tac (set_cs addSDs [evnodd_subset RS subsetD] addEs [equalityE]) 1);
 qed "tiling_domino_0_1";
 
-
-val [below_0, below_Suc] = nat_recs below_def;
-Addsimps [below_0];
-(*below_Suc should NOT be added, or Sigma_Suc1,2 cannot be used*)
-
-goal thy "(i: below k) = (i<k)";
-by (res_inst_tac [("x", "i")] spec 1);
-by (nat_ind_tac "k" 1);
-by (Simp_tac 1);
-by (asm_simp_tac (!simpset addsimps [below_Suc, less_Suc_eq]) 1);
-by (fast_tac set_cs 1);
-qed "below_less_iff";
-
-goal thy "(below (Suc n)) Times B = ({n} Times B) Un ((below n) Times B)";
-by (simp_tac (!simpset addsimps [below_Suc]) 1);
-by (fast_tac (prod_cs addIs [equalityI]) 1);
-qed "Sigma_Suc1";
-
-goal thy "A Times (below (Suc n)) = (A Times {n}) Un (A Times (below n))";
-by (simp_tac (!simpset addsimps [below_Suc]) 1);
-by (fast_tac (prod_cs addIs [equalityI]) 1);
-qed "Sigma_Suc2";
-
-goal thy "{i} Times (below (n + n)) : tiling domino";
-by (nat_ind_tac "n" 1);
-by (simp_tac (!simpset addsimps tiling.intrs) 1);
-by (asm_simp_tac (!simpset addsimps [Un_assoc RS sym, Sigma_Suc2]) 1);
-by (resolve_tac tiling.intrs 1);
-by (assume_tac 2);
-by (subgoal_tac    (*seems the easiest way of turning one to the other*)
-    "({i} Times {Suc(n1+n1)}) Un ({i} Times {n1+n1}) = \
-\    {(i, n1+n1), (i, Suc(n1+n1))}" 1);
-by (fast_tac (prod_cs addIs [equalityI]) 2);
-by (asm_simp_tac (!simpset addsimps [domino.horiz]) 1);
-by (fast_tac (prod_cs addIs [equalityI, lessI] addEs [less_irrefl, less_asym]
-                      addDs [below_less_iff RS iffD1]) 1);
-qed "dominoes_tile_row";
-
-goal thy "(below m) Times (below (n + n)) : tiling domino";
-by (nat_ind_tac "m" 1);
-by (simp_tac (!simpset addsimps (below_0::tiling.intrs)) 1);
-by (asm_simp_tac (!simpset addsimps [Sigma_Suc1]) 1);
-by (fast_tac (prod_cs addIs [equalityI, tiling_UnI, dominoes_tile_row] 
-                      addEs [below_less_iff RS iffD1 RS less_irrefl]) 1);
-qed "dominoes_tile_matrix";
-
-
-goal thy "!!m n. [| t = (below (Suc m + Suc m))  Times              \
-\                       (below (Suc n + Suc n));                    \
-\                   t' = t - {(0,0)} - {(Suc(m+m), Suc(n+n))}       \
+goal thy "!!m n. [| t = below(Suc m + Suc m) Times below(Suc n + Suc n);   \
+\                   t' = t - {(0,0)} - {(Suc(m+m), Suc(n+n))}              \
 \                |] ==> t' ~: tiling domino";
 by (rtac notI 1);
 by (dtac tiling_domino_0_1 1);
--- a/src/HOL/ex/Mutil.thy	Thu Apr 25 11:48:13 1996 +0200
+++ b/src/HOL/ex/Mutil.thy	Thu Apr 25 12:45:14 1996 +0200
@@ -3,19 +3,17 @@
     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     Copyright   1996  University of Cambridge
 
-The Mutilated Checkerboard Problem, formalized inductively
+The Mutilated Chess Board Problem, formalized inductively
+  Originator is Max Black, according to J A Robinson.
+  Popularized as the Mutilated Checkerboard Problem by J McCarthy
 *)
 
 Mutil = Finite +
 consts
-  below   :: nat => nat set
-  evnodd  :: "[(nat*nat)set, nat] => (nat*nat)set"
   domino  :: "(nat*nat)set set"
   tiling  :: 'a set set => 'a set set
-
-defs
-  below_def  "below n    == nat_rec n {} insert"
-  evnodd_def "evnodd A b == A Int {(i,j). (i+j) mod 2 = b}"
+  below   :: nat => nat set
+  evnodd  :: "[(nat*nat)set, nat] => (nat*nat)set"
 
 inductive "domino"
   intrs
@@ -27,4 +25,8 @@
     empty  "{} : tiling A"
     Un     "[| a: A;  t: tiling A;  a Int t = {} |] ==> a Un t : tiling A"
 
+defs
+  below_def  "below n    == nat_rec n {} insert"
+  evnodd_def "evnodd A b == A Int {(i,j). (i+j) mod 2 = b}"
+
 end