X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTetrahedron.hs;h=d468f0c570a920fe3967fdd7e20973ef2cd9945e;hb=aed1b3cc557b67aca7d8b3259f44715078db94ae;hp=4606761b94b3df7986fd07ce18b9d32277677d8b;hpb=3d197ab1a23d654d60617db6559daed195f1e016;p=spline3.git diff --git a/src/Tetrahedron.hs b/src/Tetrahedron.hs index 4606761..d468f0c 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, Positive(..)) +import Test.QuickCheck (Arbitrary(..), Gen, choose) import Cardinal import Comparisons (nearly_ge) @@ -13,13 +13,20 @@ import Point import RealFunction import ThreeDimensional -data Tetrahedron = Tetrahedron { fv :: FunctionValues, - v0 :: Point, - v1 :: Point, - v2 :: Point, - v3 :: Point, - precomputed_volume :: Double } - deriving (Eq) +data Tetrahedron = + Tetrahedron { fv :: FunctionValues, + v0 :: Point, + v1 :: Point, + v2 :: Point, + v3 :: Point, + precomputed_volume :: Double, + + -- | Between 0 and 23; used to quickly determine which + -- tetrahedron I am in the parent 'Cube' without + -- having to compare them all. + number :: Int + } + deriving (Eq) instance Arbitrary Tetrahedron where @@ -29,8 +36,13 @@ instance Arbitrary Tetrahedron where rnd_v2 <- arbitrary :: Gen Point rnd_v3 <- arbitrary :: Gen Point rnd_fv <- arbitrary :: Gen FunctionValues - (Positive rnd_vol) <- arbitrary :: Gen (Positive Double) - return (Tetrahedron rnd_fv rnd_v0 rnd_v1 rnd_v2 rnd_v3 rnd_vol) + rnd_no <- choose (0,23) + + -- We can't assign an incorrect precomputed volume, + -- so we have to calculate the correct one here. + let t' = Tetrahedron rnd_fv rnd_v0 rnd_v1 rnd_v2 rnd_v3 0 rnd_no + let vol = volume t' + return (Tetrahedron rnd_fv rnd_v0 rnd_v1 rnd_v2 rnd_v3 vol rnd_no) instance Show Tetrahedron where