Haskell Book Chapter 10 Notes and Exercises

haskellbook-chapter-10-notes.md

Notes and Exercises from Chapter 10 of Haskell Book

Undefined Spine vs Undefined Item

[1, 2, 3] ++ undefined

  :
 / \
1   :
   / \
  2   :
     / \
    3   ⏊

[1, 2, 3] ++ [undefined]

  :
 / \
1   :
   / \
  2   :
     / \
    3   :
       / \
      ⏊   []

Folds

A higher order function that accumulates results of a collection by repeatedly applying a given function with an initial value to return a single result.

The initial value is usually the identity of the function. It is sometimes called "the zero of the fold."

foldl Fold Left

foldl :: Foldable t => (b -> a -> b) -> b -> t a -> b

-- For lists
foldl :: (b -> a -> b) -> b -> [a] -> b

foldl f acc []     = acc
foldl f acc (x:xs) = foldl f (f acc x) xs

• Associates to the left
• Applies initial value in the beginning
• Function applies to "fold so far" and next value
• Tail recursive
• Traverses entire spine
• Cannot work with infinite lists
• Not very performant. Use discouraged.

foldl (+) 0 [1..3]
(((0 + 1) + 2) + 3)
6

foldl (^) 1 [2..3]
((1 ^ 2) ^ 3)
1

foldr Fold Right

foldr :: Foldable t => (a -> b -> b) -> b -> t a -> b

-- For lists
foldr :: (a -> b -> b) -> b -> [a] -> b

foldr f z []     = z
foldr f z (x:xs) = f x (foldr f z xs)

• Associates to the right
• Applies initial value to the end
• Function applies to next value and "the rest of the fold"
• Alternates between applying foldr and f
• Traverses only as far as it needs to
• Can work with infinite lists
• Laziness makes it more performant than foldl. Use encouraged.

foldr (+) 0 [1..3]
(1 + (2 + (3 + 0)))
6

foldl (^) 1 [1..3]
(2 ^ (3 ^ 1))
8

Exercise: Database Processing

module ExerciseDatabase 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))
    ]

filterDbDate :: [DatabaseItem] -> [UTCTime]
filterDbDate db = foldr go [] db
    where go (DbDate x) y = x : y
          go _ y = y

filterDbNumber :: [DatabaseItem] -> [Integer]
filterDbNumber db = foldr go [] db
    where go (DbNumber x) y = x : y
          go _ y = y

mostRecent :: [DatabaseItem] -> UTCTime
mostRecent db = foldr go minDate db
    where minDate = UTCTime (fromGregorian 1900 1 1) (secondsToDiffTime 0)
          go (DbDate x) y = max x y
          go _ y = y

sumDb :: [DatabaseItem] -> Integer
sumDb db = foldr go 0 db
    where go (DbNumber x) y = x + y
          go _ y = y

sumDb' :: [DatabaseItem] -> Integer
sumDb' db = sum $ filterDbNumber db

avgDb :: [DatabaseItem] -> Double
avgDb db = foldr go 0 db
    where go (DbNumber x) 0 = fromIntegral x
          go (DbNumber x) y = ((fromIntegral x) + y ) / 2
          go _ y = y

avgDb' :: [DatabaseItem] -> Double
avgDb' db = fromIntegral sum / fromIntegral count
    where sum = sumDb db
          count = length $ filterDbNumber db

Scans

Similar to folds, return list where each item is a step in the fold evaluation. They return lists instead of single values:

foldr :: (a -> b -> b) -> b -> [a] -> b
scanr :: (a -> b -> b) -> b -> [a] -> [b]

foldl :: (b -> a -> b) -> b -> [a] -> b
scanl :: (b -> a -> b) -> b -> [a] -> [b]

scanr (+) 1 [2..3]
[(2 + (3 + 1)), (3 + 1), 1]
[6, 4, 1]

Exercise: Scans

module ExerciseScans where

fibs :: [Integer]
fibs = 1 : scanl (+) 1 fibs

fibsN :: Int -> Integer
fibsN x = fibs !! x

fibsOnlyTwenty' :: [Integer]
fibsOnlyTwenty' = take 20 fibs

fibsLessThanHundred' :: [Integer]
fibsLessThanHundred' = takeWhile (< 100) fibs

fact :: Int -> [Int]
fact n = scanl (*) 1 (enumFromTo 2 n)

Exercise: Chapter 10

module ExerciseChapter10 where

stops = "pbtdkg"
vowels = "aeiou"

-- Stop-Vowel-Stop combinations
pogs :: [String]
pogs = [s1 : v : s2 : "" | s1 <- stops, v <- vowels, s2 <- stops]

pogsFromP :: [String]
pogsFromP = ['p' : v : s : "" | v <- vowels, s <- stops]

pogsFromP' :: [String]
pogsFromP' = filter (\x -> head x == 'p') pogs

pogsFromP'' :: [String]
pogsFromP'' = filter ((== 'p') . head) pogs

nouns = ["cat", "dog", "rainbow", "lake", "fish"]
verbs = ["eats", "chases", "follows", "serves", "loves"]

-- Noun-Verb-Noun combinations
gups :: [String]
gups = [n1 ++ " " ++ v ++ " " ++ n2 | n1 <- nouns, v <- verbs, n2 <- nouns]

-- Average length of word in the string
seekritFunc :: String -> Int
seekritFunc x = div (sum (map length (words x))) (length (words x))

-- More precise version
preciseSeekritFunc :: String -> Double
preciseSeekritFunc x = totalWordLength / totalWordCount
    where totalWordLength = fromIntegral (sum (map length (words x)))
          totalWordCount  = fromIntegral (length (words x))

-- Rewrite using folds
myAnd :: [Bool] -> Bool
myAnd = foldr (&&) True

myOr :: [Bool] -> Bool
myOr = foldr (||) False

myAny :: (a -> Bool) -> [a] -> Bool
myAny f = foldr go False
    where go x y = f x || y

myElem :: Eq a => a -> [a] -> Bool
myElem k = foldr go False
    where go x y = x == k || y

myElem' :: Eq a => a -> [a] -> Bool
myElem' k = any (== k)

myReverse :: [a] -> [a]
myReverse = foldl (flip (:)) []

myMap :: (a -> b) -> [a] -> [b]
myMap f = foldr go []
    where go x y = f x : y

myFilter :: (a -> Bool) -> [a] -> [a]
myFilter f = foldr go []
    where go x y = if f x then x : y else y

squish :: [[a]] -> [a]
squish = foldr (++) []

squishMap :: (a -> [b]) -> [a] -> [b]
squishMap f = foldr go []
    where go x y = f x ++ y

squishAgain :: [[a]] -> [a]
squishAgain = squishMap id

myMaximumBy :: (a -> a -> Ordering) -> [a] -> a
myMaximumBy f (k:ks) = foldl go k (k:ks)
    where go x y = case f x y of GT -> x
                                 EQ -> x
                                 LT -> y

myMinimumBy :: (a -> a -> Ordering) -> [a] -> a
myMinimumBy f (k:ks) = foldl go k (k:ks)
    where go x y = case f x y of GT -> y
                                 EQ -> x
                                 LT -> x