Complete chapter 10-11

10-folding-lists/10.10-chapter-exercises.md

@@ -0,0 +1,6 @@
+# Chapter Exercises
+## Warm-up and review
+see src/warmup.hs
+
+## Rewriting functions using folds
+see src/rewrite.hs

10-folding-lists/10.5-understanding-folds.md

@@ -0,0 +1,40 @@
+# Exercises: Understanding folds
+## Exercise 1
+This will evaluate to: `(1*(2*(3*(4*(5*1))))`, so
+1. Is not correct as the types are incorrect.
+2. Will return the same result.
+3. Will also return the same result.
+The latter two are the same because multiplication is commutative.
+
+## Exercise 2
+```
+fMul = flip (*)
+            | ------- accumulator -------| 
+  foldl fMul                   1          [1,2,3]
+= foldl fMUl             (fMul 1 1)       [2,3]
+= foldl fMul       (fMul (fMul 1 1) 2)    [3]
+= foldl fMul (fMul (fMul (fMul 1 1) 2) 3) []
+=             fMul (fMul (fMul 1 1) 2) 3
+= 3*(2*(1*1))
+= 6
+```
+
+## Exercise 3
+1. They both traverse the spine from right to left. This evident by the `(x:xs)` pattern matching in both functions' definition.
+2. They both force the rest of the fold as they are both recursive functions.
+3. **True, `foldr` associates from the right and `foldl` assocatiates from the left.**
+4. They are both recursive
+
+## Exercise 4
+(a) Catamorphism means to shape downwards and thus reduce structure. This is evident in the application of the folds which can reduce lists to a single value.
+
+## Exercise 5
+1. The zero value is missing: `foldr (++) "" ["woot", "WOOT", "woot"]`
+2. The wrong zero value is used, a `Char` is expected: `foldr max 'a' "fear is the litle death"`
+3. `and :: [a] -> Bool` is a function which takes an array and returns `True` if all values are `True`. This is not the same type as expected: `(a -> b -> b)`. **Should be: `foldr (&&) True [False, True]`**
+4. The wrong zero value is used as this will always return `True`. Such is the nature of the `(||)`operator. Should be: `foldr (||) False [False, True]`
+5. `foldl` expects a `b -> a -> b` function. `((++) . show) :: Show a =>  a -> [Char] -> [Char]`. If we use this function this means that, because the accumalator starting values `""` is of type `[Char]`, our fold function is: `[Char] -> [Char] -> [Char]` which does not fit, because this would mean our elements of the array should be of type `[Char]`. **It should be: `foldr (flip $ ((++) . show) "" [1..5]`**
+6. The result of the `const` application should be the same type as the zero value (`Char`), but `const` returns the type of the second argument, in this case `Num a => a`. **It should be: `foldr (flip const) 'a' [1..5]`**
+7. Same as (6). It should be: `foldr (flip const) 0 "tacos"`
+8. This is similar to the previous questions. The `flip` is not needed here for the same reasons it is needed in (6) and (7). It should be: `foldl const 0 "burritos"`
+9. Same as (8). It should be `foldl const 'z' [1..5]`

10-folding-lists/10.6-database-processing.md

@@ -0,0 +1,2 @@
+# Exercises: Database Processing
+see src/dbprocess.hs

10-folding-lists/10.9-scan-exercises.md

@@ -0,0 +1,2 @@
+# Scan Exercises
+see src/fibs.hs

10-folding-lists/src/dbprocess.hs

