From 05428e07995bda65f6010f666472645266294634 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ga=C3=ABl=20Depreeuw?= Date: Sat, 28 Oct 2017 01:09:37 +0200 Subject: [PATCH] Complete chapter 10-11 --- 10-folding-lists/10.10-chapter-exercises.md | 6 + 10-folding-lists/10.5-understanding-folds.md | 40 +++++ 10-folding-lists/10.6-database-processing.md | 2 + 10-folding-lists/10.9-scan-exercises.md | 2 + 10-folding-lists/src/dbprocess.hs | 63 +++++++ 10-folding-lists/src/fibs.hs | 59 +++++++ 10-folding-lists/src/rewrite.hs | 63 +++++++ 10-folding-lists/src/warmup.hs | 44 +++++ 11-algebraic-datatypes/11.10-pity-the-bool.md | 10 ++ 11-algebraic-datatypes/11.12-garden.md | 2 + 11-algebraic-datatypes/11.13-programmers.md | 2 + 11-algebraic-datatypes/11.14-the-quad.md | 18 ++ .../11.18-chapter-exercises.md | 21 +++ 11-algebraic-datatypes/11.5-dog-types.md | 10 ++ 11-algebraic-datatypes/11.6-vehicles.md | 2 + 11-algebraic-datatypes/11.8-cardinality.md | 6 + 11-algebraic-datatypes/11.8-for-example.md | 4 + 11-algebraic-datatypes/11.9-logic-goats.md | 2 + 11-algebraic-datatypes/src/aspatterns.hs | 16 ++ 11-algebraic-datatypes/src/binarytree.hs | 81 +++++++++ 11-algebraic-datatypes/src/garden.hs | 18 ++ 11-algebraic-datatypes/src/huttonrazor.hs | 14 ++ 11-algebraic-datatypes/src/langexerc.hs | 18 ++ 11-algebraic-datatypes/src/logicgoats.hs | 25 +++ 11-algebraic-datatypes/src/phone.hs | 159 ++++++++++++++++++ 11-algebraic-datatypes/src/programmers.hs | 40 +++++ 11-algebraic-datatypes/src/vehicle.hs | 56 ++++++ 11-algebraic-datatypes/src/vigenere.hs | 37 ++++ 28 files changed, 820 insertions(+) create mode 100644 10-folding-lists/10.10-chapter-exercises.md create mode 100644 10-folding-lists/10.5-understanding-folds.md create mode 100644 10-folding-lists/10.6-database-processing.md create mode 100644 10-folding-lists/10.9-scan-exercises.md create mode 100644 10-folding-lists/src/dbprocess.hs create mode 100644 10-folding-lists/src/fibs.hs create mode 100644 10-folding-lists/src/rewrite.hs create mode 100644 10-folding-lists/src/warmup.hs create mode 100644 11-algebraic-datatypes/11.10-pity-the-bool.md create mode 100644 11-algebraic-datatypes/11.12-garden.md create mode 100644 11-algebraic-datatypes/11.13-programmers.md create mode 100644 11-algebraic-datatypes/11.14-the-quad.md create mode 100644 11-algebraic-datatypes/11.18-chapter-exercises.md create mode 100644 11-algebraic-datatypes/11.5-dog-types.md create mode 100644 11-algebraic-datatypes/11.6-vehicles.md create mode 100644 11-algebraic-datatypes/11.8-cardinality.md create mode 100644 11-algebraic-datatypes/11.8-for-example.md create mode 100644 11-algebraic-datatypes/11.9-logic-goats.md create mode 100644 11-algebraic-datatypes/src/aspatterns.hs create mode 100644 11-algebraic-datatypes/src/binarytree.hs create mode 100644 11-algebraic-datatypes/src/garden.hs create mode 100644 11-algebraic-datatypes/src/huttonrazor.hs create mode 100644 11-algebraic-datatypes/src/langexerc.hs create mode 100644 11-algebraic-datatypes/src/logicgoats.hs create mode 100644 11-algebraic-datatypes/src/phone.hs create mode 100644 11-algebraic-datatypes/src/programmers.hs create mode 100644 11-algebraic-datatypes/src/vehicle.hs create mode 100644 11-algebraic-datatypes/src/vigenere.hs diff --git a/10-folding-lists/10.10-chapter-exercises.md b/10-folding-lists/10.10-chapter-exercises.md new file mode 100644 index 0000000..e8b6a2c --- /dev/null +++ b/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 \ No newline at end of file diff --git a/10-folding-lists/10.5-understanding-folds.md b/10-folding-lists/10.5-understanding-folds.md new file mode 100644 index 0000000..dd261a5 --- /dev/null +++ b/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]` \ No newline at end of file diff --git a/10-folding-lists/10.6-database-processing.md b/10-folding-lists/10.6-database-processing.md new file mode 100644 index 0000000..4cd15ce --- /dev/null +++ b/10-folding-lists/10.6-database-processing.md @@ -0,0 +1,2 @@ +# Exercises: Database Processing +see src/dbprocess.hs \ No newline at end of file diff --git a/10-folding-lists/10.9-scan-exercises.md b/10-folding-lists/10.9-scan-exercises.md new file mode 100644 index 0000000..b106daa --- /dev/null +++ b/10-folding-lists/10.9-scan-exercises.md @@ -0,0 +1,2 @@ +# Scan Exercises +see src/fibs.hs \ No newline at end of file diff --git a/10-folding-lists/src/dbprocess.hs b/10-folding-lists/src/dbprocess.hs new file mode 100644 index 0000000..a15c444 --- /dev/null +++ b/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) \ No newline at end of file diff --git a/10-folding-lists/src/fibs.hs b/10-folding-lists/src/fibs.hs new file mode 100644 index 0000000..03c90b8 --- /dev/null +++ b/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 diff --git a/10-folding-lists/src/rewrite.hs b/10-folding-lists/src/rewrite.hs new file mode 100644 index 0000000..1f8816a --- /dev/null +++ b/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 \ No newline at end of file diff --git a/10-folding-lists/src/warmup.hs b/10-folding-lists/src/warmup.hs new file mode 100644 index 0000000..bb38a90 --- /dev/null +++ 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)) + + diff --git a/11-algebraic-datatypes/11.10-pity-the-bool.md b/11-algebraic-datatypes/11.10-pity-the-bool.md new file mode 100644 index 0000000..254ad0c --- /dev/null +++ b/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` diff --git a/11-algebraic-datatypes/11.12-garden.md b/11-algebraic-datatypes/11.12-garden.md new file mode 100644 index 0000000..0295973 --- /dev/null +++ b/11-algebraic-datatypes/11.12-garden.md @@ -0,0 +1,2 @@ +# Exercises: How Does Your Garden Grow? +see src/garden.hs \ No newline at end of file diff --git a/11-algebraic-datatypes/11.13-programmers.md b/11-algebraic-datatypes/11.13-programmers.md new file mode 100644 index 0000000..7fd206f --- /dev/null +++ b/11-algebraic-datatypes/11.13-programmers.md @@ -0,0 +1,2 @@ +# Exercises: Programmers +see src/programmers.hs \ No newline at end of file diff --git a/11-algebraic-datatypes/11.14-the-quad.md b/11-algebraic-datatypes/11.14-the-quad.md new file mode 100644 index 0000000..a2312f4 --- /dev/null +++ b/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. \ No newline at end of file diff --git a/11-algebraic-datatypes/11.18-chapter-exercises.md b/11-algebraic-datatypes/11.18-chapter-exercises.md new file mode 100644 index 0000000..41045d6 --- /dev/null +++ b/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 \ No newline at end of file diff --git a/11-algebraic-datatypes/11.5-dog-types.md b/11-algebraic-datatypes/11.5-dog-types.md new file mode 100644 index 0000000..47e73a0 --- /dev/null +++ b/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]` \ No newline at end of file diff --git a/11-algebraic-datatypes/11.6-vehicles.md b/11-algebraic-datatypes/11.6-vehicles.md new file mode 100644 index 0000000..40ee20e --- /dev/null +++ b/11-algebraic-datatypes/11.6-vehicles.md @@ -0,0 +1,2 @@ +# Exercise : Vehicles +see src/vehicle.hs \ No newline at end of file diff --git a/11-algebraic-datatypes/11.8-cardinality.md b/11-algebraic-datatypes/11.8-cardinality.md new file mode 100644 index 0000000..887d4a3 --- /dev/null +++ b/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) \ No newline at end of file diff --git a/11-algebraic-datatypes/11.8-for-example.md b/11-algebraic-datatypes/11.8-for-example.md new file mode 100644 index 0000000..867355e --- /dev/null +++ b/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` diff --git a/11-algebraic-datatypes/11.9-logic-goats.md b/11-algebraic-datatypes/11.9-logic-goats.md new file mode 100644 index 0000000..b85e3de --- /dev/null +++ b/11-algebraic-datatypes/11.9-logic-goats.md @@ -0,0 +1,2 @@ +# Exercises: Logic Goats +see src/logicgoats.hs \ No newline at end of file diff --git a/11-algebraic-datatypes/src/aspatterns.hs b/11-algebraic-datatypes/src/aspatterns.hs new file mode 100644 index 0000000..533f0d5 --- /dev/null +++ b/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) \ No newline at end of file diff --git a/11-algebraic-datatypes/src/binarytree.hs b/11-algebraic-datatypes/src/binarytree.hs new file mode 100644 index 0000000..c1fdf8f --- /dev/null +++ b/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) \ No newline at end of file diff --git a/11-algebraic-datatypes/src/garden.hs b/11-algebraic-datatypes/src/garden.hs new file mode 100644 index 0000000..587b328 --- /dev/null +++ b/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 diff --git a/11-algebraic-datatypes/src/huttonrazor.hs b/11-algebraic-datatypes/src/huttonrazor.hs new file mode 100644 index 0000000..4444bbb --- /dev/null +++ b/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 diff --git a/11-algebraic-datatypes/src/langexerc.hs b/11-algebraic-datatypes/src/langexerc.hs new file mode 100644 index 0000000..f4dcc61 --- /dev/null +++ b/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 diff --git a/11-algebraic-datatypes/src/logicgoats.hs b/11-algebraic-datatypes/src/logicgoats.hs new file mode 100644 index 0000000..2fd9190 --- /dev/null +++ b/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 \ No newline at end of file diff --git a/11-algebraic-datatypes/src/phone.hs b/11-algebraic-datatypes/src/phone.hs new file mode 100644 index 0000000..ae78144 --- /dev/null +++ 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) \ No newline at end of file diff --git a/11-algebraic-datatypes/src/programmers.hs b/11-algebraic-datatypes/src/programmers.hs new file mode 100644 index 0000000..f6cc963 --- /dev/null +++ b/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 \ No newline at end of file diff --git a/11-algebraic-datatypes/src/vehicle.hs b/11-algebraic-datatypes/src/vehicle.hs new file mode 100644 index 0000000..0c1c0e1 --- /dev/null +++ b/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 \ No newline at end of file diff --git a/11-algebraic-datatypes/src/vigenere.hs b/11-algebraic-datatypes/src/vigenere.hs new file mode 100644 index 0000000..098ac92 --- /dev/null +++ b/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 \ No newline at end of file