Add the prop_interior_values_all_identical test.

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

diff --git a/src/Tests/Cube.hs b/src/Tests/Cube.hs
index 5a9ca19330465e1e6e9a7b56ab2dfc62405f7060..dac4f80749f019b0f76dd2f29e77b235eeeea82e 100644 (file)
--- a/src/Tests/Cube.hs
+++ b/src/Tests/Cube.hs
@@ -1,11 +1,14 @@
 module Tests.Cube
 where
 
 module Tests.Cube
 where
 

+import Prelude hiding (LT)

 import Test.QuickCheck
 
 import Test.QuickCheck
 

+import Cardinal

 import Comparisons
 import Cube
 import FunctionValues
 import Comparisons
 import Cube
 import FunctionValues

+import Misc (all_equal)

 import Tests.FunctionValues ()
 import Tetrahedron (b0, b1, b2, b3, c, fv,
                     v0, v1, v2, v3, volume)
 import Tests.FunctionValues ()
 import Tetrahedron (b0, b1, b2, b3, c, fv,
                     v0, v1, v2, v3, volume)


@@ -538,6 +541,69 @@ prop_c1011_identity cube =
 
 
 
 
 
 

+-- | The function values at the interior should be the same for all tetrahedra.
+prop_interior_values_all_identical :: Cube -> Bool
+prop_interior_values_all_identical cube =
+    all_equal [i0, i1, i2, i3, i4, i5, i6, i7, i8,
+               i9, i10, i11, i12, i13, i14, i15, i16,
+               i17, i18, i19, i20, i21, i22, i23]
+    where
+      i0 = eval (Tetrahedron.fv (tetrahedron0 cube)) $ I
+      i1 = eval (Tetrahedron.fv (tetrahedron1 cube)) $ I
+      i2 = eval (Tetrahedron.fv (tetrahedron2 cube)) $ I
+      i3 = eval (Tetrahedron.fv (tetrahedron3 cube)) $ I
+      i4 = eval (Tetrahedron.fv (tetrahedron4 cube)) $ I
+      i5 = eval (Tetrahedron.fv (tetrahedron5 cube)) $ I
+      i6 = eval (Tetrahedron.fv (tetrahedron6 cube)) $ I
+      i7 = eval (Tetrahedron.fv (tetrahedron7 cube)) $ I
+      i8 = eval (Tetrahedron.fv (tetrahedron8 cube)) $ I
+      i9 = eval (Tetrahedron.fv (tetrahedron9 cube)) $ I
+      i10 = eval (Tetrahedron.fv (tetrahedron10 cube)) $ I
+      i11 = eval (Tetrahedron.fv (tetrahedron11 cube)) $ I
+      i12 = eval (Tetrahedron.fv (tetrahedron12 cube)) $ I
+      i13 = eval (Tetrahedron.fv (tetrahedron13 cube)) $ I
+      i14 = eval (Tetrahedron.fv (tetrahedron14 cube)) $ I
+      i15 = eval (Tetrahedron.fv (tetrahedron15 cube)) $ I
+      i16 = eval (Tetrahedron.fv (tetrahedron16 cube)) $ I
+      i17 = eval (Tetrahedron.fv (tetrahedron17 cube)) $ I
+      i18 = eval (Tetrahedron.fv (tetrahedron18 cube)) $ I
+      i19 = eval (Tetrahedron.fv (tetrahedron19 cube)) $ I
+      i20 = eval (Tetrahedron.fv (tetrahedron20 cube)) $ I
+      i21 = eval (Tetrahedron.fv (tetrahedron21 cube)) $ I
+      i22 = eval (Tetrahedron.fv (tetrahedron22 cube)) $ I
+      i23 = eval (Tetrahedron.fv (tetrahedron23 cube)) $ I
+
+
+-- | 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
 -- | 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 +612,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
                               + (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
       t6 = tetrahedron6 cube

-      fvs = Tetrahedron.fv t6
+      fvs = Tetrahedron.fv t0

       int = interior fvs
       f = front fvs
       r = right fvs
       int = interior fvs
       f = front fvs
       r = right fvs