@@ -0,0 +1,63 @@
+module DBProcess where
+
+    import Data.Time
+
+    data DatabaseItem = DbString String
+                      | DbNumber Integer
+                      | DbDate   UTCTime
+                      deriving (Eq, Ord, Show)
+
+    theDatabase :: [DatabaseItem]
+    theDatabase =
+        [ DbDate (UTCTime 
+                  (fromGregorian 1911 5 1)
+                  (secondsToDiffTime 34123))
+        , DbNumber 9001
+        , DbString "Hello, world!"
+        , DbDate (UTCTime
+                  (fromGregorian 1921 5 1)
+                  (secondsToDiffTime 34123))
+        ]
+
+    -- 1
+    filterDbDate :: [DatabaseItem] -> [UTCTime]
+    filterDbDate = foldr f []
+        where f (DbDate u) xs = u : xs
+              f _          xs = xs
+
+    -- 2
+    filterDbNumber :: [DatabaseItem] -> [Integer]
+    filterDbNumber = foldr f []
+        where f (DbNumber i) xs = i : xs
+              f _            xs = xs
+    
+    -- 3
+    mostRecent :: [DatabaseItem] -> UTCTime
+    mostRecent = maximum . filterDbDate
+
+    -- with folds, this is more difficult, because it's not easy to find the
+    -- right zero value. Ideally it would be the smallest UTCTime possible.
+    mostRecent' :: [DatabaseItem] -> UTCTime
+    mostRecent' = foldr f z
+        where f (DbDate u1) u2 = max u1 u2
+              f _           u  = u
+              z                = UTCTime d 0
+              d = (toEnum (minBound :: Int) :: Day)
+    -- The problem here is that even this day is not the smallest possible, 
+    -- because you can simply do `pred d` which gives a smaller day. So the
+    -- original solution is superior.
+
+    -- 4 
+    sumDb :: [DatabaseItem] -> Integer
+    sumDb = sum . filterDbNumber
+
+    -- with folds
+    sumDb' :: [DatabaseItem] -> Integer
+    sumDb' = foldr f 0
+        where f (DbNumber i1) i2 = i1 + i2
+              f _           i2   = i2
+
+    -- 5
+    avgDb :: [DatabaseItem] -> Double
+    avgDb [] = undefined -- 0/0
+    avgDb xs = (fromIntegral . sumDb $ xs ) / (fromIntegral . length $ xs)

10-folding-lists/src/fibs.hs

