[More about folds. Bryan O'Sullivan **20070806055910] { hunk ./en/00book.xml 23 + hunk ./en/00book.xml 103 + &bib; + hunk ./en/Makefile 8 + bibliography.xml \ addfile ./en/bibliography.xml hunk ./en/bibliography.xml 1 + + Bibliography + + + Hutton99 + + GrahamHutton + <ulink url="http://www.cs.nott.ac.uk/~gmh/fold.pdf">A + tutorial on the universality and expressiveness of + fold</ulink> + + + <ulink + url="http://journals.cambridge.org/jid_JFP">Journal of + Functional Programming</ulink> + 9 + 4 + July 1999 + 355-372 + + Cambridge University + Press + + 0956-7968 + + + + hunk ./en/ch04-fp.xml 136 - Selecting pieces of input + Selecting pieces of input hunk ./en/ch04-fp.xml 167 + + We'll be discussing filter again + soon, in . hunk ./en/ch04-fp.xml 305 - Folding from the right + Avoiding multiple traversals of a list hunk ./en/ch04-fp.xml 307 - &Fold.hs:foldr; + From looking at adler32_foldl, we + know that we can accumulate more than one value at a time when + we fold over a list. Here's another use for a fold: + optimising code by avoiding multiple traversals of a + list. + + Let's consider the problem of finding the root mean square + of a list of numbers: compute the sum of the squares of every + element in the list, divide by its length, then coompute the + square root of that number. In an imperative language like C, + we wouldn't even think twice about writing code like + this. + + &rms.c:rootMeanSquare; + + Clearly, we're looping over the list just once, updating + the accumulator values mean_square and + length as we go. + + Meanwhile, over in functional programming land, the + temptation is strong to turn our verbal description of the + root mean square into code. + + &rms.hs:rootMeanSquare; + + This is a lovely, compact translation of the verbal + description. It even uses our new friend, the + map function, to make the code clearer by + avoiding explicit recursion, but it's not necessarily good + code. The calls to map and + length are each going to traverse the + input list once. + + On a small list, the cost of traversing it twice obviously + won't matter, but on a big list, we're likely to notice. We + can use a fold to avoid this need to traverse the list + twice. + + &rms.hs:rootMeanSquare_foldl; + + Clearly, this code isn't as readable as the earlier + version that used map and + length. Which version should we prefer? + It's often best to start out by writing the most readable + code, since we can make that correct most quickly, and put off + worrying about transforming it into something faster until + much later, when we have profiling data for our program. Only + if those numbers indicate a performance problem should we + worry about stepping back in and transforming our code. We'll + have much more to say about profiling, performance, and + optimisation later, in chapter XXX. + + + + Folding from the right and primitive recursion hunk ./en/ch04-fp.xml 366 + + &Fold.hs:foldr; + + At first glance, foldr might seem + less useful than foldl: what use is a + function that folds from the right? But consider the + Prelude's filter function, which we last + encountered in . If we write + filter using explicit recursion, it will + look something like this. + + &Fold.hs:filter; + + Perhaps surpsisingly, though, we can write + filter as a fold, using + foldr. + + &Fold.hs:myFilter; + + This is the sort of definition that could cause us a + headache, so let's examine it a little depth. Like + foldl, foldr takes a + function and a base case (what to do when the input list is + empty) as arguments. From reading the type of + filter, we know that our + myFilter function must return a list of + the same type as it consumes, so the base case should be a + list of this type, and the step helper + function must return a list. + + Since we know that foldr calls + step on one element of the input list at + a time, with the accumulator as its second argument, what + step does must be quite simple. If the + predicate returns True, it pushes that + element onto the accumulated list; otherwise, it leaves the + list untouched. + + The class of functions that we can express using + foldr is called primitive + recursive. A surprisingly large number of list + manipulation functions are primitive recursive. For example, + here's map written in terms of + foldr. + + &Fold.hs:myMap; + + In fact, we can even write foldl + using foldr! + + &Fold.hs:myFoldl; + + + If you want to understand the definition of + foldl using foldr, + it's best to have the following tools at hand: some headache + pills, a glass of water, &ghci; (so you can find out what + the id function does), and a pencil and + paper. + + + While we can write foldl in terms of + foldr, we can't do the converse: + foldr is more basic than + foldl. This should make it clearer why + we call functions written with foldr + primitive recursive. + + (By the way, don't feel like you have to go to special + lengths to remember the term primitive + recursive. It's just useful to remember that you + read about it somewhere, and that it has something to do with + foldr.) + + + + A final note about foldl + + To keep our initial discussion simple, we've used + foldl throughout this section. However, + any time you want to fold from the left in practice, use + foldl' from the Data.List + module instead, because it's more efficient. You should take + this on faith for now; we'll explain why you should avoid + plain foldl in normal use in section + XXX. + + + + Exercises + + + + + The Prelude function concat + concatenates a list of lists into a single list, and has + the following type. + + &ch04.exercises.hs:concat; + + Write your own definition of + concat using + foldr. + + + + + + + The Prelude function takeWhile + has the following type. + + &ch04.exercises.hs:takeWhile; + + Use &ghci; to figure out what + takeWhile does. Write your own + definitions, first using explicit recursion, then + foldr. + + + + + + The Data.List module defines a function, + groupBy, which has the following + type. + + &ch04.exercises.hs:groupBy; + + Use &ghci; to load the Data.List module + and figure out what groupBy does, + then write your own implementation using a fold. + + + + + + + Further reading + + The article is an excellent and + deep tutorial covering folds. It includes many examples of how + to use simple, systematic calculation techniques to turn + functions that use explicit recursion into folds. hunk ./examples/ch04/Fold.hs 1 -import Prelude hiding (foldl, foldr) +import Prelude hiding (filter, foldl, foldr) hunk ./examples/ch04/Fold.hs 19 +{-- snippet myMap --} +myMap :: (a -> b) -> [a] -> [b] + +myMap f xs = foldr step [] xs + where step x [] = [f x] + step x ys = f x : ys +{-- /snippet myMap --} + +{-- snippet myFoldl --} +myFoldl :: (a -> b -> a) -> a -> [b] -> a + +myFoldl f z xs = foldr step id xs z + where step x g a = g (f a x) +{-- /snippet myFoldl --} + +{-- snippet filter --} +filter :: (a -> Bool) -> [a] -> [a] +filter p [] = [] +filter p (x:xs) + | p x = x : filter p xs + | otherwise = filter p xs +{-- /snippet filter --} + +{-- snippet myFilter --} +myFilter p xs = foldr step [] xs + where step x ys | p x = x : ys + | otherwise = ys +{-- /snippet myFilter --} + addfile ./examples/ch04/ch04.exercises.hs hunk ./examples/ch04/ch04.exercises.hs 1 +import Prelude hiding (concat, takeWhile) + +{-- snippet concat --} +concat :: [[a]] -> [a] +{-- /snippet concat --} +concat = foldr (++) [] + +{-- snippet takeWhile --} +takeWhile :: (a -> Bool) -> [a] -> [a] +{-- /snippet takeWhile --} +takeWhile p = foldr step [] + where step x xs | p x = x:xs + | otherwise = [] + +{-- snippet groupBy --} +groupBy :: (a -> a -> Bool) -> [a] -> [[a]] +{-- /snippet groupBy --} +groupBy f = foldr step [] + where step x [] = [[x]] + step x ((y:ys):zs) | f x y = (x:y:ys):zs + | otherwise = [x]:(y:ys):zs addfile ./examples/ch04/rle.hs hunk ./examples/ch04/rle.hs 1 +runLength [] = [] +runLength (x:xs) = helper (x,1) xs + where helper (prev, count) [] = [(prev, count)] + helper (prev, count) (x:xs) + | x == prev = helper (prev, count + 1) xs + | otherwise = (prev, count) : helper (x, 1) xs + +runLength_foldr :: (Eq a, Integral b) => [a] -> [(a, b)] +runLength_foldr = foldr step [] + where step x [] = [(x,1)] + step x ((y,n):ys) | x == y = (y,n+1):ys + | otherwise = (x,1):(y,n):ys addfile ./examples/ch04/rms.hs hunk ./examples/ch04/rms.hs 1 +{-- snippet rootMeanSquare --} +rootMeanSquare :: [Double] -> Double + +rootMeanSquare xs = sqrt (sum (map square xs) / fromIntegral (length xs)) + where square x = x ** 2 +{-- /snippet rootMeanSquare --} + +rootMeanSquare_explicit xs = sqrt (meanSquare xs 0 0) + where meanSquare [] i ms = ms / fromIntegral i + meanSquare (x:xs) i ms = meanSquare xs (i+1) (ms + x**2) + +{-- snippet rootMeanSquare_foldl --} +rootMeanSquare_foldl xs = let (length, meanSquare) = foldl step (0,0) xs + in sqrt (meanSquare / fromIntegral length) + where step (length, meanSquare) x = (length + 1, meanSquare + x**2) +{-- /snippet rootMeanSquare_foldl --} }