X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FCube.hs;h=4992851f3f7b3f7a3358e33852b53730c9269961;hb=refs%2Fheads%2Fmaster;hp=df2f8abdc47d9e559e42d890f0955f2d87f6facf;hpb=16591937d99af4a899a28fee211cb2285b771abc;p=spline3.git

diff --git a/src/Cube.hs b/src/Cube.hs
index df2f8ab..026f4e9 100644
--- a/src/Cube.hs
+++ b/src/Cube.hs
@@ -1,3 +1,8 @@
+-- The "tetrahedron" function pattern matches on the integers zero
+-- through twenty-three, but doesn't handle the "otherwise" case, for
+-- performance reasons.
+{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
+
 module Cube (
   Cube(..),
   cube_properties,
@@ -15,16 +20,39 @@ import qualified Data.Vector as V (
   singleton,
   snoc,
   unsafeIndex)
-import Prelude hiding ( LT )
+import Prelude(
+  Bool,
+  Double,
+  Int,
+  Eq( (==) ),
+  Fractional( (/) ),
+  Maybe,
+  Num( (+), (-), (*) ),
+  Ord( (>=), (<=) ),
+  Show( show ),
+  ($),
+  (.),
+  (&&),
+  (++),
+  abs,
+  all,
+  and,
+  fromIntegral,
+  head,
+  map,
+  otherwise,
+  return,
+  tail )
 import Test.Tasty ( TestTree, testGroup )
 import Test.Tasty.QuickCheck (
-  Arbitrary(..),
+  Arbitrary( arbitrary ),
   Gen,
-  Positive(..),
+  Positive( Positive ),
   choose,
   testProperty )
 import Cardinal (
-  Cardinal(..),
+  Cardinal(F, B, L, R, D, T, FL, FR, FD, FT,
+           BL, BR, BD, BT, LD, LT, RD, RT, I),
   ccwx,
   ccwy,
   ccwz,
@@ -35,8 +63,12 @@ import Comparisons ( (~=), (~~=) )
 import qualified Face ( Face(..), center )
 import FunctionValues ( FunctionValues, eval, rotate )
 import Misc ( all_equal, disjoint )
-import Point ( Point(..), dot )
-import Tetrahedron ( Tetrahedron(..), barycenter, c, volume )
+import Point ( Point( Point ), dot )
+import Tetrahedron (
+  Tetrahedron(Tetrahedron, function_values, v0, v1, v2, v3),
+  barycenter,
+  c,
+  volume )
 
 data Cube = Cube { i  :: !Int,
                    j  :: !Int,
@@ -81,42 +113,42 @@ instance Show Cube where
 -- | The left-side boundary of the cube. See Sorokina and Zeilfelder,
 --   p. 76.
 xmin :: Cube -> Double
-xmin cube = (i' - 1/2)
+xmin cube = (i' - 1 / 2)
     where
       i' = fromIntegral (i cube) :: Double
 
 -- | The right-side boundary of the cube. See Sorokina and Zeilfelder,
 --   p. 76.
 xmax :: Cube -> Double
-xmax cube = (i' + 1/2)
+xmax cube = (i' + 1 / 2)
     where
       i' = fromIntegral (i cube) :: Double
 
 -- | The front boundary of the cube. See Sorokina and Zeilfelder,
 --   p. 76.
 ymin :: Cube -> Double
-ymin cube = (j' - 1/2)
+ymin cube = (j' - 1 / 2)
     where
       j' = fromIntegral (j cube) :: Double
 
 -- | The back boundary of the cube. See Sorokina and Zeilfelder,
 --   p. 76.
 ymax :: Cube -> Double
-ymax cube = (j' + 1/2)
+ymax cube = (j' + 1 / 2)
     where
       j' = fromIntegral (j cube) :: Double
 
 -- | The bottom boundary of the cube. See Sorokina and Zeilfelder,
 --   p. 76.
 zmin :: Cube -> Double
-zmin cube = (k' - 1/2)
+zmin cube = (k' - 1 / 2)
     where
       k' = fromIntegral (k cube) :: Double
 
 -- | The top boundary of the cube. See Sorokina and Zeilfelder,
 --   p. 76.
 zmax :: Cube -> Double
-zmax cube = (k' + 1/2)
+zmax cube = (k' + 1 / 2)
     where
       k' = fromIntegral (k cube) :: Double
 
@@ -138,7 +170,7 @@ center cube =
 top_face :: Cube -> Face.Face
 top_face cube = Face.Face v0' v1' v2' v3'
     where
-      delta = (1/2) :: Double
+      delta = (1 / 2) :: Double
       cc  = center cube
       v0' = cc + ( Point delta (-delta) delta )
       v1' = cc + ( Point delta delta delta )
@@ -151,7 +183,7 @@ top_face cube = Face.Face v0' v1' v2' v3'
 back_face :: Cube -> Face.Face
 back_face cube = Face.Face v0' v1' v2' v3'
     where
-      delta = (1/2) :: Double
+      delta = (1 / 2) :: Double
       cc  = center cube
       v0' = cc + ( Point delta (-delta) (-delta) )
       v1' = cc + ( Point delta delta (-delta) )
@@ -163,7 +195,7 @@ back_face cube = Face.Face v0' v1' v2' v3'
 down_face :: Cube -> Face.Face
 down_face cube = Face.Face v0' v1' v2' v3'
     where
-      delta = (1/2) :: Double
+      delta = (1 / 2) :: Double
       cc  = center cube
       v0' = cc + ( Point (-delta) (-delta) (-delta) )
       v1' = cc + ( Point (-delta) delta (-delta) )
@@ -176,7 +208,7 @@ down_face cube = Face.Face v0' v1' v2' v3'
 front_face :: Cube -> Face.Face
 front_face cube = Face.Face v0' v1' v2' v3'
     where
-      delta = (1/2) :: Double
+      delta = (1 / 2) :: Double
       cc  = center cube
       v0' = cc + ( Point (-delta) (-delta) delta )
       v1' = cc + ( Point (-delta) delta delta )
@@ -187,7 +219,7 @@ front_face cube = Face.Face v0' v1' v2' v3'
 left_face :: Cube -> Face.Face
 left_face cube = Face.Face v0' v1' v2' v3'
     where
-      delta = (1/2) :: Double
+      delta = (1 / 2) :: Double
       cc  = center cube
       v0' = cc + ( Point delta (-delta) delta )
       v1' = cc + ( Point (-delta) (-delta) delta )
@@ -199,7 +231,7 @@ left_face cube = Face.Face v0' v1' v2' v3'
 right_face :: Cube -> Face.Face
 right_face cube = Face.Face v0' v1' v2' v3'
     where
-      delta = (1/2) :: Double
+      delta = (1 / 2) :: Double
       cc  = center cube
       v0' = cc + ( Point (-delta) delta delta)
       v1' = cc + ( Point delta  delta delta )
@@ -703,7 +735,7 @@ prop_all_volumes_positive cube =
 --   we'd expect the volume of each one to be 1/24.
 prop_all_volumes_exact :: Cube -> Bool
 prop_all_volumes_exact cube =
-    and [volume t ~~= 1/24 | t <- tetrahedra cube]
+    and [volume t ~~= 1 / 24 | t <- tetrahedra cube]
 
 -- | All tetrahedron should have their v0 located at the center of the
 --   cube.
@@ -908,7 +940,7 @@ prop_c2100_identity2 cube =
 prop_c3000_identity :: Cube -> Bool
 prop_c3000_identity cube =
     c t0 3 0 0 0 ~= c t0 2 1 0 0 + c t6 2 1 0 0
-                    - ((c t0 2 0 1 0 + c t0 2 0 0 1)/ 2)
+                    - ((c t0 2 0 1 0 + c t0 2 0 0 1) / 2)
       where
         t0 = tetrahedron cube 0
         t6 = tetrahedron cube 6
@@ -919,7 +951,7 @@ prop_c3000_identity cube =
 prop_c2010_identity :: Cube -> Bool
 prop_c2010_identity cube =
     c t0 2 0 1 0 ~= c t0 1 1 1 0 + c t6 1 1 0 1
-                    - ((c t0 1 0 2 0 + c t0 1 0 1 1)/ 2)
+                    - ((c t0 1 0 2 0 + c t0 1 0 1 1) / 2)
       where
         t0 = tetrahedron cube 0
         t6 = tetrahedron cube 6
@@ -930,7 +962,7 @@ prop_c2010_identity cube =
 prop_c2001_identity :: Cube -> Bool
 prop_c2001_identity cube =
     c t0 2 0 0 1 ~= c t0 1 1 0 1 + c t6 1 1 1 0
-                    - ((c t0 1 0 0 2 + c t0 1 0 1 1)/ 2)
+                    - ((c t0 1 0 0 2 + c t0 1 0 1 1) / 2)
       where
         t0 = tetrahedron cube 0
         t6 = tetrahedron cube 6
@@ -941,7 +973,7 @@ prop_c2001_identity cube =
 prop_c1020_identity :: Cube -> Bool
 prop_c1020_identity cube =
     c t0 1 0 2 0 ~= c t0 0 1 2 0 + c t6 0 1 0 2
-                    - ((c t0 0 0 3 0 + c t0 0 0 2 1)/ 2)
+                    - ((c t0 0 0 3 0 + c t0 0 0 2 1) / 2)
       where
         t0 = tetrahedron cube 0
         t6 = tetrahedron cube 6
@@ -952,7 +984,7 @@ prop_c1020_identity cube =
 prop_c1002_identity :: Cube -> Bool
 prop_c1002_identity cube =
     c t0 1 0 0 2 ~= c t0 0 1 0 2 + c t6 0 1 2 0
-                    - ((c t0 0 0 0 3 + c t0 0 0 1 2)/ 2)
+                    - ((c t0 0 0 0 3 + c t0 0 0 1 2) / 2)
       where
         t0 = tetrahedron cube 0
         t6 = tetrahedron cube 6
@@ -963,7 +995,7 @@ prop_c1002_identity cube =
 prop_c1011_identity :: Cube -> Bool
 prop_c1011_identity cube =
     c t0 1 0 1 1 ~= c t0 0 1 1 1 + c t6 0 1 1 1 -
-                    ((c t0 0 0 1 2 + c t0 0 0 2 1)/ 2)
+                    ((c t0 0 0 1 2 + c t0 0 0 2 1) / 2)
       where
         t0 = tetrahedron cube 0
         t6 = tetrahedron cube 6
@@ -987,23 +1019,23 @@ prop_c_tilde_2100_rotation_correct cube =
 
       -- What gets computed for c2100 of t6.
       expr1 = eval (function_values 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)
+          (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 (function_values 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)
+              (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
@@ -1020,13 +1052,13 @@ prop_c_tilde_2100_correct cube =
       t6 = tetrahedron cube 6
       fvs = function_values t0
       expected = eval fvs $
-                  (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)
+                  (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)
 
 
 -- Tests to check that the correct edges are incidental.