X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FCardinal.hs;h=9432d7e852a5a52d97c8941b0560f7d39354dee7;hb=96fb8fc07b8f45e13b3aa545e0889ec50d957ab8;hp=e4e9464e1bddef6ef57fd306d6423c8a707660d5;hpb=f97dbb52b73bd90a89940b9653ff274654aba9de;p=spline3.git diff --git a/src/Cardinal.hs b/src/Cardinal.hs index e4e9464..9432d7e 100644 --- a/src/Cardinal.hs +++ b/src/Cardinal.hs @@ -1,23 +1,506 @@ -module Cardinal +{-# 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 ( + Cardinal(..), + cardinal_properties, + cardinal_tests, + ccwx, + ccwy, + ccwz, + cwx, + cwy, + cwz ) where -data Cardinal = F - | B - | L - | R - | T - | D - | Sum Cardinal Cardinal +import Control.Monad (liftM, liftM2) +import Prelude hiding (LT) +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 - | Product Cardinal Cardinal - | ScalarProduct Double 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 = Sum x y - negate x = ScalarProduct (-1) x + x * y = Product x y + negate = Product (Scalar (-1)) abs x = x signum x = x - fromInteger _ = F -- Whatever. + 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 ]