src/Cardinal.hs

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