## Catamorphisms, part four

Posted by Brian on May 24, 2008

I found something new to say about catamorphisms, so here we are again! Back in part two, we created a "fold" function for a binary tree type, which made it easy to define most any function on the tree (e.g. Sum, InOrder, Height). Today we’ll show a limitation of the "fold" function I previously showed, and demonstrate an easy way to overcome that limitation. There will also be code to "diff" trees and render them prettily, using WPF. Fun stuff ahead!

### Quick recap of Tree and FoldTree

Recall that we previously defined a data type for binary trees like this:

| Node of (*data*)‘a * (*left*)Tree<’a> * (*right*)Tree<’a>

| Leaf

let tree7 = Node(4, Node(2, Node(1, Leaf, Leaf), Node(3, Leaf, Leaf)),

Node(6, Node(5, Leaf, Leaf), Node(7, Leaf, Leaf)))

Each tree object is either an interior node (with data, a left child, and a right child) or a leaf. In the example above, "tree7" is a tree that I might draw like this:

We also defined a "fold" function for this tree data type:

let FoldTree nodeF leafV tree =

let rec Loop t cont =

match t with

| Node(x,left,right) -> Loop left (fun lacc ->

Loop right (fun racc ->

cont (nodeF x lacc racc)))

| Leaf -> cont leafV

Loop tree (fun x -> x)

FoldTree is extremely general; we previously used it to easily define various tree functions (Sum, InOrder, and Height). However, FoldTree is not quite general enough to solve one more tree problem…

### A new tree problem

Suppose I want to walk a given tree and replace every occurrence of a given number with a different number. For example, here’s a function which walks a tree of integers, and returns a new tree with every 9 replaced by a 0:

let Change9to0 tree =

FoldTree (fun x l r -> Node((if x=9 then 0 else x), l, r)) Leaf tree

As usual, we wrote this function as a simple application of FoldTree. It works as advertised.

However, you might notice a peculiarity. Suppose we apply "Change9to0" to our "tree7" tree. The "tree7" tree contains no 9s. As a result, we might expect to get the "same" tree back. In fact, we get back a tree that contains all the same data, but the tree which is returned is *an entirely new tree*. That is, Change9to0 allocated 7 new "Node" objects, filling them with the same data as the original Nodes in "tree7". For a small tree, this is not a big deal, but if this were a huge data structure, it would be a real waste to recreate the entire structure if we’re not going to change anything!

Graphically, I might draw the returned tree like this:

where red nodes are nodes that are different objects (in terms of reference-equality) from those nodes in the original tree. All the nodes are red, because Change9to0 allocated an entirely new set of nodes.

What we *want* is a function which will be smart, and only allocate new data structures when necessary. Indeed, one of the main advantages of immutable data structures is the ability to "share" portions of structure. Consider a slightly different function, that changes each *5* to a 0. Ideally when we apply such a function to the original "tree7", we want the result to look like this:

Look carefully at the colors – do you see what’s happened here? We changed the 5 to a 0, so of course that Node much now be a new object. Its parent node (the node containing the 6) must now also be a new object, since it has a different left-child reference than the corresponding node in the original tree. Similar, 6′s parent (the node with 4) is new because if now has a different right-child. However, *the rest of the nodes *(the 7, and the entire 1-2-3 subtree) *remain the same*. That is, these nodes are *shared* with the original data structure; for example, the new "4 node" points to the original "2 node" because there were no changes to that portion of the tree – everything from the 2 on down is unchanged.

In real-world applications with large immutable data structures, it is imperative to do this right and "only recreate what you need to". Otherwise, a single change to a huge tree will wind up using O(N) space, when in fact you only needed to use O(log N) space. A series of small changes would cause a plethora of extra allocations, creating tons of garbage, slowing down your program (due to the garbage collector) and spiking the memory usage. So in the real world, you *must *do this right.

But it’s impossible to do this right with the FoldTree function! (Try it!) Does this mean FoldTree is worthless for tree-transform tasks? We’ll find out in a moment.

### Doing it right

Let’s do a small example "by hand", both to make sure we understand what’s going on, and to help guide us towards a more general solution. What we want is a function which has the same general behavior as this function:

FoldTree (fun x l r -> Node((if x=5 then 0 else x), l, r)) Leaf tree

except that instead of yielding a tree like this one (with all new/red nodes)

when applied to "tree7", we want our enhanced function to result in

instead. We can do this via careful checks for reference-equality as we build up the new tree. Let’s first define a handy operator for checking reference-equality:

