From 25c8b387c4b655751265605bd4af033698624f38 Mon Sep 17 00:00:00 2001
From: Michael Orlitzky <michael@orlitzky.com>
Date: Sat, 30 Apr 2011 21:03:59 -0400
Subject: [PATCH] Add a ton of new tests based on pages 79 and 80 of Sorokina
 and Zeilfelder.

---
 src/Tests/Face.hs | 287 ++++++++++++++++++++++++++++++++++++++++++++--
 test/TestSuite.hs | 100 ++++++++++++++--
 2 files changed, 370 insertions(+), 17 deletions(-)

diff --git a/src/Tests/Face.hs b/src/Tests/Face.hs
index 14d000b..f9de1e7 100644
--- a/src/Tests/Face.hs
+++ b/src/Tests/Face.hs
@@ -3,17 +3,290 @@ where
 
 import Test.QuickCheck
 
-import Cube (Cube(grid))
-import Face (tetrahedrons)
+import Comparisons
+import Cube (Cube(grid), top)
+import Face (face0,
+             face2,
+             face5,
+             tetrahedron0,
+             tetrahedron1,
+             tetrahedron2,
+             tetrahedron3,
+             tetrahedrons)
 import Grid (Grid(h))
-import Tetrahedron (volume)
+import Tetrahedron
 
 -- QuickCheck Tests.
-prop_all_volumes_nonnegative :: Cube -> Property
-prop_all_volumes_nonnegative c =
-    (delta > 0) ==> (null negative_volumes)
+
+-- | Since the grid size is necessarily positive, all tetrahedrons
+--   (which comprise cubes of positive volume) must have positive volume
+--   as well.
+prop_all_volumes_positive :: Cube -> Property
+prop_all_volumes_positive c =
+    (delta > 0) ==> (null nonpositive_volumes)
     where
       delta = h (grid c)
       ts = tetrahedrons c
       volumes = map volume ts
