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