module Cardinal
where
+import Control.Monad (liftM, liftM2)
import Prelude hiding (LT)
+import Test.QuickCheck (Arbitrary(..), oneof)
data Cardinal = F -- ^ Front
| B -- ^ Back
fromRational x = Scalar (fromRational x)
+
+instance Arbitrary Cardinal where
+ arbitrary = oneof [f,b,l,r,d,t,fl,fr,fd,ft,bl,br,bd,bt,ld,lt,
+ rd,rt,fld,flt,frd,frt,bld,blt,brd,brt,i,
+ scalar,csum,cdiff,cprod,cquot]
+ where
+ f = return F
+ b = return B
+ l = return L
+ r = return R
+ d = return D
+ t = return T
+ fl = return FL
+ fr = return FR
+ fd = return FD
+ ft = return FT
+ bl = return BL
+ br = return BR
+ bd = return BD
+ bt = return BT
+ ld = return LD
+ lt = return LT
+ rd = return RD
+ rt = return RT
+ fld = return FLD
+ flt = return FLT
+ frd = return FRD
+ frt = return FRT
+ bld = return BLD
+ blt = return BLT
+ brd = return BRD
+ brt = return BRT
+ i = return I
+ scalar = liftM Scalar arbitrary
+ csum = liftM2 Sum arbitrary arbitrary
+ cdiff = liftM2 Difference arbitrary arbitrary
+ cprod = liftM2 Product arbitrary arbitrary
+ cquot = liftM2 Quotient arbitrary arbitrary
+
+
-- | Rotate a cardinal direction counter-clockwise about the x-axis.
ccwx :: Cardinal -> Cardinal
ccwx F = F
module Cube
where
+import Test.QuickCheck (Arbitrary(..), Gen, Positive(..), choose)
+
import Cardinal
import qualified Face (Face(Face, v0, v1, v2, v3))
import FunctionValues
deriving (Eq)
+instance Arbitrary Cube where
+ arbitrary = do
+ (Positive h') <- arbitrary :: Gen (Positive Double)
+ i' <- choose (coordmin, coordmax)
+ j' <- choose (coordmin, coordmax)
+ k' <- choose (coordmin, coordmax)
+ fv' <- arbitrary :: Gen FunctionValues
+ return (Cube h' i' j' k' fv')
+ where
+ coordmin = -268435456 -- -(2^29 / 2)
+ coordmax = 268435456 -- +(2^29 / 2)
+
+
instance Show Cube where
show c =
"Cube_" ++ subscript ++ "\n" ++
where
import Prelude hiding (LT)
+import Test.QuickCheck (Arbitrary(..), choose)
import Cardinal
interior :: Double }
deriving (Eq, Show)
+
+instance Arbitrary FunctionValues where
+ arbitrary = do
+ front' <- choose (min_double, max_double)
+ back' <- choose (min_double, max_double)
+ left' <- choose (min_double, max_double)
+ right' <- choose (min_double, max_double)
+ top' <- choose (min_double, max_double)
+ down' <- choose (min_double, max_double)
+ front_left' <- choose (min_double, max_double)
+ front_right' <- choose (min_double, max_double)
+ front_top' <- choose (min_double, max_double)
+ front_down' <- choose (min_double, max_double)
+ back_left' <- choose (min_double, max_double)
+ back_right' <- choose (min_double, max_double)
+ back_top' <- choose (min_double, max_double)
+ back_down' <- choose (min_double, max_double)
+ left_top' <- choose (min_double, max_double)
+ left_down' <- choose (min_double, max_double)
+ right_top' <- choose (min_double, max_double)
+ right_down' <- choose (min_double, max_double)
+ front_left_top' <- choose (min_double, max_double)
+ front_left_down' <- choose (min_double, max_double)
+ front_right_top' <- choose (min_double, max_double)
+ front_right_down' <- choose (min_double, max_double)
+ back_left_top' <- choose (min_double, max_double)
+ back_left_down' <- choose (min_double, max_double)
+ back_right_top' <- choose (min_double, max_double)
+ back_right_down' <- choose (min_double, max_double)
+ interior' <- choose (min_double, max_double)
+
+ return empty_values { front = front',
+ back = back',
+ left = left',
+ right = right',
+ top = top',
+ down = down',
+ front_left = front_left',
+ front_right = front_right',
+ front_top = front_top',
+ front_down = front_down',
+ back_left = back_left',
+ back_right = back_right',
+ back_top = back_top',
+ back_down = back_down',
+ left_top = left_top',
+ left_down = left_down',
+ right_top = right_top',
+ right_down = right_down',
+ front_left_top = front_left_top',
+ front_left_down = front_left_down',
+ front_right_top = front_right_top',
+ front_right_down = front_right_down',
+ back_left_top = back_left_top',
+ back_left_down = back_left_down',
+ back_right_top = back_right_top',
+ back_right_down = back_right_down',
+ interior = interior' }
+ where
+ -- | We perform addition with the function values contained in a
+ -- FunctionValues object. If we choose random doubles near the machine
+ -- min/max, we risk overflowing or underflowing the 'Double'. This
+ -- places a reasonably safe limit on the maximum size of our generated
+ -- 'Double' members.
+ max_double :: Double
+ max_double = 10000.0
+
+ -- | See 'max_double'.
+ min_double :: Double
+ min_double = (-1) * max_double
+
+
-- | Return a 'FunctionValues' with a bunch of zeros for data points.
empty_values :: FunctionValues
empty_values =
module Grid
where
+import Test.QuickCheck (Arbitrary(..), Gen, Positive(..))
+
import Cube (Cube(Cube))
import FunctionValues
import Misc (flatten)
deriving (Eq, Show)
+instance Arbitrary Grid where
+ arbitrary = do
+ (Positive h') <- arbitrary :: Gen (Positive Double)
+ fvs <- arbitrary :: Gen [[[Double]]]
+ return (make_grid h' fvs)
+
+
-- | The constructor that we want people to use. If we're passed a
-- non-positive grid size, we throw an error.
make_grid :: Double -> [[[Double]]] -> Grid
module Tests.Cardinal
where
-import Control.Monad (liftM, liftM2)
import Prelude hiding (LT)
import Test.HUnit
-import Test.QuickCheck
+import Test.QuickCheck (Property, (==>))
import Cardinal
-
-
-instance Arbitrary Cardinal where
- arbitrary = oneof [f,b,l,r,d,t,fl,fr,fd,ft,bl,br,bd,bt,ld,lt,
- rd,rt,fld,flt,frd,frt,bld,blt,brd,brt,i,
- scalar,csum,cdiff,cprod,cquot]
- where
- f = return F
- b = return B
- l = return L
- r = return R
- d = return D
- t = return T
- fl = return FL
- fr = return FR
- fd = return FD
- ft = return FT
- bl = return BL
- br = return BR
- bd = return BD
- bt = return BT
- ld = return LD
- lt = return LT
- rd = return RD
- rt = return RT
- fld = return FLD
- flt = return FLT
- frd = return FRD
- frt = return FRT
- bld = return BLD
- blt = return BLT
- brd = return BRD
- brt = return BRT
- i = return I
- scalar = liftM Scalar arbitrary
- csum = liftM2 Sum arbitrary arbitrary
- cdiff = liftM2 Difference arbitrary arbitrary
- cprod = liftM2 Product arbitrary arbitrary
- cquot = liftM2 Quotient arbitrary arbitrary
-
-
-- | We know what (c t6 2 1 0 0) should be from Sorokina and
-- Zeilfelder, p. 87. This test checks that the directions are
-- rotated properly. The order of the letters has to be just right
where
import Prelude hiding (LT)
-import Test.QuickCheck
import Cardinal
import Comparisons
import Tetrahedron (b0, b1, b2, b3, c, fv,
v0, v1, v2, v3, volume)
-instance Arbitrary Cube where
- arbitrary = do
- (Positive h') <- arbitrary :: Gen (Positive Double)
- i' <- choose (coordmin, coordmax)
- j' <- choose (coordmin, coordmax)
- k' <- choose (coordmin, coordmax)
- fv' <- arbitrary :: Gen FunctionValues
- return (Cube h' i' j' k' fv')
- where
- coordmin = -268435456 -- -(2^29 / 2)
- coordmax = 268435456 -- +(2^29 / 2)
-- Quickcheck tests.
where
import Test.HUnit
-import Test.QuickCheck
import Assertions
import Examples
import FunctionValues
--- | We perform addition with the function values contained in a
--- FunctionValues object. If we choose random doubles near the machine
--- min/max, we risk overflowing or underflowing the 'Double'. This
--- places a reasonably safe limit on the maximum size of our generated
--- 'Double' members.
-max_double :: Double
-max_double = 10000.0
-
--- | See 'max_double'.
-min_double :: Double
-min_double = (-1) * max_double
-
-
-instance Arbitrary FunctionValues where
- arbitrary = do
- front' <- choose (min_double, max_double)
- back' <- choose (min_double, max_double)
- left' <- choose (min_double, max_double)
- right' <- choose (min_double, max_double)
- top' <- choose (min_double, max_double)
- down' <- choose (min_double, max_double)
- front_left' <- choose (min_double, max_double)
- front_right' <- choose (min_double, max_double)
- front_top' <- choose (min_double, max_double)
- front_down' <- choose (min_double, max_double)
- back_left' <- choose (min_double, max_double)
- back_right' <- choose (min_double, max_double)
- back_top' <- choose (min_double, max_double)
- back_down' <- choose (min_double, max_double)
- left_top' <- choose (min_double, max_double)
- left_down' <- choose (min_double, max_double)
- right_top' <- choose (min_double, max_double)
- right_down' <- choose (min_double, max_double)
- front_left_top' <- choose (min_double, max_double)
- front_left_down' <- choose (min_double, max_double)
- front_right_top' <- choose (min_double, max_double)
- front_right_down' <- choose (min_double, max_double)
- back_left_top' <- choose (min_double, max_double)
- back_left_down' <- choose (min_double, max_double)
- back_right_top' <- choose (min_double, max_double)
- back_right_down' <- choose (min_double, max_double)
- interior' <- choose (min_double, max_double)
-
- return empty_values { front = front',
- back = back',
- left = left',
- right = right',
- top = top',
- down = down',
- front_left = front_left',
- front_right = front_right',
- front_top = front_top',
- front_down = front_down',
- back_left = back_left',
- back_right = back_right',
- back_top = back_top',
- back_down = back_down',
- left_top = left_top',
- left_down = left_down',
- right_top = right_top',
- right_down = right_down',
- front_left_top = front_left_top',
- front_left_down = front_left_down',
- front_right_top = front_right_top',
- front_right_down = front_right_down',
- back_left_top = back_left_top',
- back_left_down = back_left_down',
- back_right_top = back_right_top',
- back_right_down = back_right_down',
- interior = interior' }
-
-
-
-
test_directions :: Assertion
test_directions =
assertTrue "all direction functions work" (and equalities)
import Data.Maybe (fromJust)
import Test.HUnit
-import Test.QuickCheck
import Assertions
import Comparisons
import Tetrahedron
-instance Arbitrary Grid where
- arbitrary = do
- (Positive h') <- arbitrary :: Gen (Positive Double)
- fvs <- arbitrary :: Gen [[[Double]]]
- return (make_grid h' fvs)
-
-
-- | Check the value of c0030 for tetrahedron0 belonging to the
-- cube centered on (1,1,1) with a grid constructed from the
-- trilinear values. See example one in the paper.
where
import Test.HUnit
-import Test.QuickCheck
+import Test.QuickCheck (Property, (==>))
import Cardinal
import Comparisons
-import Point
import FunctionValues
import Tests.FunctionValues()
import Tetrahedron
import ThreeDimensional
-instance Arbitrary Tetrahedron where
- arbitrary = do
- rnd_v0 <- arbitrary :: Gen Point
- rnd_v1 <- arbitrary :: Gen Point
- 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)
-
-- HUnit Tests
import Numeric.LinearAlgebra hiding (i, scale)
import Prelude hiding (LT)
+import Test.QuickCheck (Arbitrary(..), Gen)
import Cardinal
import FunctionValues
v3 :: Point }
deriving (Eq)
+
+instance Arbitrary Tetrahedron where
+ arbitrary = do
+ rnd_v0 <- arbitrary :: Gen Point
+ rnd_v1 <- arbitrary :: Gen Point
+ 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)
+
+
instance Show Tetrahedron where
show t = "Tetrahedron:\n" ++
" fv: " ++ (show (fv t)) ++ "\n" ++
projects / spline3.git / commitdiff