src/Cube.hs

   1 module Cube (
   2   Cube(..),
   3   cube_properties,
   4   find_containing_tetrahedron,
   5   tetrahedra,
   6   tetrahedron
   7   )
   8 where
   9
  10 import Data.Maybe (fromJust)
  11 import qualified Data.Vector as V (
  12   Vector,
  13   findIndex,
  14   map,
  15   minimum,
  16   singleton,
  17   snoc,
  18   unsafeIndex
  19   )
  20 import Prelude hiding (LT)
  21 import Test.Framework (Test, testGroup)
  22 import Test.Framework.Providers.QuickCheck2 (testProperty)
  23 import Test.QuickCheck (Arbitrary(..), Gen, Positive(..), choose)
  24
  25 import Cardinal
  26 import Comparisons ((~=), (~~=))
  27 import qualified Face (Face(Face, v0, v1, v2, v3))
  28 import FunctionValues
  29 import Misc (all_equal, disjoint)
  30 import Point
  31 import Tetrahedron (Tetrahedron(..), c, volume)
  32 import ThreeDimensional
  33
  34 data Cube = Cube { h :: Double,
  35                    i :: Int,
  36                    j :: Int,
  37                    k :: Int,
  38                    fv :: FunctionValues,
  39                    tetrahedra_volume :: Double }
  40             deriving (Eq)
  41
  42
  43 instance Arbitrary Cube where
  44     arbitrary = do
  45       (Positive h') <- arbitrary :: Gen (Positive Double)
  46       i' <- choose (coordmin, coordmax)
  47       j' <- choose (coordmin, coordmax)
  48       k' <- choose (coordmin, coordmax)
  49       fv' <- arbitrary :: Gen FunctionValues
  50       (Positive tet_vol) <- arbitrary :: Gen (Positive Double)
  51       return (Cube h' i' j' k' fv' tet_vol)
  52         where
  53           coordmin = -268435456 -- -(2^29 / 2)
  54           coordmax = 268435456  -- +(2^29 / 2)
  55
  56
  57 instance Show Cube where
  58     show cube =
  59         "Cube_" ++ subscript ++ "\n" ++
  60         " h: " ++ (show (h cube)) ++ "\n" ++
  61         " Center: " ++ (show (center cube)) ++ "\n" ++
  62         " xmin: " ++ (show (xmin cube)) ++ "\n" ++
  63         " xmax: " ++ (show (xmax cube)) ++ "\n" ++
  64         " ymin: " ++ (show (ymin cube)) ++ "\n" ++
  65         " ymax: " ++ (show (ymax cube)) ++ "\n" ++
  66         " zmin: " ++ (show (zmin cube)) ++ "\n" ++
  67         " zmax: " ++ (show (zmax cube)) ++ "\n" ++
  68         " fv: " ++ (show (Cube.fv cube)) ++ "\n"
  69         where
  70           subscript =
  71               (show (i cube)) ++ "," ++ (show (j cube)) ++ "," ++ (show (k cube))
  72
  73
  74 -- | The left-side boundary of the cube. See Sorokina and Zeilfelder,
  75 --   p. 76.
  76 xmin :: Cube -> Double
  77 xmin cube = (i' - 1/2)*delta
  78     where
  79       i' = fromIntegral (i cube) :: Double
  80       delta = h cube
  81
  82 -- | The right-side boundary of the cube. See Sorokina and Zeilfelder,
  83 --   p. 76.
  84 xmax :: Cube -> Double
  85 xmax cube = (i' + 1/2)*delta
  86     where
  87       i' = fromIntegral (i cube) :: Double
  88       delta = h cube
  89
  90 -- | The front boundary of the cube. See Sorokina and Zeilfelder,
  91 --   p. 76.
  92 ymin :: Cube -> Double
  93 ymin cube = (j' - 1/2)*delta
  94     where
  95       j' = fromIntegral (j cube) :: Double
  96       delta = h cube
  97
  98 -- | The back boundary of the cube. See Sorokina and Zeilfelder,
  99 --   p. 76.
 100 ymax :: Cube -> Double
 101 ymax cube = (j' + 1/2)*delta
 102     where
 103       j' = fromIntegral (j cube) :: Double
 104       delta = h cube
 105
 106 -- | The bottom boundary of the cube. See Sorokina and Zeilfelder,
 107 --   p. 76.
 108 zmin :: Cube -> Double
 109 zmin cube = (k' - 1/2)*delta
 110     where
 111       k' = fromIntegral (k cube) :: Double
 112       delta = h cube
 113
 114 -- | The top boundary of the cube. See Sorokina and Zeilfelder,
 115 --   p. 76.
 116 zmax :: Cube -> Double
 117 zmax cube = (k' + 1/2)*delta
 118     where
 119       k' = fromIntegral (k cube) :: Double
 120       delta = h cube
 121
 122 instance ThreeDimensional Cube where
 123     -- | The center of Cube_ijk coincides with v_ijk at
 124     --   (ih, jh, kh). See Sorokina and Zeilfelder, p. 76.
 125     center cube = (x, y, z)
 126            where
 127              delta = h cube
 128              i' = fromIntegral (i cube) :: Double
 129              j' = fromIntegral (j cube) :: Double
 130              k' = fromIntegral (k cube) :: Double
 131              x = delta * i'
 132              y = delta * j'
 133              z = delta * k'
 134
 135     -- | It's easy to tell if a point is within a cube; just make sure
 136     --   that it falls on the proper side of each of the cube's faces.
 137     contains_point cube (x, y, z)
 138         | x < (xmin cube) = False
 139         | x > (xmax cube) = False
 140         | y < (ymin cube) = False
 141         | y > (ymax cube) = False
 142         | z < (zmin cube) = False
 143         | z > (zmax cube) = False
 144         | otherwise = True
 145
 146
 147
 148 -- Face stuff.
 149
 150 -- | The top (in the direction of z) face of the cube.
 151 top_face :: Cube -> Face.Face
 152 top_face cube = Face.Face v0' v1' v2' v3'
 153     where
 154       delta = (1/2)*(h cube)
 155       v0' = (center cube) + (delta, -delta, delta)
 156       v1' = (center cube) + (delta, delta, delta)
 157       v2' = (center cube) + (-delta, delta, delta)
 158       v3' = (center cube) + (-delta, -delta, delta)
 159
 160
 161
 162 -- | The back (in the direction of x) face of the cube.
 163 back_face :: Cube -> Face.Face
 164 back_face cube = Face.Face v0' v1' v2' v3'
 165     where
 166       delta = (1/2)*(h cube)
 167       v0' = (center cube) + (delta, -delta, -delta)
 168       v1' = (center cube) + (delta, delta, -delta)
 169       v2' = (center cube) + (delta, delta, delta)
 170       v3' = (center cube) + (delta, -delta, delta)
 171
 172
 173 -- The bottom face (in the direction of -z) of the cube.
 174 down_face :: Cube -> Face.Face
 175 down_face cube = Face.Face v0' v1' v2' v3'
 176     where
 177       delta = (1/2)*(h cube)
 178       v0' = (center cube) + (-delta, -delta, -delta)
 179       v1' = (center cube) + (-delta, delta, -delta)
 180       v2' = (center cube) + (delta, delta, -delta)
 181       v3' = (center cube) + (delta, -delta, -delta)
 182
 183
 184
 185 -- | The front (in the direction of -x) face of the cube.
 186 front_face :: Cube -> Face.Face
 187 front_face cube = Face.Face v0' v1' v2' v3'
 188     where
 189       delta = (1/2)*(h cube)
 190       v0' = (center cube) + (-delta, -delta, delta)
 191       v1' = (center cube) + (-delta, delta, delta)
 192       v2' = (center cube) + (-delta, delta, -delta)
 193       v3' = (center cube) + (-delta, -delta, -delta)
 194
 195 -- | The left (in the direction of -y) face of the cube.
 196 left_face :: Cube -> Face.Face
 197 left_face cube = Face.Face v0' v1' v2' v3'
 198     where
 199       delta = (1/2)*(h cube)
 200       v0' = (center cube) + (delta, -delta, delta)
 201       v1' = (center cube) + (-delta, -delta, delta)
 202       v2' = (center cube) + (-delta, -delta, -delta)
 203       v3' = (center cube) + (delta, -delta, -delta)
 204
 205
 206 -- | The right (in the direction of y) face of the cube.
 207 right_face :: Cube -> Face.Face
 208 right_face cube = Face.Face v0' v1' v2' v3'
 209     where
 210       delta = (1/2)*(h cube)
 211       v0' = (center cube) + (-delta, delta, delta)
 212       v1' = (center cube) + (delta, delta, delta)
 213       v2' = (center cube) + (delta, delta, -delta)
 214       v3' = (center cube) + (-delta, delta, -delta)
 215
 216
 217 tetrahedron :: Cube -> Int -> Tetrahedron
 218
 219 tetrahedron cube 0 =
 220     Tetrahedron (fv cube) v0' v1' v2' v3' vol
 221     where
 222       v0' = center cube
 223       v1' = center (front_face cube)
 224       v2' = Face.v0 (front_face cube)
 225       v3' = Face.v1 (front_face cube)
 226       vol = tetrahedra_volume cube
 227
 228 tetrahedron cube 1 =
 229     Tetrahedron fv' v0' v1' v2' v3' vol
 230     where
 231       v0' = center cube
 232       v1' = center (front_face cube)
 233       v2' = Face.v1 (front_face cube)
 234       v3' = Face.v2 (front_face cube)
 235       fv' = rotate ccwx (fv cube)
 236       vol = tetrahedra_volume cube
 237
 238 tetrahedron cube 2 =
 239     Tetrahedron fv' v0' v1' v2' v3' vol
 240     where
 241       v0' = center cube
 242       v1' = center (front_face cube)
 243       v2' = Face.v2 (front_face cube)
 244       v3' = Face.v3 (front_face cube)
 245       fv' = rotate ccwx $ rotate ccwx $ fv cube
 246       vol = tetrahedra_volume cube
 247
 248 tetrahedron cube 3 =
 249     Tetrahedron fv' v0' v1' v2' v3' vol
 250     where
 251       v0' = center cube
 252       v1' = center (front_face cube)
 253       v2' = Face.v3 (front_face cube)
 254       v3' = Face.v0 (front_face cube)
 255       fv' = rotate cwx (fv cube)
 256       vol = tetrahedra_volume cube
 257
 258 tetrahedron cube 4 =
 259     Tetrahedron fv' v0' v1' v2' v3' vol
 260     where
 261       v0' = center cube
 262       v1' = center (top_face cube)
 263       v2' = Face.v0 (top_face cube)
 264       v3' = Face.v1 (top_face cube)
 265       fv' = rotate cwy (fv cube)
 266       vol = tetrahedra_volume cube
 267
 268 tetrahedron cube 5 =
 269     Tetrahedron fv' v0' v1' v2' v3' vol
 270     where
 271       v0' = center cube
 272       v1' = center (top_face cube)
 273       v2' = Face.v1 (top_face cube)
 274       v3' = Face.v2 (top_face cube)
 275       fv' = rotate cwy $ rotate cwz $ fv cube
 276       vol = tetrahedra_volume cube
 277
 278 tetrahedron cube 6 =
 279     Tetrahedron fv' v0' v1' v2' v3' vol
 280     where
 281       v0' = center cube
 282       v1' = center (top_face cube)
 283       v2' = Face.v2 (top_face cube)
 284       v3' = Face.v3 (top_face cube)
 285       fv' = rotate cwy $ rotate cwz
 286                        $ rotate cwz
 287                        $ fv cube
 288       vol = tetrahedra_volume cube
 289
 290 tetrahedron cube 7 =
 291     Tetrahedron fv' v0' v1' v2' v3' vol
 292     where
 293       v0' = center cube
 294       v1' = center (top_face cube)
 295       v2' = Face.v3 (top_face cube)
 296       v3' = Face.v0 (top_face cube)
 297       fv' = rotate cwy $ rotate ccwz $ fv cube
 298       vol = tetrahedra_volume cube
 299
 300 tetrahedron cube 8 =
 301     Tetrahedron fv' v0' v1' v2' v3' vol
 302     where
 303       v0' = center cube
 304       v1' = center (back_face cube)
 305       v2' = Face.v0 (back_face cube)
 306       v3' = Face.v1 (back_face cube)
 307       fv' = rotate cwy $ rotate cwy $ fv cube
 308       vol = tetrahedra_volume cube
 309
 310 tetrahedron cube 9 =
 311     Tetrahedron fv' v0' v1' v2' v3' vol
 312     where
 313       v0' = center cube
 314       v1' = center (back_face cube)
 315       v2' = Face.v1 (back_face cube)
 316       v3' = Face.v2 (back_face cube)
 317       fv' = rotate cwy $ rotate cwy
 318                        $ rotate cwx
 319                        $ fv cube
 320       vol = tetrahedra_volume cube
 321
 322 tetrahedron cube 10 =
 323     Tetrahedron fv' v0' v1' v2' v3' vol
 324     where
 325       v0' = center cube
 326       v1' = center (back_face cube)
 327       v2' = Face.v2 (back_face cube)
 328       v3' = Face.v3 (back_face cube)
 329       fv' = rotate cwy $ rotate cwy
 330                        $ rotate cwx
 331                        $ rotate cwx
 332                        $ fv cube
 333
 334       vol = tetrahedra_volume cube
 335
 336 tetrahedron cube 11 =
 337     Tetrahedron fv' v0' v1' v2' v3' vol
 338     where
 339       v0' = center cube
 340       v1' = center (back_face cube)
 341       v2' = Face.v3 (back_face cube)
 342       v3' = Face.v0 (back_face cube)
 343       fv' = rotate cwy $ rotate cwy
 344                        $ rotate ccwx
 345                        $ fv cube
 346       vol = tetrahedra_volume cube
 347
 348 tetrahedron cube 12 =
 349     Tetrahedron fv' v0' v1' v2' v3' vol
 350     where
 351       v0' = center cube
 352       v1' = center (down_face cube)
 353       v2' = Face.v0 (down_face cube)
 354       v3' = Face.v1 (down_face cube)
 355       fv' = rotate ccwy $ fv cube
 356       vol = tetrahedra_volume cube
 357
 358 tetrahedron cube 13 =
 359     Tetrahedron fv' v0' v1' v2' v3' vol
 360     where
 361       v0' = center cube
 362       v1' = center (down_face cube)
 363       v2' = Face.v1 (down_face cube)
 364       v3' = Face.v2 (down_face cube)
 365       fv' = rotate ccwy $ rotate ccwz $ fv cube
 366       vol = tetrahedra_volume cube
 367
 368 tetrahedron cube 14 =
 369     Tetrahedron fv' v0' v1' v2' v3' vol
 370     where
 371       v0' = center cube
 372       v1' = center (down_face cube)
 373       v2' = Face.v2 (down_face cube)
 374       v3' = Face.v3 (down_face cube)
 375       fv' = rotate ccwy $ rotate ccwz
 376                         $ rotate ccwz
 377                         $ fv cube
 378       vol = tetrahedra_volume cube
 379
 380 tetrahedron cube 15 =
 381     Tetrahedron fv' v0' v1' v2' v3' vol
 382     where
 383       v0' = center cube
 384       v1' = center (down_face cube)
 385       v2' = Face.v3 (down_face cube)
 386       v3' = Face.v0 (down_face cube)
 387       fv' = rotate ccwy $ rotate cwz $ fv cube
 388       vol = tetrahedra_volume cube
 389
 390 tetrahedron cube 16 =
 391     Tetrahedron fv' v0' v1' v2' v3' vol
 392     where
 393       v0' = center cube
 394       v1' = center (right_face cube)
 395       v2' = Face.v0 (right_face cube)
 396       v3' = Face.v1 (right_face cube)
 397       fv' = rotate ccwz $ fv cube
 398       vol = tetrahedra_volume cube
 399
 400 tetrahedron cube 17 =
 401     Tetrahedron fv' v0' v1' v2' v3' vol
 402     where
 403       v0' = center cube
 404       v1' = center (right_face cube)
 405       v2' = Face.v1 (right_face cube)
 406       v3' = Face.v2 (right_face cube)
 407       fv' = rotate ccwz $ rotate cwy $ fv cube
 408       vol = tetrahedra_volume cube
 409
 410 tetrahedron cube 18 =
 411     Tetrahedron fv' v0' v1' v2' v3' vol
 412     where
 413       v0' = center cube
 414       v1' = center (right_face cube)
 415       v2' = Face.v2 (right_face cube)
 416       v3' = Face.v3 (right_face cube)
 417       fv' = rotate ccwz $ rotate cwy
 418                         $ rotate cwy
 419                         $ fv cube
 420       vol = tetrahedra_volume cube
 421
 422 tetrahedron cube 19 =
 423     Tetrahedron fv' v0' v1' v2' v3' vol
 424     where
 425       v0' = center cube
 426       v1' = center (right_face cube)
 427       v2' = Face.v3 (right_face cube)
 428       v3' = Face.v0 (right_face cube)
 429       fv' = rotate ccwz $ rotate ccwy
 430                         $ fv cube
 431       vol = tetrahedra_volume cube
 432
 433 tetrahedron cube 20 =
 434     Tetrahedron fv' v0' v1' v2' v3' vol
 435     where
 436       v0' = center cube
 437       v1' = center (left_face cube)
 438       v2' = Face.v0 (left_face cube)
 439       v3' = Face.v1 (left_face cube)
 440       fv' = rotate cwz $ fv cube
 441       vol = tetrahedra_volume cube
 442
 443 tetrahedron cube 21 =
 444     Tetrahedron fv' v0' v1' v2' v3' vol
 445     where
 446       v0' = center cube
 447       v1' = center (left_face cube)
 448       v2' = Face.v1 (left_face cube)
 449       v3' = Face.v2 (left_face cube)
 450       fv' = rotate cwz $ rotate ccwy $ fv cube
 451       vol = tetrahedra_volume cube
 452
 453 tetrahedron cube 22 =
 454     Tetrahedron fv' v0' v1' v2' v3' vol
 455     where
 456       v0' = center cube
 457       v1' = center (left_face cube)
 458       v2' = Face.v2 (left_face cube)
 459       v3' = Face.v3 (left_face cube)
 460       fv' = rotate cwz $ rotate ccwy
 461                        $ rotate ccwy
 462                        $ fv cube
 463       vol = tetrahedra_volume cube
 464
 465 tetrahedron cube 23 =
 466     Tetrahedron fv' v0' v1' v2' v3' vol
 467     where
 468       v0' = center cube
 469       v1' = center (left_face cube)
 470       v2' = Face.v3 (left_face cube)
 471       v3' = Face.v0 (left_face cube)
 472       fv' = rotate cwz $ rotate cwy
 473                        $ fv cube
 474       vol = tetrahedra_volume cube
 475
 476 -- Feels dirty, but whatever.
 477 tetrahedron _ _ = error "asked for a nonexistent tetrahedron"
 478
 479
 480 -- Only used in tests, so we don't need the added speed
 481 -- of Data.Vector.
 482 tetrahedra :: Cube -> [Tetrahedron]
 483 tetrahedra cube = [ tetrahedron cube n | n <- [0..23] ]
 484
 485 front_left_top_tetrahedra :: Cube -> V.Vector Tetrahedron
 486 front_left_top_tetrahedra  cube =
 487   V.singleton (tetrahedron cube 0) `V.snoc`
 488     (tetrahedron cube 3) `V.snoc`
 489     (tetrahedron cube 6) `V.snoc`
 490     (tetrahedron cube 7) `V.snoc`
 491     (tetrahedron cube 20) `V.snoc`
 492     (tetrahedron cube 21)
 493
 494 front_left_down_tetrahedra :: Cube -> V.Vector Tetrahedron
 495 front_left_down_tetrahedra  cube =
 496   V.singleton (tetrahedron cube 0) `V.snoc`
 497     (tetrahedron cube 2) `V.snoc`
 498     (tetrahedron cube 3) `V.snoc`
 499     (tetrahedron cube 12) `V.snoc`
 500     (tetrahedron cube 15) `V.snoc`
 501     (tetrahedron cube 21)
 502
 503 front_right_top_tetrahedra :: Cube -> V.Vector Tetrahedron
 504 front_right_top_tetrahedra  cube =
 505   V.singleton (tetrahedron cube 0) `V.snoc`
 506     (tetrahedron cube 1) `V.snoc`
 507     (tetrahedron cube 5) `V.snoc`
 508     (tetrahedron cube 6) `V.snoc`
 509     (tetrahedron cube 16) `V.snoc`
 510     (tetrahedron cube 19)
 511
 512 front_right_down_tetrahedra :: Cube -> V.Vector Tetrahedron
 513 front_right_down_tetrahedra  cube =
 514   V.singleton (tetrahedron cube 1) `V.snoc`
 515     (tetrahedron cube 2) `V.snoc`
 516     (tetrahedron cube 12) `V.snoc`
 517     (tetrahedron cube 13) `V.snoc`
 518     (tetrahedron cube 18) `V.snoc`
 519     (tetrahedron cube 19)
 520
 521 back_left_top_tetrahedra :: Cube -> V.Vector Tetrahedron
 522 back_left_top_tetrahedra  cube =
 523   V.singleton (tetrahedron cube 0) `V.snoc`
 524     (tetrahedron cube 3) `V.snoc`
 525     (tetrahedron cube 6) `V.snoc`
 526     (tetrahedron cube 7) `V.snoc`
 527     (tetrahedron cube 20) `V.snoc`
 528     (tetrahedron cube 21)
 529
 530 back_left_down_tetrahedra :: Cube -> V.Vector Tetrahedron
 531 back_left_down_tetrahedra  cube =
 532   V.singleton (tetrahedron cube 8) `V.snoc`
 533     (tetrahedron cube 11) `V.snoc`
 534     (tetrahedron cube 14) `V.snoc`
 535     (tetrahedron cube 15) `V.snoc`
 536     (tetrahedron cube 22) `V.snoc`
 537     (tetrahedron cube 23)
 538
 539 back_right_top_tetrahedra :: Cube -> V.Vector Tetrahedron
 540 back_right_top_tetrahedra  cube =
 541   V.singleton (tetrahedron cube 4) `V.snoc`
 542     (tetrahedron cube 5) `V.snoc`
 543     (tetrahedron cube 9) `V.snoc`
 544     (tetrahedron cube 10) `V.snoc`
 545     (tetrahedron cube 16) `V.snoc`
 546     (tetrahedron cube 17)
 547
 548 back_right_down_tetrahedra :: Cube -> V.Vector Tetrahedron
 549 back_right_down_tetrahedra  cube =
 550   V.singleton (tetrahedron cube 8) `V.snoc`
 551     (tetrahedron cube 9) `V.snoc`
 552     (tetrahedron cube 13) `V.snoc`
 553     (tetrahedron cube 14) `V.snoc`
 554     (tetrahedron cube 17) `V.snoc`
 555     (tetrahedron cube 18)
 556
 557 in_top_half :: Cube -> Point -> Bool
 558 in_top_half cube (_,_,z) =
 559   distance_from_top <= distance_from_bottom
 560   where
 561     distance_from_top = abs $ (zmax cube) - z
 562     distance_from_bottom = abs $ (zmin cube) - z
 563
 564 in_front_half :: Cube -> Point -> Bool
 565 in_front_half cube (x,_,_) =
 566     distance_from_front <= distance_from_back
 567   where
 568     distance_from_front = abs $ (xmin cube) - x
 569     distance_from_back = abs $ (xmax cube) - x
 570
 571
 572 in_left_half :: Cube -> Point -> Bool
 573 in_left_half cube (_,y,_) =
 574     distance_from_left <= distance_from_right
 575   where
 576     distance_from_left = abs $ (ymin cube) - y
 577     distance_from_right = abs $ (ymax cube) - y
 578
 579
 580 -- | Takes a 'Cube', and returns the Tetrahedra belonging to it that
 581 --   contain the given 'Point'. This should be faster than checking
 582 --   every tetrahedron individually, since we determine which half
 583 --   (hemisphere?) of the cube the point lies in three times: once in
 584 --   each dimension. This allows us to eliminate non-candidates
 585 --   quickly.
 586 --
 587 --   This can throw an exception, but the use of 'head' might
 588 --   save us some unnecessary computations.
 589 --
 590 find_containing_tetrahedron :: Cube -> Point -> Tetrahedron
 591 find_containing_tetrahedron cube p =
 592   candidates `V.unsafeIndex` (fromJust lucky_idx)
 593   where
 594     front_half = in_front_half cube p
 595     top_half = in_top_half cube p
 596     left_half = in_left_half cube p
 597
 598     candidates =
 599       if front_half then
 600
 601         if left_half then
 602           if top_half then
 603             front_left_top_tetrahedra cube
 604           else
 605             front_left_down_tetrahedra cube
 606         else
 607           if top_half then
 608             front_right_top_tetrahedra cube
 609           else
 610             front_right_down_tetrahedra cube
 611
 612       else -- bottom half
 613
 614         if left_half then
 615           if top_half then
 616             back_left_top_tetrahedra cube
 617           else
 618             back_left_down_tetrahedra cube
 619         else
 620           if top_half then
 621             back_right_top_tetrahedra cube
 622           else
 623             back_right_down_tetrahedra cube
 624
 625     -- Use the dot product instead of 'distance' here to save a
 626     -- sqrt(). So, "distances" below really means "distances squared."
 627     distances = V.map ((dot p) . center) candidates
 628     shortest_distance = V.minimum distances
 629     lucky_idx = V.findIndex
 630                   (\t -> (center t) `dot` p == shortest_distance)
 631                   candidates
 632
 633
 634
 635
 636
 637
 638 -- Tests
 639
 640 -- Quickcheck tests.
 641
 642 prop_opposite_octant_tetrahedra_disjoint1 :: Cube -> Bool
 643 prop_opposite_octant_tetrahedra_disjoint1 cube =
 644   disjoint (front_left_top_tetrahedra cube) (front_right_down_tetrahedra cube)
 645
 646 prop_opposite_octant_tetrahedra_disjoint2 :: Cube -> Bool
 647 prop_opposite_octant_tetrahedra_disjoint2 cube =
 648   disjoint (back_left_top_tetrahedra cube) (back_right_down_tetrahedra cube)
 649
 650 prop_opposite_octant_tetrahedra_disjoint3 :: Cube -> Bool
 651 prop_opposite_octant_tetrahedra_disjoint3 cube =
 652   disjoint (front_left_top_tetrahedra cube) (back_right_top_tetrahedra cube)
 653
 654 prop_opposite_octant_tetrahedra_disjoint4 :: Cube -> Bool
 655 prop_opposite_octant_tetrahedra_disjoint4 cube =
 656   disjoint (front_left_down_tetrahedra cube) (back_right_down_tetrahedra cube)
 657
 658 prop_opposite_octant_tetrahedra_disjoint5 :: Cube -> Bool
 659 prop_opposite_octant_tetrahedra_disjoint5 cube =
 660   disjoint (front_left_top_tetrahedra cube) (back_left_down_tetrahedra cube)
 661
 662 prop_opposite_octant_tetrahedra_disjoint6 :: Cube -> Bool
 663 prop_opposite_octant_tetrahedra_disjoint6 cube =
 664   disjoint (front_right_top_tetrahedra cube) (back_right_down_tetrahedra cube)
 665
 666
 667 -- | Since the grid size is necessarily positive, all tetrahedra
 668 --   (which comprise cubes of positive volume) must have positive
 669 --   volume as well.
 670 prop_all_volumes_positive :: Cube -> Bool
 671 prop_all_volumes_positive cube =
 672     all (>= 0) volumes
 673     where
 674       ts = tetrahedra cube
 675       volumes = map volume ts
 676
 677
 678 -- | In fact, since all of the tetrahedra are identical, we should
 679 --   already know their volumes. There's 24 tetrahedra to a cube, so
 680 --   we'd expect the volume of each one to be (1/24)*h^3.
 681 prop_all_volumes_exact :: Cube -> Bool
 682 prop_all_volumes_exact cube =
 683     and [volume t ~~= (1/24)*(delta^(3::Int)) | t <- tetrahedra cube]
 684     where
 685       delta = h cube
 686
 687 -- | All tetrahedron should have their v0 located at the center of the cube.
 688 prop_v0_all_equal :: Cube -> Bool
 689 prop_v0_all_equal cube = (v0 t0) == (v0 t1)
 690     where
 691       t0 = head (tetrahedra cube) -- Doesn't matter which two we choose.
 692       t1 = head $ tail (tetrahedra cube)
 693
 694
 695 -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Note that the
 696 --   third and fourth indices of c-t3 have been switched. This is
 697 --   because we store the triangles oriented such that their volume is
 698 --   positive. If T and T-tilde share \<v0,v1,v2\> and v3,v3-tilde point
 699 --   in opposite directions, one of them has to have negative volume!
 700 prop_c0120_identity1 :: Cube -> Bool
 701 prop_c0120_identity1 cube =
 702    c t0 0 1 2 0 ~= (c t0 0 0 2 1 + c t3 0 0 1 2) / 2
 703      where
 704        t0 = tetrahedron cube 0
 705        t3 = tetrahedron cube 3
 706
 707
 708 -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Repeats
 709 --   'prop_c0120_identity1' with tetrahedrons 1 and 2.
 710 prop_c0120_identity2 :: Cube -> Bool
 711 prop_c0120_identity2 cube =
 712    c t1 0 1 2 0 ~= (c t1 0 0 2 1 + c t0 0 0 1 2) / 2
 713      where
 714        t0 = tetrahedron cube 0
 715        t1 = tetrahedron cube 1
 716
 717 -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Repeats
 718 --   'prop_c0120_identity1' with tetrahedrons 1 and 2.
 719 prop_c0120_identity3 :: Cube -> Bool
 720 prop_c0120_identity3 cube =
 721    c t2 0 1 2 0 ~= (c t2 0 0 2 1 + c t1 0 0 1 2) / 2
 722      where
 723        t1 = tetrahedron cube 1
 724        t2 = tetrahedron cube 2
 725
 726 -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Repeats
 727 --   'prop_c0120_identity1' with tetrahedrons 2 and 3.
 728 prop_c0120_identity4 :: Cube -> Bool
 729 prop_c0120_identity4 cube =
 730    c t3 0 1 2 0 ~= (c t3 0 0 2 1 + c t2 0 0 1 2) / 2
 731      where
 732        t2 = tetrahedron cube 2
 733        t3 = tetrahedron cube 3
 734
 735
 736 -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Repeats
 737 --   'prop_c0120_identity1' with tetrahedrons 4 and 5.
 738 prop_c0120_identity5 :: Cube -> Bool
 739 prop_c0120_identity5 cube =
 740     c t5 0 1 2 0 ~= (c t5 0 0 2 1 + c t4 0 0 1 2) / 2
 741     where
 742       t4 = tetrahedron cube 4
 743       t5 = tetrahedron cube 5
 744
 745 -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Repeats
 746 --   'prop_c0120_identity1' with tetrahedrons 5 and 6.
 747 prop_c0120_identity6 :: Cube -> Bool
 748 prop_c0120_identity6 cube =
 749    c t6 0 1 2 0 ~= (c t6 0 0 2 1 + c t5 0 0 1 2) / 2
 750      where
 751        t5 = tetrahedron cube 5
 752        t6 = tetrahedron cube 6
 753
 754
 755 -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Repeats
 756 --   'prop_c0120_identity1' with tetrahedrons 6 and 7.
 757 prop_c0120_identity7 :: Cube -> Bool
 758 prop_c0120_identity7 cube =
 759    c t7 0 1 2 0 ~= (c t7 0 0 2 1 + c t6 0 0 1 2) / 2
 760      where
 761        t6 = tetrahedron cube 6
 762        t7 = tetrahedron cube 7
 763
 764
 765 -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). See
 766 --   'prop_c0120_identity1'.
 767 prop_c0210_identity1 :: Cube -> Bool
 768 prop_c0210_identity1 cube =
 769     c t0 0 2 1 0 ~= (c t0 0 1 1 1 + c t3 0 1 1 1) / 2
 770       where
 771         t0 = tetrahedron cube 0
 772         t3 = tetrahedron cube 3
 773
 774
 775 -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). See
 776 --   'prop_c0120_identity1'.
 777 prop_c0300_identity1 :: Cube -> Bool
 778 prop_c0300_identity1 cube =
 779     c t0 0 3 0 0 ~= (c t0 0 2 0 1 + c t3 0 2 1 0) / 2
 780       where
 781         t0 = tetrahedron cube 0
 782         t3 = tetrahedron cube 3
 783
 784
 785 -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). See
 786 --   'prop_c0120_identity1'.
 787 prop_c1110_identity :: Cube -> Bool
 788 prop_c1110_identity cube =
 789     c t0 1 1 1 0 ~= (c t0 1 0 1 1 + c t3 1 0 1 1) / 2
 790       where
 791         t0 = tetrahedron cube 0
 792         t3 = tetrahedron cube 3
 793
 794
 795 -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). See
 796 --   'prop_c0120_identity1'.
 797 prop_c1200_identity1 :: Cube -> Bool
 798 prop_c1200_identity1 cube =
 799     c t0 1 2 0 0 ~= (c t0 1 1 0 1 + c t3 1 1 1 0) / 2
 800       where
 801         t0 = tetrahedron cube 0
 802         t3 = tetrahedron cube 3
 803
 804
 805 -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). See
 806 --   'prop_c0120_identity1'.
 807 prop_c2100_identity1 :: Cube -> Bool
 808 prop_c2100_identity1 cube =
 809     c t0 2 1 0 0 ~= (c t0 2 0 0 1 + c t3 2 0 1 0) / 2
 810       where
 811         t0 = tetrahedron cube 0
 812         t3 = tetrahedron cube 3
 813
 814
 815
 816 -- | Given in Sorokina and Zeilfelder, p. 79, (2.7). Note that the
 817 --   third and fourth indices of c-t3 have been switched. This is
 818 --   because we store the triangles oriented such that their volume is
 819 --   positive. If T and T-tilde share \<v0,v1,v2\> and v3,v3-tilde
 820 --   point in opposite directions, one of them has to have negative
 821 --   volume!
 822 prop_c0102_identity1 :: Cube -> Bool
 823 prop_c0102_identity1 cube =
 824     c t0 0 1 0 2 ~= (c t0 0 0 1 2 + c t1 0 0 2 1) / 2
 825       where
 826         t0 = tetrahedron cube 0
 827         t1 = tetrahedron cube 1
 828
 829
 830 -- | Given in Sorokina and Zeilfelder, p. 79, (2.7). See
 831 --   'prop_c0102_identity1'.
 832 prop_c0201_identity1 :: Cube -> Bool
 833 prop_c0201_identity1 cube =
 834     c t0 0 2 0 1 ~= (c t0 0 1 1 1 + c t1 0 1 1 1) / 2
 835       where
 836         t0 = tetrahedron cube 0
 837         t1 = tetrahedron cube 1
 838
 839
 840 -- | Given in Sorokina and Zeilfelder, p. 79, (2.7). See
 841 --   'prop_c0102_identity1'.
 842 prop_c0300_identity2 :: Cube -> Bool
 843 prop_c0300_identity2 cube =
 844     c t0 0 3 0 0 ~= (c t0 0 2 1 0 + c t1 0 2 0 1) / 2
 845       where
 846         t0 = tetrahedron cube 0
 847         t1 = tetrahedron cube 1
 848
 849
 850 -- | Given in Sorokina and Zeilfelder, p. 79, (2.7). See
 851 --   'prop_c0102_identity1'.
 852 prop_c1101_identity :: Cube -> Bool
 853 prop_c1101_identity cube =
 854     c t0 1 1 0 1 ~= (c t0 1 0 1 1 + c t1 1 0 1 1) / 2
 855       where
 856         t0 = tetrahedron cube 0
 857         t1 = tetrahedron cube 1
 858
 859
 860 -- | Given in Sorokina and Zeilfelder, p. 79, (2.7). See
 861 --   'prop_c0102_identity1'.
 862 prop_c1200_identity2 :: Cube -> Bool
 863 prop_c1200_identity2 cube =
 864     c t0 1 2 0 0 ~= (c t0 1 1 1 0 + c t1 1 1 0 1) / 2
 865       where
 866         t0 = tetrahedron cube 0
 867         t1 = tetrahedron cube 1
 868
 869
 870 -- | Given in Sorokina and Zeilfelder, p. 79, (2.7). See
 871 --   'prop_c0102_identity1'.
 872 prop_c2100_identity2 :: Cube -> Bool
 873 prop_c2100_identity2 cube =
 874     c t0 2 1 0 0 ~= (c t0 2 0 1 0 + c t1 2 0 0 1) / 2
 875       where
 876         t0 = tetrahedron cube 0
 877         t1 = tetrahedron cube 1
 878
 879
 880 -- | Given in Sorokina and Zeilfelder, p. 79, (2.8). The third and
 881 --   fourth indices of c-t6 have been switched. This is because we
 882 --   store the triangles oriented such that their volume is
 883 --   positive. If T and T-tilde share \<v0,v1,v2\> and v3,v3-tilde
 884 --   point in opposite directions, one of them has to have negative
 885 --   volume!
 886 prop_c3000_identity :: Cube -> Bool
 887 prop_c3000_identity cube =
 888     c t0 3 0 0 0 ~= c t0 2 1 0 0 + c t6 2 1 0 0
 889                     - ((c t0 2 0 1 0 + c t0 2 0 0 1)/ 2)
 890       where
 891         t0 = tetrahedron cube 0
 892         t6 = tetrahedron cube 6
 893
 894
 895 -- | Given in Sorokina and Zeilfelder, p. 79, (2.8). See
 896 --   'prop_c3000_identity'.
 897 prop_c2010_identity :: Cube -> Bool
 898 prop_c2010_identity cube =
 899     c t0 2 0 1 0 ~= c t0 1 1 1 0 + c t6 1 1 0 1
 900                     - ((c t0 1 0 2 0 + c t0 1 0 1 1)/ 2)
 901       where
 902         t0 = tetrahedron cube 0
 903         t6 = tetrahedron cube 6
 904
 905
 906 -- | Given in Sorokina and Zeilfelder, p. 79, (2.8). See
 907 --   'prop_c3000_identity'.
 908 prop_c2001_identity :: Cube -> Bool
 909 prop_c2001_identity cube =
 910     c t0 2 0 0 1 ~= c t0 1 1 0 1 + c t6 1 1 1 0
 911                     - ((c t0 1 0 0 2 + c t0 1 0 1 1)/ 2)
 912       where
 913         t0 = tetrahedron cube 0
 914         t6 = tetrahedron cube 6
 915
 916
 917 -- | Given in Sorokina and Zeilfelder, p. 79, (2.8). See
 918 --   'prop_c3000_identity'.
 919 prop_c1020_identity :: Cube -> Bool
 920 prop_c1020_identity cube =
 921     c t0 1 0 2 0 ~= c t0 0 1 2 0 + c t6 0 1 0 2
 922                     - ((c t0 0 0 3 0 + c t0 0 0 2 1)/ 2)
 923       where
 924         t0 = tetrahedron cube 0
 925         t6 = tetrahedron cube 6
 926
 927
 928 -- | Given in Sorokina and Zeilfelder, p. 79, (2.8). See
 929 --   'prop_c3000_identity'.
 930 prop_c1002_identity :: Cube -> Bool
 931 prop_c1002_identity cube =
 932     c t0 1 0 0 2 ~= c t0 0 1 0 2 + c t6 0 1 2 0
 933                     - ((c t0 0 0 0 3 + c t0 0 0 1 2)/ 2)
 934       where
 935         t0 = tetrahedron cube 0
 936         t6 = tetrahedron cube 6
 937
 938
 939 -- | Given in Sorokina and Zeilfelder, p. 79, (2.8). See
 940 --   'prop_c3000_identity'.
 941 prop_c1011_identity :: Cube -> Bool
 942 prop_c1011_identity cube =
 943     c t0 1 0 1 1 ~= c t0 0 1 1 1 + c t6 0 1 1 1 -
 944                     ((c t0 0 0 1 2 + c t0 0 0 2 1)/ 2)
 945       where
 946         t0 = tetrahedron cube 0
 947         t6 = tetrahedron cube 6
 948
 949
 950 -- | The function values at the interior should be the same for all
 951 --   tetrahedra.
 952 prop_interior_values_all_identical :: Cube -> Bool
 953 prop_interior_values_all_identical cube =
 954     all_equal [ eval (function_values tet) I | tet <- tetrahedra cube ]
 955
 956
 957 -- | We know what (c t6 2 1 0 0) should be from Sorokina and Zeilfelder, p. 87.
 958 --   This test checks the rotation works as expected.
 959 prop_c_tilde_2100_rotation_correct :: Cube -> Bool
 960 prop_c_tilde_2100_rotation_correct cube =
 961     expr1 == expr2
 962     where
 963       t0 = tetrahedron cube 0
 964       t6 = tetrahedron cube 6
 965
 966       -- What gets computed for c2100 of t6.
 967       expr1 = eval (function_values t6) $
 968           (3/8)*I +
 969           (1/12)*(T + R + L + D) +
 970           (1/64)*(FT + FR + FL + FD) +
 971           (7/48)*F +
 972           (1/48)*B +
 973           (1/96)*(RT + LD + LT + RD) +
 974           (1/192)*(BT + BR + BL + BD)
 975
 976       -- What should be computed for c2100 of t6.
 977       expr2 = eval (function_values t0) $
 978               (3/8)*I +
 979               (1/12)*(F + R + L + B) +
 980               (1/64)*(FT + RT + LT + BT) +
 981               (7/48)*T +
 982               (1/48)*D +
 983               (1/96)*(FR + FL + BR + BL) +
 984               (1/192)*(FD + RD + LD + BD)
 985
 986
 987 -- | We know what (c t6 2 1 0 0) should be from Sorokina and
 988 --   Zeilfelder, p. 87.  This test checks the actual value based on
 989 --   the FunctionValues of the cube.
 990 --
 991 --   If 'prop_c_tilde_2100_rotation_correct' passes, then this test is
 992 --   even meaningful!
 993 prop_c_tilde_2100_correct :: Cube -> Bool
 994 prop_c_tilde_2100_correct cube =
 995     c t6 2 1 0 0 == expected
 996     where
 997       t0 = tetrahedron cube 0
 998       t6 = tetrahedron cube 6
 999       fvs = function_values t0
1000       expected = eval fvs $
1001                   (3/8)*I +
1002                   (1/12)*(F + R + L + B) +
1003                   (1/64)*(FT + RT + LT + BT) +
1004                   (7/48)*T +
1005                   (1/48)*D +
1006                   (1/96)*(FR + FL + BR + BL) +
1007                   (1/192)*(FD + RD + LD + BD)
1008
1009
1010 -- Tests to check that the correct edges are incidental.
1011 prop_t0_shares_edge_with_t1 :: Cube -> Bool
1012 prop_t0_shares_edge_with_t1 cube =
1013     (v1 t0) == (v1 t1) && (v3 t0) == (v2 t1)
1014       where
1015         t0 = tetrahedron cube 0
1016         t1 = tetrahedron cube 1
1017
1018 prop_t0_shares_edge_with_t3 :: Cube -> Bool
1019 prop_t0_shares_edge_with_t3 cube =
1020     (v1 t0) == (v1 t3) && (v2 t0) == (v3 t3)
1021       where
1022         t0 = tetrahedron cube 0
1023         t3 = tetrahedron cube 3
1024
1025 prop_t0_shares_edge_with_t6 :: Cube -> Bool
1026 prop_t0_shares_edge_with_t6 cube =
1027     (v2 t0) == (v3 t6) && (v3 t0) == (v2 t6)
1028       where
1029         t0 = tetrahedron cube 0
1030         t6 = tetrahedron cube 6
1031
1032 prop_t1_shares_edge_with_t2 :: Cube -> Bool
1033 prop_t1_shares_edge_with_t2 cube =
1034     (v1 t1) == (v1 t2) && (v3 t1) == (v2 t2)
1035       where
1036         t1 = tetrahedron cube 1
1037         t2 = tetrahedron cube 2
1038
1039 prop_t1_shares_edge_with_t19 :: Cube -> Bool
1040 prop_t1_shares_edge_with_t19 cube =
1041     (v2 t1) == (v3 t19) && (v3 t1) == (v2 t19)
1042       where
1043         t1 = tetrahedron cube 1
1044         t19 = tetrahedron cube 19
1045
1046 prop_t2_shares_edge_with_t3 :: Cube -> Bool
1047 prop_t2_shares_edge_with_t3 cube =
1048     (v1 t1) == (v1 t2) && (v3 t1) == (v2 t2)
1049       where
1050         t1 = tetrahedron cube 1
1051         t2 = tetrahedron cube 2
1052
1053 prop_t2_shares_edge_with_t12 :: Cube -> Bool
1054 prop_t2_shares_edge_with_t12 cube =
1055     (v2 t2) == (v3 t12) && (v3 t2) == (v2 t12)
1056       where
1057         t2 = tetrahedron cube 2
1058         t12 = tetrahedron cube 12
1059
1060 prop_t3_shares_edge_with_t21 :: Cube -> Bool
1061 prop_t3_shares_edge_with_t21 cube =
1062     (v2 t3) == (v3 t21) && (v3 t3) == (v2 t21)
1063       where
1064         t3 = tetrahedron cube 3
1065         t21 = tetrahedron cube 21
1066
1067 prop_t4_shares_edge_with_t5 :: Cube -> Bool
1068 prop_t4_shares_edge_with_t5 cube =
1069     (v1 t4) == (v1 t5) && (v3 t4) == (v2 t5)
1070       where
1071         t4 = tetrahedron cube 4
1072         t5 = tetrahedron cube 5
1073
1074 prop_t4_shares_edge_with_t7 :: Cube -> Bool
1075 prop_t4_shares_edge_with_t7 cube =
1076     (v1 t4) == (v1 t7) && (v2 t4) == (v3 t7)
1077       where
1078         t4 = tetrahedron cube 4
1079         t7 = tetrahedron cube 7
1080
1081 prop_t4_shares_edge_with_t10 :: Cube -> Bool
1082 prop_t4_shares_edge_with_t10 cube =
1083     (v2 t4) == (v3 t10) && (v3 t4) == (v2 t10)
1084       where
1085         t4 = tetrahedron cube 4
1086         t10 = tetrahedron cube 10
1087
1088 prop_t5_shares_edge_with_t6 :: Cube -> Bool
1089 prop_t5_shares_edge_with_t6 cube =
1090     (v1 t5) == (v1 t6) && (v3 t5) == (v2 t6)
1091       where
1092         t5 = tetrahedron cube 5
1093         t6 = tetrahedron cube 6
1094
1095 prop_t5_shares_edge_with_t16 :: Cube -> Bool
1096 prop_t5_shares_edge_with_t16 cube =
1097     (v2 t5) == (v3 t16) && (v3 t5) == (v2 t16)
1098       where
1099         t5 = tetrahedron cube 5
1100         t16 = tetrahedron cube 16
1101
1102 prop_t6_shares_edge_with_t7 :: Cube -> Bool
1103 prop_t6_shares_edge_with_t7 cube =
1104     (v1 t6) == (v1 t7) && (v3 t6) == (v2 t7)
1105       where
1106         t6 = tetrahedron cube 6
1107         t7 = tetrahedron cube 7
1108
1109 prop_t7_shares_edge_with_t20 :: Cube -> Bool
1110 prop_t7_shares_edge_with_t20 cube =
1111     (v2 t7) == (v3 t20) && (v2 t7) == (v3 t20)
1112       where
1113         t7 = tetrahedron cube 7
1114         t20 = tetrahedron cube 20
1115
1116
1117 p79_26_properties :: Test.Framework.Test
1118 p79_26_properties =
1119     testGroup "p. 79, Section (2.6) Properties" [
1120       testProperty "c0120 identity1" prop_c0120_identity1,
1121       testProperty "c0120 identity2" prop_c0120_identity2,
1122       testProperty "c0120 identity3" prop_c0120_identity3,
1123       testProperty "c0120 identity4" prop_c0120_identity4,
1124       testProperty "c0120 identity5" prop_c0120_identity5,
1125       testProperty "c0120 identity6" prop_c0120_identity6,
1126       testProperty "c0120 identity7" prop_c0120_identity7,
1127       testProperty "c0210 identity1" prop_c0210_identity1,
1128       testProperty "c0300 identity1" prop_c0300_identity1,
1129       testProperty "c1110 identity" prop_c1110_identity,
1130       testProperty "c1200 identity1" prop_c1200_identity1,
1131       testProperty "c2100 identity1" prop_c2100_identity1]
1132
1133 p79_27_properties :: Test.Framework.Test
1134 p79_27_properties =
1135     testGroup "p. 79, Section (2.7) Properties" [
1136       testProperty "c0102 identity1" prop_c0102_identity1,
1137       testProperty "c0201 identity1" prop_c0201_identity1,
1138       testProperty "c0300 identity2" prop_c0300_identity2,
1139       testProperty "c1101 identity" prop_c1101_identity,
1140       testProperty "c1200 identity2" prop_c1200_identity2,
1141       testProperty "c2100 identity2" prop_c2100_identity2 ]
1142
1143
1144 p79_28_properties :: Test.Framework.Test
1145 p79_28_properties =
1146   testGroup "p. 79, Section (2.8) Properties" [
1147     testProperty "c3000 identity" prop_c3000_identity,
1148     testProperty "c2010 identity" prop_c2010_identity,
1149     testProperty "c2001 identity" prop_c2001_identity,
1150     testProperty "c1020 identity" prop_c1020_identity,
1151     testProperty "c1002 identity" prop_c1002_identity,
1152     testProperty "c1011 identity" prop_c1011_identity ]
1153
1154
1155 edge_incidence_tests :: Test.Framework.Test
1156 edge_incidence_tests =
1157     testGroup "Edge Incidence Tests" [
1158       testProperty "t0 shares edge with t6" prop_t0_shares_edge_with_t6,
1159       testProperty "t0 shares edge with t1" prop_t0_shares_edge_with_t1,
1160       testProperty "t0 shares edge with t3" prop_t0_shares_edge_with_t3,
1161       testProperty "t1 shares edge with t2" prop_t1_shares_edge_with_t2,
1162       testProperty "t1 shares edge with t19" prop_t1_shares_edge_with_t19,
1163       testProperty "t2 shares edge with t3" prop_t2_shares_edge_with_t3,
1164       testProperty "t2 shares edge with t12" prop_t2_shares_edge_with_t12,
1165       testProperty "t3 shares edge with t21" prop_t3_shares_edge_with_t21,
1166       testProperty "t4 shares edge with t5" prop_t4_shares_edge_with_t5,
1167       testProperty "t4 shares edge with t7" prop_t4_shares_edge_with_t7,
1168       testProperty "t4 shares edge with t10" prop_t4_shares_edge_with_t10,
1169       testProperty "t5 shares edge with t6" prop_t5_shares_edge_with_t6,
1170       testProperty "t5 shares edge with t16" prop_t5_shares_edge_with_t16,
1171       testProperty "t6 shares edge with t7" prop_t6_shares_edge_with_t7,
1172       testProperty "t7 shares edge with t20" prop_t7_shares_edge_with_t20 ]
1173
1174 cube_properties :: Test.Framework.Test
1175 cube_properties =
1176   testGroup "Cube Properties" [
1177     p79_26_properties,
1178     p79_27_properties,
1179     p79_28_properties,
1180     edge_incidence_tests,
1181     testProperty "opposite octant tetrahedra are disjoint (1)"
1182       prop_opposite_octant_tetrahedra_disjoint1,
1183     testProperty "opposite octant tetrahedra are disjoint (2)"
1184       prop_opposite_octant_tetrahedra_disjoint2,
1185     testProperty "opposite octant tetrahedra are disjoint (3)"
1186      prop_opposite_octant_tetrahedra_disjoint3,
1187     testProperty "opposite octant tetrahedra are disjoint (4)"
1188       prop_opposite_octant_tetrahedra_disjoint4,
1189     testProperty "opposite octant tetrahedra are disjoint (5)"
1190       prop_opposite_octant_tetrahedra_disjoint5,
1191     testProperty "opposite octant tetrahedra are disjoint (6)"
1192       prop_opposite_octant_tetrahedra_disjoint6,
1193     testProperty "all volumes positive" prop_all_volumes_positive,
1194     testProperty "all volumes exact" prop_all_volumes_exact,
1195     testProperty "v0 all equal" prop_v0_all_equal,
1196     testProperty "interior values all identical"
1197       prop_interior_values_all_identical,
1198     testProperty "c-tilde_2100 rotation correct"
1199       prop_c_tilde_2100_rotation_correct,
1200     testProperty "c-tilde_2100 correct"
1201       prop_c_tilde_2100_correct ]