X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FCube.hs;h=026f4e966ccf53a0392b0a93667910627038ebef;hb=16f16e8407c31330f1c29118b06925722da56282;hp=6e33423d2da3a828257b21ab85055db58b681af8;hpb=7cee33b2fa4789525a12685923edf1f38924a7f4;p=spline3.git diff --git a/src/Cube.hs b/src/Cube.hs index 6e33423..026f4e9 100644 --- a/src/Cube.hs +++ b/src/Cube.hs @@ -1,3 +1,8 @@ +-- The "tetrahedron" function pattern matches on the integers zero +-- through twenty-three, but doesn't handle the "otherwise" case, for +-- performance reasons. +{-# OPTIONS_GHC -Wno-incomplete-patterns #-} + module Cube ( Cube(..), cube_properties, @@ -15,13 +20,39 @@ import qualified Data.Vector as V ( singleton, 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 Prelude( + Bool, + Double, + Int, + Eq( (==) ), + Fractional( (/) ), + Maybe, + Num( (+), (-), (*) ), + Ord( (>=), (<=) ), + Show( show ), + ($), + (.), + (&&), + (++), + abs, + all, + and, + fromIntegral, + head, + map, + otherwise, + return, + tail ) +import Test.Tasty ( TestTree, testGroup ) +import Test.Tasty.QuickCheck ( + Arbitrary( arbitrary ), + Gen, + Positive( Positive ), + choose, + testProperty ) import Cardinal ( - Cardinal(..), + Cardinal(F, B, L, R, D, T, FL, FR, FD, FT, + BL, BR, BD, BT, LD, LT, RD, RT, I), ccwx, ccwy, ccwz, @@ -32,8 +63,12 @@ import Comparisons ( (~=), (~~=) ) import qualified Face ( Face(..), center ) import FunctionValues ( FunctionValues, eval, rotate ) import Misc ( all_equal, disjoint ) -import Point ( Point(..), dot ) -import Tetrahedron ( Tetrahedron(..), barycenter, c, volume ) +import Point ( Point( Point ), dot ) +import Tetrahedron ( + Tetrahedron(Tetrahedron, function_values, v0, v1, v2, v3), + barycenter, + c, + volume ) data Cube = Cube { i :: !Int, j :: !Int, @@ -56,7 +91,7 @@ instance Arbitrary Cube where -- these numbers don't overflow 64 bits. This number is not -- magic in any other sense than that it does not cause test -- failures, while 2^23 does. - coordmax = 4194304 -- 2^22 + coordmax = 4194304 :: Int -- 2^22 coordmin = -coordmax @@ -78,42 +113,42 @@ instance Show Cube where -- | The left-side boundary of the cube. See Sorokina and Zeilfelder, -- p. 76. xmin :: Cube -> Double -xmin cube = (i' - 1/2) +xmin cube = (i' - 1 / 2) where i' = fromIntegral (i cube) :: Double -- | The right-side boundary of the cube. See Sorokina and Zeilfelder, -- p. 76. xmax :: Cube -> Double -xmax cube = (i' + 1/2) +xmax cube = (i' + 1 / 2) where i' = fromIntegral (i cube) :: Double -- | The front boundary of the cube. See Sorokina and Zeilfelder, -- p. 76. ymin :: Cube -> Double -ymin cube = (j' - 1/2) +ymin cube = (j' - 1 / 2) where j' = fromIntegral (j cube) :: Double -- | The back boundary of the cube. See Sorokina and Zeilfelder, -- p. 76. ymax :: Cube -> Double -ymax cube = (j' + 1/2) +ymax cube = (j' + 1 / 2) where j' = fromIntegral (j cube) :: Double -- | The bottom boundary of the cube. See Sorokina and Zeilfelder, -- p. 76. zmin :: Cube -> Double -zmin cube = (k' - 1/2) +zmin cube = (k' - 1 / 2) where k' = fromIntegral (k cube) :: Double -- | The top boundary of the cube. See Sorokina and Zeilfelder, -- p. 76. zmax :: Cube -> Double -zmax cube = (k' + 1/2) +zmax cube = (k' + 1 / 2) where k' = fromIntegral (k cube) :: Double @@ -135,7 +170,7 @@ center cube = top_face :: Cube -> Face.Face top_face cube = Face.Face v0' v1' v2' v3' where - delta = 1/2 + delta = (1 / 2) :: Double cc = center cube v0' = cc + ( Point delta (-delta) delta ) v1' = cc + ( Point delta delta delta ) @@ -148,7 +183,7 @@ top_face cube = Face.Face v0' v1' v2' v3' back_face :: Cube -> Face.Face back_face cube = Face.Face v0' v1' v2' v3' where - delta = 1/2 + delta = (1 / 2) :: Double cc = center cube v0' = cc + ( Point delta (-delta) (-delta) ) v1' = cc + ( Point delta delta (-delta) ) @@ -160,7 +195,7 @@ back_face cube = Face.Face v0' v1' v2' v3' down_face :: Cube -> Face.Face down_face cube = Face.Face v0' v1' v2' v3' where - delta = 1/2 + delta = (1 / 2) :: Double cc = center cube v0' = cc + ( Point (-delta) (-delta) (-delta) ) v1' = cc + ( Point (-delta) delta (-delta) ) @@ -173,7 +208,7 @@ down_face cube = Face.Face v0' v1' v2' v3' front_face :: Cube -> Face.Face front_face cube = Face.Face v0' v1' v2' v3' where - delta = 1/2 + delta = (1 / 2) :: Double cc = center cube v0' = cc + ( Point (-delta) (-delta) delta ) v1' = cc + ( Point (-delta) delta delta ) @@ -184,7 +219,7 @@ front_face cube = Face.Face v0' v1' v2' v3' left_face :: Cube -> Face.Face left_face cube = Face.Face v0' v1' v2' v3' where - delta = 1/2 + delta = (1 / 2) :: Double cc = center cube v0' = cc + ( Point delta (-delta) delta ) v1' = cc + ( Point (-delta) (-delta) delta ) @@ -196,7 +231,7 @@ left_face cube = Face.Face v0' v1' v2' v3' right_face :: Cube -> Face.Face right_face cube = Face.Face v0' v1' v2' v3' where - delta = 1/2 + delta = (1 / 2) :: Double cc = center cube v0' = cc + ( Point (-delta) delta delta) v1' = cc + ( Point delta delta delta ) @@ -657,9 +692,7 @@ find_containing_tetrahedron cube p = --- Tests - --- Quickcheck tests. +-- * Tests prop_opposite_octant_tetrahedra_disjoint1 :: Cube -> Bool prop_opposite_octant_tetrahedra_disjoint1 cube = @@ -702,7 +735,7 @@ prop_all_volumes_positive cube = -- we'd expect the volume of each one to be 1/24. prop_all_volumes_exact :: Cube -> Bool prop_all_volumes_exact cube = - and [volume t ~~= 1/24 | t <- tetrahedra cube] + and [volume t ~~= 1 / 24 | t <- tetrahedra cube] -- | All tetrahedron should have their v0 located at the center of the -- cube. @@ -907,7 +940,7 @@ prop_c2100_identity2 cube = 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) + - ((c t0 2 0 1 0 + c t0 2 0 0 1) / 2) where t0 = tetrahedron cube 0 t6 = tetrahedron cube 6 @@ -918,7 +951,7 @@ prop_c3000_identity cube = 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) + - ((c t0 1 0 2 0 + c t0 1 0 1 1) / 2) where t0 = tetrahedron cube 0 t6 = tetrahedron cube 6 @@ -929,7 +962,7 @@ prop_c2010_identity cube = 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) + - ((c t0 1 0 0 2 + c t0 1 0 1 1) / 2) where t0 = tetrahedron cube 0 t6 = tetrahedron cube 6 @@ -940,7 +973,7 @@ prop_c2001_identity cube = 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) + - ((c t0 0 0 3 0 + c t0 0 0 2 1) / 2) where t0 = tetrahedron cube 0 t6 = tetrahedron cube 6 @@ -951,7 +984,7 @@ prop_c1020_identity cube = 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) + - ((c t0 0 0 0 3 + c t0 0 0 1 2) / 2) where t0 = tetrahedron cube 0 t6 = tetrahedron cube 6 @@ -962,7 +995,7 @@ prop_c1002_identity cube = 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) + ((c t0 0 0 1 2 + c t0 0 0 2 1) / 2) where t0 = tetrahedron cube 0 t6 = tetrahedron cube 6 @@ -986,23 +1019,23 @@ prop_c_tilde_2100_rotation_correct cube = -- 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) + (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) + (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 @@ -1019,13 +1052,13 @@ prop_c_tilde_2100_correct cube = 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) + (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. @@ -1135,9 +1168,9 @@ prop_t7_shares_edge_with_t20 cube = t20 = tetrahedron cube 20 -p79_26_properties :: Test.Framework.Test +p79_26_properties :: TestTree p79_26_properties = - testGroup "p. 79, Section (2.6) 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, @@ -1151,9 +1184,9 @@ p79_26_properties = testProperty "c1200 identity1" prop_c1200_identity1, testProperty "c2100 identity1" prop_c2100_identity1] -p79_27_properties :: Test.Framework.Test +p79_27_properties :: TestTree p79_27_properties = - testGroup "p. 79, Section (2.7) 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, @@ -1162,9 +1195,9 @@ p79_27_properties = testProperty "c2100 identity2" prop_c2100_identity2 ] -p79_28_properties :: Test.Framework.Test +p79_28_properties :: TestTree p79_28_properties = - testGroup "p. 79, Section (2.8) 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, @@ -1173,9 +1206,9 @@ p79_28_properties = testProperty "c1011 identity" prop_c1011_identity ] -edge_incidence_tests :: Test.Framework.Test +edge_incidence_tests :: TestTree edge_incidence_tests = - testGroup "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, @@ -1192,9 +1225,9 @@ edge_incidence_tests = 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 :: TestTree cube_properties = - testGroup "Cube Properties" [ + testGroup "Cube properties" [ p79_26_properties, p79_27_properties, p79_28_properties,