-- | 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 ( Cardinal(..), cardinal_properties, cardinal_tests, ccwx, ccwy, ccwz, cwx, cwy, cwz ) where 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 | 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 :: 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 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 :: 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 ]