-{-# 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
-- include the interior point and a number of composite types that
-- allow us to perform arithmetic on directions.
-module Cardinal
+--
+module Cardinal (
+ Cardinal(..),
+ cardinal_properties,
+ cardinal_tests,
+ ccwx,
+ ccwy,
+ ccwz,
+ cwx,
+ cwy,
+ cwz )
where
import Control.Monad (liftM, liftM2)
-import Prelude hiding (LT)
-
-import Test.HUnit
-import Test.Framework (Test, testGroup)
-import Test.Framework.Providers.HUnit (testCase)
-import Test.Framework.Providers.QuickCheck2 (testProperty)
-
-import Test.QuickCheck (Arbitrary(..), Property, (==>), oneof)
+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 )
data Cardinal = F -- ^ Front
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
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]
(ccwz . ccwz . ccwz . ccwz) c == c
-cardinal_tests :: Test.Framework.Test
+cardinal_tests :: TestTree
cardinal_tests =
- testGroup "Cardinal Tests" [
+ testGroup "Cardinal tests" [
testCase "c-tilde_2100 rotation correct"test_c_tilde_2100_rotation_correct ]
-cardinal_properties :: Test.Framework.Test
+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 ]
projects / spline3.git / blobdiff