-      negative_volumes = filter (< 0) volumes
+      nonpositive_volumes = filter (<= 0) volumes
+
+
+-- | Given in Sorokina and Zeilfelder, p. 79.
+prop_c0120_identity1 :: Cube -> Bool
+prop_c0120_identity1 cube =
+    c t0' 0 1 2 0 ~= (c t0' 0 0 2 1 + c t1' 0 0 2 1) / 2
+      where
+        t0 = tetrahedron0 (face0 cube)
+        t1 = tetrahedron1 (face0 cube)
+        t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
+        t1' = Tetrahedron cube (v3 t1) (v2 t1) (v0 t1) (v1 t1)
+
+
+-- | Given in Sorokina and Zeilfelder, p. 79.
+prop_c0210_identity1 :: Cube -> Bool
+prop_c0210_identity1 cube =
+    c t0' 0 2 1 0 ~= (c t0' 0 1 1 1 + c t1' 0 1 1 1) / 2
+      where
+        t0 = tetrahedron0 (face0 cube)
+        t1 = tetrahedron1 (face0 cube)
+        t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
+        t1' = Tetrahedron cube (v3 t1) (v2 t1) (v0 t1) (v1 t1)
+
+
+-- | Given in Sorokina and Zeilfelder, p. 79.
+prop_c0300_identity1 :: Cube -> Bool
+prop_c0300_identity1 cube =
+    c t0' 0 3 0 0 ~= (c t0' 0 2 0 1 + c t1' 0 2 0 1) / 2
+      where
+        t0 = tetrahedron0 (face0 cube)
+        t1 = tetrahedron1 (face0 cube)
+        t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
+        t1' = Tetrahedron cube (v3 t1) (v2 t1) (v0 t1) (v1 t1)
+
+-- | Given in Sorokina and Zeilfelder, p. 79.
+prop_c1110_identity :: Cube -> Bool
+prop_c1110_identity cube =
+    c t0' 1 1 1 0 ~= (c t0' 1 0 1 1 + c t1' 1 0 1 1) / 2
+      where
+        t0 = tetrahedron0 (face0 cube)
+        t1 = tetrahedron1 (face0 cube)
+        t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
+        t1' = Tetrahedron cube (v3 t1) (v2 t1) (v0 t1) (v1 t1)
+
+
+-- | Given in Sorokina and Zeilfelder, p. 79.
+prop_c1200_identity1 :: Cube -> Bool
+prop_c1200_identity1 cube =
+    c t0' 1 2 0 0 ~= (c t0' 1 1 0 1 + c t1' 1 1 0 1) / 2
+      where
+        t0 = tetrahedron0 (face0 cube)
+        t1 = tetrahedron1 (face0 cube)
+        t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
+        t1' = Tetrahedron cube (v3 t1) (v2 t1) (v0 t1) (v1 t1)
+
+
+-- | Given in Sorokina and Zeilfelder, p. 79.
+prop_c2100_identity1 :: Cube -> Bool
+prop_c2100_identity1 cube =
+    c t0' 2 1 0 0 ~= (c t0' 2 0 0 1 + c t1' 2 0 0 1) / 2
+      where
+        t0 = tetrahedron0 (face0 cube)
+        t1 = tetrahedron1 (face0 cube)
+        t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
+        t1' = Tetrahedron cube (v3 t1) (v2 t1) (v0 t1) (v1 t1)
+
+
+-- | Given in Sorokina and Zeilfelder, p. 79.
+prop_c0102_identity1 :: Cube -> Bool
+prop_c0102_identity1 cube =
+    c t0' 0 1 0 2 ~= (c t0' 0 0 1 2 + c t3' 0 0 1 2) / 2
+      where
+        t0 = tetrahedron0 (face0 cube)
+        t3 = tetrahedron3 (face0 cube)
+        t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
+        t3' = Tetrahedron cube (v3 t3) (v2 t3) (v1 t3) (v0 t3)
+
+
+-- | Given in Sorokina and Zeilfelder, p. 79.
+prop_c0201_identity1 :: Cube -> Bool
+prop_c0201_identity1 cube =
+    c t0' 0 2 0 1 ~= (c t0' 0 1 1 1 + c t3' 0 1 1 1) / 2
+      where
+        t0 = tetrahedron0 (face0 cube)
+        t3 = tetrahedron3 (face0 cube)
+        t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
+        t3' = Tetrahedron cube (v3 t3) (v2 t3) (v1 t3) (v0 t3)
+
+
+-- | Given in Sorokina and Zeilfelder, p. 79.
+prop_c0300_identity2 :: Cube -> Bool
+prop_c0300_identity2 cube =
+    c t0' 3 0 0 0 ~= (c t0' 0 2 1 0 + c t3' 0 2 1 0) / 2
+      where
+        t0 = tetrahedron0 (face0 cube)
+        t3 = tetrahedron3 (face0 cube)
+        t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
+        t3' = Tetrahedron cube (v3 t3) (v2 t3) (v1 t3) (v0 t3)
+
+-- | Given in Sorokina and Zeilfelder, p. 79.
+prop_c1101_identity :: Cube -> Bool
+prop_c1101_identity cube =
+    c t0' 1 1 0 1 ~= (c t0' 1 1 0 1 + c t3' 1 1 0 1) / 2
+      where
+        t0 = tetrahedron0 (face0 cube)
+        t3 = tetrahedron3 (face0 cube)
+        t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
+        t3' = Tetrahedron cube (v3 t3) (v2 t3) (v1 t3) (v0 t3)
+
+
+-- | Given in Sorokina and Zeilfelder, p. 79.
+prop_c1200_identity2 :: Cube -> Bool
+prop_c1200_identity2 cube =
+    c t0' 1 1 1 0 ~= (c t0' 1 1 1 0 + c t3' 1 1 1 0) / 2
+      where
+        t0 = tetrahedron0 (face0 cube)
+        t3 = tetrahedron3 (face0 cube)
+        t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
+        t3' = Tetrahedron cube (v3 t3) (v2 t3) (v1 t3) (v0 t3)
+
+
+-- | Given in Sorokina and Zeilfelder, p. 79.
+prop_c2100_identity2 :: Cube -> Bool
+prop_c2100_identity2 cube =
+    c t0' 2 1 0 0 ~= (c t0' 2 0 1 0 + c t3' 2 0 1 0) / 2
+      where
+        t0 = tetrahedron0 (face0 cube)
+        t3 = tetrahedron3 (face0 cube)
+        t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
+        t3' = Tetrahedron cube (v3 t3) (v2 t3) (v1 t3) (v0 t3)
+
+
+-- | Given in Sorokina and Zeilfelder, p. 79.
+prop_c3000_identity :: Cube -> Bool
+prop_c3000_identity cube =
+    c t0' 3 0 0 0 ~= c t0' 2 1 0 0 + c t2' 2 1 0 0 - ((c t0' 2 0 1 0 + c t0' 2 0 0 1)/ 2)
+      where
+        t0 = tetrahedron0 (face0 cube)
+        t2 = tetrahedron2 (face5 cube)
+        t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
+        t2' = Tetrahedron cube (v3 t2) (v2 t2) (v1 t2) (v0 t2)
+
+
+-- | Given in Sorokina and Zeilfelder, p. 79.
+prop_c2010_identity :: Cube -> Bool
+prop_c2010_identity cube =
+    c t0' 2 0 1 0 ~= c t0' 1 1 1 0 + c t2' 1 1 1 0 - ((c t0' 1 0 2 0 + c t0' 1 0 1 1)/ 2)
+      where
+        t0 = tetrahedron0 (face0 cube)
+        t2 = tetrahedron2 (face5 cube)
+        t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
+        t2' = Tetrahedron cube (v3 t2) (v2 t2) (v1 t2) (v0 t2)
+
+
+-- | Given in Sorokina and Zeilfelder, p. 79.
+prop_c2001_identity :: Cube -> Bool
+prop_c2001_identity cube =
+    c t0' 2 0 0 1 ~= c t0' 1 1 0 1 + c t2' 1 1 0 1 - ((c t0' 1 0 0 2 + c t0' 1 0 1 1)/ 2)
+      where
+        t0 = tetrahedron0 (face0 cube)
+        t2 = tetrahedron2 (face5 cube)
+        t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
+        t2' = Tetrahedron cube (v3 t2) (v2 t2) (v1 t2) (v0 t2)
+
+-- | Given in Sorokina and Zeilfelder, p. 79.
+prop_c1020_identity :: Cube -> Bool
+prop_c1020_identity cube =
+    c t0' 1 0 2 0 ~= c t0' 0 1 2 0 + c t2' 0 1 2 0 - ((c t0' 0 0 3 0 + c t0' 0 0 2 1)/ 2)
+      where
+        t0 = tetrahedron0 (face0 cube)
+        t2 = tetrahedron2 (face5 cube)
+        t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
+        t2' = Tetrahedron cube (v3 t2) (v2 t2) (v1 t2) (v0 t2)
+
+
+-- | Given in Sorokina and Zeilfelder, p. 79.
+prop_c1002_identity :: Cube -> Bool
+prop_c1002_identity cube =
+    c t0' 1 0 0 2 ~= c t0' 0 1 0 2 + c t2' 0 1 0 2 - ((c t0' 0 0 0 3 + c t0' 0 0 1 2)/ 2)
+      where
+        t0 = tetrahedron0 (face0 cube)
+        t2 = tetrahedron2 (face5 cube)
+        t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
+        t2' = Tetrahedron cube (v3 t2) (v2 t2) (v1 t2) (v0 t2)
+
+
+-- | Given in Sorokina and Zeilfelder, p. 79.
+prop_c1011_identity :: Cube -> Bool
+prop_c1011_identity cube =
+    c t0' 1 0 1 1 ~= c t0' 0 1 1 1 + c t2' 0 1 1 1 - ((c t0' 0 0 1 2 + c t0' 0 0 2 1)/ 2)
+      where
+        t0 = tetrahedron0 (face0 cube)
+        t2 = tetrahedron2 (face5 cube)
+        t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
+        t2' = Tetrahedron cube (v3 t2) (v2 t2) (v1 t2) (v0 t2)
+
+
+-- | Given in Sorokina and Zeilfelder, p. 80.
+prop_c0120_identity2 :: Cube -> Bool
+prop_c0120_identity2 cube =
+        c t0' 0 1 2 0 ~= (c t0' 1 0 2 0 + c t1' 1 0 2 0) / 2
+      where
+        t0 = tetrahedron0 (face0 cube)
+        t1 = tetrahedron0 (face2 (top cube))
+        t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
+        t1' = Tetrahedron cube (v3 t1) (v2 t1) (v0 t1) (v1 t1)
+
+
+-- | Given in Sorokina and Zeilfelder, p. 80.
+prop_c0102_identity2 :: Cube -> Bool
+prop_c0102_identity2 cube =
+    c t0' 0 1 0 2 ~= (c t0' 1 0 0 2 + c t1' 1 0 0 2) / 2
+      where
+        t0 = tetrahedron0 (face0 cube)
+        t1 = tetrahedron0 (face2 (top cube))
+        t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
+        t1' = Tetrahedron cube (v3 t1) (v2 t1) (v0 t1) (v1 t1)
+
+
+-- | Given in Sorokina and Zeilfelder, p. 80.
+prop_c0111_identity :: Cube -> Bool
+prop_c0111_identity cube =
+    c t0' 0 1 1 1 ~= (c t0' 1 0 1 1 + c t1' 1 0 1 1) / 2
+      where
+        t0 = tetrahedron0 (face0 cube)
+        t1 = tetrahedron0 (face2 (top cube))
+        t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
+        t1' = Tetrahedron cube (v3 t1) (v2 t1) (v0 t1) (v1 t1)
+
+
+-- | Given in Sorokina and Zeilfelder, p. 80.
+prop_c0210_identity2 :: Cube -> Bool
+prop_c0210_identity2 cube =
+    c t0 0 2 1 0 ~= (c t0 1 1 1 0 + c t1 1 1 1 0) / 2
+      where
+        t0 = tetrahedron0 (face0 cube)
+        t1 = tetrahedron0 (face2 (top cube))
+        t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
+        t1' = Tetrahedron cube (v3 t1) (v2 t1) (v0 t1) (v1 t1)
+
+
+-- | Given in Sorokina and Zeilfelder, p. 80.
+prop_c0201_identity2 :: Cube -> Bool
+prop_c0201_identity2 cube =
+    c t0 0 2 0 1 ~= (c t0 1 1 0 1 + c t1 1 1 0 1) / 2
+      where
+        t0 = tetrahedron0 (face0 cube)
+        t1 = tetrahedron0 (face2 (top cube))
+        t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
+        t1' = Tetrahedron cube (v3 t1) (v2 t1) (v0 t1) (v1 t1)
+
+
+-- | Given in Sorokina and Zeilfelder, p. 80.
+prop_c0300_identity3 :: Cube -> Bool
+prop_c0300_identity3 cube =
+    c t0 0 3 0 0 ~= (c t0 1 2 0 0 + c t1 1 2 0 0) / 2
+      where
+        t0 = tetrahedron0 (face0 cube)
+        t1 = tetrahedron0 (face2 (top cube))
+        t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
+        t1' = Tetrahedron cube (v3 t1) (v2 t1) (v0 t1) (v1 t1)
diff --git a/test/TestSuite.hs b/test/TestSuite.hs
index 26c6bc9..cd39f57 100644
--- a/test/TestSuite.hs
+++ b/test/TestSuite.hs
@@ -1,9 +1,9 @@
 import Test.HUnit
 import Test.QuickCheck
 
