Real World Haskell Chapter 4 – Haskell

Whew! after a long hiatus I’ve managed to return to studying Real World Haskell. Straight down to it then.
Chapter 4 exercise solutions.
FirstWords program.
Transpose words program.

Exercise 1

safeHead, safeTail, safeInit, safeLast each require a simple guard pattern to return Nothing if an empty list is passed as an argument.

safeHead :: [a] -> Maybe a
safeHead [] = Nothing
safeHead xs = Just (head xs)

safeTail :: [a] -> Maybe [a]
safeTail [] = Nothing
safeTail xs = Just (tail xs)

safeLast :: [a] -> Maybe a
safeLast [] = Nothing
safeLast xs = Just (last xs)

safeInit :: [a] -> Maybe [a]
safeInit [] = Nothing
safeInit xs = Just (init xs)

Exercise 2

The definition of splitWith isn’t very well defined so I decided to take 2 approaches

• Preserve all list members and break the list at the point the predicate returns False,
• Discard all list members where the predicate is False.

I spent much too long on this because I was convinced there would be a nice elegant way of using the pattern let (pre,suf) = span p xs in introduced earlier when writing splitLines that could be used generically in both versions but I couldn’t really find it.

Preserving version:

splitWith :: (a -> Bool) -> [a] -> [[a]]
splitWith _ []     = []
splitWith p (x:xs) = (x : pre) : splitWith p suf
    where (pre,suf) = span p xs

Discarding version:

splitWith' :: (a-> Bool) -> [a] -> [[a]]
splitWith' _ [] = []
splitWith' p xs = case pre of
                    [] -> splitSuffix
                    _  -> pre : splitSuffix
    where
      (pre,suf)    = span p xs
      splitSuffix  = splitWith' p (dropWhile (not . p) suf)

Exercise 3

I won’t post the whole program because the only relevant things are firstWord and firstWords

firstWords :: String -> String
firstWords input = unlines (map firstWord (splitLines input))

firstWord :: String -> String
firstWord ws = takeWhile nonSpace $ dropWhile isSpace ws

nonSpace :: Char -> Bool
nonSpace = not . isSpace

I could have written takeWhile (not . isSpace) $ dropWhile isSpace ws but I thought that takeWhile nonSpace is clearer to read.

Exercise 4

There is already a function in the Prelude to transpose lists but it only works on lists of equal length. I could have written
transposeFile input = unlines $ transpose $ splitLines input but it’s unlikely that the number of words per line in a text file will be constant so I decided to cope with lists of different length so that:

ABC       A137
1 2       B 48
3456  =>  C259
789       6

Although this doesn’t preserve position for columns with no entries above them – so the 6 appears as the first character on the last transformed line.

transposeLines :: [String] -> [String]
transposeLines xs = if null heads
                    then []
                    else heads : transposeLines tails
                         where heads = concat $ map safeFirst xs
                               tails = map safeRest xs

safeFirst :: [a] -> [a]
safeFirst []     = []
safeFirst (x:xs) = [x]

safeRest :: [a] -> [a]
safeRest []     = []
safeRest (x:[]) = []
safeRest (_:xs) = xs

Folds – Exercise 1

The trick of coping with negative numbers is simply to write a guard that recursively calls asInt_fold – for some reason this reminded me of writing overloaded constructors in OO languages.
To find the overall value of a string of digits d1 d2 d3 d4

a) d1 = d1
b) d1 d2 = 10 d1 + d2 = 10 a + d2
c) d1 d2 d3 = 100 d1 + 10 d2 + d3 = 10 b + d3
d) d1 d2 d3 d4 = 1000 d1 + 100 d2 + 10 d3 + d4 = 10 c + d4

Applying a function to digits from left to right implies a left fold.

asInt_fold :: String -> Int
asInt_fold ('-':xs) = - asInt_fold xs
asInt_fold xs       = foldl shiftRightAndAdd 0 xs
    where
      -- shiftRightAndAdd :: Int -> Char -> Int
      shiftRightAndAdd acc x = 10 * acc + digitToInt x

I didn’t have to extend the function to add error handling as charToInt already takes care of the cases mentioned.

Exercise 2

One thing I’m enjoying about the book is the attitude of throwing in extra parts of the language or libraries and encouraging us to go off and read about it ourselves for example introducing the Either data type and related Left and Right constructors. Having said that I couldn’t find a way of using Either without writing verbose (and ugly) code as I have to de-construct and reconstruct values throughout. It also seems like it will a maintenance headache as changing something minor in its use will require a lot of careful fiddly changes to the code. I hope late I’ll find a more elegant or robust way of using it but I’m already wary.

type ErrorMessage = String

