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 (
36 data Cardinal = F -- ^ Front
54 | FLD -- ^ Front Left Down
55 | FLT -- ^ Front Left Top
56 | FRD -- ^ Front Right Down
57 | FRT -- ^ Front Right Top
58 | BLD -- ^ Back Left Down
59 | BLT -- ^ Back Left Top
60 | BRD -- ^ Back Right Down
61 | BRT -- ^ Back Right Top
63 | Scalar Double -- ^ A wrapper around a scalar value.
64 | Sum Cardinal Cardinal -- ^ The sum of two directions.
65 | Difference Cardinal Cardinal
66 -- ^ The difference of two directions, the first minus the second.
67 | Product Cardinal Cardinal -- ^ The product of two directions.
68 | Quotient Cardinal Cardinal
69 -- ^ The quotient of two directions, the first divided by the
74 -- | By making Cardinal an instance of 'Num', we gain the ability to
75 -- add, subtract, and multiply directions. The results of these
76 -- operations are never actually calculated; the types just keep
77 -- track of which operations were performed in which order.
78 instance Num Cardinal where
80 x - y = Difference x y
82 negate = Product (Scalar (-1))
85 fromInteger x = Scalar (fromIntegral x)
88 -- | Like the Num instance, the 'Fractional' instance allows us to
89 -- take quotients of directions.
90 instance Fractional Cardinal where
92 recip = Quotient (Scalar 1)
93 fromRational x = Scalar (fromRational x)
97 instance Arbitrary Cardinal where
98 arbitrary = oneof [f,b,l,r,d,t,fl,fr,fd,ft,bl,br,bd,bt,ld,lt,
99 rd,rt,fld,flt,frd,frt,bld,blt,brd,brt,i,
100 scalar,csum,cdiff,cprod,cquot]
129 scalar = liftM Scalar arbitrary
130 csum = liftM2 Sum arbitrary arbitrary
131 cdiff = liftM2 Difference arbitrary arbitrary
132 cprod = liftM2 Product arbitrary arbitrary
133 cquot = liftM2 Quotient arbitrary arbitrary
136 -- | Rotate a cardinal direction counter-clockwise about the x-axis.
137 ccwx :: Cardinal -> Cardinal
165 ccwx (Scalar s) = (Scalar s)
166 ccwx (Sum c0 c1) = Sum (ccwx c0) (ccwx c1)
167 ccwx (Difference c0 c1) = Difference (ccwx c0) (ccwx c1)
168 ccwx (Product c0 c1) = Product (ccwx c0) (ccwx c1)
169 ccwx (Quotient c0 c1) = Quotient (ccwx c0) (ccwx c1)
171 -- | Rotate a cardinal direction clockwise about the x-axis.
172 cwx :: Cardinal -> Cardinal
173 cwx = ccwx . ccwx . ccwx
176 -- | Rotate a cardinal direction counter-clockwise about the y-axis.
177 ccwy :: Cardinal -> Cardinal
205 ccwy (Scalar s) = (Scalar s)
206 ccwy (Sum c0 c1) = Sum (ccwy c0) (ccwy c1)
207 ccwy (Difference c0 c1) = Difference (ccwy c0) (ccwy c1)
208 ccwy (Product c0 c1) = Product (ccwy c0) (ccwy c1)
209 ccwy (Quotient c0 c1) = Quotient (ccwy c0) (ccwy c1)
211 -- | Rotate a cardinal direction clockwise about the y-axis.
212 cwy :: Cardinal -> Cardinal
213 cwy = ccwy . ccwy . ccwy
216 -- | Rotate a cardinal direction counter-clockwise about the z-axis.
217 ccwz :: Cardinal -> Cardinal
245 ccwz (Scalar s) = (Scalar s)
246 ccwz (Sum c0 c1) = Sum (ccwz c0) (ccwz c1)
247 ccwz (Difference c0 c1) = Difference (ccwz c0) (ccwz c1)
248 ccwz (Product c0 c1) = Product (ccwz c0) (ccwz c1)
249 ccwz (Quotient c0 c1) = Quotient (ccwz c0) (ccwz c1)
251 -- | Rotate a cardinal direction clockwise about the z-axis.
252 cwz :: Cardinal -> Cardinal
253 cwz = ccwz . ccwz . ccwz
258 -- | We know what (c t6 2 1 0 0) should be from Sorokina and
259 -- Zeilfelder, p. 87. This test checks that the directions are
260 -- rotated properly. The order of the letters has to be just right
261 -- since I haven't defined a proper Eq instance for Cardinals.
262 test_c_tilde_2100_rotation_correct :: Assertion
263 test_c_tilde_2100_rotation_correct =
264 assertEqual "auto-rotate equals manual rotate" ((ccwz . ccwz . cwy) expr1) expr2
268 (1/12)*(T + R + L + D) +
269 (1/64)*(FT + FR + FL + FD) +
272 (1/96)*(RT + LD + LT + RD) +
273 (1/192)*(BT + BR + BL + BD)
277 (1/12)*(F + L + R + B) +
278 (1/64)*(FT + LT + RT + BT) +
281 (1/96)*(FL + BR + FR + BL) +
282 (1/192)*(FD + LD + RD + BD)
284 -- | A list of all directions, sans the interior and composite types.
285 all_directions :: [Cardinal]
286 all_directions = [L, R, F, B, D, T, FL, FR, FD, FT,
287 BL, BR, BD, BT, LD, LT, RD, RT, FLD,
288 FLT, FRD, FRT, BLD, BLT, BRD, BRT]
291 -- | If we rotate a direction (other than front or back)
292 -- counter-clockwise with respect to the x-axis, we should get a new
294 prop_ccwx_rotation_changes_direction :: Cardinal -> Property
295 prop_ccwx_rotation_changes_direction c =
296 c `elem` [L, R, D, T, FL, FR, FD, FT, BL, BR, BD, BT, LD, LT,
297 RD, RT, FLD, FLT, FRD, FRT, BLD, BLT, BRD, BRT]
300 -- | If we rotate a direction (other than front or back) clockwise
301 -- with respect to the x-axis, we should get a new direction.
302 prop_cwx_rotation_changes_direction :: Cardinal -> Property
303 prop_cwx_rotation_changes_direction c =
304 -- The front and back faces are unchanged by x-rotation.
305 c `elem` [L, R, D, T, FL, FR, FD, FT, BL, BR, BD, BT, LD, LT,
306 RD, RT, FLD, FLT, FRD, FRT, BLD, BLT, BRD, BRT]
309 -- | If we rotate a direction (other than left or right)
310 -- counter-clockwise with respect to the y-axis, we should get a new
312 prop_ccwy_rotation_changes_direction :: Cardinal -> Property
313 prop_ccwy_rotation_changes_direction c =
314 c `elem` [F, B, D, T, FL, FR, FD, FT, BL, BR, BD, BT, LD, LT,
315 RD, RT, FLD, FLT, FRD, FRT, BLD, BLT, BRD, BRT]
319 -- | If we rotate a direction (other than left or right) clockwise
320 -- with respect to the y-axis, we should get a new direction.
321 prop_cwy_rotation_changes_direction :: Cardinal -> Property
322 prop_cwy_rotation_changes_direction c =
323 c `elem` [F, B, D, T, FL, FR, FD, FT, BL, BR, BD, BT, LD, LT,
324 RD, RT, FLD, FLT, FRD, FRT, BLD, BLT, BRD, BRT]
328 -- | If we rotate a direction (other than top or down)
329 -- counter-clockwise with respect to the z-axis, we should get a new
331 prop_ccwz_rotation_changes_direction :: Cardinal -> Property
332 prop_ccwz_rotation_changes_direction c =
333 c `elem` [L, R, F, B, FL, FR, FD, FT, BL, BR, BD, BT, LD, LT,
334 RD, RT, FLD, FLT, FRD, FRT, BLD, BLT, BRD, BRT]
338 -- | If we rotate a direction (other than top or down) clockwise with
339 -- respect to the z-axis, we should get a new direction.
340 prop_cwz_rotation_changes_direction :: Cardinal -> Property
341 prop_cwz_rotation_changes_direction c =
342 c `elem` [L, R, F, B, FL, FR, FD, FT, BL, BR, BD, BT, LD, LT,
343 RD, RT, FLD, FLT, FRD, FRT, BLD, BLT, BRD, BRT]
347 -- | If we are given a direction c, there should only be one direction
348 -- d which, when rotated counter-clockwise with respect to the
349 -- x-axis, produces c.
350 prop_ccwx_rotation_result_unique :: Cardinal -> Property
351 prop_ccwx_rotation_result_unique c =
352 c `elem` all_directions ==>
353 (length [ d | d <- all_directions, ccwx d == c ]) == 1
355 -- | If we are given a direction c, there should only be one direction
356 -- d which, when rotated clockwise with respect to the x-axis,
358 prop_cwx_rotation_result_unique :: Cardinal -> Property
359 prop_cwx_rotation_result_unique c =
360 c `elem` all_directions ==>
361 (length [ d | d <- all_directions, cwx d == c ]) == 1
364 -- | If we are given a direction c, there should only be one direction
365 -- d which, when rotated counter-clockwise with respect to the
366 -- y-axis, produces c.
367 prop_ccwy_rotation_result_unique :: Cardinal -> Property
368 prop_ccwy_rotation_result_unique c =
369 c `elem` all_directions ==>
370 (length [ d | d <- all_directions, ccwy d == c ]) == 1
373 -- | If we are given a direction c, there should only be one direction
374 -- d which, when rotated clockwise with respect to the y-axis,
376 prop_cwy_rotation_result_unique :: Cardinal -> Property
377 prop_cwy_rotation_result_unique c =
378 c `elem` all_directions ==>
379 (length [ d | d <- all_directions, cwy d == c ]) == 1
382 -- | If we are given a direction c, there should only be one direction
383 -- d which, when rotated counter-clockwise with respect to the
384 -- z-axis, produces c.
385 prop_ccwz_rotation_result_unique :: Cardinal -> Property
386 prop_ccwz_rotation_result_unique c =
387 c `elem` all_directions ==>
388 (length [ d | d <- all_directions, ccwz d == c ]) == 1
391 -- | If we are given a direction c, there should only be one direction
392 -- d which, when rotated clockwise with respect to the z-axis,
394 prop_cwz_rotation_result_unique :: Cardinal -> Property
395 prop_cwz_rotation_result_unique c =
396 c `elem` all_directions ==>
397 (length [ d | d <- all_directions, cwz d == c ]) == 1
400 -- | If you rotate a cardinal direction four times in the clockwise
401 -- (with respect to x) direction, you should wind up with the same
403 prop_four_cwx_is_identity :: Cardinal -> Bool
404 prop_four_cwx_is_identity c =
405 (cwx . cwx . cwx . cwx) c == c
407 -- | If you rotate a cardinal direction four times in the
408 -- counter-clockwise (with respect to x) direction, you should wind up
409 -- with the same direction.
410 prop_four_ccwx_is_identity :: Cardinal -> Bool
411 prop_four_ccwx_is_identity c =
412 (ccwx . ccwx . ccwx . ccwx) c == c
414 -- | If you rotate a cardinal direction four times in the clockwise
415 -- (with respect to y) direction, you should wind up with the same
417 prop_four_cwy_is_identity :: Cardinal -> Bool
418 prop_four_cwy_is_identity c =
419 (cwy . cwy . cwy . cwy) c == c
421 -- | If you rotate a cardinal direction four times in the counter-clockwise
422 -- (with respect to y) direction, you should wind up with the same
424 prop_four_ccwy_is_identity :: Cardinal -> Bool
425 prop_four_ccwy_is_identity c =
426 (ccwy . ccwy . ccwy . ccwy) c == c
428 -- | If you rotate a cardinal direction four times in the clockwise
429 -- (with respect to z) direction, you should wind up with the same
431 prop_four_cwz_is_identity :: Cardinal -> Bool
432 prop_four_cwz_is_identity c =
433 (cwz . cwz . cwz . cwz) c == c
435 -- | If you rotate a cardinal direction four times in the
436 -- counter-clockwise (with respect to z) direction, you should wind up
437 -- with the same direction.
438 prop_four_ccwz_is_identity :: Cardinal -> Bool
439 prop_four_ccwz_is_identity c =
440 (ccwz . ccwz . ccwz . ccwz) c == c
443 cardinal_tests :: TestTree
445 testGroup "Cardinal tests" [
446 testCase "c-tilde_2100 rotation correct"test_c_tilde_2100_rotation_correct ]
449 cardinal_properties :: TestTree
450 cardinal_properties =
451 let tp = testProperty
453 testGroup "Cardinal properties" [
454 tp "ccwx rotation changes direction" prop_ccwx_rotation_changes_direction,
455 tp "cwx rotation changes direction" prop_cwx_rotation_changes_direction,
456 tp "ccwy rotation changes direction" prop_ccwy_rotation_changes_direction,
457 tp "cwy rotation changes direction" prop_cwy_rotation_changes_direction,
458 tp "ccwz rotation changes direction" prop_ccwz_rotation_changes_direction,
459 tp "cwz rotation changes direction" prop_cwz_rotation_changes_direction,
460 tp "ccwx rotation result unique" prop_ccwx_rotation_result_unique,
461 tp "cwx rotation result unique" prop_cwx_rotation_result_unique,
462 tp "ccwy rotation result unique" prop_ccwy_rotation_result_unique,
463 tp "cwy rotation result unique" prop_cwy_rotation_result_unique,
464 tp "ccwz rotation result unique" prop_ccwz_rotation_result_unique,
465 tp "cwz rotation result unique" prop_cwz_rotation_result_unique,
466 tp "four cwx is identity" prop_four_cwx_is_identity,
467 tp "four ccwx is identity" prop_four_ccwx_is_identity,
468 tp "four cwy is identity" prop_four_cwy_is_identity,
469 tp "four ccwy is identity" prop_four_ccwy_is_identity,
470 tp "four cwz is identity" prop_four_cwz_is_identity,
471 tp "four ccwz is identity" prop_four_ccwz_is_identity ]