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
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192

import qualified Data.Map as Map
import qualified Data.Char as Char

type Pos = (Int, Int)
data Direction = North | South | East | West

-- Swapped the parameter order so I can use foldl in moves
move :: Pos -> Direction -> Pos
move (x,y) North = (x, y+1)
move (x,y) South = (x, y-1)
move (x,y) West  = (x-1, y)
move (x,y) East  = (x+1, y)

-- Perform the list of moves in order on the position
moves :: [Direction] -> Pos -> Pos
moves xs p = foldl move p xs

-- Natural number data type
data Nat = Zero | Succ Nat
     deriving (Eq, Show, Read, Ord)

-- Let's make it an instance of Num

instance Num Nat where
    -- Addition
    a + Zero     = a
    a + (Succ b) = Succ (a + b)

    -- Subtraction
    a        - Zero     = a
    Zero     - _        = error "Not a natural number"
    (Succ a) - (Succ b) = a - b

    -- Multiplication
    Zero     * _    = Zero
    _        * Zero = Zero
    (Succ a) * b    = b + (a * b)

    -- Conversion
    fromInteger x
        | x > 0     = Succ (fromInteger (x-1))
        | x < 0     = error "Not a natural number"
        | otherwise = Zero

    -- Abs value and signum are trivial
    abs x = x

    signum x = Succ Zero
    -- End of instance

-- Binary trees
-- This version allows for duplicates!
data Tree a = Leaf | Node a (Tree a) (Tree a)

-- insertion
insert Leaf a = Node a Leaf Leaf
insert (Node n t1 t2) a
    | a > n     = Node n t1 (insert t2 a)
    | otherwise = Node n (insert t1 a) t2

-- Expressions
data Expr = Con Int
          | Add Expr Expr
          | Sub Expr Expr
          | Mul Expr Expr
          | Div Expr Expr
     deriving (Eq, Read, Ord)

-- Calculate an expression's value
value :: Expr -> Int
value (Con n) = n
value (Add x y) = value x + value y
value (Sub x y) = value x - value y
value (Mul x y) = value x * value y
value (Div x y) = value x `div` value y

-- Pretty printing
eshow (Con n)   = show n
eshow (Add x y) = eshow x ++ " + " ++ eshow y
eshow (Sub x y) = eshow x ++ " - " ++ eshow y
eshow (Mul x y) = eshow_aux x ++ " * " ++ eshow_aux y
eshow (Div x y) = eshow_aux x ++ " / " ++ eshow_aux y
eshow_aux exp   = case exp of (Add _ _)   -> "(" ++ eshow exp ++ ")"
                              (Sub _ _)   -> "(" ++ eshow exp ++ ")"
                              otherwise   -> eshow exp

instance Show Expr where
    show = eshow

v = (((Con 2 `Mul` Con 3) `Add` Con 5) `Mul` (Con 4 `Mul` ((Con 2 `Add` Con 3) `Mul` Con 4))) `Mul` ((Con 5 `Mul` Con 6) `Add` (Con 8 `Add` ((Con 3 `Add` Con 2) `Mul` Con 4)))

-- Morse codes
-- First a list of them all
mcodes = [('A', ".-")
         ,('B', "-...")
         ,('C', "-.-.")
         ,('D', "-..")
         ,('E', ".")
         ,('F', "..-.")
         ,('G', "--.")
         ,('H', "....")
         ,('I', "..")
         ,('J', ".---")
         ,('K', "-.-")
         ,('L', ".-..")
         ,('M', "--")
         ,('N', "-.")
         ,('O', "---")
         ,('P', ".--.")
         ,('Q', "--.-")
         ,('R', ".-.")
         ,('S', "...")
         ,('T', "-")
         ,('U', "..-")
         ,('V', "...-")
         ,('W', ".--")
         ,('X', "-..-")
         ,('Y', "-.--")
         ,('Z', "--..")
         ]

-- Create two maps for working with the data.
-- One going letter -> code, and one reverse.
tomap   = Map.fromList mcodes
frommap = Map.fromList (map (\(a,b) -> (b,a)) mcodes)

-- Encode a string as morse code
encode :: String -> String
encode str = foldl (\x y -> x ++ (tomap Map.! y)) "" (map Char.toUpper str)

-- Decode a morse code and return a list of all possible strings
decode :: String ->[String]
decode []  = [""] -- Using a list with the empty string as base case is easier
decode str = concat [ys | n <- [1..min 4 (length str)], -- n = length of a code
                          let c  = take n str, -- c is a potential code
                          Map.member c frommap, -- Is c actually a code?
                          let xs = decode (drop n str), -- get codes of rest
                          let ys = map (\x -> (frommap Map.! c):x) xs]
                          -- Prepend the code to all possible codes with rest
                          -- of the string.

-- Sizeable
class Sizeable t where
    size :: t -> Int

-- Some primitives.
instance Sizeable Int where
    size _ = 1

instance Sizeable Char where
    size _ = 1

-- Size of a list is just its length
-- instance Sizeable [a] where
--    size xs = length xs

-- Size of a list is the sum of its elements' sizes plus its length plus one
instance Sizeable a => Sizeable [a] where
    size xs = sum (map size xs) + length xs + 1


-- Monad shizzle
data List a = Nil | Cons a (List a)
    deriving Show

-- Mapping for this kind of list
lmap :: (a -> b) -> List a -> List b
lmap f Nil = Nil
lmap f (Cons a xs) = Cons (f a) (lmap f xs)

-- Concat for this kind of list
lconcat :: List (List a) -> List a
lconcat Nil                   = Nil
lconcat (Cons Nil xs)         = lconcat xs
lconcat (Cons (Cons y ys) xs) = Cons y (lconcat (Cons ys xs))

-- Monad instance
instance Monad List where
    return x = Cons x Nil
    xs >>= f = lconcat (lmap f xs)
    fail _ = Nil

-- findAssoc
type Assoc a = [(String, a)]
findAssoc :: String -> Assoc a -> Maybe a
findAssoc key assoc = head bindings
    where bindings = [Just v | (k, v) <- assoc, k == key] ++ [Nothing]

-- The Maybe monad does all the work. Voila <3
addKeys assoc k1 k2 = do v1 <- findAssoc k1 assoc
                         v2 <- findAssoc k2 assoc
                         v1 + v2