Part of the "Recursive types and folds" series (more)

This post is the second in a series.

In the previous post, I introduced "catamorphisms", a way of creating functions for recursive types, and listed some rules which can be used to implement them mechanically. In this post, we'll use these rules to implement catamorphisms for some other domains.

Series contents

Here's the contents of this series:

Rules for creating catamorphisms

We saw in the previous post that creating a catamorphism is a mechanical process, and the rules were:

• Create a function parameter to handle each case in the structure.
• For non-recursive cases, pass the function parameter all the data associated with that case.
• For recursive cases, perform two steps:
• First, call the catamorphism recursively on the nested value.
• Then pass the handler all the data associated with that case, but with the result of the catamorphism replacing the original nested value.

Let's now see if we can apply these rules to create catamorphisms in other domains.

Catamorphism example: File system domain

Let's start with a very crude model of a file system:

• Each file has a name and a size.
• Each directory has a name and a size and a list of subitems.

Here's how I might model that:

``````type FileSystemItem =
| File of File
| Directory of Directory
and File = {name:string; fileSize:int}
and Directory = {name:string; dirSize:int; subitems:FileSystemItem list}
``````

I admit it's a pretty bad model, but it's just good enough for this example!

Ok, here are some sample files and directories:

``````let readme = File {name="readme.txt"; fileSize=1}
let config = File {name="config.xml"; fileSize=2}
let build  = File {name="build.bat"; fileSize=3}
let src = Directory {name="src"; dirSize=10; subitems=[readme; config; build]}
let bin = Directory {name="bin"; dirSize=10; subitems=[]}
let root = Directory {name="root"; dirSize=5; subitems=[src; bin]}
``````

Time to create the catamorphism!

Let's start by looking at the signatures to figure out what we need.

The `File` constructor takes a `File` and returns a `FileSystemItem`. Using the guidelines above, the handler for the `File` case needs to have the signature `File -> 'r`.

``````// case constructor
File  : File -> FileSystemItem

// function parameter to handle File case
fFile : File -> 'r
``````

That's simple enough. Let's put together an initial skeleton of `cataFS`, as I'll call it:

``````let rec cataFS fFile fDir item :'r =
let recurse = cataFS fFile fDir
match item with
| File file ->
fFile file
| Directory dir ->
// to do
``````

The `Directory` case is more complicated. If we naively applied the guidelines above, the handler for the `Directory` case would have the signature `Directory -> 'r`, but that would be incorrect, because the `Directory` record itself contains a `FileSystemItem` that needs to be replaced with an `'r` too. How can we do this?

One way is to "explode" the `Directory` record into a tuple of `(string,int,FileSystemItem list)`, and then replace the `FileSystemItem` with `'r` in there too.

In other words, we have this sequence of transformations:

``````// case constructor (Directory as record)
Directory : Directory -> FileSystemItem

// case constructor (Directory unpacked as tuple)
Directory : (string, int, FileSystemItem list) -> FileSystemItem
//   replace with 'r ===> ~~~~~~~~~~~~~~          ~~~~~~~~~~~~~~

