I recently learned about unfoldr
, and how to use it in Haskell. This is one possible implementation of it (though not the actual one):
unfoldr :: (b -> Maybe (a, b)) -> b -> [a]
unfoldr step b = case step b of
Nothing -> []
Just (a, b') -> a : unfoldr step b'
I then learned from reading this paper (“The Under-Appreciated Unfold”) that unfoldr
is equivalent to this function. I added the where
declarations to make the equivalence to the above version more obvious.
unfold :: (b -> Bool) -> (b -> a) -> (b -> b) -> b -> [a]
unfold done f g b
| done b = []
| otherwise = a : unfold done f g b'
where
a = f b
b' = g b
To show the equivalence (and for fun, since I had never once used unfoldr
even once before this), I rewrote some common functions using both unfoldr
and unfold
. I’ll leave them at the bottom.
I don’t think I would have thought of them being equivalent if I hadn’t read it in this paper. How can you learn to see the equivalence of things like this?
After writing those functions, I read the rest of the paper. The authors wrote a bread-first tree traversal with the second definition of unfold
.
data Tree a = Node a [Tree a]
type Forest a = [Tree a]
root (Node a ts) = a
kids (Node a ts) = ts
bftf :: Forest a -> [a]
bftf ts = bftf' (ts, [])
bftf' :: (Forest a, Forest a) -> [a]
bftf' = unfold p f g
where
p (ts, vs) = null ts && null vs
f ([], vs) = f (reverse vs, [])
f (t : ts, vs) = root t
g ([], vs) = g (reverse vs, [])
g (t : ts, vs) = (ts, reverse (kids t) ++ vs)
I rewrote the function bftf'
to use the standard unfoldr
.
bftf' :: (Forest a, Forest a) -> [a]
bftf' = unfoldr f
where
f queue = case queue of
([], []) -> Nothing
([], back) -> f (reverse back, [])
(Node root children : siblings, back) =
-- Dequeue the current node and enqueue its children.
let queue' = (siblings, revAppend children back)
in Just (root, queue')
-- revAppend xs ys == reverse xs ++ ys
revAppend xs ys = foldl' (flip (:)) ys xs
The standard functions I rewrote are iterate
, map
, zip
, takeWhile
, (++)
, and filter
. Many of these functions can also be written with foldr
, interestingly. The list functions written with unfold
seem to have an uncomfortable reliance on using head
and tail
; their correct usage relies on the predicate function guaranteeing that the list isn’t empty.
-- iterate f x == [x, f x, f (f x), ...]
iterate :: (x -> x) -> x -> [x]
iterate f x = unfold (const False) id f x
iterate f x = unfoldr (\x -> Just (x, f x)) x
-- map f [x1, x2, ..., xn] == [f x1, f x2, ..., f xn]
map :: (x -> y) -> [x] -> [y]
map f = unfold null (f . head) tail
map f = unfoldr $ \list ->
case list of
[] -> Nothing
(x : xs) -> Just (f x, xs)
-- zip [x1, ..., xn] [y1, ..., yn] == [(x1, y1), ..., (xn, yn)]
zip :: [x] -> [y] -> [(x, y)]
-- with unfold:
zip xs ys = unfold eitherNull headHead tailTail (xs, ys)
where
eitherNull (xs, ys) = null xs || null ys
headHead (xs, ys) = (head xs, head ys)
tailTail (xs, ys) = (tail xs, tail ys)
-- With unfoldr:
zip xs ys = unfoldr step (xs, ys)
where
step (x : xs, y : ys) = Just ((x, y), (xs, ys))
step _ -> Nothing
-- takeWhile (< 3) [1, 2, 3, 2] = [1, 2]
takeWhile :: (x -> Bool) -> [x] -> [x]
-- With unfold:
takeWhile p = unfold done head tail
where
done [] = True
done (x : xs) = not (p x)
-- With unfoldr:
takeWhile p = unfoldr $ \xs ->
case xs of
(x : xs') | p x -> Just (x, xs')
_ -> Nothing
-- [x1, ..., xn] ++ [y1, ..., yn] = [x1, ..., xn, y1, ..., yn]
(++) :: [a] -> [a] -> [a]
-- With unfoldr: much less ugly than with unfold
(++) xs ys = unfoldr step (xs, ys)
where
-- While xs has elements, take an x from xs.
step (x : xs, ys) = Just (x, (xs, ys))
-- Then, while ys has elements, take a y from ys.
step ([], y : ys) = Just (y, ([], ys))
-- Then, the new list is finished.
step ([], []) = Nothing
-- With unfold:
-- Translated by hand from the unfoldr version,
-- and more difficult to verify as correct.
(++) xs ys = unfold done f g (xs, ys)
where
done (xs, ys) = null xs && null ys
f (xs, ys) = head (if null xs then ys else xs)
g (x : xs, ys) = (xs, ys)
g ([], ys) = ([], tail ys)
filter :: (a -> Bool) -> [a] -> [b]
filter p = unfoldr f
where
f [] = Nothing
f (x : xs) | p x = Just (x, xs)
| otherwise = f xs
-- I haven't figured out how to write `filter` with `unfold`,
-- but I'm sure it's possible, though probably uglier.
Anyway, besides that one question I had (how can you learn to see equivalences like this?), I wrote this in large part because I thought it was pretty interesting to see the equivalence between these two functions. Isn’t it? Can you rewrite any other higher-order functions like that ?