Add another test checking the rotation for c2100.

[spline3.git] / src / Tests / Cube.hs

diff --git a/src/Tests/Cube.hs b/src/Tests/Cube.hs
index 5a9ca19330465e1e6e9a7b56ab2dfc62405f7060..aaafa7ca77a6cad7f9a6afc4cbab1745d120d611 100644 (file)
--- a/src/Tests/Cube.hs
+++ b/src/Tests/Cube.hs
@@ -1,8 +1,10 @@
 module Tests.Cube
 where
 
+import Prelude hiding (LT)
 import Test.QuickCheck
 
+import Cardinal
 import Comparisons
 import Cube
 import FunctionValues
@@ -538,6 +540,36 @@ prop_c1011_identity cube =
 
 
 
+-- | We know what (c t6 2 1 0 0) should be from Sorokina and Zeilfelder, p. 87.
+--   This test checks the rotation works as expected.
+prop_c_tilde_2100_rotation_correct :: Cube -> Bool
+prop_c_tilde_2100_rotation_correct cube =
+    expr1 == expr2
+    where
+      t0 = tetrahedron0 cube
+      t6 = tetrahedron6 cube
+
+      -- What gets computed for c2100 of t6.
+      expr1 = eval (Tetrahedron.fv t6) $
+          (3/8)*I +
+          (1/12)*(T + R + L + D) +
+          (1/64)*(FT + FR + FL + FD) +
+          (7/48)*F +
+          (1/48)*B +
+          (1/96)*(RT + LD + LT + RD) +
+          (1/192)*(BT + BR + BL + BD)
+
+      -- What should be computed for c2100 of t6.
+      expr2 = eval (Tetrahedron.fv t0) $
+              (3/8)*I +
+              (1/12)*(F + R + L + B) +
+              (1/64)*(FT + RT + LT + BT) +
+              (7/48)*T +
+              (1/48)*D +
+              (1/96)*(FR + FL + BR + BL) +
+              (1/192)*(FD + RD + LD + BD)
+
+
 -- | We know what (c t6 2 1 0 0) should be from Sorokina and Zeilfelder, p. 87.
 --   This test checks the actual value based on the FunctionValues of the cube.
 prop_c_tilde_2100_correct :: Cube -> Bool
@@ -546,8 +578,9 @@ prop_c_tilde_2100_correct cube =
                               + (7/48)*t + (1/48)*d + (1/96)*(fr + fl + br + bl)
                               + (1/192)*(fd + rd + ld + bd)
     where
+      t0 = tetrahedron0 cube
       t6 = tetrahedron6 cube
-      fvs = Tetrahedron.fv t6
+      fvs = Tetrahedron.fv t0
       int = interior fvs
       f = front fvs
       r = right fvs