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