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)
28 import Test.HUnit (Assertion, assertEqual)
29 import Test.Framework (Test, testGroup)
30 import Test.Framework.Providers.HUnit (testCase)
31 import Test.Framework.Providers.QuickCheck2 (testProperty)
33 import Test.QuickCheck (Arbitrary(..), Property, (==>), oneof)
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 :: Test.Framework.Test
445 testGroup "Cardinal Tests" [
446 testCase "c-tilde_2100 rotation correct"test_c_tilde_2100_rotation_correct ]
449 cardinal_properties :: Test.Framework.Test
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 ]