+test_zeros_reproduced :: Assertion
+test_zeros_reproduced =
+ assertTrue "the zero function is reproduced correctly" $
+ and [p (i', j', k') ~= value_at zeros i j k
+ | i <- [0..2],
+ j <- [0..2],
+ k <- [0..2],
+ let i' = fromIntegral i,
+ let j' = fromIntegral j,
+ let k' = fromIntegral k,
+ c0 <- cs,
+ t0 <- tetrahedra c0,
+ let p = polynomial t0 ]
+ where
+ g = make_grid 1 zeros
+ cs = [ cube_at g ci cj ck | ci <- [0..2], cj <- [0..2], ck <- [0..2] ]
+
+
+-- | Make sure we can reproduce a 9x9x9 trilinear from the 3x3x3 one.
+test_trilinear9x9x9_reproduced :: Assertion
+test_trilinear9x9x9_reproduced =
+ assertTrue "trilinear 9x9x9 is reproduced correctly" $
+ and [p (i', j', k') ~= value_at trilinear9x9x9 i j k
+ | i <- [0..8],
+ j <- [0..8],
+ k <- [0..8],
+ t <- tetrahedra c0,
+ let p = polynomial t,
+ let i' = (fromIntegral i) * 0.5,
+ let j' = (fromIntegral j) * 0.5,
+ let k' = (fromIntegral k) * 0.5]
+ where
+ g = make_grid 1 trilinear
+ c0 = cube_at g 1 1 1
+
+
+-- | The point 'p' in this test lies on the boundary of tetrahedra 12 and 15.
+-- However, the 'contains_point' test fails due to some numerical innacuracy.
+-- This bug should have been fixed by setting a positive tolerance level.
+--
+-- Example from before the fix:
+--
+-- b1 (tetrahedron c 20) (0, 17.5, 0.5)
+-- -0.0
+--
+test_tetrahedra_collision_sensitivity :: Assertion
+test_tetrahedra_collision_sensitivity =
+ assertTrue "tetrahedron collision tests isn't too sensitive" $
+ contains_point t20 p
+ where
+ g = make_grid 1 naturals_1d
+ cube = cube_at g 0 18 0
+ p = (0, 17.5, 0.5) :: Point
+ t20 = tetrahedron cube 20
+
+
+prop_cube_indices_never_go_out_of_bounds :: Grid -> Gen Bool
+prop_cube_indices_never_go_out_of_bounds g =
+ do
+ let delta = Grid.h g
+ let coordmin = negate (delta/2)
+
+ let (xsize, ysize, zsize) = dims $ function_values g
+ let xmax = delta*(fromIntegral xsize) - (delta/2)
+ let ymax = delta*(fromIntegral ysize) - (delta/2)
+ let zmax = delta*(fromIntegral zsize) - (delta/2)
+
+ x <- choose (coordmin, xmax)
+ y <- choose (coordmin, ymax)
+ z <- choose (coordmin, zmax)
+
+ let idx_x = calculate_containing_cube_coordinate g x
+ let idx_y = calculate_containing_cube_coordinate g y
+ let idx_z = calculate_containing_cube_coordinate g z
+
+ return $
+ idx_x >= 0 &&
+ idx_x <= xsize - 1 &&
+ idx_y >= 0 &&
+ idx_y <= ysize - 1 &&
+ idx_z >= 0 &&
+ idx_z <= zsize - 1
+
+
+-- | Given in Sorokina and Zeilfelder, p. 80, (2.9). Note that the
+-- third and fourth indices of c-t10 have been switched. This is
+-- because we store the triangles oriented such that their volume is
+-- positive. If T and T-tilde share \<v1,v2,v3\> and v0,v0-tilde point
+-- in opposite directions, one of them has to have negative volume!
+prop_c0120_identity :: Grid -> Property
+prop_c0120_identity g =
+ and [xsize >= 3, ysize >= 3, zsize >= 3] ==>
+ c t0 0 1 2 0 ~= (c t0 1 0 2 0 + c t10 1 0 0 2) / 2
+ where
+ fvs = function_values g
+ (xsize, ysize, zsize) = dims fvs
+ cube0 = cube_at g 1 1 1
+ cube1 = cube_at g 0 1 1
+ t0 = tetrahedron cube0 0 -- These two tetrahedra share a face.
+ t10 = tetrahedron cube1 10
+
+
+-- | Given in Sorokina and Zeilfelder, p. 80, (2.9). See
+-- 'prop_c0120_identity'.
+prop_c0111_identity :: Grid -> Property
+prop_c0111_identity g =
+ and [xsize >= 3, ysize >= 3, zsize >= 3] ==>
+ c t0 0 1 1 1 ~= (c t0 1 0 1 1 + c t10 1 0 1 1) / 2
+ where
+ fvs = function_values g
+ (xsize, ysize, zsize) = dims fvs
+ cube0 = cube_at g 1 1 1
+ cube1 = cube_at g 0 1 1
+ t0 = tetrahedron cube0 0 -- These two tetrahedra share a face.
+ t10 = tetrahedron cube1 10
+
+
+-- | Given in Sorokina and Zeilfelder, p. 80, (2.9). See
+-- 'prop_c0120_identity'.
+prop_c0201_identity :: Grid -> Property
+prop_c0201_identity g =
+ and [xsize >= 3, ysize >= 3, zsize >= 3] ==>
+ c t0 0 2 0 1 ~= (c t0 1 1 0 1 + c t10 1 1 1 0) / 2
+ where
+ fvs = function_values g
+ (xsize, ysize, zsize) = dims fvs
+ cube0 = cube_at g 1 1 1
+ cube1 = cube_at g 0 1 1
+ t0 = tetrahedron cube0 0 -- These two tetrahedra share a face.
+ t10 = tetrahedron cube1 10
+
+
+-- | Given in Sorokina and Zeilfelder, p. 80, (2.9). See
+-- 'prop_c0120_identity'.
+prop_c0102_identity :: Grid -> Property
+prop_c0102_identity g =
+ and [xsize >= 3, ysize >= 3, zsize >= 3] ==>
+ c t0 0 1 0 2 ~= (c t0 1 0 0 2 + c t10 1 0 2 0) / 2
+ where
+ fvs = function_values g
+ (xsize, ysize, zsize) = dims fvs
+ cube0 = cube_at g 1 1 1
+ cube1 = cube_at g 0 1 1
+ t0 = tetrahedron cube0 0 -- These two tetrahedra share a face.
+ t10 = tetrahedron cube1 10
+
+
+-- | Given in Sorokina and Zeilfelder, p. 80, (2.9). See
+-- 'prop_c0120_identity'.
+prop_c0210_identity :: Grid -> Property
+prop_c0210_identity g =
+ and [xsize >= 3, ysize >= 3, zsize >= 3] ==>
+ c t0 0 2 1 0 ~= (c t0 1 1 1 0 + c t10 1 1 0 1) / 2
+ where
+ fvs = function_values g
+ (xsize, ysize, zsize) = dims fvs
+ cube0 = cube_at g 1 1 1
+ cube1 = cube_at g 0 1 1
+ t0 = tetrahedron cube0 0 -- These two tetrahedra share a face.
+ t10 = tetrahedron cube1 10
+
+
+-- | Given in Sorokina and Zeilfelder, p. 80, (2.9). See
+-- 'prop_c0120_identity'.
+prop_c0300_identity :: Grid -> Property
+prop_c0300_identity g =
+ and [xsize >= 3, ysize >= 3, zsize >= 3] ==>
+ c t0 0 3 0 0 ~= (c t0 1 2 0 0 + c t10 1 2 0 0) / 2
+ where
+ fvs = function_values g
+ (xsize, ysize, zsize) = dims fvs
+ cube0 = cube_at g 1 1 1
+ cube1 = cube_at g 0 1 1
+ t0 = tetrahedron cube0 0 -- These two tetrahedra share a face.
+ t10 = tetrahedron cube1 10
+
+
+-- | All of the properties from Section (2.9), p. 80. These require a
+-- grid since they refer to two adjacent cubes.
+p80_29_properties :: Test.Framework.Test
+p80_29_properties =
+ testGroup "p. 80, Section (2.9) Properties" [
+ testProperty "c0120 identity" prop_c0120_identity,
+ testProperty "c0111 identity" prop_c0111_identity,
+ testProperty "c0201 identity" prop_c0201_identity,
+ testProperty "c0102 identity" prop_c0102_identity,
+ testProperty "c0210 identity" prop_c0210_identity,
+ testProperty "c0300 identity" prop_c0300_identity ]
+
+
+grid_tests :: Test.Framework.Test
+grid_tests =
+ testGroup "Grid Tests" [
+ trilinear_c0_t0_tests,
+ p80_29_properties,
+ testCase "tetrahedra collision test isn't too sensitive"
+ test_tetrahedra_collision_sensitivity,
+ testProperty "cube indices within bounds"
+ prop_cube_indices_never_go_out_of_bounds ]
+
+
+-- Do the slow tests last so we can stop paying attention.
+slow_tests :: Test.Framework.Test
+slow_tests =
+ testGroup "Slow Tests" [
+ testCase "trilinear reproduced" test_trilinear_reproduced,
+ testCase "trilinear9x9x9 reproduced" test_trilinear9x9x9_reproduced,
+ testCase "zeros reproduced" test_zeros_reproduced ]