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