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 import Test.Tasty ( TestTree, testGroup )
  28 import Test.Tasty.HUnit ( Assertion, assertEqual, testCase )
  29 import Test.Tasty.QuickCheck (
  30   Arbitrary(..),
  31   Property, (==>),
  32   oneof,
  33   testProperty )
  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 :: TestTree
 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 :: TestTree
 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 ]