src/Tests/Cube.hs

   1 module Tests.Cube
   2 where
   3
   4 import Prelude hiding (LT)
   5
   6 import Cardinal
   7 import Comparisons
   8 import Cube hiding (i, j, k)
   9 import FunctionValues
  10 import Misc (all_equal, disjoint)
  11 import Tetrahedron (b0, b1, b2, b3, c, fv,
  12                     v0, v1, v2, v3, volume)
  13
  14
  15 -- Quickcheck tests.
  16
  17 prop_opposite_octant_tetrahedra_disjoint1 :: Cube -> Bool
  18 prop_opposite_octant_tetrahedra_disjoint1 c =
  19   disjoint (front_left_top_tetrahedra c) (front_right_down_tetrahedra c)
  20
  21 prop_opposite_octant_tetrahedra_disjoint2 :: Cube -> Bool
  22 prop_opposite_octant_tetrahedra_disjoint2 c =
  23   disjoint (back_left_top_tetrahedra c) (back_right_down_tetrahedra c)
  24
  25 prop_opposite_octant_tetrahedra_disjoint3 :: Cube -> Bool
  26 prop_opposite_octant_tetrahedra_disjoint3 c =
  27   disjoint (front_left_top_tetrahedra c) (back_right_top_tetrahedra c)
  28
  29 prop_opposite_octant_tetrahedra_disjoint4 :: Cube -> Bool
  30 prop_opposite_octant_tetrahedra_disjoint4 c =
  31   disjoint (front_left_down_tetrahedra c) (back_right_down_tetrahedra c)
  32
  33 prop_opposite_octant_tetrahedra_disjoint5 :: Cube -> Bool
  34 prop_opposite_octant_tetrahedra_disjoint5 c =
  35   disjoint (front_left_top_tetrahedra c) (back_left_down_tetrahedra c)
  36
  37 prop_opposite_octant_tetrahedra_disjoint6 :: Cube -> Bool
  38 prop_opposite_octant_tetrahedra_disjoint6 c =
  39   disjoint (front_right_top_tetrahedra c) (back_right_down_tetrahedra c)
  40
  41
  42 -- | Since the grid size is necessarily positive, all tetrahedra
  43 --   (which comprise cubes of positive volume) must have positive volume
  44 --   as well.
  45 prop_all_volumes_positive :: Cube -> Bool
  46 prop_all_volumes_positive cube =
  47     null nonpositive_volumes
  48     where
  49       ts = tetrahedra cube
  50       volumes = map volume ts
  51       nonpositive_volumes = filter (<= 0) volumes
  52
  53 -- | In fact, since all of the tetrahedra are identical, we should
  54 --   already know their volumes. There's 24 tetrahedra to a cube, so
  55 --   we'd expect the volume of each one to be (1/24)*h^3.
  56 prop_all_volumes_exact :: Cube -> Bool
  57 prop_all_volumes_exact cube =
  58     and [volume t ~~= (1/24)*(delta^(3::Int)) | t <- tetrahedra cube]
  59     where
  60       delta = h cube
  61
  62 -- | All tetrahedron should have their v0 located at the center of the cube.
  63 prop_v0_all_equal :: Cube -> Bool
  64 prop_v0_all_equal cube = (v0 t0) == (v0 t1)
  65     where
  66       t0 = head (tetrahedra cube) -- Doesn't matter which two we choose.
  67       t1 = head $ tail (tetrahedra cube)
  68
  69
  70 -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Note that the
  71 --   third and fourth indices of c-t1 have been switched. This is
  72 --   because we store the triangles oriented such that their volume is
  73 --   positive. If T and T-tilde share \<v0,v1,v2\> and v3,v3-tilde point
  74 --   in opposite directions, one of them has to have negative volume!
  75 prop_c0120_identity1 :: Cube -> Bool
  76 prop_c0120_identity1 cube =
  77    c t0 0 1 2 0 ~= (c t0 0 0 2 1 + c t3 0 0 1 2) / 2
  78      where
  79        t0 = tetrahedron cube 0
  80        t3 = tetrahedron cube 3
  81
  82
  83 -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Repeats
  84 --   'prop_c0120_identity1' with tetrahedrons 1 and 2.
  85 prop_c0120_identity2 :: Cube -> Bool
  86 prop_c0120_identity2 cube =
  87    c t1 0 1 2 0 ~= (c t1 0 0 2 1 + c t0 0 0 1 2) / 2
  88      where
  89        t0 = tetrahedron cube 0
  90        t1 = tetrahedron cube 1
  91
  92 -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Repeats
  93 --   'prop_c0120_identity1' with tetrahedrons 1 and 2.
  94 prop_c0120_identity3 :: Cube -> Bool
  95 prop_c0120_identity3 cube =
  96    c t2 0 1 2 0 ~= (c t2 0 0 2 1 + c t1 0 0 1 2) / 2
  97      where
  98        t1 = tetrahedron cube 1
  99        t2 = tetrahedron cube 2
 100
 101 -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Repeats
 102 --   'prop_c0120_identity1' with tetrahedrons 2 and 3.
 103 prop_c0120_identity4 :: Cube -> Bool
 104 prop_c0120_identity4 cube =
 105    c t3 0 1 2 0 ~= (c t3 0 0 2 1 + c t2 0 0 1 2) / 2
 106      where
 107        t2 = tetrahedron cube 2
 108        t3 = tetrahedron cube 3
 109
 110
 111 -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Repeats
 112 --   'prop_c0120_identity1' with tetrahedrons 4 and 5.
 113 prop_c0120_identity5 :: Cube -> Bool
 114 prop_c0120_identity5 cube =
 115     c t5 0 1 2 0 ~= (c t5 0 0 2 1 + c t4 0 0 1 2) / 2
 116     where
 117       t4 = tetrahedron cube 4
 118       t5 = tetrahedron cube 5
 119
 120 -- -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Repeats
 121 -- --   'prop_c0120_identity1' with tetrahedrons 5 and 6.
 122 prop_c0120_identity6 :: Cube -> Bool
 123 prop_c0120_identity6 cube =
 124    c t6 0 1 2 0 ~= (c t6 0 0 2 1 + c t5 0 0 1 2) / 2
 125      where
 126        t5 = tetrahedron cube 5
 127        t6 = tetrahedron cube 6
 128
 129
 130 -- -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Repeats
 131 -- --   'prop_c0120_identity1' with tetrahedrons 6 and 7.
 132 prop_c0120_identity7 :: Cube -> Bool
 133 prop_c0120_identity7 cube =
 134    c t7 0 1 2 0 ~= (c t7 0 0 2 1 + c t6 0 0 1 2) / 2
 135      where
 136        t6 = tetrahedron cube 6
 137        t7 = tetrahedron cube 7
 138
 139
 140 -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). See
 141 --   'prop_c0120_identity1'.
 142 prop_c0210_identity1 :: Cube -> Bool
 143 prop_c0210_identity1 cube =
 144     c t0 0 2 1 0 ~= (c t0 0 1 1 1 + c t3 0 1 1 1) / 2
 145       where
 146         t0 = tetrahedron cube 0
 147         t3 = tetrahedron cube 3
 148
 149
 150 -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). See
 151 --   'prop_c0120_identity1'.
 152 prop_c0300_identity1 :: Cube -> Bool
 153 prop_c0300_identity1 cube =
 154     c t0 0 3 0 0 ~= (c t0 0 2 0 1 + c t3 0 2 1 0) / 2
 155       where
 156         t0 = tetrahedron cube 0
 157         t3 = tetrahedron cube 3
 158
 159
 160 -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). See
 161 --   'prop_c0120_identity1'.
 162 prop_c1110_identity :: Cube -> Bool
 163 prop_c1110_identity cube =
 164     c t0 1 1 1 0 ~= (c t0 1 0 1 1 + c t3 1 0 1 1) / 2
 165       where
 166         t0 = tetrahedron cube 0
 167         t3 = tetrahedron cube 3
 168
 169
 170 -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). See
 171 --   'prop_c0120_identity1'.
 172 prop_c1200_identity1 :: Cube -> Bool
 173 prop_c1200_identity1 cube =
 174     c t0 1 2 0 0 ~= (c t0 1 1 0 1 + c t3 1 1 1 0) / 2
 175       where
 176         t0 = tetrahedron cube 0
 177         t3 = tetrahedron cube 3
 178
 179
 180 -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). See
 181 --   'prop_c0120_identity1'.
 182 prop_c2100_identity1 :: Cube -> Bool
 183 prop_c2100_identity1 cube =
 184     c t0 2 1 0 0 ~= (c t0 2 0 0 1 + c t3 2 0 1 0) / 2
 185       where
 186         t0 = tetrahedron cube 0
 187         t3 = tetrahedron cube 3
 188
 189
 190
 191 -- | Given in Sorokina and Zeilfelder, p. 79, (2.7). Note that the
 192 --   third and fourth indices of c-t3 have been switched. This is
 193 --   because we store the triangles oriented such that their volume is
 194 --   positive. If T and T-tilde share \<v0,v1,v2\> and v3,v3-tilde
 195 --   point in opposite directions, one of them has to have negative
 196 --   volume!
 197 prop_c0102_identity1 :: Cube -> Bool
 198 prop_c0102_identity1 cube =
 199     c t0 0 1 0 2 ~= (c t0 0 0 1 2 + c t1 0 0 2 1) / 2
 200       where
 201         t0 = tetrahedron cube 0
 202         t1 = tetrahedron cube 1
 203
 204
 205 -- | Given in Sorokina and Zeilfelder, p. 79, (2.7). See
 206 --   'prop_c0102_identity1'.
 207 prop_c0201_identity1 :: Cube -> Bool
 208 prop_c0201_identity1 cube =
 209     c t0 0 2 0 1 ~= (c t0 0 1 1 1 + c t1 0 1 1 1) / 2
 210       where
 211         t0 = tetrahedron cube 0
 212         t1 = tetrahedron cube 1
 213
 214
 215 -- | Given in Sorokina and Zeilfelder, p. 79, (2.7). See
 216 --   'prop_c0102_identity1'.
 217 prop_c0300_identity2 :: Cube -> Bool
 218 prop_c0300_identity2 cube =
 219     c t0 0 3 0 0 ~= (c t0 0 2 1 0 + c t1 0 2 0 1) / 2
 220       where
 221         t0 = tetrahedron cube 0
 222         t1 = tetrahedron cube 1
 223
 224
 225 -- | Given in Sorokina and Zeilfelder, p. 79, (2.7). See
 226 --   'prop_c0102_identity1'.
 227 prop_c1101_identity :: Cube -> Bool
 228 prop_c1101_identity cube =
 229     c t0 1 1 0 1 ~= (c t0 1 0 1 1 + c t1 1 0 1 1) / 2
 230       where
 231         t0 = tetrahedron cube 0
 232         t1 = tetrahedron cube 1
 233
 234
 235 -- | Given in Sorokina and Zeilfelder, p. 79, (2.7). See
 236 --   'prop_c0102_identity1'.
 237 prop_c1200_identity2 :: Cube -> Bool
 238 prop_c1200_identity2 cube =
 239     c t0 1 2 0 0 ~= (c t0 1 1 1 0 + c t1 1 1 0 1) / 2
 240       where
 241         t0 = tetrahedron cube 0
 242         t1 = tetrahedron cube 1
 243
 244
 245 -- | Given in Sorokina and Zeilfelder, p. 79, (2.7). See
 246 --   'prop_c0102_identity1'.
 247 prop_c2100_identity2 :: Cube -> Bool
 248 prop_c2100_identity2 cube =
 249     c t0 2 1 0 0 ~= (c t0 2 0 1 0 + c t1 2 0 0 1) / 2
 250       where
 251         t0 = tetrahedron cube 0
 252         t1 = tetrahedron cube 1
 253
 254
 255 -- | Given in Sorokina and Zeilfelder, p. 79, (2.8). The third and
 256 --   fourth indices of c-t6 have been switched. This is because we
 257 --   store the triangles oriented such that their volume is
 258 --   positive. If T and T-tilde share \<v0,v1,v2\> and v3,v3-tilde
 259 --   point in opposite directions, one of them has to have negative
 260 --   volume!
 261 prop_c3000_identity :: Cube -> Bool
 262 prop_c3000_identity cube =
 263     c t0 3 0 0 0 ~= c t0 2 1 0 0 + c t6 2 1 0 0
 264                     - ((c t0 2 0 1 0 + c t0 2 0 0 1)/ 2)
 265       where
 266         t0 = tetrahedron cube 0
 267         t6 = tetrahedron cube 6
 268
 269
 270 -- | Given in Sorokina and Zeilfelder, p. 79, (2.8). See
 271 --   'prop_c3000_identity'.
 272 prop_c2010_identity :: Cube -> Bool
 273 prop_c2010_identity cube =
 274     c t0 2 0 1 0 ~= c t0 1 1 1 0 + c t6 1 1 0 1
 275                     - ((c t0 1 0 2 0 + c t0 1 0 1 1)/ 2)
 276       where
 277         t0 = tetrahedron cube 0
 278         t6 = tetrahedron cube 6
 279
 280
 281 -- | Given in Sorokina and Zeilfelder, p. 79, (2.8). See
 282 --   'prop_c3000_identity'.
 283 prop_c2001_identity :: Cube -> Bool
 284 prop_c2001_identity cube =
 285     c t0 2 0 0 1 ~= c t0 1 1 0 1 + c t6 1 1 1 0
 286                     - ((c t0 1 0 0 2 + c t0 1 0 1 1)/ 2)
 287       where
 288         t0 = tetrahedron cube 0
 289         t6 = tetrahedron cube 6
 290
 291
 292 -- | Given in Sorokina and Zeilfelder, p. 79, (2.8). See
 293 --   'prop_c3000_identity'.
 294 prop_c1020_identity :: Cube -> Bool
 295 prop_c1020_identity cube =
 296     c t0 1 0 2 0 ~= c t0 0 1 2 0 + c t6 0 1 0 2
 297                     - ((c t0 0 0 3 0 + c t0 0 0 2 1)/ 2)
 298       where
 299         t0 = tetrahedron cube 0
 300         t6 = tetrahedron cube 6
 301
 302
 303 -- | Given in Sorokina and Zeilfelder, p. 79, (2.8). See
 304 --   'prop_c3000_identity'.
 305 prop_c1002_identity :: Cube -> Bool
 306 prop_c1002_identity cube =
 307     c t0 1 0 0 2 ~= c t0 0 1 0 2 + c t6 0 1 2 0
 308                     - ((c t0 0 0 0 3 + c t0 0 0 1 2)/ 2)
 309       where
 310         t0 = tetrahedron cube 0
 311         t6 = tetrahedron cube 6
 312
 313
 314 -- | Given in Sorokina and Zeilfelder, p. 79, (2.8). See
 315 --   'prop_c3000_identity'.
 316 prop_c1011_identity :: Cube -> Bool
 317 prop_c1011_identity cube =
 318     c t0 1 0 1 1 ~= c t0 0 1 1 1 + c t6 0 1 1 1 -
 319                     ((c t0 0 0 1 2 + c t0 0 0 2 1)/ 2)
 320       where
 321         t0 = tetrahedron cube 0
 322         t6 = tetrahedron cube 6
 323
 324
 325
 326 -- | Given in Sorokina and Zeilfelder, p. 78.
 327 prop_cijk1_identity :: Cube -> Bool
 328 prop_cijk1_identity cube =
 329      and [ c t0 i j k 1 ~=
 330                  (c t1 (i+1) j k 0) * ((b0 t0) (v3 t1)) +
 331                  (c t1 i (j+1) k 0) * ((b1 t0) (v3 t1)) +
 332                  (c t1 i j (k+1) 0) * ((b2 t0) (v3 t1)) +
 333                  (c t1 i j k 1) * ((b3 t0) (v3 t1)) | i <- [0..2],
 334                                                       j <- [0..2],
 335                                                       k <- [0..2],
 336                                                       i + j + k == 2]
 337       where
 338         t0 = tetrahedron cube 0
 339         t1 = tetrahedron cube 1
 340
 341
 342 -- | The function values at the interior should be the same for all
 343 --   tetrahedra.
 344 prop_interior_values_all_identical :: Cube -> Bool
 345 prop_interior_values_all_identical cube =
 346     all_equal [ eval (Tetrahedron.fv tet) I | tet <- tetrahedra cube ]
 347
 348
 349 -- | We know what (c t6 2 1 0 0) should be from Sorokina and Zeilfelder, p. 87.
 350 --   This test checks the rotation works as expected.
 351 prop_c_tilde_2100_rotation_correct :: Cube -> Bool
 352 prop_c_tilde_2100_rotation_correct cube =
 353     expr1 == expr2
 354     where
 355       t0 = tetrahedron cube 0
 356       t6 = tetrahedron cube 6
 357
 358       -- What gets computed for c2100 of t6.
 359       expr1 = eval (Tetrahedron.fv t6) $
 360           (3/8)*I +
 361           (1/12)*(T + R + L + D) +
 362           (1/64)*(FT + FR + FL + FD) +
 363           (7/48)*F +
 364           (1/48)*B +
 365           (1/96)*(RT + LD + LT + RD) +
 366           (1/192)*(BT + BR + BL + BD)
 367
 368       -- What should be computed for c2100 of t6.
 369       expr2 = eval (Tetrahedron.fv t0) $
 370               (3/8)*I +
 371               (1/12)*(F + R + L + B) +
 372               (1/64)*(FT + RT + LT + BT) +
 373               (7/48)*T +
 374               (1/48)*D +
 375               (1/96)*(FR + FL + BR + BL) +
 376               (1/192)*(FD + RD + LD + BD)
 377
 378
 379 -- | We know what (c t6 2 1 0 0) should be from Sorokina and
 380 --   Zeilfelder, p. 87.  This test checks the actual value based on
 381 --   the FunctionValues of the cube.
 382 --
 383 --   If 'prop_c_tilde_2100_rotation_correct' passes, then this test is
 384 --   even meaningful!
 385 prop_c_tilde_2100_correct :: Cube -> Bool
 386 prop_c_tilde_2100_correct cube =
 387     c t6 2 1 0 0 == expected
 388     where
 389       t0 = tetrahedron cube 0
 390       t6 = tetrahedron cube 6
 391       fvs = Tetrahedron.fv t0
 392       expected = eval fvs $
 393                   (3/8)*I +
 394                   (1/12)*(F + R + L + B) +
 395                   (1/64)*(FT + RT + LT + BT) +
 396                   (7/48)*T +
 397                   (1/48)*D +
 398                   (1/96)*(FR + FL + BR + BL) +
 399                   (1/192)*(FD + RD + LD + BD)
 400
 401
 402 -- Tests to check that the correct edges are incidental.
 403 prop_t0_shares_edge_with_t1 :: Cube -> Bool
 404 prop_t0_shares_edge_with_t1 cube =
 405     (v1 t0) == (v1 t1) && (v3 t0) == (v2 t1)
 406       where
 407         t0 = tetrahedron cube 0
 408         t1 = tetrahedron cube 1
 409
 410 prop_t0_shares_edge_with_t3 :: Cube -> Bool
 411 prop_t0_shares_edge_with_t3 cube =
 412     (v1 t0) == (v1 t3) && (v2 t0) == (v3 t3)
 413       where
 414         t0 = tetrahedron cube 0
 415         t3 = tetrahedron cube 3
 416
 417 prop_t0_shares_edge_with_t6 :: Cube -> Bool
 418 prop_t0_shares_edge_with_t6 cube =
 419     (v2 t0) == (v3 t6) && (v3 t0) == (v2 t6)
 420       where
 421         t0 = tetrahedron cube 0
 422         t6 = tetrahedron cube 6
 423
 424 prop_t1_shares_edge_with_t2 :: Cube -> Bool
 425 prop_t1_shares_edge_with_t2 cube =
 426     (v1 t1) == (v1 t2) && (v3 t1) == (v2 t2)
 427       where
 428         t1 = tetrahedron cube 1
 429         t2 = tetrahedron cube 2
 430
 431 prop_t1_shares_edge_with_t19 :: Cube -> Bool
 432 prop_t1_shares_edge_with_t19 cube =
 433     (v2 t1) == (v3 t19) && (v3 t1) == (v2 t19)
 434       where
 435         t1 = tetrahedron cube 1
 436         t19 = tetrahedron cube 19
 437
 438 prop_t2_shares_edge_with_t3 :: Cube -> Bool
 439 prop_t2_shares_edge_with_t3 cube =
 440     (v1 t1) == (v1 t2) && (v3 t1) == (v2 t2)
 441       where
 442         t1 = tetrahedron cube 1
 443         t2 = tetrahedron cube 2
 444
 445 prop_t2_shares_edge_with_t12 :: Cube -> Bool
 446 prop_t2_shares_edge_with_t12 cube =
 447     (v2 t2) == (v3 t12) && (v3 t2) == (v2 t12)
 448       where
 449         t2 = tetrahedron cube 2
 450         t12 = tetrahedron cube 12
 451
 452 prop_t3_shares_edge_with_t21 :: Cube -> Bool
 453 prop_t3_shares_edge_with_t21 cube =
 454     (v2 t3) == (v3 t21) && (v3 t3) == (v2 t21)
 455       where
 456         t3 = tetrahedron cube 3
 457         t21 = tetrahedron cube 21
 458
 459 prop_t4_shares_edge_with_t5 :: Cube -> Bool
 460 prop_t4_shares_edge_with_t5 cube =
 461     (v1 t4) == (v1 t5) && (v3 t4) == (v2 t5)
 462       where
 463         t4 = tetrahedron cube 4
 464         t5 = tetrahedron cube 5
 465
 466 prop_t4_shares_edge_with_t7 :: Cube -> Bool
 467 prop_t4_shares_edge_with_t7 cube =
 468     (v1 t4) == (v1 t7) && (v2 t4) == (v3 t7)
 469       where
 470         t4 = tetrahedron cube 4
 471         t7 = tetrahedron cube 7
 472
 473 prop_t4_shares_edge_with_t10 :: Cube -> Bool
 474 prop_t4_shares_edge_with_t10 cube =
 475     (v2 t4) == (v3 t10) && (v3 t4) == (v2 t10)
 476       where
 477         t4 = tetrahedron cube 4
 478         t10 = tetrahedron cube 10
 479
 480 prop_t5_shares_edge_with_t6 :: Cube -> Bool
 481 prop_t5_shares_edge_with_t6 cube =
 482     (v1 t5) == (v1 t6) && (v3 t5) == (v2 t6)
 483       where
 484         t5 = tetrahedron cube 5
 485         t6 = tetrahedron cube 6
 486
 487 prop_t5_shares_edge_with_t16 :: Cube -> Bool
 488 prop_t5_shares_edge_with_t16 cube =
 489     (v2 t5) == (v3 t16) && (v3 t5) == (v2 t16)
 490       where
 491         t5 = tetrahedron cube 5
 492         t16 = tetrahedron cube 16
 493
 494 prop_t6_shares_edge_with_t7 :: Cube -> Bool
 495 prop_t6_shares_edge_with_t7 cube =
 496     (v1 t6) == (v1 t7) && (v3 t6) == (v2 t7)
 497       where
 498         t6 = tetrahedron cube 6
 499         t7 = tetrahedron cube 7
 500
 501 prop_t7_shares_edge_with_t20 :: Cube -> Bool
 502 prop_t7_shares_edge_with_t20 cube =
 503     (v2 t7) == (v3 t20) && (v2 t7) == (v3 t20)
 504       where
 505         t7 = tetrahedron cube 7
 506         t20 = tetrahedron cube 20