## Breadth-First Rose Trees: Traversals and the Cofree Comonad

I was looking again at the issue of writing breadth-first traversals for rose trees, and in particular the problem explored in Gibbons (2015). The breadth-first traversal here is a traversal in the lensy sense.

First, let’s look back at getting the levels out of the tree. Here’s the old function I arrived at last time:

```
levels :: Forest a -> [[a]]
= foldl f b ts [] []
levels ts where
Node x xs) ls qs = k (x : ls) (xs : qs)
f k (
= []
b _ [] = k : foldl (foldl f) b qs [] [] b k qs
```

After wrangling the definition a little, I got to the following (much cleaner) definition:

```
levels :: Tree a -> [[a]]
= f tr [] where
levels tr Node x xs) (y:ys) = (x:y) : foldr f ys xs
f (Node x xs) [] = [x] : foldr f [] xs f (
```

# Cofree

Before going any further, all of the functions so far can be redefined to work on the cofree comonad:

`data Cofree f a = a :< f (Cofree f a)`

When `f`

is specialized to
`[]`

, we get the original rose
tree. But what we actually require is much less specific: `levels`

, for instance, only needs `Foldable`

.

```
levelsCofree :: Foldable f => Cofree f a -> [[a]]
= f tr []
levelsCofree tr where
:<xs) (y:ys) = (x:y) : foldr f ys xs
f (x:<xs) [] = [x] : foldr f [] xs f (x
```

Using this, we can write the efficient breadth-first traversal:

```
breadthFirst :: (Applicative f, Traversable t)
=> (a -> f b) -> Cofree t a -> f (Cofree t b)
:<ts) =
breadthFirst c (t:<) (c t) (fill ts)) chld
liftA2 evalState (map2 (where
= foldr (liftA2 evalState) (pure []) (foldr f [] ts)
chld = traverse (const (state (\(x:xs) -> (x,xs))))
fill
:<xs) (q:qs)
f (x= app2 (\y ys zs -> (y:<ys) : zs) (c x) (fill xs) q
: foldr f qs xs
:<xs) []
f (x= map2 (\y ys -> [y:<ys]) (c x) (fill xs)
: foldr f [] xs
= fmap (\y -> fmap (k y) xs) x
map2 k x xs = liftA2 (\y -> liftA2 (k y) xs) x app2 k x xs
```

At every level, the subforest’s shape it taken (`fill`

), and it’s traversed recursively.
We can fuse these two steps into one:

```
breadthFirst :: (Traversable t, Applicative f)
=> (a -> f b) -> Cofree t a -> f (Cofree t b)
:<ts) =
breadthFirst c (t
liftA2
evalState:<) (c t) fill)
(map2 (foldr (liftA2 evalState) (pure []) (chld []))
(where
Compose (Endo chld,fill) = go ts
= traverse (\x -> Compose (Endo (f x), state (\(y:ys) -> (y,ys))))
go
:<xs) (q:qs) = app2 (\y ys zs -> (y:<ys) : zs) (c x) r q : rs qs
f (xwhere Compose (Endo rs,r) = go xs
:<xs) [] = map2 (\y ys -> [y:<ys]) (c x) r : rs []
f (xwhere Compose (Endo rs,r) = go xs
= fmap (\y -> fmap (k y) xs) x
map2 k x xs = liftA2 (\y -> liftA2 (k y) xs) x app2 k x xs
```

The overhead from this approach scraps any benefit, though.

*Patterns in Functional Programming*. https://patternsinfp.wordpress.com/2015/03/05/breadth-first-traversal/.