Saturday, April 25, 2009

Solutions to Chapter 4 (p. 84)

#1.

safeHead :: [a] -> Maybe a
safeHead [] = Nothing
safeHead (x:xs) = Just x
safeTail :: [a] -> Maybe [a]
safeTail [] = Nothing
safeTail (x:xs) = Just xs
safeLast :: [a] -> Maybe a
safeLast [] = Nothing
safeLast [x] = Just x
safeLast (x:xs) = safeLast xs
safeInit :: [a] -> Maybe [a]
safeInit [] = Nothing
safeInit [x] = Just []
safeInit (x:xs) = Just (x:fromMaybe xs (safeInit xs))

You need to import Data.Maybe for the last one. It is also possible to implement safeLast using last, like this:

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

But in fact, this is true for every one of those functions: if the input is empty, return Nothing; otherwise, reutrn Just whatever-the-unsafe-variant-returns. So a quick solution to all four would be:

safeVariantOf :: ([a] -> b) -> ([a] -> Maybe b)
safeVariantOf _ [] = Nothing
safeVariantOf func xs = Just (func xs)

safeHead :: [a] -> Maybe a
safeHead = safeVariantOf head

safeTail :: [a] -> [a]
safeTail = safeVariantOf tail

safeLast :: [a] -> Maybe a
safeLast = safeVariantOf last

safeInit :: [a] -> [a]
safeInit = safeVariantOf init

Note how the type of safeVariantOf does not assume any relationship between the original function's input type ([a]) and output type (b). That's because b is sometimes [a] and sometimes just a. In fact, this block of code is one of those cases where the code looks simpler and easier to understand without the type declarations:

safeVariantOf _ [] = Nothing
safeVariantOf func xs = Just (func xs)

safeHead = safeVariantOf head
safeTail = safeVariantOf tail
safeLast = safeVariantOf last
safeInit = safeVariantOf init

Finally, while the authors suggest using Maybe, another approach on safe variants is providing a default when no data is available. This works very naturally with the list-returning functions, where the obvious default is an empty list:

tailOrEmpty :: [a] -> [a]
tailOrEmpty [] = []
tailOrEmpty (x:xs) = xs
initOrEmpty :: [a] -> [a]
initOrEmpty [] = []
initOrEmpty [x] = []
initOrEmpty (x:xs) = x:initOrEmpty xs

For head and last, the user has to provide the default as an extra argument:

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

#2. Confusingly, the function parameter should return False for characters that are not boundaries; e.g., to implement words, we'll need a predicate that returns False for whitespace (only).

splitWith :: (a -> Bool) -> [a] -> [[a]]
splitWith _ [] = []
splitWith pred (x:xs) | not (pred x) = splitWith pred xs
splitWith pred xs = (takeWhile pred xs):(splitWith pred next)
                    where rest = dropWhile pred xs
                          rev pred x = not (pred x)
                          next = dropWhile (rev pred) rest

We use takeWhile and dropWhile because a sequence of spaces shouldn't result in multiple empty words (between each pair of spaces). It is also important to correctly handle any leading or trailing spaces.

Using function composition (the dot operator) will make this simpler, since rev will not be required; but it wasn't introduced yet in the book.

#3. Set myFuction to firstWords, defined thus:

firstWords :: String -> String
firstWords input = unlines (firstWordsList (lines input))
    where firstWordsList :: [String] -> [String]
          firstWordsList [] = []
          firstWordsList (ln:lns) = headOrDefault (words ln) "" : 
                                    firstWordsList lns

Note that to extract the first word from a line, we can't simply use head (words ln), since the line could be empty. We use headOrDefault, defined in question #1 above.

(To be continued...)

#4. What a beautiful example of lacking specifications... How should the function behave if there are more than two lines (abort? ignore the extra line? transpose them all?). How should it handle cases there some lines are shorter than others? For this solution, I assume a transposition of all lines, as wide as the shortest line in the input.

We should obviously first split the input into a list of lines (strings), process this list, and then re-wrap the list of lines as one long string. So,

transpose :: String -> String
transpose [] = []
transpose inp = unlines (transposeLines (lines inp))

But how do you define transposeLines? The type is obviously a list of strings to a list of strings ([String] -> [String]). For the nth line, we have to zip each character in that line with the output of processing all the following lines (remember that the pattern format x:xs makes us handle the list from the end backwards, assuming we recurse for xs). So, zipping should be done using a function that takes one character (from the nth line) and one line (one item from the transpose result of all lines following the current one), and prepend the character to that line. So we get:

transposeLines :: [String] -> [String]
transposeLines [ln] = ??? -- not handled yet
transposeLines (ln:lns) = zipWith prepend ln (transposeLines lns)

prepend :: Char -> String -> String
prepend ch str = [ch] ++ str

For the single-line (bottom of the recursion) case, we need to take a line and give a list of lines, each containing a single character from the original line. In other words, we break up the line:

transposeLines :: [String] -> [String]
transposeLines [ln] = breakUp ln
transposeLines (ln:lns) = zipWith prepend ln (transposeLines lns)

