From: Michael Orlitzky <michael@orlitzky.com>
Date: Wed, 26 Oct 2011 03:28:46 +0000 (-0400)
Subject: Define a custom 'Point' type instead of a 3-tuple so that its constructor can be... 
X-Git-Tag: 0.0.1~79
X-Git-Url: https://gitweb.michael.orlitzky.com/?a=commitdiff_plain;h=edd0bfa30456c0f609418e730af641835b8650aa;p=spline3.git

Define a custom 'Point' type instead of a 3-tuple so that its constructor can be made strict.
Updated all 'Point' references to use the new constructor.
---

diff --git a/src/Cube.hs b/src/Cube.hs
index 1c654ff..3c82f67 100644
--- a/src/Cube.hs
+++ b/src/Cube.hs
@@ -27,7 +27,7 @@ import Comparisons ((~=), (~~=))
 import qualified Face (Face(Face, v0, v1, v2, v3))
 import FunctionValues (FunctionValues, eval, rotate)
 import Misc (all_equal, disjoint)
-import Point
+import Point (Point(..), dot)
 import Tetrahedron (Tetrahedron(..), c, volume)
 import ThreeDimensional
 
@@ -125,7 +125,7 @@ zmax cube = (k' + 1/2)*delta
 instance ThreeDimensional Cube where
     -- | The center of Cube_ijk coincides with v_ijk at
     --   (ih, jh, kh). See Sorokina and Zeilfelder, p. 76.
-    center cube = (x, y, z)
+    center cube = Point x y z
            where
              delta = h cube
              i' = fromIntegral (i cube) :: Double
@@ -137,7 +137,7 @@ instance ThreeDimensional Cube where
 
     -- | It's easy to tell if a point is within a cube; just make sure
     --   that it falls on the proper side of each of the cube's faces.
-    contains_point cube (x, y, z)
+    contains_point cube (Point x y z)
         | x < (xmin cube) = False
         | x > (xmax cube) = False
         | y < (ymin cube) = False
@@ -156,10 +156,10 @@ top_face cube = Face.Face v0' v1' v2' v3'
     where
       delta = (1/2)*(h cube)
       cc  = center cube
-      v0' = cc + (delta, -delta, delta)
-      v1' = cc + (delta, delta, delta)
-      v2' = cc + (-delta, delta, delta)
-      v3' = cc + (-delta, -delta, delta)
+      v0' = cc + ( Point delta (-delta) delta )
+      v1' = cc + ( Point delta delta delta )
+      v2' = cc + ( Point (-delta) delta delta )
+      v3' = cc + ( Point (-delta) (-delta) delta )
 
 
 
@@ -169,10 +169,10 @@ back_face cube = Face.Face v0' v1' v2' v3'
     where
       delta = (1/2)*(h cube)
       cc  = center cube
-      v0' = cc + (delta, -delta, -delta)
-      v1' = cc + (delta, delta, -delta)
-      v2' = cc + (delta, delta, delta)
-      v3' = cc + (delta, -delta, delta)
+      v0' = cc + ( Point delta (-delta) (-delta) )
+      v1' = cc + ( Point delta delta (-delta) )
+      v2' = cc + ( Point delta delta delta )
+      v3' = cc + ( Point delta (-delta) delta )
 
 
 -- The bottom face (in the direction of -z) of the cube.
@@ -181,10 +181,10 @@ down_face cube = Face.Face v0' v1' v2' v3'
     where
       delta = (1/2)*(h cube)
       cc  = center cube
-      v0' = cc + (-delta, -delta, -delta)
-      v1' = cc + (-delta, delta, -delta)
-      v2' = cc + (delta, delta, -delta)
-      v3' = cc + (delta, -delta, -delta)
+      v0' = cc + ( Point (-delta) (-delta) (-delta) )
+      v1' = cc + ( Point (-delta) delta (-delta) )
+      v2' = cc + ( Point delta delta (-delta) )
+      v3' = cc + ( Point delta (-delta) (-delta) )
 
 
 
@@ -194,10 +194,10 @@ front_face cube = Face.Face v0' v1' v2' v3'
     where
       delta = (1/2)*(h cube)
       cc  = center cube
-      v0' = cc + (-delta, -delta, delta)
-      v1' = cc + (-delta, delta, delta)
-      v2' = cc + (-delta, delta, -delta)
-      v3' = cc + (-delta, -delta, -delta)
+      v0' = cc + ( Point (-delta) (-delta) delta )
+      v1' = cc + ( Point (-delta) delta delta )
+      v2' = cc + ( Point (-delta) delta (-delta) )
+      v3' = cc + ( Point (-delta) (-delta) (-delta) )
 
 -- | The left (in the direction of -y) face of the cube.
 left_face :: Cube -> Face.Face
@@ -205,10 +205,10 @@ left_face cube = Face.Face v0' v1' v2' v3'
     where
       delta = (1/2)*(h cube)
       cc  = center cube
-      v0' = cc + (delta, -delta, delta)
-      v1' = cc + (-delta, -delta, delta)
-      v2' = cc + (-delta, -delta, -delta)
-      v3' = cc + (delta, -delta, -delta)
+      v0' = cc + ( Point delta (-delta) delta )
+      v1' = cc + ( Point (-delta) (-delta) delta )
+      v2' = cc + ( Point (-delta) (-delta) (-delta) )
+      v3' = cc + ( Point delta (-delta) (-delta) )
 
 
 -- | The right (in the direction of y) face of the cube.
@@ -217,10 +217,10 @@ right_face cube = Face.Face v0' v1' v2' v3'
     where
       delta = (1/2)*(h cube)
       cc  = center cube
-      v0' = cc + (-delta, delta, delta)
-      v1' = cc + (delta, delta, delta)
-      v2' = cc + (delta, delta, -delta)
-      v3' = cc + (-delta, delta, -delta)
+      v0' = cc + ( Point (-delta) delta delta)
+      v1' = cc + ( Point delta  delta delta )
+      v2' = cc + ( Point delta delta (-delta) )
+      v3' = cc + ( Point (-delta) delta (-delta) )
 
 
 tetrahedron :: Cube -> Int -> Tetrahedron
@@ -588,14 +588,14 @@ back_right_down_tetrahedra  cube =
     (tetrahedron cube 18)
 
 in_top_half :: Cube -> Point -> Bool
-in_top_half cube (_,_,z) =
+in_top_half cube (Point _ _ z) =
   distance_from_top <= distance_from_bottom
   where
     distance_from_top = abs $ (zmax cube) - z
     distance_from_bottom = abs $ (zmin cube) - z
 
 in_front_half :: Cube -> Point -> Bool
-in_front_half cube (x,_,_) =
+in_front_half cube (Point x _ _) =
     distance_from_front <= distance_from_back
   where
     distance_from_front = abs $ (xmin cube) - x
@@ -603,7 +603,7 @@ in_front_half cube (x,_,_) =
 
 
 in_left_half :: Cube -> Point -> Bool
-in_left_half cube (_,y,_) =
+in_left_half cube (Point _ y _) =
     distance_from_left <= distance_from_right
   where
     distance_from_left = abs $ (ymin cube) - y
diff --git a/src/Grid.hs b/src/Grid.hs
index d5553b4..de5f76a 100644
--- a/src/Grid.hs
+++ b/src/Grid.hs
@@ -30,7 +30,7 @@ import Cube (Cube(Cube),
              tetrahedron)
 import Examples (trilinear, trilinear9x9x9, zeros, naturals_1d)
 import FunctionValues (make_values, value_at)
-import Point (Point)
+import Point (Point(..))
 import ScaleFactor (ScaleFactor)
 import Tetrahedron (Tetrahedron, c, polynomial, v0, v1, v2, v3)
 import ThreeDimensional (ThreeDimensional(..))
@@ -105,10 +105,9 @@ calculate_containing_cube_coordinate g coord
 --   Since our grid is rectangular, we can figure this out without having
 --   to check every cube.
 find_containing_cube :: Grid -> Point -> Cube
-find_containing_cube g p =
+find_containing_cube g (Point x y z) =
     cube_at g i j k
     where
-      (x, y, z) = p
       i = calculate_containing_cube_coordinate g x
       j = calculate_containing_cube_coordinate g y
       k = calculate_containing_cube_coordinate g z
@@ -128,7 +127,7 @@ zoom_result v3d (sfx, sfy, sfz) (R.Z R.:. m R.:. n R.:. o) =
     m' = (fromIntegral m) / (fromIntegral sfx) - offset
     n' = (fromIntegral n) / (fromIntegral sfy) - offset
     o' = (fromIntegral o) / (fromIntegral sfz) - offset
-    p  = (m', n', o') :: Point
+    p  = Point m' n' o'
     cube = find_containing_cube g p
     t = find_containing_tetrahedron cube p
     f = polynomial t
@@ -270,25 +269,25 @@ trilinear_c0_t0_tests =
 
     test_trilinear_f0_t0_v0 :: Assertion
     test_trilinear_f0_t0_v0 =
-      assertEqual "v0 is correct" (v0 t) (1, 1, 1)
+      assertEqual "v0 is correct" (v0 t) (Point 1 1 1)
 
     test_trilinear_f0_t0_v1 :: Assertion
     test_trilinear_f0_t0_v1 =
-      assertEqual "v1 is correct" (v1 t) (0.5, 1, 1)
+      assertEqual "v1 is correct" (v1 t) (Point 0.5 1 1)
 
     test_trilinear_f0_t0_v2 :: Assertion
     test_trilinear_f0_t0_v2 =
-      assertEqual "v2 is correct" (v2 t) (0.5, 0.5, 1.5)
+      assertEqual "v2 is correct" (v2 t) (Point 0.5 0.5 1.5)
 
     test_trilinear_f0_t0_v3 :: Assertion
     test_trilinear_f0_t0_v3 =
-      assertEqual "v3 is correct" (v3 t) (0.5, 1.5, 1.5)
+      assertEqual "v3 is correct" (v3 t) (Point 0.5 1.5 1.5)
 
 
 test_trilinear_reproduced :: Assertion
 test_trilinear_reproduced =
     assertTrue "trilinears are reproduced correctly" $
-             and [p (i', j', k') ~= value_at trilinear i j k
+             and [p (Point i' j' k') ~= value_at trilinear i j k
                     | i <- [0..2],
                       j <- [0..2],
                       k <- [0..2],
@@ -306,7 +305,7 @@ test_trilinear_reproduced =
 test_zeros_reproduced :: Assertion
 test_zeros_reproduced =
     assertTrue "the zero function is reproduced correctly" $
-             and [p (i', j', k') ~= value_at zeros i j k
+             and [p (Point i' j' k') ~= value_at zeros i j k
                     | i <- [0..2],
                       j <- [0..2],
                       k <- [0..2],
@@ -325,7 +324,7 @@ test_zeros_reproduced =
 test_trilinear9x9x9_reproduced :: Assertion
 test_trilinear9x9x9_reproduced =
     assertTrue "trilinear 9x9x9 is reproduced correctly" $
-      and [p (i', j', k') ~= value_at trilinear9x9x9 i j k
+      and [p (Point i' j' k') ~= value_at trilinear9x9x9 i j k
             | i <- [0..8],
               j <- [0..8],
               k <- [0..8],
@@ -355,7 +354,7 @@ test_tetrahedra_collision_sensitivity =
   where
     g = make_grid 1 naturals_1d
     cube = cube_at g 0 18 0
-    p = (0, 17.5, 0.5) :: Point
+    p = Point 0 17.5 0.5
     t20 = tetrahedron cube 20
 
 
diff --git a/src/Point.hs b/src/Point.hs
index fd3ac58..a334c5c 100644
--- a/src/Point.hs
+++ b/src/Point.hs
@@ -1,30 +1,47 @@
 {-# LANGUAGE FlexibleInstances #-}
 
 module Point (
-  Point,
+  Point(..),
   dot,
   scale
   )
 where
 
-type Point = (Double, Double, Double)
+import Test.QuickCheck (Arbitrary(..))
+
+
+-- | Represents a point in three dimensions. We use a custom type (as
+--   opposed to a 3-tuple) so that we can make the coordinates strict.
+data Point =
+  Point !Double !Double !Double
+  deriving (Eq, Show)
+
+
+instance Arbitrary Point where
+  arbitrary = do
+    (x,y,z) <- arbitrary
+    return $ Point x y z
+
 
 instance Num Point where
-    (x1,y1,z1) + (x2,y2,z2) = (x1+x2, y1+y2, z1+z2)
-    (x1,y1,z1) - (x2,y2,z2) = (x1-x2, y1-y2, z1-z2)
-    (x1,y1,z1) * (x2,y2,z2) = (x1*x2, y1*y2, z1*z2)
-    abs (x, y, z) = (abs x, abs y, abs z)
-    signum (x, y, z) = (signum x, signum y, signum z)
-    fromInteger n = (fromInteger n, fromInteger n, fromInteger n)
+  (Point x1 y1 z1) + (Point x2 y2 z2) = Point (x1+x2) (y1+y2) (z1+z2)
+  (Point x1 y1 z1) - (Point x2 y2 z2) = Point (x1-x2) (y1-y2) (z1-z2)
+  (Point x1 y1 z1) * (Point x2 y2 z2) = Point (x1*x2) (y1*y2) (z1*z2)
+  abs (Point x y z) = Point (abs x) (abs y) (abs z)
+  signum (Point x y z) = Point (signum x) (signum y) (signum z)
+  fromInteger n =
+    Point coord coord coord
+    where
+      coord = fromInteger n
 
 
 -- | Scale a point by a constant.
 scale :: Point -> Double -> Point
-scale (x, y, z) d = (x*d, y*d, z*d)
+scale (Point x y z) d = Point (x*d) (y*d) (z*d)
 
 
 -- | Returns the dot product of two points (taken as three-vectors).
 {-# INLINE dot #-}
 dot :: Point -> Point -> Double
-dot (x1, y1, z1) (x2, y2, z2) =
+dot (Point x1 y1 z1) (Point x2 y2 z2) =
     (x2 - x1)^(2::Int) + (y2 - y1)^(2::Int) + (z2 - z1)^(2::Int)
diff --git a/src/Tetrahedron.hs b/src/Tetrahedron.hs
index 4c7abed..f1614f9 100644
--- a/src/Tetrahedron.hs
+++ b/src/Tetrahedron.hs
@@ -28,7 +28,7 @@ import Test.QuickCheck (Arbitrary(..), Gen, Property, (==>))
 import Comparisons ((~=), nearly_ge)
 import FunctionValues (FunctionValues(..), empty_values)
 import Misc (factorial)
-import Point (Point, scale)
+import Point (Point(..), scale)
 import RealFunction (RealFunction, cmult, fexp)
 import ThreeDimensional (ThreeDimensional(..))
 
@@ -294,10 +294,10 @@ det :: Point -> Point -> Point -> Point -> Double
 det p0 p1 p2 p3 =
   term5 + term6
   where
-    (x1, y1, z1) = p0
-    (x2, y2, z2) = p1
-    (x3, y3, z3) = p2
-    (x4, y4, z4) = p3
+    Point x1 y1 z1 = p0
+    Point x2 y2 z2 = p1
+    Point x3 y3 z3 = p2
+    Point x4 y4 z4 = p3
     term1 = ((x2 - x4)*y1 - (x1 - x4)*y2 + (x1 - x2)*y4)*z3
     term2 = ((x2 - x3)*y1 - (x1 - x3)*y2 + (x1 - x2)*y3)*z4
     term3 = ((x3 - x4)*y2 - (x2 - x4)*y3 + (x2 - x3)*y4)*z1
@@ -367,10 +367,10 @@ tetrahedron1_geometry_tests =
               [ testCase "volume1" volume1,
                 testCase "doesn't contain point1" doesnt_contain_point1]
   where
-    p0 = (0, -0.5, 0)
-    p1 = (0, 0.5, 0)
-    p2 = (2, 0, 0)
-    p3 = (1, 0, 1)
+    p0 = Point 0 (-0.5) 0
+    p1 = Point 0 0.5 0
+    p2 = Point 2 0 0
+    p3 = Point 1 0 1
     t = Tetrahedron { v0 = p0,
                       v1 = p1,
                       v2 = p2,
@@ -388,7 +388,7 @@ tetrahedron1_geometry_tests =
     doesnt_contain_point1 =
       assertEqual "doesn't contain an exterior point" False contained
       where
-        exterior_point = (5, 2, -9.0212)
+        exterior_point = Point 5 2 (-9.0212)
         contained = contains_point t exterior_point
 
 
@@ -402,10 +402,10 @@ tetrahedron2_geometry_tests =
               [ testCase "volume1" volume1,
                 testCase "contains point1" contains_point1]
   where
-    p0 = (0, -0.5, 0)
-    p1 = (2, 0, 0)
-    p2 = (0, 0.5, 0)
-    p3 = (1, 0, 1)
+    p0 = Point 0 (-0.5) 0
+    p1 = Point 2 0 0
+    p2 = Point 0 0.5 0
+    p3 = Point 1 0 1
     t = Tetrahedron { v0 = p0,
                       v1 = p1,
                       v2 = p2,
@@ -421,7 +421,7 @@ tetrahedron2_geometry_tests =
     contains_point1 :: Assertion
     contains_point1 = assertEqual "contains an inner point" True contained
         where
-          inner_point = (1, 0, 0.5)
+          inner_point = Point 1 0 0.5
           contained = contains_point t inner_point
 
 
@@ -435,16 +435,16 @@ containment_tests =
                 testCase "doesn't contain point4" doesnt_contain_point4,
                 testCase "doesn't contain point5" doesnt_contain_point5]
   where
-    p2 = (0.5, 0.5, 1)
-    p3 = (0.5, 0.5, 0.5)
-    exterior_point = (0, 0, 0)
+    p2 = Point 0.5 0.5 1
+    p3 = Point 0.5 0.5 0.5
+    exterior_point = Point 0 0 0
 
     doesnt_contain_point2 :: Assertion
     doesnt_contain_point2 =
       assertEqual "doesn't contain an exterior point" False contained
       where
-        p0 = (0, 1, 1)
-        p1 = (1, 1, 1)
+        p0 = Point 0 1 1
+        p1 = Point 1 1 1
         t = Tetrahedron { v0 = p0,
                           v1 = p1,
                           v2 = p2,
@@ -458,8 +458,8 @@ containment_tests =
     doesnt_contain_point3 =
       assertEqual "doesn't contain an exterior point" False contained
       where
-        p0 = (1, 1, 1)
-        p1 = (1, 0, 1)
+        p0 = Point 1 1 1
+        p1 = Point 1 0 1
         t = Tetrahedron { v0 = p0,
                           v1 = p1,
                           v2 = p2,
@@ -473,8 +473,8 @@ containment_tests =
     doesnt_contain_point4 =
       assertEqual "doesn't contain an exterior point" False contained
       where
-        p0 = (1, 0, 1)
-        p1 = (0, 0, 1)
+        p0 = Point 1 0 1
+        p1 = Point 0 0 1
         t = Tetrahedron { v0 = p0,
                           v1 = p1,
                           v2 = p2,
@@ -488,8 +488,8 @@ containment_tests =
     doesnt_contain_point5 =
       assertEqual "doesn't contain an exterior point" False contained
       where
-        p0 = (0, 0, 1)
-        p1 = (0, 1, 1)
+        p0 = Point 0 0 1
+        p1 = Point 0 1 1
         t = Tetrahedron { v0 = p0,
                           v1 = p1,
                           v2 = p2,