src/Cardinal.hs

   1 {-# LANGUAGE NoMonomorphismRestriction #-}
   2
   3 --
   4 -- Disable the MR so that let tp = testProperty does what it should!
   5 --
   6
   7 -- | The Cardinal module contains the Cardinal data type, representing
   8 --   a cardinal direction (one of the 26 directions surrounding the
   9 --   center of a cube. In addition to those 26 directions, we also
  10 --   include the interior point and a number of composite types that
  11 --   allow us to perform arithmetic on directions.
  12 --
  13 module Cardinal (
  14   Cardinal(..),
  15   cardinal_properties,
  16   cardinal_tests,
  17   ccwx,
  18   ccwy,
  19   ccwz,
  20   cwx,
  21   cwy,
  22   cwz )
  23 where
  24
  25 import Control.Monad (liftM, liftM2)
  26 import Prelude hiding (LT)
  27
  28 import Test.HUnit (Assertion, assertEqual)
  29 import Test.Framework (Test, testGroup)
  30 import Test.Framework.Providers.HUnit (testCase)
  31 import Test.Framework.Providers.QuickCheck2 (testProperty)
  32
  33 import Test.QuickCheck (Arbitrary(..), Property, (==>), oneof)
  34
  35
  36 data Cardinal = F   -- ^ Front
  37               | B   -- ^ Back
  38               | L   -- ^ Left
  39               | R   -- ^ Right
  40               | D   -- ^ Down
  41               | T   -- ^ Top
  42               | FL  -- ^ Front Left
  43               | FR  -- ^ Front Right
  44               | FD  -- ^ Front Down
  45               | FT  -- ^ Front Top
  46               | BL  -- ^ Back Left
  47               | BR  -- ^ Back Right
  48               | BD  -- ^ Back Down
  49               | BT  -- ^ Back Top
  50               | LD  -- ^ Left Down
  51               | LT  -- ^ Left Top
  52               | RD  -- ^ Right Down
  53               | RT  -- ^ Right Top
  54               | FLD -- ^ Front Left Down
  55               | FLT -- ^ Front Left Top
  56               | FRD -- ^ Front Right Down
  57               | FRT -- ^ Front Right Top
  58               | BLD -- ^ Back Left Down
  59               | BLT -- ^ Back Left Top
  60               | BRD -- ^ Back Right Down
  61               | BRT -- ^ Back Right Top
  62               | I   -- ^ Interior
  63               | Scalar Double -- ^ A wrapper around a scalar value.
  64               | Sum Cardinal Cardinal -- ^ The sum of two directions.
  65               | Difference Cardinal Cardinal
  66               -- ^ The difference of two directions, the first minus the second.
  67               | Product Cardinal Cardinal -- ^ The product of two directions.
  68               | Quotient Cardinal Cardinal
  69               -- ^ The quotient of two directions, the first divided by the
  70               --   second.
  71                 deriving (Show, Eq)
  72
  73
  74 -- | By making Cardinal an instance of 'Num', we gain the ability to
  75 --   add, subtract, and multiply directions. The results of these
  76 --   operations are never actually calculated; the types just keep
  77 --   track of which operations were performed in which order.
  78 instance Num Cardinal where
  79     x + y = Sum x y
  80     x - y = Difference x y
  81     x * y = Product x y
  82     negate = Product (Scalar (-1))
  83     abs x = x
  84     signum x = x
  85     fromInteger x = Scalar (fromIntegral x)
  86
  87
  88 -- | Like the Num instance, the 'Fractional' instance allows us to
  89 --   take quotients of directions.
  90 instance Fractional Cardinal where
  91     x / y   = Quotient x y
  92     recip = Quotient (Scalar 1)
  93     fromRational x = Scalar (fromRational x)
  94
  95
  96
  97 instance Arbitrary Cardinal where
  98     arbitrary = oneof [f,b,l,r,d,t,fl,fr,fd,ft,bl,br,bd,bt,ld,lt,
  99                        rd,rt,fld,flt,frd,frt,bld,blt,brd,brt,i,
 100                        scalar,csum,cdiff,cprod,cquot]
 101         where
 102           f = return F
 103           b = return B
 104           l = return L
 105           r = return R
 106           d = return D
 107           t = return T
 108           fl = return FL
 109           fr = return FR
 110           fd = return FD
 111           ft = return FT
 112           bl = return BL
 113           br = return BR
 114           bd = return BD
 115           bt = return BT
 116           ld = return LD
 117           lt = return LT
 118           rd = return RD
 119           rt = return RT
 120           fld = return FLD
 121           flt = return FLT
 122           frd = return FRD
 123           frt = return FRT
 124           bld = return BLD
 125           blt = return BLT
 126           brd = return BRD
 127           brt = return BRT
 128           i = return I
 129           scalar = liftM Scalar arbitrary
 130           csum = liftM2 Sum arbitrary arbitrary
 131           cdiff = liftM2 Difference arbitrary arbitrary
 132           cprod = liftM2 Product arbitrary arbitrary
 133           cquot = liftM2 Quotient arbitrary arbitrary
 134
 135
 136 -- | Rotate a cardinal direction counter-clockwise about the x-axis.
 137 ccwx :: Cardinal -> Cardinal
 138 ccwx F = F
 139 ccwx B = B
 140 ccwx L = T
 141 ccwx R = D
 142 ccwx D = L
 143 ccwx T = R
 144 ccwx FL = FT
 145 ccwx FR = FD
 146 ccwx FD = FL
 147 ccwx FT = FR
 148 ccwx BL = BT
 149 ccwx BR = BD
 150 ccwx BD = BL
 151 ccwx BT = BR
 152 ccwx LD = LT
 153 ccwx LT = RT
 154 ccwx RD = LD
 155 ccwx RT = RD
 156 ccwx FLD = FLT
 157 ccwx FLT = FRT
 158 ccwx FRD = FLD
 159 ccwx FRT = FRD
 160 ccwx BLD = BLT
 161 ccwx BLT = BRT
 162 ccwx BRD = BLD
 163 ccwx BRT = BRD
 164 ccwx I = I
 165 ccwx (Scalar s) = (Scalar s)
 166 ccwx (Sum c0 c1) = Sum (ccwx c0) (ccwx c1)
 167 ccwx (Difference c0 c1) = Difference (ccwx c0) (ccwx c1)
 168 ccwx (Product c0 c1) = Product (ccwx c0) (ccwx c1)
 169 ccwx (Quotient c0 c1) = Quotient (ccwx c0) (ccwx c1)
 170
 171 -- | Rotate a cardinal direction clockwise about the x-axis.
 172 cwx :: Cardinal -> Cardinal
 173 cwx = ccwx . ccwx . ccwx
 174
 175
 176 -- | Rotate a cardinal direction counter-clockwise about the y-axis.
 177 ccwy :: Cardinal -> Cardinal
 178 ccwy F = D
 179 ccwy B = T
 180 ccwy L = L
 181 ccwy R = R
 182 ccwy D = B
 183 ccwy T = F
 184 ccwy FL = LD
 185 ccwy FR = RD
 186 ccwy FD = BD
 187 ccwy FT = FD
 188 ccwy BL = LT
 189 ccwy BR = RT
 190 ccwy BD = BT
 191 ccwy BT = FT
 192 ccwy LD = BL
 193 ccwy LT = FL
 194 ccwy RD = BR
 195 ccwy RT = FR
 196 ccwy FLD = BLD
 197 ccwy FLT = FLD
 198 ccwy FRD = BRD
 199 ccwy FRT = FRD
 200 ccwy BLD = BLT
 201 ccwy BLT = FLT
 202 ccwy BRD = BRT
 203 ccwy BRT = FRT
 204 ccwy I = I
 205 ccwy (Scalar s) = (Scalar s)
 206 ccwy (Sum c0 c1) = Sum (ccwy c0) (ccwy c1)
 207 ccwy (Difference c0 c1) = Difference (ccwy c0) (ccwy c1)
 208 ccwy (Product c0 c1) = Product (ccwy c0) (ccwy c1)
 209 ccwy (Quotient c0 c1) = Quotient (ccwy c0) (ccwy c1)
 210
 211 -- | Rotate a cardinal direction clockwise about the y-axis.
 212 cwy :: Cardinal -> Cardinal
 213 cwy = ccwy . ccwy . ccwy
 214
 215
 216 -- | Rotate a cardinal direction counter-clockwise about the z-axis.
 217 ccwz :: Cardinal -> Cardinal
 218 ccwz F = R
 219 ccwz B = L
 220 ccwz L = F
 221 ccwz R = B
 222 ccwz D = D
 223 ccwz T = T
 224 ccwz FL = FR
 225 ccwz FR = BR
 226 ccwz FD = RD
 227 ccwz FT = RT
 228 ccwz BL = FL
 229 ccwz BR = BL
 230 ccwz BD = LD
 231 ccwz BT = LT
 232 ccwz LD = FD
 233 ccwz LT = FT
 234 ccwz RD = BD
 235 ccwz RT = BT
 236 ccwz FLD = FRD
 237 ccwz FLT = FRT
 238 ccwz FRD = BRD
 239 ccwz FRT = BRT
 240 ccwz BLD = FLD
 241 ccwz BLT = FLT
 242 ccwz BRD = BLD
 243 ccwz BRT = BLT
 244 ccwz I = I
 245 ccwz (Scalar s) = (Scalar s)
 246 ccwz (Sum c0 c1) = Sum (ccwz c0) (ccwz c1)
 247 ccwz (Difference c0 c1) = Difference (ccwz c0) (ccwz c1)
 248 ccwz (Product c0 c1) = Product (ccwz c0) (ccwz c1)
 249 ccwz (Quotient c0 c1) = Quotient (ccwz c0) (ccwz c1)
 250
 251 -- | Rotate a cardinal direction clockwise about the z-axis.
 252 cwz :: Cardinal -> Cardinal
 253 cwz = ccwz . ccwz . ccwz
 254
 255
 256
 257
 258 -- | We know what (c t6 2 1 0 0) should be from Sorokina and
 259 --   Zeilfelder, p. 87.  This test checks that the directions are
 260 --   rotated properly.  The order of the letters has to be just right
 261 --   since I haven't defined a proper Eq instance for Cardinals.
 262 test_c_tilde_2100_rotation_correct :: Assertion
 263 test_c_tilde_2100_rotation_correct =
 264     assertEqual "auto-rotate equals manual rotate" ((ccwz . ccwz . cwy) expr1) expr2
 265     where
 266       expr1 =
 267           (3/8)*I +
 268           (1/12)*(T + R + L + D) +
 269           (1/64)*(FT + FR + FL + FD) +
 270           (7/48)*F +
 271           (1/48)*B +
 272           (1/96)*(RT + LD + LT + RD) +
 273           (1/192)*(BT + BR + BL + BD)
 274
 275       expr2 =
 276           (3/8)*I +
 277           (1/12)*(F + L + R + B) +
 278           (1/64)*(FT + LT + RT + BT) +
 279           (7/48)*T +
 280           (1/48)*D +
 281           (1/96)*(FL + BR + FR + BL) +
 282           (1/192)*(FD + LD + RD + BD)
 283
 284 -- | A list of all directions, sans the interior and composite types.
 285 all_directions :: [Cardinal]
 286 all_directions = [L, R, F, B, D, T, FL, FR, FD, FT,
 287                   BL, BR, BD, BT, LD, LT, RD, RT, FLD,
 288                   FLT, FRD, FRT, BLD, BLT, BRD, BRT]
 289
 290
 291 -- | If we rotate a direction (other than front or back)
 292 --   counter-clockwise with respect to the x-axis, we should get a new
 293 --   direction.
 294 prop_ccwx_rotation_changes_direction :: Cardinal -> Property
 295 prop_ccwx_rotation_changes_direction c =
 296     c `elem` [L, R, D, T, FL, FR, FD, FT, BL, BR, BD, BT, LD, LT,
 297                RD, RT, FLD, FLT, FRD, FRT, BLD, BLT, BRD, BRT]
 298           ==> ccwx c /= c
 299
 300 -- | If we rotate a direction (other than front or back) clockwise
 301 --   with respect to the x-axis, we should get a new direction.
 302 prop_cwx_rotation_changes_direction :: Cardinal -> Property
 303 prop_cwx_rotation_changes_direction c =
 304     -- The front and back faces are unchanged by x-rotation.
 305     c `elem` [L, R, D, T, FL, FR, FD, FT, BL, BR, BD, BT, LD, LT,
 306                RD, RT, FLD, FLT, FRD, FRT, BLD, BLT, BRD, BRT]
 307           ==> cwx c /= c
 308
 309 -- | If we rotate a direction (other than left or right)
 310 --   counter-clockwise with respect to the y-axis, we should get a new
 311 --   direction.
 312 prop_ccwy_rotation_changes_direction :: Cardinal -> Property
 313 prop_ccwy_rotation_changes_direction c =
 314     c `elem` [F, B, D, T, FL, FR, FD, FT, BL, BR, BD, BT, LD, LT,
 315                RD, RT, FLD, FLT, FRD, FRT, BLD, BLT, BRD, BRT]
 316           ==> ccwy c /= c
 317
 318
 319 -- | If we rotate a direction (other than left or right) clockwise
 320 --   with respect to the y-axis, we should get a new direction.
 321 prop_cwy_rotation_changes_direction :: Cardinal -> Property
 322 prop_cwy_rotation_changes_direction c =
 323     c `elem` [F, B, D, T, FL, FR, FD, FT, BL, BR, BD, BT, LD, LT,
 324                RD, RT, FLD, FLT, FRD, FRT, BLD, BLT, BRD, BRT]
 325           ==> cwy c /= c
 326
 327
 328 -- | If we rotate a direction (other than top or down)
 329 --   counter-clockwise with respect to the z-axis, we should get a new
 330 --   direction.
 331 prop_ccwz_rotation_changes_direction :: Cardinal -> Property
 332 prop_ccwz_rotation_changes_direction c =
 333     c `elem` [L, R, F, B, FL, FR, FD, FT, BL, BR, BD, BT, LD, LT,
 334                RD, RT, FLD, FLT, FRD, FRT, BLD, BLT, BRD, BRT]
 335           ==> ccwz c /= c
 336
 337
 338 -- | If we rotate a direction (other than top or down) clockwise with
 339 --   respect to the z-axis, we should get a new direction.
 340 prop_cwz_rotation_changes_direction :: Cardinal -> Property
 341 prop_cwz_rotation_changes_direction c =
 342     c `elem` [L, R, F, B, FL, FR, FD, FT, BL, BR, BD, BT, LD, LT,
 343                RD, RT, FLD, FLT, FRD, FRT, BLD, BLT, BRD, BRT]
 344           ==> cwz c /= c
 345
 346
 347 -- | If we are given a direction c, there should only be one direction
 348 --   d which, when rotated counter-clockwise with respect to the
 349 --   x-axis, produces c.
 350 prop_ccwx_rotation_result_unique :: Cardinal -> Property
 351 prop_ccwx_rotation_result_unique c =
 352     c `elem` all_directions ==>
 353           (length [ d | d <- all_directions, ccwx d == c ]) == 1
 354
 355 -- | If we are given a direction c, there should only be one direction
 356 --   d which, when rotated clockwise with respect to the x-axis,
 357 --   produces c.
 358 prop_cwx_rotation_result_unique :: Cardinal -> Property
 359 prop_cwx_rotation_result_unique c =
 360     c `elem` all_directions ==>
 361           (length [ d | d <- all_directions, cwx d == c ]) == 1
 362
 363
 364 -- | If we are given a direction c, there should only be one direction
 365 --   d which, when rotated counter-clockwise with respect to the
 366 --   y-axis, produces c.
 367 prop_ccwy_rotation_result_unique :: Cardinal -> Property
 368 prop_ccwy_rotation_result_unique c =
 369     c `elem` all_directions ==>
 370           (length [ d | d <- all_directions, ccwy d == c ]) == 1
 371
 372
 373 -- | If we are given a direction c, there should only be one direction
 374 --   d which, when rotated clockwise with respect to the y-axis,
 375 --   produces c.
 376 prop_cwy_rotation_result_unique :: Cardinal -> Property
 377 prop_cwy_rotation_result_unique c =
 378     c `elem` all_directions ==>
 379           (length [ d | d <- all_directions, cwy d == c ]) == 1
 380
 381
 382 -- | If we are given a direction c, there should only be one direction
 383 --   d which, when rotated counter-clockwise with respect to the
 384 --   z-axis, produces c.
 385 prop_ccwz_rotation_result_unique :: Cardinal -> Property
 386 prop_ccwz_rotation_result_unique c =
 387     c `elem` all_directions ==>
 388           (length [ d | d <- all_directions, ccwz d == c ]) == 1
 389
 390
 391 -- | If we are given a direction c, there should only be one direction
 392 --   d which, when rotated clockwise with respect to the z-axis,
 393 --   produces c.
 394 prop_cwz_rotation_result_unique :: Cardinal -> Property
 395 prop_cwz_rotation_result_unique c =
 396     c `elem` all_directions ==>
 397           (length [ d | d <- all_directions, cwz d == c ]) == 1
 398
 399
 400 -- | If you rotate a cardinal direction four times in the clockwise
 401 --   (with respect to x) direction, you should wind up with the same
 402 --   direction.
 403 prop_four_cwx_is_identity :: Cardinal -> Bool
 404 prop_four_cwx_is_identity c =
 405     (cwx . cwx . cwx . cwx) c == c
 406
 407 -- | If you rotate a cardinal direction four times in the
 408 --   counter-clockwise (with respect to x) direction, you should wind up
 409 --   with the same direction.
 410 prop_four_ccwx_is_identity :: Cardinal -> Bool
 411 prop_four_ccwx_is_identity c =
 412     (ccwx . ccwx . ccwx . ccwx) c == c
 413
 414 -- | If you rotate a cardinal direction four times in the clockwise
 415 --   (with respect to y) direction, you should wind up with the same
 416 --   direction.
 417 prop_four_cwy_is_identity :: Cardinal -> Bool
 418 prop_four_cwy_is_identity c =
 419     (cwy . cwy . cwy . cwy) c == c
 420
 421 -- | If you rotate a cardinal direction four times in the counter-clockwise
 422 --   (with respect to y) direction, you should wind up with the same
 423 --   direction.
 424 prop_four_ccwy_is_identity :: Cardinal -> Bool
 425 prop_four_ccwy_is_identity c =
 426     (ccwy . ccwy . ccwy . ccwy) c == c
 427
 428 -- | If you rotate a cardinal direction four times in the clockwise
 429 --   (with respect to z) direction, you should wind up with the same
 430 --   direction.
 431 prop_four_cwz_is_identity :: Cardinal -> Bool
 432 prop_four_cwz_is_identity c =
 433     (cwz . cwz . cwz . cwz) c == c
 434
 435 -- | If you rotate a cardinal direction four times in the
 436 --   counter-clockwise (with respect to z) direction, you should wind up
 437 --   with the same direction.
 438 prop_four_ccwz_is_identity :: Cardinal -> Bool
 439 prop_four_ccwz_is_identity c =
 440     (ccwz . ccwz . ccwz . ccwz) c == c
 441
 442
 443 cardinal_tests :: Test.Framework.Test
 444 cardinal_tests =
 445   testGroup "Cardinal Tests" [
 446     testCase "c-tilde_2100 rotation correct"test_c_tilde_2100_rotation_correct ]
 447
 448
 449 cardinal_properties :: Test.Framework.Test
 450 cardinal_properties =
 451   let tp = testProperty
 452   in
 453     testGroup "Cardinal Properties" [
 454       tp "ccwx rotation changes direction" prop_ccwx_rotation_changes_direction,
 455       tp "cwx rotation changes direction" prop_cwx_rotation_changes_direction,
 456       tp "ccwy rotation changes direction" prop_ccwy_rotation_changes_direction,
 457       tp "cwy rotation changes direction" prop_cwy_rotation_changes_direction,
 458       tp "ccwz rotation changes direction" prop_ccwz_rotation_changes_direction,
 459       tp "cwz rotation changes direction" prop_cwz_rotation_changes_direction,
 460       tp "ccwx rotation result unique" prop_ccwx_rotation_result_unique,
 461       tp "cwx rotation result unique" prop_cwx_rotation_result_unique,
 462       tp "ccwy rotation result unique" prop_ccwy_rotation_result_unique,
 463       tp "cwy rotation result unique" prop_cwy_rotation_result_unique,
 464       tp "ccwz rotation result unique" prop_ccwz_rotation_result_unique,
 465       tp "cwz rotation result unique" prop_cwz_rotation_result_unique,
 466       tp "four cwx is identity" prop_four_cwx_is_identity,
 467       tp "four ccwx is identity" prop_four_ccwx_is_identity,
 468       tp "four cwy is identity" prop_four_cwy_is_identity,
 469       tp "four ccwy is identity" prop_four_ccwy_is_identity,
 470       tp "four cwz is identity" prop_four_cwz_is_identity,
 471       tp "four ccwz is identity" prop_four_ccwz_is_identity ]