asInt_either :: String -> Either ErrorMessage Int
asInt_either ('-':[]) = Left "No digits supplied"
asInt_either ('-':xs) = case asInt_either xs of
                          Left mess -> Left mess
                          Right val -> Right (negate val)
asInt_either xs       = foldl radixAdd (Right 0) xs
    where
      -- radixAdd :: Either ErrorMessage Int -> Char -> Either ErrorMessage Int
      radixAdd acc x =
          case acc of
            Left mess -> Left mess
            Right acc -> digitToInt' x
                where -- digitToInt' :: Char -> Either ErrorMessage Int
                      digitToInt' x = if isDigit x
                                      then Right (10 * acc + digitToInt x)
                                      else Left ("non digit '" ++ x:"'")

Exercise 3

Each step of concat is a matter of appending the current item to the previous result l1 ++ (l2 ++ (l3 ++ (l4 ++ [])))

a) l4 = l4
b) l3 ++ l4 = l3 ++ a
c) l2 ++ l3 ++ l4 = l2 ++ b
c) l1 ++ l2 ++ l3 ++ l4 = l1 ++ c

Building up the value using items from right to left means a right fold as a simple one liner.

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

Exercise 4

The recursive version of takeWhile:

baTakeWhile :: (a -> Bool) -> [a] -> [a]
baTakeWhile f [] = []
baTakeWhile f (x:xs)
 | f x       = x : baTakeWhile f xs
 | otherwise = []

Converting a recursive function that exits before the list argument is exhausted seems to be a wasteful because the fold calls its function argument for every value – but its a good exercise to think more creatively about using folds at a higher level. The key insight for me was that accumulating all items to the end of the result list (in original order) until the predicate is False is identical when traversing in reverse order to starting with an empty list and appending its value to the front of the result which lends itself a right fold.

baTakeWhile' :: (a -> Bool) -> [a] -> [a]
baTakeWhile' f xs = foldr takeStep [] xs
    where takeStep x acc = if f x then x:acc else []

Exercise 5

I had to rewrite my answer for this one because my original answer compared items pairwise along the length of the list so baGroupBy f [a,b,c,d] executes f a b, f b c, f c d until the predicate returns False.
groupBy doesn’t behave like that though – it executes : f a b, f a c, f a d until the predicate returns False.

baGroupBy :: (a -> a -> Bool) -> [a] -> [[a]]
baGroupBy f xs = foldl step [] xs
    where
    step [] x  = [[x]]
    step acc x =
        if f (head lastAdded) x
        then init acc ++ [lastAdded ++ [x]]
        else acc ++ [[x]]
            where lastAdded = last acc

My original answer though needed much more creative thinking – I transformed the list into a list of tuples using zip and ignored the last item – so [a,b,c,d] -> init [(a,b),(b,c),(c,d),(d,a)].
I’ll remember this technique in future when I need to hop pairwise through list items.

Exercise 6

any p xs can be written p xn || pxn-1 || ... || p1 || False and so we have a right fold

baAny :: (a -> Bool) -> [a] -> Bool
baAny p = foldr or False
          where or x acc = p x || acc

I would write cycle as a recursive function with no exit test and let Haskell’s laziness deal with
A right fold can be applied to an infinite list and in the past I’ve seen a right fold used to generate an infinite result list e.g. of even numbers using foldr (*2) [1..] and so

baCycle :: [a] -> [a]
baCycle xs = foldr selfAppend xs [1..]
    where selfAppend x ys = xs ++ ys

Another little trick I’ve discovered is using a tuple of (state, returnValue) as the return value the function being folded.
It feels a bit dirty though, like imperative programming, but the alternative when building up a list is to continually deconstruct and reconstruct it as in the gropBy function.
The list of words can be built up by working from the end of the given string and pre-pending each word built up form non spaces at the front of the result which means I can use a right fold again.

baWords :: String -> [String]
baWords ws = if null headWord
             then tailWords
             else headWord:tailWords
    where
      (headWord, tailWords) = foldr buildWord ("",[]) ws
      buildWord c (thisWord,allWords) | isSpace c = if null thisWord
                                                    then ("", allWords)
                                                    else ("", thisWord:allWords)
                                      | otherwise = (c:thisWord, allWords)

unlines can also be written using a right fold by prepending each word plus by a newline at the front of the result.

baUnlines :: [String] -> String
baUnlines ls = foldr appendCr [] ls
    where appendCr w ws = w ++ "\n" ++ ws

Lots of new things in this chapter but I do like the way the exercises stretch the material. The thing that caused me the most trouble was working out how the left fold was written using the right fold. Haskell keeps doing this, just when I start to feel comfortable with something I see there’s much more to it than meets the eye. I’m going to grab a copy of the cited paper on folds by Paul Hutton and have a look at that. Understanding how the left fold definition using foldr is one thing, but actually using a similar technique is going to take a lot of effort.