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