# Folding Trees in PureScript

Functional ProgrammingPureScript

Let’s say we wanted to perform two operations on a tree:

- count the number of leaves
- transform it to a list

In this post we will perform both by employing three different strategies:

- recursive functions
- using the Foldable typeclass
- using the State Monad

## The Tree Type

```
data Tree a
= Leaf a
| Node (Tree a) (Tree a)
instance showTree :: Show a => Show (Tree a) where
show (Leaf x) = "(Leaf " <> show x <> ")"
show (Node l r) = "(Node " <> show l <> " " <> show r <> ")"
exampleTree :: Tree Char
=
exampleTree Node
Node (Leaf 'a') (Leaf 'b'))
(Leaf 'c')
(
main :: Effect Unit
= do
main
logShow exampleTree-- (Node (Node (Leaf 'a') (Leaf 'b')) (Leaf 'c'))
```

## Recursive Functions

PureScript is a purely functional programming language and `Tree a`

is a recursive type: recursive functions are a perfect fit.

```
countTreeRec :: forall a. Tree a -> Int
=
countTreeRec tree 0 tree
go where
Leaf _) = i + 1
go i (Node l r) = go i l + go i r
go i (
toListRec :: forall a. Tree a -> List a
=
toListRec tree Nil tree
go where
Leaf x) = xs <> Cons x Nil
go xs (Node l r) = go xs l <> go xs r
go xs (
main :: Effect Unit
= do
main $ countTreeRec exampleTree
logShow -- 3
$ toListRec exampleTree
logShow -- ('a' : 'b' : 'c' : Nil)
```

The functions do what they are supposed to do. However, their shape is really similar. The only differences between `countTreeRec`

and `toListRec`

are:

- the initial value passed to the
`go`

function (i.e.`0`

vs`Nil`

) - the calculation in the base case of
`go`

(i.e.`i + 1`

vs`xs <> Cons x Nil`

) - the way the recursive case combines the result of the recursive calls (i.e.
`+`

vs`<>`

)

What’s described above is exactly what the Foldable typeclass captures. Let’s see how that looks in code.

## Using the Foldable Typeclass

The Foldable typeclass captures the idea of “folding” a structure into another one.

```
instance foldableTree :: Foldable Tree where
-- foldMap :: forall a m. Monoid m => (a -> m) -> f a -> m
foldMap g (Leaf x) = g x
foldMap g (Node l r) = foldMap g l <> foldMap g r
foldr g = foldrDefault g
foldl g = foldlDefault g
countTreeFold :: forall a. Tree a -> Int
=
countTreeFold tree
countwhere Additive count = foldMap (\_ -> Additive 1) tree
toListFold :: forall a. Tree a -> List a
=
toListFold tree foldMap (\x -> Cons x Nil) tree
main :: Effect Unit
= do
main $ countTreeFold exampleTree
logShow -- 3
$ toListFold exampleTree
logShow -- ('a' : 'b' : 'c' : Nil)
```

In this case, we could have used `foldr`

or `foldl`

to achieve the same results. But `foldMap`

is a tad more elegant. The way it works is simple:

