From 3d197ab1a23d654d60617db6559daed195f1e016 Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Fri, 2 Sep 2011 09:34:42 -0400 Subject: [PATCH] Attempt to use precomputed volumes everywhere, tests fail en masse. --- src/Cube.hs | 61 ++++++++++++++++++++++------------------ src/Grid.hs | 5 +++- src/Tests/Tetrahedron.hs | 18 ++++++++---- src/Tetrahedron.hs | 16 ++++++----- 4 files changed, 59 insertions(+), 41 deletions(-) diff --git a/src/Cube.hs b/src/Cube.hs index 0122aea..077fbbc 100644 --- a/src/Cube.hs +++ b/src/Cube.hs @@ -15,7 +15,8 @@ data Cube = Cube { h :: Double, i :: Int, j :: Int, k :: Int, - fv :: FunctionValues } + fv :: FunctionValues, + tetrahedra_volume :: Double } deriving (Eq) @@ -26,7 +27,8 @@ instance Arbitrary Cube where j' <- choose (coordmin, coordmax) k' <- choose (coordmin, coordmax) fv' <- arbitrary :: Gen FunctionValues - return (Cube h' i' j' k' fv') + (Positive tet_vol) <- arbitrary :: Gen (Positive Double) + return (Cube h' i' j' k' fv' tet_vol) where coordmin = -268435456 -- -(2^29 / 2) coordmax = 268435456 -- +(2^29 / 2) @@ -51,7 +53,7 @@ instance Show Cube where -- | Returns an empty 'Cube'. empty_cube :: Cube -empty_cube = Cube 0 0 0 0 empty_values +empty_cube = Cube 0 0 0 0 empty_values 0 -- | The left-side boundary of the cube. See Sorokina and Zeilfelder, @@ -197,9 +199,14 @@ right_face c = Face.Face v0' v1' v2' v3' v3' = (center c) + (-delta, delta, -delta) +make_tetrahedron :: Cube -> Point -> Point -> Point -> Point -> Tetrahedron +make_tetrahedron c v0 v1 v2 v3 = + Tetrahedron (Cube.fv c) v0 v1 v2 v3 (tetrahedra_volume c) + + tetrahedron0 :: Cube -> Tetrahedron tetrahedron0 c = - Tetrahedron (Cube.fv c) v0' v1' v2' v3' + make_tetrahedron c v0' v1' v2' v3' where v0' = center c v1' = center (front_face c) @@ -208,7 +215,7 @@ tetrahedron0 c = tetrahedron1 :: Cube -> Tetrahedron tetrahedron1 c = - Tetrahedron fv' v0' v1' v2' v3' + make_tetrahedron c v0' v1' v2' v3' where v0' = center c v1' = center (front_face c) @@ -218,7 +225,7 @@ tetrahedron1 c = tetrahedron2 :: Cube -> Tetrahedron tetrahedron2 c = - Tetrahedron fv' v0' v1' v2' v3' + make_tetrahedron c v0' v1' v2' v3' where v0' = center c v1' = center (front_face c) @@ -228,7 +235,7 @@ tetrahedron2 c = tetrahedron3 :: Cube -> Tetrahedron tetrahedron3 c = - Tetrahedron fv' v0' v1' v2' v3' + make_tetrahedron c v0' v1' v2' v3' where v0' = center c v1' = center (front_face c) @@ -238,7 +245,7 @@ tetrahedron3 c = tetrahedron4 :: Cube -> Tetrahedron tetrahedron4 c = - Tetrahedron fv' v0' v1' v2' v3' + make_tetrahedron c v0' v1' v2' v3' where v0' = center c v1' = center (top_face c) @@ -248,7 +255,7 @@ tetrahedron4 c = tetrahedron5 :: Cube -> Tetrahedron tetrahedron5 c = - Tetrahedron fv' v0' v1' v2' v3' + make_tetrahedron c v0' v1' v2' v3' where v0' = center c v1' = center (top_face c) @@ -258,7 +265,7 @@ tetrahedron5 c = tetrahedron6 :: Cube -> Tetrahedron tetrahedron6 c = - Tetrahedron fv' v0' v1' v2' v3' + make_tetrahedron c v0' v1' v2' v3' where v0' = center c v1' = center (top_face c) @@ -270,7 +277,7 @@ tetrahedron6 c = tetrahedron7 :: Cube -> Tetrahedron tetrahedron7 c = - Tetrahedron fv' v0' v1' v2' v3' + make_tetrahedron c v0' v1' v2' v3' where v0' = center c v1' = center (top_face c) @@ -280,7 +287,7 @@ tetrahedron7 c = tetrahedron8 :: Cube -> Tetrahedron tetrahedron8 c = - Tetrahedron fv' v0' v1' v2' v3' + make_tetrahedron c v0' v1' v2' v3' where v0' = center c v1' = center (back_face c) @@ -290,7 +297,7 @@ tetrahedron8 c = tetrahedron9 :: Cube -> Tetrahedron tetrahedron9 c = - Tetrahedron fv' v0' v1' v2' v3' + make_tetrahedron c v0' v1' v2' v3' where v0' = center c v1' = center (back_face c) @@ -302,7 +309,7 @@ tetrahedron9 c = tetrahedron10 :: Cube -> Tetrahedron tetrahedron10 c = - Tetrahedron fv' v0' v1' v2' v3' + make_tetrahedron c v0' v1' v2' v3' where v0' = center c v1' = center (back_face c) @@ -316,7 +323,7 @@ tetrahedron10 c = tetrahedron11 :: Cube -> Tetrahedron tetrahedron11 c = - Tetrahedron fv' v0' v1' v2' v3' + make_tetrahedron c v0' v1' v2' v3' where v0' = center c v1' = center (back_face c) @@ -329,7 +336,7 @@ tetrahedron11 c = tetrahedron12 :: Cube -> Tetrahedron tetrahedron12 c = - Tetrahedron fv' v0' v1' v2' v3' + make_tetrahedron c v0' v1' v2' v3' where v0' = center c v1' = center (down_face c) @@ -340,7 +347,7 @@ tetrahedron12 c = tetrahedron13 :: Cube -> Tetrahedron tetrahedron13 c = - Tetrahedron fv' v0' v1' v2' v3' + make_tetrahedron c v0' v1' v2' v3' where v0' = center c v1' = center (down_face c) @@ -351,7 +358,7 @@ tetrahedron13 c = tetrahedron14 :: Cube -> Tetrahedron tetrahedron14 c = - Tetrahedron fv' v0' v1' v2' v3' + make_tetrahedron c v0' v1' v2' v3' where v0' = center c v1' = center (down_face c) @@ -364,7 +371,7 @@ tetrahedron14 c = tetrahedron15 :: Cube -> Tetrahedron tetrahedron15 c = - Tetrahedron fv' v0' v1' v2' v3' + make_tetrahedron c v0' v1' v2' v3' where v0' = center c v1' = center (down_face c) @@ -375,7 +382,7 @@ tetrahedron15 c = tetrahedron16 :: Cube -> Tetrahedron tetrahedron16 c = - Tetrahedron fv' v0' v1' v2' v3' + make_tetrahedron c v0' v1' v2' v3' where v0' = center c v1' = center (right_face c) @@ -386,7 +393,7 @@ tetrahedron16 c = tetrahedron17 :: Cube -> Tetrahedron tetrahedron17 c = - Tetrahedron fv' v0' v1' v2' v3' + make_tetrahedron c v0' v1' v2' v3' where v0' = center c v1' = center (right_face c) @@ -397,7 +404,7 @@ tetrahedron17 c = tetrahedron18 :: Cube -> Tetrahedron tetrahedron18 c = - Tetrahedron fv' v0' v1' v2' v3' + make_tetrahedron c v0' v1' v2' v3' where v0' = center c v1' = center (right_face c) @@ -410,7 +417,7 @@ tetrahedron18 c = tetrahedron19 :: Cube -> Tetrahedron tetrahedron19 c = - Tetrahedron fv' v0' v1' v2' v3' + make_tetrahedron c v0' v1' v2' v3' where v0' = center c v1' = center (right_face c) @@ -422,7 +429,7 @@ tetrahedron19 c = tetrahedron20 :: Cube -> Tetrahedron tetrahedron20 c = - Tetrahedron fv' v0' v1' v2' v3' + make_tetrahedron c v0' v1' v2' v3' where v0' = center c v1' = center (left_face c) @@ -433,7 +440,7 @@ tetrahedron20 c = tetrahedron21 :: Cube -> Tetrahedron tetrahedron21 c = - Tetrahedron fv' v0' v1' v2' v3' + make_tetrahedron c v0' v1' v2' v3' where v0' = center c v1' = center (left_face c) @@ -444,7 +451,7 @@ tetrahedron21 c = tetrahedron22 :: Cube -> Tetrahedron tetrahedron22 c = - Tetrahedron fv' v0' v1' v2' v3' + make_tetrahedron c v0' v1' v2' v3' where v0' = center c v1' = center (left_face c) @@ -457,7 +464,7 @@ tetrahedron22 c = tetrahedron23 :: Cube -> Tetrahedron tetrahedron23 c = - Tetrahedron fv' v0' v1' v2' v3' + make_tetrahedron c v0' v1' v2' v3' where v0' = center c v1' = center (left_face c) diff --git a/src/Grid.hs b/src/Grid.hs index 7325d2b..435f095 100644 --- a/src/Grid.hs +++ b/src/Grid.hs @@ -57,7 +57,10 @@ cubes g | i <- [0..xmax], j <- [0..ymax], k <- [0..zmax], - let cube_ijk = Cube (h g) i j k (make_values fvs i j k)] + let delta = h g, + let tet_vol = (1/24)*(delta^(3::Int)), + let cube_ijk = + Cube delta i j k (make_values fvs i j k) tet_vol] where xmax = xsize - 1 ymax = ysize - 1 diff --git a/src/Tests/Tetrahedron.hs b/src/Tests/Tetrahedron.hs index 8f83808..3b511d2 100644 --- a/src/Tests/Tetrahedron.hs +++ b/src/Tests/Tetrahedron.hs @@ -34,7 +34,8 @@ tetrahedron1_geometry_tests = v1 = p1, v2 = p2, v3 = p3, - fv = empty_values } + fv = empty_values, + precomputed_volume = 0 } volume1 :: Assertion volume1 = @@ -68,7 +69,8 @@ tetrahedron2_geometry_tests = v1 = p1, v2 = p2, v3 = p3, - fv = empty_values } + fv = empty_values, + precomputed_volume = 0 } volume1 :: Assertion volume1 = assertEqual "volume1 is correct" True (vol ~= (1/3)) @@ -106,7 +108,8 @@ containment_tests = v1 = p1, v2 = p2, v3 = p3, - fv = empty_values } + fv = empty_values, + precomputed_volume = 0 } contained = contains_point t exterior_point @@ -120,7 +123,8 @@ containment_tests = v1 = p1, v2 = p2, v3 = p3, - fv = empty_values } + fv = empty_values, + precomputed_volume = 0 } contained = contains_point t exterior_point @@ -134,7 +138,8 @@ containment_tests = v1 = p1, v2 = p2, v3 = p3, - fv = empty_values } + fv = empty_values, + precomputed_volume = 0 } contained = contains_point t exterior_point @@ -148,7 +153,8 @@ containment_tests = v1 = p1, v2 = p2, v3 = p3, - fv = empty_values } + fv = empty_values, + precomputed_volume = 0 } contained = contains_point t exterior_point diff --git a/src/Tetrahedron.hs b/src/Tetrahedron.hs index 95233e0..4606761 100644 --- a/src/Tetrahedron.hs +++ b/src/Tetrahedron.hs @@ -3,7 +3,7 @@ where import Numeric.LinearAlgebra hiding (i, scale) import Prelude hiding (LT) -import Test.QuickCheck (Arbitrary(..), Gen) +import Test.QuickCheck (Arbitrary(..), Gen, Positive(..)) import Cardinal import Comparisons (nearly_ge) @@ -17,7 +17,8 @@ data Tetrahedron = Tetrahedron { fv :: FunctionValues, v0 :: Point, v1 :: Point, v2 :: Point, - v3 :: Point } + v3 :: Point, + precomputed_volume :: Double } deriving (Eq) @@ -28,7 +29,8 @@ instance Arbitrary Tetrahedron where rnd_v2 <- arbitrary :: Gen Point rnd_v3 <- arbitrary :: Gen Point rnd_fv <- arbitrary :: Gen FunctionValues - return (Tetrahedron rnd_fv rnd_v0 rnd_v1 rnd_v2 rnd_v3) + (Positive rnd_vol) <- arbitrary :: Gen (Positive Double) + return (Tetrahedron rnd_fv rnd_v0 rnd_v1 rnd_v2 rnd_v3 rnd_vol) instance Show Tetrahedron where @@ -265,27 +267,27 @@ volume t -- | The barycentric coordinates of a point with respect to v0. b0 :: Tetrahedron -> (RealFunction Point) -b0 t point = (volume inner_tetrahedron) / (volume t) +b0 t point = (volume inner_tetrahedron) / (precomputed_volume t) where inner_tetrahedron = t { v0 = point } -- | The barycentric coordinates of a point with respect to v1. b1 :: Tetrahedron -> (RealFunction Point) -b1 t point = (volume inner_tetrahedron) / (volume t) +b1 t point = (volume inner_tetrahedron) / (precomputed_volume t) where inner_tetrahedron = t { v1 = point } -- | The barycentric coordinates of a point with respect to v2. b2 :: Tetrahedron -> (RealFunction Point) -b2 t point = (volume inner_tetrahedron) / (volume t) +b2 t point = (volume inner_tetrahedron) / (precomputed_volume t) where inner_tetrahedron = t { v2 = point } -- | The barycentric coordinates of a point with respect to v3. b3 :: Tetrahedron -> (RealFunction Point) -b3 t point = (volume inner_tetrahedron) / (volume t) +b3 t point = (volume inner_tetrahedron) / (precomputed_volume t) where inner_tetrahedron = t { v3 = point } -- 2.43.2