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)
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 ),
37 data Cardinal = F -- ^ Front
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
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
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
81 x - y = Difference x y
83 negate = Product (Scalar (-1))
86 fromInteger x = Scalar (fromIntegral x)
89 -- | Like the Num instance, the 'Fractional' instance allows us to
90 -- take quotients of directions.
91 instance Fractional Cardinal where
93 recip = Quotient (Scalar 1)
94 fromRational x = Scalar (fromRational x)
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]
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
137 -- | Rotate a cardinal direction counter-clockwise about the x-axis.
138 ccwx :: Cardinal -> Cardinal
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)
172 -- | Rotate a cardinal direction clockwise about the x-axis.
173 cwx :: Cardinal -> Cardinal
174 cwx = ccwx . ccwx . ccwx
177 -- | Rotate a cardinal direction counter-clockwise about the y-axis.
178 ccwy :: Cardinal -> Cardinal
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)
212 -- | Rotate a cardinal direction clockwise about the y-axis.
213 cwy :: Cardinal -> Cardinal
214 cwy = ccwy . ccwy . ccwy
217 -- | Rotate a cardinal direction counter-clockwise about the z-axis.
218 ccwz :: Cardinal -> Cardinal
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)
252 -- | Rotate a cardinal direction clockwise about the z-axis.
253 cwz :: Cardinal -> Cardinal
254 cwz = ccwz . ccwz . ccwz
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
269 (1/12)*(T + R + L + D) +
270 (1/64)*(FT + FR + FL + FD) +
273 (1/96)*(RT + LD + LT + RD) +
274 (1/192)*(BT + BR + BL + BD)
278 (1/12)*(F + L + R + B) +
279 (1/64)*(FT + LT + RT + BT) +
282 (1/96)*(FL + BR + FR + BL) +
283 (1/192)*(FD + LD + RD + BD)
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]
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
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]
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]
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
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]
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]
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
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]
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]
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
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,
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
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
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,
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
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
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,
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
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
404 prop_four_cwx_is_identity :: Cardinal -> Bool
405 prop_four_cwx_is_identity c =
406 (cwx . cwx . cwx . cwx) c == c
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
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
418 prop_four_cwy_is_identity :: Cardinal -> Bool
419 prop_four_cwy_is_identity c =
420 (cwy . cwy . cwy . cwy) c == c
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
425 prop_four_ccwy_is_identity :: Cardinal -> Bool
426 prop_four_ccwy_is_identity c =
427 (ccwy . ccwy . ccwy . ccwy) c == c
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
432 prop_four_cwz_is_identity :: Cardinal -> Bool
433 prop_four_cwz_is_identity c =
434 (cwz . cwz . cwz . cwz) c == c
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
444 cardinal_tests :: TestTree
446 testGroup "Cardinal tests" [
447 testCase "c-tilde_2100 rotation correct"test_c_tilde_2100_rotation_correct ]
450 cardinal_properties :: TestTree
451 cardinal_properties =
452 testGroup "Cardinal properties" [
454 "ccwx rotation changes direction"
455 prop_ccwx_rotation_changes_direction,
457 "cwx rotation changes direction"
458 prop_cwx_rotation_changes_direction,
460 "ccwy rotation changes direction"
461 prop_ccwy_rotation_changes_direction,
463 "cwy rotation changes direction"
464 prop_cwy_rotation_changes_direction,
466 "ccwz rotation changes direction"
467 prop_ccwz_rotation_changes_direction,
469 "cwz rotation changes direction"
470 prop_cwz_rotation_changes_direction,
472 "ccwx rotation result unique"
473 prop_ccwx_rotation_result_unique,
475 "cwx rotation result unique"
476 prop_cwx_rotation_result_unique,
478 "ccwy rotation result unique"
479 prop_ccwy_rotation_result_unique,
481 "cwy rotation result unique"
482 prop_cwy_rotation_result_unique,
484 "ccwz rotation result unique"
485 prop_ccwz_rotation_result_unique,
487 "cwz rotation result unique"
488 prop_cwz_rotation_result_unique,
490 "four cwx is identity"
491 prop_four_cwx_is_identity,
493 "four ccwx is identity"
494 prop_four_ccwx_is_identity,
496 "four cwy is identity"
497 prop_four_cwy_is_identity,
499 "four ccwy is identity"
500 prop_four_ccwy_is_identity,
502 "four cwz is identity"
503 prop_four_cwz_is_identity,
505 "four ccwz is identity"
506 prop_four_ccwz_is_identity ]