That is, "x===y" returns true if x and y are the same object in memory. Now we can define:

match tree with

| Leaf -> tree

| Node(x,l,r) ->

let newL = MyChange5to0 l

let newR = MyChange5to0 r

if x<>5 && newL === l && newR === r then

tree

else

Node((if x = 5 then 0 else x), newL, newR)

This preserves as much structure of the original tree as possible. In the case of a Leaf, we can always return the same object. In the case of an interior Node, there’s a bit of logic. First we need to recurse on both children. If we are not changing the data value in the current node (it’s not 5), and both recursive calls returned the original children (the same objects in memory as the originals), then this whole call can return the original tree object as-is. Otherwise, we need to allocate a new Node, filled in with the right data.

The good news is, this works. The bad news is "MyChange5to0" is 9 lines of code (subtle code, non-tail-recursive code), whereas "Change5to0" was just a single line of code. In an ideal world, the function would be as simple to write as Change5to0, but also have the right reference-equality-preserving behavior. Can we have our cake and eat it too?

### XFold to the rescue

We can! Here again is the original function based on "FoldTree" that has bad behavior:

FoldTree (fun x l r -> Node((if x=5 then 0 else x), l, r)) Leaf tree

It turns out we can write a slightly different function based on "XFoldTree" that has the desired behavior:

XFoldTree (fun x l r -> XNode((if x=5 then 0 else x), l, r)) XLeaf tree

The only differences are that "FoldTree", "Node", and "Leaf" have been replaced by "XFoldTree", "XNode", and "XLeaf". What are these crazy X-entities?

The definition of XFoldTree is just like the definition of FoldTree, except that its "nodeF" and "leafV" are modified to take an extra tree parameter (note the extra ‘t’ at the call sites):

let XFoldTree nodeF leafV tree =

let rec Loop t cont =

match t with

| Node(x,left,right) -> Loop left (fun lacc ->

Loop right (fun racc ->

cont (nodeF x lacc racc t))) // note ‘t’

| Leaf -> cont (leafV t) // note ‘t’

Loop tree (fun x -> x)

Passing in the original tree object to "nodeF" and "leafV" makes it possible to inspect the original object reference, in case you want to do reference-equality tests.

(Aside: It turns out that our original FoldTree function (which still has many utilities) can easily be defined in terms of XFoldTree:

XFoldTree (fun x l r _ -> nodeF x l r) (fun _ -> leafV) tree

That is, FoldTree is just XFoldTree where we discard the extra tree parameter (the "_" is the original-tree parameter we are ignoring). XFold is more general than Fold; so Fold can be defined in terms of it.)

Just as the XFoldTree arguments "take an extra tree parameter", the X-constructors (XNode and XLeaf) also take an extra tree parameter (but otherwise work similarly to the case labels of the discriminated union data type). These X-constructors do the equality-comparsion, so as to not create new objects whenever we have an existing object nearby that we expect might be exactly the same:

if xo = x && lo === l && ro === r then

orig

else

Node(x,l,r)

let XLeaf (Leaf as orig) =

orig

It may help you understand these functions by thinking of them as "constructors that take a hint". That is, for example, the expression "XNode (x,l,r) hint" means "I want to create ‘Node(x,l,r)’, but it just so happens that I have another Node named ‘hint’ right here, and it’s possible that ‘hint’ contains exactly the same data as the Node I am about to construct. So please check if these are the same. If they are, let’s not allocate anything new, and instead just reuse the hint. Otherwise, give me a new Node with the data I want."

### A closer look

Look again now at the difference between

FoldTree (fun x l r -> Node((if x=5 then 0 else x), l, r)) Leaf tree

and

XFoldTree (fun x l r -> XNode((if x=5 then 0 else x), l, r)) XLeaf tree

As is often the case, currying is hiding the plumbing, so as to make the code look simple on its face. Currying is great, but it may help you understand how XFoldTree interacts with the X-constructors if I rewrite the code like this:

XFoldTree (fun x l r hint -> XNode ((if x=5 then 0 else x), l, r) hint)

(fun hint -> XLeaf hint) tree

This is exactly the same code, except that I "uncurried" the "hint" argument. Now things are more clear. XFoldTree’s parameters each take an extra Tree parameter, which I’ve called "hint". This "hint" is passed as the extra parameter to XNode and XLeaf. Currying handily hides this extra plumbing, so that we preserve the structure of the original solution. To change from Change5to0 to XChange5to0, all we have to do is swap out the non-X versions of FoldTree/Node/Leaf with the X versions. That’s all. A trivial change, and now you get reference-equality-preservation "for free".

