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