+-- 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 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( arbitrary ),
Gen,
- Positive(..),
+ 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
-- | The left-side boundary of the cube. See Sorokina and Zeilfelder,
-- p. 76.
xmin :: Cube -> Double
-xmin cube = (i' - 1/2)
+xmin cube = (i' - 1 / 2)
where
i' = fromIntegral (i cube) :: Double
-- | The right-side boundary of the cube. See Sorokina and Zeilfelder,
-- p. 76.
xmax :: Cube -> Double
-xmax cube = (i' + 1/2)
+xmax cube = (i' + 1 / 2)
where
i' = fromIntegral (i cube) :: Double
-- | The front boundary of the cube. See Sorokina and Zeilfelder,
-- p. 76.
ymin :: Cube -> Double
-ymin cube = (j' - 1/2)
+ymin cube = (j' - 1 / 2)
where
j' = fromIntegral (j cube) :: Double
-- | The back boundary of the cube. See Sorokina and Zeilfelder,
-- p. 76.
ymax :: Cube -> Double
-ymax cube = (j' + 1/2)
+ymax cube = (j' + 1 / 2)
where
j' = fromIntegral (j cube) :: Double
-- | The bottom boundary of the cube. See Sorokina and Zeilfelder,
-- p. 76.
zmin :: Cube -> Double
-zmin cube = (k' - 1/2)
+zmin cube = (k' - 1 / 2)
where
k' = fromIntegral (k cube) :: Double
-- | The top boundary of the cube. See Sorokina and Zeilfelder,
-- p. 76.
zmax :: Cube -> Double
-zmax cube = (k' + 1/2)
+zmax cube = (k' + 1 / 2)
where
k' = fromIntegral (k cube) :: Double
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 )
-- we'd expect the volume of each one to be 1/24.
prop_all_volumes_exact :: Cube -> Bool
prop_all_volumes_exact cube =
- and [volume t ~~= 1/24 | t <- tetrahedra cube]
+ and [volume t ~~= 1 / 24 | t <- tetrahedra cube]
-- | All tetrahedron should have their v0 located at the center of the
-- cube.
prop_c3000_identity :: Cube -> Bool
prop_c3000_identity cube =
c t0 3 0 0 0 ~= c t0 2 1 0 0 + c t6 2 1 0 0
- - ((c t0 2 0 1 0 + c t0 2 0 0 1)/ 2)
+ - ((c t0 2 0 1 0 + c t0 2 0 0 1) / 2)
where
t0 = tetrahedron cube 0
t6 = tetrahedron cube 6
prop_c2010_identity :: Cube -> Bool
prop_c2010_identity cube =
c t0 2 0 1 0 ~= c t0 1 1 1 0 + c t6 1 1 0 1
- - ((c t0 1 0 2 0 + c t0 1 0 1 1)/ 2)
+ - ((c t0 1 0 2 0 + c t0 1 0 1 1) / 2)
where
t0 = tetrahedron cube 0
t6 = tetrahedron cube 6
prop_c2001_identity :: Cube -> Bool
prop_c2001_identity cube =
c t0 2 0 0 1 ~= c t0 1 1 0 1 + c t6 1 1 1 0
- - ((c t0 1 0 0 2 + c t0 1 0 1 1)/ 2)
+ - ((c t0 1 0 0 2 + c t0 1 0 1 1) / 2)
where
t0 = tetrahedron cube 0
t6 = tetrahedron cube 6
prop_c1020_identity :: Cube -> Bool
prop_c1020_identity cube =
c t0 1 0 2 0 ~= c t0 0 1 2 0 + c t6 0 1 0 2
- - ((c t0 0 0 3 0 + c t0 0 0 2 1)/ 2)
+ - ((c t0 0 0 3 0 + c t0 0 0 2 1) / 2)
where
t0 = tetrahedron cube 0
t6 = tetrahedron cube 6
prop_c1002_identity :: Cube -> Bool
prop_c1002_identity cube =
c t0 1 0 0 2 ~= c t0 0 1 0 2 + c t6 0 1 2 0
- - ((c t0 0 0 0 3 + c t0 0 0 1 2)/ 2)
+ - ((c t0 0 0 0 3 + c t0 0 0 1 2) / 2)
where
t0 = tetrahedron cube 0
t6 = tetrahedron cube 6
prop_c1011_identity :: Cube -> Bool
prop_c1011_identity cube =
c t0 1 0 1 1 ~= c t0 0 1 1 1 + c t6 0 1 1 1 -
- ((c t0 0 0 1 2 + c t0 0 0 2 1)/ 2)
+ ((c t0 0 0 1 2 + c t0 0 0 2 1) / 2)
where
t0 = tetrahedron cube 0
t6 = tetrahedron cube 6
-- What gets computed for c2100 of t6.
expr1 = eval (function_values t6) $
- (3/8)*I +
- (1/12)*(T + R + L + D) +
- (1/64)*(FT + FR + FL + FD) +
- (7/48)*F +
- (1/48)*B +
- (1/96)*(RT + LD + LT + RD) +
- (1/192)*(BT + BR + BL + BD)
+ (3 / 8)*I +
+ (1 / 12)*(T + R + L + D) +
+ (1 / 64)*(FT + FR + FL + FD) +
+ (7 / 48)*F +
+ (1 / 48)*B +
+ (1 / 96)*(RT + LD + LT + RD) +
+ (1 / 192)*(BT + BR + BL + BD)
-- What should be computed for c2100 of t6.
expr2 = eval (function_values t0) $
- (3/8)*I +
- (1/12)*(F + R + L + B) +
- (1/64)*(FT + RT + LT + BT) +
- (7/48)*T +
- (1/48)*D +
- (1/96)*(FR + FL + BR + BL) +
- (1/192)*(FD + RD + LD + BD)
+ (3 / 8)*I +
+ (1 / 12)*(F + R + L + B) +
+ (1 / 64)*(FT + RT + LT + BT) +
+ (7 / 48)*T +
+ (1 / 48)*D +
+ (1 / 96)*(FR + FL + BR + BL) +
+ (1 / 192)*(FD + RD + LD + BD)
-- | We know what (c t6 2 1 0 0) should be from Sorokina and
t6 = tetrahedron cube 6
fvs = function_values t0
expected = eval fvs $
- (3/8)*I +
- (1/12)*(F + R + L + B) +
- (1/64)*(FT + RT + LT + BT) +
- (7/48)*T +
- (1/48)*D +
- (1/96)*(FR + FL + BR + BL) +
- (1/192)*(FD + RD + LD + BD)
+ (3 / 8)*I +
+ (1 / 12)*(F + R + L + B) +
+ (1 / 64)*(FT + RT + LT + BT) +
+ (7 / 48)*T +
+ (1 / 48)*D +
+ (1 / 96)*(FR + FL + BR + BL) +
+ (1 / 192)*(FD + RD + LD + BD)
-- Tests to check that the correct edges are incidental.