X-Git-Url: https://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FCardinal.hs;h=74a729fcda56c52865120da466ba9e38ddab2ea5;hb=HEAD;hp=530ea1acbf5e94014bda8b59f04f9a2e382cf2fd;hpb=5297a1f696e0f99ceaef5e3adb76c5ab425f528d;p=spline3.git diff --git a/src/Cardinal.hs b/src/Cardinal.hs index 530ea1a..d3a76b6 100644 --- a/src/Cardinal.hs +++ b/src/Cardinal.hs @@ -1,9 +1,3 @@ -{-# LANGUAGE NoMonomorphismRestriction #-} - --- --- Disable the MR so that let tp = testProperty does what it should! --- - -- | The Cardinal module contains the Cardinal data type, representing -- a cardinal direction (one of the 26 directions surrounding the -- center of a cube. In addition to those 26 directions, we also @@ -23,11 +17,23 @@ module Cardinal ( where import Control.Monad (liftM, liftM2) -import Prelude hiding (LT) +import Prelude ( + (.), + Bool, + Double, + Eq( (==), (/=) ), + Fractional( (/), fromRational, recip ), + Num( (+), (-), (*), abs, negate, signum, fromInteger ), + Show, + elem, + fromIntegral, + length, + return ) import Test.Tasty ( TestTree, testGroup ) import Test.Tasty.HUnit ( Assertion, assertEqual, testCase ) import Test.Tasty.QuickCheck ( Arbitrary( arbitrary ), + Gen, Property, (==>), oneof, testProperty ) @@ -99,33 +105,33 @@ instance Arbitrary Cardinal where rd,rt,fld,flt,frd,frt,bld,blt,brd,brt,i, scalar,csum,cdiff,cprod,cquot] where - f = return F - b = return B - l = return L - r = return R - d = return D - t = return T - fl = return FL - fr = return FR - fd = return FD - ft = return FT - bl = return BL - br = return BR - bd = return BD - bt = return BT - ld = return LD - lt = return LT - rd = return RD - rt = return RT - fld = return FLD - flt = return FLT - frd = return FRD - frt = return FRT - bld = return BLD - blt = return BLT - brd = return BRD - brt = return BRT - i = return I + f = return F :: Gen Cardinal + b = return B :: Gen Cardinal + l = return L :: Gen Cardinal + r = return R :: Gen Cardinal + d = return D :: Gen Cardinal + t = return T :: Gen Cardinal + fl = return FL :: Gen Cardinal + fr = return FR :: Gen Cardinal + fd = return FD :: Gen Cardinal + ft = return FT :: Gen Cardinal + bl = return BL :: Gen Cardinal + br = return BR :: Gen Cardinal + bd = return BD :: Gen Cardinal + bt = return BT :: Gen Cardinal + ld = return LD :: Gen Cardinal + lt = return LT :: Gen Cardinal + rd = return RD :: Gen Cardinal + rt = return RT :: Gen Cardinal + fld = return FLD :: Gen Cardinal + flt = return FLT :: Gen Cardinal + frd = return FRD :: Gen Cardinal + frt = return FRT :: Gen Cardinal + bld = return BLD :: Gen Cardinal + blt = return BLT :: Gen Cardinal + brd = return BRD :: Gen Cardinal + brt = return BRT :: Gen Cardinal + i = return I :: Gen Cardinal scalar = liftM Scalar arbitrary csum = liftM2 Sum arbitrary arbitrary cdiff = liftM2 Difference arbitrary arbitrary @@ -264,22 +270,22 @@ test_c_tilde_2100_rotation_correct = assertEqual "auto-rotate equals manual rotate" ((ccwz . ccwz . cwy) expr1) expr2 where expr1 = - (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) expr2 = - (3/8)*I + - (1/12)*(F + L + R + B) + - (1/64)*(FT + LT + RT + BT) + - (7/48)*T + - (1/48)*D + - (1/96)*(FL + BR + FR + BL) + - (1/192)*(FD + LD + RD + BD) + (3 / 8)*I + + (1 / 12)*(F + L + R + B) + + (1 / 64)*(FT + LT + RT + BT) + + (7 / 48)*T + + (1 / 48)*D + + (1 / 96)*(FL + BR + FR + BL) + + (1 / 192)*(FD + LD + RD + BD) -- | A list of all directions, sans the interior and composite types. all_directions :: [Cardinal] @@ -448,24 +454,58 @@ cardinal_tests = cardinal_properties :: TestTree cardinal_properties = - let tp = testProperty - in - testGroup "Cardinal properties" [ - tp "ccwx rotation changes direction" prop_ccwx_rotation_changes_direction, - tp "cwx rotation changes direction" prop_cwx_rotation_changes_direction, - tp "ccwy rotation changes direction" prop_ccwy_rotation_changes_direction, - tp "cwy rotation changes direction" prop_cwy_rotation_changes_direction, - tp "ccwz rotation changes direction" prop_ccwz_rotation_changes_direction, - tp "cwz rotation changes direction" prop_cwz_rotation_changes_direction, - tp "ccwx rotation result unique" prop_ccwx_rotation_result_unique, - tp "cwx rotation result unique" prop_cwx_rotation_result_unique, - tp "ccwy rotation result unique" prop_ccwy_rotation_result_unique, - tp "cwy rotation result unique" prop_cwy_rotation_result_unique, - tp "ccwz rotation result unique" prop_ccwz_rotation_result_unique, - tp "cwz rotation result unique" prop_cwz_rotation_result_unique, - tp "four cwx is identity" prop_four_cwx_is_identity, - tp "four ccwx is identity" prop_four_ccwx_is_identity, - tp "four cwy is identity" prop_four_cwy_is_identity, - tp "four ccwy is identity" prop_four_ccwy_is_identity, - tp "four cwz is identity" prop_four_cwz_is_identity, - tp "four ccwz is identity" prop_four_ccwz_is_identity ] + testGroup "Cardinal properties" [ + testProperty + "ccwx rotation changes direction" + prop_ccwx_rotation_changes_direction, + testProperty + "cwx rotation changes direction" + prop_cwx_rotation_changes_direction, + testProperty + "ccwy rotation changes direction" + prop_ccwy_rotation_changes_direction, + testProperty + "cwy rotation changes direction" + prop_cwy_rotation_changes_direction, + testProperty + "ccwz rotation changes direction" + prop_ccwz_rotation_changes_direction, + testProperty + "cwz rotation changes direction" + prop_cwz_rotation_changes_direction, + testProperty + "ccwx rotation result unique" + prop_ccwx_rotation_result_unique, + testProperty + "cwx rotation result unique" + prop_cwx_rotation_result_unique, + testProperty + "ccwy rotation result unique" + prop_ccwy_rotation_result_unique, + testProperty + "cwy rotation result unique" + prop_cwy_rotation_result_unique, + testProperty + "ccwz rotation result unique" + prop_ccwz_rotation_result_unique, + testProperty + "cwz rotation result unique" + prop_cwz_rotation_result_unique, + testProperty + "four cwx is identity" + prop_four_cwx_is_identity, + testProperty + "four ccwx is identity" + prop_four_ccwx_is_identity, + testProperty + "four cwy is identity" + prop_four_cwy_is_identity, + testProperty + "four ccwy is identity" + prop_four_ccwy_is_identity, + testProperty + "four cwz is identity" + prop_four_cwz_is_identity, + testProperty + "four ccwz is identity" + prop_four_ccwz_is_identity ]