{-# 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 where import Control.Monad (liftM, liftM2) import Prelude hiding (LT) import Test.HUnit (Assertion, assertEqual) import Test.Framework (Test, testGroup) import Test.Framework.Providers.HUnit (testCase) import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.QuickCheck (Arbitrary(..), Property, (==>), oneof) data Cardinal = F -- ^ Front | B -- ^ Back | L -- ^ Left | R -- ^ Right | D -- ^ Down | T -- ^ Top | FL -- ^ Front Left | FR -- ^ Front Right | FD -- ^ Front Down | FT -- ^ Front Top | BL -- ^ Back Left | BR -- ^ Back Right | BD -- ^ Back Down | BT -- ^ Back Top | LD -- ^ Left Down | LT -- ^ Left Top | RD -- ^ Right Down | RT -- ^ Right Top | FLD -- ^ Front Left Down | FLT -- ^ Front Left Top | FRD -- ^ Front Right Down | FRT -- ^ Front Right Top | BLD -- ^ Back Left Down | BLT -- ^ Back Left Top | BRD -- ^ Back Right Down | BRT -- ^ Back Right Top | I -- ^ Interior | Scalar Double -- ^ A wrapper around a scalar value. | Sum Cardinal Cardinal -- ^ The sum of two directions. | Difference Cardinal Cardinal -- ^ The difference of two directions, the first minus the second. | Product Cardinal Cardinal -- ^ The product of two directions. | Quotient Cardinal Cardinal -- ^ The quotient of two directions, the first divided by the -- second. deriving (Show, Eq) -- | By making Cardinal an instance of 'Num', we gain the ability to -- add, subtract, and multiply directions. The results of these -- operations are never actually calculated; the types just keep -- track of which operations were performed in which order. instance Num Cardinal where x + y = Sum x y x - y = Difference x y x * y = Product x y negate = Product (Scalar (-1)) abs x = x signum x = x fromInteger x = Scalar (fromIntegral x) -- | Like the Num instance, the 'Fractional' instance allows us to -- take quotients of directions. instance Fractional Cardinal where x / y = Quotient x y recip = Quotient (Scalar 1) 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 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 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 ccwx B = B ccwx L = T ccwx R = D ccwx D = L ccwx T = R ccwx FL = FT ccwx FR = FD ccwx FD = FL ccwx FT = FR ccwx BL = BT ccwx BR = BD ccwx BD = BL ccwx BT = BR ccwx LD = LT ccwx LT = RT ccwx RD = LD ccwx RT = RD ccwx FLD = FLT ccwx FLT = FRT ccwx FRD = FLD ccwx FRT = FRD ccwx BLD = BLT ccwx BLT = BRT ccwx BRD = BLD ccwx BRT = BRD ccwx I = I ccwx (Scalar s) = (Scalar s) ccwx (Sum c0 c1) = Sum (ccwx c0) (ccwx c1) ccwx (Difference c0 c1) = Difference (ccwx c0) (ccwx c1) ccwx (Product c0 c1) = Product (ccwx c0) (ccwx c1) ccwx (Quotient c0 c1) = Quotient (ccwx c0) (ccwx c1) -- | Rotate a cardinal direction clockwise about the x-axis. cwx :: Cardinal -> Cardinal cwx = ccwx . ccwx . ccwx -- | Rotate a cardinal direction counter-clockwise about the y-axis. ccwy :: Cardinal -> Cardinal ccwy F = D ccwy B = T ccwy L = L ccwy R = R ccwy D = B ccwy T = F ccwy FL = LD ccwy FR = RD ccwy FD = BD ccwy FT = FD ccwy BL = LT ccwy BR = RT ccwy BD = BT ccwy BT = FT ccwy LD = BL ccwy LT = FL ccwy RD = BR ccwy RT = FR ccwy FLD = BLD ccwy FLT = FLD ccwy FRD = BRD ccwy FRT = FRD ccwy BLD = BLT ccwy BLT = FLT ccwy BRD = BRT ccwy BRT = FRT ccwy I = I ccwy (Scalar s) = (Scalar s) ccwy (Sum c0 c1) = Sum (ccwy c0) (ccwy c1) ccwy (Difference c0 c1) = Difference (ccwy c0) (ccwy c1) ccwy (Product c0 c1) = Product (ccwy c0) (ccwy c1) ccwy (Quotient c0 c1) = Quotient (ccwy c0) (ccwy c1) -- | Rotate a cardinal direction clockwise about the y-axis. cwy :: Cardinal -> Cardinal cwy = ccwy . ccwy . ccwy -- | Rotate a cardinal direction counter-clockwise about the z-axis. ccwz :: Cardinal -> Cardinal ccwz F = R ccwz B = L ccwz L = F ccwz R = B ccwz D = D ccwz T = T 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) ccwz (Difference c0 c1) = Difference (ccwz c0) (ccwz c1) ccwz (Product c0 c1) = Product (ccwz c0) (ccwz c1) ccwz (Quotient c0 c1) = Quotient (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 :: Test.Framework.Test cardinal_tests = testGroup "Cardinal Tests" [ testCase "c-tilde_2100 rotation correct"test_c_tilde_2100_rotation_correct ] cardinal_properties :: Test.Framework.Test 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 ]