- It first runs each element of the tree through the function passed to it (i.e.
`(\_ -> Additive 1)`

vs`(\x -> Cons x Nil)`

. That function must transform each element of the tree into a Monoid - It combines all of the Monoids of the tree using the
`<>`

operator. Since`<>`

is implemented as`+`

for`Additive`

and`<>`

is implemented as`Cons`

for`List`

, everything works as before.

Try to compare `countTreeFold`

vs `countTreeRec`

and `toListFold`

vs `toListRec`

.

## Using the State Monad

The foldable trick is totally cool. But why not go overkill implementing and using a State Monad?

```
newtype State s a = State (s -> Tuple a s)
runState :: forall s a. State s a -> s -> Tuple a s
State s) a = s a
runState (
instance functorState :: Functor (State s) where
-- map :: forall a b. (a -> b) -> f a -> f b
map g f = State (\s -> let Tuple a s' = runState f s in Tuple (g a) s')
instance applyState :: Functor (State s) => Apply (State s) where
-- apply :: forall a b. f (a -> b) -> f a -> f b
= State (\s -> let Tuple g s' = runState fg s
apply fg f Tuple a s'' = runState f s' in Tuple (g a) s'')
instance applicativeState :: Apply (State s) => Applicative (State s) where
-- pure :: forall a. a -> f a
pure a = State (\s -> Tuple a s)
instance bindState :: Apply (State s) => Bind (State s) where
-- bind :: forall a b. m a -> (a -> m b) -> m b
= State (\s -> let Tuple a s' = runState m s in runState (mg a) s')
bind m mg
addOne :: State Int Int
= State (\s -> Tuple s (s+1))
addOne
countTreeState :: forall a. Tree a -> State Int (Tree Int)
Leaf _) = Leaf <$> addOne
countTreeState (Node l r) = Node <$> countTreeState l <*> countTreeState r
countTreeState (
appendValue :: forall a. a -> State (List a) a
= State (\s -> Tuple x (s <> Cons x Nil))
appendValue x
toListState :: forall a. Tree a -> State (List a) (Tree a)
Leaf x) = Leaf <$> appendValue x
toListState (Node l r) = Node <$> toListState l <*> toListState r
toListState (
main :: Effect Unit
= do
main $ snd $ runState (countTreeState exampleTree) 0
logShow -- 3
$ snd $ runState (toListState exampleTree) Nil
logShow -- ('a' : 'b' : 'c' : Nil)
```

I’m gonna cover `State`

in a future post, so keep tuned!

## The Whole Code

```
module Main where
import Prelude (class Applicative, class Apply, class Bind, class Functor, class Show, Unit, discard, show, ($), (+), (<$>),
<*>), (<>))
(import Effect (Effect)
import Effect.Console (logShow)
import Data.Foldable
import Data.List (List(..), foldMap)
import Data.Monoid.Additive (Additive(..))
import Data.Tuple (Tuple(..), snd)
data Tree a
= Leaf a
| Node (Tree a) (Tree a)
instance showTree :: Show a => Show (Tree a) where
show (Leaf x) = "(Leaf " <> show x <> ")"
show (Node l r) = "(Node " <> show l <> " " <> show r <> ")"
exampleTree :: Tree Char
=
exampleTree Node
Node (Leaf 'a') (Leaf 'b'))
(Leaf 'c')
(
countTreeRec :: forall a. Tree a -> Int
=
countTreeRec tree 0 tree
go where
Leaf _) = i + 1
go i (Node l r) = go i l + go i r
go i (
toListRec :: forall a. Tree a -> List a
=
toListRec tree Nil tree
go where
Leaf x) = xs <> Cons x Nil
go xs (Node l r) = go xs l <> go xs r
go xs (
instance foldableTree :: Foldable Tree where
-- foldMap :: forall a m. Monoid m => (a -> m) -> f a -> m
foldMap g (Leaf x) = g x
foldMap g (Node l r) = foldMap g l <> foldMap g r
foldr g = foldrDefault g
foldl g = foldlDefault g
countTreeFold :: forall a. Tree a -> Int
=
countTreeFold tree
countwhere Additive count = foldMap (\_ -> Additive 1) tree
toListFold :: forall a. Tree a -> List a
=
toListFold tree foldMap (\x -> Cons x Nil) tree
newtype State s a = State (s -> Tuple a s)
runState :: forall s a. State s a -> s -> Tuple a s
State s) a = s a
runState (
instance functorState :: Functor (State s) where
-- map :: forall a b. (a -> b) -> f a -> f b
map g f = State (\s -> let Tuple a s' = runState f s in Tuple (g a) s')
instance applyState :: Functor (State s) => Apply (State s) where
-- apply :: forall a b. f (a -> b) -> f a -> f b
= State (\s -> let Tuple g s' = runState fg s
apply fg f Tuple a s'' = runState f s' in Tuple (g a) s'')
instance applicativeState :: Apply (State s) => Applicative (State s) where
-- pure :: forall a. a -> f a
pure a = State (\s -> Tuple a s)
instance bindState :: Apply (State s) => Bind (State s) where
-- bind :: forall a b. m a -> (a -> m b) -> m b
= State (\s -> let Tuple a s' = runState m s in runState (mg a) s')
bind m mg
addOne :: State Int Int
= State (\s -> Tuple s (s+1))
addOne
countTreeState :: forall a. Tree a -> State Int (Tree Int)
Leaf _) = Leaf <$> addOne
countTreeState (Node l r) = Node <$> countTreeState l <*> countTreeState r
countTreeState (
appendValue :: forall a. a -> State (List a) a
= State (\s -> Tuple x (s <> Cons x Nil))
appendValue x
toListState :: forall a. Tree a -> State (List a) (Tree a)
Leaf x) = Leaf <$> appendValue x
toListState (Node l r) = Node <$> toListState l <*> toListState r
toListState (
main :: Effect Unit
= do
main
logShow exampleTree-- (Node (Node (Leaf 'a') (Leaf 'b')) (Leaf 'c'))
$ countTreeRec exampleTree
logShow -- 3
$ toListRec exampleTree
logShow -- ('a' : 'b' : 'c' : Nil)
$ countTreeFold exampleTree
logShow -- 3
$ toListFold exampleTree
logShow -- ('a' : 'b' : 'c' : Nil)
$ snd $ runState (countTreeState exampleTree) 0
logShow -- 3
$ snd $ runState (toListState exampleTree) Nil
logShow -- ('a' : 'b' : 'c' : Nil)
```

Support my work by tweeting this article! 🙏