Appendix. Answers to end-of-lesson exercises
The beautiful thing about code is that there are no wrong answers as long as you get the right results. The answers to the exercises shown here should be viewed as simply one possible solution to the problem. Especially in Haskell, there are many paths to the correct solution; if you have an alternative answer that gives the correct results, that’s the correct solution.
Unit 1
Lesson 2
inc x = x + 1 double x = x*2 square x = x^2
ex3 n = if n 'mod' 2 == 0
then n - 2
else 3*n+1
ifEven n = if even n
then n - 2
else 3 * n + 1
Lesson 3
simple = (\x -> x)
makeChange = (\owed given ->
if given - owed > 0
then given - owed
else 0)
inc = (\x -> x+1)
double = (\x -> x*2)
square = (\x -> x^2)
counter x = (\x -> x + 1)
((\x -> x + 1)
((\x -> x) x))
Lesson 4
Note—if the results are equal, you need to compare first names:
compareLastNames name1 name2 = if result == EQ then compare (fst name1) (fst name2) else result where result = compare (snd name1) (snd name2)
And the new DC office:
dcOffice name = nameText ++ " PO Box 1337 - Washington DC, 20001" where nameText = (fst name) ++ " " ++ (snd name) ++ ", Esq." getLocationFunction location = case location of "ny" -> nyOffice "sf" -> sfOffice "reno" -> renoOffice "dc" -> dcOffice _ -> (\name -> (fst name) ++ " " ++ (snd name))
Lesson 5
ifEven myFunction x = if even x
then myFunction x
else x
inc n = n + 1
double n = n*2
square n = n^2
ifEvenInc = ifEven inc
ifEvenDouble = ifEven double
ifEvenSquare = ifEven square
binaryPartialApplication binaryFunc arg = (\x -> binaryFunc arg x)Here’s an example:
takeFromFour = binaryPartialApplication (-) 4
Lesson 6
repeat n = cycle [n]
subseq start end myList = take difference (drop start myList) where difference = end - start
inFirstHalf val myList = val 'elem' firstHalf
where midpoint = (length myList) 'div' 2
firstHalf = take midpoint myList
Lesson 7
myTail [] = [] myTail (_:xs) = xs
myGCD a 0 = a myGCD a b = myGCD b (a 'mod' b)
Lesson 8
myReverse [] = [] myReverse (x:[]) = [x] myReverse (x:xs) = (myReverse xs) ++ [x]
fastFib _ _ 0 = 0 fastFib _ _ 1 = 1 fastFib _ _ 2 = 1 fastFib x y 3 = x + y fastFib x y c = fastFib (x + y) x (c - 1)Note that you can use a function to hide the fact that you always start with 1 1:
fib n = fastFib 1 1 n
Lesson 9
myElem val myList = (length filteredList) /= 0 where filteredList = filter (== val) myList
isPalindrome text = processedText == reverse processedText
where noSpaces = filter (/= ' ') text
processedText = map toLower noSpaces
harmonic n = sum (take n seriesValues)
where seriesPairs = zip (cycle [1.0]) [1.0,2.0 .. ]
seriesValues = map
(\pair -> (fst pair)/(snd pair))
seriesPairs
Unit 2
Lesson 11
filter :: (a -> Bool) -> [a] -> [a]If you look at map, you can see there are two differences:
map :: (a -> b) -> [a] -> [b]First is that the function passed into filter must return a Bool.
Second is that map can transform the type of the list, whereas filter can’t.
For tail, you can return the empty list if the list is empty:
safeTail :: [a] -> [a] safeTail [] = [] safeTail (x:xs) = xsYou can’t do the same for head, because there’s no sane default value for an element. You can’t return an empty list, because an empty list is the same type as the elements of the list. See lesson 37 for a more detailed discussion of this topic.
myFoldl :: (a -> b -> a) -> a -> [b] -> a myFoldl f init [] = init myFoldl f init (x:xs) = myFoldl f newInit xs where newInit = f init x
Lesson 12
You can make this much easier by reusing canDonateTo:
donorFor :: Patient -> Patient -> Bool donorFor p1 p2 = canDonateTo (bloodType p1) (bloodType p2)
You add this helper function to display sex:
showSex Male = "Male" showSex Female = "Female" patientSummary :: Patient -> String patientSummary patient = "**************\n" ++ "Sex: " ++ showSex (sex patient) ++ "\n" ++ "Age: " ++ show (age patient) ++ "\n" ++ "Height: " ++ show (height patient) ++ " in.\n" ++ "Weight: " ++ show (weight patient) ++ " lbs.\n" ++ "Blood Type: " ++ showBloodType (bloodType patient) ++ "\n**************\n"
Lesson 13
If you look at the type classes that each belongs to, you get a good sense of your answer.
For Word:
instance Bounded Word instance Enum Word instance Eq Word instance Integral Word instance Num Word instance Ord Word instance Read Word instance Real Word instance Show WordFor Int:
instance Bounded Int instance Enum Int instance Eq Int instance Integral Int instance Num Int instance Ord Int instance Read Int instance Real Int instance Show IntYou can see that they share identical type classes. The best guess would be that Word has different bounds than Int. If you look at maxBound, you can see that Word is larger than Int:
GHCi> maxBound :: Word 18446744073709551615 GHCi> maxBound :: Int 9223372036854775807But Word also has minBound of 0, whereas Int is much lower:
GHCi> minBound :: Word 0 GHCi> minBound :: Int -9223372036854775808So as you might have guessed, Word is an Int that takes on only positive values—essentially an unsigned Int.
You can see the difference if you try inc and succ on the maxBound of Int:
GHCi> inc maxBound :: Int -9223372036854775808 GHCi> succ maxBound :: Int *** Exception: Prelude.Enum.succ{Int}: tried to take 'succ' of maxBoundBecause there’s no true successor to a Bounded type, succ throws an error. The inc function just rotates you back to the beginning.
cycleSucc :: (Bounded a, Enum a, Eq a) => a -> a
cycleSucc n = if n == maxBound
then minBound
else succ n
Lesson 14
Suppose you have a type like this:
data Number = One | Two | Three deriving EnumNow you can use fromEnum to convert this into an Int.
This makes implementing Eq easy as well as Ord:
instance Eq Number where (==) num1 num2 = (fromEnum num1) == (fromEnum num2) instance Ord Number where compare num1 num2 = compare (fromEnum num1) (fromEnum num2)
data FiveSidedDie = Side1 | Side2 | Side3 | Side4 |Side5 deriving (Enum, Eq, Show) class (Eq a, Enum a) => Die a where roll :: Int -> a instance Die FiveSidedDie where roll n = toEnum (n 'mod' 5)
Unit 3
Lesson 16
data Pamphlet = Pamphlet { pamphletTitle :: String, description :: String, contact :: String } data StoreItem = BookItem Book | RecordItem VinylRecord | ToyItem CollectibleToy | PamphletItem PamphletNow you need to add another pattern for price:
price :: StoreItem -> Double price (BookItem book) = bookPrice book price (RecordItem record) = recordPrice record price (ToyItem toy) = toyPrice toy price (PamphletItem _) = 0.0
type Radius = Double
type Height = Double
type Width = Double
data Shape = Circle Radius
| Square Height
| Rectangle Height Width deriving Show
perimeter :: Shape -> Double
perimeter (Circle r) = 2*pi*r
perimeter (Square h) = 4*h
perimeter (Rectangle h w) = 2*h + 2*w
area :: Shape -> Double
area (Circle r) = pi*r^2
area (Square h) = h^2
area (Rectangle h w) = h*w
Lesson 17
data Color = Red |
Yellow |
Blue |
Green |
Purple |
Orange |
Brown |
Clear deriving (Show,Eq)
instance Semigroup Color where
(<>) Clear any = any
(<>) any Clear = any
(<>) Red Blue = Purple
(<>) Blue Red = Purple
(<>) Yellow Blue = Green
(<>) Blue Yellow = Green
(<>) Yellow Red = Orange
(<>) Red Yellow = Orange
(<>) a b | a == b = a
| all ('elem' [Red,Blue,Purple]) [a,b] = Purple
| all ('elem' [Blue,Yellow,Green]) [a,b] = Green
| all ('elem' [Red,Yellow,Orange]) [a,b] = Orange
| otherwise = Brown
instance Monoid Color where
mempty = Clear
mappend col1 col2 = col1 <> col2
data Events = Events [String] data Probs = Probs [Double] combineEvents :: Events -> Events -> Events combineEvents (Events e1) (Events e2) = Events (cartCombine combiner e1 e2) where combiner = (\x y -> mconcat [x,"-",y]) instance Semigroup Events where (<>) = combineEvents instance Monoid Events where mappend = (<>) mempty = Events [] combineProbs :: Probs -> Probs -> Probs combineProbs (Probs p1) (Probs p2) = Probs (cartCombine (*) p1 p2) instance Semigroup Probs where (<>) = combineProbs instance Monoid Probs where mappend = (<>) mempty = Probs []
Lesson 18
boxMap :: (a -> b) -> Box a -> Box b boxMap func (Box val) = Box (func val) tripleMap :: (a -> b) -> Triple a -> Triple b tripleMap func (Triple v1 v2 v3) = Triple (func v1) (func v2) (func v3)
The trick is that Organ needs to be of type Ord to be a key for a Map.
You add enum to easily build a list of all organs:
data Organ = Heart | Brain | Kidney | Spleen deriving (Show, Eq, Ord, Enum) values :: [Organ] values = map snd (Map.toList organCatalog)Now you have a list of all organs:
allOrgans :: [Organ] allOrgans = [Heart .. Spleen]Then count those organs:
organCounts :: [Int] organCounts = map countOrgan allOrgans where countOrgan = (\organ -> (length . filter (== organ)) values)Now build your organ inventory:
organInventory :: Map.Map Organ Int organInventory = Map.fromList (zip allOrgans organCounts)
Lesson 19
data Organ = Heart | Brain | Kidney | Spleen deriving (Show, Eq) sampleResults :: [Maybe Organ] sampleResults = [(Just Brain),Nothing,Nothing,(Just Spleen)] emptyDrawers :: [Maybe Organ] -> Int emptyDrawers contents = (length . filter isNothing) contents
maybeMap :: (a -> b) -> Maybe a -> Maybe b maybeMap func Nothing = Nothing maybeMap func (Just val) = Just (func val)
Unit 4
Lesson 21
helloPerson :: String -> String helloPerson name = "Hello" ++ " " ++ name ++ "!" sampleMap :: Map.Map Int String sampleMap = Map.fromList [(1,"Will")] mainMaybe :: Maybe String mainMaybe = do name <- Map.lookup 1 sampleMap let statement = helloPerson name return statement
fib 0 = 0 fib 1 = 1 fib 2 = 1 fib n = fib (n-1) + fib (n - 2) main :: IO () main = do putStrLn "enter a number" number <- getLine let value = fib (read number) putStrLn (show value)
Lesson 22
Remember that lazy I/O lets you treat your input like a list:
sampleInput :: [String] sampleInput = ["21","+","123"]This function isn’t perfect, but the aim is just to get familiar with lazy I/O:
calc :: [String] -> Int calc (val1:"+":val2:rest) = read val1 + read val2 calc (val1:"*":val2:rest) = read val1 * read val2 main :: IO () main = do userInput <- getContents let values = lines userInput print (calc values)
quotes :: [String]
quotes = ["quote 1"
,"quote 2"
,"quote 3"
,"quote 4"
,"quote 5"]
lookupQuote :: [String] -> [String]
lookupQuote [] = []
lookupQuote ("n":xs) = []
lookupQuote (x:xs) = quote : (lookupQuote xs)
where quote = quotes !! (read x - 1)
main :: IO ()
main = do
userInput <- getContents
mapM_ putStrLn (lookupQuote (lines userInput))
Lesson 23
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
helloPerson :: T.Text -> T.Text
helloPerson name = mconcat [ "Hello "
, name
, "!"]
main :: IO ()
main = do
TIO.putStrLn "Hello! What's your name?"
name <- TIO.getLine
let statement = helloPerson name
TIO.putStrLn statement
import qualified Data.Text.Lazy as T import qualified Data.Text.Lazy.IO as TIO toInts :: T.Text -> [Int] toInts = map (read . T.unpack) . T.lines main :: IO () main = do userInput <- TIO.getContents let numbers = toInts userInput TIO.putStrLn ((T.pack . show . sum) numbers)
Lesson 24
import System.IO import System.Environment import qualified Data.Text as T import qualified Data.Text.IO as TI main :: IO () main = do args <- getArgs let source = args !! 0 let dest = args !! 1 input <- TI.readFile source TI.writeFile dest input
import System.IO import System.Environment import qualified Data.Text as T import qualified Data.Text.IO as TI main :: IO () main = do args <- getArgs let fileName = head args input <- TI.readFile fileName TI.writeFile fileName (T.toUpper input)
Lesson 25
import System.IO import System.Environment import qualified Data.Text as T import qualified Data.ByteString as B import qualified Data.Text.Encoding as E main :: IO () main = do args <- getArgs let source = args !! 0 input <- B.readFile source putStrLn "Bytes:" print (B.length input) putStrLn "Characters:" print ((T.length . E.decodeUtf8) input)
reverseSection :: Int -> Int -> BC.ByteString -> BC.ByteString
reverseSection start size bytes = mconcat [before,changed,after]
where (before,rest) = BC.splitAt start bytes
(target,after) = BC.splitAt size rest
changed = BC.reverse target
randomReverseBytes :: BC.ByteString -> IO BC.ByteString
randomReverseBytes bytes = do
let sectionSize = 25
let bytesLength = BC.length bytes
start <- randomRIO (0,(bytesLength - sectionSize))
return (reverseSection start sectionSize bytes)
Unit 5
Lesson 27
data Box a = Box a deriving Show instance Functor Box where fmap func (Box val) = Box (func val)
myBox :: Box Int myBox = Box 1 unwrap :: Box a -> a unwrap (Box val) = val
printCost :: Maybe Double -> IO() printCost Nothing = putStrLn "item not found" printCost (Just cost)= print cost main :: IO () main = do putStrLn "enter a part number" partNo <- getLine let part = Map.lookup (read partNo) partsDB printCost (cost <$> part)
Lesson 28
Unlike haversineMaybe, you can’t use pattern matching to get your values, so you have to use familiar do-notation if you don’t use <*>:
haversineIO :: IO LatLong -> IO LatLong -> IO Double haversineIO ioVal1 ioVal2 = do val1 <- ioVal1 val2 <- ioVal2 let dist = haversine val1 val2 return dist
haversineIO :: IO LatLong -> IO LatLong -> IO Double haversineIO ioVal1 ioVal2 = haversine <$> ioVal1 <*> ioVal2
printCost :: Maybe Double -> IO() printCost Nothing = putStrLn "missing item" printCost (Just cost)= print cost main :: IO () main = do putStrLn "enter a part number 1" partNo1 <- getLine putStrLn "enter a part number 2" partNo2 <- getLine let part1 = Map.lookup (read partNo1) partsDB let part2 = Map.lookup (read partNo2) partsDB let cheapest = min <$> (cost <$> part1) <*> (cost <$> part2) printCost cheapest
Lesson 29
allFmap :: Applicative f => (a -> b) -> f a -> f b allFmap func app = (pure func) <*> app
example :: Int example = (*) ((+) 2 4) 6 exampleMaybe :: Maybe Int exampleMaybe = pure (*) <*> (pure (+) <*> pure 2 <*> pure 4) <*> pure 6
startingBeer :: [Int] startingBeer = [6,12] remainingBeer :: [Int] remainingBeer = (\count -> count - 4) <$> startingBeer guests :: [Int] guests = [2,3] totalPeople :: [Int] totalPeople = (+ 2) <$> guests beersPerGuest :: [Int] beersPerGuest = [3,4] totalBeersNeeded :: [Int] totalBeersNeeded = (pure (*)) <*> beersPerGuest <*> totalPeople beersToPurchase :: [Int] beersToPurchase = (pure (-)) <*> totalBeersNeeded <*> remainingBeer
Lesson30
allFmapM :: Monad m => (a -> b) -> m a -> m b allFmapM func val = val >>= (\x -> return (func x))
allApp :: Monad m => m (a -> b) -> m a -> m b allApp func val = func >>= (\f -> val >>= (\x -> return (f x)) )
bind :: Maybe a -> (a -> Maybe b) -> Maybe b bind Nothing _ = Nothing bind (Just val) func = func val
Lesson 31
Now that you’ve done this once, you’ll never again forget how useful do-notation is!
main :: IO () main = putStrLn "What is the size of pizza 1" >> getLine >>= (\size1 -> putStrLn "What is the cost of pizza 1" >> getLine >>= (\cost1 -> putStrLn "What is the size of pizza 2" >> getLine >>= (\size2 -> putStrLn "What is the cost of pizza 2" >> getLine >>= (\cost2 -> (\pizza1 -> (\pizza2 -> (\betterPizza -> putStrLn (describePizza betterPizza): ) (comparePizzas pizza1 pizza2) )(read size2,read cost2) )(read size1, read cost1) ))))
listMain :: [String] listMain = do size1 <- [10,12,17] cost1 <- [12.0,15.0,20.0] size2 <- [10,11,18] cost2 <- [13.0,14.0,21.0] let pizza1 = (size1,cost1) let pizza2 = (size2,cost2) let betterPizza = comparePizzas pizza1 pizza2 return (describePizza betterPizza)
monadMain :: Monad m => m Double -> m Double
-> m Double -> m Double -> m String
monadMain s1 c1 s2 c2 = do
size1 <- s1
cost1 <- c1
size2 <- s2
cost2 <- c2
let pizza1 = (size1,cost1)
let pizza2 = (size2,cost2)
let betterPizza = comparePizzas pizza1 pizza2
return (describePizza betterPizza)
Lesson 32
monthEnds :: [Int] monthEnds = [31,28,31,30,31,30,31,31,30,31,30,31] dates :: [Int] -> [Int] dates ends = [date| end <- ends, date <- [1 ..end ] ]
datesDo :: [Int] -> [Int]
datesDo ends = do
end <- ends
date <- [1 .. end]
return date
datesMonad :: [Int] -> [Int]
datesMonad ends = ends >>=
(\end ->
[1 .. end] >>=
(\date -> return date))
Unit 6
The exercises in unit 6 consist of refactoring code into multiple files. This takes up too much space for an appendix, and the exercises aren’t so much about being correct as about manually walking through the steps covered in each lesson.
Unit 7
Lesson 38
Make a helper function here:
allDigits :: String -> Bool allDigits val = all (== True) (map isDigit val) addStrInts :: String -> String -> Either Int String addStrInts val1 val2 | allDigits val1 && allDigits val2 = Left (read val1 + read val2) | not (allDigits val1 || allDigits val2) = Right "both args invalid" | not (allDigits val1) = Right "first arg invalid" | otherwise = Right "second arg invalid"
safeSucc :: (Enum a, Bounded a, Eq a) => a -> Maybe a safeSucc n = if n == maxBound then Nothing else Just (succ n) safeTail :: [a] -> [a] safeTail [] = [] safeTail (x:xs) = xs safeLast :: [a] -> Either a String safeLast [] = Right "empty list" safeLast xs = safeLast' 10000 xsYou know that the empty list isn’t possible, because only safeLast will call this function, and it already checks for the empty list:
safeLast' :: Int -> [a] -> Either a String safeLast' 0 _ = Right "List exceeds safe bound" safeLast' _ (x:[]) = Left x safeLast' n (x:xs) = safeLast' (n - 1) xs
Lesson 39
buildRequestNOSSL :: BC.ByteString -> BC.ByteString
-> BC.ByteString -> BC.ByteString -> Request
buildRequestNOSSL token host method path = setRequestMethod method
$ setRequestHost host
$ setRequestHeader "token" [token]
$ setRequestSecure False
$ setRequestPort 80
$ setRequestPath path
$ defaultRequest
Note that you also need to add http-types to your project and import Network.HTTP .Types.Status:
main :: IO () main = do response <- httpLBS request let status = getResponseStatusCode response if status == 200 then do print "saving request to file" let jsonBody = getResponseBody response L.writeFile "data.json" jsonBody else print $ statusMessage $ getResponseStatus response
Lesson 40
instance ToJSON NOAAResult where
toJSON (NOAAResult uid mindate maxdate name datacoverage resultId) =
object ["uid" .= uid
,"mindate" .= mindate
,"maxdate" .= maxdate
,"name" .= name
,"datacoverage" .= datacoverage
,"id" .= resultId]
instance ToJSON Resultset
instance ToJSON Metadata
instance ToJSON NOAAResponse
data IntList = EmptyList | Cons Int IntList deriving (Show,Generic) instance ToJSON IntList instance FromJSON IntList
Lesson 41
addTool :: String -> String -> IO ()
addTool toolName toolDesc = withConn "tools.db" $
\conn -> do
execute conn (mconcat ["INSERT INTO tools
,"(name,description "
,",timesBorrowed)"
,"VALUES (?,?,?)"])
(toolName,toolDesc,(0 :: Int))
print "tool added"
promptAndAddTool :: IO () promptAndAddTool = do print "Enter tool name" toolName <- getLine print "Enter tool description" toolDesc <- getLine addTool toolName toolDesc performCommand :: String -> IO () performCommand command | command == "users" = printUsers >> main | command == "tools" = printTools >> main | command == "adduser" = promptAndAddUser >> main | command == "checkout" = promptAndCheckout >> main | command == "checkin" = promptAndCheckin >> main | command == "in" = printAvailable >> main | command == "out" = printCheckedout >> main | command == "quit" = print "bye!" | command == "addtool" = promptAndAddTool >> main | otherwise = print "Sorry command not found" >> main
Lesson 42
crossOver :: (UArray Int Int ,UArray Int Int) -> Int -> UArray Int Int
crossOver (a1,a2) crossOverPt = runSTUArray $ do
st1 <- thaw a1
let end = (snd . bounds) a1
forM_ [crossOverPt .. end] $ \i -> do
writeArray st1 i $ a2 ! i
return st1
replaceZeros :: UArray Int Int -> UArray Int Int
replaceZeros array = runSTUArray $ do
starray <- thaw array
let end = (snd . bounds) array
let count = 0
forM_ [0 .. end] $ \i -> do
val <- readArray starray i
when (val == 0) $ do
writeArray starray i (-1)
return starray