X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FCardinal.hs;h=300c340687fbd86daf9a21035a19207acb936f0b;hb=380f69c2f37dc154c6f908fb893beb4bb1b185a6;hp=b911003b7d6cfaedff1f31ba6179208422c6c6b4;hpb=58cf11569acb270995d2de924dda03ef526647e2;p=spline3.git diff --git a/src/Cardinal.hs b/src/Cardinal.hs index b911003..300c340 100644 --- a/src/Cardinal.hs +++ b/src/Cardinal.hs @@ -1,13 +1,38 @@ +{-# 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 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 @@ -60,7 +85,7 @@ instance Num Cardinal where 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 @@ -68,6 +93,46 @@ instance Fractional Cardinal where 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 @@ -150,32 +215,32 @@ cwy = ccwy . ccwy . ccwy -- | 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) @@ -186,3 +251,221 @@ 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 ]