From: Michael Orlitzky Date: Tue, 20 Sep 2011 17:11:39 +0000 (-0400) Subject: Rename Tetrahedron.fv to Tetrahedron.function_values. X-Git-Tag: 0.0.1~128 X-Git-Url: https://gitweb.michael.orlitzky.com/?a=commitdiff_plain;h=3a954903101eca7594a65824868517b9758e188d;p=spline3.git Rename Tetrahedron.fv to Tetrahedron.function_values. Move all of the Cube tests into the Cube module. Re-enable that failing test. --- diff --git a/src/Cube.hs b/src/Cube.hs index 3c202a7..d3f5151 100644 --- a/src/Cube.hs +++ b/src/Cube.hs @@ -1,4 +1,10 @@ -module Cube +module Cube ( + Cube(..), + cube_properties, + find_containing_tetrahedron, + tetrahedra, + tetrahedron + ) where import Data.Maybe (fromJust) @@ -11,13 +17,26 @@ import qualified Data.Vector as V ( snoc, unsafeIndex ) +import Prelude hiding (LT) +import Test.Framework (Test, testGroup) +import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.QuickCheck (Arbitrary(..), Gen, Positive(..), choose) import Cardinal +import Comparisons ((~=), (~~=)) import qualified Face (Face(Face, v0, v1, v2, v3)) import FunctionValues +import Misc (all_equal, disjoint) import Point -import Tetrahedron (Tetrahedron(Tetrahedron)) +import Tetrahedron ( + Tetrahedron(..), + c, + b0, + b1, + b2, + b3, + volume + ) import ThreeDimensional data Cube = Cube { h :: Double, @@ -211,7 +230,7 @@ right_face c = Face.Face v0' v1' v2' v3' tetrahedron :: Cube -> Int -> Tetrahedron tetrahedron c 0 = - Tetrahedron (Cube.fv c) v0' v1' v2' v3' vol + Tetrahedron (fv c) v0' v1' v2' v3' vol where v0' = center c v1' = center (front_face c) @@ -226,7 +245,7 @@ tetrahedron c 1 = v1' = center (front_face c) v2' = Face.v1 (front_face c) v3' = Face.v2 (front_face c) - fv' = rotate ccwx (Cube.fv c) + fv' = rotate ccwx (fv c) vol = tetrahedra_volume c tetrahedron c 2 = @@ -236,7 +255,7 @@ tetrahedron c 2 = v1' = center (front_face c) v2' = Face.v2 (front_face c) v3' = Face.v3 (front_face c) - fv' = rotate ccwx $ rotate ccwx $ Cube.fv c + fv' = rotate ccwx $ rotate ccwx $ fv c vol = tetrahedra_volume c tetrahedron c 3 = @@ -246,7 +265,7 @@ tetrahedron c 3 = v1' = center (front_face c) v2' = Face.v3 (front_face c) v3' = Face.v0 (front_face c) - fv' = rotate cwx (Cube.fv c) + fv' = rotate cwx (fv c) vol = tetrahedra_volume c tetrahedron c 4 = @@ -256,7 +275,7 @@ tetrahedron c 4 = v1' = center (top_face c) v2' = Face.v0 (top_face c) v3' = Face.v1 (top_face c) - fv' = rotate cwy (Cube.fv c) + fv' = rotate cwy (fv c) vol = tetrahedra_volume c tetrahedron c 5 = @@ -623,3 +642,599 @@ find_containing_tetrahedron c p = lucky_idx = V.findIndex (\t -> (center t) `dot` p == shortest_distance) candidates + + + + + + +-- Tests + +-- Quickcheck tests. + +prop_opposite_octant_tetrahedra_disjoint1 :: Cube -> Bool +prop_opposite_octant_tetrahedra_disjoint1 c = + disjoint (front_left_top_tetrahedra c) (front_right_down_tetrahedra c) + +prop_opposite_octant_tetrahedra_disjoint2 :: Cube -> Bool +prop_opposite_octant_tetrahedra_disjoint2 c = + disjoint (back_left_top_tetrahedra c) (back_right_down_tetrahedra c) + +prop_opposite_octant_tetrahedra_disjoint3 :: Cube -> Bool +prop_opposite_octant_tetrahedra_disjoint3 c = + disjoint (front_left_top_tetrahedra c) (back_right_top_tetrahedra c) + +prop_opposite_octant_tetrahedra_disjoint4 :: Cube -> Bool +prop_opposite_octant_tetrahedra_disjoint4 c = + disjoint (front_left_down_tetrahedra c) (back_right_down_tetrahedra c) + +prop_opposite_octant_tetrahedra_disjoint5 :: Cube -> Bool +prop_opposite_octant_tetrahedra_disjoint5 c = + disjoint (front_left_top_tetrahedra c) (back_left_down_tetrahedra c) + +prop_opposite_octant_tetrahedra_disjoint6 :: Cube -> Bool +prop_opposite_octant_tetrahedra_disjoint6 c = + disjoint (front_right_top_tetrahedra c) (back_right_down_tetrahedra c) + + +-- | Since the grid size is necessarily positive, all tetrahedra +-- (which comprise cubes of positive volume) must have positive volume +-- as well. +prop_all_volumes_positive :: Cube -> Bool +prop_all_volumes_positive cube = + null nonpositive_volumes + where + ts = tetrahedra cube + volumes = map volume ts + nonpositive_volumes = filter (<= 0) volumes + +-- | In fact, since all of the tetrahedra are identical, we should +-- already know their volumes. There's 24 tetrahedra to a cube, so +-- we'd expect the volume of each one to be (1/24)*h^3. +prop_all_volumes_exact :: Cube -> Bool +prop_all_volumes_exact cube = + and [volume t ~~= (1/24)*(delta^(3::Int)) | t <- tetrahedra cube] + where + delta = h cube + +-- | All tetrahedron should have their v0 located at the center of the cube. +prop_v0_all_equal :: Cube -> Bool +prop_v0_all_equal cube = (v0 t0) == (v0 t1) + where + t0 = head (tetrahedra cube) -- Doesn't matter which two we choose. + t1 = head $ tail (tetrahedra cube) + + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Note that the +-- third and fourth indices of c-t1 have been switched. This is +-- because we store the triangles oriented such that their volume is +-- positive. If T and T-tilde share \ and v3,v3-tilde point +-- in opposite directions, one of them has to have negative volume! +prop_c0120_identity1 :: Cube -> Bool +prop_c0120_identity1 cube = + c t0 0 1 2 0 ~= (c t0 0 0 2 1 + c t3 0 0 1 2) / 2 + where + t0 = tetrahedron cube 0 + t3 = tetrahedron cube 3 + + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Repeats +-- 'prop_c0120_identity1' with tetrahedrons 1 and 2. +prop_c0120_identity2 :: Cube -> Bool +prop_c0120_identity2 cube = + c t1 0 1 2 0 ~= (c t1 0 0 2 1 + c t0 0 0 1 2) / 2 + where + t0 = tetrahedron cube 0 + t1 = tetrahedron cube 1 + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Repeats +-- 'prop_c0120_identity1' with tetrahedrons 1 and 2. +prop_c0120_identity3 :: Cube -> Bool +prop_c0120_identity3 cube = + c t2 0 1 2 0 ~= (c t2 0 0 2 1 + c t1 0 0 1 2) / 2 + where + t1 = tetrahedron cube 1 + t2 = tetrahedron cube 2 + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Repeats +-- 'prop_c0120_identity1' with tetrahedrons 2 and 3. +prop_c0120_identity4 :: Cube -> Bool +prop_c0120_identity4 cube = + c t3 0 1 2 0 ~= (c t3 0 0 2 1 + c t2 0 0 1 2) / 2 + where + t2 = tetrahedron cube 2 + t3 = tetrahedron cube 3 + + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Repeats +-- 'prop_c0120_identity1' with tetrahedrons 4 and 5. +prop_c0120_identity5 :: Cube -> Bool +prop_c0120_identity5 cube = + c t5 0 1 2 0 ~= (c t5 0 0 2 1 + c t4 0 0 1 2) / 2 + where + t4 = tetrahedron cube 4 + t5 = tetrahedron cube 5 + +-- -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Repeats +-- -- 'prop_c0120_identity1' with tetrahedrons 5 and 6. +prop_c0120_identity6 :: Cube -> Bool +prop_c0120_identity6 cube = + c t6 0 1 2 0 ~= (c t6 0 0 2 1 + c t5 0 0 1 2) / 2 + where + t5 = tetrahedron cube 5 + t6 = tetrahedron cube 6 + + +-- -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Repeats +-- -- 'prop_c0120_identity1' with tetrahedrons 6 and 7. +prop_c0120_identity7 :: Cube -> Bool +prop_c0120_identity7 cube = + c t7 0 1 2 0 ~= (c t7 0 0 2 1 + c t6 0 0 1 2) / 2 + where + t6 = tetrahedron cube 6 + t7 = tetrahedron cube 7 + + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.6). See +-- 'prop_c0120_identity1'. +prop_c0210_identity1 :: Cube -> Bool +prop_c0210_identity1 cube = + c t0 0 2 1 0 ~= (c t0 0 1 1 1 + c t3 0 1 1 1) / 2 + where + t0 = tetrahedron cube 0 + t3 = tetrahedron cube 3 + + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.6). See +-- 'prop_c0120_identity1'. +prop_c0300_identity1 :: Cube -> Bool +prop_c0300_identity1 cube = + c t0 0 3 0 0 ~= (c t0 0 2 0 1 + c t3 0 2 1 0) / 2 + where + t0 = tetrahedron cube 0 + t3 = tetrahedron cube 3 + + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.6). See +-- 'prop_c0120_identity1'. +prop_c1110_identity :: Cube -> Bool +prop_c1110_identity cube = + c t0 1 1 1 0 ~= (c t0 1 0 1 1 + c t3 1 0 1 1) / 2 + where + t0 = tetrahedron cube 0 + t3 = tetrahedron cube 3 + + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.6). See +-- 'prop_c0120_identity1'. +prop_c1200_identity1 :: Cube -> Bool +prop_c1200_identity1 cube = + c t0 1 2 0 0 ~= (c t0 1 1 0 1 + c t3 1 1 1 0) / 2 + where + t0 = tetrahedron cube 0 + t3 = tetrahedron cube 3 + + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.6). See +-- 'prop_c0120_identity1'. +prop_c2100_identity1 :: Cube -> Bool +prop_c2100_identity1 cube = + c t0 2 1 0 0 ~= (c t0 2 0 0 1 + c t3 2 0 1 0) / 2 + where + t0 = tetrahedron cube 0 + t3 = tetrahedron cube 3 + + + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.7). Note that the +-- third and fourth indices of c-t3 have been switched. This is +-- because we store the triangles oriented such that their volume is +-- positive. If T and T-tilde share \ and v3,v3-tilde +-- point in opposite directions, one of them has to have negative +-- volume! +prop_c0102_identity1 :: Cube -> Bool +prop_c0102_identity1 cube = + c t0 0 1 0 2 ~= (c t0 0 0 1 2 + c t1 0 0 2 1) / 2 + where + t0 = tetrahedron cube 0 + t1 = tetrahedron cube 1 + + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.7). See +-- 'prop_c0102_identity1'. +prop_c0201_identity1 :: Cube -> Bool +prop_c0201_identity1 cube = + c t0 0 2 0 1 ~= (c t0 0 1 1 1 + c t1 0 1 1 1) / 2 + where + t0 = tetrahedron cube 0 + t1 = tetrahedron cube 1 + + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.7). See +-- 'prop_c0102_identity1'. +prop_c0300_identity2 :: Cube -> Bool +prop_c0300_identity2 cube = + c t0 0 3 0 0 ~= (c t0 0 2 1 0 + c t1 0 2 0 1) / 2 + where + t0 = tetrahedron cube 0 + t1 = tetrahedron cube 1 + + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.7). See +-- 'prop_c0102_identity1'. +prop_c1101_identity :: Cube -> Bool +prop_c1101_identity cube = + c t0 1 1 0 1 ~= (c t0 1 0 1 1 + c t1 1 0 1 1) / 2 + where + t0 = tetrahedron cube 0 + t1 = tetrahedron cube 1 + + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.7). See +-- 'prop_c0102_identity1'. +prop_c1200_identity2 :: Cube -> Bool +prop_c1200_identity2 cube = + c t0 1 2 0 0 ~= (c t0 1 1 1 0 + c t1 1 1 0 1) / 2 + where + t0 = tetrahedron cube 0 + t1 = tetrahedron cube 1 + + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.7). See +-- 'prop_c0102_identity1'. +prop_c2100_identity2 :: Cube -> Bool +prop_c2100_identity2 cube = + c t0 2 1 0 0 ~= (c t0 2 0 1 0 + c t1 2 0 0 1) / 2 + where + t0 = tetrahedron cube 0 + t1 = tetrahedron cube 1 + + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.8). The third and +-- fourth indices of c-t6 have been switched. This is because we +-- store the triangles oriented such that their volume is +-- positive. If T and T-tilde share \ and v3,v3-tilde +-- point in opposite directions, one of them has to have negative +-- volume! +prop_c3000_identity :: Cube -> Bool +prop_c3000_identity cube = + c t0 3 0 0 0 ~= c t0 2 1 0 0 + c t6 2 1 0 0 + - ((c t0 2 0 1 0 + c t0 2 0 0 1)/ 2) + where + t0 = tetrahedron cube 0 + t6 = tetrahedron cube 6 + + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.8). See +-- 'prop_c3000_identity'. +prop_c2010_identity :: Cube -> Bool +prop_c2010_identity cube = + c t0 2 0 1 0 ~= c t0 1 1 1 0 + c t6 1 1 0 1 + - ((c t0 1 0 2 0 + c t0 1 0 1 1)/ 2) + where + t0 = tetrahedron cube 0 + t6 = tetrahedron cube 6 + + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.8). See +-- 'prop_c3000_identity'. +prop_c2001_identity :: Cube -> Bool +prop_c2001_identity cube = + c t0 2 0 0 1 ~= c t0 1 1 0 1 + c t6 1 1 1 0 + - ((c t0 1 0 0 2 + c t0 1 0 1 1)/ 2) + where + t0 = tetrahedron cube 0 + t6 = tetrahedron cube 6 + + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.8). See +-- 'prop_c3000_identity'. +prop_c1020_identity :: Cube -> Bool +prop_c1020_identity cube = + c t0 1 0 2 0 ~= c t0 0 1 2 0 + c t6 0 1 0 2 + - ((c t0 0 0 3 0 + c t0 0 0 2 1)/ 2) + where + t0 = tetrahedron cube 0 + t6 = tetrahedron cube 6 + + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.8). See +-- 'prop_c3000_identity'. +prop_c1002_identity :: Cube -> Bool +prop_c1002_identity cube = + c t0 1 0 0 2 ~= c t0 0 1 0 2 + c t6 0 1 2 0 + - ((c t0 0 0 0 3 + c t0 0 0 1 2)/ 2) + where + t0 = tetrahedron cube 0 + t6 = tetrahedron cube 6 + + +-- | Given in Sorokina and Zeilfelder, p. 79, (2.8). See +-- 'prop_c3000_identity'. +prop_c1011_identity :: Cube -> Bool +prop_c1011_identity cube = + c t0 1 0 1 1 ~= c t0 0 1 1 1 + c t6 0 1 1 1 - + ((c t0 0 0 1 2 + c t0 0 0 2 1)/ 2) + where + t0 = tetrahedron cube 0 + t6 = tetrahedron cube 6 + + + +-- | Given in Sorokina and Zeilfelder, p. 78. +prop_cijk1_identity :: Cube -> Bool +prop_cijk1_identity cube = + and [ c t0 i j k 1 ~= + (c t1 (i+1) j k 0) * ((b0 t0) (v3 t1)) + + (c t1 i (j+1) k 0) * ((b1 t0) (v3 t1)) + + (c t1 i j (k+1) 0) * ((b2 t0) (v3 t1)) + + (c t1 i j k 1) * ((b3 t0) (v3 t1)) | i <- [0..2], + j <- [0..2], + k <- [0..2], + i + j + k == 2] + where + t0 = tetrahedron cube 0 + t1 = tetrahedron cube 1 + + +-- | The function values at the interior should be the same for all +-- tetrahedra. +prop_interior_values_all_identical :: Cube -> Bool +prop_interior_values_all_identical cube = + all_equal [ eval (function_values tet) I | tet <- tetrahedra cube ] + + +-- | We know what (c t6 2 1 0 0) should be from Sorokina and Zeilfelder, p. 87. +-- This test checks the rotation works as expected. +prop_c_tilde_2100_rotation_correct :: Cube -> Bool +prop_c_tilde_2100_rotation_correct cube = + expr1 == expr2 + where + t0 = tetrahedron cube 0 + t6 = tetrahedron cube 6 + + -- What gets computed for c2100 of t6. + expr1 = eval (function_values t6) $ + (3/8)*I + + (1/12)*(T + R + L + D) + + (1/64)*(FT + FR + FL + FD) + + (7/48)*F + + (1/48)*B + + (1/96)*(RT + LD + LT + RD) + + (1/192)*(BT + BR + BL + BD) + + -- What should be computed for c2100 of t6. + expr2 = eval (function_values t0) $ + (3/8)*I + + (1/12)*(F + R + L + B) + + (1/64)*(FT + RT + LT + BT) + + (7/48)*T + + (1/48)*D + + (1/96)*(FR + FL + BR + BL) + + (1/192)*(FD + RD + LD + BD) + + +-- | We know what (c t6 2 1 0 0) should be from Sorokina and +-- Zeilfelder, p. 87. This test checks the actual value based on +-- the FunctionValues of the cube. +-- +-- If 'prop_c_tilde_2100_rotation_correct' passes, then this test is +-- even meaningful! +prop_c_tilde_2100_correct :: Cube -> Bool +prop_c_tilde_2100_correct cube = + c t6 2 1 0 0 == expected + where + t0 = tetrahedron cube 0 + t6 = tetrahedron cube 6 + fvs = function_values t0 + expected = eval fvs $ + (3/8)*I + + (1/12)*(F + R + L + B) + + (1/64)*(FT + RT + LT + BT) + + (7/48)*T + + (1/48)*D + + (1/96)*(FR + FL + BR + BL) + + (1/192)*(FD + RD + LD + BD) + + +-- Tests to check that the correct edges are incidental. +prop_t0_shares_edge_with_t1 :: Cube -> Bool +prop_t0_shares_edge_with_t1 cube = + (v1 t0) == (v1 t1) && (v3 t0) == (v2 t1) + where + t0 = tetrahedron cube 0 + t1 = tetrahedron cube 1 + +prop_t0_shares_edge_with_t3 :: Cube -> Bool +prop_t0_shares_edge_with_t3 cube = + (v1 t0) == (v1 t3) && (v2 t0) == (v3 t3) + where + t0 = tetrahedron cube 0 + t3 = tetrahedron cube 3 + +prop_t0_shares_edge_with_t6 :: Cube -> Bool +prop_t0_shares_edge_with_t6 cube = + (v2 t0) == (v3 t6) && (v3 t0) == (v2 t6) + where + t0 = tetrahedron cube 0 + t6 = tetrahedron cube 6 + +prop_t1_shares_edge_with_t2 :: Cube -> Bool +prop_t1_shares_edge_with_t2 cube = + (v1 t1) == (v1 t2) && (v3 t1) == (v2 t2) + where + t1 = tetrahedron cube 1 + t2 = tetrahedron cube 2 + +prop_t1_shares_edge_with_t19 :: Cube -> Bool +prop_t1_shares_edge_with_t19 cube = + (v2 t1) == (v3 t19) && (v3 t1) == (v2 t19) + where + t1 = tetrahedron cube 1 + t19 = tetrahedron cube 19 + +prop_t2_shares_edge_with_t3 :: Cube -> Bool +prop_t2_shares_edge_with_t3 cube = + (v1 t1) == (v1 t2) && (v3 t1) == (v2 t2) + where + t1 = tetrahedron cube 1 + t2 = tetrahedron cube 2 + +prop_t2_shares_edge_with_t12 :: Cube -> Bool +prop_t2_shares_edge_with_t12 cube = + (v2 t2) == (v3 t12) && (v3 t2) == (v2 t12) + where + t2 = tetrahedron cube 2 + t12 = tetrahedron cube 12 + +prop_t3_shares_edge_with_t21 :: Cube -> Bool +prop_t3_shares_edge_with_t21 cube = + (v2 t3) == (v3 t21) && (v3 t3) == (v2 t21) + where + t3 = tetrahedron cube 3 + t21 = tetrahedron cube 21 + +prop_t4_shares_edge_with_t5 :: Cube -> Bool +prop_t4_shares_edge_with_t5 cube = + (v1 t4) == (v1 t5) && (v3 t4) == (v2 t5) + where + t4 = tetrahedron cube 4 + t5 = tetrahedron cube 5 + +prop_t4_shares_edge_with_t7 :: Cube -> Bool +prop_t4_shares_edge_with_t7 cube = + (v1 t4) == (v1 t7) && (v2 t4) == (v3 t7) + where + t4 = tetrahedron cube 4 + t7 = tetrahedron cube 7 + +prop_t4_shares_edge_with_t10 :: Cube -> Bool +prop_t4_shares_edge_with_t10 cube = + (v2 t4) == (v3 t10) && (v3 t4) == (v2 t10) + where + t4 = tetrahedron cube 4 + t10 = tetrahedron cube 10 + +prop_t5_shares_edge_with_t6 :: Cube -> Bool +prop_t5_shares_edge_with_t6 cube = + (v1 t5) == (v1 t6) && (v3 t5) == (v2 t6) + where + t5 = tetrahedron cube 5 + t6 = tetrahedron cube 6 + +prop_t5_shares_edge_with_t16 :: Cube -> Bool +prop_t5_shares_edge_with_t16 cube = + (v2 t5) == (v3 t16) && (v3 t5) == (v2 t16) + where + t5 = tetrahedron cube 5 + t16 = tetrahedron cube 16 + +prop_t6_shares_edge_with_t7 :: Cube -> Bool +prop_t6_shares_edge_with_t7 cube = + (v1 t6) == (v1 t7) && (v3 t6) == (v2 t7) + where + t6 = tetrahedron cube 6 + t7 = tetrahedron cube 7 + +prop_t7_shares_edge_with_t20 :: Cube -> Bool +prop_t7_shares_edge_with_t20 cube = + (v2 t7) == (v3 t20) && (v2 t7) == (v3 t20) + where + t7 = tetrahedron cube 7 + t20 = tetrahedron cube 20 + + + + + +p78_25_properties :: Test.Framework.Test +p78_25_properties = + testGroup "p. 78, Section (2.5) Properties" [ + testProperty "c_ijk1 identity" prop_cijk1_identity ] + +p79_26_properties :: Test.Framework.Test +p79_26_properties = + testGroup "p. 79, Section (2.6) Properties" [ + testProperty "c0120 identity1" prop_c0120_identity1, + testProperty "c0120 identity2" prop_c0120_identity2, + testProperty "c0120 identity3" prop_c0120_identity3, + testProperty "c0120 identity4" prop_c0120_identity4, + testProperty "c0120 identity5" prop_c0120_identity5, + testProperty "c0120 identity6" prop_c0120_identity6, + testProperty "c0120 identity7" prop_c0120_identity7, + testProperty "c0210 identity1" prop_c0210_identity1, + testProperty "c0300 identity1" prop_c0300_identity1, + testProperty "c1110 identity" prop_c1110_identity, + testProperty "c1200 identity1" prop_c1200_identity1, + testProperty "c2100 identity1" prop_c2100_identity1] + +p79_27_properties :: Test.Framework.Test +p79_27_properties = + testGroup "p. 79, Section (2.7) Properties" [ + testProperty "c0102 identity1" prop_c0102_identity1, + testProperty "c0201 identity1" prop_c0201_identity1, + testProperty "c0300 identity2" prop_c0300_identity2, + testProperty "c1101 identity" prop_c1101_identity, + testProperty "c1200 identity2" prop_c1200_identity2, + testProperty "c2100 identity2" prop_c2100_identity2 ] + + +p79_28_properties :: Test.Framework.Test +p79_28_properties = + testGroup "p. 79, Section (2.8) Properties" [ + testProperty "c3000 identity" prop_c3000_identity, + testProperty "c2010 identity" prop_c2010_identity, + testProperty "c2001 identity" prop_c2001_identity, + testProperty "c1020 identity" prop_c1020_identity, + testProperty "c1002 identity" prop_c1002_identity, + testProperty "c1011 identity" prop_c1011_identity ] + + +edge_incidence_tests :: Test.Framework.Test +edge_incidence_tests = + testGroup "Edge Incidence Tests" [ + testProperty "t0 shares edge with t6" prop_t0_shares_edge_with_t6, + testProperty "t0 shares edge with t1" prop_t0_shares_edge_with_t1, + testProperty "t0 shares edge with t3" prop_t0_shares_edge_with_t3, + testProperty "t1 shares edge with t2" prop_t1_shares_edge_with_t2, + testProperty "t1 shares edge with t19" prop_t1_shares_edge_with_t19, + testProperty "t2 shares edge with t3" prop_t2_shares_edge_with_t3, + testProperty "t2 shares edge with t12" prop_t2_shares_edge_with_t12, + testProperty "t3 shares edge with t21" prop_t3_shares_edge_with_t21, + testProperty "t4 shares edge with t5" prop_t4_shares_edge_with_t5, + testProperty "t4 shares edge with t7" prop_t4_shares_edge_with_t7, + testProperty "t4 shares edge with t10" prop_t4_shares_edge_with_t10, + testProperty "t5 shares edge with t6" prop_t5_shares_edge_with_t6, + testProperty "t5 shares edge with t16" prop_t5_shares_edge_with_t16, + testProperty "t6 shares edge with t7" prop_t6_shares_edge_with_t7, + testProperty "t7 shares edge with t20" prop_t7_shares_edge_with_t20 ] + +cube_properties :: Test.Framework.Test +cube_properties = + testGroup "Cube Properties" [ + p78_25_properties, + p79_26_properties, + p79_27_properties, + p79_28_properties, + edge_incidence_tests, + testProperty "opposite octant tetrahedra are disjoint (1)" + prop_opposite_octant_tetrahedra_disjoint1, + testProperty "opposite octant tetrahedra are disjoint (2)" + prop_opposite_octant_tetrahedra_disjoint2, + testProperty "opposite octant tetrahedra are disjoint (3)" + prop_opposite_octant_tetrahedra_disjoint3, + testProperty "opposite octant tetrahedra are disjoint (4)" + prop_opposite_octant_tetrahedra_disjoint4, + testProperty "opposite octant tetrahedra are disjoint (5)" + prop_opposite_octant_tetrahedra_disjoint5, + testProperty "opposite octant tetrahedra are disjoint (6)" + prop_opposite_octant_tetrahedra_disjoint6, + testProperty "all volumes positive" prop_all_volumes_positive, + testProperty "all volumes exact" prop_all_volumes_exact, + testProperty "v0 all equal" prop_v0_all_equal, + testProperty "interior values all identical" + prop_interior_values_all_identical, + testProperty "c-tilde_2100 rotation correct" + prop_c_tilde_2100_rotation_correct, + testProperty "c-tilde_2100 correct" + prop_c_tilde_2100_correct ] diff --git a/src/Everything.hs b/src/Everything.hs index 7934a25..af74566 100644 --- a/src/Everything.hs +++ b/src/Everything.hs @@ -17,5 +17,5 @@ import Misc as X import MRI as X import Point as X import RealFunction as X -import Tetrahedron as X hiding (fv) +import Tetrahedron as X import Values as X diff --git a/src/Tests/Cube.hs b/src/Tests/Cube.hs deleted file mode 100644 index 2fd8cb6..0000000 --- a/src/Tests/Cube.hs +++ /dev/null @@ -1,506 +0,0 @@ -module Tests.Cube -where - -import Prelude hiding (LT) - -import Cardinal -import Comparisons -import Cube hiding (i, j, k) -import FunctionValues -import Misc (all_equal, disjoint) -import Tetrahedron (b0, b1, b2, b3, c, fv, - v0, v1, v2, v3, volume) - - --- Quickcheck tests. - -prop_opposite_octant_tetrahedra_disjoint1 :: Cube -> Bool -prop_opposite_octant_tetrahedra_disjoint1 c = - disjoint (front_left_top_tetrahedra c) (front_right_down_tetrahedra c) - -prop_opposite_octant_tetrahedra_disjoint2 :: Cube -> Bool -prop_opposite_octant_tetrahedra_disjoint2 c = - disjoint (back_left_top_tetrahedra c) (back_right_down_tetrahedra c) - -prop_opposite_octant_tetrahedra_disjoint3 :: Cube -> Bool -prop_opposite_octant_tetrahedra_disjoint3 c = - disjoint (front_left_top_tetrahedra c) (back_right_top_tetrahedra c) - -prop_opposite_octant_tetrahedra_disjoint4 :: Cube -> Bool -prop_opposite_octant_tetrahedra_disjoint4 c = - disjoint (front_left_down_tetrahedra c) (back_right_down_tetrahedra c) - -prop_opposite_octant_tetrahedra_disjoint5 :: Cube -> Bool -prop_opposite_octant_tetrahedra_disjoint5 c = - disjoint (front_left_top_tetrahedra c) (back_left_down_tetrahedra c) - -prop_opposite_octant_tetrahedra_disjoint6 :: Cube -> Bool -prop_opposite_octant_tetrahedra_disjoint6 c = - disjoint (front_right_top_tetrahedra c) (back_right_down_tetrahedra c) - - --- | Since the grid size is necessarily positive, all tetrahedra --- (which comprise cubes of positive volume) must have positive volume --- as well. -prop_all_volumes_positive :: Cube -> Bool -prop_all_volumes_positive cube = - null nonpositive_volumes - where - ts = tetrahedra cube - volumes = map volume ts - nonpositive_volumes = filter (<= 0) volumes - --- | In fact, since all of the tetrahedra are identical, we should --- already know their volumes. There's 24 tetrahedra to a cube, so --- we'd expect the volume of each one to be (1/24)*h^3. -prop_all_volumes_exact :: Cube -> Bool -prop_all_volumes_exact cube = - and [volume t ~~= (1/24)*(delta^(3::Int)) | t <- tetrahedra cube] - where - delta = h cube - --- | All tetrahedron should have their v0 located at the center of the cube. -prop_v0_all_equal :: Cube -> Bool -prop_v0_all_equal cube = (v0 t0) == (v0 t1) - where - t0 = head (tetrahedra cube) -- Doesn't matter which two we choose. - t1 = head $ tail (tetrahedra cube) - - --- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Note that the --- third and fourth indices of c-t1 have been switched. This is --- because we store the triangles oriented such that their volume is --- positive. If T and T-tilde share \ and v3,v3-tilde point --- in opposite directions, one of them has to have negative volume! -prop_c0120_identity1 :: Cube -> Bool -prop_c0120_identity1 cube = - c t0 0 1 2 0 ~= (c t0 0 0 2 1 + c t3 0 0 1 2) / 2 - where - t0 = tetrahedron cube 0 - t3 = tetrahedron cube 3 - - --- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Repeats --- 'prop_c0120_identity1' with tetrahedrons 1 and 2. -prop_c0120_identity2 :: Cube -> Bool -prop_c0120_identity2 cube = - c t1 0 1 2 0 ~= (c t1 0 0 2 1 + c t0 0 0 1 2) / 2 - where - t0 = tetrahedron cube 0 - t1 = tetrahedron cube 1 - --- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Repeats --- 'prop_c0120_identity1' with tetrahedrons 1 and 2. -prop_c0120_identity3 :: Cube -> Bool -prop_c0120_identity3 cube = - c t2 0 1 2 0 ~= (c t2 0 0 2 1 + c t1 0 0 1 2) / 2 - where - t1 = tetrahedron cube 1 - t2 = tetrahedron cube 2 - --- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Repeats --- 'prop_c0120_identity1' with tetrahedrons 2 and 3. -prop_c0120_identity4 :: Cube -> Bool -prop_c0120_identity4 cube = - c t3 0 1 2 0 ~= (c t3 0 0 2 1 + c t2 0 0 1 2) / 2 - where - t2 = tetrahedron cube 2 - t3 = tetrahedron cube 3 - - --- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Repeats --- 'prop_c0120_identity1' with tetrahedrons 4 and 5. -prop_c0120_identity5 :: Cube -> Bool -prop_c0120_identity5 cube = - c t5 0 1 2 0 ~= (c t5 0 0 2 1 + c t4 0 0 1 2) / 2 - where - t4 = tetrahedron cube 4 - t5 = tetrahedron cube 5 - --- -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Repeats --- -- 'prop_c0120_identity1' with tetrahedrons 5 and 6. -prop_c0120_identity6 :: Cube -> Bool -prop_c0120_identity6 cube = - c t6 0 1 2 0 ~= (c t6 0 0 2 1 + c t5 0 0 1 2) / 2 - where - t5 = tetrahedron cube 5 - t6 = tetrahedron cube 6 - - --- -- | Given in Sorokina and Zeilfelder, p. 79, (2.6). Repeats --- -- 'prop_c0120_identity1' with tetrahedrons 6 and 7. -prop_c0120_identity7 :: Cube -> Bool -prop_c0120_identity7 cube = - c t7 0 1 2 0 ~= (c t7 0 0 2 1 + c t6 0 0 1 2) / 2 - where - t6 = tetrahedron cube 6 - t7 = tetrahedron cube 7 - - --- | Given in Sorokina and Zeilfelder, p. 79, (2.6). See --- 'prop_c0120_identity1'. -prop_c0210_identity1 :: Cube -> Bool -prop_c0210_identity1 cube = - c t0 0 2 1 0 ~= (c t0 0 1 1 1 + c t3 0 1 1 1) / 2 - where - t0 = tetrahedron cube 0 - t3 = tetrahedron cube 3 - - --- | Given in Sorokina and Zeilfelder, p. 79, (2.6). See --- 'prop_c0120_identity1'. -prop_c0300_identity1 :: Cube -> Bool -prop_c0300_identity1 cube = - c t0 0 3 0 0 ~= (c t0 0 2 0 1 + c t3 0 2 1 0) / 2 - where - t0 = tetrahedron cube 0 - t3 = tetrahedron cube 3 - - --- | Given in Sorokina and Zeilfelder, p. 79, (2.6). See --- 'prop_c0120_identity1'. -prop_c1110_identity :: Cube -> Bool -prop_c1110_identity cube = - c t0 1 1 1 0 ~= (c t0 1 0 1 1 + c t3 1 0 1 1) / 2 - where - t0 = tetrahedron cube 0 - t3 = tetrahedron cube 3 - - --- | Given in Sorokina and Zeilfelder, p. 79, (2.6). See --- 'prop_c0120_identity1'. -prop_c1200_identity1 :: Cube -> Bool -prop_c1200_identity1 cube = - c t0 1 2 0 0 ~= (c t0 1 1 0 1 + c t3 1 1 1 0) / 2 - where - t0 = tetrahedron cube 0 - t3 = tetrahedron cube 3 - - --- | Given in Sorokina and Zeilfelder, p. 79, (2.6). See --- 'prop_c0120_identity1'. -prop_c2100_identity1 :: Cube -> Bool -prop_c2100_identity1 cube = - c t0 2 1 0 0 ~= (c t0 2 0 0 1 + c t3 2 0 1 0) / 2 - where - t0 = tetrahedron cube 0 - t3 = tetrahedron cube 3 - - - --- | Given in Sorokina and Zeilfelder, p. 79, (2.7). Note that the --- third and fourth indices of c-t3 have been switched. This is --- because we store the triangles oriented such that their volume is --- positive. If T and T-tilde share \ and v3,v3-tilde --- point in opposite directions, one of them has to have negative --- volume! -prop_c0102_identity1 :: Cube -> Bool -prop_c0102_identity1 cube = - c t0 0 1 0 2 ~= (c t0 0 0 1 2 + c t1 0 0 2 1) / 2 - where - t0 = tetrahedron cube 0 - t1 = tetrahedron cube 1 - - --- | Given in Sorokina and Zeilfelder, p. 79, (2.7). See --- 'prop_c0102_identity1'. -prop_c0201_identity1 :: Cube -> Bool -prop_c0201_identity1 cube = - c t0 0 2 0 1 ~= (c t0 0 1 1 1 + c t1 0 1 1 1) / 2 - where - t0 = tetrahedron cube 0 - t1 = tetrahedron cube 1 - - --- | Given in Sorokina and Zeilfelder, p. 79, (2.7). See --- 'prop_c0102_identity1'. -prop_c0300_identity2 :: Cube -> Bool -prop_c0300_identity2 cube = - c t0 0 3 0 0 ~= (c t0 0 2 1 0 + c t1 0 2 0 1) / 2 - where - t0 = tetrahedron cube 0 - t1 = tetrahedron cube 1 - - --- | Given in Sorokina and Zeilfelder, p. 79, (2.7). See --- 'prop_c0102_identity1'. -prop_c1101_identity :: Cube -> Bool -prop_c1101_identity cube = - c t0 1 1 0 1 ~= (c t0 1 0 1 1 + c t1 1 0 1 1) / 2 - where - t0 = tetrahedron cube 0 - t1 = tetrahedron cube 1 - - --- | Given in Sorokina and Zeilfelder, p. 79, (2.7). See --- 'prop_c0102_identity1'. -prop_c1200_identity2 :: Cube -> Bool -prop_c1200_identity2 cube = - c t0 1 2 0 0 ~= (c t0 1 1 1 0 + c t1 1 1 0 1) / 2 - where - t0 = tetrahedron cube 0 - t1 = tetrahedron cube 1 - - --- | Given in Sorokina and Zeilfelder, p. 79, (2.7). See --- 'prop_c0102_identity1'. -prop_c2100_identity2 :: Cube -> Bool -prop_c2100_identity2 cube = - c t0 2 1 0 0 ~= (c t0 2 0 1 0 + c t1 2 0 0 1) / 2 - where - t0 = tetrahedron cube 0 - t1 = tetrahedron cube 1 - - --- | Given in Sorokina and Zeilfelder, p. 79, (2.8). The third and --- fourth indices of c-t6 have been switched. This is because we --- store the triangles oriented such that their volume is --- positive. If T and T-tilde share \ and v3,v3-tilde --- point in opposite directions, one of them has to have negative --- volume! -prop_c3000_identity :: Cube -> Bool -prop_c3000_identity cube = - c t0 3 0 0 0 ~= c t0 2 1 0 0 + c t6 2 1 0 0 - - ((c t0 2 0 1 0 + c t0 2 0 0 1)/ 2) - where - t0 = tetrahedron cube 0 - t6 = tetrahedron cube 6 - - --- | Given in Sorokina and Zeilfelder, p. 79, (2.8). See --- 'prop_c3000_identity'. -prop_c2010_identity :: Cube -> Bool -prop_c2010_identity cube = - c t0 2 0 1 0 ~= c t0 1 1 1 0 + c t6 1 1 0 1 - - ((c t0 1 0 2 0 + c t0 1 0 1 1)/ 2) - where - t0 = tetrahedron cube 0 - t6 = tetrahedron cube 6 - - --- | Given in Sorokina and Zeilfelder, p. 79, (2.8). See --- 'prop_c3000_identity'. -prop_c2001_identity :: Cube -> Bool -prop_c2001_identity cube = - c t0 2 0 0 1 ~= c t0 1 1 0 1 + c t6 1 1 1 0 - - ((c t0 1 0 0 2 + c t0 1 0 1 1)/ 2) - where - t0 = tetrahedron cube 0 - t6 = tetrahedron cube 6 - - --- | Given in Sorokina and Zeilfelder, p. 79, (2.8). See --- 'prop_c3000_identity'. -prop_c1020_identity :: Cube -> Bool -prop_c1020_identity cube = - c t0 1 0 2 0 ~= c t0 0 1 2 0 + c t6 0 1 0 2 - - ((c t0 0 0 3 0 + c t0 0 0 2 1)/ 2) - where - t0 = tetrahedron cube 0 - t6 = tetrahedron cube 6 - - --- | Given in Sorokina and Zeilfelder, p. 79, (2.8). See --- 'prop_c3000_identity'. -prop_c1002_identity :: Cube -> Bool -prop_c1002_identity cube = - c t0 1 0 0 2 ~= c t0 0 1 0 2 + c t6 0 1 2 0 - - ((c t0 0 0 0 3 + c t0 0 0 1 2)/ 2) - where - t0 = tetrahedron cube 0 - t6 = tetrahedron cube 6 - - --- | Given in Sorokina and Zeilfelder, p. 79, (2.8). See --- 'prop_c3000_identity'. -prop_c1011_identity :: Cube -> Bool -prop_c1011_identity cube = - c t0 1 0 1 1 ~= c t0 0 1 1 1 + c t6 0 1 1 1 - - ((c t0 0 0 1 2 + c t0 0 0 2 1)/ 2) - where - t0 = tetrahedron cube 0 - t6 = tetrahedron cube 6 - - - --- | Given in Sorokina and Zeilfelder, p. 78. -prop_cijk1_identity :: Cube -> Bool -prop_cijk1_identity cube = - and [ c t0 i j k 1 ~= - (c t1 (i+1) j k 0) * ((b0 t0) (v3 t1)) + - (c t1 i (j+1) k 0) * ((b1 t0) (v3 t1)) + - (c t1 i j (k+1) 0) * ((b2 t0) (v3 t1)) + - (c t1 i j k 1) * ((b3 t0) (v3 t1)) | i <- [0..2], - j <- [0..2], - k <- [0..2], - i + j + k == 2] - where - t0 = tetrahedron cube 0 - t1 = tetrahedron cube 1 - - --- | The function values at the interior should be the same for all --- tetrahedra. -prop_interior_values_all_identical :: Cube -> Bool -prop_interior_values_all_identical cube = - all_equal [ eval (Tetrahedron.fv tet) I | tet <- tetrahedra cube ] - - --- | We know what (c t6 2 1 0 0) should be from Sorokina and Zeilfelder, p. 87. --- This test checks the rotation works as expected. -prop_c_tilde_2100_rotation_correct :: Cube -> Bool -prop_c_tilde_2100_rotation_correct cube = - expr1 == expr2 - where - t0 = tetrahedron cube 0 - t6 = tetrahedron cube 6 - - -- What gets computed for c2100 of t6. - expr1 = eval (Tetrahedron.fv t6) $ - (3/8)*I + - (1/12)*(T + R + L + D) + - (1/64)*(FT + FR + FL + FD) + - (7/48)*F + - (1/48)*B + - (1/96)*(RT + LD + LT + RD) + - (1/192)*(BT + BR + BL + BD) - - -- What should be computed for c2100 of t6. - expr2 = eval (Tetrahedron.fv t0) $ - (3/8)*I + - (1/12)*(F + R + L + B) + - (1/64)*(FT + RT + LT + BT) + - (7/48)*T + - (1/48)*D + - (1/96)*(FR + FL + BR + BL) + - (1/192)*(FD + RD + LD + BD) - - --- | We know what (c t6 2 1 0 0) should be from Sorokina and --- Zeilfelder, p. 87. This test checks the actual value based on --- the FunctionValues of the cube. --- --- If 'prop_c_tilde_2100_rotation_correct' passes, then this test is --- even meaningful! -prop_c_tilde_2100_correct :: Cube -> Bool -prop_c_tilde_2100_correct cube = - c t6 2 1 0 0 == expected - where - t0 = tetrahedron cube 0 - t6 = tetrahedron cube 6 - fvs = Tetrahedron.fv t0 - expected = eval fvs $ - (3/8)*I + - (1/12)*(F + R + L + B) + - (1/64)*(FT + RT + LT + BT) + - (7/48)*T + - (1/48)*D + - (1/96)*(FR + FL + BR + BL) + - (1/192)*(FD + RD + LD + BD) - - --- Tests to check that the correct edges are incidental. -prop_t0_shares_edge_with_t1 :: Cube -> Bool -prop_t0_shares_edge_with_t1 cube = - (v1 t0) == (v1 t1) && (v3 t0) == (v2 t1) - where - t0 = tetrahedron cube 0 - t1 = tetrahedron cube 1 - -prop_t0_shares_edge_with_t3 :: Cube -> Bool -prop_t0_shares_edge_with_t3 cube = - (v1 t0) == (v1 t3) && (v2 t0) == (v3 t3) - where - t0 = tetrahedron cube 0 - t3 = tetrahedron cube 3 - -prop_t0_shares_edge_with_t6 :: Cube -> Bool -prop_t0_shares_edge_with_t6 cube = - (v2 t0) == (v3 t6) && (v3 t0) == (v2 t6) - where - t0 = tetrahedron cube 0 - t6 = tetrahedron cube 6 - -prop_t1_shares_edge_with_t2 :: Cube -> Bool -prop_t1_shares_edge_with_t2 cube = - (v1 t1) == (v1 t2) && (v3 t1) == (v2 t2) - where - t1 = tetrahedron cube 1 - t2 = tetrahedron cube 2 - -prop_t1_shares_edge_with_t19 :: Cube -> Bool -prop_t1_shares_edge_with_t19 cube = - (v2 t1) == (v3 t19) && (v3 t1) == (v2 t19) - where - t1 = tetrahedron cube 1 - t19 = tetrahedron cube 19 - -prop_t2_shares_edge_with_t3 :: Cube -> Bool -prop_t2_shares_edge_with_t3 cube = - (v1 t1) == (v1 t2) && (v3 t1) == (v2 t2) - where - t1 = tetrahedron cube 1 - t2 = tetrahedron cube 2 - -prop_t2_shares_edge_with_t12 :: Cube -> Bool -prop_t2_shares_edge_with_t12 cube = - (v2 t2) == (v3 t12) && (v3 t2) == (v2 t12) - where - t2 = tetrahedron cube 2 - t12 = tetrahedron cube 12 - -prop_t3_shares_edge_with_t21 :: Cube -> Bool -prop_t3_shares_edge_with_t21 cube = - (v2 t3) == (v3 t21) && (v3 t3) == (v2 t21) - where - t3 = tetrahedron cube 3 - t21 = tetrahedron cube 21 - -prop_t4_shares_edge_with_t5 :: Cube -> Bool -prop_t4_shares_edge_with_t5 cube = - (v1 t4) == (v1 t5) && (v3 t4) == (v2 t5) - where - t4 = tetrahedron cube 4 - t5 = tetrahedron cube 5 - -prop_t4_shares_edge_with_t7 :: Cube -> Bool -prop_t4_shares_edge_with_t7 cube = - (v1 t4) == (v1 t7) && (v2 t4) == (v3 t7) - where - t4 = tetrahedron cube 4 - t7 = tetrahedron cube 7 - -prop_t4_shares_edge_with_t10 :: Cube -> Bool -prop_t4_shares_edge_with_t10 cube = - (v2 t4) == (v3 t10) && (v3 t4) == (v2 t10) - where - t4 = tetrahedron cube 4 - t10 = tetrahedron cube 10 - -prop_t5_shares_edge_with_t6 :: Cube -> Bool -prop_t5_shares_edge_with_t6 cube = - (v1 t5) == (v1 t6) && (v3 t5) == (v2 t6) - where - t5 = tetrahedron cube 5 - t6 = tetrahedron cube 6 - -prop_t5_shares_edge_with_t16 :: Cube -> Bool -prop_t5_shares_edge_with_t16 cube = - (v2 t5) == (v3 t16) && (v3 t5) == (v2 t16) - where - t5 = tetrahedron cube 5 - t16 = tetrahedron cube 16 - -prop_t6_shares_edge_with_t7 :: Cube -> Bool -prop_t6_shares_edge_with_t7 cube = - (v1 t6) == (v1 t7) && (v3 t6) == (v2 t7) - where - t6 = tetrahedron cube 6 - t7 = tetrahedron cube 7 - -prop_t7_shares_edge_with_t20 :: Cube -> Bool -prop_t7_shares_edge_with_t20 cube = - (v2 t7) == (v3 t20) && (v2 t7) == (v3 t20) - where - t7 = tetrahedron cube 7 - t20 = tetrahedron cube 20 diff --git a/src/Tetrahedron.hs b/src/Tetrahedron.hs index 6da4194..b8d4fe6 100644 --- a/src/Tetrahedron.hs +++ b/src/Tetrahedron.hs @@ -34,7 +34,7 @@ import RealFunction import ThreeDimensional data Tetrahedron = - Tetrahedron { fv :: FunctionValues, + Tetrahedron { function_values :: FunctionValues, v0 :: Point, v1 :: Point, v2 :: Point, @@ -61,7 +61,7 @@ instance Arbitrary Tetrahedron where instance Show Tetrahedron where show t = "Tetrahedron:\n" ++ - " fv: " ++ (show (fv t)) ++ "\n" ++ + " function_values: " ++ (show (function_values t)) ++ "\n" ++ " v0: " ++ (show (v0 t)) ++ "\n" ++ " v1: " ++ (show (v1 t)) ++ "\n" ++ " v2: " ++ (show (v2 t)) ++ "\n" ++ @@ -161,73 +161,73 @@ beta t i j k l -- Zeilfelder, pp. 84-86. If incorrect indices are supplied, the -- function will simply error. c :: Tetrahedron -> Int -> Int -> Int -> Int -> Double -c t 0 0 3 0 = eval (fv t) $ +c t 0 0 3 0 = eval (function_values t) $ (1/8) * (I + F + L + T + LT + FL + FT + FLT) -c t 0 0 0 3 = eval (fv t) $ +c t 0 0 0 3 = eval (function_values t) $ (1/8) * (I + F + R + T + RT + FR + FT + FRT) -c t 0 0 2 1 = eval (fv t) $ +c t 0 0 2 1 = eval (function_values t) $ (5/24)*(I + F + T + FT) + (1/24)*(L + FL + LT + FLT) -c t 0 0 1 2 = eval (fv t) $ +c t 0 0 1 2 = eval (function_values t) $ (5/24)*(I + F + T + FT) + (1/24)*(R + FR + RT + FRT) -c t 0 1 2 0 = eval (fv t) $ +c t 0 1 2 0 = eval (function_values t) $ (5/24)*(I + F) + (1/8)*(L + T + FL + FT) + (1/24)*(LT + FLT) -c t 0 1 0 2 = eval (fv t) $ +c t 0 1 0 2 = eval (function_values t) $ (5/24)*(I + F) + (1/8)*(R + T + FR + FT) + (1/24)*(RT + FRT) -c t 0 1 1 1 = eval (fv t) $ +c t 0 1 1 1 = eval (function_values t) $ (13/48)*(I + F) + (7/48)*(T + FT) + (1/32)*(L + R + FL + FR) + (1/96)*(LT + RT + FLT + FRT) -c t 0 2 1 0 = eval (fv t) $ +c t 0 2 1 0 = eval (function_values t) $ (13/48)*(I + F) + (17/192)*(L + T + FL + FT) + (1/96)*(LT + FLT) + (1/64)*(R + D + FR + FD) + (1/192)*(RT + LD + FRT + FLD) -c t 0 2 0 1 = eval (fv t) $ +c t 0 2 0 1 = eval (function_values t) $ (13/48)*(I + F) + (17/192)*(R + T + FR + FT) + (1/96)*(RT + FRT) + (1/64)*(L + D + FL + FD) + (1/192)*(RD + LT + FLT + FRD) -c t 0 3 0 0 = eval (fv t) $ +c t 0 3 0 0 = eval (function_values t) $ (13/48)*(I + F) + (5/96)*(L + R + T + D + FL + FR + FT + FD) + (1/192)*(RT + RD + LT + LD + FRT + FRD + FLT + FLD) -c t 1 0 2 0 = eval (fv t) $ +c t 1 0 2 0 = eval (function_values t) $ (1/4)*I + (1/6)*(F + L + T) + (1/12)*(LT + FL + FT) -c t 1 0 0 2 = eval (fv t) $ +c t 1 0 0 2 = eval (function_values t) $ (1/4)*I + (1/6)*(F + R + T) + (1/12)*(RT + FR + FT) -c t 1 0 1 1 = eval (fv t) $ +c t 1 0 1 1 = eval (function_values t) $ (1/3)*I + (5/24)*(F + T) + (1/12)*FT + (1/24)*(L + R) + (1/48)*(LT + RT + FL + FR) -c t 1 1 1 0 = eval (fv t) $ +c t 1 1 1 0 = eval (function_values t) $ (1/3)*I + (5/24)*F + (1/8)*(L + T) + @@ -235,7 +235,7 @@ c t 1 1 1 0 = eval (fv t) $ (1/48)*(D + R + LT) + (1/96)*(FD + LD + RT + FR) -c t 1 1 0 1 = eval (fv t) $ +c t 1 1 0 1 = eval (function_values t) $ (1/3)*I + (5/24)*F + (1/8)*(R + T) + @@ -243,26 +243,26 @@ c t 1 1 0 1 = eval (fv t) $ (1/48)*(D + L + RT) + (1/96)*(FD + LT + RD + FL) -c t 1 2 0 0 = eval (fv t) $ +c t 1 2 0 0 = eval (function_values t) $ (1/3)*I + (5/24)*F + (7/96)*(L + R + T + D) + (1/32)*(FL + FR + FT + FD) + (1/96)*(RT + RD + LT + LD) -c t 2 0 1 0 = eval (fv t) $ +c t 2 0 1 0 = eval (function_values t) $ (3/8)*I + (7/48)*(F + T + L) + (1/48)*(R + D + B + LT + FL + FT) + (1/96)*(RT + BT + FR + FD + LD + BL) -c t 2 0 0 1 = eval (fv t) $ +c t 2 0 0 1 = eval (function_values t) $ (3/8)*I + (7/48)*(F + T + R) + (1/48)*(L + D + B + RT + FR + FT) + (1/96)*(LT + BT + FL + FD + RD + BR) -c t 2 1 0 0 = eval (fv t) $ +c t 2 1 0 0 = eval (function_values t) $ (3/8)*I + (1/12)*(T + R + L + D) + (1/64)*(FT + FR + FL + FD) + @@ -271,7 +271,7 @@ c t 2 1 0 0 = eval (fv t) $ (1/96)*(RT + LD + LT + RD) + (1/192)*(BT + BR + BL + BD) -c t 3 0 0 0 = eval (fv t) $ +c t 3 0 0 0 = eval (function_values t) $ (3/8)*I + (1/12)*(T + F + L + R + D + B) + (1/96)*(LT + FL + FT + RT + BT + FR) + @@ -359,7 +359,7 @@ tetrahedron1_geometry_tests = v1 = p1, v2 = p2, v3 = p3, - fv = empty_values, + function_values = empty_values, precomputed_volume = 0 } volume1 :: Assertion @@ -394,7 +394,7 @@ tetrahedron2_geometry_tests = v1 = p1, v2 = p2, v3 = p3, - fv = empty_values, + function_values = empty_values, precomputed_volume = 0 } volume1 :: Assertion @@ -433,7 +433,7 @@ containment_tests = v1 = p1, v2 = p2, v3 = p3, - fv = empty_values, + function_values = empty_values, precomputed_volume = 0 } contained = contains_point t exterior_point @@ -448,7 +448,7 @@ containment_tests = v1 = p1, v2 = p2, v3 = p3, - fv = empty_values, + function_values = empty_values, precomputed_volume = 0 } contained = contains_point t exterior_point @@ -463,7 +463,7 @@ containment_tests = v1 = p1, v2 = p2, v3 = p3, - fv = empty_values, + function_values = empty_values, precomputed_volume = 0 } contained = contains_point t exterior_point @@ -478,7 +478,7 @@ containment_tests = v1 = p1, v2 = p2, v3 = p3, - fv = empty_values, + function_values = empty_values, precomputed_volume = 0 } contained = contains_point t exterior_point diff --git a/test/TestSuite.hs b/test/TestSuite.hs index 2432224..0e11d1c 100644 --- a/test/TestSuite.hs +++ b/test/TestSuite.hs @@ -10,10 +10,10 @@ import Test.HUnit import Test.QuickCheck (Testable ()) import Cardinal (cardinal_tests, cardinal_properties) +import Cube (cube_properties) import FunctionValues (function_values_tests, function_values_properties) import Grid (grid_tests, slow_tests) import Misc (misc_tests, misc_properties) -import Tests.Cube as TC import Tetrahedron (tetrahedron_tests, tetrahedron_properties) main :: IO () @@ -31,93 +31,6 @@ tp :: Test.QuickCheck.Testable a => Test.Framework.TestName -> a -> Test.Framewo tp = testProperty - -p78_25_properties :: Test.Framework.Test -p78_25_properties = - testGroup "p. 78, Section (2.5) Properties" [ - tp "c_ijk1 identity" prop_cijk1_identity ] - -edge_incidence_tests :: Test.Framework.Test -edge_incidence_tests = - testGroup "Edge Incidence Tests" [ - tp "t0 shares edge with t6" prop_t0_shares_edge_with_t6, - tp "t0 shares edge with t1" prop_t0_shares_edge_with_t1, - tp "t0 shares edge with t3" prop_t0_shares_edge_with_t3, - tp "t1 shares edge with t2" prop_t1_shares_edge_with_t2, - tp "t1 shares edge with t19" prop_t1_shares_edge_with_t19, - tp "t2 shares edge with t3" prop_t2_shares_edge_with_t3, - tp "t2 shares edge with t12" prop_t2_shares_edge_with_t12, - tp "t3 shares edge with t21" prop_t3_shares_edge_with_t21, - tp "t4 shares edge with t5" prop_t4_shares_edge_with_t5, - tp "t4 shares edge with t7" prop_t4_shares_edge_with_t7, - tp "t4 shares edge with t10" prop_t4_shares_edge_with_t10, - tp "t5 shares edge with t6" prop_t5_shares_edge_with_t6, - tp "t5 shares edge with t16" prop_t5_shares_edge_with_t16, - tp "t6 shares edge with t7" prop_t6_shares_edge_with_t7, - tp "t7 shares edge with t20" prop_t7_shares_edge_with_t20 ] - - -p79_26_properties :: Test.Framework.Test -p79_26_properties = - testGroup "p. 79, Section (2.6) Properties" [ - tp "c0120 identity1" TC.prop_c0120_identity1, - tp "c0120 identity2" TC.prop_c0120_identity2, - tp "c0120 identity3" TC.prop_c0120_identity3, - tp "c0120 identity4" TC.prop_c0120_identity4, - tp "c0120 identity5" TC.prop_c0120_identity5, - tp "c0120 identity6" TC.prop_c0120_identity6, - tp "c0120 identity7" TC.prop_c0120_identity7, - tp "c0210 identity1" TC.prop_c0210_identity1, - tp "c0300 identity1" TC.prop_c0300_identity1, - tp "c1110 identity" TC.prop_c1110_identity, - tp "c1200 identity1" TC.prop_c1200_identity1, - tp "c2100 identity1" TC.prop_c2100_identity1] - -p79_27_properties :: Test.Framework.Test -p79_27_properties = - testGroup "p. 79, Section (2.7) Properties" [ - tp "c0102 identity1" TC.prop_c0102_identity1, - tp "c0201 identity1" TC.prop_c0201_identity1, - tp "c0300 identity2" TC.prop_c0300_identity2, - tp "c1101 identity" TC.prop_c1101_identity, - tp "c1200 identity2" TC.prop_c1200_identity2, - tp "c2100 identity2" TC.prop_c2100_identity2 ] - - -p79_28_properties :: Test.Framework.Test -p79_28_properties = - testGroup "p. 79, Section (2.8) Properties" [ - tp "c3000 identity" TC.prop_c3000_identity, - tp "c2010 identity" TC.prop_c2010_identity, - tp "c2001 identity" TC.prop_c2001_identity, - tp "c1020 identity" TC.prop_c1020_identity, - tp "c1002 identity" TC.prop_c1002_identity, - tp "c1011 identity" TC.prop_c1011_identity ] - - -cube_properties :: Test.Framework.Test -cube_properties = - testGroup "Cube Properties" [ - tp "opposite octant tetrahedra are disjoint (1)" - prop_opposite_octant_tetrahedra_disjoint1, - tp "opposite octant tetrahedra are disjoint (2)" - prop_opposite_octant_tetrahedra_disjoint2, - tp "opposite octant tetrahedra are disjoint (3)" - prop_opposite_octant_tetrahedra_disjoint3, - tp "opposite octant tetrahedra are disjoint (4)" - prop_opposite_octant_tetrahedra_disjoint4, - tp "opposite octant tetrahedra are disjoint (5)" - prop_opposite_octant_tetrahedra_disjoint5, - tp "opposite octant tetrahedra are disjoint (6)" - prop_opposite_octant_tetrahedra_disjoint6, - tp "all volumes positive" prop_all_volumes_positive, - tp "all volumes exact" prop_all_volumes_exact, - tp "v0 all equal" prop_v0_all_equal, - tp "interior values all identical" prop_interior_values_all_identical, - tp "c-tilde_2100 rotation correct" prop_c_tilde_2100_rotation_correct, - tp "c-tilde_2100 correct" prop_c_tilde_2100_correct ] - - tests :: [Test.Framework.Test] tests = [ cardinal_tests, function_values_tests, @@ -128,9 +41,4 @@ tests = [ cardinal_tests, tetrahedron_properties, misc_properties, cardinal_properties, - edge_incidence_tests, --- p78_25_properties, - p79_26_properties, - p79_27_properties, - p79_28_properties, slow_tests ]