X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTetrahedron.hs;h=f1614f9004b8a984b8e29ff3095072f1c16a72a4;hb=edd0bfa30456c0f609418e730af641835b8650aa;hp=e71151a1e6a1d370a1057010415976a332cc15fe;hpb=db0cb44e128f8dc20625bc0888000df262cbe2ac;p=spline3.git diff --git a/src/Tetrahedron.hs b/src/Tetrahedron.hs index e71151a..f1614f9 100644 --- a/src/Tetrahedron.hs +++ b/src/Tetrahedron.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE BangPatterns #-} module Tetrahedron ( Tetrahedron(..), b0, -- Cube test @@ -27,17 +28,17 @@ 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(..)) data Tetrahedron = Tetrahedron { function_values :: FunctionValues, - v0 :: Point, - v1 :: Point, - v2 :: Point, - v3 :: Point, - precomputed_volume :: Double + v0 :: !Point, + v1 :: !Point, + v2 :: !Point, + v3 :: !Point, + precomputed_volume :: !Double } deriving (Eq) @@ -70,6 +71,7 @@ instance ThreeDimensional Tetrahedron where center (Tetrahedron _ v0' v1' v2' v3' _) = (v0' + v1' + v2' + v3') `scale` (1/4) + -- contains_point is only used in tests. contains_point t p0 = b0_unscaled `nearly_ge` 0 && b1_unscaled `nearly_ge` 0 && @@ -142,7 +144,7 @@ beta t i j k l -- Zeilfelder, pp. 84-86. If incorrect indices are supplied, the -- function will simply error. c :: Tetrahedron -> Int -> Int -> Int -> Int -> Double -c t i j k l = +c !t !i !j !k !l = coefficient i j k l where fvs = function_values t @@ -292,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 @@ -365,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, @@ -386,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 @@ -400,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, @@ -419,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 @@ -433,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, @@ -456,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, @@ -471,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, @@ -486,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,