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