### The XFold boilerplate – catamorphisms++

I just said "for free", but of course it’s not *entirely* free. After all, we had to pay the price of defining these new X functions. Just like the Fold functions I previously showed you, however, these functions are entirely boilerplate – given a discriminated union type definition, a (very-well-trained) monkey could author XFold, Fold, and the X-constructors. (*You *might not be able to write them yet, but that’s because I haven’t trained you – I’ve simply asserted that there exists a mechanical algorithm from "data type" to "useful fold functions". I haven’t yet tried to find a way to automagically create these functions using F# reflection, or F# quotations, or whatnot, but those might be interesting future pursuits.)

The moral is, if you have a recursive discriminated union type that you will be using a lot, you should spend a little time up-front and define these handy functions alongside the data type. Then you can express practically every possible function over this data type as a simple application of Fold (or of XFold and the X-constructors). Folds are a huge win – they are an omnipresent idiom in functional programming. You should "wear them on your tool belt" (not just "keep them in your tool box" – Folds come up all the time, so you want the tool right at hand, at every moment) whenever you are writing F# code.

### The rest

The pictures in this blog entry are just screenshots from today’s program (code below). There are two portions of the code below that I did not discuss in the blog entry. "DiffTree" is a function that compares the interior nodes of two trees for reference-equality, returning a new tree with an extra boolean value at each interior node; check out the code itself for details. Of course, DiffTree is implemented as an application of XFoldTree. "Draw" is a function that renders a Tree on a graphics Canvas using WPF. It recursively partitions the Canvas into portions for the current node, the left subtree, and the right subtree. Of course, Draw is implemented as an application of FoldTree. (Did I mention that you use folds *all the time *in F#?) Check out the code; it’s short.

### The source code

Here’s today’s dose of F# goodness!

#r @"WindowsBase.dll"

#r @"PresentationCore.dll"

#r @"PresentationFramework.dll"

open System

// handy operator

let (===) = fun x y -> Object.ReferenceEquals(x,y)

type Tree<’a> =

| Node of (*data*)‘a * (*left*)Tree<’a> * (*right*)Tree<’a>

| Leaf

// 4

// 2 6

// 1 3 5 7

let tree7 = Node(4, Node(2, Node(1, Leaf, Leaf), Node(3, Leaf, Leaf)),

Node(6, Node(5, Leaf, Leaf), Node(7, Leaf, Leaf)))

// XFoldTree : (‘a -> ‘r -> ‘r -> Tree<’a> -> ‘r) -> (Tree<’a> -> ‘r) -> Tree<’a> -> ‘r

let XFoldTree nodeF leafV tree =

let rec Loop t cont =

match t with

| Node(x,left,right) -> Loop left (fun lacc ->

Loop right (fun racc ->

cont (nodeF x lacc racc t))) // note ‘t’

| Leaf -> cont (leafV t) // note ‘t’

Loop tree (fun x -> x)

// Can express the usual Fold in terms of XFold:

// FoldTree : (‘a -> ‘r -> ‘r -> ‘r) -> ‘r -> Tree<’a> -> ‘r

let FoldTree nodeF leafV tree =

XFoldTree (fun x l r _ -> nodeF x l r) (fun _ -> leafV) tree

// Since the "X" version takes an extra tree parameter (the ‘original’ tree),

// we can also define "X" versions of the constructors which preserve reference-equality:

let XNode (x,l,r) (Node(xo,lo,ro) as orig) =

if xo = x && lo === l && ro === r then

orig

else

Node(x,l,r)

let XLeaf (Leaf as orig) =

orig

// (Note that XFold, Fold, and the X-constructors are potentially useful boilerplate for

// every recursive DU type.)

// original version recreates entire tree, yuck

let Change5to0 tree =

FoldTree (fun x l r -> Node((if x=5 then 0 else x), l, r)) Leaf tree

// here’s a "smart" one written by hand

let rec MyChange5to0 tree =

match tree with

| Leaf -> tree

| Node(x,l,r) ->

let newL = MyChange5to0 l

let newR = MyChange5to0 r

if x<>5 && newL === l && newR === r then

tree

else

Node((if x = 5 then 0 else x), newL, newR)

// here it is with XFold – same as original, only with Xs

let XChange5to0 tree =

XFoldTree (fun x l r -> XNode((if x=5 then 0 else x), l, r)) XLeaf tree

let Change9to0 tree =

FoldTree (fun x l r -> Node((if x=9 then 0 else x), l, r)) Leaf tree

let XChange9to0 tree =

XFoldTree (fun x l r -> XNode((if x=9 then 0 else x), l, r)) XLeaf tree

// DiffTree: Tree<’a> * Tree<’a> -> Tree<’a * bool>

// return second tree with extra bool

// the bool signifies whether the Node "ReferenceEquals" the first tree

let rec DiffTree(tree,tree2) =

XFoldTree (fun x l r t t2 ->

let (Node(x2,l2,r2)) = t2

Node((x2,t===t2), l l2, r r2)) (fun _ _ -> Leaf) tree tree2

let ch9to0 = DiffTree(tree7, Change9to0 tree7)

let xch9to0 = DiffTree(tree7, XChange9to0 tree7)

let ch5to0 = DiffTree(tree7, Change5to0 tree7)

let mych5to0 = DiffTree(tree7, MyChange5to0 tree7)

let xch5to0 = DiffTree(tree7, XChange5to0 tree7)

open System.Windows

open System.Windows.Controls

open System.Windows.Input

open System.Windows.Media

open System.Windows.Shapes

// Handy functions to make multiple transforms be a more fluent interface

let IdentT() = new TransformGroup()

let AddT t (tg : TransformGroup) = tg.Children.Add(t); tg

let ScaleT x y (tg : TransformGroup) = tg.Children.Add(new ScaleTransform(x, y)); tg

let TranslateT x y (tg : TransformGroup) = tg.Children.Add(new TranslateTransform(x, y)); tg

// Draw: Canvas -> Tree<int * bool> -> unit

let Draw (canvas : Canvas) tree =

// assumes canvas is normalized to 1.0 x 1.0

FoldTree (fun (x,b) l r trans ->

// current node in top half, centered left-to-right

let tb = new TextBox(Width=100.0, Height=100.0, FontSize=70.0, Text=sprintf "%d" x,

// the tree is a "diff tree" where the bool represents

// "ReferenceEquals" differences, so color diffs Red

Foreground=(if b then Brushes.Black else Brushes.Red),

HorizontalContentAlignment=HorizontalAlignment.Center,

VerticalContentAlignment=VerticalAlignment.Center)

tb.RenderTransform <- IdentT() |> ScaleT 0.005 0.005 |> TranslateT 0.25 0.0 |> AddT trans

canvas.Children.Add(tb) |> ignore

// left child in bottom-left quadrant

l (IdentT() |> ScaleT 0.5 0.5 |> TranslateT 0.0 0.5 |> AddT trans)

// right child in bottom-right quadrant

r (IdentT() |> ScaleT 0.5 0.5 |> TranslateT 0.5 0.5 |> AddT trans)

) (fun _ -> ()) tree (IdentT())

type MyWPFWindow<’a>(tree : Tree<’a>, draw : Canvas -> Tree<’a> -> unit) as this =

inherit Window()

let canvas = new Canvas(Width=1.0, Height=1.0, Background = Brushes.Blue,

LayoutTransform=new ScaleTransform(200.0, 200.0))

do

draw canvas tree

this.Content <- canvas

this.Title <- "MyWPFWindow"

this.SizeToContent <- SizeToContent.WidthAndHeight

[<STAThread()>]

do

let app = new Application()

app.Run(new MyWPFWindow<_>(ch9to0, Draw)) |> ignore

//app.Run(new MyWPFWindow<_>(xch9to0, Draw)) |> ignore

//app.Run(new MyWPFWindow<_>(ch5to0, Draw)) |> ignore

//app.Run(new MyWPFWindow<_>(mych5to0, Draw)) |> ignore

//app.Run(new MyWPFWindow<_>(xch5to0, Draw)) |> ignore

## Steffen said

I love your FoldTree-Function – but I have a problem.How would the code look like if you would sum the node-values in project1 (where your type definition is) and concatenate the corresponding string values in a other project?I think the compiler nails the accumulator-type down to int?! Best regards, Steffen

## Brian said

There are cases when the F# type inference algorithm will make generic code less generic than it could be, based on a particular instantiation (F# usually provides a compiler warning when this happens), but you can fix this by structuring the code a little differently or by adding extra generic type annotations. If you have a particular code example in mind, post the code and we can step through how to make it work the way you want.