]> gitweb.michael.orlitzky.com - spline3.git/blob - src/Cardinal.hs
spline3.cabal: update to v1.0.1.
[spline3.git] / src / Cardinal.hs
1 -- | The Cardinal module contains the Cardinal data type, representing
2 -- a cardinal direction (one of the 26 directions surrounding the
3 -- center of a cube. In addition to those 26 directions, we also
4 -- include the interior point and a number of composite types that
5 -- allow us to perform arithmetic on directions.
6 --
7 module Cardinal (
8 Cardinal(..),
9 cardinal_properties,
10 cardinal_tests,
11 ccwx,
12 ccwy,
13 ccwz,
14 cwx,
15 cwy,
16 cwz )
17 where
18
19 import Control.Monad (liftM, liftM2)
20 import Prelude (
21 (.),
22 Bool,
23 Double,
24 Eq( (==), (/=) ),
25 Fractional( (/), fromRational, recip ),
26 Num( (+), (-), (*), abs, negate, signum, fromInteger ),
27 Show,
28 elem,
29 fromIntegral,
30 length,
31 return )
32 import Test.Tasty ( TestTree, testGroup )
33 import Test.Tasty.HUnit ( Assertion, assertEqual, testCase )
34 import Test.Tasty.QuickCheck (
35 Arbitrary( arbitrary ),
36 Gen,
37 Property, (==>),
38 oneof,
39 testProperty )
40
41
42 data Cardinal = F -- ^ Front
43 | B -- ^ Back
44 | L -- ^ Left
45 | R -- ^ Right
46 | D -- ^ Down
47 | T -- ^ Top
48 | FL -- ^ Front Left
49 | FR -- ^ Front Right
50 | FD -- ^ Front Down
51 | FT -- ^ Front Top
52 | BL -- ^ Back Left
53 | BR -- ^ Back Right
54 | BD -- ^ Back Down
55 | BT -- ^ Back Top
56 | LD -- ^ Left Down
57 | LT -- ^ Left Top
58 | RD -- ^ Right Down
59 | RT -- ^ Right Top
60 | FLD -- ^ Front Left Down
61 | FLT -- ^ Front Left Top
62 | FRD -- ^ Front Right Down
63 | FRT -- ^ Front Right Top
64 | BLD -- ^ Back Left Down
65 | BLT -- ^ Back Left Top
66 | BRD -- ^ Back Right Down
67 | BRT -- ^ Back Right Top
68 | I -- ^ Interior
69 | Scalar Double -- ^ A wrapper around a scalar value.
70 | Sum Cardinal Cardinal -- ^ The sum of two directions.
71 | Difference Cardinal Cardinal
72 -- ^ The difference of two directions, the first minus the second.
73 | Product Cardinal Cardinal -- ^ The product of two directions.
74 | Quotient Cardinal Cardinal
75 -- ^ The quotient of two directions, the first divided by the
76 -- second.
77 deriving (Show, Eq)
78
79
80 -- | By making Cardinal an instance of 'Num', we gain the ability to
81 -- add, subtract, and multiply directions. The results of these
82 -- operations are never actually calculated; the types just keep
83 -- track of which operations were performed in which order.
84 instance Num Cardinal where
85 x + y = Sum x y
86 x - y = Difference x y
87 x * y = Product x y
88 negate = Product (Scalar (-1))
89 abs x = x
90 signum x = x
91 fromInteger x = Scalar (fromIntegral x)
92
93
94 -- | Like the Num instance, the 'Fractional' instance allows us to
95 -- take quotients of directions.
96 instance Fractional Cardinal where
97 x / y = Quotient x y
98 recip = Quotient (Scalar 1)
99 fromRational x = Scalar (fromRational x)
100
101
102
103 instance Arbitrary Cardinal where
104 arbitrary = oneof [f,b,l,r,d,t,fl,fr,fd,ft,bl,br,bd,bt,ld,lt,
105 rd,rt,fld,flt,frd,frt,bld,blt,brd,brt,i,
106 scalar,csum,cdiff,cprod,cquot]
107 where
108 f = return F :: Gen Cardinal
109 b = return B :: Gen Cardinal
110 l = return L :: Gen Cardinal
111 r = return R :: Gen Cardinal
112 d = return D :: Gen Cardinal
113 t = return T :: Gen Cardinal
114 fl = return FL :: Gen Cardinal
115 fr = return FR :: Gen Cardinal
116 fd = return FD :: Gen Cardinal
117 ft = return FT :: Gen Cardinal
118 bl = return BL :: Gen Cardinal
119 br = return BR :: Gen Cardinal
120 bd = return BD :: Gen Cardinal
121 bt = return BT :: Gen Cardinal
122 ld = return LD :: Gen Cardinal
123 lt = return LT :: Gen Cardinal
124 rd = return RD :: Gen Cardinal
125 rt = return RT :: Gen Cardinal
126 fld = return FLD :: Gen Cardinal
127 flt = return FLT :: Gen Cardinal
128 frd = return FRD :: Gen Cardinal
129 frt = return FRT :: Gen Cardinal
130 bld = return BLD :: Gen Cardinal
131 blt = return BLT :: Gen Cardinal
132 brd = return BRD :: Gen Cardinal
133 brt = return BRT :: Gen Cardinal
134 i = return I :: Gen Cardinal
135 scalar = liftM Scalar arbitrary
136 csum = liftM2 Sum arbitrary arbitrary
137 cdiff = liftM2 Difference arbitrary arbitrary
138 cprod = liftM2 Product arbitrary arbitrary
139 cquot = liftM2 Quotient arbitrary arbitrary
140
141
142 -- | Rotate a cardinal direction counter-clockwise about the x-axis.
143 ccwx :: Cardinal -> Cardinal
144 ccwx F = F
145 ccwx B = B
146 ccwx L = T
147 ccwx R = D
148 ccwx D = L
149 ccwx T = R
150 ccwx FL = FT
151 ccwx FR = FD
152 ccwx FD = FL
153 ccwx FT = FR
154 ccwx BL = BT
155 ccwx BR = BD
156 ccwx BD = BL
157 ccwx BT = BR
158 ccwx LD = LT
159 ccwx LT = RT
160 ccwx RD = LD
161 ccwx RT = RD
162 ccwx FLD = FLT
163 ccwx FLT = FRT
164 ccwx FRD = FLD
165 ccwx FRT = FRD
166 ccwx BLD = BLT
167 ccwx BLT = BRT
168 ccwx BRD = BLD
169 ccwx BRT = BRD
170 ccwx I = I
171 ccwx (Scalar s) = (Scalar s)
172 ccwx (Sum c0 c1) = Sum (ccwx c0) (ccwx c1)
173 ccwx (Difference c0 c1) = Difference (ccwx c0) (ccwx c1)
174 ccwx (Product c0 c1) = Product (ccwx c0) (ccwx c1)
175 ccwx (Quotient c0 c1) = Quotient (ccwx c0) (ccwx c1)
176
177 -- | Rotate a cardinal direction clockwise about the x-axis.
178 cwx :: Cardinal -> Cardinal
179 cwx = ccwx . ccwx . ccwx
180
181
182 -- | Rotate a cardinal direction counter-clockwise about the y-axis.
183 ccwy :: Cardinal -> Cardinal
184 ccwy F = D
185 ccwy B = T
186 ccwy L = L
187 ccwy R = R
188 ccwy D = B
189 ccwy T = F
190 ccwy FL = LD
191 ccwy FR = RD
192 ccwy FD = BD
193 ccwy FT = FD
194 ccwy BL = LT
195 ccwy BR = RT
196 ccwy BD = BT
197 ccwy BT = FT
198 ccwy LD = BL
199 ccwy LT = FL
200 ccwy RD = BR
201 ccwy RT = FR
202 ccwy FLD = BLD
203 ccwy FLT = FLD
204 ccwy FRD = BRD
205 ccwy FRT = FRD
206 ccwy BLD = BLT
207 ccwy BLT = FLT
208 ccwy BRD = BRT
209 ccwy BRT = FRT
210 ccwy I = I
211 ccwy (Scalar s) = (Scalar s)
212 ccwy (Sum c0 c1) = Sum (ccwy c0) (ccwy c1)
213 ccwy (Difference c0 c1) = Difference (ccwy c0) (ccwy c1)
214 ccwy (Product c0 c1) = Product (ccwy c0) (ccwy c1)
215 ccwy (Quotient c0 c1) = Quotient (ccwy c0) (ccwy c1)
216
217 -- | Rotate a cardinal direction clockwise about the y-axis.
218 cwy :: Cardinal -> Cardinal
219 cwy = ccwy . ccwy . ccwy
220
221
222 -- | Rotate a cardinal direction counter-clockwise about the z-axis.
223 ccwz :: Cardinal -> Cardinal
224 ccwz F = R
225 ccwz B = L
226 ccwz L = F
227 ccwz R = B
228 ccwz D = D
229 ccwz T = T
230 ccwz FL = FR
231 ccwz FR = BR
232 ccwz FD = RD
233 ccwz FT = RT
234 ccwz BL = FL
235 ccwz BR = BL
236 ccwz BD = LD
237 ccwz BT = LT
238 ccwz LD = FD
239 ccwz LT = FT
240 ccwz RD = BD
241 ccwz RT = BT
242 ccwz FLD = FRD
243 ccwz FLT = FRT
244 ccwz FRD = BRD
245 ccwz FRT = BRT
246 ccwz BLD = FLD
247 ccwz BLT = FLT
248 ccwz BRD = BLD
249 ccwz BRT = BLT
250 ccwz I = I
251 ccwz (Scalar s) = (Scalar s)
252 ccwz (Sum c0 c1) = Sum (ccwz c0) (ccwz c1)
253 ccwz (Difference c0 c1) = Difference (ccwz c0) (ccwz c1)
254 ccwz (Product c0 c1) = Product (ccwz c0) (ccwz c1)
255 ccwz (Quotient c0 c1) = Quotient (ccwz c0) (ccwz c1)
256
257 -- | Rotate a cardinal direction clockwise about the z-axis.
258 cwz :: Cardinal -> Cardinal
259 cwz = ccwz . ccwz . ccwz
260
261
262
263
264 -- | We know what (c t6 2 1 0 0) should be from Sorokina and
265 -- Zeilfelder, p. 87. This test checks that the directions are
266 -- rotated properly. The order of the letters has to be just right
267 -- since I haven't defined a proper Eq instance for Cardinals.
268 test_c_tilde_2100_rotation_correct :: Assertion
269 test_c_tilde_2100_rotation_correct =
270 assertEqual "auto-rotate equals manual rotate" ((ccwz . ccwz . cwy) expr1) expr2
271 where
272 expr1 =
273 (3/8)*I +
274 (1/12)*(T + R + L + D) +
275 (1/64)*(FT + FR + FL + FD) +
276 (7/48)*F +
277 (1/48)*B +
278 (1/96)*(RT + LD + LT + RD) +
279 (1/192)*(BT + BR + BL + BD)
280
281 expr2 =
282 (3/8)*I +
283 (1/12)*(F + L + R + B) +
284 (1/64)*(FT + LT + RT + BT) +
285 (7/48)*T +
286 (1/48)*D +
287 (1/96)*(FL + BR + FR + BL) +
288 (1/192)*(FD + LD + RD + BD)
289
290 -- | A list of all directions, sans the interior and composite types.
291 all_directions :: [Cardinal]
292 all_directions = [L, R, F, B, D, T, FL, FR, FD, FT,
293 BL, BR, BD, BT, LD, LT, RD, RT, FLD,
294 FLT, FRD, FRT, BLD, BLT, BRD, BRT]
295
296
297 -- | If we rotate a direction (other than front or back)
298 -- counter-clockwise with respect to the x-axis, we should get a new
299 -- direction.
300 prop_ccwx_rotation_changes_direction :: Cardinal -> Property
301 prop_ccwx_rotation_changes_direction c =
302 c `elem` [L, R, D, T, FL, FR, FD, FT, BL, BR, BD, BT, LD, LT,
303 RD, RT, FLD, FLT, FRD, FRT, BLD, BLT, BRD, BRT]
304 ==> ccwx c /= c
305
306 -- | If we rotate a direction (other than front or back) clockwise
307 -- with respect to the x-axis, we should get a new direction.
308 prop_cwx_rotation_changes_direction :: Cardinal -> Property
309 prop_cwx_rotation_changes_direction c =
310 -- The front and back faces are unchanged by x-rotation.
311 c `elem` [L, R, D, T, FL, FR, FD, FT, BL, BR, BD, BT, LD, LT,
312 RD, RT, FLD, FLT, FRD, FRT, BLD, BLT, BRD, BRT]
313 ==> cwx c /= c
314
315 -- | If we rotate a direction (other than left or right)
316 -- counter-clockwise with respect to the y-axis, we should get a new
317 -- direction.
318 prop_ccwy_rotation_changes_direction :: Cardinal -> Property
319 prop_ccwy_rotation_changes_direction c =
320 c `elem` [F, B, D, T, FL, FR, FD, FT, BL, BR, BD, BT, LD, LT,
321 RD, RT, FLD, FLT, FRD, FRT, BLD, BLT, BRD, BRT]
322 ==> ccwy c /= c
323
324
325 -- | If we rotate a direction (other than left or right) clockwise
326 -- with respect to the y-axis, we should get a new direction.
327 prop_cwy_rotation_changes_direction :: Cardinal -> Property
328 prop_cwy_rotation_changes_direction c =
329 c `elem` [F, B, D, T, FL, FR, FD, FT, BL, BR, BD, BT, LD, LT,
330 RD, RT, FLD, FLT, FRD, FRT, BLD, BLT, BRD, BRT]
331 ==> cwy c /= c
332
333
334 -- | If we rotate a direction (other than top or down)
335 -- counter-clockwise with respect to the z-axis, we should get a new
336 -- direction.
337 prop_ccwz_rotation_changes_direction :: Cardinal -> Property
338 prop_ccwz_rotation_changes_direction c =
339 c `elem` [L, R, F, B, FL, FR, FD, FT, BL, BR, BD, BT, LD, LT,
340 RD, RT, FLD, FLT, FRD, FRT, BLD, BLT, BRD, BRT]
341 ==> ccwz c /= c
342
343
344 -- | If we rotate a direction (other than top or down) clockwise with
345 -- respect to the z-axis, we should get a new direction.
346 prop_cwz_rotation_changes_direction :: Cardinal -> Property
347 prop_cwz_rotation_changes_direction c =
348 c `elem` [L, R, F, B, FL, FR, FD, FT, BL, BR, BD, BT, LD, LT,
349 RD, RT, FLD, FLT, FRD, FRT, BLD, BLT, BRD, BRT]
350 ==> cwz c /= c
351
352
353 -- | If we are given a direction c, there should only be one direction
354 -- d which, when rotated counter-clockwise with respect to the
355 -- x-axis, produces c.
356 prop_ccwx_rotation_result_unique :: Cardinal -> Property
357 prop_ccwx_rotation_result_unique c =
358 c `elem` all_directions ==>
359 (length [ d | d <- all_directions, ccwx d == c ]) == 1
360
361 -- | If we are given a direction c, there should only be one direction
362 -- d which, when rotated clockwise with respect to the x-axis,
363 -- produces c.
364 prop_cwx_rotation_result_unique :: Cardinal -> Property
365 prop_cwx_rotation_result_unique c =
366 c `elem` all_directions ==>
367 (length [ d | d <- all_directions, cwx d == c ]) == 1
368
369
370 -- | If we are given a direction c, there should only be one direction
371 -- d which, when rotated counter-clockwise with respect to the
372 -- y-axis, produces c.
373 prop_ccwy_rotation_result_unique :: Cardinal -> Property
374 prop_ccwy_rotation_result_unique c =
375 c `elem` all_directions ==>
376 (length [ d | d <- all_directions, ccwy d == c ]) == 1
377
378
379 -- | If we are given a direction c, there should only be one direction
380 -- d which, when rotated clockwise with respect to the y-axis,
381 -- produces c.
382 prop_cwy_rotation_result_unique :: Cardinal -> Property
383 prop_cwy_rotation_result_unique c =
384 c `elem` all_directions ==>
385 (length [ d | d <- all_directions, cwy d == c ]) == 1
386
387
388 -- | If we are given a direction c, there should only be one direction
389 -- d which, when rotated counter-clockwise with respect to the
390 -- z-axis, produces c.
391 prop_ccwz_rotation_result_unique :: Cardinal -> Property
392 prop_ccwz_rotation_result_unique c =
393 c `elem` all_directions ==>
394 (length [ d | d <- all_directions, ccwz d == c ]) == 1
395
396
397 -- | If we are given a direction c, there should only be one direction
398 -- d which, when rotated clockwise with respect to the z-axis,
399 -- produces c.
400 prop_cwz_rotation_result_unique :: Cardinal -> Property
401 prop_cwz_rotation_result_unique c =
402 c `elem` all_directions ==>
403 (length [ d | d <- all_directions, cwz d == c ]) == 1
404
405
406 -- | If you rotate a cardinal direction four times in the clockwise
407 -- (with respect to x) direction, you should wind up with the same
408 -- direction.
409 prop_four_cwx_is_identity :: Cardinal -> Bool
410 prop_four_cwx_is_identity c =
411 (cwx . cwx . cwx . cwx) c == c
412
413 -- | If you rotate a cardinal direction four times in the
414 -- counter-clockwise (with respect to x) direction, you should wind up
415 -- with the same direction.
416 prop_four_ccwx_is_identity :: Cardinal -> Bool
417 prop_four_ccwx_is_identity c =
418 (ccwx . ccwx . ccwx . ccwx) c == c
419
420 -- | If you rotate a cardinal direction four times in the clockwise
421 -- (with respect to y) direction, you should wind up with the same
422 -- direction.
423 prop_four_cwy_is_identity :: Cardinal -> Bool
424 prop_four_cwy_is_identity c =
425 (cwy . cwy . cwy . cwy) c == c
426
427 -- | If you rotate a cardinal direction four times in the counter-clockwise
428 -- (with respect to y) direction, you should wind up with the same
429 -- direction.
430 prop_four_ccwy_is_identity :: Cardinal -> Bool
431 prop_four_ccwy_is_identity c =
432 (ccwy . ccwy . ccwy . ccwy) c == c
433
434 -- | If you rotate a cardinal direction four times in the clockwise
435 -- (with respect to z) direction, you should wind up with the same
436 -- direction.
437 prop_four_cwz_is_identity :: Cardinal -> Bool
438 prop_four_cwz_is_identity c =
439 (cwz . cwz . cwz . cwz) c == c
440
441 -- | If you rotate a cardinal direction four times in the
442 -- counter-clockwise (with respect to z) direction, you should wind up
443 -- with the same direction.
444 prop_four_ccwz_is_identity :: Cardinal -> Bool
445 prop_four_ccwz_is_identity c =
446 (ccwz . ccwz . ccwz . ccwz) c == c
447
448
449 cardinal_tests :: TestTree
450 cardinal_tests =
451 testGroup "Cardinal tests" [
452 testCase "c-tilde_2100 rotation correct"test_c_tilde_2100_rotation_correct ]
453
454
455 cardinal_properties :: TestTree
456 cardinal_properties =
457 testGroup "Cardinal properties" [
458 testProperty
459 "ccwx rotation changes direction"
460 prop_ccwx_rotation_changes_direction,
461 testProperty
462 "cwx rotation changes direction"
463 prop_cwx_rotation_changes_direction,
464 testProperty
465 "ccwy rotation changes direction"
466 prop_ccwy_rotation_changes_direction,
467 testProperty
468 "cwy rotation changes direction"
469 prop_cwy_rotation_changes_direction,
470 testProperty
471 "ccwz rotation changes direction"
472 prop_ccwz_rotation_changes_direction,
473 testProperty
474 "cwz rotation changes direction"
475 prop_cwz_rotation_changes_direction,
476 testProperty
477 "ccwx rotation result unique"
478 prop_ccwx_rotation_result_unique,
479 testProperty
480 "cwx rotation result unique"
481 prop_cwx_rotation_result_unique,
482 testProperty
483 "ccwy rotation result unique"
484 prop_ccwy_rotation_result_unique,
485 testProperty
486 "cwy rotation result unique"
487 prop_cwy_rotation_result_unique,
488 testProperty
489 "ccwz rotation result unique"
490 prop_ccwz_rotation_result_unique,
491 testProperty
492 "cwz rotation result unique"
493 prop_cwz_rotation_result_unique,
494 testProperty
495 "four cwx is identity"
496 prop_four_cwx_is_identity,
497 testProperty
498 "four ccwx is identity"
499 prop_four_ccwx_is_identity,
500 testProperty
501 "four cwy is identity"
502 prop_four_cwy_is_identity,
503 testProperty
504 "four ccwy is identity"
505 prop_four_ccwy_is_identity,
506 testProperty
507 "four cwz is identity"
508 prop_four_cwz_is_identity,
509 testProperty
510 "four ccwz is identity"
511 prop_four_ccwz_is_identity ]