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