src/Tests/Cube.hs

   1 module Tests.Cube
   2 where
   3
   4 import Prelude hiding (LT)
   5 import Test.QuickCheck
   6
   7 import Cardinal
   8 import Comparisons
   9 import Cube hiding (i, j, k)
  10 import FunctionValues
  11 import Misc (all_equal)
  12 import Tests.FunctionValues ()
  13 import Tetrahedron (b0, b1, b2, b3, c, fv,
  14                     v0, v1, v2, v3, volume)
  15
  16 instance Arbitrary Cube where
  17     arbitrary = do
  18       (Positive h') <- arbitrary :: Gen (Positive Double)
  19       i' <- choose (coordmin, coordmax)
  20       j' <- choose (coordmin, coordmax)
  21       k' <- choose (coordmin, coordmax)
  22       fv' <- arbitrary :: Gen FunctionValues
  23       return (Cube h' i' j' k' fv')
  24         where
  25           coordmin = -268435456 -- -(2^29 / 2)
  26           coordmax = 268435456  -- +(2^29 / 2)
  27
  28
  29 -- Quickcheck tests.
  30
  31 -- | Since the grid size is necessarily positive, all tetrahedrons
  32 --   (which comprise cubes of positive volume) must have positive volume
  33 --   as well.
  34 prop_all_volumes_positive :: Cube -> Bool
  35 prop_all_volumes_positive cube =
  36     null nonpositive_volumes
  37     where
  38       ts = tetrahedrons cube
  39       volumes = map volume ts
  40       nonpositive_volumes = filter (<= 0) volumes
  41
  42 -- | In fact, since all of the tetrahedra are identical, we should
  43 --   already know their volumes. There's 24 tetrahedra to a cube, so
  44 --   we'd expect the volume of each one to be (1/24)*h^3.
  45 prop_tetrahedron0_volumes_exact :: Cube -> Bool
  46 prop_tetrahedron0_volumes_exact cube =
  47     volume (tetrahedron0 cube) ~~= (1/24)*(delta^(3::Int))
  48     where
  49       delta = h cube
  50
  51
  52 -- | In fact, since all of the tetrahedra are identical, we should
  53 --   already know their volumes. There's 24 tetrahedra to a cube, so
  54 --   we'd expect the volume of each one to be (1/24)*h^3.
  55 prop_tetrahedron1_volumes_exact :: Cube -> Bool
  56 prop_tetrahedron1_volumes_exact cube =
  57     volume (tetrahedron1 cube) ~~= (1/24)*(delta^(3::Int))
  58     where
  59       delta = h cube
  60
  61 -- | In fact, since all of the tetrahedra are identical, we should
  62 --   already know their volumes. There's 24 tetrahedra to a cube, so
  63 --   we'd expect the volume of each one to be (1/24)*h^3.
  64 prop_tetrahedron2_volumes_exact :: Cube -> Bool
  65 prop_tetrahedron2_volumes_exact cube =
  66     volume (tetrahedron2 cube) ~~= (1/24)*(delta^(3::Int))
  67     where
  68       delta = h cube
  69
  70 -- | In fact, since all of the tetrahedra are identical, we should
  71 --   already know their volumes. There's 24 tetrahedra to a cube, so
  72 --   we'd expect the volume of each one to be (1/24)*h^3.
  73 prop_tetrahedron3_volumes_exact :: Cube -> Bool
  74 prop_tetrahedron3_volumes_exact cube =
  75     volume (tetrahedron3 cube) ~~= (1/24)*(delta^(3::Int))
  76     where
  77       delta = h cube
  78
  79 -- | In fact, since all of the tetrahedra are identical, we should
  80 --   already know their volumes. There's 24 tetrahedra to a cube, so
  81 --   we'd expect the volume of each one to be (1/24)*h^3.
  82 prop_tetrahedron4_volumes_exact :: Cube -> Bool
  83 prop_tetrahedron4_volumes_exact cube =
  84     volume (tetrahedron4 cube) ~~= (1/24)*(delta^(3::Int))
  85     where
  86       delta = h cube
  87
  88 -- | In fact, since all of the tetrahedra are identical, we should
  89 --   already know their volumes. There's 24 tetrahedra to a cube, so
  90 --   we'd expect the volume of each one to be (1/24)*h^3.
  91 prop_tetrahedron5_volumes_exact :: Cube -> Bool
  92 prop_tetrahedron5_volumes_exact cube =
  93     volume (tetrahedron5 cube) ~~= (1/24)*(delta^(3::Int))
  94     where
  95       delta = h cube
  96
  97 -- | In fact, since all of the tetrahedra are identical, we should
  98 --   already know their volumes. There's 24 tetrahedra to a cube, so
  99 --   we'd expect the volume of each one to be (1/24)*h^3.
 100 prop_tetrahedron6_volumes_exact :: Cube -> Bool
 101 prop_tetrahedron6_volumes_exact cube =
 102     volume (tetrahedron6 cube) ~~= (1/24)*(delta^(3::Int))
 103     where
 104       delta = h cube
 105
 106 -- | In fact, since all of the tetrahedra are identical, we should
 107 --   already know their volumes. There's 24 tetrahedra to a cube, so
 108 --   we'd expect the volume of each one to be (1/24)*h^3.
 109 prop_tetrahedron7_volumes_exact :: Cube -> Bool
 110 prop_tetrahedron7_volumes_exact cube =
 111     volume (tetrahedron7 cube) ~~= (1/24)*(delta^(3::Int))
 112     where
 113       delta = h cube
 114
 115 -- | In fact, since all of the tetrahedra are identical, we should
 116 --   already know their volumes. There's 24 tetrahedra to a cube, so
 117 --   we'd expect the volume of each one to be (1/24)*h^3.
 118 prop_tetrahedron8_volumes_exact :: Cube -> Bool
 119 prop_tetrahedron8_volumes_exact cube =
 120     volume (tetrahedron8 cube) ~~= (1/24)*(delta^(3::Int))
 121     where
 122       delta = h cube
 123
 124 -- | In fact, since all of the tetrahedra are identical, we should
 125 --   already know their volumes. There's 24 tetrahedra to a cube, so
 126 --   we'd expect the volume of each one to be (1/24)*h^3.
 127 prop_tetrahedron9_volumes_exact :: Cube -> Bool
 128 prop_tetrahedron9_volumes_exact cube =
 129     volume (tetrahedron9 cube) ~~= (1/24)*(delta^(3::Int))
 130     where
 131       delta = h cube
 132
 133 -- | In fact, since all of the tetrahedra are identical, we should
 134 --   already know their volumes. There's 24 tetrahedra to a cube, so
 135 --   we'd expect the volume of each one to be (1/24)*h^3.
 136 prop_tetrahedron10_volumes_exact :: Cube -> Bool
 137 prop_tetrahedron10_volumes_exact cube =
 138     volume (tetrahedron10 cube) ~~= (1/24)*(delta^(3::Int))
 139     where
 140       delta = h cube
 141
 142 -- | In fact, since all of the tetrahedra are identical, we should
 143 --   already know their volumes. There's 24 tetrahedra to a cube, so
 144 --   we'd expect the volume of each one to be (1/24)*h^3.
 145 prop_tetrahedron11_volumes_exact :: Cube -> Bool
 146 prop_tetrahedron11_volumes_exact cube =
 147     volume (tetrahedron11 cube) ~~= (1/24)*(delta^(3::Int))
 148     where
 149       delta = h cube
 150
 151 -- | In fact, since all of the tetrahedra are identical, we should
 152 --   already know their volumes. There's 24 tetrahedra to a cube, so
 153 --   we'd expect the volume of each one to be (1/24)*h^3.
 154 prop_tetrahedron12_volumes_exact :: Cube -> Bool
 155 prop_tetrahedron12_volumes_exact cube =
 156     volume (tetrahedron12 cube) ~~= (1/24)*(delta^(3::Int))
 157     where
 158       delta = h cube
 159
 160 -- | In fact, since all of the tetrahedra are identical, we should
 161 --   already know their volumes. There's 24 tetrahedra to a cube, so
 162 --   we'd expect the volume of each one to be (1/24)*h^3.
 163 prop_tetrahedron13_volumes_exact :: Cube -> Bool
 164 prop_tetrahedron13_volumes_exact cube =
 165     volume (tetrahedron13 cube) ~~= (1/24)*(delta^(3::Int))
 166     where
 167       delta = h cube
 168
 169 -- | In fact, since all of the tetrahedra are identical, we should
 170 --   already know their volumes. There's 24 tetrahedra to a cube, so
 171 --   we'd expect the volume of each one to be (1/24)*h^3.
 172 prop_tetrahedron14_volumes_exact :: Cube -> Bool
 173 prop_tetrahedron14_volumes_exact cube =
 174     volume (tetrahedron14 cube) ~~= (1/24)*(delta^(3::Int))
 175     where
 176       delta = h cube
 177
 178 -- | In fact, since all of the tetrahedra are identical, we should
 179 --   already know their volumes. There's 24 tetrahedra to a cube, so
 180 --   we'd expect the volume of each one to be (1/24)*h^3.
 181 prop_tetrahedron15_volumes_exact :: Cube -> Bool
 182 prop_tetrahedron15_volumes_exact cube =
 183     volume (tetrahedron15 cube) ~~= (1/24)*(delta^(3::Int))
 184     where
 185       delta = h cube
 186
 187 -- | In fact, since all of the tetrahedra are identical, we should
 188 --   already know their volumes. There's 24 tetrahedra to a cube, so
 189 --   we'd expect the volume of each one to be (1/24)*h^3.
 190 prop_tetrahedron16_volumes_exact :: Cube -> Bool
 191 prop_tetrahedron16_volumes_exact cube =
 192     volume (tetrahedron16 cube) ~~= (1/24)*(delta^(3::Int))
 193     where
 194       delta = h cube
 195
 196 -- | In fact, since all of the tetrahedra are identical, we should
 197 --   already know their volumes. There's 24 tetrahedra to a cube, so
 198 --   we'd expect the volume of each one to be (1/24)*h^3.
 199 prop_tetrahedron17_volumes_exact :: Cube -> Bool
 200 prop_tetrahedron17_volumes_exact cube =
 201     volume (tetrahedron17 cube) ~~= (1/24)*(delta^(3::Int))
 202     where
 203       delta = h cube
 204
 205 -- | In fact, since all of the tetrahedra are identical, we should
 206 --   already know their volumes. There's 24 tetrahedra to a cube, so
 207 --   we'd expect the volume of each one to be (1/24)*h^3.
 208 prop_tetrahedron18_volumes_exact :: Cube -> Bool
 209 prop_tetrahedron18_volumes_exact cube =
 210     volume (tetrahedron18 cube) ~~= (1/24)*(delta^(3::Int))
 211     where
 212       delta = h cube
 213
 214 -- | In fact, since all of the tetrahedra are identical, we should
 215 --   already know their volumes. There's 24 tetrahedra to a cube, so
 216 --   we'd expect the volume of each one to be (1/24)*h^3.
 217 prop_tetrahedron19_volumes_exact :: Cube -> Bool
 218 prop_tetrahedron19_volumes_exact cube =
 219     volume (tetrahedron19 cube) ~~= (1/24)*(delta^(3::Int))
 220     where
 221       delta = h cube
 222
 223 -- | In fact, since all of the tetrahedra are identical, we should
 224 --   already know their volumes. There's 24 tetrahedra to a cube, so
 225 --   we'd expect the volume of each one to be (1/24)*h^3.
 226 prop_tetrahedron20_volumes_exact :: Cube -> Bool
 227 prop_tetrahedron20_volumes_exact cube =
 228     volume (tetrahedron20 cube) ~~= (1/24)*(delta^(3::Int))
 229     where
 230       delta = h cube
 231
 232 -- | In fact, since all of the tetrahedra are identical, we should
 233 --   already know their volumes. There's 24 tetrahedra to a cube, so
 234 --   we'd expect the volume of each one to be (1/24)*h^3.
 235 prop_tetrahedron21_volumes_exact :: Cube -> Bool
 236 prop_tetrahedron21_volumes_exact cube =
 237     volume (tetrahedron21 cube) ~~= (1/24)*(delta^(3::Int))
 238     where
 239       delta = h cube
 240
 241 -- | In fact, since all of the tetrahedra are identical, we should
 242 --   already know their volumes. There's 24 tetrahedra to a cube, so
 243 --   we'd expect the volume of each one to be (1/24)*h^3.
 244 prop_tetrahedron22_volumes_exact :: Cube -> Bool
 245 prop_tetrahedron22_volumes_exact cube =
 246     volume (tetrahedron22 cube) ~~= (1/24)*(delta^(3::Int))
 247     where
 248       delta = h cube
 249
 250 -- | In fact, since all of the tetrahedra are identical, we should
 251 --   already know their volumes. There's 24 tetrahedra to a cube, so
 252 --   we'd expect the volume of each one to be (1/24)*h^3.
 253 prop_tetrahedron23_volumes_exact :: Cube -> Bool
 254 prop_tetrahedron23_volumes_exact cube =
 255     volume (tetrahedron23 cube) ~~= (1/24)*(delta^(3::Int))
 256     where
 257       delta = h cube
 258
 259 -- | All tetrahedron should have their v0 located at the center of the cube.
 260 prop_v0_all_equal :: Cube -> Bool
 261 prop_v0_all_equal cube = (v0 t0) == (v0 t1)
 262     where
 263       t0 = head (tetrahedrons cube) -- Doesn't matter which two we choose.
 264       t1 = head $ tail (tetrahedrons cube)
 265
 266
 267 -- | This pretty much repeats the prop_all_volumes_positive property,
 268 --   but will let me know which tetrahedrons's vertices are disoriented.
 269 prop_tetrahedron0_volumes_positive :: Cube -> Bool
 270 prop_tetrahedron0_volumes_positive cube =
 271     volume (tetrahedron0 cube) > 0
 272
 273 -- | This pretty much repeats the prop_all_volumes_positive property,
 274 --   but will let me know which tetrahedrons's vertices are disoriented.
 275 prop_tetrahedron1_volumes_positive :: Cube -> Bool
 276 prop_tetrahedron1_volumes_positive cube =
 277     volume (tetrahedron1 cube) > 0
 278
 279 -- | This pretty much repeats the prop_all_volumes_positive property,
 280 --   but will let me know which tetrahedrons's vertices are disoriented.
 281 prop_tetrahedron2_volumes_positive :: Cube -> Bool
 282 prop_tetrahedron2_volumes_positive cube =
 283     volume (tetrahedron2 cube) > 0
 284
 285 -- | This pretty much repeats the prop_all_volumes_positive property,
 286 --   but will let me know which tetrahedrons's vertices are disoriented.
 287 prop_tetrahedron3_volumes_positive :: Cube -> Bool
 288 prop_tetrahedron3_volumes_positive cube =
 289     volume (tetrahedron3 cube) > 0
 290
 291 -- | This pretty much repeats the prop_all_volumes_positive property,
 292 --   but will let me know which tetrahedrons's vertices are disoriented.
 293 prop_tetrahedron4_volumes_positive :: Cube -> Bool
 294 prop_tetrahedron4_volumes_positive cube =
 295     volume (tetrahedron4 cube) > 0
 296
 297 -- | This pretty much repeats the prop_all_volumes_positive property,
 298 --   but will let me know which tetrahedrons's vertices are disoriented.
 299 prop_tetrahedron5_volumes_positive :: Cube -> Bool
 300 prop_tetrahedron5_volumes_positive cube =
 301     volume (tetrahedron5 cube) > 0
 302
 303 -- | This pretty much repeats the prop_all_volumes_positive property,
 304 --   but will let me know which tetrahedrons's vertices are disoriented.
 305 prop_tetrahedron6_volumes_positive :: Cube -> Bool
 306 prop_tetrahedron6_volumes_positive cube =
 307     volume (tetrahedron6 cube) > 0
 308
 309 -- | This pretty much repeats the prop_all_volumes_positive property,
 310 --   but will let me know which tetrahedrons's vertices are disoriented.
 311 prop_tetrahedron7_volumes_positive :: Cube -> Bool
 312 prop_tetrahedron7_volumes_positive cube =
 313     volume (tetrahedron7 cube) > 0
 314
 315 -- | This pretty much repeats the prop_all_volumes_positive property,
 316 --   but will let me know which tetrahedrons's vertices are disoriented.
 317 prop_tetrahedron8_volumes_positive :: Cube -> Bool
 318 prop_tetrahedron8_volumes_positive cube =
 319     volume (tetrahedron8 cube) > 0
 320
 321 -- | This pretty much repeats the prop_all_volumes_positive property,
 322 --   but will let me know which tetrahedrons's vertices are disoriented.
 323 prop_tetrahedron9_volumes_positive :: Cube -> Bool
 324 prop_tetrahedron9_volumes_positive cube =
 325     volume (tetrahedron9 cube) > 0
 326
 327 -- | This pretty much repeats the prop_all_volumes_positive property,
 328 --   but will let me know which tetrahedrons's vertices are disoriented.
 329 prop_tetrahedron10_volumes_positive :: Cube -> Bool
 330 prop_tetrahedron10_volumes_positive cube =
 331     volume (tetrahedron10 cube) > 0
 332
 333 -- | This pretty much repeats the prop_all_volumes_positive property,
 334 --   but will let me know which tetrahedrons's vertices are disoriented.
 335 prop_tetrahedron11_volumes_positive :: Cube -> Bool
 336 prop_tetrahedron11_volumes_positive cube =
 337     volume (tetrahedron11 cube) > 0
 338
 339 -- | This pretty much repeats the prop_all_volumes_positive property,
 340 --   but will let me know which tetrahedrons's vertices are disoriented.
 341 prop_tetrahedron12_volumes_positive :: Cube -> Bool
 342 prop_tetrahedron12_volumes_positive cube =
 343     volume (tetrahedron12 cube) > 0
 344
 345 -- | This pretty much repeats the prop_all_volumes_positive property,
 346 --   but will let me know which tetrahedrons's vertices are disoriented.
 347 prop_tetrahedron13_volumes_positive :: Cube -> Bool
 348 prop_tetrahedron13_volumes_positive cube =
 349     volume (tetrahedron13 cube) > 0
 350
 351 -- | This pretty much repeats the prop_all_volumes_positive property,
 352 --   but will let me know which tetrahedrons's vertices are disoriented.
 353 prop_tetrahedron14_volumes_positive :: Cube -> Bool
 354 prop_tetrahedron14_volumes_positive cube =
 355     volume (tetrahedron14 cube) > 0
 356
 357 -- | This pretty much repeats the prop_all_volumes_positive property,
 358 --   but will let me know which tetrahedrons's vertices are disoriented.
 359 prop_tetrahedron15_volumes_positive :: Cube -> Bool
 360 prop_tetrahedron15_volumes_positive cube =
 361     volume (tetrahedron15 cube) > 0
 362
 363 -- | This pretty much repeats the prop_all_volumes_positive property,
 364 --   but will let me know which tetrahedrons's vertices are disoriented.
 365 prop_tetrahedron16_volumes_positive :: Cube -> Bool
 366 prop_tetrahedron16_volumes_positive cube =
 367     volume (tetrahedron16 cube) > 0
 368
 369 -- | This pretty much repeats the prop_all_volumes_positive property,
 370 --   but will let me know which tetrahedrons's vertices are disoriented.
 371 prop_tetrahedron17_volumes_positive :: Cube -> Bool
 372 prop_tetrahedron17_volumes_positive cube =
 373     volume (tetrahedron17 cube) > 0
 374
 375 -- | This pretty much repeats the prop_all_volumes_positive property,
 376 --   but will let me know which tetrahedrons's vertices are disoriented.
 377 prop_tetrahedron18_volumes_positive :: Cube -> Bool
 378 prop_tetrahedron18_volumes_positive cube =
 379     volume (tetrahedron18 cube) > 0
 380
 381 -- | This pretty much repeats the prop_all_volumes_positive property,
 382 --   but will let me know which tetrahedrons's vertices are disoriented.
 383 prop_tetrahedron19_volumes_positive :: Cube -> Bool
 384 prop_tetrahedron19_volumes_positive cube =
 385     volume (tetrahedron19 cube) > 0
 386
 387 -- | This pretty much repeats the prop_all_volumes_positive property,
 388 --   but will let me know which tetrahedrons's vertices are disoriented.
 389 prop_tetrahedron20_volumes_positive :: Cube -> Bool
 390 prop_tetrahedron20_volumes_positive cube =
 391     volume (tetrahedron20 cube) > 0
 392
 393 -- | This pretty much repeats the prop_all_volumes_positive property,
 394 --   but will let me know which tetrahedrons's vertices are disoriented.
 395 prop_tetrahedron21_volumes_positive :: Cube -> Bool
 396 prop_tetrahedron21_volumes_positive cube =
 397     volume (tetrahedron21 cube) > 0
 398
 399 -- | This pretty much repeats the prop_all_volumes_positive property,
 400 --   but will let me know which tetrahedrons's vertices are disoriented.
 401 prop_tetrahedron22_volumes_positive :: Cube -> Bool
 402 prop_tetrahedron22_volumes_positive cube =
 403     volume (tetrahedron22 cube) > 0
 404
 405 -- | This pretty much repeats the prop_all_volumes_positive property,
 406 --   but will let me know which tetrahedrons's vertices are disoriented.
 407 prop_tetrahedron23_volumes_positive :: Cube -> Bool
 408 prop_tetrahedron23_volumes_positive cube =
 409     volume (tetrahedron23 cube) > 0
 410
 411
 412 -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). It appears that
 413 --   the assumptions in sections (2.6) and (2.7) have been
 414 --   switched. From the description, one would expect 'tetrahedron0'
 415 --   and 'tetrahedron3' to share face \<v0,v1,v2\>; however, we have
 416 --   to use 'tetrahedron0' and 'tetahedron1' for all of the tests in
 417 --   section (2.6). Also note that the third and fourth indices of
 418 --   c-t1 have been switched. This is because we store the triangles
 419 --   oriented such that their volume is positive. If T and T-tilde
 420 --   share \<v0,v1,v2\> and v3,v3-tilde point in opposite directions,
 421 --   one of them has to have negative volume!
 422 prop_c0120_identity1 :: Cube -> Bool
 423 prop_c0120_identity1 cube =
 424    c t0 0 1 2 0 ~= (c t0 0 0 2 1 + c t1 0 0 1 2) / 2
 425      where
 426        t0 = tetrahedron0 cube
 427        t1 = tetrahedron1 cube
 428
 429
 430 -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Repeats
 431 --   'prop_c0120_identity1' with tetrahedrons 1 and 2.
 432 prop_c0120_identity2 :: Cube -> Bool
 433 prop_c0120_identity2 cube =
 434    c t1 0 1 2 0 ~= (c t1 0 0 2 1 + c t2 0 0 1 2) / 2
 435      where
 436        t1 = tetrahedron1 cube
 437        t2 = tetrahedron2 cube
 438
 439 -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Repeats
 440 --   'prop_c0120_identity1' with tetrahedrons 2 and 3.
 441 prop_c0120_identity3 :: Cube -> Bool
 442 prop_c0120_identity3 cube =
 443    c t2 0 1 2 0 ~= (c t2 0 0 2 1 + c t3 0 0 1 2) / 2
 444      where
 445        t2 = tetrahedron2 cube
 446        t3 = tetrahedron3 cube
 447
 448
 449 -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Repeats
 450 --   'prop_c0120_identity1' with tetrahedrons 4 and 5.
 451 -- prop_c0120_identity4 :: Cube -> Bool
 452 -- prop_c0120_identity4 cube =
 453 --     sum [trace ("c_t4_0120: " ++ (show tmp1)) tmp1,
 454 --          trace ("c_t5_0012: " ++ (show tmp2)) tmp2,
 455 --          trace ("c_t5_0102: " ++ (show tmp3)) tmp3,
 456 --          trace ("c_t5_1002: " ++ (show tmp4)) tmp4,
 457 --          trace ("c_t5_0120: " ++ (show tmp5)) tmp5,
 458 --          trace ("c_t5_1020: " ++ (show tmp6)) tmp6,
 459 --          trace ("c_t5_1200: " ++ (show tmp7)) tmp7,
 460 --          trace ("c_t5_0021: " ++ (show tmp8)) tmp8,
 461 --          trace ("c_t5_0201: " ++ (show tmp9)) tmp9,
 462 --          trace ("c_t5_2001: " ++ (show tmp10)) tmp10,
 463 --          trace ("c_t5_0210: " ++ (show tmp11)) tmp11,
 464 --          trace ("c_t5_2010: " ++ (show tmp12)) tmp12,
 465 --          trace ("c_t5_2100: " ++ (show tmp13)) tmp13] == 10
 466 -- --   c t4 0 1 2 0 ~= (c t4 0 0 2 1 + c t5 0 0 1 2) / 2
 467 --      where
 468 --        t4 = tetrahedron4 cube
 469 --        t5 = tetrahedron5 cube
 470 --        tmp1 = c t4 0 1 2 0
 471 --        tmp2 = (c t4 0 0 2 1 + c t5 0 0 1 2) / 2
 472 --        tmp3 = (c t4 0 0 2 1 + c t5 0 1 0 2) / 2
 473 --        tmp4 = (c t4 0 0 2 1 + c t5 1 0 0 2) / 2
 474 --        tmp5 = (c t4 0 0 2 1 + c t5 0 1 2 0) / 2
 475 --        tmp6 = (c t4 0 0 2 1 + c t5 1 0 2 0) / 2
 476 --        tmp7 = (c t4 0 0 2 1 + c t5 1 2 0 0) / 2
 477 --        tmp8 = (c t4 0 0 2 1 + c t5 0 0 2 1) / 2
 478 --        tmp9 = (c t4 0 0 2 1 + c t5 0 2 0 1) / 2
 479 --        tmp10 = (c t4 0 0 2 1 + c t5 2 0 0 1) / 2
 480 --        tmp11 = (c t4 0 0 2 1 + c t5 0 2 1 0) / 2
 481 --        tmp12 = (c t4 0 0 2 1 + c t5 2 0 1 0) / 2
 482 --        tmp13 = (c t4 0 0 2 1 + c t5 2 1 0 0) / 2
 483
 484 -- -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Repeats
 485 -- --   'prop_c0120_identity1' with tetrahedrons 5 and 6.
 486 -- prop_c0120_identity5 :: Cube -> Bool
 487 -- prop_c0120_identity5 cube =
 488 --    c t5 0 1 2 0 ~= (c t5 0 0 2 1 + c t6 0 0 1 2) / 2
 489 --      where
 490 --        t5 = tetrahedron5 cube
 491 --        t6 = tetrahedron6 cube
 492
 493
 494 -- -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Repeats
 495 -- --   'prop_c0120_identity1' with tetrahedrons 6 and 7.
 496 -- prop_c0120_identity6 :: Cube -> Bool
 497 -- prop_c0120_identity6 cube =
 498 --    c t6 0 1 2 0 ~= (c t6 0 0 2 1 + c t7 0 0 1 2) / 2
 499 --      where
 500 --        t6 = tetrahedron6 cube
 501 --        t7 = tetrahedron7 cube
 502
 503
 504 -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). See
 505 --   'prop_c0120_identity1'.
 506 prop_c0210_identity1 :: Cube -> Bool
 507 prop_c0210_identity1 cube =
 508     c t0 0 2 1 0 ~= (c t0 0 1 1 1 + c t1 0 1 1 1) / 2
 509       where
 510         t0 = tetrahedron0 cube
 511         t1 = tetrahedron1 cube
 512
 513
 514 -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). See
 515 --   'prop_c0120_identity1'.
 516 prop_c0300_identity1 :: Cube -> Bool
 517 prop_c0300_identity1 cube =
 518     c t0 0 3 0 0 ~= (c t0 0 2 0 1 + c t1 0 2 1 0) / 2
 519       where
 520         t0 = tetrahedron0 cube
 521         t1 = tetrahedron1 cube
 522
 523
 524 -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). See
 525 --   'prop_c0120_identity1'.
 526 prop_c1110_identity :: Cube -> Bool
 527 prop_c1110_identity cube =
 528     c t0 1 1 1 0 ~= (c t0 1 0 1 1 + c t1 1 0 1 1) / 2
 529       where
 530         t0 = tetrahedron0 cube
 531         t1 = tetrahedron1 cube
 532
 533
 534 -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). See
 535 --   'prop_c0120_identity1'.
 536 prop_c1200_identity1 :: Cube -> Bool
 537 prop_c1200_identity1 cube =
 538     c t0 1 2 0 0 ~= (c t0 1 1 0 1 + c t1 1 1 1 0) / 2
 539       where
 540         t0 = tetrahedron0 cube
 541         t1 = tetrahedron1 cube
 542
 543
 544 -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). See
 545 --   'prop_c0120_identity1'.
 546 prop_c2100_identity1 :: Cube -> Bool
 547 prop_c2100_identity1 cube =
 548     c t0 2 1 0 0 ~= (c t0 2 0 0 1 + c t1 2 0 1 0) / 2
 549       where
 550         t0 = tetrahedron0 cube
 551         t1 = tetrahedron1 cube
 552
 553
 554
 555 -- | Given in Sorokina and Zeilfelder, p. 79, (2.7). It appears that
 556 --   the assumptions in sections (2.6) and (2.7) have been
 557 --   switched. From the description, one would expect 'tetrahedron0'
 558 --   and 'tetrahedron1' to share face \<v0,v1,v3\>; however, we have
 559 --   to use 'tetrahedron0' and 'tetahedron3' for all of the tests in
 560 --   section (2.7). Also note that the third and fourth indices of
 561 --   c-t3 have been switched. This is because we store the triangles
 562 --   oriented such that their volume is positive. If T and T-tilde
 563 --   share \<v0,v1,v2\> and v3,v3-tilde point in opposite directions,
 564 --   one of them has to have negative volume!
 565 prop_c0102_identity1 :: Cube -> Bool
 566 prop_c0102_identity1 cube =
 567     c t0 0 1 0 2 ~= (c t0 0 0 1 2 + c t3 0 0 2 1) / 2
 568       where
 569         t0 = tetrahedron0 cube
 570         t3 = tetrahedron3 cube
 571
 572
 573 -- | Given in Sorokina and Zeilfelder, p. 79, (2.7). See
 574 --   'prop_c0102_identity1'.
 575 prop_c0201_identity1 :: Cube -> Bool
 576 prop_c0201_identity1 cube =
 577     c t0 0 2 0 1 ~= (c t0 0 1 1 1 + c t3 0 1 1 1) / 2
 578       where
 579         t0 = tetrahedron0 cube
 580         t3 = tetrahedron3 cube
 581
 582
 583 -- | Given in Sorokina and Zeilfelder, p. 79, (2.7). See
 584 --   'prop_c0102_identity1'.
 585 prop_c0300_identity2 :: Cube -> Bool
 586 prop_c0300_identity2 cube =
 587     c t0 0 3 0 0 ~= (c t0 0 2 1 0 + c t3 0 2 0 1) / 2
 588       where
 589         t0 = tetrahedron0 cube
 590         t3 = tetrahedron3 cube
 591
 592
 593 -- | Given in Sorokina and Zeilfelder, p. 79, (2.7). See
 594 --   'prop_c0102_identity1'.
 595 prop_c1101_identity :: Cube -> Bool
 596 prop_c1101_identity cube =
 597     c t0 1 1 0 1 ~= (c t0 1 0 1 1 + c t3 1 0 1 1) / 2
 598       where
 599         t0 = tetrahedron0 cube
 600         t3 = tetrahedron3 cube
 601
 602
 603 -- | Given in Sorokina and Zeilfelder, p. 79, (2.7). See
 604 --   'prop_c0102_identity1'.
 605 prop_c1200_identity2 :: Cube -> Bool
 606 prop_c1200_identity2 cube =
 607     c t0 1 2 0 0 ~= (c t0 1 1 1 0 + c t3 1 1 0 1) / 2
 608       where
 609         t0 = tetrahedron0 cube
 610         t3 = tetrahedron3 cube
 611
 612
 613 -- | Given in Sorokina and Zeilfelder, p. 79, (2.7). See
 614 --   'prop_c0102_identity1'.
 615 prop_c2100_identity2 :: Cube -> Bool
 616 prop_c2100_identity2 cube =
 617     c t0 2 1 0 0 ~= (c t0 2 0 1 0 + c t3 2 0 0 1) / 2
 618       where
 619         t0 = tetrahedron0 cube
 620         t3 = tetrahedron3 cube
 621
 622
 623 -- | Given in Sorokina and Zeilfelder, p. 79, (2.8). The third and
 624 --   fourth indices of c-t6 have been switched. This is because we
 625 --   store the triangles oriented such that their volume is
 626 --   positive. If T and T-tilde share \<v0,v1,v2\> and v3,v3-tilde
 627 --   point in opposite directions, one of them has to have negative
 628 --   volume!
 629 prop_c3000_identity :: Cube -> Bool
 630 prop_c3000_identity cube =
 631     c t0 3 0 0 0 ~= c t0 2 1 0 0 + c t6 2 1 0 0
 632                     - ((c t0 2 0 1 0 + c t0 2 0 0 1)/ 2)
 633       where
 634         t0 = tetrahedron0 cube
 635         t6 = tetrahedron6 cube
 636
 637
 638 -- | Given in Sorokina and Zeilfelder, p. 79, (2.8). See
 639 --   'prop_c3000_identity'.
 640 prop_c2010_identity :: Cube -> Bool
 641 prop_c2010_identity cube =
 642     c t0 2 0 1 0 ~= c t0 1 1 1 0 + c t6 1 1 0 1
 643                     - ((c t0 1 0 2 0 + c t0 1 0 1 1)/ 2)
 644       where
 645         t0 = tetrahedron0 cube
 646         t6 = tetrahedron6 cube
 647
 648
 649 -- | Given in Sorokina and Zeilfelder, p. 79, (2.8). See
 650 --   'prop_c3000_identity'.
 651 prop_c2001_identity :: Cube -> Bool
 652 prop_c2001_identity cube =
 653     c t0 2 0 0 1 ~= c t0 1 1 0 1 + c t6 1 1 1 0
 654                     - ((c t0 1 0 0 2 + c t0 1 0 1 1)/ 2)
 655       where
 656         t0 = tetrahedron0 cube
 657         t6 = tetrahedron6 cube
 658
 659
 660 -- | Given in Sorokina and Zeilfelder, p. 79, (2.8). See
 661 --   'prop_c3000_identity'.
 662 prop_c1020_identity :: Cube -> Bool
 663 prop_c1020_identity cube =
 664     c t0 1 0 2 0 ~= c t0 0 1 2 0 + c t6 0 1 0 2
 665                     - ((c t0 0 0 3 0 + c t0 0 0 2 1)/ 2)
 666       where
 667         t0 = tetrahedron0 cube
 668         t6 = tetrahedron6 cube
 669
 670
 671 -- | Given in Sorokina and Zeilfelder, p. 79, (2.8). See
 672 --   'prop_c3000_identity'.
 673 prop_c1002_identity :: Cube -> Bool
 674 prop_c1002_identity cube =
 675     c t0 1 0 0 2 ~= c t0 0 1 0 2 + c t6 0 1 2 0
 676                     - ((c t0 0 0 0 3 + c t0 0 0 1 2)/ 2)
 677       where
 678         t0 = tetrahedron0 cube
 679         t6 = tetrahedron6 cube
 680
 681
 682 -- | Given in Sorokina and Zeilfelder, p. 79, (2.8). See
 683 --   'prop_c3000_identity'.
 684 prop_c1011_identity :: Cube -> Bool
 685 prop_c1011_identity cube =
 686     c t0 1 0 1 1 ~= c t0 0 1 1 1 + c t6 0 1 1 1 -
 687                     ((c t0 0 0 1 2 + c t0 0 0 2 1)/ 2)
 688       where
 689         t0 = tetrahedron0 cube
 690         t6 = tetrahedron6 cube
 691
 692
 693
 694 -- | Given in Sorokina and Zeilfelder, p. 78.
 695 prop_cijk1_identity :: Cube -> Bool
 696 prop_cijk1_identity cube =
 697      and [ c t0 i j k 1 ~=
 698                  (c t1 (i+1) j k 0) * ((b0 t0) (v3 t1)) +
 699                  (c t1 i (j+1) k 0) * ((b1 t0) (v3 t1)) +
 700                  (c t1 i j (k+1) 0) * ((b2 t0) (v3 t1)) +
 701                  (c t1 i j k 1) * ((b3 t0) (v3 t1)) | i <- [0..2],
 702                                                       j <- [0..2],
 703                                                       k <- [0..2],
 704                                                       i + j + k == 2]
 705       where
 706         t0 = tetrahedron0 cube
 707         t1 = tetrahedron1 cube
 708
 709
 710 -- | The function values at the interior should be the same for all tetrahedra.
 711 prop_interior_values_all_identical :: Cube -> Bool
 712 prop_interior_values_all_identical cube =
 713     all_equal [i0, i1, i2, i3, i4, i5, i6, i7, i8,
 714                i9, i10, i11, i12, i13, i14, i15, i16,
 715                i17, i18, i19, i20, i21, i22, i23]
 716     where
 717       i0 = eval (Tetrahedron.fv (tetrahedron0 cube)) I
 718       i1 = eval (Tetrahedron.fv (tetrahedron1 cube)) I
 719       i2 = eval (Tetrahedron.fv (tetrahedron2 cube)) I
 720       i3 = eval (Tetrahedron.fv (tetrahedron3 cube)) I
 721       i4 = eval (Tetrahedron.fv (tetrahedron4 cube)) I
 722       i5 = eval (Tetrahedron.fv (tetrahedron5 cube)) I
 723       i6 = eval (Tetrahedron.fv (tetrahedron6 cube)) I
 724       i7 = eval (Tetrahedron.fv (tetrahedron7 cube)) I
 725       i8 = eval (Tetrahedron.fv (tetrahedron8 cube)) I
 726       i9 = eval (Tetrahedron.fv (tetrahedron9 cube)) I
 727       i10 = eval (Tetrahedron.fv (tetrahedron10 cube)) I
 728       i11 = eval (Tetrahedron.fv (tetrahedron11 cube)) I
 729       i12 = eval (Tetrahedron.fv (tetrahedron12 cube)) I
 730       i13 = eval (Tetrahedron.fv (tetrahedron13 cube)) I
 731       i14 = eval (Tetrahedron.fv (tetrahedron14 cube)) I
 732       i15 = eval (Tetrahedron.fv (tetrahedron15 cube)) I
 733       i16 = eval (Tetrahedron.fv (tetrahedron16 cube)) I
 734       i17 = eval (Tetrahedron.fv (tetrahedron17 cube)) I
 735       i18 = eval (Tetrahedron.fv (tetrahedron18 cube)) I
 736       i19 = eval (Tetrahedron.fv (tetrahedron19 cube)) I
 737       i20 = eval (Tetrahedron.fv (tetrahedron20 cube)) I
 738       i21 = eval (Tetrahedron.fv (tetrahedron21 cube)) I
 739       i22 = eval (Tetrahedron.fv (tetrahedron22 cube)) I
 740       i23 = eval (Tetrahedron.fv (tetrahedron23 cube)) I
 741
 742
 743 -- | We know what (c t6 2 1 0 0) should be from Sorokina and Zeilfelder, p. 87.
 744 --   This test checks the rotation works as expected.
 745 prop_c_tilde_2100_rotation_correct :: Cube -> Bool
 746 prop_c_tilde_2100_rotation_correct cube =
 747     expr1 == expr2
 748     where
 749       t0 = tetrahedron0 cube
 750       t6 = tetrahedron6 cube
 751
 752       -- What gets computed for c2100 of t6.
 753       expr1 = eval (Tetrahedron.fv t6) $
 754           (3/8)*I +
 755           (1/12)*(T + R + L + D) +
 756           (1/64)*(FT + FR + FL + FD) +
 757           (7/48)*F +
 758           (1/48)*B +
 759           (1/96)*(RT + LD + LT + RD) +
 760           (1/192)*(BT + BR + BL + BD)
 761
 762       -- What should be computed for c2100 of t6.
 763       expr2 = eval (Tetrahedron.fv t0) $
 764               (3/8)*I +
 765               (1/12)*(F + R + L + B) +
 766               (1/64)*(FT + RT + LT + BT) +
 767               (7/48)*T +
 768               (1/48)*D +
 769               (1/96)*(FR + FL + BR + BL) +
 770               (1/192)*(FD + RD + LD + BD)
 771
 772
 773 -- | We know what (c t6 2 1 0 0) should be from Sorokina and Zeilfelder, p. 87.
 774 --   This test checks the actual value based on the FunctionValues of the cube.
 775 prop_c_tilde_2100_correct :: Cube -> Bool
 776 prop_c_tilde_2100_correct cube =
 777     c t6 2 1 0 0 == (3/8)*int
 778                     + (1/12)*(f + r + l + b)
 779                     + (1/64)*(ft + rt + lt + bt)
 780                     + (7/48)*t + (1/48)*d + (1/96)*(fr + fl + br + bl)
 781                     + (1/192)*(fd + rd + ld + bd)
 782     where
 783       t0 = tetrahedron0 cube
 784       t6 = tetrahedron6 cube
 785       fvs = Tetrahedron.fv t0
 786       int = interior fvs
 787       f = front fvs
 788       r = right fvs
 789       l = left fvs
 790       b = back fvs
 791       ft = front_top fvs
 792       rt = right_top fvs
 793       lt = left_top fvs
 794       bt = back_top fvs
 795       t = top fvs
 796       d = down fvs
 797       fr = front_right fvs
 798       fl = front_left fvs
 799       br = back_right fvs
 800       bl = back_left fvs
 801       fd = front_down fvs
 802       rd = right_down fvs
 803       ld = left_down fvs
 804       bd = back_down fvs
 805
 806 -- Tests to check that the correct edges are incidental.
 807 prop_t0_shares_edge_with_t1 :: Cube -> Bool
 808 prop_t0_shares_edge_with_t1 cube =
 809     (v1 t0) == (v1 t1) && (v3 t0) == (v2 t1)
 810       where
 811         t0 = tetrahedron0 cube
 812         t1 = tetrahedron1 cube
 813
 814 prop_t0_shares_edge_with_t3 :: Cube -> Bool
 815 prop_t0_shares_edge_with_t3 cube =
 816     (v1 t0) == (v1 t3) && (v2 t0) == (v3 t3)
 817       where
 818         t0 = tetrahedron0 cube
 819         t3 = tetrahedron3 cube
 820
 821 prop_t0_shares_edge_with_t6 :: Cube -> Bool
 822 prop_t0_shares_edge_with_t6 cube =
 823     (v2 t0) == (v3 t6) && (v3 t0) == (v2 t6)
 824       where
 825         t0 = tetrahedron0 cube
 826         t6 = tetrahedron6 cube
 827
 828 prop_t1_shares_edge_with_t2 :: Cube -> Bool
 829 prop_t1_shares_edge_with_t2 cube =
 830     (v1 t1) == (v1 t2) && (v3 t1) == (v2 t2)
 831       where
 832         t1 = tetrahedron1 cube
 833         t2 = tetrahedron2 cube
 834
 835 prop_t1_shares_edge_with_t19 :: Cube -> Bool
 836 prop_t1_shares_edge_with_t19 cube =
 837     (v2 t1) == (v3 t19) && (v3 t1) == (v2 t19)
 838       where
 839         t1 = tetrahedron1 cube
 840         t19 = tetrahedron19 cube
 841
 842 prop_t2_shares_edge_with_t3 :: Cube -> Bool
 843 prop_t2_shares_edge_with_t3 cube =
 844     (v1 t1) == (v1 t2) && (v3 t1) == (v2 t2)
 845       where
 846         t1 = tetrahedron1 cube
 847         t2 = tetrahedron2 cube
 848
 849 prop_t2_shares_edge_with_t12 :: Cube -> Bool
 850 prop_t2_shares_edge_with_t12 cube =
 851     (v2 t2) == (v3 t12) && (v3 t2) == (v2 t12)
 852       where
 853         t2 = tetrahedron2 cube
 854         t12 = tetrahedron12 cube
 855
 856 prop_t3_shares_edge_with_t21 :: Cube -> Bool
 857 prop_t3_shares_edge_with_t21 cube =
 858     (v2 t3) == (v3 t21) && (v3 t3) == (v2 t21)
 859       where
 860         t3 = tetrahedron3 cube
 861         t21 = tetrahedron21 cube
 862
 863 prop_t4_shares_edge_with_t5 :: Cube -> Bool
 864 prop_t4_shares_edge_with_t5 cube =
 865     (v1 t4) == (v1 t5) && (v3 t4) == (v2 t5)
 866       where
 867         t4 = tetrahedron4 cube
 868         t5 = tetrahedron5 cube
 869
 870 prop_t4_shares_edge_with_t7 :: Cube -> Bool
 871 prop_t4_shares_edge_with_t7 cube =
 872     (v1 t4) == (v1 t7) && (v2 t4) == (v3 t7)
 873       where
 874         t4 = tetrahedron4 cube
 875         t7 = tetrahedron7 cube
 876
 877 prop_t4_shares_edge_with_t10 :: Cube -> Bool
 878 prop_t4_shares_edge_with_t10 cube =
 879     (v2 t4) == (v3 t10) && (v3 t4) == (v2 t10)
 880       where
 881         t4 = tetrahedron4 cube
 882         t10 = tetrahedron10 cube
 883
 884 prop_t5_shares_edge_with_t6 :: Cube -> Bool
 885 prop_t5_shares_edge_with_t6 cube =
 886     (v1 t5) == (v1 t6) && (v3 t5) == (v2 t6)
 887       where
 888         t5 = tetrahedron5 cube
 889         t6 = tetrahedron6 cube
 890
 891 prop_t5_shares_edge_with_t16 :: Cube -> Bool
 892 prop_t5_shares_edge_with_t16 cube =
 893     (v2 t5) == (v3 t16) && (v3 t5) == (v2 t16)
 894       where
 895         t5 = tetrahedron5 cube
 896         t16 = tetrahedron16 cube
 897
 898 prop_t6_shares_edge_with_t7 :: Cube -> Bool
 899 prop_t6_shares_edge_with_t7 cube =
 900     (v1 t6) == (v1 t7) && (v3 t6) == (v2 t7)
 901       where
 902         t6 = tetrahedron6 cube
 903         t7 = tetrahedron7 cube
 904
 905 prop_t7_shares_edge_with_t20 :: Cube -> Bool
 906 prop_t7_shares_edge_with_t20 cube =
 907     (v2 t7) == (v3 t20) && (v2 t7) == (v3 t20)
 908       where
 909         t7 = tetrahedron7 cube
 910         t20 = tetrahedron20 cube