+{-# 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 27 directions surrounding the
--- center of a cube. In addition to those 27 directions, we also
+-- 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 Prelude hiding (LT)
+import Control.Monad (liftM, liftM2)
+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
| B -- ^ Back
fromInteger x = Scalar (fromIntegral x)
--- | Like the Num instance, the Fractional instance allows us to
+-- | Like the Num instance, the 'Fractional' instance allows us to
-- take quotients of directions.
instance Fractional Cardinal where
x / y = Quotient x y
fromRational x = Scalar (fromRational x)
+
+instance Arbitrary Cardinal where
+ arbitrary = oneof [f,b,l,r,d,t,fl,fr,fd,ft,bl,br,bd,bt,ld,lt,
+ rd,rt,fld,flt,frd,frt,bld,blt,brd,brt,i,
+ scalar,csum,cdiff,cprod,cquot]
+ where
+ 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
+ cprod = liftM2 Product arbitrary arbitrary
+ cquot = liftM2 Quotient arbitrary arbitrary
+
+
-- | Rotate a cardinal direction counter-clockwise about the x-axis.
ccwx :: Cardinal -> Cardinal
ccwx F = F
-- | Rotate a cardinal direction counter-clockwise about the z-axis.
ccwz :: Cardinal -> Cardinal
-ccwz F = L
-ccwz B = R
-ccwz L = B
-ccwz R = F
+ccwz F = R
+ccwz B = L
+ccwz L = F
+ccwz R = B
ccwz D = D
ccwz T = T
-ccwz FL = BL
-ccwz FR = FL
-ccwz FD = LD
-ccwz FT = LT
-ccwz BL = BR
-ccwz BR = FR
-ccwz BD = RD
-ccwz BT = RT
-ccwz LD = BD
-ccwz LT = BT
-ccwz RD = FD
-ccwz RT = FT
-ccwz FLD = BLD
-ccwz FLT = BLT
-ccwz FRD = FLD
-ccwz FRT = FLT
-ccwz BLD = BRD
-ccwz BLT = BRT
-ccwz BRD = FRD
-ccwz BRT = FRT
+ccwz FL = FR
+ccwz FR = BR
+ccwz FD = RD
+ccwz FT = RT
+ccwz BL = FL
+ccwz BR = BL
+ccwz BD = LD
+ccwz BT = LT
+ccwz LD = FD
+ccwz LT = FT
+ccwz RD = BD
+ccwz RT = BT
+ccwz FLD = FRD
+ccwz FLT = FRT
+ccwz FRD = BRD
+ccwz FRT = BRT
+ccwz BLD = FLD
+ccwz BLT = FLT
+ccwz BRD = BLD
+ccwz BRT = BLT
ccwz I = I
ccwz (Scalar s) = (Scalar s)
ccwz (Sum c0 c1) = Sum (ccwz c0) (ccwz c1)
-- | Rotate a cardinal direction clockwise about the z-axis.
cwz :: Cardinal -> Cardinal
cwz = ccwz . ccwz . ccwz
+
+
+
+
+-- | We know what (c t6 2 1 0 0) should be from Sorokina and
+-- Zeilfelder, p. 87. This test checks that the directions are
+-- rotated properly. The order of the letters has to be just right
+-- since I haven't defined a proper Eq instance for Cardinals.
+test_c_tilde_2100_rotation_correct :: Assertion
+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)
+
+ 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)
+
+-- | A list of all directions, sans the interior and composite types.
+all_directions :: [Cardinal]
+all_directions = [L, R, F, B, D, T, FL, FR, FD, FT,
+ BL, BR, BD, BT, LD, LT, RD, RT, FLD,
+ FLT, FRD, FRT, BLD, BLT, BRD, BRT]
+
+
+-- | If we rotate a direction (other than front or back)
+-- counter-clockwise with respect to the x-axis, we should get a new
+-- direction.
+prop_ccwx_rotation_changes_direction :: Cardinal -> Property
+prop_ccwx_rotation_changes_direction c =
+ c `elem` [L, R, D, T, FL, FR, FD, FT, BL, BR, BD, BT, LD, LT,
+ RD, RT, FLD, FLT, FRD, FRT, BLD, BLT, BRD, BRT]
+ ==> ccwx c /= c
+
+-- | If we rotate a direction (other than front or back) clockwise
+-- with respect to the x-axis, we should get a new direction.
+prop_cwx_rotation_changes_direction :: Cardinal -> Property
+prop_cwx_rotation_changes_direction c =
+ -- The front and back faces are unchanged by x-rotation.
+ c `elem` [L, R, D, T, FL, FR, FD, FT, BL, BR, BD, BT, LD, LT,
+ RD, RT, FLD, FLT, FRD, FRT, BLD, BLT, BRD, BRT]
+ ==> cwx c /= c
+
+-- | If we rotate a direction (other than left or right)
+-- counter-clockwise with respect to the y-axis, we should get a new
+-- direction.
+prop_ccwy_rotation_changes_direction :: Cardinal -> Property
+prop_ccwy_rotation_changes_direction c =
+ c `elem` [F, B, D, T, FL, FR, FD, FT, BL, BR, BD, BT, LD, LT,
+ RD, RT, FLD, FLT, FRD, FRT, BLD, BLT, BRD, BRT]
+ ==> ccwy c /= c
+
+
+-- | If we rotate a direction (other than left or right) clockwise
+-- with respect to the y-axis, we should get a new direction.
+prop_cwy_rotation_changes_direction :: Cardinal -> Property
+prop_cwy_rotation_changes_direction c =
+ c `elem` [F, B, D, T, FL, FR, FD, FT, BL, BR, BD, BT, LD, LT,
+ RD, RT, FLD, FLT, FRD, FRT, BLD, BLT, BRD, BRT]
+ ==> cwy c /= c
+
+
+-- | If we rotate a direction (other than top or down)
+-- counter-clockwise with respect to the z-axis, we should get a new
+-- direction.
+prop_ccwz_rotation_changes_direction :: Cardinal -> Property
+prop_ccwz_rotation_changes_direction c =
+ c `elem` [L, R, F, B, FL, FR, FD, FT, BL, BR, BD, BT, LD, LT,
+ RD, RT, FLD, FLT, FRD, FRT, BLD, BLT, BRD, BRT]
+ ==> ccwz c /= c
+
+
+-- | If we rotate a direction (other than top or down) clockwise with
+-- respect to the z-axis, we should get a new direction.
+prop_cwz_rotation_changes_direction :: Cardinal -> Property
+prop_cwz_rotation_changes_direction c =
+ c `elem` [L, R, F, B, FL, FR, FD, FT, BL, BR, BD, BT, LD, LT,
+ RD, RT, FLD, FLT, FRD, FRT, BLD, BLT, BRD, BRT]
+ ==> cwz c /= c
+
+
+-- | If we are given a direction c, there should only be one direction
+-- d which, when rotated counter-clockwise with respect to the
+-- x-axis, produces c.
+prop_ccwx_rotation_result_unique :: Cardinal -> Property
+prop_ccwx_rotation_result_unique c =
+ c `elem` all_directions ==>
+ (length [ d | d <- all_directions, ccwx d == c ]) == 1
+
+-- | If we are given a direction c, there should only be one direction
+-- d which, when rotated clockwise with respect to the x-axis,
+-- produces c.
+prop_cwx_rotation_result_unique :: Cardinal -> Property
+prop_cwx_rotation_result_unique c =
+ c `elem` all_directions ==>
+ (length [ d | d <- all_directions, cwx d == c ]) == 1
+
+
+-- | If we are given a direction c, there should only be one direction
+-- d which, when rotated counter-clockwise with respect to the
+-- y-axis, produces c.
+prop_ccwy_rotation_result_unique :: Cardinal -> Property
+prop_ccwy_rotation_result_unique c =
+ c `elem` all_directions ==>
+ (length [ d | d <- all_directions, ccwy d == c ]) == 1
+
+
+-- | If we are given a direction c, there should only be one direction
+-- d which, when rotated clockwise with respect to the y-axis,
+-- produces c.
+prop_cwy_rotation_result_unique :: Cardinal -> Property
+prop_cwy_rotation_result_unique c =
+ c `elem` all_directions ==>
+ (length [ d | d <- all_directions, cwy d == c ]) == 1
+
+
+-- | If we are given a direction c, there should only be one direction
+-- d which, when rotated counter-clockwise with respect to the
+-- z-axis, produces c.
+prop_ccwz_rotation_result_unique :: Cardinal -> Property
+prop_ccwz_rotation_result_unique c =
+ c `elem` all_directions ==>
+ (length [ d | d <- all_directions, ccwz d == c ]) == 1
+
+
+-- | If we are given a direction c, there should only be one direction
+-- d which, when rotated clockwise with respect to the z-axis,
+-- produces c.
+prop_cwz_rotation_result_unique :: Cardinal -> Property
+prop_cwz_rotation_result_unique c =
+ c `elem` all_directions ==>
+ (length [ d | d <- all_directions, cwz d == c ]) == 1
+
+
+-- | If you rotate a cardinal direction four times in the clockwise
+-- (with respect to x) direction, you should wind up with the same
+-- direction.
+prop_four_cwx_is_identity :: Cardinal -> Bool
+prop_four_cwx_is_identity c =
+ (cwx . cwx . cwx . cwx) c == c
+
+-- | If you rotate a cardinal direction four times in the
+-- counter-clockwise (with respect to x) direction, you should wind up
+-- with the same direction.
+prop_four_ccwx_is_identity :: Cardinal -> Bool
+prop_four_ccwx_is_identity c =
+ (ccwx . ccwx . ccwx . ccwx) c == c
+
+-- | If you rotate a cardinal direction four times in the clockwise
+-- (with respect to y) direction, you should wind up with the same
+-- direction.
+prop_four_cwy_is_identity :: Cardinal -> Bool
+prop_four_cwy_is_identity c =
+ (cwy . cwy . cwy . cwy) c == c
+
+-- | If you rotate a cardinal direction four times in the counter-clockwise
+-- (with respect to y) direction, you should wind up with the same
+-- direction.
+prop_four_ccwy_is_identity :: Cardinal -> Bool
+prop_four_ccwy_is_identity c =
+ (ccwy . ccwy . ccwy . ccwy) c == c
+
+-- | If you rotate a cardinal direction four times in the clockwise
+-- (with respect to z) direction, you should wind up with the same
+-- direction.
+prop_four_cwz_is_identity :: Cardinal -> Bool
+prop_four_cwz_is_identity c =
+ (cwz . cwz . cwz . cwz) c == c
+
+-- | If you rotate a cardinal direction four times in the
+-- counter-clockwise (with respect to z) direction, you should wind up
+-- with the same direction.
+prop_four_ccwz_is_identity :: Cardinal -> Bool
+prop_four_ccwz_is_identity c =
+ (ccwz . ccwz . ccwz . ccwz) c == c
+
+
+cardinal_tests :: TestTree
+cardinal_tests =
+ testGroup "Cardinal tests" [
+ testCase "c-tilde_2100 rotation correct"test_c_tilde_2100_rotation_correct ]
+
+
+cardinal_properties :: TestTree
+cardinal_properties =
+ 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