src/Tests/Face.hs

   1 module Tests.Face
   2 where
   3
   4 import Control.Monad (unless)
   5 import Test.HUnit
   6 import Test.QuickCheck
   7
   8 import Comparisons
   9 import Cube (Cube(grid), cube_at, top)
  10 import Face (face0,
  11              face2,
  12              face5,
  13              tetrahedron0,
  14              tetrahedron1,
  15              tetrahedron2,
  16              tetrahedron3,
  17              tetrahedrons)
  18 import Grid (Grid(h), make_grid)
  19 import Point
  20 import Tetrahedron
  21
  22
  23 -- HUnit tests.
  24
  25 -- | An HUnit assertion that wraps the almost_equals function. Stolen
  26 --   from the definition of assertEqual in Test/HUnit/Base.hs.
  27 assertAlmostEqual :: String -> Double -> Double -> Assertion
  28 assertAlmostEqual preface expected actual =
  29   unless (actual ~= expected) (assertFailure msg)
  30  where msg = (if null preface then "" else preface ++ "\n") ++
  31              "expected: " ++ show expected ++ "\n but got: " ++ show actual
  32
  33
  34 -- | An HUnit assertion that wraps the is_close function. Stolen
  35 --   from the definition of assertEqual in Test/HUnit/Base.hs.
  36 assertClose :: String -> Point -> Point -> Assertion
  37 assertClose preface expected actual =
  38   unless (actual `is_close` expected) (assertFailure msg)
  39  where msg = (if null preface then "" else preface ++ "\n") ++
  40              "expected: " ++ show expected ++ "\n but got: " ++ show actual
  41
  42
  43 -- | Values of the function f(x,y,z) = 1 + x + xy + xyz taken at nine
  44 --   points (hi, hj, jk) with h = 1. From example one in the paper.
  45 --   Used in the next bunch of tests.
  46 trilinear :: [[[Double]]]
  47 trilinear = [ [ [ 1, 2, 3 ],
  48                 [ 1, 3, 5 ],
  49                 [ 1, 4, 7 ] ],
  50               [ [ 1, 2, 3 ],
  51                 [ 1, 4, 7 ],
  52                 [ 1, 6, 11 ] ],
  53               [ [ 1, 2, 3 ],
  54                 [ 1, 5, 9 ],
  55                 [ 1, 8, 15 ]]]
  56
  57 -- | Check the value of c0030 for any tetrahedron belonging to the
  58 --   cube centered on (1,1,1) with a grid constructed from the
  59 --   trilinear values. See example one in the paper.
  60 test_trilinear_c0030 :: Test
  61 test_trilinear_c0030 =
  62     TestCase $ assertAlmostEqual "c0030 is correct" (c t 0 0 3 0) (17/8)
  63       where
  64         g = make_grid 1 trilinear
  65         cube = cube_at g 1 1 1
  66         t = head (tetrahedrons cube) -- Any one will do.
  67
  68
  69 -- | Check the value of c0003 for any tetrahedron belonging to the
  70 --   cube centered on (1,1,1) with a grid constructed from the
  71 --   trilinear values. See example one in the paper.
  72 test_trilinear_c0003 :: Test
  73 test_trilinear_c0003 =
  74     TestCase $ assertAlmostEqual "c0003 is correct" (c t 0 0 0 3) (27/8)
  75       where
  76         g = make_grid 1 trilinear
  77         cube = cube_at g 1 1 1
  78         t = head (tetrahedrons cube) -- Any one will do.
  79
  80
  81 -- | Check the value of c0021 for any tetrahedron belonging to the
  82 --   cube centered on (1,1,1) with a grid constructed from the
  83 --   trilinear values. See example one in the paper.
  84 test_trilinear_c0021 :: Test
  85 test_trilinear_c0021 =
  86     TestCase $ assertAlmostEqual "c0021 is correct" (c t 0 0 2 1) (61/24)
  87       where
  88         g = make_grid 1 trilinear
  89         cube = cube_at g 1 1 1
  90         t = head (tetrahedrons cube) -- Any one will do.
  91
  92
  93 -- | Check the value of c0012 for any tetrahedron belonging to the
  94 --   cube centered on (1,1,1) with a grid constructed from the
  95 --   trilinear values. See example one in the paper.
  96 test_trilinear_c0012 :: Test
  97 test_trilinear_c0012 =
  98     TestCase $ assertAlmostEqual "c0012 is correct" (c t 0 0 1 2) (71/24)
  99       where
 100         g = make_grid 1 trilinear
 101         cube = cube_at g 1 1 1
 102         t = head (tetrahedrons cube) -- Any one will do.
 103
 104
 105 -- | Check the value of c0120 for any tetrahedron belonging to the
 106 --   cube centered on (1,1,1) with a grid constructed from the
 107 --   trilinear values. See example one in the paper.
 108 test_trilinear_c0120 :: Test
 109 test_trilinear_c0120 =
 110     TestCase $ assertAlmostEqual "c0120 is correct" (c t 0 1 2 0) (55/24)
 111       where
 112         g = make_grid 1 trilinear
 113         cube = cube_at g 1 1 1
 114         t = head (tetrahedrons cube) -- Any one will do.
 115
 116
 117 -- | Check the value of c0102 for any tetrahedron belonging to the
 118 --   cube centered on (1,1,1) with a grid constructed from the
 119 --   trilinear values. See example one in the paper.
 120 test_trilinear_c0102 :: Test
 121 test_trilinear_c0102 =
 122     TestCase $ assertAlmostEqual "c0102 is correct" (c t 0 1 0 2) (73/24)
 123       where
 124         g = make_grid 1 trilinear
 125         cube = cube_at g 1 1 1
 126         t = head (tetrahedrons cube) -- Any one will do.
 127
 128
 129 -- | Check the value of c0111 for any tetrahedron belonging to the
 130 --   cube centered on (1,1,1) with a grid constructed from the
 131 --   trilinear values. See example one in the paper.
 132 test_trilinear_c0111 :: Test
 133 test_trilinear_c0111 =
 134     TestCase $ assertAlmostEqual "c0111 is correct" (c t 0 1 1 1) (8/3)
 135       where
 136         g = make_grid 1 trilinear
 137         cube = cube_at g 1 1 1
 138         t = head (tetrahedrons cube) -- Any one will do.
 139
 140
 141 -- | Check the value of c0210 for any tetrahedron belonging to the
 142 --   cube centered on (1,1,1) with a grid constructed from the
 143 --   trilinear values. See example one in the paper.
 144 test_trilinear_c0210 :: Test
 145 test_trilinear_c0210 =
 146     TestCase $ assertAlmostEqual "c0210 is correct" (c t 0 2 1 0) (29/12)
 147       where
 148         g = make_grid 1 trilinear
 149         cube = cube_at g 1 1 1
 150         t = head (tetrahedrons cube) -- Any one will do.
 151
 152
 153 -- | Check the value of c0201 for any tetrahedron belonging to the
 154 --   cube centered on (1,1,1) with a grid constructed from the
 155 --   trilinear values. See example one in the paper.
 156 test_trilinear_c0201 :: Test
 157 test_trilinear_c0201 =
 158     TestCase $ assertAlmostEqual "c0201 is correct" (c t 0 2 0 1) (11/4)
 159       where
 160         g = make_grid 1 trilinear
 161         cube = cube_at g 1 1 1
 162         t = head (tetrahedrons cube) -- Any one will do.
 163
 164
 165 -- | Check the value of c0300 for any tetrahedron belonging to the
 166 --   cube centered on (1,1,1) with a grid constructed from the
 167 --   trilinear values. See example one in the paper.
 168 test_trilinear_c0300 :: Test
 169 test_trilinear_c0300 =
 170     TestCase $ assertAlmostEqual "c0300 is correct" (c t 0 3 0 0) (5/2)
 171       where
 172         g = make_grid 1 trilinear
 173         cube = cube_at g 1 1 1
 174         t = head (tetrahedrons cube) -- Any one will do.
 175
 176
 177 -- | Check the value of c1020 for any tetrahedron belonging to the
 178 --   cube centered on (1,1,1) with a grid constructed from the
 179 --   trilinear values. See example one in the paper.
 180 test_trilinear_c1020 :: Test
 181 test_trilinear_c1020 =
 182     TestCase $ assertAlmostEqual "c1020 is correct" (c t 1 0 2 0) (8/3)
 183       where
 184         g = make_grid 1 trilinear
 185         cube = cube_at g 1 1 1
 186         t = head (tetrahedrons cube) -- Any one will do.
 187
 188
 189 -- | Check the value of c1002 for any tetrahedron belonging to the
 190 --   cube centered on (1,1,1) with a grid constructed from the
 191 --   trilinear values. See example one in the paper.
 192 test_trilinear_c1002 :: Test
 193 test_trilinear_c1002 =
 194     TestCase $ assertAlmostEqual "c1002 is correct" (c t 1 0 0 2) (23/6)
 195       where
 196         g = make_grid 1 trilinear
 197         cube = cube_at g 1 1 1
 198         t = head (tetrahedrons cube) -- Any one will do.
 199
 200
 201 -- | Check the value of c1011 for any tetrahedron belonging to the
 202 --   cube centered on (1,1,1) with a grid constructed from the
 203 --   trilinear values. See example one in the paper.
 204 test_trilinear_c1011 :: Test
 205 test_trilinear_c1011 =
 206     TestCase $ assertAlmostEqual "c1011 is correct" (c t 1 0 1 1) (13/4)
 207       where
 208         g = make_grid 1 trilinear
 209         cube = cube_at g 1 1 1
 210         t = head (tetrahedrons cube) -- Any one will do.
 211
 212
 213 -- | Check the value of c1110 for any tetrahedron belonging to the
 214 --   cube centered on (1,1,1) with a grid constructed from the
 215 --   trilinear values. See example one in the paper.
 216 test_trilinear_c1110 :: Test
 217 test_trilinear_c1110 =
 218     TestCase $ assertAlmostEqual "c1110 is correct" (c t 1 1 1 0) (23/8)
 219       where
 220         g = make_grid 1 trilinear
 221         cube = cube_at g 1 1 1
 222         t = head (tetrahedrons cube) -- Any one will do.
 223
 224
 225 -- | Check the value of c1101 for any tetrahedron belonging to the
 226 --   cube centered on (1,1,1) with a grid constructed from the
 227 --   trilinear values. See example one in the paper.
 228 test_trilinear_c1101 :: Test
 229 test_trilinear_c1101 =
 230     TestCase $ assertAlmostEqual "c1101 is correct" (c t 1 1 0 1) (27/8)
 231       where
 232         g = make_grid 1 trilinear
 233         cube = cube_at g 1 1 1
 234         t = head (tetrahedrons cube) -- Any one will do.
 235
 236
 237 -- | Check the value of c1200 for any tetrahedron belonging to the
 238 --   cube centered on (1,1,1) with a grid constructed from the
 239 --   trilinear values. See example one in the paper.
 240 test_trilinear_c1200 :: Test
 241 test_trilinear_c1200 =
 242     TestCase $ assertAlmostEqual "c1200 is correct" (c t 1 2 0 0) 3
 243       where
 244         g = make_grid 1 trilinear
 245         cube = cube_at g 1 1 1
 246         t = head (tetrahedrons cube) -- Any one will do.
 247
 248
 249 -- | Check the value of c2010 for any tetrahedron belonging to the
 250 --   cube centered on (1,1,1) with a grid constructed from the
 251 --   trilinear values. See example one in the paper.
 252 test_trilinear_c2010 :: Test
 253 test_trilinear_c2010 =
 254     TestCase $ assertAlmostEqual "c2010 is correct" (c t 2 0 1 0) (10/3)
 255       where
 256         g = make_grid 1 trilinear
 257         cube = cube_at g 1 1 1
 258         t = head (tetrahedrons cube) -- Any one will do.
 259
 260
 261 -- | Check the value of c2001 for any tetrahedron belonging to the
 262 --   cube centered on (1,1,1) with a grid constructed from the
 263 --   trilinear values. See example one in the paper.
 264 test_trilinear_c2001 :: Test
 265 test_trilinear_c2001 =
 266     TestCase $ assertAlmostEqual "c2001 is correct" (c t 2 0 0 1) 4
 267       where
 268         g = make_grid 1 trilinear
 269         cube = cube_at g 1 1 1
 270         t = head (tetrahedrons cube) -- Any one will do.
 271
 272
 273 -- | Check the value of c2100 for any tetrahedron belonging to the
 274 --   cube centered on (1,1,1) with a grid constructed from the
 275 --   trilinear values. See example one in the paper.
 276 test_trilinear_c2100 :: Test
 277 test_trilinear_c2100 =
 278     TestCase $ assertAlmostEqual "c2100 is correct" (c t 2 1 0 0) (7/2)
 279       where
 280         g = make_grid 1 trilinear
 281         cube = cube_at g 1 1 1
 282         t = head (tetrahedrons cube) -- Any one will do.
 283
 284
 285 -- | Check the value of c3000 for any tetrahedron belonging to the
 286 --   cube centered on (1,1,1) with a grid constructed from the
 287 --   trilinear values. See example one in the paper.
 288 test_trilinear_c3000 :: Test
 289 test_trilinear_c3000 =
 290     TestCase $ assertAlmostEqual "c3000 is correct" (c t 3 0 0 0) 4
 291       where
 292         g = make_grid 1 trilinear
 293         cube = cube_at g 1 1 1
 294         t = head (tetrahedrons cube) -- Any one will do.
 295
 296
 297
 298 test_trilinear_f0_t0_v0 :: Test
 299 test_trilinear_f0_t0_v0 =
 300     TestCase $ assertClose "v0 is correct" (v0 t) (0.5, 1.5, 1.5)
 301       where
 302         g = make_grid 1 trilinear
 303         cube = cube_at g 1 1 1
 304         t = tetrahedron0 (face0 cube) -- Any one will do.
 305
 306
 307 test_trilinear_f0_t0_v1 :: Test
 308 test_trilinear_f0_t0_v1 =
 309     TestCase $ assertClose "v1 is correct" (v1 t) (1.5, 1.5, 1.5)
 310       where
 311         g = make_grid 1 trilinear
 312         cube = cube_at g 1 1 1
 313         t = tetrahedron0 (face0 cube) -- Any one will do.
 314
 315
 316 test_trilinear_f0_t0_v2 :: Test
 317 test_trilinear_f0_t0_v2 =
 318     TestCase $ assertClose "v2 is correct" (v2 t) (1, 1, 1.5)
 319       where
 320         g = make_grid 1 trilinear
 321         cube = cube_at g 1 1 1
 322         t = tetrahedron0 (face0 cube) -- Any one will do.
 323
 324
 325
 326 test_trilinear_f0_t0_v3 :: Test
 327 test_trilinear_f0_t0_v3 =
 328     TestCase $ assertClose "v3 is correct" (v3 t) (1, 1, 1)
 329       where
 330         g = make_grid 1 trilinear
 331         cube = cube_at g 1 1 1
 332         t = tetrahedron0 (face0 cube) -- Any one will do.
 333
 334
 335
 336 face_tests :: [Test]
 337 face_tests = [test_trilinear_c0030,
 338               test_trilinear_c0003,
 339               test_trilinear_c0021,
 340               test_trilinear_c0012,
 341               test_trilinear_c0120,
 342               test_trilinear_c0102,
 343               test_trilinear_c0111,
 344               test_trilinear_c0210,
 345               test_trilinear_c0201,
 346               test_trilinear_c0300,
 347               test_trilinear_c1020,
 348               test_trilinear_c1002,
 349               test_trilinear_c1011,
 350               test_trilinear_c1110,
 351               test_trilinear_c1101,
 352               test_trilinear_c1200,
 353               test_trilinear_c2010,
 354               test_trilinear_c2001,
 355               test_trilinear_c2100,
 356               test_trilinear_c3000,
 357               test_trilinear_f0_t0_v0,
 358               test_trilinear_f0_t0_v1,
 359               test_trilinear_f0_t0_v2,
 360               test_trilinear_f0_t0_v3]
 361
 362
 363 -- QuickCheck Tests.
 364
 365 -- | Since the grid size is necessarily positive, all tetrahedrons
 366 --   (which comprise cubes of positive volume) must have positive volume
 367 --   as well.
 368 prop_all_volumes_positive :: Cube -> Property
 369 prop_all_volumes_positive c =
 370     (delta > 0) ==> (null nonpositive_volumes)
 371     where
 372       delta = h (grid c)
 373       ts = tetrahedrons c
 374       volumes = map volume ts
 375       nonpositive_volumes = filter (<= 0) volumes
 376
 377
 378 -- | Given in Sorokina and Zeilfelder, p. 78.
 379 prop_cijk1_identity :: Cube -> Bool
 380 prop_cijk1_identity cube =
 381      and [ c t0' i j k 1 ~= (c t1' (i+1) j k 0) * ((b0 t0') (v3 t1')) +
 382                             (c t1' i (j+1) k 0) * ((b1 t0') (v3 t1')) +
 383                             (c t1' i j (k+1) 0) * ((b2 t0') (v3 t1')) +
 384                             (c t1' i j k 1) * ((b3 t0') (v3 t1')) | i <- [0..2],
 385                                                                     j <- [0..2],
 386                                                                     k <- [0..2],
 387                                                                     i + j + k == 2]
 388       where
 389         t0 = tetrahedron0 (face0 cube)
 390         t1 = tetrahedron1 (face0 cube)
 391         t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
 392         t1' = Tetrahedron cube (v3 t1) (v2 t1) (v0 t1) (v1 t1)
 393
 394 -- | Given in Sorokina and Zeilfelder, p. 79.
 395 prop_c0120_identity1 :: Cube -> Bool
 396 prop_c0120_identity1 cube =
 397     c t0' 0 1 2 0 ~= (c t0' 0 0 2 1 + c t1' 0 0 2 1) / 2
 398       where
 399         t0 = tetrahedron0 (face0 cube)
 400         t1 = tetrahedron1 (face0 cube)
 401         t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
 402         t1' = Tetrahedron cube (v3 t1) (v2 t1) (v0 t1) (v1 t1)
 403
 404
 405 -- | Given in Sorokina and Zeilfelder, p. 79.
 406 prop_c0210_identity1 :: Cube -> Bool
 407 prop_c0210_identity1 cube =
 408     c t0' 0 2 1 0 ~= (c t0' 0 1 1 1 + c t1' 0 1 1 1) / 2
 409       where
 410         t0 = tetrahedron0 (face0 cube)
 411         t1 = tetrahedron1 (face0 cube)
 412         t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
 413         t1' = Tetrahedron cube (v3 t1) (v2 t1) (v0 t1) (v1 t1)
 414
 415
 416 -- | Given in Sorokina and Zeilfelder, p. 79.
 417 prop_c0300_identity1 :: Cube -> Bool
 418 prop_c0300_identity1 cube =
 419     c t0' 0 3 0 0 ~= (c t0' 0 2 0 1 + c t1' 0 2 0 1) / 2
 420       where
 421         t0 = tetrahedron0 (face0 cube)
 422         t1 = tetrahedron1 (face0 cube)
 423         t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
 424         t1' = Tetrahedron cube (v3 t1) (v2 t1) (v0 t1) (v1 t1)
 425
 426 -- | Given in Sorokina and Zeilfelder, p. 79.
 427 prop_c1110_identity :: Cube -> Bool
 428 prop_c1110_identity cube =
 429     c t0' 1 1 1 0 ~= (c t0' 1 0 1 1 + c t1' 1 0 1 1) / 2
 430       where
 431         t0 = tetrahedron0 (face0 cube)
 432         t1 = tetrahedron1 (face0 cube)
 433         t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
 434         t1' = Tetrahedron cube (v3 t1) (v2 t1) (v0 t1) (v1 t1)
 435
 436
 437 -- | Given in Sorokina and Zeilfelder, p. 79.
 438 prop_c1200_identity1 :: Cube -> Bool
 439 prop_c1200_identity1 cube =
 440     c t0' 1 2 0 0 ~= (c t0' 1 1 0 1 + c t1' 1 1 0 1) / 2
 441       where
 442         t0 = tetrahedron0 (face0 cube)
 443         t1 = tetrahedron1 (face0 cube)
 444         t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
 445         t1' = Tetrahedron cube (v3 t1) (v2 t1) (v0 t1) (v1 t1)
 446
 447
 448 -- | Given in Sorokina and Zeilfelder, p. 79.
 449 prop_c2100_identity1 :: Cube -> Bool
 450 prop_c2100_identity1 cube =
 451     c t0' 2 1 0 0 ~= (c t0' 2 0 0 1 + c t1' 2 0 0 1) / 2
 452       where
 453         t0 = tetrahedron0 (face0 cube)
 454         t1 = tetrahedron1 (face0 cube)
 455         t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
 456         t1' = Tetrahedron cube (v3 t1) (v2 t1) (v0 t1) (v1 t1)
 457
 458
 459 -- | Given in Sorokina and Zeilfelder, p. 79.
 460 prop_c0102_identity1 :: Cube -> Bool
 461 prop_c0102_identity1 cube =
 462     c t0' 0 1 0 2 ~= (c t0' 0 0 1 2 + c t3' 0 0 1 2) / 2
 463       where
 464         t0 = tetrahedron0 (face0 cube)
 465         t3 = tetrahedron3 (face0 cube)
 466         t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
 467         t3' = Tetrahedron cube (v3 t3) (v2 t3) (v1 t3) (v0 t3)
 468
 469
 470 -- | Given in Sorokina and Zeilfelder, p. 79.
 471 prop_c0201_identity1 :: Cube -> Bool
 472 prop_c0201_identity1 cube =
 473     c t0' 0 2 0 1 ~= (c t0' 0 1 1 1 + c t3' 0 1 1 1) / 2
 474       where
 475         t0 = tetrahedron0 (face0 cube)
 476         t3 = tetrahedron3 (face0 cube)
 477         t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
 478         t3' = Tetrahedron cube (v3 t3) (v2 t3) (v1 t3) (v0 t3)
 479
 480
 481 -- | Given in Sorokina and Zeilfelder, p. 79.
 482 prop_c0300_identity2 :: Cube -> Bool
 483 prop_c0300_identity2 cube =
 484     c t0' 3 0 0 0 ~= (c t0' 0 2 1 0 + c t3' 0 2 1 0) / 2
 485       where
 486         t0 = tetrahedron0 (face0 cube)
 487         t3 = tetrahedron3 (face0 cube)
 488         t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
 489         t3' = Tetrahedron cube (v3 t3) (v2 t3) (v1 t3) (v0 t3)
 490
 491 -- | Given in Sorokina and Zeilfelder, p. 79.
 492 prop_c1101_identity :: Cube -> Bool
 493 prop_c1101_identity cube =
 494     c t0' 1 1 0 1 ~= (c t0' 1 1 0 1 + c t3' 1 1 0 1) / 2
 495       where
 496         t0 = tetrahedron0 (face0 cube)
 497         t3 = tetrahedron3 (face0 cube)
 498         t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
 499         t3' = Tetrahedron cube (v3 t3) (v2 t3) (v1 t3) (v0 t3)
 500
 501
 502 -- | Given in Sorokina and Zeilfelder, p. 79.
 503 prop_c1200_identity2 :: Cube -> Bool
 504 prop_c1200_identity2 cube =
 505     c t0' 1 1 1 0 ~= (c t0' 1 1 1 0 + c t3' 1 1 1 0) / 2
 506       where
 507         t0 = tetrahedron0 (face0 cube)
 508         t3 = tetrahedron3 (face0 cube)
 509         t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
 510         t3' = Tetrahedron cube (v3 t3) (v2 t3) (v1 t3) (v0 t3)
 511
 512
 513 -- | Given in Sorokina and Zeilfelder, p. 79.
 514 prop_c2100_identity2 :: Cube -> Bool
 515 prop_c2100_identity2 cube =
 516     c t0' 2 1 0 0 ~= (c t0' 2 0 1 0 + c t3' 2 0 1 0) / 2
 517       where
 518         t0 = tetrahedron0 (face0 cube)
 519         t3 = tetrahedron3 (face0 cube)
 520         t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
 521         t3' = Tetrahedron cube (v3 t3) (v2 t3) (v1 t3) (v0 t3)
 522
 523
 524 -- | Given in Sorokina and Zeilfelder, p. 79.
 525 prop_c3000_identity :: Cube -> Bool
 526 prop_c3000_identity cube =
 527     c t0' 3 0 0 0 ~= c t0' 2 1 0 0 + c t2' 2 1 0 0 - ((c t0' 2 0 1 0 + c t0' 2 0 0 1)/ 2)
 528       where
 529         t0 = tetrahedron0 (face0 cube)
 530         t2 = tetrahedron2 (face5 cube)
 531         t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
 532         t2' = Tetrahedron cube (v3 t2) (v2 t2) (v1 t2) (v0 t2)
 533
 534
 535 -- | Given in Sorokina and Zeilfelder, p. 79.
 536 prop_c2010_identity :: Cube -> Bool
 537 prop_c2010_identity cube =
 538     c t0' 2 0 1 0 ~= c t0' 1 1 1 0 + c t2' 1 1 1 0 - ((c t0' 1 0 2 0 + c t0' 1 0 1 1)/ 2)
 539       where
 540         t0 = tetrahedron0 (face0 cube)
 541         t2 = tetrahedron2 (face5 cube)
 542         t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
 543         t2' = Tetrahedron cube (v3 t2) (v2 t2) (v1 t2) (v0 t2)
 544
 545
 546 -- | Given in Sorokina and Zeilfelder, p. 79.
 547 prop_c2001_identity :: Cube -> Bool
 548 prop_c2001_identity cube =
 549     c t0' 2 0 0 1 ~= c t0' 1 1 0 1 + c t2' 1 1 0 1 - ((c t0' 1 0 0 2 + c t0' 1 0 1 1)/ 2)
 550       where
 551         t0 = tetrahedron0 (face0 cube)
 552         t2 = tetrahedron2 (face5 cube)
 553         t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
 554         t2' = Tetrahedron cube (v3 t2) (v2 t2) (v1 t2) (v0 t2)
 555
 556 -- | Given in Sorokina and Zeilfelder, p. 79.
 557 prop_c1020_identity :: Cube -> Bool
 558 prop_c1020_identity cube =
 559     c t0' 1 0 2 0 ~= c t0' 0 1 2 0 + c t2' 0 1 2 0 - ((c t0' 0 0 3 0 + c t0' 0 0 2 1)/ 2)
 560       where
 561         t0 = tetrahedron0 (face0 cube)
 562         t2 = tetrahedron2 (face5 cube)
 563         t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
 564         t2' = Tetrahedron cube (v3 t2) (v2 t2) (v1 t2) (v0 t2)
 565
 566
 567 -- | Given in Sorokina and Zeilfelder, p. 79.
 568 prop_c1002_identity :: Cube -> Bool
 569 prop_c1002_identity cube =
 570     c t0' 1 0 0 2 ~= c t0' 0 1 0 2 + c t2' 0 1 0 2 - ((c t0' 0 0 0 3 + c t0' 0 0 1 2)/ 2)
 571       where
 572         t0 = tetrahedron0 (face0 cube)
 573         t2 = tetrahedron2 (face5 cube)
 574         t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
 575         t2' = Tetrahedron cube (v3 t2) (v2 t2) (v1 t2) (v0 t2)
 576
 577
 578 -- | Given in Sorokina and Zeilfelder, p. 79.
 579 prop_c1011_identity :: Cube -> Bool
 580 prop_c1011_identity cube =
 581     c t0' 1 0 1 1 ~= c t0' 0 1 1 1 + c t2' 0 1 1 1 - ((c t0' 0 0 1 2 + c t0' 0 0 2 1)/ 2)
 582       where
 583         t0 = tetrahedron0 (face0 cube)
 584         t2 = tetrahedron2 (face5 cube)
 585         t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
 586         t2' = Tetrahedron cube (v3 t2) (v2 t2) (v1 t2) (v0 t2)
 587
 588
 589 -- | Given in Sorokina and Zeilfelder, p. 80.
 590 prop_c0120_identity2 :: Cube -> Bool
 591 prop_c0120_identity2 cube =
 592         c t0' 0 1 2 0 ~= (c t0' 1 0 2 0 + c t1' 1 0 2 0) / 2
 593       where
 594         t0 = tetrahedron0 (face0 cube)
 595         t1 = tetrahedron0 (face2 (top cube))
 596         t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
 597         t1' = Tetrahedron cube (v3 t1) (v2 t1) (v0 t1) (v1 t1)
 598
 599
 600 -- | Given in Sorokina and Zeilfelder, p. 80.
 601 prop_c0102_identity2 :: Cube -> Bool
 602 prop_c0102_identity2 cube =
 603     c t0' 0 1 0 2 ~= (c t0' 1 0 0 2 + c t1' 1 0 0 2) / 2
 604       where
 605         t0 = tetrahedron0 (face0 cube)
 606         t1 = tetrahedron0 (face2 (top cube))
 607         t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
 608         t1' = Tetrahedron cube (v3 t1) (v2 t1) (v0 t1) (v1 t1)
 609
 610
 611 -- | Given in Sorokina and Zeilfelder, p. 80.
 612 prop_c0111_identity :: Cube -> Bool
 613 prop_c0111_identity cube =
 614     c t0' 0 1 1 1 ~= (c t0' 1 0 1 1 + c t1' 1 0 1 1) / 2
 615       where
 616         t0 = tetrahedron0 (face0 cube)
 617         t1 = tetrahedron0 (face2 (top cube))
 618         t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
 619         t1' = Tetrahedron cube (v3 t1) (v2 t1) (v0 t1) (v1 t1)
 620
 621
 622 -- | Given in Sorokina and Zeilfelder, p. 80.
 623 prop_c0210_identity2 :: Cube -> Bool
 624 prop_c0210_identity2 cube =
 625     c t0 0 2 1 0 ~= (c t0 1 1 1 0 + c t1 1 1 1 0) / 2
 626       where
 627         t0 = tetrahedron0 (face0 cube)
 628         t1 = tetrahedron0 (face2 (top cube))
 629         t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
 630         t1' = Tetrahedron cube (v3 t1) (v2 t1) (v0 t1) (v1 t1)
 631
 632
 633 -- | Given in Sorokina and Zeilfelder, p. 80.
 634 prop_c0201_identity2 :: Cube -> Bool
 635 prop_c0201_identity2 cube =
 636     c t0 0 2 0 1 ~= (c t0 1 1 0 1 + c t1 1 1 0 1) / 2
 637       where
 638         t0 = tetrahedron0 (face0 cube)
 639         t1 = tetrahedron0 (face2 (top cube))
 640         t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
 641         t1' = Tetrahedron cube (v3 t1) (v2 t1) (v0 t1) (v1 t1)
 642
 643
 644 -- | Given in Sorokina and Zeilfelder, p. 80.
 645 prop_c0300_identity3 :: Cube -> Bool
 646 prop_c0300_identity3 cube =
 647     c t0 0 3 0 0 ~= (c t0 1 2 0 0 + c t1 1 2 0 0) / 2
 648       where
 649         t0 = tetrahedron0 (face0 cube)
 650         t1 = tetrahedron0 (face2 (top cube))
 651         t0' = Tetrahedron cube (v3 t0) (v2 t0) (v1 t0) (v0 t0)
 652         t1' = Tetrahedron cube (v3 t1) (v2 t1) (v0 t1) (v1 t1)