@@ -0,0 +1,59 @@
+module Fibs where
+
+    fibs :: [Integer]
+    fibs = 1 : scanl (+) 1 fibs
+
+    -- To understand how this works, let's expand fibs, but first
+    -- the definition of scanl
+    --
+    scanl' :: (a -> b -> a) -> a -> [b] -> [a]
+    scanl' f q ls =
+      q : (case ls of
+             [] -> []
+             x:xs -> scanl' f (f q x) xs)
+
+    -- Now on to the expansion, replace fibs with it's definition
+    fibs1 :: [Integer]
+    fibs1 = 1 : scanl (+) 1 (1 : scanl (+) 1 fibs)
+
+    -- Apply definition of scanl
+    fibs2 :: [Integer]
+    fibs2 = 1 : (1 : scanl (+) 2 (scanl (+) 1 fibs))
+    
+    -- As you can see we've constructed another element of the list
+    -- If we continue, we'll generate another one, but before we can do this
+    -- we have to repalce fibs with it's definition again.
+    -- Note: all fibs's are the same so you replace another fibs instead
+    fibs3 :: [Integer]
+    fibs3 = 1 : (1 : scanl (+) 2 (scanl (+) 1 
+                 (1 : scanl (+) 1 fibs)))
+    
+    -- Apply the definition of the second scanl
+    fibs4 :: [Integer]
+    fibs4 = 1 : (1 : scanl (+) 2 (1 : scanl (+) 2 (scanl (+) 1 fibs)))
+
+    -- Apply the definition of the first scanl
+    fibs5 :: [Integer]
+    fibs5 = 1 : (1 : (2 : (scanl (+) 3 (scanl (+) 2 (scanl (+) 1 fibs)))))
+
+    -- We have now generated the first 3 elements of the fibonacci series
+    -- If the same replacements are being applied, it will keep generating
+    -- new entries.
+    
+    fibsN :: Int -> Integer
+    fibsN = (!!) fibs
+    
+    -- 1
+    fibs' :: [Integer]
+    fibs' = take 20 $ fibs
+
+    -- 2
+    fibs'' :: [Integer]
+    fibs'' = takeWhile (<100) fibs
+
+    -- 3
+    fact :: [Integer]
+    fact =  scanl (*) 1 [1..]
+
+    factN :: Int -> Integer
+    factN = (!!) fact

10-folding-lists/src/rewrite.hs

@@ -0,0 +1,63 @@
+module Rewrite where
+
+    -- 1
+    myOr :: [Bool] -> Bool
+    myOr = foldr (||) False
+
+    -- 2
+    myAny :: (a -> Bool) -> [a] -> Bool
+    myAny f = foldr (\a b -> f a || b) False
+
+    -- 3
+    myElem :: Eq a => a -> [a] -> Bool
+    myElem x = foldr (\a b -> (x == a) || b) False
+
+    myElem' :: Eq a => a -> [a] -> Bool
+    myElem' x = any (x==)
+
+    -- 4
+    myReverse :: [a] -> [a]
+    myReverse = foldr (\a b -> b ++ [a]) []
+    -- other solution would be to use foldl (flip (:)) []
+
+    -- 5
+    myMap :: (a -> b) -> [a] -> [b]
+    myMap f = foldr (\a b -> f a : b) []
+    -- myMap = foldr ((:) . f) []
+
+    -- 6  
+    myFilter :: (a -> Bool) -> [a] -> [a]
+    myFilter f = foldr g []
+        where g a b
+                | f a = a : b
+                | otherwise = b
+
+    -- 7
+    squish :: [[a]] -> [a]
+    squish = foldr (++) []
+    
+    -- 8
+    squishMap :: (a -> [b]) -> [a] -> [b]
+    squishMap f = foldr ((++) . f) []
+
+    -- 9
+    squishAgain :: [[a]] -> [a]
+    squishAgain = squishMap id
+
+    -- 10
+    myMaximumBy :: (a -> a -> Ordering) -> [a] -> a
+    myMaximumBy _ [] = undefined
+    myMaximumBy _ [x] = x
+    myMaximumBy f (x:xs) = foldl go x xs
+        where go a b
+               | f a b == GT = a
+               | otherwise   = b
+
+    -- 11
+    myMinimumBy :: (a -> a -> Ordering) -> [a] -> a
+    myMinimumBy _ [] = undefined
+    myMinimumBy _ [x] = x
+    myMinimumBy f (x:xs) = foldl go x xs
+        where go a b
+               | f a b == LT = a
+               | otherwise   = b

10-folding-lists/src/warmup.hs

@@ -0,0 +1,44 @@
+module WarmUp where
+
+    -- 1
+    stops :: [Char]
+    stops  = "pbtdkg"
+    vowels :: [Char]
+    vowels = "aeiou"
+
+    stopVowelStop :: [(Char, Char, Char)]
+    stopVowelStop = [(x,y,z) | x <- stops, y <- vowels, z <- stops]
+    
+    svsP :: [(Char, Char, Char)]
+    svsP = [(x,y,z) | x <- stops, y <- vowels, z <- stops, x == 'p']
+    -- or
+    svsP' :: [(Char, Char, Char)]
+    svsP' = [('p', x, y) | x <- vowels, y <- stops]
+    -- or
+    svsP'' :: [(Char, Char, Char)]
+    svsP'' = filter (\(x,_,_) -> x == 'p') stopVowelStop
+
+    nouns :: [[Char]]
+    nouns = ["apple", "dog", "door", "water", "life"]
+
+    verbs :: [[Char]]
+    verbs = ["eat", "run", "drop", "jump", "grow"]
+
+    tupleUp :: [a] -> [b] -> [c] -> [(a,b,c)]
+    tupleUp xs ys zs = [(x,y,z) | x <- xs, y <- ys, z <- zs]
+
+    nvn :: [([Char], [Char], [Char])]
+    nvn = tupleUp nouns verbs nouns
+
+    -- 2
+    seekritFunc :: [Char] -> Int
+    seekritFunc x = div (sum (map length (words x)))
+                        (length (words x))
+    -- This function returns average number of characters per word
+
+    -- 3
+    seekritFunc' :: Fractional a => [Char] -> a
+    seekritFunc' x = (/) (fromIntegral $ sum (map length (words x)))
+                         (fromIntegral $ length (words x))
+
+

11-algebraic-datatypes/11.10-pity-the-bool.md

@@ -0,0 +1,10 @@
+# Exercises: Pity the Bool
+## Exercise 1
+The cardinality here is 4: `[Big False, Big True, Small False, Small True]`
+
+## Exercise 2
+Cardinality of `Numba` is 256 (same as `Int8`).
+Cardinality of `Bool` is 2.
+Cardinality of `NumberOrBool` is `256 + 2 = 258`
+
+If you try to create a `Numba` with numeric literals larger than 127 or smaller than  (-128) you will get an error as the number will be higher than what can be contained in an `Int8`

11-algebraic-datatypes/11.12-garden.md

@@ -0,0 +1,2 @@
+# Exercises: How Does Your Garden Grow?
+see src/garden.hs

11-algebraic-datatypes/11.13-programmers.md

@@ -0,0 +1,2 @@
+# Exercises: Programmers
+see src/programmers.hs

11-algebraic-datatypes/11.14-the-quad.md

@@ -0,0 +1,18 @@
+# Exercises: The Quad
+# Exercise 1
+`Either` is a sum type, so `eQuad` has `4 + 4 = 8` inhabitants.
+
+# Exercise 2
+`(,)` is a product type, so `prodQuad` has `4 * 4 = 16` inhabitants.
+
+# Exercise 3
+`(->)` is an exponential type, so `funcQuad` has `4 ^ 4 = 256` inhabitants.
+
+# Exercise 4
+`(,,)` is a product type, so `prodTBool` has `2 * 2 * 2 = 8` inhabitants.
+
+# Exercise 5
+`(->)` is an exponential type, so `gTwo` has `(2 ^ 2) ^ 2 = 16` inhabitants.
+
+# Exercise 6
+`(->)` is an exponential type, so `fTwo` has `(4 ^ 4) ^ 2 = 65536` inhabitants.

11-algebraic-datatypes/11.18-chapter-exercises.md

@@ -0,0 +1,21 @@
+# Chapter Exercise
+## Multiple Choice
+1. (a)
+2. (c)
+3. (b)
+4. (c)
+
+## Ciphers
+see src/vigenere.hs
+
+## As-patterns
+see src/aspatterns.hs
+
+## Language exercises
+see src/langexerc.hs
+
+## Phone excercise
+see src/phone.hs
+
+## Hutton's Razor
+see src/huttonrazor.hs

11-algebraic-datatypes/11.5-dog-types.md

@@ -0,0 +1,10 @@
+# Exercises: Dog Types
+1. Type constructor
+2. `* -> *`
+3. `*`
+4. `Num a => Doggies a`
+5. `Doggies Integer`
+6. `Doggies [Char]`
+7. Both.
+8. `a -> DogueDeBordeaux a`
+9. `DogueDeBordeaux [Char]`

11-algebraic-datatypes/11.6-vehicles.md

@@ -0,0 +1,2 @@
+# Exercise : Vehicles
+see src/vehicle.hs

11-algebraic-datatypes/11.8-cardinality.md

@@ -0,0 +1,6 @@
+# Exercises: Cardinality
+1. 1
+2. 3
+3. 65536
+4. `Integer` is unbounded.
+5. 8 bits represent 256 value (2 to the power of 8)

11-algebraic-datatypes/11.8-for-example.md

@@ -0,0 +1,4 @@
+# Exercises: For Example
+1. Type is `Example` `MakeExample :: Example`
+2. It shows deriving of the typeclass `Show`
+3. It will change to `Int -> Example`

11-algebraic-datatypes/11.9-logic-goats.md

@@ -0,0 +1,2 @@
+# Exercises: Logic Goats
+see src/logicgoats.hs

11-algebraic-datatypes/src/aspatterns.hs

@@ -0,0 +1,16 @@
+module AsPatters where
+
+    import Data.Char
+
+    isSubseqOff :: (Eq a) => [a] -> [a] -> Bool
+    isSubseqOff [] _ = True
+    isSubseqOff _ [] =  False
+    isSubseqOff s1@(x:xs) (y:ys) =
+        if x == y
+        then isSubseqOff xs ys
+        else isSubseqOff s1 ys
+
+    capitalizeWords :: String -> [(String, String)]
+    capitalizeWords = map f . words
+            where f [] = ([],[])
+                  f s@(x:xs) = (s, toUpper x : xs)

11-algebraic-datatypes/src/binarytree.hs

@@ -0,0 +1,81 @@
+module BinaryTree where
+
+    data BinaryTree a = Leaf
+                    | Node (BinaryTree a) a (BinaryTree a)
+                    deriving (Show, Eq, Ord)
+
+    insert' :: Ord a => a -> BinaryTree a -> BinaryTree a
+    insert' b Leaf = Node Leaf b Leaf
+    insert' b (Node left a right)
+      | b == a = Node left a right
+      | b < a  = Node (insert' b left) a right
+      | b > a  = Node left a (insert' b right)
+
+    -- map
+    mapTree :: (a -> b) -> BinaryTree a -> BinaryTree b
+    mapTree _ Leaf = Leaf
+    mapTree f (Node left a right) = Node (mapTree f left)
+                                         (f a)
+                                         (mapTree f right)
+
+    testTree' :: BinaryTree Integer
+    testTree' = Node (Node Leaf 3 Leaf) 1 (Node Leaf 4 Leaf)
+
+    mapExpected :: BinaryTree Integer
+    mapExpected = Node (Node Leaf 4 Leaf) 2 (Node Leaf 5 Leaf)
+
+    mapOkay :: IO ()
+    mapOkay =
+        if mapTree (+1) testTree' == mapExpected
+        then print "yup okay!"
+        else error "test failed!"
+
+    -- lists
+    preorder :: BinaryTree a -> [a]
+    preorder Leaf = []
+    preorder (Node left a right) =
+        a : (preorder left ++ preorder right)
+
+    inorder :: BinaryTree a -> [a]
+    inorder Leaf = []
+    inorder (Node left a right) =
+        inorder left ++ (a : inorder right)
+    
+    postorder :: BinaryTree a -> [a]
+    postorder Leaf = []
+    postorder (Node left a right) =
+        postorder left ++ postorder right ++ [a]
+
+    testTree :: BinaryTree Integer
+    testTree = Node (Node Leaf 1 Leaf) 2 (Node Leaf 3 Leaf)
+
+    testPreorder :: IO ()
+    testPreorder =
+        if preorder testTree == [2, 1, 3]
+        then putStrLn "Preorder fine!"
+        else putStrLn "Bad news bears."
+    
+    testInorder :: IO ()
+    testInorder =
+        if inorder testTree == [1, 2, 3]
+        then putStrLn "Inorder fine!"
+        else putStrLn "Bad news bears."
+
+    testPostorder :: IO ()
+    testPostorder =
+        if postorder testTree == [1, 3, 2]
+        then putStrLn "Postorder fine!"
+        else putStrLn "Bad news bears."
+
+    main :: IO ()
+    main = do
+        testPreorder
+        testInorder
+        testPostorder
+
+
+    -- foldr
+    foldTree :: (a -> b -> b) -> b -> BinaryTree a -> b
+    foldTree _ b Leaf = b
+    foldTree f b (Node left a right) = 
+        f a (foldTree f (foldTree f b right) left) 

11-algebraic-datatypes/src/garden.hs

@@ -0,0 +1,18 @@
+module Garden where
+
+    data FlowerType = Gardenia
+                    | Daisy
+                    | Rose
+                    | Lilac
+                    deriving Show
+    
+    type Gardener = String
+
+    data Garden = Garden Gardener FlowerType deriving Show
+
+    -- 1
+    data Garden' = Gardenia' Gardener
+                 | Daisy' Gardener
+                 | Rose' Gardener
+                 | Lilac' Gardener
+                 deriving Show

11-algebraic-datatypes/src/huttonrazor.hs

@@ -0,0 +1,14 @@
+module HuttonRazor where
+
+    data Expr = Lit Integer | Add Expr Expr
+
+    -- 1
+    eval :: Expr -> Integer
+    eval (Lit i)     = i
+    eval (Add e1 e2) = eval e1 + eval e2
+
+    -- 2
+    printExpr :: Expr -> String
+    printExpr (Lit i) = show i
+    printExpr (Add e1 e2) = 
+        printExpr e1 ++ " + " ++ printExpr e2

11-algebraic-datatypes/src/langexerc.hs

@@ -0,0 +1,18 @@
+module LangExerc where
+
+    import Data.Char
+    import Data.List
+
+    -- 1
+    capitalizeWord :: String -> String
+    capitalizeWord [] = []
+    capitalizeWord (x:xs) = toUpper x : xs
+
+    -- 2
+    capitalizeParagraph :: String -> String
+    capitalizeParagraph = unwords . (foo True) . words
+        where foo _ [] = []
+              foo True (x:xs) = capitalizeWord x : go (x,xs)
+              foo False (x:xs) = x : go (x,xs)
+              go (_, []) = []
+              go (x,xs) = foo (isSuffixOf "." x) xs

11-algebraic-datatypes/src/logicgoats.hs

@@ -0,0 +1,25 @@
+{-# LANGUAGE FlexibleInstances #-}
+
+module LogicGoats where
+
+    class TooMany a where
+        tooMany :: a -> Bool
+
+    -- 1
+    newtype IntString = IntString (Int,String)    
+    instance TooMany IntString where
+        tooMany (IntString (n, _)) = n > 42
+    
+    -- needs FlexibleInstances
+    instance TooMany (Int, String) where
+        tooMany (n, _) = n > 42
+
+    -- 2
+    newtype Goats = Goats (Int, Int)
+    instance TooMany Goats where
+        tooMany (Goats (m, n)) = (m+n)>42
+
+    --3
+    -- needs FlexibleInstances
+    instance (Num a, TooMany a) => TooMany (a,a) where
+        tooMany (a,b) = tooMany $ a + b

11-algebraic-datatypes/src/phone.hs

@@ -0,0 +1,159 @@
+module Phone where
+    -- This was quite a doozy.
+    -- It's far from perfect, but it does the job.
+    import Data.Char
+    import Data.List
+    
+    convo :: [String]
+    convo =
+        ["Wanna play 20 questions",
+         "Ya",
+         "U 1st haha",
+         "Lol ok. Have u ever tasted alcohol",
+         "Lol ya",
+         "Wow ur cool haha. Ur turn",
+         "Ok. Do u think I am pretty Lol",
+         "Lol ya",
+         "Just making sure rofl ur turn"]
+    
+    
+    -- validButtons = "1234567890*#"
+    type Digit = Char
+
+    -- Valid presses: 1 and up
+    type Presses = Int
+
+    contains :: Char -> (Digit, String) -> Bool
+    contains c (d,s) = c `elem` d : s
+
+    -- Two types of buttons
+    -- A bit silly that you have to now pattern match
+    -- on each of them, even though they have the same
+    -- 'content'. Better solution? It is a sum of products
+    -- rather than a product of sums though...
+    data Button = Normal (Digit, String)
+                | Capital (Digit, String)
+                deriving (Eq, Show)
+
+    -- Some buttons
+    isCapital :: Button -> Bool
+    isCapital (Capital _) = True
+    isCapital _           = False
+
+    isNormal :: Button -> Bool
+    isNormal (Normal _) = True
+    isNormal _          = False
+
+    contains' :: Char -> Button  -> Bool
+    contains' c (Capital a) = contains c a
+    contains' c (Normal a)  = contains c a
+    
+    getDigit :: Button -> Digit
+    getDigit (Capital (d,_)) = d
+    getDigit (Normal (d, _)) = d
+
+    getPresses :: Char -> (Digit, String) -> Maybe Presses
+    getPresses c (d,s) = fmap (+1) $ elemIndex c (d:s) 
+
+    getPresses' :: Char -> Button -> Maybe Presses
+    getPresses' c (Capital a) = getPresses c a
+    getPresses' c (Normal a)  = getPresses c a 
+
+    -- 1 The phone is just a list of buttons
+    data DaPhone = DaPhone [Button] deriving (Eq, Show)
+
+    getCapital :: DaPhone -> Maybe Button
+    getCapital (DaPhone xs) = find isCapital xs
+
+    lookUp :: DaPhone -> Char -> Maybe Button
+    lookUp (DaPhone xs) c = find (contains' c) xs
+
+    -- A valid phone has one Capital
+    -- button
+    mkDaPhone :: [Button] -> Maybe DaPhone
+    mkDaPhone xs
+        | req = Just $ DaPhone xs
+        | otherwise = Nothing
+        where req = (length $ filter isCapital xs) == 1
+
+    -- 2
+    reverseTaps :: DaPhone -> Char -> [(Digit, Presses)]
+    reverseTaps p c
+        | isUpper c = (cap $ getCapital p) ++ (reverseTaps p $ toLower c)
+        | otherwise = go m
+        where cap Nothing = []
+              cap (Just b) = [(getDigit b, 1)]
+              m = lookUp p c
+              go Nothing = []
+              go (Just b) = blah (getPresses' c b) $ (,) $ getDigit b
+              blah Nothing _ = [] 
+              blah (Just a) f = f a : []
+
+    cellPhonesDead :: DaPhone -> String -> [(Digit, Presses)]
+    cellPhonesDead p = concat . map (reverseTaps p)
+
+    -- 3
+    fingerTaps :: [(Digit, Presses)] -> Presses
+    fingerTaps = foldr (\(_,p) z -> p + z) 0
+
+    count :: Eq a => a -> [a] -> Int
+    count c s = length $ filter (==c) s
+
+    countElements :: Eq a => [a] -> [(a, Int)]
+    countElements s = map (\c -> (c,(count c s))) $ nub s
+    
+    -- 4
+    mostPopular :: (Eq a, Ord a) => [a] -> a
+    mostPopular s = fst m
+        where d = countElements s
+              m = maximumBy (\(_,i) (_,j) -> compare i j) d
+
+    myPhone :: Maybe DaPhone
+    myPhone = mkDaPhone
+        [ Normal ('1', ""),
+          Normal ('2', "abc"),
+          Normal ('3', "def"),
+          Normal ('4', "ghi"),
+          Normal ('5', "jkl"),
+          Normal ('6', "mno"),
+          Normal ('7', "pqrs"),
+          Normal ('8', "tuv"),
+          Normal ('9', "wvxz"),
+          Normal ('0', "+ "),
+          Capital ('*', "^"),
+          Normal ('#', ".,")]
+
+    -- Applies cellPhonesdead on myPhone
+    -- Keep in mind that myPhone is of type Maybe DaPhone
+    -- That is why we use fmap to act on the DaPhone
+    -- inside the Maybe 'container' (i.e. Functor)
+    --
+    -- fmap cellPhonesDead myPhone :: Maybe (String -> [(Digit, Presses)])
+    -- to which we now want to provide a string, so we need a map that
+    -- maps (String -> [(Digit, Presses)]) to [(Digit, Presses)].
+    -- In order to do that we want to provide a map that applies a String
+    -- to the contained function.
+    getDP :: String -> Maybe [(Digit, Presses)]
+    getDP s = fmap (\f -> f s) $ fmap cellPhonesDead myPhone
+
+    -- Same deal as getDp, a bit more complex.
+    getFT :: String -> Maybe Presses
+    getFT s = fmap fingerTaps fil
+        where fil = getDP (filter (==(mostPopular s)) s)
+
+    -- 5
+    coolestLtr :: [String] -> Char
+    coolestLtr = mostPopular . concat
+    
+    coolestWord :: [String] -> String
+    coolestWord = mostPopular
+
+    -- coolestWord :: [String] -> String
+
+    main :: IO ()
+    main = do
+        print $ map getDP convo
+        print $ map mostPopular convo
+        print $ map getFT convo
+        print $ coolestLtr convo
+        print $ coolestWord ((words . concat) convo)

11-algebraic-datatypes/src/programmers.hs

@@ -0,0 +1,40 @@
+module Programmers where
+
+    data OperatingSystem =
+          GnuPlusLinux
+        | OpenBSDPlusNevermindJustBSDStill
+        | Mac
+        | Windows
+        deriving (Eq, Show)
+
+    data ProgLang =
+          Haskell
+        | Agda
+        | Idris
+        | PureScript
+        deriving (Eq, Show)
+
+    data Programmer =
+        Programmer { os :: OperatingSystem
+                   , lang :: ProgLang }
+        deriving (Eq, Show)
+
+    -- Programmers
+    allOperatingSystems :: [OperatingSystem]
+    allOperatingSystems =
+        [ GnuPlusLinux
+        , OpenBSDPlusNevermindJustBSDStill
+        , Mac
+        , Windows
+        ]
+    
+    allLanguages :: [ProgLang]
+    allLanguages = [Haskell, Agda, Idris, PureScript]
+
+    allProgrammers :: [Programmer]
+    allProgrammers = 
+        [Programmer x y | x <- allOperatingSystems, y <- allLanguages ]
+
+    check :: Bool
+    check = length allProgrammers == 
+        length allOperatingSystems * length allLanguages 

11-algebraic-datatypes/src/vehicle.hs

@@ -0,0 +1,56 @@
+module Vehicle where
+
+    data Price = Price Integer deriving (Eq, Show)
+    data Manufacturer = Mini | Mazda | Tata deriving (Eq, Show)
+    data Airline = PapuAir | CatapultsR'Us | TakeYourChancesUnited
+        deriving (Eq, Show)
+
+    data Vehicle = Car Manufacturer Price | Plane Airline deriving (Eq, Show)
+
+    myCar :: Vehicle
+    myCar = Car Mini (Price 14000)
+    
+    urCar :: Vehicle
+    urCar = Car Mazda (Price 20000)
+
+    clownCar :: Vehicle
+    clownCar = Car Tata (Price 7000)
+
+    doge :: Vehicle
+    doge = Plane PapuAir
+
+    -- 1
+    -- myCar :: Vehicle
+
+    -- 2
+    isCar :: Vehicle -> Bool
+    isCar (Car _ _) = True
+    isCar _         = False
+
+    isPlane :: Vehicle -> Bool
+    isPlane (Plane _) = True
+    isPlane _         = False
+
+    areCars :: [Vehicle] -> [Bool]
+    areCars = map isCar
+
+    -- 3
+    getManu :: Vehicle -> Manufacturer
+    getManu (Car m _) = m
+    getManu _         = undefined
+
+    -- 4
+    -- Would generate a partial function error.
+    -- You could change it to a Maybe Manufacturer and return Nothing
+
+    -- 5
+    data Size = Size Integer deriving (Eq, Show)
+    data Vehicle' = Car' Manufacturer | Plane' Airline Size deriving (Eq, Show)
+    doge' :: Vehicle'
+    doge' = Plane' PapuAir (Size 120)
+    -- isCar stays the same
+    isPlane' :: Vehicle' -> Bool
+    isPlane' (Plane' _ _) = True
+    isPlane' _            = False
+    -- areCars stays the same
+    -- getManu stays the same

11-algebraic-datatypes/src/vigenere.hs

@@ -0,0 +1,37 @@
+module Vigenere where
+
+    import Data.Char
+
+    alphaIndex :: Char -> Int
+    alphaIndex c
+        | elem c ['a'..'z'] = ord c - ord 'a'
+        | elem c ['A'..'Z'] = ord c - ord 'A'
+        | otherwise = 0
+
+
+    shift :: Char -> Char -> Char
+    shift c k
+        | elem c ['a'..'z'] = go c k 'a'
+        | elem c ['A'..'Z'] = go c k 'A'
+        | otherwise = c
+        where go p key base = chr $ (mod rel r) + b
+                 where rel = alphaIndex p + alphaIndex key
+                       r = 26
+                       b = ord base
+
+    -- nice solution, but maps keyword to non-alpha characters
+    -- e.g. MEET_AT_DAWN 
+    --      ALLYALLYALLY
+    vigenere' :: [Char] -> [Char] -> [Char]
+    vigenere' xs ys = zipWith shift xs ((concat . repeat) ys)
+
+    -- wrote own zipWith variant which maps only when isAlpha
+    vigenere :: [Char] -> [Char] -> [Char]
+    vigenere xs [] = xs -- necessary to avoid bottom
+    vigenere xs ys = myZipWith shift xs ys
+        where myZipWith _ [] _  = []
+              myZipWith f s [] = myZipWith f s ys
+              myZipWith f (a:as) k@(b:bs) =
+                if isAlpha a
+                then f a b : myZipWith f as bs
+                else     a : myZipWith f as k