4 import Prelude hiding (LT)
8 import Cube hiding (i, j, k)
10 import Misc (all_equal, disjoint)
11 import Tests.FunctionValues ()
12 import Tetrahedron (b0, b1, b2, b3, c, fv,
13 v0, v1, v2, v3, volume)
18 -- | The 'front_half_tetrahedra' and 'back_half_tetrahedra' should
19 -- have no tetrahedra in common.
20 prop_front_back_tetrahedra_disjoint :: Cube -> Bool
21 prop_front_back_tetrahedra_disjoint c =
22 disjoint (front_half_tetrahedra c) (back_half_tetrahedra c)
25 -- | The 'top_half_tetrahedra' and 'down_half_tetrahedra' should
26 -- have no tetrahedra in common.
27 prop_top_down_tetrahedra_disjoint :: Cube -> Bool
28 prop_top_down_tetrahedra_disjoint c =
29 disjoint (top_half_tetrahedra c) (down_half_tetrahedra c)
32 -- | The 'left_half_tetrahedra' and 'right_half_tetrahedra' should
33 -- have no tetrahedra in common.
34 prop_left_right_tetrahedra_disjoint :: Cube -> Bool
35 prop_left_right_tetrahedra_disjoint c =
36 disjoint (left_half_tetrahedra c) (right_half_tetrahedra c)
39 -- | Since the grid size is necessarily positive, all tetrahedra
40 -- (which comprise cubes of positive volume) must have positive volume
42 prop_all_volumes_positive :: Cube -> Bool
43 prop_all_volumes_positive cube =
44 null nonpositive_volumes
47 volumes = map volume ts
48 nonpositive_volumes = filter (<= 0) volumes
50 -- | In fact, since all of the tetrahedra are identical, we should
51 -- already know their volumes. There's 24 tetrahedra to a cube, so
52 -- we'd expect the volume of each one to be (1/24)*h^3.
53 prop_all_volumes_exact :: Cube -> Bool
54 prop_all_volumes_exact cube =
55 and [volume t ~~= (1/24)*(delta^(3::Int)) | t <- tetrahedra cube]
59 -- | All tetrahedron should have their v0 located at the center of the cube.
60 prop_v0_all_equal :: Cube -> Bool
61 prop_v0_all_equal cube = (v0 t0) == (v0 t1)
63 t0 = head (tetrahedra cube) -- Doesn't matter which two we choose.
64 t1 = head $ tail (tetrahedra cube)
67 -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Note that the
68 -- third and fourth indices of c-t1 have been switched. This is
69 -- because we store the triangles oriented such that their volume is
70 -- positive. If T and T-tilde share \<v0,v1,v2\> and v3,v3-tilde point
71 -- in opposite directions, one of them has to have negative volume!
72 prop_c0120_identity1 :: Cube -> Bool
73 prop_c0120_identity1 cube =
74 c t0 0 1 2 0 ~= (c t0 0 0 2 1 + c t3 0 0 1 2) / 2
76 t0 = tetrahedron0 cube
77 t3 = tetrahedron3 cube
80 -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Repeats
81 -- 'prop_c0120_identity1' with tetrahedrons 1 and 2.
82 prop_c0120_identity2 :: Cube -> Bool
83 prop_c0120_identity2 cube =
84 c t1 0 1 2 0 ~= (c t1 0 0 2 1 + c t0 0 0 1 2) / 2
86 t0 = tetrahedron0 cube
87 t1 = tetrahedron1 cube
89 -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Repeats
90 -- 'prop_c0120_identity1' with tetrahedrons 1 and 2.
91 prop_c0120_identity3 :: Cube -> Bool
92 prop_c0120_identity3 cube =
93 c t2 0 1 2 0 ~= (c t2 0 0 2 1 + c t1 0 0 1 2) / 2
95 t1 = tetrahedron1 cube
96 t2 = tetrahedron2 cube
98 -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Repeats
99 -- 'prop_c0120_identity1' with tetrahedrons 2 and 3.
100 prop_c0120_identity4 :: Cube -> Bool
101 prop_c0120_identity4 cube =
102 c t3 0 1 2 0 ~= (c t3 0 0 2 1 + c t2 0 0 1 2) / 2
104 t2 = tetrahedron2 cube
105 t3 = tetrahedron3 cube
108 -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Repeats
109 -- 'prop_c0120_identity1' with tetrahedrons 4 and 5.
110 prop_c0120_identity5 :: Cube -> Bool
111 prop_c0120_identity5 cube =
112 c t5 0 1 2 0 ~= (c t5 0 0 2 1 + c t4 0 0 1 2) / 2
114 t4 = tetrahedron4 cube
115 t5 = tetrahedron5 cube
117 -- -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Repeats
118 -- -- 'prop_c0120_identity1' with tetrahedrons 5 and 6.
119 prop_c0120_identity6 :: Cube -> Bool
120 prop_c0120_identity6 cube =
121 c t6 0 1 2 0 ~= (c t6 0 0 2 1 + c t5 0 0 1 2) / 2
123 t5 = tetrahedron5 cube
124 t6 = tetrahedron6 cube
127 -- -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Repeats
128 -- -- 'prop_c0120_identity1' with tetrahedrons 6 and 7.
129 prop_c0120_identity7 :: Cube -> Bool
130 prop_c0120_identity7 cube =
131 c t7 0 1 2 0 ~= (c t7 0 0 2 1 + c t6 0 0 1 2) / 2
133 t6 = tetrahedron6 cube
134 t7 = tetrahedron7 cube
137 -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). See
138 -- 'prop_c0120_identity1'.
139 prop_c0210_identity1 :: Cube -> Bool
140 prop_c0210_identity1 cube =
141 c t0 0 2 1 0 ~= (c t0 0 1 1 1 + c t3 0 1 1 1) / 2
143 t0 = tetrahedron0 cube
144 t3 = tetrahedron3 cube
147 -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). See
148 -- 'prop_c0120_identity1'.
149 prop_c0300_identity1 :: Cube -> Bool
150 prop_c0300_identity1 cube =
151 c t0 0 3 0 0 ~= (c t0 0 2 0 1 + c t3 0 2 1 0) / 2
153 t0 = tetrahedron0 cube
154 t3 = tetrahedron3 cube
157 -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). See
158 -- 'prop_c0120_identity1'.
159 prop_c1110_identity :: Cube -> Bool
160 prop_c1110_identity cube =
161 c t0 1 1 1 0 ~= (c t0 1 0 1 1 + c t3 1 0 1 1) / 2
163 t0 = tetrahedron0 cube
164 t3 = tetrahedron3 cube
167 -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). See
168 -- 'prop_c0120_identity1'.
169 prop_c1200_identity1 :: Cube -> Bool
170 prop_c1200_identity1 cube =
171 c t0 1 2 0 0 ~= (c t0 1 1 0 1 + c t3 1 1 1 0) / 2
173 t0 = tetrahedron0 cube
174 t3 = tetrahedron3 cube
177 -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). See
178 -- 'prop_c0120_identity1'.
179 prop_c2100_identity1 :: Cube -> Bool
180 prop_c2100_identity1 cube =
181 c t0 2 1 0 0 ~= (c t0 2 0 0 1 + c t3 2 0 1 0) / 2
183 t0 = tetrahedron0 cube
184 t3 = tetrahedron3 cube
188 -- | Given in Sorokina and Zeilfelder, p. 79, (2.7). Note that the
189 -- third and fourth indices of c-t3 have been switched. This is
190 -- because we store the triangles oriented such that their volume is
191 -- positive. If T and T-tilde share \<v0,v1,v2\> and v3,v3-tilde
192 -- point in opposite directions, one of them has to have negative
194 prop_c0102_identity1 :: Cube -> Bool
195 prop_c0102_identity1 cube =
196 c t0 0 1 0 2 ~= (c t0 0 0 1 2 + c t1 0 0 2 1) / 2
198 t0 = tetrahedron0 cube
199 t1 = tetrahedron1 cube
202 -- | Given in Sorokina and Zeilfelder, p. 79, (2.7). See
203 -- 'prop_c0102_identity1'.
204 prop_c0201_identity1 :: Cube -> Bool
205 prop_c0201_identity1 cube =
206 c t0 0 2 0 1 ~= (c t0 0 1 1 1 + c t1 0 1 1 1) / 2
208 t0 = tetrahedron0 cube
209 t1 = tetrahedron1 cube
212 -- | Given in Sorokina and Zeilfelder, p. 79, (2.7). See
213 -- 'prop_c0102_identity1'.
214 prop_c0300_identity2 :: Cube -> Bool
215 prop_c0300_identity2 cube =
216 c t0 0 3 0 0 ~= (c t0 0 2 1 0 + c t1 0 2 0 1) / 2
218 t0 = tetrahedron0 cube
219 t1 = tetrahedron1 cube
222 -- | Given in Sorokina and Zeilfelder, p. 79, (2.7). See
223 -- 'prop_c0102_identity1'.
224 prop_c1101_identity :: Cube -> Bool
225 prop_c1101_identity cube =
226 c t0 1 1 0 1 ~= (c t0 1 0 1 1 + c t1 1 0 1 1) / 2
228 t0 = tetrahedron0 cube
229 t1 = tetrahedron1 cube
232 -- | Given in Sorokina and Zeilfelder, p. 79, (2.7). See
233 -- 'prop_c0102_identity1'.
234 prop_c1200_identity2 :: Cube -> Bool
235 prop_c1200_identity2 cube =
236 c t0 1 2 0 0 ~= (c t0 1 1 1 0 + c t1 1 1 0 1) / 2
238 t0 = tetrahedron0 cube
239 t1 = tetrahedron1 cube
242 -- | Given in Sorokina and Zeilfelder, p. 79, (2.7). See
243 -- 'prop_c0102_identity1'.
244 prop_c2100_identity2 :: Cube -> Bool
245 prop_c2100_identity2 cube =
246 c t0 2 1 0 0 ~= (c t0 2 0 1 0 + c t1 2 0 0 1) / 2
248 t0 = tetrahedron0 cube
249 t1 = tetrahedron1 cube
252 -- | Given in Sorokina and Zeilfelder, p. 79, (2.8). The third and
253 -- fourth indices of c-t6 have been switched. This is because we
254 -- store the triangles oriented such that their volume is
255 -- positive. If T and T-tilde share \<v0,v1,v2\> and v3,v3-tilde
256 -- point in opposite directions, one of them has to have negative
258 prop_c3000_identity :: Cube -> Bool
259 prop_c3000_identity cube =
260 c t0 3 0 0 0 ~= c t0 2 1 0 0 + c t6 2 1 0 0
261 - ((c t0 2 0 1 0 + c t0 2 0 0 1)/ 2)
263 t0 = tetrahedron0 cube
264 t6 = tetrahedron6 cube
267 -- | Given in Sorokina and Zeilfelder, p. 79, (2.8). See
268 -- 'prop_c3000_identity'.
269 prop_c2010_identity :: Cube -> Bool
270 prop_c2010_identity cube =
271 c t0 2 0 1 0 ~= c t0 1 1 1 0 + c t6 1 1 0 1
272 - ((c t0 1 0 2 0 + c t0 1 0 1 1)/ 2)
274 t0 = tetrahedron0 cube
275 t6 = tetrahedron6 cube
278 -- | Given in Sorokina and Zeilfelder, p. 79, (2.8). See
279 -- 'prop_c3000_identity'.
280 prop_c2001_identity :: Cube -> Bool
281 prop_c2001_identity cube =
282 c t0 2 0 0 1 ~= c t0 1 1 0 1 + c t6 1 1 1 0
283 - ((c t0 1 0 0 2 + c t0 1 0 1 1)/ 2)
285 t0 = tetrahedron0 cube
286 t6 = tetrahedron6 cube
289 -- | Given in Sorokina and Zeilfelder, p. 79, (2.8). See
290 -- 'prop_c3000_identity'.
291 prop_c1020_identity :: Cube -> Bool
292 prop_c1020_identity cube =
293 c t0 1 0 2 0 ~= c t0 0 1 2 0 + c t6 0 1 0 2
294 - ((c t0 0 0 3 0 + c t0 0 0 2 1)/ 2)
296 t0 = tetrahedron0 cube
297 t6 = tetrahedron6 cube
300 -- | Given in Sorokina and Zeilfelder, p. 79, (2.8). See
301 -- 'prop_c3000_identity'.
302 prop_c1002_identity :: Cube -> Bool
303 prop_c1002_identity cube =
304 c t0 1 0 0 2 ~= c t0 0 1 0 2 + c t6 0 1 2 0
305 - ((c t0 0 0 0 3 + c t0 0 0 1 2)/ 2)
307 t0 = tetrahedron0 cube
308 t6 = tetrahedron6 cube
311 -- | Given in Sorokina and Zeilfelder, p. 79, (2.8). See
312 -- 'prop_c3000_identity'.
313 prop_c1011_identity :: Cube -> Bool
314 prop_c1011_identity cube =
315 c t0 1 0 1 1 ~= c t0 0 1 1 1 + c t6 0 1 1 1 -
316 ((c t0 0 0 1 2 + c t0 0 0 2 1)/ 2)
318 t0 = tetrahedron0 cube
319 t6 = tetrahedron6 cube
323 -- | Given in Sorokina and Zeilfelder, p. 78.
324 prop_cijk1_identity :: Cube -> Bool
325 prop_cijk1_identity cube =
326 and [ c t0 i j k 1 ~=
327 (c t1 (i+1) j k 0) * ((b0 t0) (v3 t1)) +
328 (c t1 i (j+1) k 0) * ((b1 t0) (v3 t1)) +
329 (c t1 i j (k+1) 0) * ((b2 t0) (v3 t1)) +
330 (c t1 i j k 1) * ((b3 t0) (v3 t1)) | i <- [0..2],
335 t0 = tetrahedron0 cube
336 t1 = tetrahedron1 cube
339 -- | The function values at the interior should be the same for all tetrahedra.
340 prop_interior_values_all_identical :: Cube -> Bool
341 prop_interior_values_all_identical cube =
342 all_equal [i0, i1, i2, i3, i4, i5, i6, i7, i8,
343 i9, i10, i11, i12, i13, i14, i15, i16,
344 i17, i18, i19, i20, i21, i22, i23]
346 i0 = eval (Tetrahedron.fv (tetrahedron0 cube)) I
347 i1 = eval (Tetrahedron.fv (tetrahedron1 cube)) I
348 i2 = eval (Tetrahedron.fv (tetrahedron2 cube)) I
349 i3 = eval (Tetrahedron.fv (tetrahedron3 cube)) I
350 i4 = eval (Tetrahedron.fv (tetrahedron4 cube)) I
351 i5 = eval (Tetrahedron.fv (tetrahedron5 cube)) I
352 i6 = eval (Tetrahedron.fv (tetrahedron6 cube)) I
353 i7 = eval (Tetrahedron.fv (tetrahedron7 cube)) I
354 i8 = eval (Tetrahedron.fv (tetrahedron8 cube)) I
355 i9 = eval (Tetrahedron.fv (tetrahedron9 cube)) I
356 i10 = eval (Tetrahedron.fv (tetrahedron10 cube)) I
357 i11 = eval (Tetrahedron.fv (tetrahedron11 cube)) I
358 i12 = eval (Tetrahedron.fv (tetrahedron12 cube)) I
359 i13 = eval (Tetrahedron.fv (tetrahedron13 cube)) I
360 i14 = eval (Tetrahedron.fv (tetrahedron14 cube)) I
361 i15 = eval (Tetrahedron.fv (tetrahedron15 cube)) I
362 i16 = eval (Tetrahedron.fv (tetrahedron16 cube)) I
363 i17 = eval (Tetrahedron.fv (tetrahedron17 cube)) I
364 i18 = eval (Tetrahedron.fv (tetrahedron18 cube)) I
365 i19 = eval (Tetrahedron.fv (tetrahedron19 cube)) I
366 i20 = eval (Tetrahedron.fv (tetrahedron20 cube)) I
367 i21 = eval (Tetrahedron.fv (tetrahedron21 cube)) I
368 i22 = eval (Tetrahedron.fv (tetrahedron22 cube)) I
369 i23 = eval (Tetrahedron.fv (tetrahedron23 cube)) I
372 -- | We know what (c t6 2 1 0 0) should be from Sorokina and Zeilfelder, p. 87.
373 -- This test checks the rotation works as expected.
374 prop_c_tilde_2100_rotation_correct :: Cube -> Bool
375 prop_c_tilde_2100_rotation_correct cube =
378 t0 = tetrahedron0 cube
379 t6 = tetrahedron6 cube
381 -- What gets computed for c2100 of t6.
382 expr1 = eval (Tetrahedron.fv t6) $
384 (1/12)*(T + R + L + D) +
385 (1/64)*(FT + FR + FL + FD) +
388 (1/96)*(RT + LD + LT + RD) +
389 (1/192)*(BT + BR + BL + BD)
391 -- What should be computed for c2100 of t6.
392 expr2 = eval (Tetrahedron.fv t0) $
394 (1/12)*(F + R + L + B) +
395 (1/64)*(FT + RT + LT + BT) +
398 (1/96)*(FR + FL + BR + BL) +
399 (1/192)*(FD + RD + LD + BD)
402 -- | We know what (c t6 2 1 0 0) should be from Sorokina and Zeilfelder, p. 87.
403 -- This test checks the actual value based on the FunctionValues of the cube.
404 prop_c_tilde_2100_correct :: Cube -> Bool
405 prop_c_tilde_2100_correct cube =
406 c t6 2 1 0 0 == (3/8)*int
407 + (1/12)*(f + r + l + b)
408 + (1/64)*(ft + rt + lt + bt)
409 + (7/48)*t + (1/48)*d + (1/96)*(fr + fl + br + bl)
410 + (1/192)*(fd + rd + ld + bd)
412 t0 = tetrahedron0 cube
413 t6 = tetrahedron6 cube
414 fvs = Tetrahedron.fv t0
435 -- Tests to check that the correct edges are incidental.
436 prop_t0_shares_edge_with_t1 :: Cube -> Bool
437 prop_t0_shares_edge_with_t1 cube =
438 (v1 t0) == (v1 t1) && (v3 t0) == (v2 t1)
440 t0 = tetrahedron0 cube
441 t1 = tetrahedron1 cube
443 prop_t0_shares_edge_with_t3 :: Cube -> Bool
444 prop_t0_shares_edge_with_t3 cube =
445 (v1 t0) == (v1 t3) && (v2 t0) == (v3 t3)
447 t0 = tetrahedron0 cube
448 t3 = tetrahedron3 cube
450 prop_t0_shares_edge_with_t6 :: Cube -> Bool
451 prop_t0_shares_edge_with_t6 cube =
452 (v2 t0) == (v3 t6) && (v3 t0) == (v2 t6)
454 t0 = tetrahedron0 cube
455 t6 = tetrahedron6 cube
457 prop_t1_shares_edge_with_t2 :: Cube -> Bool
458 prop_t1_shares_edge_with_t2 cube =
459 (v1 t1) == (v1 t2) && (v3 t1) == (v2 t2)
461 t1 = tetrahedron1 cube
462 t2 = tetrahedron2 cube
464 prop_t1_shares_edge_with_t19 :: Cube -> Bool
465 prop_t1_shares_edge_with_t19 cube =
466 (v2 t1) == (v3 t19) && (v3 t1) == (v2 t19)
468 t1 = tetrahedron1 cube
469 t19 = tetrahedron19 cube
471 prop_t2_shares_edge_with_t3 :: Cube -> Bool
472 prop_t2_shares_edge_with_t3 cube =
473 (v1 t1) == (v1 t2) && (v3 t1) == (v2 t2)
475 t1 = tetrahedron1 cube
476 t2 = tetrahedron2 cube
478 prop_t2_shares_edge_with_t12 :: Cube -> Bool
479 prop_t2_shares_edge_with_t12 cube =
480 (v2 t2) == (v3 t12) && (v3 t2) == (v2 t12)
482 t2 = tetrahedron2 cube
483 t12 = tetrahedron12 cube
485 prop_t3_shares_edge_with_t21 :: Cube -> Bool
486 prop_t3_shares_edge_with_t21 cube =
487 (v2 t3) == (v3 t21) && (v3 t3) == (v2 t21)
489 t3 = tetrahedron3 cube
490 t21 = tetrahedron21 cube
492 prop_t4_shares_edge_with_t5 :: Cube -> Bool
493 prop_t4_shares_edge_with_t5 cube =
494 (v1 t4) == (v1 t5) && (v3 t4) == (v2 t5)
496 t4 = tetrahedron4 cube
497 t5 = tetrahedron5 cube
499 prop_t4_shares_edge_with_t7 :: Cube -> Bool
500 prop_t4_shares_edge_with_t7 cube =
501 (v1 t4) == (v1 t7) && (v2 t4) == (v3 t7)
503 t4 = tetrahedron4 cube
504 t7 = tetrahedron7 cube
506 prop_t4_shares_edge_with_t10 :: Cube -> Bool
507 prop_t4_shares_edge_with_t10 cube =
508 (v2 t4) == (v3 t10) && (v3 t4) == (v2 t10)
510 t4 = tetrahedron4 cube
511 t10 = tetrahedron10 cube
513 prop_t5_shares_edge_with_t6 :: Cube -> Bool
514 prop_t5_shares_edge_with_t6 cube =
515 (v1 t5) == (v1 t6) && (v3 t5) == (v2 t6)
517 t5 = tetrahedron5 cube
518 t6 = tetrahedron6 cube
520 prop_t5_shares_edge_with_t16 :: Cube -> Bool
521 prop_t5_shares_edge_with_t16 cube =
522 (v2 t5) == (v3 t16) && (v3 t5) == (v2 t16)
524 t5 = tetrahedron5 cube
525 t16 = tetrahedron16 cube
527 prop_t6_shares_edge_with_t7 :: Cube -> Bool
528 prop_t6_shares_edge_with_t7 cube =
529 (v1 t6) == (v1 t7) && (v3 t6) == (v2 t7)
531 t6 = tetrahedron6 cube
532 t7 = tetrahedron7 cube
534 prop_t7_shares_edge_with_t20 :: Cube -> Bool
535 prop_t7_shares_edge_with_t20 cube =
536 (v2 t7) == (v3 t20) && (v2 t7) == (v3 t20)
538 t7 = tetrahedron7 cube
539 t20 = tetrahedron20 cube