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.
15 import Control.Monad (liftM, liftM2)
16 import Prelude hiding (LT)
19 import Test.Framework (Test, testGroup)
20 import Test.Framework.Providers.HUnit (testCase)
21 import Test.Framework.Providers.QuickCheck2 (testProperty)
23 import Test.QuickCheck (Arbitrary(..), Property, (==>), oneof)
26 data Cardinal = F -- ^ Front
44 | FLD -- ^ Front Left Down
45 | FLT -- ^ Front Left Top
46 | FRD -- ^ Front Right Down
47 | FRT -- ^ Front Right Top
48 | BLD -- ^ Back Left Down
49 | BLT -- ^ Back Left Top
50 | BRD -- ^ Back Right Down
51 | BRT -- ^ Back Right Top
53 | Scalar Double -- ^ A wrapper around a scalar value.
54 | Sum Cardinal Cardinal -- ^ The sum of two directions.
55 | Difference Cardinal Cardinal
56 -- ^ The difference of two directions, the first minus the second.
57 | Product Cardinal Cardinal -- ^ The product of two directions.
58 | Quotient Cardinal Cardinal
59 -- ^ The quotient of two directions, the first divided by the
64 -- | By making Cardinal an instance of 'Num', we gain the ability to
65 -- add, subtract, and multiply directions. The results of these
66 -- operations are never actually calculated; the types just keep
67 -- track of which operations were performed in which order.
68 instance Num Cardinal where
70 x - y = Difference x y
72 negate = Product (Scalar (-1))
75 fromInteger x = Scalar (fromIntegral x)
78 -- | Like the Num instance, the 'Fractional' instance allows us to
79 -- take quotients of directions.
80 instance Fractional Cardinal where
82 recip = Quotient (Scalar 1)
83 fromRational x = Scalar (fromRational x)
87 instance Arbitrary Cardinal where
88 arbitrary = oneof [f,b,l,r,d,t,fl,fr,fd,ft,bl,br,bd,bt,ld,lt,
89 rd,rt,fld,flt,frd,frt,bld,blt,brd,brt,i,
90 scalar,csum,cdiff,cprod,cquot]
119 scalar = liftM Scalar arbitrary
120 csum = liftM2 Sum arbitrary arbitrary
121 cdiff = liftM2 Difference arbitrary arbitrary
122 cprod = liftM2 Product arbitrary arbitrary
123 cquot = liftM2 Quotient arbitrary arbitrary
126 -- | Rotate a cardinal direction counter-clockwise about the x-axis.
127 ccwx :: Cardinal -> Cardinal
155 ccwx (Scalar s) = (Scalar s)
156 ccwx (Sum c0 c1) = Sum (ccwx c0) (ccwx c1)
157 ccwx (Difference c0 c1) = Difference (ccwx c0) (ccwx c1)
158 ccwx (Product c0 c1) = Product (ccwx c0) (ccwx c1)
159 ccwx (Quotient c0 c1) = Quotient (ccwx c0) (ccwx c1)
161 -- | Rotate a cardinal direction clockwise about the x-axis.
162 cwx :: Cardinal -> Cardinal
163 cwx = ccwx . ccwx . ccwx
166 -- | Rotate a cardinal direction counter-clockwise about the y-axis.
167 ccwy :: Cardinal -> Cardinal
195 ccwy (Scalar s) = (Scalar s)
196 ccwy (Sum c0 c1) = Sum (ccwy c0) (ccwy c1)
197 ccwy (Difference c0 c1) = Difference (ccwy c0) (ccwy c1)
198 ccwy (Product c0 c1) = Product (ccwy c0) (ccwy c1)
199 ccwy (Quotient c0 c1) = Quotient (ccwy c0) (ccwy c1)
201 -- | Rotate a cardinal direction clockwise about the y-axis.
202 cwy :: Cardinal -> Cardinal
203 cwy = ccwy . ccwy . ccwy
206 -- | Rotate a cardinal direction counter-clockwise about the z-axis.
207 ccwz :: Cardinal -> Cardinal
235 ccwz (Scalar s) = (Scalar s)
236 ccwz (Sum c0 c1) = Sum (ccwz c0) (ccwz c1)
237 ccwz (Difference c0 c1) = Difference (ccwz c0) (ccwz c1)
238 ccwz (Product c0 c1) = Product (ccwz c0) (ccwz c1)
239 ccwz (Quotient c0 c1) = Quotient (ccwz c0) (ccwz c1)
241 -- | Rotate a cardinal direction clockwise about the z-axis.
242 cwz :: Cardinal -> Cardinal
243 cwz = ccwz . ccwz . ccwz
248 -- | We know what (c t6 2 1 0 0) should be from Sorokina and
249 -- Zeilfelder, p. 87. This test checks that the directions are
250 -- rotated properly. The order of the letters has to be just right
251 -- since I haven't defined a proper Eq instance for Cardinals.
252 test_c_tilde_2100_rotation_correct :: Assertion
253 test_c_tilde_2100_rotation_correct =
254 assertEqual "auto-rotate equals manual rotate" ((ccwz . ccwz . cwy) expr1) expr2
258 (1/12)*(T + R + L + D) +
259 (1/64)*(FT + FR + FL + FD) +
262 (1/96)*(RT + LD + LT + RD) +
263 (1/192)*(BT + BR + BL + BD)
267 (1/12)*(F + L + R + B) +
268 (1/64)*(FT + LT + RT + BT) +
271 (1/96)*(FL + BR + FR + BL) +
272 (1/192)*(FD + LD + RD + BD)
274 -- | A list of all directions, sans the interior and composite types.
275 all_directions :: [Cardinal]
276 all_directions = [L, R, F, B, D, T, FL, FR, FD, FT,
277 BL, BR, BD, BT, LD, LT, RD, RT, FLD,
278 FLT, FRD, FRT, BLD, BLT, BRD, BRT]
281 -- | If we rotate a direction (other than front or back)
282 -- counter-clockwise with respect to the x-axis, we should get a new
284 prop_ccwx_rotation_changes_direction :: Cardinal -> Property
285 prop_ccwx_rotation_changes_direction c =
286 c `elem` [L, R, D, T, FL, FR, FD, FT, BL, BR, BD, BT, LD, LT,
287 RD, RT, FLD, FLT, FRD, FRT, BLD, BLT, BRD, BRT]
290 -- | If we rotate a direction (other than front or back) clockwise
291 -- with respect to the x-axis, we should get a new direction.
292 prop_cwx_rotation_changes_direction :: Cardinal -> Property
293 prop_cwx_rotation_changes_direction c =
294 -- The front and back faces are unchanged by x-rotation.
295 c `elem` [L, R, D, T, FL, FR, FD, FT, BL, BR, BD, BT, LD, LT,
296 RD, RT, FLD, FLT, FRD, FRT, BLD, BLT, BRD, BRT]
299 -- | If we rotate a direction (other than left or right)
300 -- counter-clockwise with respect to the y-axis, we should get a new
302 prop_ccwy_rotation_changes_direction :: Cardinal -> Property
303 prop_ccwy_rotation_changes_direction c =
304 c `elem` [F, B, D, T, FL, FR, FD, FT, BL, BR, BD, BT, LD, LT,
305 RD, RT, FLD, FLT, FRD, FRT, BLD, BLT, BRD, BRT]
309 -- | If we rotate a direction (other than left or right) clockwise
310 -- with respect to the y-axis, we should get a new direction.
311 prop_cwy_rotation_changes_direction :: Cardinal -> Property
312 prop_cwy_rotation_changes_direction c =
313 c `elem` [F, B, D, T, FL, FR, FD, FT, BL, BR, BD, BT, LD, LT,
314 RD, RT, FLD, FLT, FRD, FRT, BLD, BLT, BRD, BRT]
318 -- | If we rotate a direction (other than top or down)
319 -- counter-clockwise with respect to the z-axis, we should get a new
321 prop_ccwz_rotation_changes_direction :: Cardinal -> Property
322 prop_ccwz_rotation_changes_direction c =
323 c `elem` [L, R, F, B, 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) clockwise with
329 -- respect to the z-axis, we should get a new direction.
330 prop_cwz_rotation_changes_direction :: Cardinal -> Property
331 prop_cwz_rotation_changes_direction c =
332 c `elem` [L, R, F, B, FL, FR, FD, FT, BL, BR, BD, BT, LD, LT,
333 RD, RT, FLD, FLT, FRD, FRT, BLD, BLT, BRD, BRT]
337 -- | If we are given a direction c, there should only be one direction
338 -- d which, when rotated counter-clockwise with respect to the
339 -- x-axis, produces c.
340 prop_ccwx_rotation_result_unique :: Cardinal -> Property
341 prop_ccwx_rotation_result_unique c =
342 c `elem` all_directions ==>
343 (length [ d | d <- all_directions, ccwx d == c ]) == 1
345 -- | If we are given a direction c, there should only be one direction
346 -- d which, when rotated clockwise with respect to the x-axis,
348 prop_cwx_rotation_result_unique :: Cardinal -> Property
349 prop_cwx_rotation_result_unique c =
350 c `elem` all_directions ==>
351 (length [ d | d <- all_directions, cwx d == c ]) == 1
354 -- | If we are given a direction c, there should only be one direction
355 -- d which, when rotated counter-clockwise with respect to the
356 -- y-axis, produces c.
357 prop_ccwy_rotation_result_unique :: Cardinal -> Property
358 prop_ccwy_rotation_result_unique c =
359 c `elem` all_directions ==>
360 (length [ d | d <- all_directions, ccwy d == c ]) == 1
363 -- | If we are given a direction c, there should only be one direction
364 -- d which, when rotated clockwise with respect to the y-axis,
366 prop_cwy_rotation_result_unique :: Cardinal -> Property
367 prop_cwy_rotation_result_unique c =
368 c `elem` all_directions ==>
369 (length [ d | d <- all_directions, cwy d == c ]) == 1
372 -- | If we are given a direction c, there should only be one direction
373 -- d which, when rotated counter-clockwise with respect to the
374 -- z-axis, produces c.
375 prop_ccwz_rotation_result_unique :: Cardinal -> Property
376 prop_ccwz_rotation_result_unique c =
377 c `elem` all_directions ==>
378 (length [ d | d <- all_directions, ccwz d == c ]) == 1
381 -- | If we are given a direction c, there should only be one direction
382 -- d which, when rotated clockwise with respect to the z-axis,
384 prop_cwz_rotation_result_unique :: Cardinal -> Property
385 prop_cwz_rotation_result_unique c =
386 c `elem` all_directions ==>
387 (length [ d | d <- all_directions, cwz d == c ]) == 1
390 -- | If you rotate a cardinal direction four times in the clockwise
391 -- (with respect to x) direction, you should wind up with the same
393 prop_four_cwx_is_identity :: Cardinal -> Bool
394 prop_four_cwx_is_identity c =
395 (cwx . cwx . cwx . cwx) c == c
397 -- | If you rotate a cardinal direction four times in the
398 -- counter-clockwise (with respect to x) direction, you should wind up
399 -- with the same direction.
400 prop_four_ccwx_is_identity :: Cardinal -> Bool
401 prop_four_ccwx_is_identity c =
402 (ccwx . ccwx . ccwx . ccwx) c == c
404 -- | If you rotate a cardinal direction four times in the clockwise
405 -- (with respect to y) direction, you should wind up with the same
407 prop_four_cwy_is_identity :: Cardinal -> Bool
408 prop_four_cwy_is_identity c =
409 (cwy . cwy . cwy . cwy) c == c
411 -- | If you rotate a cardinal direction four times in the counter-clockwise
412 -- (with respect to y) direction, you should wind up with the same
414 prop_four_ccwy_is_identity :: Cardinal -> Bool
415 prop_four_ccwy_is_identity c =
416 (ccwy . ccwy . ccwy . ccwy) c == c
418 -- | If you rotate a cardinal direction four times in the clockwise
419 -- (with respect to z) direction, you should wind up with the same
421 prop_four_cwz_is_identity :: Cardinal -> Bool
422 prop_four_cwz_is_identity c =
423 (cwz . cwz . cwz . cwz) c == c
425 -- | If you rotate a cardinal direction four times in the
426 -- counter-clockwise (with respect to z) direction, you should wind up
427 -- with the same direction.
428 prop_four_ccwz_is_identity :: Cardinal -> Bool
429 prop_four_ccwz_is_identity c =
430 (ccwz . ccwz . ccwz . ccwz) c == c
433 cardinal_tests :: Test.Framework.Test
435 testGroup "Cardinal Tests" [
436 testCase "c-tilde_2100 rotation correct"test_c_tilde_2100_rotation_correct ]
439 cardinal_properties :: Test.Framework.Test
440 cardinal_properties =
441 let tp = testProperty
443 testGroup "Cardinal Properties" [
444 tp "ccwx rotation changes direction" prop_ccwx_rotation_changes_direction,
445 tp "cwx rotation changes direction" prop_cwx_rotation_changes_direction,
446 tp "ccwy rotation changes direction" prop_ccwy_rotation_changes_direction,
447 tp "cwy rotation changes direction" prop_cwy_rotation_changes_direction,
448 tp "ccwz rotation changes direction" prop_ccwz_rotation_changes_direction,
449 tp "cwz rotation changes direction" prop_cwz_rotation_changes_direction,
450 tp "ccwx rotation result unique" prop_ccwx_rotation_result_unique,
451 tp "cwx rotation result unique" prop_cwx_rotation_result_unique,
452 tp "ccwy rotation result unique" prop_ccwy_rotation_result_unique,
453 tp "cwy rotation result unique" prop_cwy_rotation_result_unique,
454 tp "ccwz rotation result unique" prop_ccwz_rotation_result_unique,
455 tp "cwz rotation result unique" prop_cwz_rotation_result_unique,
456 tp "four cwx is identity" prop_four_cwx_is_identity,
457 tp "four ccwx is identity" prop_four_ccwx_is_identity,
458 tp "four cwy is identity" prop_four_cwy_is_identity,
459 tp "four ccwy is identity" prop_four_ccwy_is_identity,
460 tp "four cwz is identity" prop_four_cwz_is_identity,
461 tp "four ccwz is identity" prop_four_ccwz_is_identity ]