// function parameter to handle Directory case
fDir :      (string, int, 'r list)             -> 'r
``````

Another issue is that the data associated with the Directory case is a list of `FileSystemItem`s. How can we convert that into a list of `'r`s?

Well, the `recurse` helper turns a `FileSystemItem` into an `'r`, so we can just use `List.map` passing in `recurse` as the mapping function, and that will give us the list of `'r`s we need!

Putting it all together, we get this implementation:

``````let rec cataFS fFile fDir item :'r =
let recurse = cataFS fFile fDir
match item with
| File file ->
fFile file
| Directory dir ->
let listOfRs = dir.subitems |> List.map recurse
fDir (dir.name,dir.dirSize,listOfRs)
``````

and if we look at the type signature, we can see that it is just what we want:

``````val cataFS :
fFile : (File -> 'r) ->
fDir  : (string * int * 'r list -> 'r) ->
// input value
FileSystemItem ->
// return value
'r
``````

So we're done. It's a bit complicated to set up, but once built, we have a nice reusable function that can be the basis for many others.

File system domain: `totalSize` example

Alrighty then, let's use it in practice.

To start with, we can easily define a `totalSize` function that returns the total size of an item and all its subitems:

``````let totalSize fileSystemItem =
let fFile (file:File) =
file.fileSize
let fDir (name,size,subsizes) =
(List.sum subsizes) + size
cataFS fFile fDir fileSystemItem
``````

And here are the results:

``````readme |> totalSize  // 1
src |> totalSize     // 16 = 10 + (1 + 2 + 3)
root |> totalSize    // 31 = 5 + 16 + 10
``````

File system domain: `largestFile` example

How about a more complicated function, such as "what is the largest file in the tree?"

Before we start this one, let's think about what it should return. That is, what is the `'r`?

You might think that it's just a `File`. But what if the subdirectory is empty and there are no files?

So let's make `'r` a `File option` instead.

The function for the `File` case should return `Some file` then:

``````let fFile (file:File) =
Some file
``````

The function for the `Directory` case needs more thought:

• If list of subfiles is empty, then return `None`
• If list of subfiles is non-empty, then return the largest one
``````let fDir (name,size,subfiles) =
match subfiles with
| [] ->
None  // empty directory
| subfiles ->
// return largest one
``````

But remember that `'r` is not a `File` but a `File option`. So that means that `subfiles` is not a list of files, but a list of `File option`.

Now, how can we find the largest one of these? We probably want to use `List.maxBy` and pass in the size. But what is the size of a `File option`?

Let's write a helper function to provide the size of a `File option`, using this logic:

• If the `File option` is `None`, return 0
• Else return the size of the file inside the option

Here's the code:

``````// helper to provide a default if missing
let ifNone deflt opt =
defaultArg opt deflt

// get the file size of an option
let fileSize fileOpt =
fileOpt
|> Option.map (fun file -> file.fileSize)
|> ifNone 0
``````

Putting it all together then, we have our `largestFile` function:

``````let largestFile fileSystemItem =

// helper to provide a default if missing
let ifNone deflt opt =
defaultArg opt deflt

// helper to get the size of a File option
let fileSize fileOpt =
fileOpt
|> Option.map (fun file -> file.fileSize)
|> ifNone 0

// handle File case
let fFile (file:File) =
Some file

// handle Directory case
let fDir (name,size,subfiles) =
match subfiles with
| [] ->
None  // empty directory
| subfiles ->
// find the biggest File option using the helper
subfiles
|> List.maxBy fileSize

// call the catamorphism
cataFS fFile fDir fileSystemItem
``````

If we test it, we get the results we expect:

``````readme |> largestFile
// Some {name = "readme.txt"; fileSize = 1}

src |> largestFile
// Some {name = "build.bat"; fileSize = 3}

bin |> largestFile
// None

root |> largestFile
// Some {name = "build.bat"; fileSize = 3}
``````

Again, a little bit tricky to set up, but no more than if we had to write it from scratch without using a catamorphism at all.

Catamorphism example: Product domain

Let's work with a slightly more complicated domain. This time, imagine that we make and sell products of some kind:

• Some products are bought, with an optional vendor.
• Some products are made on our premises, built from subcomponents, where a subcomponent is some quantity of another product.

Here's the domain modelled as types:

``````type Product =
| Bought of BoughtProduct
and BoughtProduct = {
name : string
weight : int
vendor : string option }
and MadeProduct = {
name : string
weight : int
components:Component list }
and Component = {
qty : int
product : Product }
``````

Note that the types are mutally recursive. `Product` references `MadeProduct` which references `Component` which in turn references `Product` again.

Here are some example products:

``````let label =
Bought {name="label"; weight=1; vendor=Some "ACME"}
let bottle =
Bought {name="bottle"; weight=2; vendor=Some "ACME"}
let formulation =
Bought {name="formulation"; weight=3; vendor=None}

let shampoo =
Made {name="shampoo"; weight=10; components=
[
{qty=1; product=formulation}
{qty=1; product=bottle}
{qty=2; product=label}
]}

let twoPack =
Made {name="twoPack"; weight=5; components=
[
{qty=2; product=shampoo}
]}
``````

Now to design the catamorphism, we need to do is replace the `Product` type with `'r` in all the constructors.

Just as with the previous example, the `Bought` case is easy:

``````// case constructor
Bought  : BoughtProduct -> Product

// function parameter to handle Bought case
fBought : BoughtProduct -> 'r
``````

The `Made` case is trickier. We need to expand the `MadeProduct` into a tuple. But that tuple contains a `Component`, so we need to expand that as well. Finally we get to the inner `Product`, and we can then mechanically replace that with `'r`.

Here's the sequence of transformations:

``````// case constructor

// case constructor (MadeProduct unpacked as tuple)
Made  : (string,int,Component list) -> Product

// case constructor (Component unpacked as tuple)
Made  : (string,int,(int,Product) list) -> Product
//  replace with 'r ===> ~~~~~~~           ~~~~~~~

// function parameter to handle Made case
fMade : (string,int,(int,'r) list)      -> 'r
``````

When implementing the `cataProduct` function we need to the same kind of mapping as before, turning a list of `Component` into a list of `(int,'r)`.

We'll need a helper for that:

``````// Converts a Component into a (int * 'r) tuple
let convertComponentToTuple comp =
(comp.qty,recurse comp.product)
``````

You can see that this uses the `recurse` function to turn the inner product (`comp.product`) into an `'r` and then make a tuple `int * 'r`.

With `convertComponentToTuple` available, we can convert all the components to tuples using `List.map`:

``````let componentTuples =
|> List.map convertComponentToTuple
``````

`componentTuples` is a list of `(int * 'r)`, which is just what we need for the `fMade` function.

The complete implementation of `cataProduct` looks like this:

``````let rec cataProduct fBought fMade product :'r =
let recurse = cataProduct fBought fMade

// Converts a Component into a (int * 'r) tuple
let convertComponentToTuple comp =
(comp.qty,recurse comp.product)

match product with
| Bought bought ->
fBought bought
let componentTuples =  // (int * 'r) list
|> List.map convertComponentToTuple
``````

Product domain: `productWeight` example

We can now use `cataProduct` to calculate the weight, say.

``````let productWeight product =

// handle Bought case
let fBought (bought:BoughtProduct) =
bought.weight

// handle Made case
let fMade (name,weight,componentTuples) =
// helper to calculate weight of one component tuple
let componentWeight (qty,weight) =
qty * weight
// add up the weights of all component tuples
let totalComponentWeight =
componentTuples
|> List.sumBy componentWeight
// and add the weight of the Made case too
totalComponentWeight + weight

// call the catamorphism
cataProduct fBought fMade product
``````

Let's test it interactively to make sure it works:

``````label |> productWeight    // 1
shampoo |> productWeight  // 17 = 10 + (2x1 + 1x2 + 1x3)
twoPack |> productWeight  // 39 = 5  + (2x17)
``````

That's as we expect.

Try implementing `productWeight` from scratch, without using a helper function like `cataProduct`. Again, it's do-able, but you'll probably waste quite bit of time getting the recursion logic right.

Product domain: `mostUsedVendor` example

Let's do a more complex function now. What is the most used vendor?

The logic is simple: each time a product references a vendor, we'll give that vendor one point, and the vendor with the highest score wins.

Again, let's think about what it should return. That is, what is the `'r`?

You might think that it's just a score of some kind, but we also need to know the vendor name. Ok, a tuple then. But what if there are no vendors?

So let's make `'r` a `VendorScore option`, where we are going to create a little type `VendorScore`, rather than using a tuple.

``````type VendorScore = {vendor:string; score:int}
``````

We'll also define some helpers to get data from a `VendorScore` easily:

``````let vendor vs = vs.vendor
let score vs = vs.score
``````

Now, you can't determine the most used vendor over until you have results from the entire tree, so both the `Bought` case and the `Made` case need to return a list which can added to as we recurse up the tree. And then, after getting all the scores, we'll sort descending to find the vendor with the highest one.

So we have to make `'r` a `VendorScore list`, not just an option!

The logic for the `Bought` case is then:

• If the vendor is present, return a `VendorScore` with score = 1, but as a one-element list rather than as a single item.
• If the vendor is missing, return an empty list.
``````let fBought (bought:BoughtProduct) =
// set score = 1 if there is a vendor
bought.vendor
|> Option.map (fun vendor -> {vendor = vendor; score = 1} )
// => a VendorScore option
|> Option.toList
// => a VendorScore list
``````

The function for the `Made` case is more complicated.

• If list of subscores is empty, then return an empty list.
• If list of subscores is non-empty, we sum them by vendor and then return the new list.

But the list of subresults passed into the `fMade` function will not be a list of subscores, it will be a list of tuples, `qty * 'r` where `'r` is `VendorScore list`. Complicated!

What we need to do then is:

• Turn `qty * 'r` into just `'r` because we don't care about the qty in this case. We now have a list of `VendorScore list`. We can use `List.map snd` to do this.
• But now we would have a list of `VendorScore list`. We can flatten a list of lists into a simple list using `List.collect`. And in fact, using `List.collect snd` can do both steps in one go.
• Group this list by vendor so that we have a list of `key=vendor; values=VendorScore list` tuples.
• Sum up the scores for each vendor (`values=VendorScore list`) into a single value, so that we have a list of `key=vendor; values=VendorScore` tuples.

At this point the `cata` function will return a `VendorScore list`. To get the highest score, use `List.sortByDescending` then `List.tryHead`. Note that `maxBy` won't work because the list could be empty.

Here's the complete `mostUsedVendor` function:

``````let mostUsedVendor product =

let fBought (bought:BoughtProduct) =
// set score = 1 if there is a vendor
bought.vendor
|> Option.map (fun vendor -> {vendor = vendor; score = 1} )
// => a VendorScore option
|> Option.toList
// => a VendorScore list

let fMade (name,weight,subresults) =
// subresults are a list of (qty * VendorScore list)

// helper to get sum of scores
let totalScore (vendor,vendorScores) =
let totalScore = vendorScores |> List.sumBy score
{vendor=vendor; score=totalScore}

subresults
// => a list of (qty * VendorScore list)
|> List.collect snd  // ignore qty part of subresult
// => a list of VendorScore
|> List.groupBy vendor
// second item is list of VendorScore, reduce to sum
|> List.map totalScore
// => list of VendorScores

// call the catamorphism
cataProduct fBought fMade product
|> List.sortByDescending score  // find highest score
// return first, or None if list is empty
``````

Now let's test it:

``````label |> mostUsedVendor
// Some {vendor = "ACME"; score = 1}

formulation |> mostUsedVendor
// None

shampoo |> mostUsedVendor
// Some {vendor = "ACME"; score = 2}

twoPack |> mostUsedVendor
// Some {vendor = "ACME"; score = 2}
``````

This isn't the only possible implementation of `fMade`, of course. I could have used `List.fold` and done the whole thing in one pass, but this version seems like the most obvious and readable implementation.

It's also true that I could have avoided using `cataProduct` altogether and written `mostUsedVendor` from scratch. If performance is an issue, then that might be a better approach, because the generic catamorphism creates intermediate values (such as the list of `qty * VendorScore option`) which are over general and potentially wasteful.

On other hand, by using the catamorphism, I could focus on the counting logic only and ignore the recursion logic.

So as always, you should consider the pros and cons of reuse vs. creating from scratch; the benefits of writing common code once and using it in a standardized way, versus the performance but extra effort (and potential bugginess) of custom code.

Summary

We've seen in this post how to define a recursive type, and been introduced to catamorphisms.

And we have also seen some uses for catamorphisms:

• Any function that "collapses" a recursive type, such as `Gift -> 'r`, can be written in terms of the catamorphism for that type.
• Catamorphisms can be used to hide the internal structure of the type.
• Catamorphisms can be used to create mappings from one type to another by tweaking the functions that handle each case.
• Catamorphisms can be used to create a clone of the original value by passing in the type's case constructors.

But all is not perfect in the land of catamorphisms. In fact, all the catamorphism implementations on this page have a potentially serious flaw.

In the next post we'll see what can go wrong with them, how to fix them, and in the process look at the various kinds of "fold".

See you then!

The source code for this post is available at this gist.

UPDATE: Fixed logic error in `mostUsedVendor` as pointed out by Paul Schnapp in comments. Thanks, Paul!