HS-Poker/TupleSort.hs at master · adek05/HS-Poker · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
module TupleSort where

gt :: (a -> a -> Ordering) -> a -> a -> Bool
gt cmp a b = a `cmp` b == GT

lt :: (a -> a -> Ordering) -> a -> a -> Bool
lt cmp a b = a `cmp` b == LT


gte :: (a -> a -> Ordering) -> a -> a -> Bool
gte cmp a b = c == GT || c == EQ
  where
    c = cmp a b

tuple5SortBy :: (a -> a -> Ordering) -> (a,a,a,a,a) -> (a,a,a,a,a)
tuple5SortBy cmp = step4 . step3 . step2 . step1
  where
    step1 (a,b,c,d,e) | gt cmp a b = (b,a,c,d,e)
                      | otherwise = (a,b,c,d,e)

    step2 (a,b,c,d,e) | gt cmp c d = (a,b,d,c,e)
                      | otherwise = (a,b,c,d,e)

    step3 (a,b,c,d,e) | gt cmp b d = (c,d,a,b,e)
                      | otherwise = (a,b,c,d,e)

    step4 (a,b,c,d,e) | gte cmp e b = step5 (a,b,c,d,e) -- e >= b
                      | otherwise = step6 (a,b,c,d,e) -- e < b

    step5 (a,b,c,d,e) | lt cmp e d = step7 (a,b,c,d,e) -- e < d
                      | otherwise = step8 (a,b,c,d,e) -- e >= d

    step6 (a,b,c,d,e) | lt cmp e a = step12 (a,b,c,d,e)
                      | otherwise = step13 (a,b,c,d,e)

    step7 (a,b,c,d,e) | gte cmp c b = step9 (a,b,c,d,e) -- complete
                      | otherwise = step10 (a,b,c,d,e) -- complete

    step8 (a,b,c,d,e) | gte cmp c b = (a,b,c,d,e) -- complete
                      | otherwise = step11 (a,b,c,d,e) -- complete

    step9 (a,b,c,d,e) | lt cmp c e = (a,b,c,e,d) -- complete
                      | otherwise = (a,b,e,c,d) -- complete

    step10 (a,b,c,d,e) | lt cmp c a = (c,a,b,e,d) -- complete
                       | otherwise = (a,c,b,e,d) -- complete

    step11 (a,b,c,d,e) | lt cmp c a = (c,a,b,d,e) -- Complete
                       | otherwise = (a,c,b,d,e) -- Complete

    step12 (a,b,c,d,e) | gte cmp c a = step14 (a,b,c,d,e) -- complete
                       | otherwise = step15 (a,b,c,d,e) -- complete

    step13 (a,b,c,d,e) | gte cmp c e = step16 (a,b,c,d,e)
                       | otherwise = step17 (a,b,c,d,e)

    step14 (a,b,c,d,e) | lt cmp c b = (e,a,c,b,d) -- complete
                       | otherwise = (e,a,b,c,d) -- complete

    step15 (a,b,c,d,e) | lt cmp c e = (c,e,a,b,d) -- complete
                       | otherwise = (e,c,a,b,d) -- complete

    step16 (a,b,c,d,e) | lt cmp c b = (a,e,c,b,d)
                       | otherwise = (a,e,b,c,d)

    step17 (a,b,c,d,e) | lt cmp c a = (c,a,e,b,d)
                       | otherwise = (a,c,e,b,d)