Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 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
Add Comment
Please, Sign In to add comment