-import Tests.Face
+import Tests.Face as TF
 import Tests.Misc
-import Tests.Tetrahedron
+import Tests.Tetrahedron as TT
 
 -- The list of HUnit tests.
 test_suite = TestList (concat [misc_tests,
@@ -17,12 +17,12 @@ main = do
   putStrLn ""
   putStrLn "QuickCheck"
   putStrLn "----------"
-  let qc_args = stdArgs { maxSuccess = 1000,
-                          maxDiscard = 5000,
-                          maxSize = 1000 }
+  let qc_args = stdArgs { maxSuccess = 100,
+                          maxDiscard = 500,
+                          maxSize = 100 }
 
-  putStr "prop_all_volumes_nonnegative... "
-  quickCheckWith qc_args prop_all_volumes_nonnegative
+  putStr "prop_all_volumes_positive... "
+  quickCheckWith qc_args prop_all_volumes_positive
 
   putStr "prop_factorial_greater... "
   quickCheckWith qc_args prop_factorial_greater
@@ -76,12 +76,92 @@ main = do
   quickCheckWith qc_args prop_b3_v2_always_zero
 
   putStr "prop_c3000_identity... "
-  quickCheckWith qc_args prop_c3000_identity
+  quickCheckWith qc_args TT.prop_c3000_identity
 
   putStr "prop_c2100_identity... "
-  quickCheckWith qc_args prop_c2100_identity
+  quickCheckWith qc_args TT.prop_c2100_identity
 
   putStr "prop_c1110_identity... "
-  quickCheckWith qc_args prop_c1110_identity
+  quickCheckWith qc_args TT.prop_c1110_identity
+
+  putStrLn "\np. 79, (2.6)\n"
+
+  putStr "prop_c0120_identity1... "
+  quickCheckWith qc_args TF.prop_c0120_identity1
+
+  putStr "prop_c0210_identity1... "
+  quickCheckWith qc_args TF.prop_c0210_identity1
+
+  putStr "prop_c0300_identity1... "
+  quickCheckWith qc_args TF.prop_c0300_identity1
+
+  putStr "prop_c1110_identity... "
+  quickCheckWith qc_args TF.prop_c1110_identity
+
+  putStr "prop_c1200_identity1... "
+  quickCheckWith qc_args prop_c1200_identity1
+
+  putStr "prop_c2100_identity1... "
+  quickCheckWith qc_args TF.prop_c2100_identity1
+
+  putStrLn "\np. 79, (2.7)\n"
+
+  putStr "prop_c0102_identity1... "
+  quickCheckWith qc_args TF.prop_c0102_identity1
+
+  putStr "prop_c0201_identity1... "
+  quickCheckWith qc_args TF.prop_c0201_identity1
+
+  putStr "prop_c0300_identity2... "
+  quickCheckWith qc_args TF.prop_c0300_identity2
+
+  putStr "prop_c1101_identity... "
+  quickCheckWith qc_args TF.prop_c1101_identity
+
+  putStr "prop_c1200_identity2... "
+  quickCheckWith qc_args TF.prop_c1200_identity2
+
+  putStr "prop_c2100_identity2... "
+  quickCheckWith qc_args TF.prop_c2100_identity2
+
+  putStrLn "\np. 79, (2.8)\n"
+
+  putStr "prop_c3000_identity... "
+  quickCheckWith qc_args TF.prop_c3000_identity
+
+  putStr "prop_c2010_identity... "
+  quickCheckWith qc_args TF.prop_c2010_identity
+
+  putStr "prop_c2001_identity... "
+  quickCheckWith qc_args TF.prop_c2001_identity
+
+  putStr "prop_c1020_identity... "
+  quickCheckWith qc_args TF.prop_c1020_identity
+
+  putStr "prop_c1002_identity... "
+  quickCheckWith qc_args TF.prop_c1002_identity
+
+  putStr "prop_c1011_identity... "
+  quickCheckWith qc_args TF.prop_c1011_identity
+
+  putStrLn "\np. 80, (2.9)\n"
+
+  putStr "prop_c0120_identity2... "
+  quickCheckWith qc_args TF.prop_c0120_identity2
+
+  putStr "prop_c0102_identity2... "
+  quickCheckWith qc_args TF.prop_c0102_identity2
+
+  putStr "prop_c0111_identity... "
+  quickCheckWith qc_args TF.prop_c0111_identity
+
+  putStr "prop_c0210_identity2... "
+  quickCheckWith qc_args TF.prop_c0210_identity2
+
+  putStr "prop_c0201_identity2... "
+  quickCheckWith qc_args TF.prop_c0201_identity2
+
+  putStr "prop_c0300_identity3... "
+  quickCheckWith qc_args TF.prop_c0300_identity3
 
   return ()
-- 
2.43.2