breakUp :: String -> [String]
breakUp [] = []
breakUp (ch:chs) = [[ch]] ++ breakUp chs

In fact, using breakUp, we can simplify the handling of the nth line as well, by breaking up each line as it is processed, and zipping with standard concatanation. This implies we don't need prepend, and the final result is:

transpose :: String -> String
transpose [] = []
transpose inp = unlines (transposeLines (lines inp))
   where transposeLines :: [String] -> [String]
         transposeLines [ln] = breakUp ln
         transposeLines (ln:lns) = zipWith (++) (breakUp ln) (transposeLines lns)
         breakUp :: String -> [String]
         breakUp [] = []
         breakUp (ch:chs) = [[ch]] ++ breakUp chs

12 comments:

  1. In #2, is using span less efficient than dropWhile and takeWhile?
    for example, couldn't the last line read:

    splitWith pred xs = fst brk : splitWith pred (snd brk)
    where brk = span pred xs

    ReplyDelete
  2. Here's a solution that, instead of processing lines horizontally (one line at a time), it processes them vertically (first character of every line first, then the second, etc.). It uses tail recursion.

    transposeLines :: String -> String
    transposeLines input = unlines (transposeLines' [] (lines input))
       where transposeLines' accum [] = accum
             transposeLines' accum lines
               | any null lines = accum
               | otherwise = transposeLines' (accum ++ [zip]) rest
                 where zip = map head lines
                       rest = map tail lines

    ReplyDelete
  3. (By the way many thanks for this blog with your solutions, I find it rather useful. Particularly more useful than the overwhelming amount of comments in the book's page. Cheers!)

    ReplyDelete
  4. Regarding #4: Introduced to Data.List in the chapter just before it felt just to use a function from there so I solved it using the predefined function transpose...

    myTranspose inp = unlines $ transpose $ lines inp

    Feels a bit like cheating though in retrospect since you don't learn that much from it.

    ReplyDelete
  5. This comment has been removed by the author.

    ReplyDelete
  6. For #2 I used:
    splitWith :: (a -> Bool) -> [a] -> [[a]]
    splitWith _ [] = []
    splitWith f ls = x : splitWith f ys
    where (x,y:ys) = break f ls

    ReplyDelete
  7. For #4 I used the original transpose from prelude but modified it for what was learned up to this chapter:
    {- Prelude Def
    transpose :: [[a]] -> [[a]]
    transpose [] = []
    transpose ([] : xss) = transpose xss
    transpose ((x:xs) : xss) = (x : [h | (h:_) <- xss]) : transpose' (xs : [ t | (_:t) <- xss])
    -}

    transpose' :: [[a]] -> [[a]]
    transpose' [] = []
    transpose' ([] : xss) = transpose' xss
    transpose' ((x:xs) : xss) =
    (x : (thead xss)) : transpose' (xs : (ttail xss))
    where thead ls = concat $ map thead' ls
    where thead' (y:_) = [y]
    thead' [] = []
    ttail ls = concat $ map ttail' ls
    where ttail' (_:y) = [y]
    ttail' [] = []

    myTranspose :: [Char] -> [Char]
    myTranspose input = unlines $ transpose' $ lines input

    More on stackoverflow.com: http://stackoverflow.com/questions/7007222/haskell-list-comprehension-to-combinatory

    ReplyDelete
  8. I think your splitWith solution can be simply written as:

    splitWith :: (a -> Bool) -> [a] -> [[a]]
    splitWith _ [] = []
    splitWith pred (x:xs) | not (pred x) = splitWith pred xs
    splitWith pred xs = (takeWhile pred xs):(splitWith pred next)
    where next = dropWhile pred xs

    As the pattern "splitWith pred (x:xs) | not (pred x) = splitWith pred xs" already deals with leading / trailing cases.

    It worked at least when I tried it.

    Thanks for your solutions.

    ReplyDelete
  9. Here's yet another solution for #4. In order to keep it more readable, it's split into three smaller functions.

    transpose :: String -> String
    transpose = unlines . zipWith' . map breakUp . lines

    zipWith' :: [[String]] -> [String]
    zipWith' (a:b:[]) = zipWith (++) a b
    zipWith' (a:b:rest) = zipWith' $ (zipWith (++) a b):rest

    breakUp :: String -> [String]
    breakUp xs = zipWith (:) xs [[] | x <- [1..length xs]]

    ReplyDelete
  10. transpose :: String -> String
    transpose text = unlines $ trans' rows
        where
            rows = words text
            -- trans' :: [String] -> [String]
            trans' [] = []
            trans' (x:xs) = trans'' x (trans' xs)
            -- trans'' :: String -> [String] -> [String]
            trans'' [] [] = []
            trans'' [] (y:ys) = y : trans'' [] ys
            trans'' (x:xs) [] = [x] : trans'' xs []
            trans'' (x:xs) (y:ys) = (x:y) : (trans'' xs ys)

    ReplyDelete