From edd0bfa30456c0f609418e730af641835b8650aa Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Tue, 25 Oct 2011 23:28:46 -0400 Subject: [PATCH] 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. --- src/Cube.hs | 60 +++++++++++++++++++++++----------------------- src/Grid.hs | 23 +++++++++--------- src/Point.hs | 37 ++++++++++++++++++++-------- src/Tetrahedron.hs | 52 ++++++++++++++++++++-------------------- 4 files changed, 94 insertions(+), 78 deletions(-) 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, -- 2.43.2