X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FCube.hs;h=d3f5151260905827254885c579f1f208f2586bd3;hb=3a954903101eca7594a65824868517b9758e188d;hp=d873a379ddfca39eba80bf7cb3022b258addfacc;hpb=408f4da9058366cd8047592aa96f97bcc348d329;p=spline3.git diff --git a/src/Cube.hs b/src/Cube.hs index d873a37..d3f5151 100644 --- a/src/Cube.hs +++ b/src/Cube.hs @@ -1,34 +1,87 @@ -module Cube +module Cube ( + Cube(..), + cube_properties, + find_containing_tetrahedron, + tetrahedra, + tetrahedron + ) where +import Data.Maybe (fromJust) +import qualified Data.Vector as V ( + Vector, + findIndex, + map, + minimum, + 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 Cardinal -import Face (Face(Face, v0, v1, v2, v3)) +import Comparisons ((~=), (~~=)) +import qualified Face (Face(Face, v0, v1, v2, v3)) import FunctionValues +import Misc (all_equal, disjoint) import Point -import Tetrahedron (Tetrahedron(Tetrahedron), fv) +import Tetrahedron ( + Tetrahedron(..), + c, + b0, + b1, + b2, + b3, + volume + ) import ThreeDimensional data Cube = Cube { h :: Double, i :: Int, j :: Int, k :: Int, - fv :: FunctionValues } + fv :: FunctionValues, + tetrahedra_volume :: Double } 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 + (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) + + instance Show Cube where show c = - "Cube_" ++ (show (i c)) ++ "," ++ (show (j c)) ++ "," ++ (show (k c)) ++ - " (Center: " ++ (show (center c)) ++ ")" ++ - " (xmin: " ++ (show (xmin c)) ++ ")" ++ - " (xmax: " ++ (show (xmax c)) ++ ")" ++ - " (ymin: " ++ (show (ymin c)) ++ ")" ++ - " (ymax: " ++ (show (ymax c)) ++ ")" ++ - " (zmin: " ++ (show (zmin c)) ++ ")" ++ - " (zmax: " ++ (show (zmax c)) ++ ")" + "Cube_" ++ subscript ++ "\n" ++ + " h: " ++ (show (h c)) ++ "\n" ++ + " Center: " ++ (show (center c)) ++ "\n" ++ + " xmin: " ++ (show (xmin c)) ++ "\n" ++ + " xmax: " ++ (show (xmax c)) ++ "\n" ++ + " ymin: " ++ (show (ymin c)) ++ "\n" ++ + " ymax: " ++ (show (ymax c)) ++ "\n" ++ + " zmin: " ++ (show (zmin c)) ++ "\n" ++ + " zmax: " ++ (show (zmax c)) ++ "\n" ++ + " fv: " ++ (show (Cube.fv c)) ++ "\n" + where + subscript = + (show (i c)) ++ "," ++ (show (j c)) ++ "," ++ (show (k c)) + +-- | 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, @@ -92,104 +145,59 @@ instance ThreeDimensional Cube where y = delta * j' z = delta * k' - contains_point c p - | (x_coord p) < (xmin c) = False - | (x_coord p) > (xmax c) = False - | (y_coord p) < (ymin c) = False - | (y_coord p) > (ymax c) = False - | (z_coord p) < (zmin c) = False - | (z_coord p) > (zmax c) = False + -- | It's easy to tell if a point is within a cube; just make sure + -- that it falls on the proper side of each of the cube's faces. + contains_point c (x, y, z) + | x < (xmin c) = False + | x > (xmax c) = False + | y < (ymin c) = False + | y > (ymax c) = False + | z < (zmin c) = False + | z > (zmax c) = False | otherwise = True --- instance Num Cube where --- (Cube g1 i1 j1 k1 d1) + (Cube _ i2 j2 k2 d2) = --- Cube g1 (i1 + i2) (j1 + j2) (k1 + k2) (d1 + d2) - --- (Cube g1 i1 j1 k1 d1) - (Cube _ i2 j2 k2 d2) = --- Cube g1 (i1 - i2) (j1 - j2) (k1 - k2) (d1 - d2) - --- (Cube g1 i1 j1 k1 d1) * (Cube _ i2 j2 k2 d2) = --- Cube g1 (i1 * i2) (j1 * j2) (k1 * k2) (d1 * d2) - --- abs (Cube g1 i1 j1 k1 d1) = --- Cube g1 (abs i1) (abs j1) (abs k1) (abs d1) - --- signum (Cube g1 i1 j1 k1 d1) = --- Cube g1 (signum i1) (signum j1) (signum k1) (signum d1) - --- fromInteger x = empty_cube { datum = (fromIntegral x) } - --- instance Fractional Cube where --- (Cube g1 i1 j1 k1 d1) / (Cube _ _ _ _ d2) = --- Cube g1 i1 j1 k1 (d1 / d2) - --- recip (Cube g1 i1 j1 k1 d1) = --- Cube g1 i1 j1 k1 (recip d1) - --- fromRational q = empty_cube { datum = fromRational q } - - - --- | Return the cube corresponding to the grid point i,j,k. The list --- of cubes is stored as [z][y][x] but we'll be requesting it by --- [x][y][z] so we flip the indices in the last line. --- cube_at :: Grid -> Int -> Int -> Int -> Cube --- cube_at g i' j' k' --- | i' >= length (function_values g) = Cube g i' j' k' 0 --- | i' < 0 = Cube g i' j' k' 0 --- | j' >= length ((function_values g) !! i') = Cube g i' j' k' 0 --- | j' < 0 = Cube g i' j' k' 0 --- | k' >= length (((function_values g) !! i') !! j') = Cube g i' j' k' 0 --- | k' < 0 = Cube g i' j' k' 0 --- | otherwise = --- (((cubes g) !! k') !! j') !! i' - - - - - -- Face stuff. -- | The top (in the direction of z) face of the cube. -top_face :: Cube -> Face -top_face c = Face v0' v1' v2' v3' +top_face :: Cube -> Face.Face +top_face c = Face.Face v0' v1' v2' v3' where delta = (1/2)*(h c) - v0' = (center c) + (delta, delta, delta) - v1' = (center c) + (delta, -delta, delta) - v2' = (center c) + (-delta, -delta, delta) - v3' = (center c) + (-delta, delta, delta) + v0' = (center c) + (delta, -delta, delta) + v1' = (center c) + (delta, delta, delta) + v2' = (center c) + (-delta, delta, delta) + v3' = (center c) + (-delta, -delta, delta) -- | The back (in the direction of x) face of the cube. -back_face :: Cube -> Face -back_face c = Face v0' v1' v2' v3' +back_face :: Cube -> Face.Face +back_face c = Face.Face v0' v1' v2' v3' where delta = (1/2)*(h c) - v0' = (center c) + (delta, delta, delta) + v0' = (center c) + (delta, -delta, -delta) v1' = (center c) + (delta, delta, -delta) - v2' = (center c) + (delta, -delta, -delta) + v2' = (center c) + (delta, delta, delta) v3' = (center c) + (delta, -delta, delta) -- The bottom face (in the direction of -z) of the cube. -down_face :: Cube -> Face -down_face c = Face v0' v1' v2' v3' +down_face :: Cube -> Face.Face +down_face c = Face.Face v0' v1' v2' v3' where delta = (1/2)*(h c) - v0' = (center c) + (delta, delta, -delta) + v0' = (center c) + (-delta, -delta, -delta) v1' = (center c) + (-delta, delta, -delta) - v2' = (center c) + (-delta, -delta, -delta) + v2' = (center c) + (delta, delta, -delta) v3' = (center c) + (delta, -delta, -delta) -- | The front (in the direction of -x) face of the cube. -front_face :: Cube -> Face -front_face c = Face v0' v1' v2' v3' +front_face :: Cube -> Face.Face +front_face c = Face.Face v0' v1' v2' v3' where delta = (1/2)*(h c) v0' = (center c) + (-delta, -delta, delta) @@ -197,134 +205,1036 @@ front_face c = Face v0' v1' v2' v3' v2' = (center c) + (-delta, delta, -delta) v3' = (center c) + (-delta, -delta, -delta) - -- | The left (in the direction of -y) face of the cube. -left_face :: Cube -> Face -left_face c = Face v0' v1' v2' v3' +left_face :: Cube -> Face.Face +left_face c = Face.Face v0' v1' v2' v3' where delta = (1/2)*(h c) - v0' = (center c) + (-delta, -delta, delta) - v1' = (center c) + (delta, -delta, delta) - v2' = (center c) + (delta, -delta, -delta) - v3' = (center c) + (-delta, -delta, -delta) + v0' = (center c) + (delta, -delta, delta) + v1' = (center c) + (-delta, -delta, delta) + v2' = (center c) + (-delta, -delta, -delta) + v3' = (center c) + (delta, -delta, -delta) -- | The right (in the direction of y) face of the cube. -right_face :: Cube -> Face -right_face c = Face v0' v1' v2' v3' +right_face :: Cube -> Face.Face +right_face c = Face.Face v0' v1' v2' v3' where delta = (1/2)*(h c) - v0' = (center c) + (-delta, delta, -delta) - v1' = (center c) + (delta, delta, -delta) - v2' = (center c) + (delta, delta, delta) - v3' = (center c) + (-delta, delta, delta) + v0' = (center c) + (-delta, delta, delta) + v1' = (center c) + (delta, delta, delta) + v2' = (center c) + (delta, delta, -delta) + v3' = (center c) + (-delta, delta, -delta) +tetrahedron :: Cube -> Int -> Tetrahedron -tetrahedron0 :: Cube -> Tetrahedron -tetrahedron0 c = - Tetrahedron (Cube.fv c) v0' v1' v2' v3' +tetrahedron c 0 = + Tetrahedron (fv c) v0' v1' v2' v3' vol where v0' = center c v1' = center (front_face c) - v2' = v0 (front_face c) - v3' = v1 (front_face c) + v2' = Face.v0 (front_face c) + v3' = Face.v1 (front_face c) + vol = tetrahedra_volume c -tetrahedron1 :: Cube -> Tetrahedron -tetrahedron1 c = - Tetrahedron fv' v0' v1' v2' v3' +tetrahedron c 1 = + Tetrahedron fv' v0' v1' v2' v3' vol where v0' = center c v1' = center (front_face c) - v2' = v1 (front_face c) - v3' = v2 (front_face c) - fv' = rotate (Cube.fv c) ccwx + v2' = Face.v1 (front_face c) + v3' = Face.v2 (front_face c) + fv' = rotate ccwx (fv c) + vol = tetrahedra_volume c -tetrahedron2 :: Cube -> Tetrahedron -tetrahedron2 c = - Tetrahedron fv' v0' v1' v2' v3' +tetrahedron c 2 = + Tetrahedron fv' v0' v1' v2' v3' vol where v0' = center c v1' = center (front_face c) - v2' = v2 (front_face c) - v3' = v3 (front_face c) - fv' = rotate (Cube.fv c) (ccwx . ccwx) + v2' = Face.v2 (front_face c) + v3' = Face.v3 (front_face c) + fv' = rotate ccwx $ rotate ccwx $ fv c + vol = tetrahedra_volume c -tetrahedron3 :: Cube -> Tetrahedron -tetrahedron3 c = - Tetrahedron fv' v0' v1' v2' v3' +tetrahedron c 3 = + Tetrahedron fv' v0' v1' v2' v3' vol where v0' = center c v1' = center (front_face c) - v2' = v3 (front_face c) - v3' = v1 (front_face c) - fv' = rotate (Cube.fv c) cwx + v2' = Face.v3 (front_face c) + v3' = Face.v0 (front_face c) + fv' = rotate cwx (fv c) + vol = tetrahedra_volume c -tetrahedron4 :: Cube -> Tetrahedron -tetrahedron4 c = - Tetrahedron fv' v0' v1' v2' v3' +tetrahedron c 4 = + Tetrahedron fv' v0' v1' v2' v3' vol where v0' = center c v1' = center (top_face c) - v2' = v0 (front_face c) - v3' = v1 (front_face c) - fv' = rotate (Cube.fv c) cwy + v2' = Face.v0 (top_face c) + v3' = Face.v1 (top_face c) + fv' = rotate cwy (fv c) + vol = tetrahedra_volume c -tetrahedron5 :: Cube -> Tetrahedron -tetrahedron5 c = - Tetrahedron fv' v0' v1' v2' v3' +tetrahedron c 5 = + Tetrahedron fv' v0' v1' v2' v3' vol where v0' = center c v1' = center (top_face c) - v2' = v1 (top_face c) - v3' = v2 (top_face c) - fv' = rotate (Tetrahedron.fv (tetrahedron0 c)) ccwx + v2' = Face.v1 (top_face c) + v3' = Face.v2 (top_face c) + fv' = rotate cwy $ rotate cwz $ fv c + vol = tetrahedra_volume c -tetrahedron6 c = - Tetrahedron fv' v0' v1' v2' v3' +tetrahedron c 6 = + Tetrahedron fv' v0' v1' v2' v3' vol where v0' = center c v1' = center (top_face c) - v2' = v2 (top_face c) - v3' = v3 (top_face c) - fv' = rotate (Tetrahedron.fv (tetrahedron0 c)) (ccwx . ccwx) + v2' = Face.v2 (top_face c) + v3' = Face.v3 (top_face c) + fv' = rotate cwy $ rotate cwz + $ rotate cwz + $ fv c + vol = tetrahedra_volume c -tetrahedron7 c = - Tetrahedron fv' v0' v1' v2' v3' +tetrahedron c 7 = + Tetrahedron fv' v0' v1' v2' v3' vol where v0' = center c v1' = center (top_face c) - v2' = v3 (top_face c) - v3' = v1 (top_face c) - fv' = rotate (Tetrahedron.fv (tetrahedron0 c)) cwx - -tetrahedrons :: Cube -> [Tetrahedron] -tetrahedrons c = - [tetrahedron0 c, - tetrahedron1 c, - tetrahedron2 c, - tetrahedron3 c, - tetrahedron4 c, - tetrahedron5 c, - tetrahedron6 c, - tetrahedron7 c - -- , - -- tetrahedron8 c, - -- tetrahedron9 c, - -- tetrahedron10 c, - -- tetrahedron11 c, - -- tetrahedron12 c, - -- tetrahedron13 c, - -- tetrahedron14 c, - -- tetrahedron15 c, - -- tetrahedron16 c, - -- tetrahedron17 c, - -- tetrahedron18 c, - -- tetrahedron19 c, - -- tetrahedron20 c, - -- tetrahedron21 c, - -- tetrahedron21 c, - -- tetrahedron22 c, - -- tetrahedron23 c, - -- tetrahedron24 c - ] + v2' = Face.v3 (top_face c) + v3' = Face.v0 (top_face c) + fv' = rotate cwy $ rotate ccwz $ fv c + vol = tetrahedra_volume c + +tetrahedron c 8 = + Tetrahedron fv' v0' v1' v2' v3' vol + where + v0' = center c + v1' = center (back_face c) + v2' = Face.v0 (back_face c) + v3' = Face.v1 (back_face c) + fv' = rotate cwy $ rotate cwy $ fv c + vol = tetrahedra_volume c + +tetrahedron c 9 = + Tetrahedron fv' v0' v1' v2' v3' vol + where + v0' = center c + v1' = center (back_face c) + v2' = Face.v1 (back_face c) + v3' = Face.v2 (back_face c) + fv' = rotate cwy $ rotate cwy + $ rotate cwx + $ fv c + vol = tetrahedra_volume c + +tetrahedron c 10 = + Tetrahedron fv' v0' v1' v2' v3' vol + where + v0' = center c + v1' = center (back_face c) + v2' = Face.v2 (back_face c) + v3' = Face.v3 (back_face c) + fv' = rotate cwy $ rotate cwy + $ rotate cwx + $ rotate cwx + $ fv c + + vol = tetrahedra_volume c + +tetrahedron c 11 = + Tetrahedron fv' v0' v1' v2' v3' vol + where + v0' = center c + v1' = center (back_face c) + v2' = Face.v3 (back_face c) + v3' = Face.v0 (back_face c) + fv' = rotate cwy $ rotate cwy + $ rotate ccwx + $ fv c + vol = tetrahedra_volume c + +tetrahedron c 12 = + Tetrahedron fv' v0' v1' v2' v3' vol + where + v0' = center c + v1' = center (down_face c) + v2' = Face.v0 (down_face c) + v3' = Face.v1 (down_face c) + fv' = rotate ccwy $ fv c + vol = tetrahedra_volume c + +tetrahedron c 13 = + Tetrahedron fv' v0' v1' v2' v3' vol + where + v0' = center c + v1' = center (down_face c) + v2' = Face.v1 (down_face c) + v3' = Face.v2 (down_face c) + fv' = rotate ccwy $ rotate ccwz $ fv c + vol = tetrahedra_volume c + +tetrahedron c 14 = + Tetrahedron fv' v0' v1' v2' v3' vol + where + v0' = center c + v1' = center (down_face c) + v2' = Face.v2 (down_face c) + v3' = Face.v3 (down_face c) + fv' = rotate ccwy $ rotate ccwz + $ rotate ccwz + $ fv c + vol = tetrahedra_volume c + +tetrahedron c 15 = + Tetrahedron fv' v0' v1' v2' v3' vol + where + v0' = center c + v1' = center (down_face c) + v2' = Face.v3 (down_face c) + v3' = Face.v0 (down_face c) + fv' = rotate ccwy $ rotate cwz $ fv c + vol = tetrahedra_volume c + +tetrahedron c 16 = + Tetrahedron fv' v0' v1' v2' v3' vol + where + v0' = center c + v1' = center (right_face c) + v2' = Face.v0 (right_face c) + v3' = Face.v1 (right_face c) + fv' = rotate ccwz $ fv c + vol = tetrahedra_volume c + +tetrahedron c 17 = + Tetrahedron fv' v0' v1' v2' v3' vol + where + v0' = center c + v1' = center (right_face c) + v2' = Face.v1 (right_face c) + v3' = Face.v2 (right_face c) + fv' = rotate ccwz $ rotate cwy $ fv c + vol = tetrahedra_volume c + +tetrahedron c 18 = + Tetrahedron fv' v0' v1' v2' v3' vol + where + v0' = center c + v1' = center (right_face c) + v2' = Face.v2 (right_face c) + v3' = Face.v3 (right_face c) + fv' = rotate ccwz $ rotate cwy + $ rotate cwy + $ fv c + vol = tetrahedra_volume c + +tetrahedron c 19 = + Tetrahedron fv' v0' v1' v2' v3' vol + where + v0' = center c + v1' = center (right_face c) + v2' = Face.v3 (right_face c) + v3' = Face.v0 (right_face c) + fv' = rotate ccwz $ rotate ccwy + $ fv c + vol = tetrahedra_volume c + +tetrahedron c 20 = + Tetrahedron fv' v0' v1' v2' v3' vol + where + v0' = center c + v1' = center (left_face c) + v2' = Face.v0 (left_face c) + v3' = Face.v1 (left_face c) + fv' = rotate cwz $ fv c + vol = tetrahedra_volume c + +tetrahedron c 21 = + Tetrahedron fv' v0' v1' v2' v3' vol + where + v0' = center c + v1' = center (left_face c) + v2' = Face.v1 (left_face c) + v3' = Face.v2 (left_face c) + fv' = rotate cwz $ rotate ccwy $ fv c + vol = tetrahedra_volume c + +tetrahedron c 22 = + Tetrahedron fv' v0' v1' v2' v3' vol + where + v0' = center c + v1' = center (left_face c) + v2' = Face.v2 (left_face c) + v3' = Face.v3 (left_face c) + fv' = rotate cwz $ rotate ccwy + $ rotate ccwy + $ fv c + vol = tetrahedra_volume c + +tetrahedron c 23 = + Tetrahedron fv' v0' v1' v2' v3' vol + where + v0' = center c + v1' = center (left_face c) + v2' = Face.v3 (left_face c) + v3' = Face.v0 (left_face c) + fv' = rotate cwz $ rotate cwy + $ fv c + vol = tetrahedra_volume c + +-- Feels dirty, but whatever. +tetrahedron _ _ = error "asked for a nonexistent tetrahedron" + + +-- Only used in tests, so we don't need the added speed +-- of Data.Vector. +tetrahedra :: Cube -> [Tetrahedron] +tetrahedra c = [ tetrahedron c n | n <- [0..23] ] + +front_left_top_tetrahedra :: Cube -> V.Vector Tetrahedron +front_left_top_tetrahedra c = + V.singleton (tetrahedron c 0) `V.snoc` + (tetrahedron c 3) `V.snoc` + (tetrahedron c 6) `V.snoc` + (tetrahedron c 7) `V.snoc` + (tetrahedron c 20) `V.snoc` + (tetrahedron c 21) + +front_left_down_tetrahedra :: Cube -> V.Vector Tetrahedron +front_left_down_tetrahedra c = + V.singleton (tetrahedron c 0) `V.snoc` + (tetrahedron c 2) `V.snoc` + (tetrahedron c 3) `V.snoc` + (tetrahedron c 12) `V.snoc` + (tetrahedron c 15) `V.snoc` + (tetrahedron c 21) + +front_right_top_tetrahedra :: Cube -> V.Vector Tetrahedron +front_right_top_tetrahedra c = + V.singleton (tetrahedron c 0) `V.snoc` + (tetrahedron c 1) `V.snoc` + (tetrahedron c 5) `V.snoc` + (tetrahedron c 6) `V.snoc` + (tetrahedron c 16) `V.snoc` + (tetrahedron c 19) + +front_right_down_tetrahedra :: Cube -> V.Vector Tetrahedron +front_right_down_tetrahedra c = + V.singleton (tetrahedron c 1) `V.snoc` + (tetrahedron c 2) `V.snoc` + (tetrahedron c 12) `V.snoc` + (tetrahedron c 13) `V.snoc` + (tetrahedron c 18) `V.snoc` + (tetrahedron c 19) + +back_left_top_tetrahedra :: Cube -> V.Vector Tetrahedron +back_left_top_tetrahedra c = + V.singleton (tetrahedron c 0) `V.snoc` + (tetrahedron c 3) `V.snoc` + (tetrahedron c 6) `V.snoc` + (tetrahedron c 7) `V.snoc` + (tetrahedron c 20) `V.snoc` + (tetrahedron c 21) + +back_left_down_tetrahedra :: Cube -> V.Vector Tetrahedron +back_left_down_tetrahedra c = + V.singleton (tetrahedron c 8) `V.snoc` + (tetrahedron c 11) `V.snoc` + (tetrahedron c 14) `V.snoc` + (tetrahedron c 15) `V.snoc` + (tetrahedron c 22) `V.snoc` + (tetrahedron c 23) + +back_right_top_tetrahedra :: Cube -> V.Vector Tetrahedron +back_right_top_tetrahedra c = + V.singleton (tetrahedron c 4) `V.snoc` + (tetrahedron c 5) `V.snoc` + (tetrahedron c 9) `V.snoc` + (tetrahedron c 10) `V.snoc` + (tetrahedron c 16) `V.snoc` + (tetrahedron c 17) + +back_right_down_tetrahedra :: Cube -> V.Vector Tetrahedron +back_right_down_tetrahedra c = + V.singleton (tetrahedron c 8) `V.snoc` + (tetrahedron c 9) `V.snoc` + (tetrahedron c 13) `V.snoc` + (tetrahedron c 14) `V.snoc` + (tetrahedron c 17) `V.snoc` + (tetrahedron c 18) + +in_top_half :: Cube -> Point -> Bool +in_top_half c (_,_,z) = + distance_from_top <= distance_from_bottom + where + distance_from_top = abs $ (zmax c) - z + distance_from_bottom = abs $ (zmin c) - z + +in_front_half :: Cube -> Point -> Bool +in_front_half c (x,_,_) = + distance_from_front <= distance_from_back + where + distance_from_front = abs $ (xmin c) - x + distance_from_back = abs $ (xmax c) - x + + +in_left_half :: Cube -> Point -> Bool +in_left_half c (_,y,_) = + distance_from_left <= distance_from_right + where + distance_from_left = abs $ (ymin c) - y + distance_from_right = abs $ (ymax c) - y + + +-- | Takes a 'Cube', and returns the Tetrahedra belonging to it that +-- contain the given 'Point'. This should be faster than checking +-- every tetrahedron individually, since we determine which half +-- (hemisphere?) of the cube the point lies in three times: once in +-- each dimension. This allows us to eliminate non-candidates +-- quickly. +-- +-- This can throw an exception, but the use of 'head' might +-- save us some unnecessary computations. +-- +find_containing_tetrahedron :: Cube -> Point -> Tetrahedron +find_containing_tetrahedron c p = + candidates `V.unsafeIndex` (fromJust lucky_idx) + where + front_half = in_front_half c p + top_half = in_top_half c p + left_half = in_left_half c p + + candidates = + if front_half then + + if left_half then + if top_half then + front_left_top_tetrahedra c + else + front_left_down_tetrahedra c + else + if top_half then + front_right_top_tetrahedra c + else + front_right_down_tetrahedra c + + else -- bottom half + + if left_half then + if top_half then + back_left_top_tetrahedra c + else + back_left_down_tetrahedra c + else + if top_half then + back_right_top_tetrahedra c + else + back_right_down_tetrahedra c + + -- Use the dot product instead of 'distance' here to save a + -- sqrt(). So, "distances" below really means "distances squared." + distances = V.map ((dot p) . center) candidates + shortest_distance = V.minimum distances + lucky_idx = V.findIndex + (\t -> (center t) `dot` p == shortest_distance) + candidates + + + + + + +-- Tests + +-- Quickcheck tests. + +prop_opposite_octant_tetrahedra_disjoint1 :: Cube -> Bool +prop_opposite_octant_tetrahedra_disjoint1 c = + disjoint (front_left_top_tetrahedra c) (front_right_down_tetrahedra c) + +prop_opposite_octant_tetrahedra_disjoint2 :: Cube -> Bool +prop_opposite_octant_tetrahedra_disjoint2 c = + disjoint (back_left_top_tetrahedra c) (back_right_down_tetrahedra c) + +prop_opposite_octant_tetrahedra_disjoint3 :: Cube -> Bool +prop_opposite_octant_tetrahedra_disjoint3 c = + disjoint (front_left_top_tetrahedra c) (back_right_top_tetrahedra c) + +prop_opposite_octant_tetrahedra_disjoint4 :: Cube -> Bool +prop_opposite_octant_tetrahedra_disjoint4 c = + disjoint (front_left_down_tetrahedra c) (back_right_down_tetrahedra c) + +prop_opposite_octant_tetrahedra_disjoint5 :: Cube -> Bool +prop_opposite_octant_tetrahedra_disjoint5 c = + disjoint (front_left_top_tetrahedra c) (back_left_down_tetrahedra c) + +prop_opposite_octant_tetrahedra_disjoint6 :: Cube -> Bool +prop_opposite_octant_tetrahedra_disjoint6 c = + disjoint (front_right_top_tetrahedra c) (back_right_down_tetrahedra c) + + +-- | Since the grid size is necessarily positive, all tetrahedra +-- (which comprise cubes of positive volume) must have positive volume +-- as well. +prop_all_volumes_positive :: Cube -> Bool +prop_all_volumes_positive cube = + null nonpositive_volumes + where + ts = tetrahedra cube + volumes = map volume ts + nonpositive_volumes = filter (<= 0) volumes + +-- | In fact, since all of the tetrahedra are identical, we should +-- already know their volumes. There's 24 tetrahedra to a cube, so +-- we'd expect the volume of each one to be (1/24)*h^3. +prop_all_volumes_exact :: Cube -> Bool +prop_all_volumes_exact cube = + and [volume t ~~= (1/24)*(delta^(3::Int)) | t <- tetrahedra cube] + where + delta = h cube + +-- | All tetrahedron should have their v0 located at the center of the cube. +prop_v0_all_equal :: Cube -> Bool +prop_v0_all_equal cube = (v0 t0) == (v0 t1) + where + t0 = head (tetrahedra cube) -- Doesn't matter which two we choose. + t1 = head $ tail (tetrahedra cube) + + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Note that the +-- third and fourth indices of c-t1 have been switched. This is +-- because we store the triangles oriented such that their volume is +-- positive. If T and T-tilde share \ and v3,v3-tilde point +-- in opposite directions, one of them has to have negative volume! +prop_c0120_identity1 :: Cube -> Bool +prop_c0120_identity1 cube = + c t0 0 1 2 0 ~= (c t0 0 0 2 1 + c t3 0 0 1 2) / 2 + where + t0 = tetrahedron cube 0 + t3 = tetrahedron cube 3 + + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Repeats +-- 'prop_c0120_identity1' with tetrahedrons 1 and 2. +prop_c0120_identity2 :: Cube -> Bool +prop_c0120_identity2 cube = + c t1 0 1 2 0 ~= (c t1 0 0 2 1 + c t0 0 0 1 2) / 2 + where + t0 = tetrahedron cube 0 + t1 = tetrahedron cube 1 + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Repeats +-- 'prop_c0120_identity1' with tetrahedrons 1 and 2. +prop_c0120_identity3 :: Cube -> Bool +prop_c0120_identity3 cube = + c t2 0 1 2 0 ~= (c t2 0 0 2 1 + c t1 0 0 1 2) / 2 + where + t1 = tetrahedron cube 1 + t2 = tetrahedron cube 2 + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Repeats +-- 'prop_c0120_identity1' with tetrahedrons 2 and 3. +prop_c0120_identity4 :: Cube -> Bool +prop_c0120_identity4 cube = + c t3 0 1 2 0 ~= (c t3 0 0 2 1 + c t2 0 0 1 2) / 2 + where + t2 = tetrahedron cube 2 + t3 = tetrahedron cube 3 + + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Repeats +-- 'prop_c0120_identity1' with tetrahedrons 4 and 5. +prop_c0120_identity5 :: Cube -> Bool +prop_c0120_identity5 cube = + c t5 0 1 2 0 ~= (c t5 0 0 2 1 + c t4 0 0 1 2) / 2 + where + t4 = tetrahedron cube 4 + t5 = tetrahedron cube 5 + +-- -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Repeats +-- -- 'prop_c0120_identity1' with tetrahedrons 5 and 6. +prop_c0120_identity6 :: Cube -> Bool +prop_c0120_identity6 cube = + c t6 0 1 2 0 ~= (c t6 0 0 2 1 + c t5 0 0 1 2) / 2 + where + t5 = tetrahedron cube 5 + t6 = tetrahedron cube 6 + + +-- -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Repeats +-- -- 'prop_c0120_identity1' with tetrahedrons 6 and 7. +prop_c0120_identity7 :: Cube -> Bool +prop_c0120_identity7 cube = + c t7 0 1 2 0 ~= (c t7 0 0 2 1 + c t6 0 0 1 2) / 2 + where + t6 = tetrahedron cube 6 + t7 = tetrahedron cube 7 + + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.6). See +-- 'prop_c0120_identity1'. +prop_c0210_identity1 :: Cube -> Bool +prop_c0210_identity1 cube = + c t0 0 2 1 0 ~= (c t0 0 1 1 1 + c t3 0 1 1 1) / 2 + where + t0 = tetrahedron cube 0 + t3 = tetrahedron cube 3 + + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.6). See +-- 'prop_c0120_identity1'. +prop_c0300_identity1 :: Cube -> Bool +prop_c0300_identity1 cube = + c t0 0 3 0 0 ~= (c t0 0 2 0 1 + c t3 0 2 1 0) / 2 + where + t0 = tetrahedron cube 0 + t3 = tetrahedron cube 3 + + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.6). See +-- 'prop_c0120_identity1'. +prop_c1110_identity :: Cube -> Bool +prop_c1110_identity cube = + c t0 1 1 1 0 ~= (c t0 1 0 1 1 + c t3 1 0 1 1) / 2 + where + t0 = tetrahedron cube 0 + t3 = tetrahedron cube 3 + + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.6). See +-- 'prop_c0120_identity1'. +prop_c1200_identity1 :: Cube -> Bool +prop_c1200_identity1 cube = + c t0 1 2 0 0 ~= (c t0 1 1 0 1 + c t3 1 1 1 0) / 2 + where + t0 = tetrahedron cube 0 + t3 = tetrahedron cube 3 + + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.6). See +-- 'prop_c0120_identity1'. +prop_c2100_identity1 :: Cube -> Bool +prop_c2100_identity1 cube = + c t0 2 1 0 0 ~= (c t0 2 0 0 1 + c t3 2 0 1 0) / 2 + where + t0 = tetrahedron cube 0 + t3 = tetrahedron cube 3 + + + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.7). Note that the +-- third and fourth indices of c-t3 have been switched. This is +-- because we store the triangles oriented such that their volume is +-- positive. If T and T-tilde share \ and v3,v3-tilde +-- point in opposite directions, one of them has to have negative +-- volume! +prop_c0102_identity1 :: Cube -> Bool +prop_c0102_identity1 cube = + c t0 0 1 0 2 ~= (c t0 0 0 1 2 + c t1 0 0 2 1) / 2 + where + t0 = tetrahedron cube 0 + t1 = tetrahedron cube 1 + + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.7). See +-- 'prop_c0102_identity1'. +prop_c0201_identity1 :: Cube -> Bool +prop_c0201_identity1 cube = + c t0 0 2 0 1 ~= (c t0 0 1 1 1 + c t1 0 1 1 1) / 2 + where + t0 = tetrahedron cube 0 + t1 = tetrahedron cube 1 + + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.7). See +-- 'prop_c0102_identity1'. +prop_c0300_identity2 :: Cube -> Bool +prop_c0300_identity2 cube = + c t0 0 3 0 0 ~= (c t0 0 2 1 0 + c t1 0 2 0 1) / 2 + where + t0 = tetrahedron cube 0 + t1 = tetrahedron cube 1 + + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.7). See +-- 'prop_c0102_identity1'. +prop_c1101_identity :: Cube -> Bool +prop_c1101_identity cube = + c t0 1 1 0 1 ~= (c t0 1 0 1 1 + c t1 1 0 1 1) / 2 + where + t0 = tetrahedron cube 0 + t1 = tetrahedron cube 1 + + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.7). See +-- 'prop_c0102_identity1'. +prop_c1200_identity2 :: Cube -> Bool +prop_c1200_identity2 cube = + c t0 1 2 0 0 ~= (c t0 1 1 1 0 + c t1 1 1 0 1) / 2 + where + t0 = tetrahedron cube 0 + t1 = tetrahedron cube 1 + + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.7). See +-- 'prop_c0102_identity1'. +prop_c2100_identity2 :: Cube -> Bool +prop_c2100_identity2 cube = + c t0 2 1 0 0 ~= (c t0 2 0 1 0 + c t1 2 0 0 1) / 2 + where + t0 = tetrahedron cube 0 + t1 = tetrahedron cube 1 + + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.8). The third and +-- fourth indices of c-t6 have been switched. This is because we +-- store the triangles oriented such that their volume is +-- positive. If T and T-tilde share \ and v3,v3-tilde +-- point in opposite directions, one of them has to have negative +-- volume! +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) + where + t0 = tetrahedron cube 0 + t6 = tetrahedron cube 6 + + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.8). See +-- 'prop_c3000_identity'. +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) + where + t0 = tetrahedron cube 0 + t6 = tetrahedron cube 6 + + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.8). See +-- 'prop_c3000_identity'. +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) + where + t0 = tetrahedron cube 0 + t6 = tetrahedron cube 6 + + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.8). See +-- 'prop_c3000_identity'. +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) + where + t0 = tetrahedron cube 0 + t6 = tetrahedron cube 6 + + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.8). See +-- 'prop_c3000_identity'. +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) + where + t0 = tetrahedron cube 0 + t6 = tetrahedron cube 6 + + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.8). See +-- 'prop_c3000_identity'. +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) + where + t0 = tetrahedron cube 0 + t6 = tetrahedron cube 6 + + + +-- | Given in Sorokina and Zeilfelder, p. 78. +prop_cijk1_identity :: Cube -> Bool +prop_cijk1_identity cube = + and [ c t0 i j k 1 ~= + (c t1 (i+1) j k 0) * ((b0 t0) (v3 t1)) + + (c t1 i (j+1) k 0) * ((b1 t0) (v3 t1)) + + (c t1 i j (k+1) 0) * ((b2 t0) (v3 t1)) + + (c t1 i j k 1) * ((b3 t0) (v3 t1)) | i <- [0..2], + j <- [0..2], + k <- [0..2], + i + j + k == 2] + where + t0 = tetrahedron cube 0 + t1 = tetrahedron cube 1 + + +-- | The function values at the interior should be the same for all +-- tetrahedra. +prop_interior_values_all_identical :: Cube -> Bool +prop_interior_values_all_identical cube = + all_equal [ eval (function_values tet) I | tet <- tetrahedra cube ] + + +-- | We know what (c t6 2 1 0 0) should be from Sorokina and Zeilfelder, p. 87. +-- This test checks the rotation works as expected. +prop_c_tilde_2100_rotation_correct :: Cube -> Bool +prop_c_tilde_2100_rotation_correct cube = + expr1 == expr2 + 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) + + -- 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) + + +-- | We know what (c t6 2 1 0 0) should be from Sorokina and +-- Zeilfelder, p. 87. This test checks the actual value based on +-- the FunctionValues of the cube. +-- +-- If 'prop_c_tilde_2100_rotation_correct' passes, then this test is +-- even meaningful! +prop_c_tilde_2100_correct :: Cube -> Bool +prop_c_tilde_2100_correct cube = + c t6 2 1 0 0 == expected + where + t0 = tetrahedron cube 0 + 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) + + +-- Tests to check that the correct edges are incidental. +prop_t0_shares_edge_with_t1 :: Cube -> Bool +prop_t0_shares_edge_with_t1 cube = + (v1 t0) == (v1 t1) && (v3 t0) == (v2 t1) + where + t0 = tetrahedron cube 0 + t1 = tetrahedron cube 1 + +prop_t0_shares_edge_with_t3 :: Cube -> Bool +prop_t0_shares_edge_with_t3 cube = + (v1 t0) == (v1 t3) && (v2 t0) == (v3 t3) + where + t0 = tetrahedron cube 0 + t3 = tetrahedron cube 3 + +prop_t0_shares_edge_with_t6 :: Cube -> Bool +prop_t0_shares_edge_with_t6 cube = + (v2 t0) == (v3 t6) && (v3 t0) == (v2 t6) + where + t0 = tetrahedron cube 0 + t6 = tetrahedron cube 6 + +prop_t1_shares_edge_with_t2 :: Cube -> Bool +prop_t1_shares_edge_with_t2 cube = + (v1 t1) == (v1 t2) && (v3 t1) == (v2 t2) + where + t1 = tetrahedron cube 1 + t2 = tetrahedron cube 2 + +prop_t1_shares_edge_with_t19 :: Cube -> Bool +prop_t1_shares_edge_with_t19 cube = + (v2 t1) == (v3 t19) && (v3 t1) == (v2 t19) + where + t1 = tetrahedron cube 1 + t19 = tetrahedron cube 19 + +prop_t2_shares_edge_with_t3 :: Cube -> Bool +prop_t2_shares_edge_with_t3 cube = + (v1 t1) == (v1 t2) && (v3 t1) == (v2 t2) + where + t1 = tetrahedron cube 1 + t2 = tetrahedron cube 2 + +prop_t2_shares_edge_with_t12 :: Cube -> Bool +prop_t2_shares_edge_with_t12 cube = + (v2 t2) == (v3 t12) && (v3 t2) == (v2 t12) + where + t2 = tetrahedron cube 2 + t12 = tetrahedron cube 12 + +prop_t3_shares_edge_with_t21 :: Cube -> Bool +prop_t3_shares_edge_with_t21 cube = + (v2 t3) == (v3 t21) && (v3 t3) == (v2 t21) + where + t3 = tetrahedron cube 3 + t21 = tetrahedron cube 21 + +prop_t4_shares_edge_with_t5 :: Cube -> Bool +prop_t4_shares_edge_with_t5 cube = + (v1 t4) == (v1 t5) && (v3 t4) == (v2 t5) + where + t4 = tetrahedron cube 4 + t5 = tetrahedron cube 5 + +prop_t4_shares_edge_with_t7 :: Cube -> Bool +prop_t4_shares_edge_with_t7 cube = + (v1 t4) == (v1 t7) && (v2 t4) == (v3 t7) + where + t4 = tetrahedron cube 4 + t7 = tetrahedron cube 7 + +prop_t4_shares_edge_with_t10 :: Cube -> Bool +prop_t4_shares_edge_with_t10 cube = + (v2 t4) == (v3 t10) && (v3 t4) == (v2 t10) + where + t4 = tetrahedron cube 4 + t10 = tetrahedron cube 10 + +prop_t5_shares_edge_with_t6 :: Cube -> Bool +prop_t5_shares_edge_with_t6 cube = + (v1 t5) == (v1 t6) && (v3 t5) == (v2 t6) + where + t5 = tetrahedron cube 5 + t6 = tetrahedron cube 6 + +prop_t5_shares_edge_with_t16 :: Cube -> Bool +prop_t5_shares_edge_with_t16 cube = + (v2 t5) == (v3 t16) && (v3 t5) == (v2 t16) + where + t5 = tetrahedron cube 5 + t16 = tetrahedron cube 16 + +prop_t6_shares_edge_with_t7 :: Cube -> Bool +prop_t6_shares_edge_with_t7 cube = + (v1 t6) == (v1 t7) && (v3 t6) == (v2 t7) + where + t6 = tetrahedron cube 6 + t7 = tetrahedron cube 7 + +prop_t7_shares_edge_with_t20 :: Cube -> Bool +prop_t7_shares_edge_with_t20 cube = + (v2 t7) == (v3 t20) && (v2 t7) == (v3 t20) + where + t7 = tetrahedron cube 7 + t20 = tetrahedron cube 20 + + + + + +p78_25_properties :: Test.Framework.Test +p78_25_properties = + testGroup "p. 78, Section (2.5) Properties" [ + testProperty "c_ijk1 identity" prop_cijk1_identity ] + +p79_26_properties :: Test.Framework.Test +p79_26_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 "c0120 identity4" prop_c0120_identity4, + testProperty "c0120 identity5" prop_c0120_identity5, + testProperty "c0120 identity6" prop_c0120_identity6, + testProperty "c0120 identity7" prop_c0120_identity7, + testProperty "c0210 identity1" prop_c0210_identity1, + testProperty "c0300 identity1" prop_c0300_identity1, + testProperty "c1110 identity" prop_c1110_identity, + testProperty "c1200 identity1" prop_c1200_identity1, + testProperty "c2100 identity1" prop_c2100_identity1] + +p79_27_properties :: Test.Framework.Test +p79_27_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 "c1101 identity" prop_c1101_identity, + testProperty "c1200 identity2" prop_c1200_identity2, + testProperty "c2100 identity2" prop_c2100_identity2 ] + + +p79_28_properties :: Test.Framework.Test +p79_28_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 "c1020 identity" prop_c1020_identity, + testProperty "c1002 identity" prop_c1002_identity, + testProperty "c1011 identity" prop_c1011_identity ] + + +edge_incidence_tests :: Test.Framework.Test +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 "t1 shares edge with t2" prop_t1_shares_edge_with_t2, + testProperty "t1 shares edge with t19" prop_t1_shares_edge_with_t19, + testProperty "t2 shares edge with t3" prop_t2_shares_edge_with_t3, + testProperty "t2 shares edge with t12" prop_t2_shares_edge_with_t12, + testProperty "t3 shares edge with t21" prop_t3_shares_edge_with_t21, + testProperty "t4 shares edge with t5" prop_t4_shares_edge_with_t5, + testProperty "t4 shares edge with t7" prop_t4_shares_edge_with_t7, + testProperty "t4 shares edge with t10" prop_t4_shares_edge_with_t10, + testProperty "t5 shares edge with t6" prop_t5_shares_edge_with_t6, + testProperty "t5 shares edge with t16" prop_t5_shares_edge_with_t16, + 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 = + testGroup "Cube Properties" [ + p78_25_properties, + p79_26_properties, + p79_27_properties, + p79_28_properties, + edge_incidence_tests, + testProperty "opposite octant tetrahedra are disjoint (1)" + prop_opposite_octant_tetrahedra_disjoint1, + testProperty "opposite octant tetrahedra are disjoint (2)" + prop_opposite_octant_tetrahedra_disjoint2, + testProperty "opposite octant tetrahedra are disjoint (3)" + prop_opposite_octant_tetrahedra_disjoint3, + testProperty "opposite octant tetrahedra are disjoint (4)" + prop_opposite_octant_tetrahedra_disjoint4, + testProperty "opposite octant tetrahedra are disjoint (5)" + prop_opposite_octant_tetrahedra_disjoint5, + testProperty "opposite octant tetrahedra are disjoint (6)" + prop_opposite_octant_tetrahedra_disjoint6, + testProperty "all volumes positive" prop_all_volumes_positive, + testProperty "all volumes exact" prop_all_volumes_exact, + testProperty "v0 all equal" prop_v0_all_equal, + testProperty "interior values all identical" + prop_interior_values_all_identical, + testProperty "c-tilde_2100 rotation correct" + prop_c_tilde_2100_rotation_correct, + testProperty "c-tilde_2100 correct" + prop_c_tilde_2100_correct ]