+-- The "tetrahedron" function pattern matches on the integers zero
+-- through twenty-three, but doesn't handle the "otherwise" case, for
+-- performance reasons.
+{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
+
module Cube (
Cube(..),
cube_properties,
singleton,
snoc,
unsafeIndex)
-import Prelude hiding ( LT )
-import Test.Framework ( Test, testGroup )
-import Test.Framework.Providers.QuickCheck2 ( testProperty )
-import Test.QuickCheck ( Arbitrary(..), Gen, Positive(..), choose )
-
+import Prelude(
+ Bool,
+ Double,
+ Int,
+ Eq( (==) ),
+ Fractional( (/) ),
+ Maybe,
+ Num( (+), (-), (*) ),
+ Ord( (>=), (<=) ),
+ Show( show ),
+ ($),
+ (.),
+ (&&),
+ (++),
+ abs,
+ all,
+ and,
+ fromIntegral,
+ head,
+ map,
+ otherwise,
+ return,
+ tail )
+import Test.Tasty ( TestTree, testGroup )
+import Test.Tasty.QuickCheck (
+ Arbitrary( arbitrary ),
+ Gen,
+ Positive( Positive ),
+ choose,
+ testProperty )
import Cardinal (
- Cardinal(..),
+ Cardinal(F, B, L, R, D, T, FL, FR, FD, FT,
+ BL, BR, BD, BT, LD, LT, RD, RT, I),
ccwx,
ccwy,
ccwz,
import qualified Face ( Face(..), center )
import FunctionValues ( FunctionValues, eval, rotate )
import Misc ( all_equal, disjoint )
-import Point ( Point(..), dot )
-import Tetrahedron ( Tetrahedron(..), barycenter, c, volume )
+import Point ( Point( Point ), dot )
+import Tetrahedron (
+ Tetrahedron(Tetrahedron, function_values, v0, v1, v2, v3),
+ barycenter,
+ c,
+ volume )
data Cube = Cube { i :: !Int,
j :: !Int,
-- these numbers don't overflow 64 bits. This number is not
-- magic in any other sense than that it does not cause test
-- failures, while 2^23 does.
- coordmax = 4194304 -- 2^22
+ coordmax = 4194304 :: Int -- 2^22
coordmin = -coordmax
top_face :: Cube -> Face.Face
top_face cube = Face.Face v0' v1' v2' v3'
where
- delta = 1/2
+ delta = (1/2) :: Double
cc = center cube
v0' = cc + ( Point delta (-delta) delta )
v1' = cc + ( Point delta delta delta )
back_face :: Cube -> Face.Face
back_face cube = Face.Face v0' v1' v2' v3'
where
- delta = 1/2
+ delta = (1/2) :: Double
cc = center cube
v0' = cc + ( Point delta (-delta) (-delta) )
v1' = cc + ( Point delta delta (-delta) )
down_face :: Cube -> Face.Face
down_face cube = Face.Face v0' v1' v2' v3'
where
- delta = 1/2
+ delta = (1/2) :: Double
cc = center cube
v0' = cc + ( Point (-delta) (-delta) (-delta) )
v1' = cc + ( Point (-delta) delta (-delta) )
front_face :: Cube -> Face.Face
front_face cube = Face.Face v0' v1' v2' v3'
where
- delta = 1/2
+ delta = (1/2) :: Double
cc = center cube
v0' = cc + ( Point (-delta) (-delta) delta )
v1' = cc + ( Point (-delta) delta delta )
left_face :: Cube -> Face.Face
left_face cube = Face.Face v0' v1' v2' v3'
where
- delta = 1/2
+ delta = (1/2) :: Double
cc = center cube
v0' = cc + ( Point delta (-delta) delta )
v1' = cc + ( Point (-delta) (-delta) delta )
right_face :: Cube -> Face.Face
right_face cube = Face.Face v0' v1' v2' v3'
where
- delta = 1/2
+ delta = (1/2) :: Double
cc = center cube
v0' = cc + ( Point (-delta) delta delta)
v1' = cc + ( Point delta delta delta )
--- Tests
-
--- Quickcheck tests.
+-- * Tests
prop_opposite_octant_tetrahedra_disjoint1 :: Cube -> Bool
prop_opposite_octant_tetrahedra_disjoint1 cube =
t20 = tetrahedron cube 20
-p79_26_properties :: Test.Framework.Test
+p79_26_properties :: TestTree
p79_26_properties =
- testGroup "p. 79, Section (2.6) Properties" [
+ testGroup "p. 79, Section (2.6) properties" [
testProperty "c0120 identity1" prop_c0120_identity1,
testProperty "c0120 identity2" prop_c0120_identity2,
testProperty "c0120 identity3" prop_c0120_identity3,
testProperty "c1200 identity1" prop_c1200_identity1,
testProperty "c2100 identity1" prop_c2100_identity1]
-p79_27_properties :: Test.Framework.Test
+p79_27_properties :: TestTree
p79_27_properties =
- testGroup "p. 79, Section (2.7) Properties" [
+ testGroup "p. 79, Section (2.7) properties" [
testProperty "c0102 identity1" prop_c0102_identity1,
testProperty "c0201 identity1" prop_c0201_identity1,
testProperty "c0300 identity2" prop_c0300_identity2,
testProperty "c2100 identity2" prop_c2100_identity2 ]
-p79_28_properties :: Test.Framework.Test
+p79_28_properties :: TestTree
p79_28_properties =
- testGroup "p. 79, Section (2.8) Properties" [
+ testGroup "p. 79, Section (2.8) properties" [
testProperty "c3000 identity" prop_c3000_identity,
testProperty "c2010 identity" prop_c2010_identity,
testProperty "c2001 identity" prop_c2001_identity,
testProperty "c1011 identity" prop_c1011_identity ]
-edge_incidence_tests :: Test.Framework.Test
+edge_incidence_tests :: TestTree
edge_incidence_tests =
- testGroup "Edge Incidence Tests" [
+ testGroup "Edge incidence tests" [
testProperty "t0 shares edge with t6" prop_t0_shares_edge_with_t6,
testProperty "t0 shares edge with t1" prop_t0_shares_edge_with_t1,
testProperty "t0 shares edge with t3" prop_t0_shares_edge_with_t3,
testProperty "t6 shares edge with t7" prop_t6_shares_edge_with_t7,
testProperty "t7 shares edge with t20" prop_t7_shares_edge_with_t20 ]
-cube_properties :: Test.Framework.Test
+cube_properties :: TestTree
cube_properties =
- testGroup "Cube Properties" [
+ testGroup "Cube properties" [
p79_26_properties,
p79_27_properties,
p79_28_properties,