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