Added the Everything module.

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

diff --git a/src/Tests/Cube.hs b/src/Tests/Cube.hs
index 58469779293c33577908dd66b3638d1ee8c5a45b..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)


@@ -537,15 +540,81 @@ prop_c1011_identity cube =
 --         t1 = tetrahedron1 cube
 
 
 --         t1 = tetrahedron1 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.
 -- | 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
 prop_c_tilde_2100_correct cube =
     c t6 2 1 0 0 == (3/8)*int + (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)
     where
 prop_c_tilde_2100_correct :: Cube -> Bool
 prop_c_tilde_2100_correct cube =
     c t6 2 1 0 0 == (3/8)*int + (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)
     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