1 {-# LANGUAGE NoMonomorphismRestriction #-}
4 -- Disable the MR so that let tp = testProperty does what it should!
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.
25 import Control.Monad (liftM, liftM2)
31 Fractional( (/), fromRational, recip ),
32 Num( (+), (-), (*), abs, negate, signum, fromInteger ),
38 import Test.Tasty ( TestTree, testGroup )
39 import Test.Tasty.HUnit ( Assertion, assertEqual, testCase )
40 import Test.Tasty.QuickCheck (
41 Arbitrary( arbitrary ),
48 data Cardinal = F -- ^ Front
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
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
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
92 x - y = Difference x y
94 negate = Product (Scalar (-1))
97 fromInteger x = Scalar (fromIntegral x)
100 -- | Like the Num instance, the 'Fractional' instance allows us to
101 -- take quotients of directions.
102 instance Fractional Cardinal where
104 recip = Quotient (Scalar 1)
105 fromRational x = Scalar (fromRational x)
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]
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
148 -- | Rotate a cardinal direction counter-clockwise about the x-axis.
149 ccwx :: Cardinal -> Cardinal
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)
183 -- | Rotate a cardinal direction clockwise about the x-axis.
184 cwx :: Cardinal -> Cardinal
185 cwx = ccwx . ccwx . ccwx
188 -- | Rotate a cardinal direction counter-clockwise about the y-axis.
189 ccwy :: Cardinal -> Cardinal
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)
223 -- | Rotate a cardinal direction clockwise about the y-axis.
224 cwy :: Cardinal -> Cardinal
225 cwy = ccwy . ccwy . ccwy
228 -- | Rotate a cardinal direction counter-clockwise about the z-axis.
229 ccwz :: Cardinal -> Cardinal
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)
263 -- | Rotate a cardinal direction clockwise about the z-axis.
264 cwz :: Cardinal -> Cardinal
265 cwz = ccwz . ccwz . ccwz
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
280 (1/12)*(T + R + L + D) +
281 (1/64)*(FT + FR + FL + FD) +
284 (1/96)*(RT + LD + LT + RD) +
285 (1/192)*(BT + BR + BL + BD)
289 (1/12)*(F + L + R + B) +
290 (1/64)*(FT + LT + RT + BT) +
293 (1/96)*(FL + BR + FR + BL) +
294 (1/192)*(FD + LD + RD + BD)
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]
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
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]
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]
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
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]
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]
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
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]
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]
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
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,
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
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
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,
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
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
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,
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
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
415 prop_four_cwx_is_identity :: Cardinal -> Bool
416 prop_four_cwx_is_identity c =
417 (cwx . cwx . cwx . cwx) c == c
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
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
429 prop_four_cwy_is_identity :: Cardinal -> Bool
430 prop_four_cwy_is_identity c =
431 (cwy . cwy . cwy . cwy) c == c
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
436 prop_four_ccwy_is_identity :: Cardinal -> Bool
437 prop_four_ccwy_is_identity c =
438 (ccwy . ccwy . ccwy . ccwy) c == c
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
443 prop_four_cwz_is_identity :: Cardinal -> Bool
444 prop_four_cwz_is_identity c =
445 (cwz . cwz . cwz . cwz) c == c
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
455 cardinal_tests :: TestTree
457 testGroup "Cardinal tests" [
458 testCase "c-tilde_2100 rotation correct"test_c_tilde_2100_rotation_correct ]
461 cardinal_properties :: TestTree
462 cardinal_properties =
463 testGroup "Cardinal properties" [
465 "ccwx rotation changes direction"
466 prop_ccwx_rotation_changes_direction,
468 "cwx rotation changes direction"
469 prop_cwx_rotation_changes_direction,
471 "ccwy rotation changes direction"
472 prop_ccwy_rotation_changes_direction,
474 "cwy rotation changes direction"
475 prop_cwy_rotation_changes_direction,
477 "ccwz rotation changes direction"
478 prop_ccwz_rotation_changes_direction,
480 "cwz rotation changes direction"
481 prop_cwz_rotation_changes_direction,
483 "ccwx rotation result unique"
484 prop_ccwx_rotation_result_unique,
486 "cwx rotation result unique"
487 prop_cwx_rotation_result_unique,
489 "ccwy rotation result unique"
490 prop_ccwy_rotation_result_unique,
492 "cwy rotation result unique"
493 prop_cwy_rotation_result_unique,
495 "ccwz rotation result unique"
496 prop_ccwz_rotation_result_unique,
498 "cwz rotation result unique"
499 prop_cwz_rotation_result_unique,
501 "four cwx is identity"
502 prop_four_cwx_is_identity,
504 "four ccwx is identity"
505 prop_four_ccwx_is_identity,
507 "four cwy is identity"
508 prop_four_cwy_is_identity,
510 "four ccwy is identity"
511 prop_four_ccwy_is_identity,
513 "four cwz is identity"
514 prop_four_cwz_is_identity,
516 "four ccwz is identity"
517 prop_four_ccwz_is_identity ]