Mathias Brandewinder blog

RANSAC: estimating a model using very noisy data (part 1)

2026-03-05T00:00:00+00:00

Recently, as part of a project I am working on, I had to estimate a model to make some predictions. And, as is usually the case, the data available was not very good, with a lot of suspect data points, so called “outliers”. Estimating the parameters of a model becomes tricky then, because a few data points that are very wrong can have an outsized impact on the parameters, and tilt the results of the estimation far off the correct values.

This lead me to the RANSAC algorithm, which is designed to handle that exact problem. And, in my experience, re-implementing an algorithm from scratch is a great way to really understand how it works, so that’s what I did: you can find the current code here.

In this post, I will motivate the problem first, demonstrating how outliers can wreck model estimation. In our next installment, we will go over RANSAC and see if it fares any better!

Let’s illustrate the problem on a simple example. Imagine that we have a model, where we observe a value X and a value Y, and that these 2 follow a simple relationship where

Y = 1 + 0.5 * X

That is, they form a straight line. Now imagine that we have a dataset with a sample of observations for X and Y, with 2 caveats:

In half the cases, the observation is completely wrong, and there is no relationship between X and Y,
When the observation is correct, the observation is a bit off, and the recorded values are Y = 1 + 0.5 * X + some noise.

Let’s first create a model to represent that:

type Obs = { X: float }

type Parameters = {
    Constant: float
    Slope: float
    }

let predictor (parameters: Parameters) =
    fun (obs: Obs) ->
        parameters.Constant
        + parameters.Slope * obs.X

let trueParameters = {
    Constant = 1.0
    Slope = 0.5
    }

We have observations Obs and model Parameters. The “true” model has parameters { Constant = 1.0; Slope = 0.5 }, which we can use to predict the value Y like so:

predictor trueParameters { X = 1.0 }
val it: float = 1.5

We can now generate a synthetic sample of 100 examples, recording the value X and the value we observe for Y, the Label. We deliberately add noise to the dataset, so the Label we observe could be far off the correct value:

let rng = System.Random 0
let probaNoisy = 0.5
let sample =
    Array.init 100 (fun _ ->
        let obs = { X = rng.NextDouble () }
        let y =
            if rng.NextDouble () < probaNoisy
            then 1.0 + 0.5 * rng.NextDouble ()
            else 
                predictor trueParameters obs 
                + (0.2 * rng.NextDouble () - 0.1)
        {
            Observation = obs
            Label = y
        }

With a 50% probability, the Y value is generated randomly, without any relationship whatsoever to X (outlier). Otherwise, the Y value will be the “correct” value, plus some random noise, between plus and minus 0.1.

Let’s visualize the dataset, using Plotly.NET, together with the “true” model that we want to estimate from the data:

[
    Chart.Scatter (
        sample
        |> Array.map (fun ex -> ex.Observation.X, ex.Label),
        StyleParam.Mode.Markers
        )
    |> Chart.withTraceInfo "Sample"

    Chart.Line (
        [ 0.0; 1.0 ]
        |> List.map (fun x -> x, predictor trueParameters { X = x })
        )
    |> Chart.withTraceInfo "True Model"
]
|> Chart.combine
|> Chart.show

This is what we’ll be working with. The data is very noisy, and it is hard to visually detect the straight line that we used to generate the data behind all the noise. Our goal will be to see if RANSAC can actually pick it up!

Before diving into RANSAC, first let’s illustrate the issue I brought up earlier. What would happen if we tried to use standard linear regression here?

To do so, we bring in Math.NET, and run a line fit, like so:

#r "nuget: MathNET.Numerics.FSharp"
open MathNet.Numerics

let lineFit (sample: (float * float) []) =
    let xs, ys =
        sample
        |> Array.unzip
    let struct (x, y) = Fit.line xs ys
    {
        Constant = x
        Slope = y
    }

let estimator (sample: Example<Obs, float> []) =
    sample
    |> Array.map (fun ex -> ex.Observation.X, ex.Label)
    |> lineFit

let naiveParameters =
    sample
    |> Array.map (fun ex -> ex.Observation.X, ex.Label)
    |> lineFit

This produces the following estimates for our model:

{ 
    Constant = 1.116521067
    Slope = 0.3092724541
}

This is… not very good:

The line produced by the naive regression is pretty far off. This is not unexpected, standard regression is known to be sensitive to outliers, and we deliberately added a lot of bad data to our sample.

In practical terms, what is happening here is that the regression cannot distinguish between good and bad data, and is trying to find a line where no observation is too far off. But we can see on the scatterplot that:

We have a lot of bad observations for X < 0.5 with high Y values,
We have a lot of bad observations for X > 0.5 with low Y values.

To accomodate for these outliers, the regression has to reduce the slope of the line down, and instead of the correct value, 0.5, we get 0.3, which is pretty bad.

And that’s where we will leave things today. Now that we demonstrated on a simple example how linear regression can go wrong when used on a noisy dataset, in our next installment, we will see if RANSAC fares any better!

How much of a burden is management?

2026-01-21T00:00:00+00:00

From time to time, a small and usually unimportant question gets stuck in my head, and won’t stop nagging me until I spend the time to figure out the answer. This post is about one of these.

Last December, I mentioned in a post that “bigger teams require more coordination”, which would lead to diminishing returns to scale. As a team grows, it requires managers to coordinate activities. Grow the team more, and managers themselves require coordination, and another layer of managers, and so on and so forth. My intuition was that, ignoring other effects, larger teams would progressively become less and less productive, because of the increased burden of management.

The question that got stuck in my head was, how does this burden grow? What shape does it have, and can I express it as a mathematical function? This is the question I will be investigating in this post.

The way I approached the question started by formulating a simplistic model, without being too concerned about the finer details. In my world, any time we form a group of a certain size, a coordinator (a manager, if you will) is needed. These coordinators do not directly contribute to the actual work, but they are necessary for the workers to perform their work.

As an illustration, let’s imagine that this group size is 5. In this case,

1 worker can work without coordination,
4 workers can work without coordination,
5 workers require 1 coordinator (we reached a group size of 5),
6 workers require 1 coordinator (we have 1 group of 5, and an unsupervised worker),
25 workers require 5 coordinators, who themselves require 1 coordinator.

… and so on and so forth: 125 workers (5*5*5) require another layer of coordinators, 625 yet another layer, etc…

So how does it look? Let’s write a function, computing the coordination overhead needed for a given number of workers:

let groupSize = 5

let overhead (workers: int) =
    workers
    |> Seq.unfold (fun population ->
        if population >= groupSize
        then
            let managers = population / groupSize
            Some (managers, managers)
        else None
        )

We start with the population of workers. If that population is less than the groupSize, we stop. If we have more than the groupSize, at least one coordinator is needed. We create a manager for each group of groupSize, and repeat for these managers, checking if they too need managers, until we are done.

Let’s confirm that it works first:

overhead 1
> seq []

overhead 4
> seq []

overhead 5
> seq [1]
overhead 6
seq [1]

overhead 25
seq [5; 1]

overhead 125
seq [25; 5; 1]

overhead 625
seq [125; 25; 5; 1]

The overhead function calculates how many coordinators are needed, by layer. For example, overhead 125 calculates that 125 workers will require 25 direct coordinators, who will themselves require 5 coordinators, who will require 1 last coordinator.

Now that we have this function in place, we can plot how many people we need for any number of workers. Let’s do that, using Plotly.NET:

#r "nuget: Plotly.NET"
open Plotly.NET

let totalStaff (workers: int) =
    let totalOverhead =
        overhead workers
        |> Seq.sum
    workers + totalOverhead

[ 1 .. 1000 ]
|> List.map (fun workers -> workers, totalStaff workers)
|> Chart.Line
|> Chart.withXAxisStyle "Workers"
|> Chart.withYAxisStyle "Total"
|> Chart.show

The resulting chart is as follows:

This chart caught me by surprise. I was expecting the curve to bend upwards, and show diminishing returns to scale. It doesn’t - this looks like a straight line, with a roughly constant ratio of coordinators to workers. In other words, in this model, teams scale perfectly fine.

Does this make sense? Hindsight being 20/20, it does. Zooming in a bit on just the number of managers needed in isolation helps understand better what is happening:

[ 1 .. 200 ]
|> List.map (fun workers ->
    workers,
    overhead workers |> Seq.sum
    )
|> Chart.Line
|> Chart.withXAxisStyle "Workers"
|> Chart.withYAxisStyle "Managers"
|> Chart.show

The number of managers as a function of the number of workers grows as a “staircase” function. To be more specific, it is a stack of staircase functions: every 5 workers, we add a manager, every 25 workers, we add 1 extra, every 125 we add 1 extra, and so on and so forth.

In other words, as an approximation, the overhead for x workers is:

$overhead(x) = x \times \frac{1}{5} + x \times \frac{1}{5 \times 5} + x \times \frac{1}{5 \times 5 \times 5} …$

This is a sum of linear functions, that is, a linear function. We can even compute its slope, recognizing that 1/5 + 1/5*5 + 1/5*5*5... is a geometric series, which gives us a limit of

$overhead(x) \approx \frac {x} {5 - 1}$

This happens to match the last chart, where we see that for 200 workers, we need approximately 50 managers.

Long story short, as long as a group needs less direct managers than the group size, the overhead cost grows linearly with the number of workers needed.

Now that model also assumes that the cost of a manager is the same as a worker, which is not exactly realistic. However, if we assume that each level of the hierarchical pyramid gets a geometric paid increase, that is, each level is paid for instance 20% more than the previous, the results remain the same. The overhead function becomes something like this:

$overhead(x) = x \times \frac{1}{5} \times 1.2 + x \times \frac{1}{5 \times 5} \times 1.2^2 + x \times \frac{1}{5 \times 5 \times 5} \times 1.2^3…$

We still have a geometric series pattern at play, and the overall behavior remains the same.

Parting thoughts

I really did not expect the model to turn out linear! I suspect it is because I assumed that adding a pyramid of managers would introduce inefficiencies and diminishing returns to scale, which blinded me to the geometric series pattern. So… question your assumptions, build a simple model, and plot your data!

Adding Goal Seek to Quipu (and helping Santa with it!)

2025-12-11T00:00:00+00:00

This post is part of the F# Advent 2025 series, which already has bangers! Check out the whole series, and a big shout out to Sergey Tihon for organizing this once again!

It is that merry time of the year again! The holidays are approaching, and in houses everywhere, people are happily sipping eggnogg and hanging decorations. But in one house, the mood is not festive. Every year on December 1st, the first day of Advent, Santa Claus begins wrapping gifts for 2 billion children worldwide, from his workshop in the North Pole. But this year, Krampus unexpectedly decided to impose tariffs on Greenland, throwing the supply chain of gifts into chaos. It is now December 11th, and Santa just received the goods. Santa is now 11 days behind schedule, and needs to hire many, many more Elves than usual to catch up. But… how many Elves does he need to hire?

Santa runs a tight ship at Santa, Inc., and he knows that adding new Elves to the team won’t be seamless. Bigger teams require more coordination and additional equipment.

Based on available data, Santa knows that:

He needs to hire Elves to wrap 2,000,000,000 gifts,
A single Elf can wrap at most 100,000 gifts a day,
Instead of the normal 24 Advent days, Santa has only 13 days left,
A team of n Elves will only be able to produce n ^ 0.8 as much as a single elf, that is, there are diminishing returns to scale.

Note: the function f(elves) = elves ^ 0.8 is largely arbitrary. It has the shape we want for our problem: it is always increasing (more elves can wrap more gifts), but the increase slows down gradually. For instance f(1)=1.00, whereas f(2)=1.74, meaning that 2 elves will only be able to wrap 1.74 as many gifts as 1 elf, instead of twice as many.

Can we help Santa decide how many Elves to hire? And can we figure out how much the Krampus shenanigans are costing Santa, Inc.? We certainly can, and today we will do so using the goalSeek feature which we just added to Quipu.

Expressing the problem

What we are looking for is the number of elves we need so that in 13 days, they can wrap exactly 2 billion gifts. Let’s write a giftsWrapped function first, computing how many gifts a group of elves can wrap over a given number of days:

let giftsPerDay = 100_000.0

let giftsWrapped (days: float) (elves: float) =
    if elves <= 0.0
    then 0.0
    else
    days * giftsPerDay * (elves ** 0.8)

We guard against negative elves values to spare us from dealing with nan.

Quick sanity checks! A single elf working a single day should be able to wrap 100,000 gifts:

giftsWrapped 1.0 1.0
val it: float = 100000.0

A single elf working 10 days should be able to wrap 1 million gifts:

giftsWrapped 10.0 1.0
val it: float = 1000000.0

2 elves should wrap less than 200,000 gifts in a day:

giftsWrapped 1.0 2.0
val it: float = 174110.1127

So far, so good. Now what we are looking for is the value of elves that can wrap 2 billion gifts over the 13 days we have left, that is, we want to find the value of elves such that

giftsWrapped 13.0 elves = 2_000_000_000.0.

Solving the problem with Quipu

There are many ways Santa could go about solving that problem. He could do it visually, by plotting the giftsWrapped function and finding where the curve reaches 2 billion. He could roll up his sleeves and do some old-fashioned math by hand. He could do a grid search or use the bisection method. If Santa hadn’t cancelled his Excel 365 subscription because of the constant Copilot AI nagging, he could use the Excel GoalSeek function.

Or, drumroll, he could use the goalSeek function that we just added to Quipu!

#r "nuget: Quipu, 1.1.0-beta1"
open Quipu

let children = 2_000_000_000.0
let advent = 24.0

giftsWrapped (advent - 11.0)
|> NelderMead.objective
|> NelderMead.goalSeek children

This produces the following result:

val it: SolverResult =
  Successful {
    Status = Optimal
    Iterations = 49
    Candidate = {
      Arguments = [|9635.146097|]
      Value = 2000000000.0
      }
    Simplex = [|[|9635.146097|]; [|9635.146097|]|] 
    }

The solver was Successful in its search. After 49 iterations, it found an Optimal solution, with a Candidate solution: 9,635 elves will be able to wrap exactly 2 billion packages in 13 days. Well, 9,635.146097 elves to be precise.

Quick check again:

giftsWrapped 13.0 9635.146097
val it: float = 2000000000.0

We are good to go! As a bonus, we can also quickly check how many elves Santa would have needed, without Krampuses’ shenanigans, using the full Advent period to wrap gifts, instead of performing a rush job in 13 days:

giftsWrapped advent
|> NelderMead.objective
|> NelderMead.goalSeek children

With the full 24 days of Advent, Santa would have needed only 4477 elves. Converted to comparable scales, instead of 24 * 4477 = 107,448 elf-days, we now need 13 * 9635 = 125,255 elf-days, a nearly 17% extra. Thanks, Krampus!

How does it work?

Under the hood, NelderMead.goalSeek uses NelderMead.minimize. What goalSeek does is search for arguments args to a function f such that f(args)=target, where target is a user-supplied value. This can be restated slightly differently as f(args)-target=0, which we can convert to a “classic” minimization problem, like so: minimize abs(f(args)-target). As Leonhard Euler would say, “Nothing takes place in the world whose meaning is not that of some maximum or minimum”. The smallest possible value for the function abs(x) is 0, so if the minimization succeeds, the result will be abs(f(args)-target)=0, that is, f(args)=target.

This is exactly what the first part of Quipu.goalSeek does:

static member goalSeek (target: float) (problem: Problem) =
    { problem with
        Objective =
            { new IVectorFunction with
                member this.Dimension = problem.Objective.Dimension
                member this.Value (args: float []) =
                    abs (target - problem.Objective.Value args)
            }
    }
    |> NelderMead.minimize

We convert the original objective function into a new objective, abs (target - problem.Objective.Value args), and we just let it rip.

There is a small problem with that approach, though. As an example, what would happen if we tried this?

fun x -> x * x
|> NelderMead.objective
|> NelderMead.goalSeek -10.0

The function fun x -> x * x is always positive, and has a minimum for x=0, f(0)=0. In other words, there is no value x such that f(x)=-10. I debated about how to handle that situation - should the result be a failure? As of this version, 1.1.0-beta1, Quipu will return the following result:

val it: SolverResult =
  Successful {
    Status = Suboptimal
    Iterations = 11
    Candidate = {
      Arguments = [|0.0|]
      Value = 0.0
      }
    Simplex = [|[|0.0|]; [|-0.0009765625|]|] 
    }

The solver declares the result Successful, but Suboptimal: the search completed properly, and the result is as close as we will ever get to the target value, but it is NOT exactly what was asked - It is the best we can do. I might change my mind (hence the beta1 release), but it feels better than the alternative.

A related issue ended up being less straightforward than what I expected. I initially thought that I could use a simpler termination rule than the regular minimization solver, and stop when the objective function value was sufficiently close to the target value. This would be much faster than the termination rule I use for the “regular” solver, which checks if all function values and arguments are within a certain tolerance. The issue, though, is that if there is no solution close to the target value, as in the previous example, then the solver will never terminate. This is obviously a problem, so I ended up using the original termination rule, at least for now. I might try to write an alternate version with an early exit if the solver has found a sufficiently good candidate.

Parting thoughts

Arguably, goalSeek is only a minor feature addition to Quipu. It is mainly a convenient shortcut, making something you could do manually by tinkering with the objective function a straightforward call. That being said, it is a useful function, in particular for financial calculations, and one I used regularly in my Excel days. And, as an added bonus, one thing it does that Excel doesn’t (if memory serves) is handle functions with more than one argument. Whether that would ever be useful is up for debate, but it is a feature!

Anyways, as always, I am all ears if you have feedback or thoughts. In the meantime, I wish you wonderful holidays! And again, check out the other posts in the F# Advent series, and a big thanks to Sergey Tihon for organizing F# Advent again this year.

Count distinct items with the CVM algorithm

2025-10-22T00:00:00+00:00

I came across this post on the fediverse the other day, pointing to an interesting article explaining the CVM algorithm. I found the algorithm very intriguing, and thought I would go over it in this post, and try to understand how it works by implementing it myself.

The CVM algorithm, named after its creators, is a procedure to count the number of distinct elements in a collection. In most situations, this is not a hard problem. For example, in F#, one could write something like this:

open System

let rng = Random 42
let data = Array.init 1_000_000 (fun _ -> rng.Next(0, 1000))
data
|> Array.distinct
|> Array.length

val it: int = 1000

We create an array filled with 1 million random numbers between 0 and 999, and directly extract the distinct values, which we then count. Easy peasy.

However, imagine that perhaps your data is so large that you can’t just open it in memory, and perhaps even the distinct items you are trying to count are too large to fit in memory. How would you go about counting the distinct items in your data then?

The CVM algorithm solves that problem. In this post, we will first write a direct, naive implementation of the algorithm as presented in the paper, and try to discuss why it works. Then we’ll test it out on the same example used in the article, counting the words used in Hamlet.

Naive F# implementation of the CVM algorithm

Rather than discussing the pseudo-code presented in the paper, which uses dense notation, we will present directly our F# implementation. This implementation is rather inefficient, and could easily be optimized - our goal was to follow the pseudo-code closely, to quickly get a testable version going.

Without further ado, here is our implementation:

let cvm (rng: Random) memorySize stream =

    let memory = Set.empty
    let proba = 1.0

    ((memory, proba), stream)
    ||> Seq.fold (fun (memory, proba) item ->
        let memory = memory |> Set.remove item
        let memory =
            if rng.NextDouble () < proba
            then memory |> Set.add item
            else memory
        let memory, proba =
            if memory.Count = memorySize
            then
                memory
                |> Set.filter (fun _ ->
                    rng.NextDouble () < 0.5
                    ),
                proba / 2.0
            else memory, proba
        memory, proba
        )
    |> fun (memory, proba) ->
        float memory.Count / proba

The code is not overly complicated. It takes 3 inputs:

stream: the data we are counting items from (a sequence),
memorySize: the number of items we can keep in memory,
rng: a random number generator.

At a high level, the algorithm goes over the stream item by item, and adds new items to a set of distinct items, memory. However, instead of just adding them one by one and counting how many we have at the end (as one would typically do), it does something different. When the memory is full, that is, we have reached memorySize, it flushes roughly half of the items from memory at random (hence the random number generator), and starts a new round, filling in memory again, but keeping new items with a probability of one half only. The algorithm keeps going until the end of the stream is reached, halving the probability that an item is kept each time the memory is filled, that is, each time a round completes.

Before considering why this might even work, let’s test it out on our original data. We will use a memorySize of 100: at any given time we will keep track of only 100 distinct items at most:

cvm (Random 0) 100 data

val it: float = 1056.0

We do not get an exact count. Instead of the correct value, 1000, we get an estimate, 1056 (about 6% off). The part that is interesting is that to estimate the count of these 1000 items, we only had to keep track of up to 100 items.

Note: the paper also discusses bounds on the estimate. We did not have the time or energy to look into that part, check out the article for details!

Why does it even work?

Let’s sketch out an argument. First, let’s consider the case where the algorithm terminates within round 0. In that case, we simply add distinct items one by one to the memory. If we don’t reach round 1, it means we never reached the condition memory.Count = memorySize, that is, we never filled the memory, and proba = 1. In that case, the algorithm is correct: our memory contains every distinct item, and, as proba = 1, the result float memory.Count / proba simply returns the count of distinct items.

Now imagine that the algorithm terminates in round 1, that is, we filled the memory during round 0, flushed half of it randomly, and started re-filling it, with proba = 0.5.

What is the probability then that an item shows up in memory when the algorithm terminates? We have 3 cases to consider:

The item is encountered during round 0, and not during round 1. In this case, it will be added to memory during round 0, and with probability 0.5, it is discarded when we start round 1, so there is a 0.5 probability that it ends in memory when the algorithm finishes during round 1.
The item is encountered during round 0 and during round 1. During round 1, when we encounter the item, we remove it from memory, and add it back with a probability of 0.5, so again there is a 0.5 probability that the item ends up in memory when the algorithm terminates during round 1.
The item is encountered during round 1, and not round 0. We simply add the item with a probability of 0.5 to memory during round 1.

In other words, if the algorithm terminates during round 1, any distinct item has a probability of 0.5 to be listed in memory when we terminate.

Now if we have N distinct items in our stream, how many distinct items should we observe in memory when the algorithm terminates? Each item has a probabiliy of 0.5 to be there, so on average we should have N * 0.5 items listed. Or, conversely, if we end up with M items in memory, this means we had around M / 0.5 distinct items in the overall stream.

With a bit of hand-waving, the same reasoning can be applied to the case where the algorithm terminates in k rounds. In that case, by construction, each item has a probability of 0.5 ^ k of being listed in memory in the end, which leads to the complete algorithm.

Hamlet

The Quanta magazine article mentions applying the algorithm to the text of Hamlet, which I thought would be a fun experiment to reproduce. Of course, Hamlet is not large enough to warrant using such a jackhammer, but… it is fun! So let’s do this.

First, we need the book as a text file, which fortunately enough is available on Project Gutenberg. Let’s download that as a string, using FsHttp:

open FsHttp

let hamlet =
    http {
        GET @"https://www.gutenberg.org/files/1524/1524-0.txt"
        }
    |> Request.send
    |> Response.toText

Next, we need to break that string into words, which we will lowercase to avoid double counting capitalized words. Time for some Regular Expressions:

let pattern = @"(\w+)"
let regex = Regex(pattern)

let words =
    hamlet
    |> regex.Matches
    |> Seq.cast<System.Text.RegularExpressions.Match>
    |> Seq.map (fun m -> m.Value.ToLowerInvariant())
    |> Array.ofSeq

We can directly count the words we have in this array, thereby also proving that we don’t really need the CVM artillery for this case:

words.Length
val it: int = 33176

words
|> Array.distinct
|> Array.length
val it: int = 4610

For the record, the article mentions 3,967 distinct words - they were perhaps more careful than I was removing extraneous information. Anyways, let’s see what CVM says:

cvm (Random 0) 100 words
val it: float = 4608.0

CVM produces an estimate of 4608 distinct words, where the correct value is 4610 - not bad at all! Note that depending on the seed you use for the random number generator, your mileage may vary.

Parting thoughts

Like the original poster, I was super excited by this algorithm. It’s not that I really need it for practical purposes (although I might some day), but more that I find the approach very interesting. I understand why the math works, and still, it feels like a clever magic trick.

My implementation is clearly not optimized at all. I struggled a bit with the notation in the paper, and aimed for clarity. As an obvious example, instead of removing and maybe re-adding an item, it is very likely faster to check first if the item is already listed, and perform a single set operation then. Using a HashSet instead of a Set would probably be faster as well. But again, speed was not my goal here!

Finally, I think there is a minor bug in my implementation. If the number of distinct items equals the size of memory, the algorithm will terminate in round 0, and memory should contain exactly the distinct items. However, what happens is that the condition memory.Count = memorySize is triggered, flushing half the items at random. Just like speed optimizations, I’ll leave that as an exercise to the interested reader!

And that’s where I will leave things for today, hope you found the approach as interesting as I did!

Study notes: Softmax function

2025-10-08T00:00:00+00:00

I was thinking recently about ways to combine prediction models, which lead me to the Softmax function. This wasn’t my first encounter with it (it appears regularly in machine learning, neural networks in particular), but I never took the time to properly understand how it works. So… let’s take a look!

What is the Softmax function

The Softmax function normalizes a set of N arbitrary real numbers, and converts them into a “probability distribution” over these N values. Stated differently, given N numbers, Softmax will return N numbers, with the following properties:

Every output value is between 0.0 and 1.0 (a “probability”),
The sum of the output values equals 1.0,
The output values ranking is the same as the input values.

In F#, the standard Softmax function could be implemented like so:

let softmax (values: float []) =
    let exponentials = values |> Array.map exp
    let total = exponentials |> Array.sum
    exponentials |> Array.map (fun x -> x / total)

We convert all the input values to their exponentials, which guarantees that all of them are strictly positive, and we compute their relative weight. Note that I used an array here, so we can operate on arbitrary many numbers.

Let’s check how that works out on the example from the Wikipedia page:

let input = [| 1.0; 2.0; 8.0 |]
let output = input |> softmax
val output: float array = [|0.0009088005554; 0.002470376035; 0.9966208234|]

The 3 numbers (1, 2, 8) have been converted to (approximately) (0.001, 0.002, 0.997). The sum of the converted value is 1, and their ranking is the same as the ranking of the original 3 values.

And, because the exponential function will convert any number to a strictly positive value, this would work as well if some or all our inputs were negative. As an example:

[| -1.0; 1.0; 3.0 |] |> softmax

Softmax converts (-1, 1, 3) into (0.016, 0.117, 0.867), which are still all between 0 and 1, sum to 1, and properly ranked.

While Softmax preserves the ranking of the input values, it distorts the spread between values. A variation of the standard Softmax function exists, where a parameter b (the base) controls how much the output values should be concentrated on the largest inputs, or evened out:

let generalSoftmax (b: float) (values: float []) =
    let exponentials =
        values
        |> Array.map (fun x -> exp (b * x))
    let total = exponentials |> Array.sum
    exponentials |> Array.map (fun x -> x / total)

Note how instead of
values |> Array.map exp,
we now use
values |> Array.map (fun x -> exp (b * x))

Using a value of b = 1 is equivalent to using the standard Softmax function. A value of b > 1 will amplify the weight of larger values, and a value of b < 1 will soften the difference, with the extreme case b = 0, which removes any differences:

let input = [| 1.0; 2.0; 8.0 |]
input |> generalSoftmax 1.0
// [| 0.001; 0.002; 0.997 |]
input |> generalSoftmax 0.5
// [| 0.028; 0.046; 0.926 |]
input |> generalSoftmax 2.0
// [| 0.000; 0.000; 0.999 |]
input |> generalSoftmax 0.0
// [| 0.333; 0.333; 0.333 |]

If you push the idea further, with b < 0, the ranking becomes reversed.

What is the Softmax function useful for

Being able to reduce a set of numbers to positive values that sum to 1 is very convenient. In particular it is very handy for multi-class classification in machine learning. A multi-class classification model is a prediction model that given an observation, tries to determine which of 3 or more classes the observation belongs to.

This is by contrast to a binary classifier, where the model only has to decide between 2 classes, for instance “is this a hot dog?” (or not). Such a model, given a picture, will likely produce a score, indicating how confident it is that the picture is of a hot dog. Using Softmax, we could train different binary models for different classes (hot dog, pizza, …), and convert the scores across all classes to (pseudo) probabilities using the Softmax function.

A similar approach appears in neural networks classifiers, where the last layer will be a Softmax function, converting the output values of perceptrons into a (pseudo) distribution over classes.

Beyond machine learning, the Softmax function solves an interesting problem: converting any set of numbers into proportions. Apportioning a quantity based on a (positive) measure is easy, because we can directly compute proportions. As a contrived example, if we wanted to split profits between people based on hours worked, we could simply allocate based on hours worked / total hours worked. However, allocating based on some value that is not necessarily positive or doesn’t have a lower bound doesn’t work, because some proportions will be negative, and some might be greater than 1. That being said, I can’t think of a practical case where I would use Softmax to address that issue!

Interesting properties and semi-random thoughts

The Softmax function has a few interesting mathematical properties, which are important in understanding how it transforms its input numbers.

The Softmax function is invariant under translation, but not invariant under scaling. In less pompous terms, this means that

shifting all the inputs by the same value produces the same result,
how spread out the numbers are matters, or, stated differently, units matter.

As an example, the inputs (0,1), (1,2), or (100,101) produce the same output through Softmax (invariant under translation):

softmax [| 0.; 1. |]
// [| 0.269; 0.731 |]
softmax [| 100.; 101. |]
// [| 0.269; 0.731 |]

Conversely, the inputs (0.0, 0.1, 0.2) and (0.0, 1.0, 2.0) do not produce the same output through Softmax, even though the second one has the same proportions, just scaled up a factor 10:

softmax [| 0.0; 0.1; 0.2 |]
// [| 0.301; 0.332; 0.367 |]
softmax [| 0.0; 1.0; 2.0 |]
// [| 0.090; 0.245; 0.665 |]

What drives how evenly the outputs of Softmax are spread out is mainly the absolute difference between the smallest and largest input values, not how large or small these values are. This means that using Softmax requires picking consistent units, and that equivalent units (ex: kilogram vs pound) will not produce identical results.

One thing that bugged me in the Wikipedia entry for Softmax was the statement “the Softmax function converts real numbers into a probability distribution”. In my view, the Softmax function is a very useful normalization technique, which produces numbers that happen to look like a probability distribution, but have no reason to correspond to the probability of events occurring.

As an obvious example, if we start from a well-formed, valid distribution, Softmax will produce a different set of values:

[| 0.2; 0.3; 0.5 |] |> softmax
// [| 0.289; 0.320; 0.390 |]

I haven’t checked if this is always true, but applying Softmax repeatedly to a distribution appears to converge to an even distribution, where each class gets the same weight:

[| 0.1; 0.2; 0.7 |]
|> Seq.unfold (fun probas -> Some (probas, softmax probas))
|> Seq.take 10
|> Seq.toArray
|> Array.iter (fun probas ->
    printfn $"%.3f{probas[0]}, %.3f{probas[1]}, %.3f{probas[2]}")

100, 0.200, 0.700
255, 0.281, 0.464
307, 0.315, 0.378
324, 0.327, 0.348
330, 0.331, 0.338
332, 0.333, 0.335
333, 0.333, 0.334
333, 0.333, 0.334
333, 0.333, 0.333
333, 0.333, 0.333

One way to look at this is that Softmax will first take any numbers and normalize them into proportions, respecting the original input ranking. Applying Softmax again will progressively smooth out the differences, and converge to an uninformative distribution. Whether this is of any practical use or not I don’t know, but I found it interesting.

Editing a list in Avalonia FuncUI

2025-09-26T00:00:00+00:00

In my previous post, I took a look at handling the selected item in an Avalonia ListBox with FuncUI, so the ListBox properly reflects what item is currently selected, based on the current State. In this post, I will go into another aspect of the ListBox that gave me some trouble, handling dynamic updates to the list of items. Once again, this post is nothing particularly fancy, and is mainly intended as notes to myself so I can remember later some of the steps I took.

First, what do I mean by dynamic updates? The examples in the FuncUI docs go over displaying a list of items that do not change. However, in many real world applications, you would want to be able to change that list, in a couple of different ways:

adding or removing an item,
editing the selected item,
filtering the contents of the list.

While editing an item is not particularly complicated in general, and follows the standard Elmish / MVU pattern, one case that tripped me up was editing an item in a fashion that impacts how it is rendered in the list, such as changing the display name of the item. I will go over the solution I landed on, but I am not sure this is the best way to do it, so if anybody can suggest a better approach, I would be very interested in hearing about it!

Anyways, let’s dig into it, and build a simple example illustrating all of these features. The final result will look something like this, and, in case you are impatient, you can find the full code example here.

We’ll start from where we left off last time, with a State that contains a collection of Items, and the currently selected item:

type Item = {
    Id: Guid
    Name: string
    }

type State = {
    Items: Item []
    SelectedItemId: Option<Guid>
    }

Adding and Removing items

Let’s start with adding and removing items to the State. First, we will need messages for this:

type Msg =
    | SelectedItemIdChanged of Option<Guid>
    | CreateItem
    | DeleteItem of Guid

The corresponding update of the State is fairly straightforward:

let update (msg: Msg) (state: State): State * Cmd<Msg> =
    match msg with
    | SelectedItemIdChanged selection ->
        { state with
            SelectedItemId = selection
        },
        Cmd.none

    | CreateItem ->
        let item = {
            Id = Guid.NewGuid()
            Name = "NEW ITEM"
            }
        { state with
            Items =
                state.Items
                |> Array.append (Array.singleton item)
            SelectedItemId = Some item.Id
        },
        Cmd.none

    | DeleteItem itemID ->
        { state with
            Items =
                state.Items
                |> Array.filter (fun item -> item.Id <> itemID)
            SelectedItemId = None
        },
        Cmd.none

When creating an Item, we simply pre-pend it to the list, and set the SelectedItemId to the corresponding Id, so it will be selected by default. When deleting an Item, we filter out the corresponding Id from the list, set the selection to None, and we are done.

What about the view? By definition, a new item does not belong to the list yet. Let’s add a button at the top of the list to create items:

let view (state: State) dispatch =
    DockPanel.create [
        DockPanel.children [

            TextBlock.create [
                TextBlock.dock Dock.Top
                TextBlock.text "Items"
                TextBlock.fontSize 16
                ]

            Button.create [
                Button.dock Dock.Top
                Button.content "Create New"
                Button.onClick (fun _ ->
                    CreateItem
                    |> dispatch
                    )
                ]

            ListBox.create [
                // same as before
                ]
                // We assign a unique key each time,
                // forcing a refresh of the ListBox.
                |> View.withKey (Guid.NewGuid().ToString())
            ]
        ]

Note the usage of View.withKey after ListBox.create. Without that piece of code, the UI freezes when an item is added to State.Items. Why is that piece necessary? I am not sure. The issue disappears if we do not set the SelectedItemId in the update function, so I suspect this triggers an infinite update loop somehow. Anyways, adding View.withKey fixes the issue. As I understand it, View.withKey assigns an explicit key to the corresponding UI element, so the view element gets redrawn when the key changes, instead of checking for changes in the backing State. In our example, we assign a new Guid as a key, which is a hack: anytime the view is called, a new key is created, and the ListBox is re-drawn from scratch. This is clearly not pretty and might also not be a great idea performance-wise, but… that’s the only way I found to achieve my goal.

How about deletions? We could add a button at the top of the list, in a fashion similar to what we did for additions, and delete the selected Item that way. However, we will do something else instead, and add a Delete button to the Item displayed in the ListBox instead, which reduces the interactions needed.

Let’s do that, with a DataTemplate in the ListBox:

ListBox.create [
    // Omitted, same as before
    ListBox.itemTemplate (
        DataTemplateView<Item>.create(fun item ->
            DockPanel.create [
                DockPanel.children [
                    Button.create [
                        Button.dock Dock.Right
                        Button.fontSize 8
                        Button.content "X"
                        Button.onClick (
                            (fun _ ->
                                item.Id
                                |> DeleteItem
                                |> dispatch
                            ),
                            SubPatchOptions.Always
                            )
                        ]
                    TextBlock.create [
                        TextBlock.text $"{item.Name}"
                        ]
                    ]
                ]
            )
        )
    ]

The DataTemplateView allows us to define a template and apply it to each Item in the list, creating a “custom” view to render the list elements. We could (and probably should) extract that view into a separate function, but for the sake of simplicity, we won’t do so here.

And with that we are done! We have a ListBox, bound to an Item collection on the State, with proper selection and the ability to add and delete items.

Editing Items

Now that we can add / remove / select Items, let’s look into editing them. First, we need something to edit, so we will expand our Item and add a Description field, a string, and make the corresponding changes to the code:

type Item = {
    Id: Guid
    Name: string
    Description: string
    }

We can now create a basic view for the selected item:

module SelectedItem =

    let view (item: Item) dispatch: IView =
        DockPanel.create [
            DockPanel.children [
                StackPanel.create [
                    StackPanel.children [
                        TextBlock.create [
                            TextBox.text item.Name
                            ]
                        TextBox.create [
                            TextBox.text item.Description
                            ]
                        ]
                    ]
                ]
            ]

… and bolt that view to the main view, on the right of the ListBox:

let view (state: State) (dispatch: Msg -> unit): IView =
    // main dock panel
    DockPanel.create [
        DockPanel.margin 10
        DockPanel.children [
            // left section: item selector
            Border.create [
                Border.dock Dock.Left
                Border.width 200
                Border.child (
                    Selector.view state dispatch
                    )
                ]
            // left section: end

            // right section: selected item
            Border.create [
                Border.child (
                    state.SelectedItemId
                    |> Option.bind (fun selectedItemID ->
                        state.Items
                        |> Array.tryFind (fun item ->
                            item.Id = selectedItemID
                            )
                        )
                    |> function
                    | None ->
                        TextBlock.create [
                            TextBlock.text "Select an Item"
                            ]
                        :> IView
                    | Some item ->
                        SelectedItem.view item dispatch
                    )
                ]
            // right section: end
            ]
        ]

All we need at that point is to propagate name or description changes, which is easily done. First, we add 2 new messages:

type Msg =
    // omitted, same as before
    | NameChanged of string
    | DescriptionChanged of string

Next, we modify the update function accordingly:

let update (msg: Msg) (state: State): State * Cmd<Msg> =
    match msg with
    // omitted, same as before
    | NameChanged name ->
        match state.SelectedItemId with
        | None -> state, Cmd.none
        | Some selectedId ->
            let items =
                state.Items
                |> Array.map (fun item ->
                    if item.Id = selectedId
                    then { item with Name = name }
                    else item
                    )
            { state with Items = items },
            Cmd.none
    | DescriptionChanged description ->
    // omitted, similar to above

And finally, we emit messages via events in the view:

module SelectedItem =

    let view (item: Item) dispatch: IView =
        DockPanel.create [
            DockPanel.children [
                StackPanel.create [
                    StackPanel.children [
                        TextBox.create [
                            TextBox.text item.Name
                            TextBox.onTextChanged (fun text ->
                                text
                                |> NameChanged
                                |> dispatch
                                )
                            ]
                        TextBox.create [
                            TextBox.text item.Description
                            TextBox.onTextChanged (fun text ->
                                text
                                |> DescriptionChanged
                                |> dispatch
                                )
                            ]
                        ]
                    ]
                ]
            ]

And we are done! We can now change the name or description, with the name displayed in the ListBox updating live as we type, while retaining the selected item.

Dynamic filtering

One last thing for the road. Suppose that, instead of always showing all the items in the list, we wanted to be able to search or filter. How could we go about that?

Let’s add a simple version in our example, allowing users to search for items whose name contain certain substrings. To do that, we will add a TextBox to the UI, and filter down dynamically the items displayed in the ListBox based on whether or not they match the search string entered in the TextBox.

First, let’s modify the State, and add a SearchString field, as well as a property VisibleItems:

type State = {
    Items: Item []
    SelectedItemId: Option<Guid>
    SearchString: string
    }
    with
    member this.VisibleItems =
        this.Items
        |> Array.filter (fun item ->
            item.Name.Contains this.SearchString
            )

We need to track down changes made to the search string, let’s add a Message for that:

type Msg =
    // omitted, same as before
    | SearchStringChanged of string

We can now add a TextBox above the ListBox, where the use can enter their search string, and, in a fashion similar to what we did for the Item Name and Description, we can handle that message in the update function. All that is left to do then is to bind the ListBox to the State.VisibleItems, instead of the raw Items collection:

ListBox.create [
    ListBox.dataItems (state.VisibleItems)
    // omitted, same as before
    ]

… and we are done! As you type a search string in the TextBox, the list of items on display adjusts on the fly, retaining only items with a matching name.

Parting thoughts

Getting a ListBox to behave the way I wanted it, properly maintaining the selected item highlighted, and handling editions, took me a bit of effort. The example I walked through details some of the steps I had to take to make it work, and it mostly works.

One minor issue I could not resolve is that when the list is long enough to require scrolling, selecting and editing an item way down the list causes an annoying flicker, and resets the scrollbar so the selected item becomes the last one visible in the list. I think the issue is that the entire list gets re-drawn when an edit occurs, losing the state of the scrollbar, causing it to scroll down just enough for the selected item to be visible. This is not the end of the world, but it is visually jarring. One direction I haven’t tried that could maybe help address it is using keys on the Item itself, perhaps tracking some unique version any time the selected item changed. If someone knows of a better way to handle this, I am all ears :)

One minor change I would probably do as well is extract all the messages that pertain to an update of the Item into their own group, something like:

type ItemChanged =
    | NameChanged of string
    | DescriptionChanged of string

type Msg =
    | ItemChanged of ItemChanged
    | SelectedItemIdChanged of Option<Guid>
    | CreateItem
    | DeleteItem of Guid
    | SearchStringChanged of string

This would allow some code simplification in the update function, at the expense of perhaps a harder to follow code flow, due to mapping of messages.

Finally, one thing I am not entirely clear about is the difference between View.withKey and View.createWithKey.

At any rate, this is where we will leave things for today!

You can find the completed, full code example here.

Handling list view selection in Avalonia FuncUI

2025-08-20T00:00:00+00:00

After a brief summer hiatus, I am back! I wish this pause was due to exciting vacation plans, but unfortunately, the main reason was that I had a gas leak in my apartment, which ended up disrupting my routine quite a bit. Anyways, I am looking forward to enjoying simple pleasures of life like warm showers or home cooking again hopefully soon.

Today’s post is not anything fancy. I have been working on deskop applications in F# recently, using Avalonia FuncUI, and getting the ListBox to do what I wanted it to do was a bit more involved than I expected. This post is intended mainly as notes to myself, documenting some of the details that tripped me up.

Today’s post will focus on handling selection. I intend to have a follow-up post soon, covering dynamic updates. Until that is published, you can take a look at the full code example on GitHub.

The `ListBox` in Avalonia FuncUI

The ListBox in Avalonia is a control intended to display a collection of items, and track which item is selected. The documentation gives a pretty good description of its basic usage in FuncUI:

ListBox.create [
    ListBox.dataItems [ "Linux"; "Mac"; "Windows" ]
    ListBox.selectedItem state.os
    ListBox.onSelectedItemChanged (fun os -> dispatch ChangeOs)
]

ListBox.dataItems expects a collection of Items to display, which would typically coming from the State,
ListBox.onSelectedItemChanged tracks changes of selection,
ListBox.selectedItem drives which Item should visually appear as selected in the list.

I will focus only on single-item selection in this post. Multi-selection is also supported, but I haven’t dug into that very much, because this wasn’t something I needed. The use case I am after is very basic:

Present a list of items to the user in a ListBox,
Allow the user to edit the item currently selected,
Highlight the item currently selected in the ListBox.

As it turns out, this was less straightforward than I expected. Let’s dig into it!

Displaying the Selected Item

The first struggle I had was with handling item selection for “complex” items. In the documentation example mentioned previously, the items are simple strings. What if our items are more complex entities?

To simplify the question of identity, I decided to assign a unique ID, a Guid, to each item. In this example, we will work with the simplest possible Item, a record that looks like this:

type Item = {
    Id: Guid
    Name: string
    }

Our State then has a collection of Items, and maintains which item is selected, by tracking the corresponding ID as an Option<Guid>, so we can also handle the situation where no item is selected:

type State = {
    Items: Item []
    SelectedItemId: Option<Guid>
    }

We can then add a ListBox to the view, like so:

let view (state: State) dispatch =
    ListBox.create [
        ListBox.dataItems (state.Items)
        ListBox.selectedItem (
            match state.SelectedItemId with
            | None -> null
            | Some itemId ->
                state.Items
                |> Array.tryFind (fun item -> item.Id = itemId)
                |> function
                    | None -> null
                    | Some item -> box item
            )
        ]

The selectedItem part tripped me up quite a bit. The issue, as I understand it, is that the ListBox is not generic, but operates on objects. As an example, the signature of ListBox.selectedItem offers a hint of that:

static member selectedItem: 
    item: obj 
        -> IAttr<'t> (requires :> SelectingItemsControl)

As a result, we need to convert our SelectedItemId, an Option<Guid>, to either a null if nothing is selected, or box the selected Item otherwise, converting it to a System.Object.

Without boxing, the UI will only reflect the item selected by the user, by clicking on items on screen. What boxing buys us is that if we change the SelectedItemId on the State, via code, the change will be properly reflected visually on the ListBox. As an example, in our init function, we can pre-select the first item of the list on initialization, like so:

let init (): State * Cmd<Msg> =
    let items =
        Array.init 10 (fun i ->
            {
                Id = Guid.NewGuid()
                Name = $"Item {i}"
            }
            )
    {
        Items = items
        SelectedItemId = Some (items.[0].Id)
        Filter = ""
    },
    Cmd.none

Changing the Selected Item

In a fashion similar to how we handle highlighting the selected item, we can handle changes in selection sending the corresponding ID, an Option<Guid>, to the State. We create a message for that purpose, like so:

type Msg =
    | SelectedItemIdChanged of Option<Guid>
    // | ... other messages

This allows us to signal that nothing is selected (None), or that some ID has been selected (Some itemID). To signal that the selected item has changed, we use ListBox.onSelectedItemChanged, which, as in the previous example, expects an object:

static member onSelectedItemChanged:
    func            : (obj -> unit) *
    ?subPatchOptions: SubPatchOptions
        -> IAttr<'t> (requires :> SelectingItemsControl))

I might have over-complicated things a little, but below is the code I ended up with. We check if the selected object is indeed of type Item, and if so, if its ID is different from the selected one. Otherwise, no message is needed:

let view (state: State) dispatch =
    ListBox.create [
        // same as before, omitted for brevity
        ListBox.onSelectedItemChanged (
            (fun selected ->
                match selected with
                | :? Item as selectedItem ->
                    match state.SelectedItemId with
                    | None ->
                        selectedItem.Id
                        |> Some
                        |> SelectedItemIdChanged
                        |> dispatch
                    | Some currentlySelectedId ->
                        if currentlySelectedId <> selectedItem.Id
                        then
                            selectedItem.Id
                            |> Some
                            |> SelectedItemIdChanged
                            |> dispatch
                        else ignore ()
                | _ ->
                    None
                    |> SelectedItemIdChanged
                    |> dispatch
            ),
            SubPatchOptions.Always
            )
        ]

The SubPatchOptions.Always is possibly un-necessary, but after having been bitten a couple of times with closures having unanticipated effects in events, I have become a little paranoid!

Parting thoughts

Part of me is wondering what it would take to make a generic version of the ListBox (or other Avalonia controls). In the end, the code I wrote does the job, but it feels a bit more noisy than it should.

Anyways, that’s where I will leave things for today! I plan on a follow up soon, going over dynamically updating a ListBox, to perform actions such as:

Adding an Item to the ListBox,
Deleting an Item from the ListBox,
Changing the name of an Item in the ListBox,
Dynamically filtering the contents of the ListBox.

I am also hoping to follow up with a TreeView example. There is just one problem - I still haven’t gotten it to work the way I want it to :) If the ListBox was a bit tricky, the TreeView feels like the boss fight of working with collections within Avalonia FuncUI.

In the meantime, you can get a preview of what is coming next here, with the full ListBox code example on GitHub. Warning: this repository is my playground where I experiment with various controls and explore ideas, so it is a little messy, don’t judge too harshly!

Releasing Quipu version 1.0.0, a .NET Nelder-Mead solver

2025-07-23T00:00:00+00:00

On February 25, 2023, I made the initial commit to Quipu. I needed a Nelder-Mead solver in .NET, and couldn’t find one, so I started writing my own. Today, I am happy to announce version 1.0.0 of Quipu!

What does it do?

Quipu takes in a function, and searches for the arguments that minimize (or maximize) the value of that function. This is a problem that arises in many areas (curve fitting, machine learning, finance, optimization, …).

Let’s demonstrate on a simple example, rather than go into a lengthy explanation. Imagine that we have a fictional factory, where we produce Widgets:

We sell Widgets for $12 per unit
Producing a Widget costs $5 per unit
Shipping widgets: the more Widgets we produce on a day, the further we have to ship to reach customers and sell them. Shipping n Widgets costs us $0.5 * n * n. As a result, the total transportation cost increases rapidly. Shipping 1 Widget would cost us half a dollar only, whereas 10 Widgets would cost us $50 total.

We could represent this fictional model in C# like so:

public class ProfitModel
{
    public static double ProductionCost(double volume)
    {
        return 5 * volume;
    }
    public static double TransportationCost(double volume)
    {
        return 0.5 * (volume * volume);
    }
    public static double Revenue(double volume)
    {
        return 12 * volume;
    }
    public static double Profit(double volume)
    {
        return
            Revenue(volume)
            - ProductionCost(volume)
            - TransportationCost(volume);
    }
}

How many widgets should we produce, if we wanted to maximize our daily profit?

Let’s ask Quipu:

using Quipu.CSharp;

var solverResult =
    NelderMead
        .Objective(ProfitModel.Profit)
        .Maximize();

if (solverResult.HasSolution)
{
    var solution = solverResult.Solution;
    Console.WriteLine($"Solution: {solution.Status}");
    var candidate = solution.Candidate;
    var args = candidate.Arguments;
    var value = candidate.Value;
    Console.WriteLine($"Profit({args[0]:N3}) = {value:N3}");
}

The answer we get from Quipu is:

Solution: Optimal
Profit(7.000) = 24.500

If you lean more towards F#, you could solve the same problem using a pipeline, like so:

let profit (production: float) =
    let productionCost = 5.0 * production
    let transportCost = 0.5 * (production ** 2.0)
    let revenue = 12.0 * production
    revenue - productionCost - transportCost

profit
|> NelderMead.objective
|> NelderMead.maximize

While not particularly realistic, this problem hopefully gives a sense for where Quipu can be useful. And, a word of caution, Quipu is not a magic silver bullet. It only handles functions that take in one or more floating point arguments, and return a floating point value. It is also not guaranteed to find the best solution: it could potentially return a good solution that is not the absolute best (the global optimum), or even occasionally fail to find a solution.

What’s next?

Getting a working version of the algorithm was fairly quick. Putting together an API that was reasonably pleasant to use, from F# and C#, took some effort. Making it robust and reasonably fast also took some iterations.

But I think it’s good enough to ship now! I am sure it can be improved, but I have been using it quite a bit now, and it works reasonably well, at least for my purposes.

If you are interested in trying it out, it’s available on Nuget. Just run dotnet add package Quipu --version 1.0.0, and give it a spin! And let me know if you find bugs (the code is on GitHub), or have thoughts on how to make it better. I built it to solve a problem I had, and so unsurprisingly it works pretty well for me, but I would love to hear if there is something I could do to make it more convenient for you or others!

Is there a cost to try catch blocks?

2025-07-09T00:00:00+00:00

I spent some time revisiting my solver library Quipu recently, looking in particular at improving the user experience when the algorithm encounters abnormal situations, that is, when the objective function could throw an exception. This in turn got me wondering about the performance cost of using try ... catch blocks, when the code does not throw any exception.

Based on a quick internet search, the general wisdom seems to be that the cost is minimal. However, Quipu runs as a loop, evaluating the same function over and over again, so I was interested in quantifying how minimal that impact actually is.

For clarity, I am not interested in the case where an exception is thrown. Handling an exception IS expensive. What I am after here is the cost of just adding a try ... catch block around a well-behaved function.

So let’s check that out!

Benchmarking

We will start from the existing benchmark we have in the repository, using the Beale function, a classic test function for optimization problems:

[<Benchmark(Description="Beale function")>]
member this.BealeFunction () =
    beale
    |> NelderMead.objective
    |> NelderMead.withConfiguration solverConfiguration
    |> NelderMead.startFrom (Start.around [ 4.5; 4.5 ])
    |> NelderMead.solve

The details of the Beale function are not particularly important here. We use it because it should cause the solver to do a bit of work, and because it cannot throw:

let beale (x, y) =
    pown (1.5 - x + (x * y)) 2
    +
    pown (2.25 - x + (x * pown y 2)) 2
    +
    pown (2.625 - x + x * pown y 3) 2

NelderMead.objective will transform that function into something the solver can work with, a “vectorized” function float [] -> float, like so:

type Vectorize () =
    static member from (f: (float * float) -> float) =
        { new IVectorFunction with
            member this.Dimension = 2
            member this.Value x = f (x.[0], x.[1])
        }

To evaluate the impact of a try ... catch block, we create an alternate method, NelderMead.safeObjective, which creates a “safe” vectorized function:

type Vectorize () =
    static member safeFrom (f: (float * float) -> float) =
        { new IVectorFunction with
            member this.Dimension = 2
            member this.Value x =
                try f (x.[0], x.[1])
                with | _ -> nan
        }

… and add a benchmark:

[<Benchmark(Description="Beale function, safe")>]
member this.BealeFunction_safe () =

    beale
    |> NelderMead.safeObjective
    |> NelderMead.withConfiguration solverConfiguration
    |> NelderMead.startFrom (Start.around [ 4.5; 4.5 ])
    |> NelderMead.solve

So what’s the verdict? After seeing the result of the first benchmark, I decided to run it a couple of times:

|----------------------- |---------:|---------:|---------:|---------:|
| 'Beale function'       | 18.44 us | 0.150 us | 0.442 us | 18.32 us |
| 'Beale function, safe' | 18.53 us | 0.101 us | 0.298 us | 18.44 us |

| Method                 | Mean     | Error    | StdDev   | Median   |
|----------------------- |---------:|---------:|---------:|---------:|
| 'Beale function'       | 18.32 us | 0.069 us | 0.202 us | 18.31 us |
| 'Beale function, safe' | 18.34 us | 0.207 us | 0.611 us | 18.16 us |

| Method                 | Mean     | Error    | StdDev   |
|----------------------- |---------:|---------:|---------:|
| 'Beale function'       | 18.26 us | 0.121 us | 0.357 us |
| 'Beale function, safe' | 18.75 us | 0.103 us | 0.303 us |

| Method                 | Mean     | Error    | StdDev   |
|----------------------- |---------:|---------:|---------:|
| 'Beale function'       | 18.12 us | 0.054 us | 0.160 us |
| 'Beale function, safe' | 18.69 us | 0.049 us | 0.143 us |

| Method                 | Mean     | Error    | StdDev   |
|----------------------- |---------:|---------:|---------:|
| 'Beale function'       | 18.14 us | 0.039 us | 0.115 us |
| 'Beale function, safe' | 18.45 us | 0.062 us | 0.184 us |

The try ... catch block version does run slower on average, but not by much. In the best case, we have a 0.1% degradation, in the worst, a 3.1% degradation, for an average performance degradation of 1.6%. So, a fairly minimal impact indeed.

As a side-note, for completeness, given that the results were pretty close, I modified the default Benchmark configuration, and increased both the number of invocations and iterations:

let config =
    DefaultConfig.Instance
        .AddJob(
            Job.Default
                .WithInvocationCount(100_000)
                .WithIterationCount(100)
                )

BenchmarkRunner.Run<Benchmarks>(config)
|> ignore

Parting thoughts

So where does this leave me? Besides pure curiosity, I ended up looking into this question because I have been bitten a few times by objective functions that could throw. This is uncommon for vanilla functions using only standard operators on floats. Typically, invalid inputs will result in a NaN, and Quipu handles that out of the box.

However, this can happen if your objective function relies on an external library. In my case, I hit that issue a couple of times using Quipu for Maximum Likelihood Estimation, like in this example. The objective function uses the Math.NET implementation of the LogNormal distribution, and the constructor LogNormal(mu, sigma) throws for negative values of sigma.

The proper way to handle that issue is by making sure the objective function cannot throw, and returns NaN for inputs were the function is not properly defined, like so:

let logLikelihood (mu, sigma) =
    if sigma < 0.0
    then nan
    else
        let distribution = LogNormal(mu, sigma)
        // do something with distribution

This is not particularly complicated, but it requires some understanding of how Quipu handles partial functions. As an alternative, I was considering adding a “safe mode” helper function, wrapping the objective function in a try ... catch block, along these lines:

type NelderMead private (problem: Problem) =
    static member safe (problem: Problem) =
        { problem with
            Objective =
                problem.Objective
                |> Vectorize.safe
        }

type Vectorize () =
    static member safe (vectorFunction: IVectorFunction) =
        { new IVectorFunction with
            member this.Dimension = vectorFunction.Dimension
            member this.Value (vector: float []) =
                try vectorFunction.Value vector
                with
                | _ -> nan
        }

With that option, you could run the solver in “safe” mode, bypassing any exception:

beale
|> NelderMead.objective
|> NelderMead.safe
|> ...

However, the more I think about it, the less I like this idea. Either

the objective function is safe in the first place, in which case you would get a tiny performance penalty for no benefit, or
the objective is not safe, in which case you would possibly get a massive performance hit, without any information surfaced about the exceptions that occurred.

The only benefit I could see is for quick-and-dirty exploration. But even in that case, I think it’s better to signal whatever exception might have occurred, and let the user guard the objective function accordingly. In other words, this safe function seems like a bad idea, potentially letting users do things they should not, without any meaningful feedback to avoid the problem - and I will be removing that code from the library!

Field notes on integrating a LLM in a Business Workflow

2025-07-02T00:00:00+00:00

For many reasons, I am not a fan of the current hype around Large Language Models (LLMs). However, a few months ago, I was asked to work on a project to evaluate using LLMs for a practical use case. I figured this would be an interesting opportunity to see by myself what worked and what didn’t, and perhaps even change my mind on the overall usefulness of LLMs.

In this post, I will go over some of the things I found interesting.

Caveat: I have a decent knowledge of Machine Learning, but this was my first foray into LLMs. As a result, this post should not be taken as competent advice on the topic. It is intended as a beginners’ first impressions.

Context

The client - let’s call them ACME Corp - produces and distributes many products all over the world. Plenty of useful information about these products, such as inventory or shipments, are available in a database. Unfortunately, most employees at ACME Corp have neither access nor a good enough grasp of SQL (or of the database itself) to make use of that information.

The thought then was to explore if, by using LLMs, we could give users a way to access that information, in their own language (“what is the current inventory of sprockets model 12345 in Timbuktu”), without the hurdle of writing complex SQL queries. And, because ACME Corp is international, “in their own language” is meant quite literally: the question could be asked in English, as well as in a wide range of other languages.

At a high level, we want something like this:

Given the time budget on the project, we did not have the option to fine-tune a model for our domain, and used a “stock” LLM.

SQL Injection As A Service

One decision we took early on was to not let the LLM write SQL Queries. The concern here was two-fold. First, the target database is complex, and without providing a lot of context to the LLM, we did not believe it could generate reasonable queries. Second, we were concerned about how wrong things could go, if we let users essentially run arbitrary SQL queries, potentially creating a Little Bobby Tables situation.

Instead, we decided to run pre-written queries. This reduces the risks, but also the usefulness of the system, because only a limited set of queries is supported.

This approach makes the task simpler: assuming for a minute that we know the query is about inventory levels, given a user request like, say:

what is the current inventory of sprockets model 12345 in Timbuktu

… we need to extract 2 pieces of information only:

ProductID: 12345
Location: Timbuktu

… which we can then use to run a query along the lines of, say:

SELECT InventoryLevel
FROM Inventory
WHERE ProductID = '12345'
AND Location = 'Timbuktu'

Stringly Typed Code

So how can we extract the 2 relevant pieces of information from the message? This is where we used the LLM, with prompts along the lines of:

In the following message, find the product number and location.  
Write the product number on one line and the location on one line, 
and nothing else.
Message: { message goes here }

This approach worked pretty well, with some caveats. One thing that proved challenging was getting outputs that were formatted consistently. From one run to the next, we would get results like this:

12345
Timbuktu

… but also, less often, perhaps like this:

Product: 12345, Location: Timbuktu

From the perspective of a human, both of these results are equally good. From a code standpoint, either would be fine, as long as the same prompt consistently produced results formatted the same way.

In our experience, achieving that type of consistency has been a challenge. Practically, this meant that quite a bit of code needed to be written to validate what came out of the LLM, and compensate for inconsistent formatting - hello Regex my old friend!

This strikes me as a general problem to integrate LLMs in a larger workflow. In the end, the LLM is a black box, which exposes a single function: it takes in a string, and returns a string. A typical workflow will involve steps that executes a piece of code, and require some set of arguments, with well-defined types (int, date, …). Without a reliable way for an LLM to produce structured outputs, it will be up to the developers to validate these outputs and convert them into the expected shape.

To be fair, the fact that extracting potential parameters from a piece of text worked was fairly impressive. It is also something that would have been very difficult to achieve without a LLM, especially in the context of requests that could be written in different languages. The surprising part was how it was possible to achieve something fairly complex with very limited effort, but it wasn’t possible to achieve something comparatively much simpler (format the responses consistently).

Selecting an Option

In the example above, I assumed that we knew what the intented query was. This is not the case in general: we need to determine what query is relevant, given the user request.

Our strategy here was to use the LLM to make that determination, with prompts along the lines of

Which option best describes the following message:  
Option 1: inventory for a product  
Option 2: shipment to a location  
Write the best option, and nothing else.  

Unsurprisingly, we ran into the same problem as with the parameters extraction. Getting usable, consistently formatted responses was a challenge, and required quite a bit of string fiddling.

Another thing I wish could be surfaced was any form of feedback on how reliable the decision was. What if there is no good option? What if 2 options seem a plausible fit, but it is difficult to decide which?

With a traditional Machine Learning model, you would get a probability distribution over the alternatives, because you would have explicitly trained a model to classify between these alternatives. Using an LLM for that task means re-applying a model that was trained to generate plausible text, and hope that it somehow works on your problem, too.

This also strikes me as a problem, because most non-trivial business workflows will contain some form of automated decision making, and a stock LLM does not seem well-suited for that task.

Reliability and Testing

Following the same train of thought, the response of a LLM is not deterministic. Running the same exact prompt multiple times is not guaranteed to produce the same results. This creates an issue: instead of a binary test (a feature works, or it doesn’t), we need to fall back to weaker statements (how often does the feature work as expected).

Our strategy here was to write a validation harness, using labeled examples. Instead of running the test once, we ran it numerous times, measuring the proportion of correct answers. As an example, we could validate the extraction of the product ID like this:

message: what is the current inventory of sprockets model 12345 in Timbuktu
expected: 12345
prompt: { insert prompt here}

Run the prompt 100 times, check how many times you get the expected answer, and you have a reliability measurement.

This is not a particularly novel idea: this is how you would go about validating a Machine Learning model in general. This allowed us to quantify how good a prompt was, and gave us a benchmark to compare prompt variations. Instead of anecdotal evidence (“I tried this prompt once and it seemed to work”), we could compare different prompts on the same task, and evaluate how much better (or worse…) they actually were.

Languages

So far, I focused on the parts that I found problematic. One positive surprise was how well a LLM handled different languages.

One goal was to accept requests in a variety of languages, and not just English. Our initial thought was to reduce everything to English, like so:

This is obviously fraught with issues, because we introduce a Telephone Game in our workflow. Unsurprisingly, the results were not very good, so we decided to try to bypass the translation step entirely, asking in English what the request was about, regardless of the language it was written in. And… it worked! Or, more accurately, it worked much better.

In hindsight, this makes sense. A LLM is trained on many pieces of text, and what language they are written in is not directly relevant. What matters is the tokens and their relationships, as observed in the training corpus. Thinking in terms of translation was me projecting how I think of documents and languages.

Anyways, the ability to skip translation and directly work off a piece of text in your own language, regardless of what the text is written in, is pretty powerful.

As a side benefit, skipping the translation was helpful in reducing the overall number of steps in the process. Any step in the workflow that can fail will mechanically increase the overall probability of failure, so the less steps, the better!

Parting thoughts

Overall, this experiment did not change my mind. What Large Language Models do is very impressive, but I find their usefulness limited, at least for my use cases. A LLM is fundamentally a black box that converts a string to a string, and does not offer much in terms of expressing a domain model. As a result, integrating a LLM in a workflow that involves interactions with code will require manual work to make sure the LLM output is converted to parameters that can be consumed downstream.

Stated differently, I can see their usefulness in scenarios where the inputs are text, and a human will supervise the process. Without fine-tuning a LLM for a specific domain task, a LLM can be useful in specific situations, and perform tasks that would be difficult to achieve writing code manually, but at a cost. If getting the correct answer reliably is important, a “stock” LLM will not be ideal. It can do complicated things easily, but in my limited experience, getting consistent, reliable results is hard.

Part of me believes that the appeal of LLMs is the old desire to be able to write code without having to deal with developers. Instead of going through a slow design and development process, just tweak a few prompts, and voilà! It works. However, in our example, most of the issues I described could be resolved with a different approach. Instead of letting a LLM try to figure out the topic or parameters, the user could be presented with a basic user interface to make these choices. This would be both be entirely reliable, and fairly cheap to implement.

One place where I can imagine a LLM being powerful in this case is generating a SQL query. However, doing that in an automated fashion is very dangerous. I can see that direction being viable as an assistant for a user who already has some knowledge of SQL (and can decide if a Query is plausible or dangerous), focusing less on the SQL part, and more with navigating a complex schema.

I suspect most of the problems I mentioned could be adressed by fine-tuning a LLM for the task at hand. This is arguably as complicated as writing code, but this would perhaps address another general issue I have with using a “stock” model. One definition of Machine Learning is as a program that learns, that is, that becomes mechanically better at performing a task as more data becomes available. When using a pre-existing LLM for a task, there is no learning whatsoever. If we keep using the same LLM, our workflow will see no improvements over time.

Maximum Likelihood estimation with Quipu, part 2

2025-06-11T00:00:00+00:00

In my previous post, I went over fitting the parameters of a Log-Normal distribution to a sample of observations, using Maximum Likelihood Estimation (MLE) and Quipu, my Nelder-Mead solver. MLE was overkill for the example I used, but today I want to illustrate some more interesting things you could do with MLE, building up from the same base setup.

Let’s do a quick recap first. I will be using the following libraries:

#r "nuget: MathNet.Numerics, 5.0.0"
#r "nuget: MathNet.Numerics.FSharp, 5.0.0"
#r "nuget: Plotly.NET, 5.0.0"
#r "nuget: Quipu, 0.5.2"

Our starting point is a sample of 100 independent observations, generated by a Log-Normal distribution with parameters Mu=1.3 and Sigma=0.3 (which describe the shape of the distribution), like so:

open MathNet.Numerics.Random
open MathNet.Numerics.Distributions

let mu, sigma = 1.3, 0.3
let rng = MersenneTwister 42
let duration = LogNormal(mu, sigma, rng)

let sample =
    duration.Samples()
    |> Seq.take 100
    |> Array.ofSeq

If we want to find a distribution that fits the data, we need a way to compare how well 2 distributions fit the data. The Maximum Likelihood function does just that: it measures how likely it is that a particular distribution could have generated a sample - the higher the number, the higher the likelihood:

let logLikelihood sample distributionDensity =
    sample
    |> Array.sumBy (fun observation ->
        observation
        |> distributionDensity
        |> log
        )

There are many distributions we could try to fit to a sample. If we assume that a Log-Normal distribution is what generated our observations, the problem becomes simpler: out of all the parameters Mu and Sigma that correspond to a valid Log-Normal distribution, which pair is the most likely to have produced what we observe?.

We can then make our log-likelihood function more specific, and use Quipu to find the parameters that maximize that function:

open Quipu

let logLikelihood sample (mu, sigma) =
    if sigma < 0.0
    then - infinity
    else
        let distribution = LogNormal(mu, sigma)
        let density = distribution.Density
        sample
        |> Array.sumBy (fun t ->
            t
            |> density
            |> log
            )

logLikelihood sample
|> NelderMead.objective
|> NelderMead.maximize

… which happens to return a solution of (1.31, 0.29), pretty close to the values we used to generate that sample, (1.3, 0.3).

Is this overkill?

I mentioned earlier that using MLE for this particular example was overkill. A Log-Normal distribution, as the name suggests, has the following property: if X follows a Log-Normal distribution, then Ln(X) follows a Normal distribution. The mean Mu and standard deviation Sigma of a Normal distribution can be estimated in a direct fashion from a sample, so we can get estimates for our Log-Normal by transforming the sample into logarithms, and using that transformed sample instead:

// convert to log
let logSample = sample |> Array.map log
// mu is the sample average
let muEstimate = logSample |> Array.average
// sigma is the average distance from the average
let sigmaEstimate =
    let sampleSize = sample |> Array.length
    logSample
    |> Array.sumBy (fun x -> 
        pown (x - mu) 2 / (float (sampleSize - 1))
        )
    |> sqrt
printfn $"%.2f{muEstimate}, %.2f{sigmaEstimate}"

1.32, 0.30

This is both simpler and faster than using Quipu and MLE. So… why use MLE?

First, while we can easily estimate the parameters of a Log-Normal, this is not the case for other distributions in general. The Log-Normal is a special case, where a shortcut exists. If we thought the observations were generated by something that was not a Log-Normal, say, a Gamma or a Weibull, the MLE approach would still work. All we would need is an expression for the likelihood of an observation, that is, the density of the distribution. As an added benefit, we would also immediately get an answer to the question “is the data I am looking at more likely to be generated by a Log-Normal, or by this other distribution?” just by comparing their log likelihoods.

In the next section, I will follow this train of thought further, and explore what other type of questions you could ask of your data using Maximum Likelihood Estimation.

Censored observations

So far, we looked into the straightforward estimation case, where we have a nice, clean sample of observations. Now let’s look into more interesting things you could do with Maximum Likelihood Estimation.

Imagine for a minute that instead of observing all the data, we had only partial observations. As an example, let’s imagine that we are observing things through a device / sensor that can only record values above a certain level.

Building on our original example, let’s say we have a limit, and if the true value is below that limit, we can’t observed what the actual value was, but only that there was an observation.

For instance, if that limit was 4, instead of the original sample, we would now have the following partial sample, where None denotes the case where we know there was a value, but we don’t have a record of it because it was below the limit:

let limit = 4.0

let partial =
    sample
    |> Array.map (fun obs ->
        if obs < limit
        then None
        else Some obs
        )

Instead of 100 observations, we only have 42 actual values to work with:

partial
|> Array.choose id
|> Array.length

So how could we estimate the parameters of the underlying Log-Normal?

The naive way to do this would be to ignore the fact that our dataset is censored, and work off just the clean observations, like so:

// don't do this!
partial
|> Array.choose id
|> LogNormal.Estimate

This runs just fine, and estimates the parameters to be Mu=1.60 and Sigma=0.16, pretty far off from the correct values. It is incorrect, because we are treating the sample as if it had been generated by a Log-Normal, but it hasn’t. It is a Log-Normal, which has been transformed by another function. Treating it as a regular Log-Normal sample has no reason to produce the correct estimates.

So what can we do? Maximum Likelihood hinges on having a function that can calculate the likelihood of any observation, let’s see if we can do that. We have 2 cases to consider here:

If the true observation was below the limit=4, we observe None. The likelihood to observe None for a Log-Normal is therefore the probability that a value is less than 4. This we can get using the so-called cumulative distribution function.

If the true observation was above the limit, we observe Some value. The likelihood to observe value is, like before, the density distribution function.

Let’s modify our likelihood function to represent that:

let logLikelihood sample (mu, sigma) =
    if sigma < 0.0
    then - infinity
    else
        let distribution = LogNormal(mu, sigma)
        let density = distribution.Density
        let cumulative = distribution.CumulativeDistribution
        let likelihood obs =
            match obs with
            | None -> cumulative limit
            | Some value -> density value
        sample
        |> Seq.sumBy (likelihood >> log)

This function will return the likelihood of any observation, and we can then re-use the same approach as before, using Quipu to maximize the log-likelihood:

partial
|> logLikelihood
|> NelderMead.objective
|> NelderMead.maximize

Quipu estimates Mu=1.33 and Sigma=0.29. It is not as good as what we got using the full sample, which is not a surprise, given that we have only 42 clean observations instead of 100 initially. Still, this is pretty close to the true values of 1.3 and 0.3, and definitely much better than what the “incorrect” estimation gave us!

You could use the exact same technique if the observations were recorded only up to a certain limit. In that case, instead of using the cumulative function, you would compute the likelihood of an observation being greater than the limit as 1 - cumulative(observation).

Unknown limit

In the previous case, we assumed that we knew what the limit was. What if we didn’t? Again, we can use Maximum Likelihood, we just need to specify a function that computes the likelihood of each observation, given the model we assume.

Here, the transformation is as simple as turning the limit into a parameter of the model:

let logLikelihood sample (limit, mu, sigma) =
    if sigma < 0.0
    then - infinity
    else
        let distribution = LogNormal(mu, sigma)
        let density = distribution.Density
        let cumulative = distribution.CumulativeDistribution
        let likelihood obs =
            match obs with
            | None -> cumulative limit
            | Some value ->
                if value < limit
                then - infinity
                else density value
        sample
        |> Seq.sumBy (likelihood >> log)

Instead of assuming that we know the value of the limit, we turn it into a third argument to the likelihood function. In essence, what we are now saying is “how likely is it that the data was generated using a Log-Normal with parameters Mu and Sigma, AND this particular value of limit?”

Most of the function remains the same, with one small change here:

| Some value ->
    if value < limit
    then - infinity
    else density value

We cannot have an observation below the limit. Therefore, we make the likelihood of that -infinity. This will force the search to avoid impossible values for limit.

And we are done! All we need to do next is search for a set of 3 values that maximize the likelihood, like so:

partial
|> logLikelihood
|> NelderMead.objective
|> NelderMead.startFrom (Start.around([ 0.0; 0.0; 1.0 ], 0.1))
|> NelderMead.maximize

Quipu proposes the following solution: limit=4.01, Mu=1.31 and Sigma=0.34, which is once again fairly close to the correct values.

I had to make one small adjustment to the Quipu setup to make this work. After setting the objective function, I direct Quipu to start the search around limit=0, Mu=0 and Sigma=1, within 0.1 of these 3 values.

The reasons are a bit technical. By default, Quipu will start its search around 0, or, if we are searching for 3 parameters, around 0, 0, 0. In most cases, starting around 0 works just fine, but this depends on the objective function. In our particular situation, it doesn’t, and causes the solver to terminate without finding a solution.

This was also a reminder that I need to revisit how Quipu surfaces solver issues to the user.

I haven’t worked out the details of what goes wrong exactly, but I believe the issue goes something like this. The default initial candidates for 3 parameters (the so-called simplex) ends up being these 4 candidates (see this file for details):

0.577, -0.577, -0.577
-0.577, 0.577, -0.577
-0.577, -0.577, 0.577
0.577, 0.577, 0.577

Now out of these 4 candidates, 2 already have “bad” starting values for Sigma (which should always be positive), at -0.577. This might not be the only problem, but we are certainly not giving the solver an easy starting point. So rather than using the defaults, we supply the solver with a starting point where none of the initial candidates is problematic, which addresses the issue. And… we are done.

Parting thoughts

I remember being introduced to Maximum Likelihood Estimation while I was still a student, and feeling very intimidated. As a result, I avoided the subject for a long time. I wish I hadn’t! I really enjoy how explicit the approach is: state what you believe the probability model to be, and find the parameters that are the most likely to have produced the observations you have.

My goal with this post was to illustrate how powerful and versatile the technique is. We started with a simple problem, estimating the parameters of a Log-Normal distribution on a sample. In this particular case, Maximum Likelihood Estimation was more complex than necessary. However, we were able to re-use essentially the same scaffold, with minor modifications, to tackle much more complicated cases like censored data. As long as our model involves distributions whose density or cumulative distribution can be evaluated, we can fit a model.

Anyways, this is where I will leave it today!

Maximum Likelihood estimation with Quipu, part 1

2025-05-28T00:00:00+00:00

Back in 2022, I wrote a post around using Maximum Likelihood Estimation with DiffSharp to analyze the reliability of a production system. Around the same time, I also started developing - and blogging about - Quipu, my F# implementation of the Nelder-Mead algorithm.

The two topics are related. Using gradient descent with DiffSharp worked fine, but wasn’t ideal. For my purposes, it was too slow, and the gradient approach was a little overly complex. This led me to investigate if perhaps a simpler maximization technique like Nelder-Mead would do the job, which in turn led me to develop Quipu.

Fast forward to today: while Quipu is still in pre-release, its core is fairly solid now, so I figured I would revisit the problem, and demonstrate how you could go about using Quipu on a Maximum Likelihood Estimation (or MLE in short) problem.

In this post, we will begin with a simple problem first, to set the stage. In the next installment, we will dive into a more complex case, to illustrate why MLE can be such a powerful technique.

The setup

Imagine that you have a dataset, recording when a piece of equipment experienced failures. You are interested perhaps in simulating that piece of equipment, and therefore want to model the time elapsed between failures. As a starting point, you plot the data as a histogram, and observe something like this:

It looks like observations fall in between 0 and 8, with a peak around 3.

What we would like to do is estimate a distribution that fits the data. Given the shape we are observing, a LogNormal distribution is a plausible candidate. It takes only positive values, which we would expect for durations, and its density climbs to a peak, and then decreases slowly, which is what we observe here.

Let’s create an F# script to illustrate the process, and get the dependencies out of way, loading first the libraries I will be using throughout this post.

#r "nuget: MathNet.Numerics, 5.0.0"
#r "nuget: MathNet.Numerics.FSharp, 5.0.0"
#r "nuget: Plotly.NET, 5.0.0"
#r "nuget: Quipu, 0.5.2"

First, observing data that looks like a LogNormal isn’t really a surprise, as I simulated the sample data using a LogNormal and Math.NET, using random parameter values of mu = 1.3 and sigma = 0.3:

open MathNet.Numerics.Random
open MathNet.Numerics.Distributions

let mu, sigma = 1.3, 0.3
let rng = MersenneTwister 42
let duration = LogNormal(mu, sigma, rng)

let sample =
    duration.Samples()
    |> Seq.take 100
    |> Array.ofSeq

The histogram above was generated using Plotly.NET:

open Plotly.NET

sample
|> Chart.Histogram
|> Chart.withXAxisStyle "Time between failures"
|> Chart.withYAxisStyle "# Observations"
|> Chart.show

The “true” distribution of that LogNormal can be plotted using its density (the function that represents the relative likelihood of observing each value), which is helpfully available in Math.NET:

[ 0.0 .. 0.1 .. 10.0 ]
|> List.map (fun t -> t, duration.Density(t))
|> Chart.Line
|> Chart.show

The problem

We happen to know the true distribution behind our sample, a LogNormal with parameters (1.3, 0.3), because we are the ones who generated that sample in the first place. However, in real life, we wouldn’t know these parameters. The problem we are interested in is to figure out what these parameters are, by using just our sample observations.

Maximum Likelihood Estimation approaches that problem this way: assuming a specific distribution / shape, what is the set of parameters for that distribution that is the most likely to have produced the sample we observe?

In our case, if we think a LogNormal is a plausible candidate, what we are looking for is values for the 2 parameters of a LogNormal, mu and sigma, that maximize the likelihood of observing our sample.

Without going into the details of why the formula below works (see this link and this one for more), we can measure how likely it is that a particular probability model generated data by measuring its Log Likelihood, the sum over the sample of the log of the likelihood of each observation.

This is a mouthful, but it isn’t that complicated. Let’s illustrate in code. In our example, what this means is that we can measure the likelihood that a LogNormal with parameters mu and sigma produced our sample using the following function:

let logLikelihood sample (mu, sigma) =
    let distribution = LogNormal(mu, sigma)
    let density = distribution.Density
    sample
    |> Array.sumBy (fun t ->
        t
        |> density
        |> log
        )

As an example, using the actual parameters (1.3, 0.3) that we used to generate our sample, we get:

(1.3, 0.3) |> logLikelihood sample
> -151.8225702

If we try this with a different set of parameters, say (1.0, 1.0), we get

(1.0, 1.0) |> logLikelihood sample
> -233.0546586

The log-likelihood using the “wrong” parameters (1.0, 1.0) is -233, much lower than the value we get using the “correct” parameters (1.3, 0.3, -151. In other words, a higher log-likelihood indicates a better fit. The idea here is to search across the possible parameters, and try to find the pair that maximizes the log-likelihood, which should give us a good fit.

Solution with Quipu

Finding the parameters that minimize or maximize a function is exactly the type of problems Quipu is intended to handle. Quipu takes an objective function (the function we are trying to maximize), a starting value for the parameters (optional, defaulting to 0.0), and searches by probing different directions and following the most promising ones until it reaches a solution.

Setting up the problem should be as simple as this:

open Quipu

logLikelihood sample
|> NelderMead.objective
|> NelderMead.maximize

However, this doesn’t quite work:

val it: SolverResult =
  Abnormal
    [|[|0.2588190451; -0.9659258263|]; [|-0.9659258263; 0.2588190451|];
      [|0.7071067812; 0.7071067812|]|]

What is going on here?

The solver signals that it could not complete its search, and encountered an Abnormal situation, probing around values (0.25, -0.96), (-0.96, 0.25) and (0.70, 0.70). This makes sense, if you happen to know that the parameter sigma of a LogNormal is expected to be positive:

LogNormal(1.0, -1.0)
> System.ArgumentException: Invalid parametrization for the distribution.

The first of the 3 values the solver is probing, (0.25, -0.96), causes an exception. What can we do?

An easy way to solve this is to add a guard in the log likelihood function, like so:

let logLikelihood sample (mu, sigma) =
    if sigma < 0.0
    then - infinity
    else
        let distribution = LogNormal(mu, sigma)
        let density = distribution.Density
        sample
        |> Array.sumBy (fun t ->
            t
            |> density
            |> log
            )

If the parameter sigma is less than 0, instead of instantiating a LogNormal and causing an exception, we simply return a log-likelihood of - infinity. As we are trying to maximize that function, any direction evaluating to - infinity will be rejected.

Let’s try again:

#time "on"
logLikelihood sample
|> NelderMead.objective
|> NelderMead.maximize

Real: 00:00:00.002, CPU: 00:00:00.010, GC gen0: 0, gen1: 0, gen2: 0
val it: SolverResult =
  Successful
    { Status = Optimal
      Candidate = { Arguments = [|1.31780528; 0.2951006595|]
                    Value = -151.6237793 }
      Simplex =
       [|[|1.317242263; 0.2953732612|]; [|1.31723014; 0.2948290322|];
         [|1.31780528; 0.2951006595|]|] }

The solver proposes an optimal solution of (1.31, 0.29), which is pretty close to the value we used to generate that sample, (1.3, 0.3).

How close? Let’s compare the real and estimated densities:

Parting thoughts

When I originally set to write Quipu, my goal was to have a library to solve minimization / maximization problems that was reasonably fast and easy to use. Hopefully this example illustrates the point!

One thing I don’t like at the moment is how issues are surfaced to the user. The only information I had to figure out why the solver wasn’t happy was that it encountered an Abnormal situation, with the input that caused the problem. This is about as uninformative as it gets, basically “something went wrong, figure it out”. I’ll revisit that part of the solver, to see if I can surface more detailed diagnosis, in this case something like “the objective function threw this exception”.

Otherwise, readers familiar with statistics might be thinking “this example is a bit pointless, because the parameters of a LogNormal can be estimated easily by transforming the sample back to a Normal distribution and computing some averages” - and they would be right. Using MLE in that particular example is a bit of overkill. However, in my next post, I will keep that same setup, but go into some more interesting examples, illustrating the flexibility of Maximum Likelihood Estimation, and why I like it so much!

Delaunay triangulation with Bowyer-Watson: initial super triangle, revisited

2025-04-30T00:00:00+00:00

In our last installment, I hit a roadblock. I attempted to implement Delaunay triangulations using the Bowyer-Watson algorithm, followed this pseudo-code from Wikipedia, and ended up with a mostly working F# implementation. Given a list of points, the code produces a triangulation, but occasionally the outer boundary of the triangulation is not convex, displaying bends towards the inside, something that should never supposed happen for a proper Delaunay triangulation.

While I could not figure out the exact issue, by elimination I narrowed it down a bit. My guess was that the issue was probably a missing unstated condition, probably related to the initial super-triangle. As it turns out, my guess was correct.

The reason I know is, a kind stranger on the internet reached out with a couple of helpful links (thank you!):

Bowyer-Watson algorithm: how to fill “holes” left by removing triangles with super triangle vertices
Bowyer-Watson algorithm for Delaunay triangulation fails, when three vertices approach a line

The second link in particular mentions that the Wikipedia page is indeed missing conditions, and suggests that the initial super triangle should verify the following property to be valid:

it seems that one should rather demand that the vertices of the super triangle have to be outside all circumcircles of any three given points to begin with (which is hard when any three points are almost collinear)

That doesn’t look overly complicated, let’s modify our code accordingly, and check if this fixes our problem!

First off, what does our original code do?

What we are after with the so-called super-triangle is a triangle that contains all the points we are triangulating. The strategy we followed is simple:

1) compute a rectangular box that contains all the points we want to triangulate,
2) compute a triangle that contains that rectangular box.

Below is how (1) looks in code; we omitted (2) because we are simply going to re-use it as-is, but you can look at this earlier post for details.

let superTriangle (points: seq<Point>): Triangle =

    // find the left and right edges 
    // of the containing box
    let xs =
        points
        |> Seq.map (fun pt -> pt.X)
        |> Array.ofSeq
    let xMin = xs |> Array.min
    let xMax = xs |> Array.max
    // find the top and bottom edges
    // of the containing box
    let ys =
        points
        |> Seq.map (fun pt -> pt.Y)
        |> Array.ofSeq
    let yMin = ys |> Array.min
    let yMax = ys |> Array.max

    // omitted: given a box, 
    // we can compute a triangle around it.

The missing condition we need to incorporate says that the corners of the super triangle

have to be outside all circumcircles of any three given points

Stated differently, the super triangle needs to be large enough to contain not just the points we want to triangulate, but also, for every single possible triangle they can form, the corresponding circumcircle.

As a reminder, the circumcircle of a triangle is the circle that passes through all the triangle corners:

Fortunately, we already have the code we need to compute that, because it is used in the algorithm itself. The details of the calculations are not particularly important, what matters here is that we have a function that, given a Triangle, will give us back a Circle like so:

let circumCircle (triangle: Triangle) =
    // Calculations details omitted, see link:
    // https://en.wikipedia.org/wiki/Circumcircle#Cartesian_coordinates_2
    { Center = center; Radius = radius }

With these tools in hand, we should be able to fix our code. Let’s try to reduce our problem to a (mostly) known problem, following this strategy:

1) enumerate every triangle we can form with the points we want to triangulate,
2) for each triangle, compute the circumcircle
3) compute a rectangular box that contains all the circles,
4) compute a triangle that contains that rectangular box.

(2) and (4) we know how to do already, all we need to focus on is (1) and (3).

So how can we enumerate the triangles we can form using a collection of points? Triangles that have the same corners are identical, regardless of the order (ABC is the same triangle as CBA or any other combination), so all we need is to enumerate all distinct combinations of 3 points we can form.

One way to go about it would be along these lines:

let triangles (points: seq<Point>) =
    let points = points |> Array.ofSeq
    let len = points.Length
    seq {
        for p1 in 0 .. len - 3 do
            for p2 in (p1 + 1) .. len - 2 do
                for p3 in (p2 + 1) .. len - 1 ->
                    {
                        A = points.[p1]
                        B = points.[p2]
                        C = points.[p3]
                    }
        }

That takes care of (1), now let’s consider (3). How can we find a rectangular box that contains a collection of circles?

In our earlier version, we proceeded by finding the left-most and right-most points in our collection, which define the left and right boundary of the rectangular box, and did the same for the top and bottom-most points.

We can reduce our new problem to that same problem, by converting each circle into 4 points that box it from the left, right, top and bottom, like so:

let xs =
    circles
    |> Seq.collect (fun circle ->
        seq {
            circle.Center.X - circle.Radius
            circle.Center.X + circle.Radius }
        )
    |> Array.ofSeq
let ys =
    circles
    |> Seq.collect (fun circle ->
        seq {
            circle.Center.Y - circle.Radius
            circle.Center.Y + circle.Radius
            }
        )
    |> Array.ofSeq

let xMin = xs |> Array.min
let xMax = xs |> Array.max

let yMin = ys |> Array.min
let yMax = ys |> Array.max

Essentially, we create a box around the circles first, and then find a box that contains all these boxes.

And… we are pretty much done at that point, all we need to do is bolt these 4 steps together:

let superTriangle (points: seq<Point>) =
    let points = points |> Array.ofSeq
    let len = points.Length
    let circles =
        // 1) enumerate all triangles
        seq {
            for p1 in 0 .. len - 3 do
                for p2 in (p1 + 1) .. len - 2 do
                    for p3 in (p2 + 1) .. len - 1 ->
                        {
                            A = points.[p1]
                            B = points.[p2]
                            C = points.[p3]
                        }
            }
        // 2) compute their circumcircles
        |> Seq.map circumCircle
    // 3) convert the circles into points that
    // box them left, right, top and bottom
    let xs =
        circles
        |> Seq.collect (fun circle ->
            seq {
                circle.Center.X - circle.Radius
                circle.Center.X + circle.Radius }
            )
        |> Array.ofSeq
    let ys =
        circles
        |> Seq.collect (fun circle ->
            seq {
                circle.Center.Y - circle.Radius
                circle.Center.Y + circle.Radius
                }
            )
        |> Array.ofSeq

    let xMin = xs |> Array.min
    let xMax = xs |> Array.max

    let yMin = ys |> Array.min
    let yMax = ys |> Array.max

    // 4) back to original algorithm: 
    // find triangle around the bounding boxs
    // Omitted, same as before

And we are done!

Parting thoughts

Does it work? Yes, it appears so. It’s not a proof, but when running the modified version, the issues we had previously are gone. Now we have a nicely convex triangulation!

The obvious drawback here is that the initial super-triangle computation went from O(n) to O(n^3). Instead of computing the bounding box in a single pass over the points, we need to compute every possible triangle first. That being said, correct and slow beats fast and wrong.

Another approach that was suggested involved using a super triangle with infinite coordinates. I am still wrapping my head around what that means practically, and might look into it later. There is also still the issue of points that could be aligned. But… these questions can wait, this is where we’ll stop for today! And thank you again, Stranger on the Internet, for helping me get un-stuck!

Delaunay triangulation: hitting an impasse

2025-04-16T00:00:00+00:00

During the recent weeks, I have been making slow but steady progress implementing Delaunay triangulation with the Bowyer-Watson algorithm. However, as I mentioned in the conclusion of my previous post, I spotted a bug, which I hoped would be an easy fix, but so far no such luck: it has me stumped. In this post, I will go over how I approached figuring out the problem, which is interesting in its own right. My hope is that by talking it through I might either get an idea, or perhaps someone else will spot what I am missing!

Anyways, let’s get into it. Per the Wikipedia entry:

a Delaunay triangulation […] of a set of points in the plane subdivides their convex hull into triangles whose circumcircles do not contain any of the points; that is, each circumcircle has its generating points on its circumference, but all other points in the set are outside of it. This maximizes the size of the smallest angle in any of the triangles, and tends to avoid sliver triangles.

The Bowyer-Watson algorithm seemed straightforward to implement, so that’s what I did. For those interested, my current code is here, and it mostly works. Starting from a list of 20 random points, I can generate a triangulation like so:

let points =
    let rng = Random 0
    List.init size (fun _ ->
        {
            X = rng.NextDouble() * 100.
            Y = rng.NextDouble() * 100.
        }
        )
points
|> BowyerWatson.delaunay

With a bit of tinkering, I can render the result using SVG:

This looks like what I would expect: all the points are connected in a mesh of triangles.

However, if I take a subset of the points, like so:

points
|> List.truncate 9
|> BowyerWatson.delaunay

… I then get the following result:

This is still pretty, but it can’t be right. From the Wikipedia entry:

a Delaunay triangulation […] of a set of points in the plane subdivides their convex hull into triangles

The result should be a convex hull, that is, the outer boundary should be convex. Or, stated differently, the outer boundary should never “bend inwards”, and yet, we can see such a bend on the figure above, in the West to South-East boundary. What is going on here?

My first assumption was of course Denial. Certainly, my code is correct, I must be hitting a weird edge case with that particular set of points. So I generated a list of Delaunay diagrams, taking more and more points:

This does unfortunately not look like a fluke. I can observe bends inwards occurring multiple times, for example in images 7, 8, 13.

So I switched from Denial to Acceptance: I must have made a bone-headed coding error somewhere. Fine, but… how do I even approach understanding what might be going wrong? The first problem occurs on image 7, and there are already 10 points involved. This is going to be a nightmare to work with.

My first step was to try and shrink the problem to the smallest failing case I could. With a bit of tinkering and intuition, I ended up reproducing the issue with a much smaller setup:

let points =
    [ 0; 2; 4; 8 ]
    |> List.map (fun i -> points.[i])
points
|> BowyerWatson.delaunay

This involves only 4 points now, and the result is most definitely not a convex polygon:

Great. Now that we have a small test case, let’s dig in. We’ll run the triangulation before and after the step where things go off the rails, including the outer super-triangle, which is relevant to how the triangulation is updated:

Before

After

Here we can see how, as we add a point in the South-East area, while the triangulation gets properly adjusted in the North-East area, the bottom section shows a bend inwards appearing. Some of the triangles that should be recomputed are not.

How does the algorithm decide if a triangle needs to be recomputed? Per the Bowyer-Watson pseudo code,

for each point in pointList do
    badTriangles := empty set
    for each triangle in triangulation do
        // first find all the triangles that are no longer valid due to the insertion
        if point is inside circumcircle of triangle
            add triangle to badTriangles

When a point is added, we take the existing triangles, and, if the point is inside the circumcircle of a triangle, we add it to the list of “bad triangles” that need to be recomputed. Let’s visualize these circles then:

And this is where I hit an impasse. On this diagram, we can see the point we are adding to the triangulation, in the South-East area. The triangle West of it must be recomputed to avoid creating the issue we observe, but its circumcircle, while coming close to our point, does not contain it. In other words, the algorithm concludes that this section of the triangulation is fine - when it is not.

Parting thoughts

So where does this leave me? I am genuinely stumped here. From what I can tell, my implementation is faithful to the pseudo-code. I can’t see an obvious error, and yet, the result is clearly incorrect.

My best guess at the moment is that either I missed a subtlety in the algorithm, or that perhaps there is an unspoken assumption / missing detail, perhaps around triangles that are connected to the corners of the outer super-triangle.

I suspect the issue has to do with the initial super-triangle. The algorithm begins by creating the so-called “super triangle”, which, per the pseudo-code outline, should just be

large enough to completely contain all the points

add super-triangle to triangulation
// must be large enough to completely contain all the points in pointList

However, that triangle is not unique, and, if I were to move a bit the position of the South corner of the triangle, I could move it so that it still contains all the points, and causes a re-computation of the problem area. Long story short, I suspect that the source of the issue might be around what conditions that initial triangle must satisfy, or perhaps around recomputations involving its corners.

At any rate, I am stuck. My next steps are first to sleep on it, and then possibly to see if the original source articles might help. In the meantime, hopefully you will have found something of interest in this bug hunt, with its unusual graphical debugging. And if you happen to know what I am doing wrong, I would love to hear it :)

Delaunay triangulation: Bowyer-Watson algorithm

2025-04-02T00:00:00+00:00

In my last two posts, I did a bit of prep work leading to an implementation of the Bowyer-Watson algorithm. Now that we have the geometry building blocks we need, we can attack the core of the algorithm, and perform a Delaunay triangulation on a list of points.

Rather than attempt to explain what a Delaunay triangulation is, I will leave that out, and simply illustrate on an example. Starting from a collection of 20 random points, like so:

let points =
    let rng = Random 0
    List.init 20 (fun _ ->
        {
            X = rng.NextDouble() * 100.
            Y = rng.NextDouble() * 100.
        }
        )

… their Delaunay triangulation produces something like this: a mesh of triangles connecting all the points, without any edges crossing each other, and where the triangles have “reasonably even” angles:

The Bowyer-Watson algorithm is one way to generate such a triangulation. In this post, I’ll go over implementing it in F#.

Implementing the algorithm

In the same spirit as the previous posts, I will simply follow the Wikipedia pseudo-code, and convert it to F#. Let’s dive into the middle of the algorithm:

// add all the points one at a time to the triangulation
for each point in pointList do
    badTriangles := empty set
    // 1) first find all the triangles that are no longer valid due to the insertion
    for each triangle in triangulation do 
        if point is inside circumcircle of triangle
            add triangle to badTriangles
    // 2) find the boundary of the polygonal hole
    polygon := empty set
    for each triangle in badTriangles do
        for each edge in triangle do
            if edge is not shared by any other triangles in badTriangles
                add edge to polygon
    // 3) remove them from the data structure
    for each triangle in badTriangles do
        remove triangle from triangulation
    // 4) re-triangulate the polygonal hole
    for each edge in polygon do
        newTri := form a triangle from edge to point
        add newTri to triangulation

The algorithm starts with a valid triangulation (the initial “super triangle”, see [previous post][]), and adds points one-by-one, checking (1) which of the existing triangles are no longer valid, and updating them (2, 3, 4). This suggests a function which takes in a collection of triangles and a point, and returns an updated collection of triangles, something like this:

addPoint: Point -> Triangle array -> Triangle array

Step 1 is pretty direct. We re-use some of the tools we wrote in the previous post, to separate the current triangles in 2 groups, good and bad triangles:

// 1) first find all the triangles that are no longer valid due to the insertion
for each triangle in triangulation do 
    if point is inside circumcircle of triangle
        add triangle to badTriangles

let addPoint (point: Point) (triangles: Triangle []) =
    let badTriangles, goodTriangles =
        triangles
        |> Array.partition (fun triangle ->
            triangle
            |> circumCircle
            |> Circle.contains point
            )

Note: I changed Circle.isInside to Circle.contains, which reads much better I think.

Done. Now to Step 2:

// 2) find the boundary of the polygonal hole
for each triangle in badTriangles do
    for each edge in triangle do
        if edge is not shared by any other triangles in badTriangles
            add edge to polygon

This is a bit trickier. For each bad triangle, we want to extract the sides that are not shared, that is, unique edges. The tricky bit is that 2 edges (2 points) are equal if the 2 points are equal, regardless of their order. That is, edge A,B is equal to edge B,A.

Rather than implement equality, I will be lazy here, and use a trick:

let edge (pt1: Point, pt2: Point) =
    if pt1.X < pt2.X
    then pt1, pt2
    elif pt1.X > pt2.X
    then pt2, pt1
    else
        if pt1.Y < pt2.Y
        then pt1, pt2
        else pt2, pt1

The edge function takes a pair of points, and returns a tuple where the points are sorted by X coordinates and Y coordinates. Assuming I did not make a logical error here, this should result in edge(A,B)=edge(B,A).

Armed with that, we can then go over the bad triangles, extract all the edges, count them, and keep only the edges that are unique:

let uniqueEdges =
    badTriangles
    |> Array.collect (fun triangle ->
        [|
            triangle.A, triangle.B
            triangle.B, triangle.C
            triangle.C, triangle.A
        |]
        )
    |> Array.map edge
    |> Array.countBy id
    |> Array.filter (fun (_, count) -> count = 1)
    |> Array.map fst

Step 3 is already done for us. We don’t need to remove anything, because we already extracted the good triangles in Step 1. All that is left to do is Step 4: create a triangle for each unique edge, connecting it to the point we are adding to the triangulation:

for each edge in polygon do
    newTri := form a triangle from edge to point
    add newTri to triangulation

Pretty direct again:

let newTriangles =
    uniqueEdges
    |> Array.map (fun (a, b) ->
        { A = a; B = b; C = point }
        )

Array.append goodTriangles newTriangles

… and we are done. The complete addPoint function looks like this:

let addPoint (point: Point) (triangles: Triangle []) =
    let badTriangles, goodTriangles =
        triangles
        |> Array.partition (fun triangle ->
            triangle
            |> circumCircle
            |> Circle.contains point
            )
    let edge (pt1: Point, pt2: Point) =
        if pt1.X < pt2.X
        then pt1, pt2
        elif pt1.X > pt2.X
        then pt2, pt1
        else
            if pt1.Y < pt2.Y
            then pt1, pt2
            else pt2, pt1

    let uniqueEdges =
        badTriangles
        |> Array.collect (fun triangle ->
            [|
                triangle.A, triangle.B
                triangle.B, triangle.C
                triangle.C, triangle.A
            |]
            )
        |> Array.map edge
        |> Array.countBy id
        |> Array.filter (fun (_, count) -> count = 1)
        |> Array.map fst

    let newTriangles =
        uniqueEdges
        |> Array.map (fun (a, b) ->
            { A = a; B = b; C = point }
            )

    Array.append goodTriangles newTriangles

Adding all the points

Now that we have a function to add a point to an existing triangulation, all we need is to chain that together, adding the points one by one.

Let’s start manually, for illustration. First, we need an initial super triangle that will contain all the points (see the first post in this series):

let points =
    let rng = Random 0
    List.init 20 (fun _ ->
        {
            X = rng.NextDouble() * 100.
            Y = rng.NextDouble() * 100.
        }
        )

let triangle = BowyerWatson.superTriangle points

This gives us the points we want to triangulate, and an initial triangle. We can now start adding the first point, which produces an array of 3 triangles:

let update1 =
    BowyerWatson.addPoint points.[0] [| triangle |]

And we can keep going:

let update2 =
    BowyerWatson.addPoint points.[1] update1

let update3 =
    BowyerWatson.addPoint points.[2] update2

After update 3, this produces the following triangulation:

Note that the triangulation still includes the initial, outer super-triangle. We will remove that in a minute. First, let’s see how we can write that loop and add all the points in one go.

Updates 1, 2 and 3 follow a clear pattern:

Take the current collection of triangles, the State of the triangulation,
Take the next Point in the collection of Points,
Add the Point, which gives us a new collection of triangles,
Repeat, using the new collection of triangles as a new State.

This is exactly what a fold does: starting from an initial state and a collection, we iterate over the collection, updating the state each time until there isn’t anything left to iterate over.

val fold:
   folder: ('State -> 'T -> 'State) ->
   state : 'State ->
   source: seq<'T>
        -> 'State

So we can iterate over all the points like so:

([| triangle |], points)
||> Seq.fold (fun triangulation point ->
    BowyerWatson.addPoint point triangulation
    )

Wrapping it all up

We are more or less done at that point. The only thing we need to do is remove any triangle that has an edge connected to one of the initial 3 points. Let’s do that, and wrap the whole thing into a function:

let delaunay (points: seq<Point>) =
    let corners (triangle: Triangle) =
        set [ triangle.A; triangle.B; triangle.C ]
    let initial = superTriangle points
    let initialCorners = corners initial
    ([| initial |], points)
    ||> Seq.fold (fun triangulation point ->
        addPoint point triangulation
        )
    |> Array.filter (fun triangle ->
        Set.intersect (corners triangle) initialCorners
        |> Set.isEmpty
        )

We write a small utility function, corners, which takes a triangle and extracts its 3 corners into a Set. This is useful, because we can use set functions, like Set.intersect, to verify if 2 triangles have a common corner, and, if so, remove them from the list. And… we are done, and can run a full Delaunay triangulation, and visualize it:

points
|> BowyerWatson.delaunay
|> List.ofArray
|> List.map (fun triangle ->
    polygon
        [
            Style.Fill (Fill.Color "lightyellow")
            Style.Stroke (Stroke.Color "black")
            Style.Stroke (Stroke.Width 0.2)
        ]
        [ triangle.A; triangle.B; triangle.C ]
    )
|> Plot.plot (400, 400)

Note: I am still working on that SVG generation DSL, once it’s in a presentable state I plan to blog about it.

Parting thoughts

I was expecting the core algorithm to give me more trouble than it did. As it turns out, the hardest part was getting the geometry functions done - wiring up the main loop was more or less a direct transcription of the pseudo code to F#.

That being said, I know I am not fully done, because there is a bug, which I spotted by accident. If I run the same code, using only the first 9 points instead of the full list, I get this:

This looks mostly correct, which is also commonly described as “wrong”. The problem is visible on the bottom edge, connecting the west and south-east corners. The triangulation looks pretty, but, if it is done right, the result should always be a convex hull. Stated differently: the outer polygon should never bend inwards.

There is a clear inwards bend on that edge, which tells me that something is wrong in my implementation somewhere. If you run the algorithm for more points, the problem fixes itself, but reappears a few iterations later. The algorithm as implemented seems to occasionally produce obviously incorrect triangulations. This might be a more general problem, but it seems related to adding points that are added close to the outside boundary.

The problem here is that I am not entirely sure yet how to approach fixing that issue. Fortunately, I have an example that reproduces the bug, but it involves adding 1 point to an 8 points mesh. Isolating what step goes wrong or even debugging will be a nightmare.

Anyways, that’s probably what I will be tackling next! In the meantime, if you can spot the bug… let me know :)

Delaunay triangulation with Bowyer-Watson: circumcircle

2025-03-19T00:00:00+00:00

In my last installment, I started revisiting some old code of mine around Delaunay triangulation, the dual of a Voronoi diagram. My goal is to implement the Bowyer–Watson algorithm, and perhaps use it for procedural map generation at some point.

I will follow the pseudo-code outlined on the Wikipedia page, and work my way through it. Last time I took care of the initialization step, computing an initial super-triangle large enough to completely contain all the points:

function BowyerWatson (pointList)
    triangulation := empty triangle mesh data structure
    add super-triangle to triangulation

Today I will tackle the next step:

for each point in pointList do
    badTriangles := empty set
    for each triangle in triangulation do
        if point is inside circumcircle of triangle
            add triangle to badTriangles

I need 2 new pieces of machinery here:

Determine if a Point is inside a Circle,
Identify the Circumcircle of a Triangle.

Circumcircle of a Triangle

First, what is the circumcirle of a triangle? Per Wikipedia again, the circumcircle of a triangle is the circle that passes through all 3 corners of the triangle.

Let’s compute that circle. We already defined Point and Triangle last time, let’s add Circle too:

type Point = { X: float; Y: float }

type Triangle = {
    A: Point
    B: Point
    C: Point
    }

type Circle = {
    Center: Point
    Radius: float
    }

If that circle goes through all 3 corners of the triangle, the radius will be the distance from its center to any corner. We will need to compute the distance between two points, let’s get that out of the way:

let distance (a: Point, b: Point) =
    sqrt (pown (a.X - b.X) 2 + pown (a.Y - b.Y) 2)

Fortunately, computing the coordinates of the center of the circumcircle is a well-known problem, I will lazily lift the formula, which gives us the following function:

let circumCircle (triangle: Triangle) =

    let a, b, c = triangle.A, triangle.B, triangle.C

    let d = 2.0 * (a.X * (b.Y - c.Y) + b.X * (c.Y - a.Y) + c.X * (a.Y - b.Y))
    let x =
        (pown a.X 2 + pown a.Y 2) * (b.Y - c.Y)
        +
        (pown b.X 2 + pown b.Y 2) * (c.Y - a.Y)
        +
        (pown c.X 2 + pown c.Y 2) * (a.Y - b.Y)
    let y =
        (pown a.X 2 + pown a.Y 2) * (c.X - b.X)
        +
        (pown b.X 2 + pown b.Y 2) * (a.X - c.X)
        +
        (pown c.X 2 + pown c.Y 2) * (b.X - a.X)

    let center = { X = x / d; Y = y / d }
    let radius = distance (center, a)

    { Center = center; Radius = radius }

It’s not particularly pretty, but it does the job. Or… does it? Let’s check, by re-using last week’s code, computing a super-triangle, and its circumcircle:

let points =
    let rng = Random 0
    List.init 20 (fun _ ->
        {
            X = rng.NextDouble() * 100.
            Y = rng.NextDouble() * 100.
        }
        )

let triangle = BowyerWatson.superTriangle points
let circum = BowyerWatson.circumCircle triangle

[
    // render circumcircle
    circle
        [
            Style.Stroke (Stroke.Color "black")
            Style.Fill (Fill.Color "none")
        ]
        (circum.Center, circum.Radius)
    // render super triangle as a polygon
    polygon
        [
            Style.Fill (Fill.Color "lightyellow")
            Style.Stroke (Stroke.Color "black")
            Style.Stroke (Stroke.Width 1)
            Style.Stroke (Stroke.Dashes [ 1; 1 ])
        ]
        [ triangle.A; triangle.B; triangle.C ]
]
|> Plot.plot (400, 400)

This produces the following SVG - things appear to be working as expected:

While we are at it, the algorithm also contains the following check:

if point is inside circumcircle of triangle

Let’s take care of that quick:

    type Circle = {
        Center: Point
        Radius: float
        }

    let distance (a: Point, b: Point) =
        sqrt (pown (a.X - b.X) 2 + pown (a.Y - b.Y) 2)

    [<RequireQualifiedAccess>]
    module Circle =
        let isInside (circle: Circle) (pt: Point) =
            distance (pt, circle.Center) <= circle.Radius

As expected, the 3 corners of the triangle are inside the circumcircle:

[ triangle.A; triangle.B; triangle.C ]
|> List.map (Circle.isInside circum)

// val it: bool list = [true; true; true]

Parting thoughts

Nothing particularly fancy in this episode, this was mainly re-using a math formula. The good news is, I think we are over the geometry part. The rest of the algorithm revolves around updating a set of triangles as we add points to the triangulation one by one, which should be more about data structures.

One interesting edge case of the circumcircle function is the situation where the 3 points are aligned (and distinct), that is, the triangle is really just a straight line. In this case, there is no circle that can pass through all 3 corners, which we can confirm by running our code on an example of such a situation:

{
    A = { X = 0.0; Y = 0.0 }
    B = { X = 0.0; Y = 1.0 }
    C = { X = 0.0; Y = 2.0 }
}
|> BowyerWatson.circumCircle

val it: Circle = { Center = { X = -infinity
                              Y = nan }
                   Radius = nan }

I will ignore that issue for now, but we will probably have to revisit that later. We should be fine for as long as none of the points we want to triangulate are aligned. As a first step, we should be able to recognize that situation by changing the signature of circumCirle from Triangle -> Circle to Triangle -> Option<Circle>. However, that only postpones the real issue, which is “what should we do if we add a point that creates a flat triangle”? But we can deal with that later, when we actually go through the rest of the algorithm and create / update triangles.

Delaunay triangulation with Bowyer-Watson: initial super triangle

2025-03-05T00:00:00+00:00

A while ago, I got interested in Delaunay triangulation, because it seemed to be a good building block for procedural map generation, city maps in particular. I started implementing the Bowyer–Watson algorithm, but ended up putting this side-project on ice, because, well, life got busy. I had something messy somewhat working back then, and figured it would be fun to revisit that code and try to get it into shape.

In this post, I’ll revisit one minor piece of the algorithm that seemed easy, but gave me some trouble: the calculation of the so-called “super triangle”.

The algorithm is quite interesting. The first step is to compute a triangle that contains all the points we want to triangulate, adding points one by one and updating the triangulation, until there is nothing left to add. At that point, the initial triangle and anything connected to it is removed, and the triangulation is done.

Super Triangle

What I am after here is fairly simple: given a collection of points on the plane, find 3 points (the super triangle) that enclose every point in the list.

Let’s illustrate with an example. Suppose we have 5 points, like in the example below. The triangle ABC in yellow is a valid super triangle:

ABC isn’t the only valid super triangle. Many other triangles, some smaller, some larger, would do the job equally well. Our problem here is to find reasonably effectively a triangle that works.

My first take was to start by finding a circle that contains all the points, which is not too complicated. Pick a center for the circle, perhaps the average position of all the points, compute the distance between every point and the center, take the largest value and use that as the radius.

However, that doesn’t really help us: that circle doesn’t immediately give us a valid triangle. All we have is a different problem: finding a triangle that fully contains that circle. This is not super hard, but after making a few silly mistakes (trigonometry was never something I enjoyed) I got irritated and decided to try something simpler.

The thought went something like this: what if instead of a circle, I could find a square that contains all the points? Would that help me find a triangle enclosing all the points?

As it turns out, yes:

Starting from a yellow square like above, I can easily create a triangle ABC that covers it. That triangle is formed of 4 equal smaller triangles, which all have simple properties:

They are isosceles (2 sides have the same length),
The base has the same length as the square,
The altitude (height) has the same length as the square.

This is also dead-easy to code:

type Point = { X: float; Y: float }

type Triangle = {
    A: Point
    B: Point
    C: Point
    }

module BowyerWatson =

    let superTriangle (points: seq<Point>): Triangle =

        let xs =
            points 
            |> Seq.map (fun pt -> pt.X)
            |> Array.ofSeq
        let xMin = xs |> Array.min
        let xMax = xs |> Array.max

        let ys =
            points
            |> Seq.map (fun pt -> pt.Y)
            |> Array.ofSeq
        let yMin = ys |> Array.min
        let yMax = ys |> Array.max

        let squareWidth =
            max (xMax - xMin) (yMax - yMin)

        let pointA = {
            X = xMin - 0.5 * squareWidth
            Y = yMin
            }

        let pointB = {
            X = xMin + 1.5 * squareWidth
            Y = yMin
            }

        let pointC = {
            X = xMin + 0.5 * squareWidth
            Y = yMin + 2.0 * squareWidth
            }

        {
            A = pointA
            B = pointB
            C = pointC
        }

First, we identify the bounding square, by finding the min and max values of the X and Y coordinates. We compute the largest difference, which will be the size of the square. We have now a “virtual” square, anchored at xMin, yMin, and computing the 3 points A, B and C is straightforward.

Visual check

Let’s see if we can confirm visually that this works as expected.

We create first a sample of 20 random points:

open System

let points =
    let rng = Random 0
    List.init 20 (fun _ ->
        {
            X = rng.NextDouble() * 100.
            Y = rng.NextDouble() * 100.
        }
        )

We can now compute a super triangle:

let triangle = BowyerWatson.superTriangle points

And we can render the result, with a little home-cooked DSL to convert to SVG:

[
    // render super triangle as a polygon
    polygon
        [
            Style.Fill (Fill.Color "lightyellow")
            Style.Stroke (Stroke.Color "black")
            Style.Stroke (Stroke.Width 1)
            Style.Stroke (Stroke.Dashes [ 1; 1 ])
        ]
        [ triangle.A; triangle.B; triangle.C ]
    // render each point
    for pt in points do
        point
            [
                Style.Fill (Fill.Color "white")
                Style.Stroke (Stroke.Color "black")
            ]
            (pt, 4)
]
|> Plot.plot (400, 400)

… we get the following result:

Parting thoughts

In hindsight, I am surprised that this super triangle question caused me issues earlier on. I suspect it’s one of these situations where I started with the wrong idea of what the solution to the problem was, and then stayed on the wrong path for too long because I didn’t want to accept that my initial direction was wrong.

Once I scrapped my initial plan entirely, it was pretty quick. I took a piece of paper, drew a few shapes, and realized that there was a simple solution: covering the square with 4 equal triangles. There is something about finding a nice, clean solution to a geometry problem that brings me joy. As it happens, I suspect the box approach must also be much more efficient computationally than a trigonometry based one.

That being said, even though the solution described here works perfectly fine, I think using a bounding rectangle instead of a square would work equally well, and form a tighter super triangle. This train of thought got me wondering about another question: what is the tightest super triangle for a set of points? This seems like a fun geometry problem, but I’ll let that one rest for now, I want to finish this Delaunay triangulation first :)

Finally, as I was working through this problem, I realized that embedding SVG directly in this post would be much easier than creating images, which led me to write a quick-and-dirty DSL to convert shapes (points and polygons) to an SVG plot. This is currently a bit too messy to post about, but I’ll probably revisit that later as well!

Anyways, that’s what I got for today! In the next installments, I will start digging into the Bowyer-Watson algorithm.

Async Commands with Avalonia FuncUi

2025-02-19T00:00:00+00:00

Another Avalonia FuncUI post this week! One problem I struggled with initially with Avalonia FuncUI is how to handle async calls. I had some familiarity with the Elmish Cmd.OfAsync module, and wanted to use that if possible (Maxime Mangel has a great post on Cmd and how to use them, if you are curious).

Anyways, using Cmd.OfAsync and its cousin Cmd.OfTask in Avalonia FuncUI is what we will cover in today’s installment!

Without further due, let’s dive in, starting with a very basic example, without anything async to begin with. Our example app will have just a TextBox, where the text of a “Request” can be entered, and a Button, which will send the “Request”, and return a “Response”, a string, which we will display back to our user.

We’ll start synchronous, and work our way up to asynchronous commands.

Basic scaffold

First, let’s set up that basic app in Avalonia FuncUI.

    let respondToRequest (request: string) =
        $"{DateTime.Now}: Request was {request}"

    type State = {
        Request: string
        Response: string
        }

    type Msg =
        | UpdateRequest of string
        | SendRequest

    let init (): State * Cmd<Msg> =
        {
            Request = ""
            Response = ""
        },
        Cmd.none

    let update (msg: Msg) (state: State): State * Cmd<Msg> =
        match msg with
        | UpdateRequest text ->
            { state with Request = text }, Cmd.none
        | SendRequest ->
            let response = respondToRequest state.Request
            { state with Response = response }, Cmd.none

Our State has 2 fields, Request, the request we want to send, and Response, the response we received back. We have 2 messages to represent our user interactions: SendRequest, which should be self-explanatory, and UpdateRequest, to reflect changes the user makes to the “Request”.

In typical MVU fashion, init () creates our initial State, and update takes action based on the message received, to update the State accordingly. When the SendRequest message is received, we take the current Request, call the 100% synchronous respondToRequest function, which gives us back a “Response” (a time-stamped string), and update the Response field in State. Nothing particularly complicated.

How about the UI part? Not too complicated either:

let view (state: State) (dispatch: Msg -> unit): IView =
    StackPanel.create [
        StackPanel.children [
            TextBox.create [
                TextBox.watermark "Type your request"
                TextBox.text $"{state.Request}"
                TextBox.onTextChanged (fun text ->
                    text
                    |> UpdateRequest
                    |> dispatch
                    )
                ]
            Button.create [
                Button.content "Send Request"
                Button.onClick (fun _ ->
                    SendRequest
                    |> dispatch
                    )
                ]
            TextBlock.create [
                TextBlock.text state.Response
                ]
            ]
        ]

In a StackPanel, we create a TextBox where our user can type in a Request. We bind the contents TextBox.text to State.Request, to display the current state of that value. When the text is changed, we dispatch UpdateRequest with the current text content, to reflect UI changes in the State.

We add a Button, which dispatches SendRequest when pressed, and a TextBlock to display the current value of State.Response, and we are done. We have the scaffold of a working app.

Gist: code of version 0

Async Problems

Now imagine that the function respondToRequest was slow, or that for whatever reason we wanted it to be asynchronous. For illustration purposes, let’s change respondToRequest to something like this:

let respondToRequest (request: string) =
    task {
        // Create an artificial delay
        do! Async.Sleep 1000
        return $"{DateTime.Now}: Request was {request}"
        }

Note: I could have used async instead of task here. I deliberately chose to use task, because it will highlight an interesting issue that would not show up otherwise.

This immediately breaks the update function, because respondToRequest produces a Task<string> instead of a string previously:

    let update (msg: Msg) (state: State): State * Cmd<Msg> =
        match msg with
        // omitted
        | SendRequest ->
            let response = respondToRequest state.Request

Let’s attempt something gross to fix the issue first:

let update (msg: Msg) (state: State): State * Cmd<Msg> =
    match msg with
    // omitted
    | SendRequest ->
        let response =
            respondToRequest state.Request
            |> Async.AwaitTask
            |> Async.RunSynchronously
        { state with Response = response }, Cmd.none

This is gross, because we are throwing away all the benefits we could get from Async: we are going to wait for the response in the update loop, completely blocking the UI until respondToRequest completes its job, leaving the user with an un-responsive application.

Besides being gross, this fix also has another, more serious flaw: it just doesn’t work. If you run the code, the application will go in an unusable, completely unresponsive state. As I understand it, the problem here is that updates need to happen on the UI Thread, but this is not where the response returns.

Note: had we used async instead of task for our function, the gross solution would have worked in this specific case.

Using Cmd.OfAsync or Cmd.OfTask

So why did I want to use Cmd.OfAsync, or its cousin Cmd.OfTask? This Elmish module has a couple of very useful functions, which allow you to create a Cmd, but defer its execution without blocking the update.

The specific one I am interested in today is Cmd.OfTask.perform. It has a bit of an intimidating signature:

val inline perform:
   task     : ('a -> Threading.Tasks.Task<'a0>) ->
   arg      : 'a ->
   ofSuccess: ('a -> 'msg)
           -> Cmd<'msg>

Cmd.OfTask.perform expects 3 things:

a task (a function returning a Task<'T>) to perform,
arguments to be passed to that function,
a Msg to receive the result of the function evaluation.

We are missing one thing in our example: a Msg to signal that our request has completed, and carry the corresponding response. Let’s change our code and add such a message:

type Msg =
    | UpdateRequest of string
    | SendRequest
    | ReceivedResponse of string

We change the update function accordingly:

let update (msg: Msg) (state: State): State * Cmd<Msg> =
    match msg with
    | UpdateRequest text ->
        { state with Request = text }, Cmd.none
    | SendRequest ->
        let deferredCmd =
            Cmd.OfTask.perform
                respondToRequest
                state.Request
                ReceivedResponse
        state, deferredCmd
    | ReceivedResponse response ->
        { state with Response = response }, Cmd.none

Gist: code of version 1

Note how we separated starting the request, and completing it. SendRequest creates a “deferred” command, which will:

execute respondToRequest,
pass it state.Request as an argument,
wrap the response, a string, in ReceivedResponse,
and dispatch that Msg to update when it completed the task.

As a result, the update for SendRequest is quick. We don’t change the State, all we do is enqueue a Cmd, which will run asynchronously, and come back to update when it is done.

Does it work? Almost. The last change needed to make it work is to modify the part where your Avalonia FuncUI app starts the Elmish main loop, replacing Program.run with Program.runWithAvaloniaSyncDispatch () like so:

Elmish.Program.mkProgram Main.init Main.update Main.view
|> Program.withHost this
// |> Program.run
|> Program.runWithAvaloniaSyncDispatch ()

And… voilà! We are now getting all the benefits of asynchronous code: when we click the button to send a request, our UI is not blocked. The task runs in the background, and once completed, updates the UI with the response.

Parting thoughts

Not much to add to this, really! I remember Cmd.OfAsync as one of these bits of code which took me a little to digest at first, but that ended up feeling very natural (and powerful!) after using it a couple of times.

One piece I find unfortunate is that Program.runWithAvaloniaSyncDispatch () is not the default mode in Avalonia.FuncUI. It’s probably because Program.run is already defined in Elmish itself. As far as I can tell, the only place where this piece is documented is somewhere in Github issues.

Anyways, if you haven’t seen Cmd.OfAsync before, and want to use that in your Avalonia.FuncUI app, hopefully this example will help you start on the right foot!

Maintainable Avalonia FuncUI screen layouts with DockPanels and Borders

2025-02-05T00:00:00+00:00

I have been using Avalonia FuncUI quite a bit lately, to develop Windows desktop clients for 2 applications. The UI for these applications is not particularly fancy: select items using listboxes, edit the selected item, and save it, that kind of thing.

As these applications grew, the screens grew in complexity, and I realized that I was struggling a bit when I wanted to re-arrange their layout. The problem was not caused by FuncUI, but rather by how I was using controls, creating layouts that ended up being hard to refactor or re-arrange.

In this post, I will go over what I ended up doing. It’s not particularly earth shattering, but who knows - it might help someone out there avoid some of the pain I went through :)

DockPanel layout

Avalonia includes multiple controls to organize screen layout. My go-to workhorse for screen layout is the DockPanel. A DockPanel specifies an area that will expand to fill its parent area, and defines how elements inside the dock panel area should be displayed, by specifying how they are positioned relative to the previous element.

As they say, a picture is worth a thousand words. Let’s illustrate with a quick example, with one DockPanel split into 5 children:

let view (state: State) (dispatch: Msg -> unit) =
    DockPanel.create [
        DockPanel.children [
            TextBlock.create [
                TextBlock.dock Dock.Left
                TextBlock.text "1: LEFT"
                TextBlock.background "Red"
                ]
            TextBlock.create [
                TextBlock.dock Dock.Top
                TextBlock.text "2: TOP"
                TextBlock.background "Yellow"
                ]
            TextBlock.create [
                TextBlock.dock Dock.Top
                TextBlock.text "3: TOP"
                TextBlock.background "Orange"
                ]
            TextBlock.create [
                TextBlock.dock Dock.Right
                TextBlock.text "4: RIGHT"
                TextBlock.background "Green"
                ]
            // last child will fill in whatever space is left
            TextBlock.create [
                TextBlock.text "5: LAST"
                ]
            ]
        ]

This DockPanel creates the following layout, which will most certainly not win any design prizes, but illustrates what is going on:

The first TextBlock is docked to the left of the available space. The second is docked to the top of the remaining space available on the right of the first TextBlock. We keep going down the list, until we reach the last child, which will fill all the space still available.

What I like about the DockPanel is that

it handles dynamic screen resizing gracefully,
it handles dynamic scroll bars for controls with expanding contents, such as ListBox,
it is a pretty natural fit for layouts like item selector on the left / selected item editor on the right, or more generally newspaper / column style layouts.

DockPanel of Doom

So what can go wrong using DockPanels? If you are not careful, things can get out of hand quickly. As a simplistic (and ugly looking) example, you might end up with a screen layout along these lines:

let view (state: State) (dispatch: Msg -> unit) =
    DockPanel.create [
        DockPanel.children [
            // Left: Selection
            DockPanel.create [
                DockPanel.dock Dock.Left
                DockPanel.minWidth 150
                DockPanel.children [
                    TextBlock.create [
                        TextBlock.dock Dock.Top
                        TextBlock.text "TITLE"
                        TextBlock.background "Red"
                        ]
                    TextBlock.create [
                        TextBlock.dock Dock.Bottom
                        TextBlock.text "FOOTER"
                        TextBlock.background "Orange"
                        ]
                    ListBox.create [
                        ListBox.dataItems (
                            Array.init 20 (fun i -> $"Item {i}")
                            )
                        ]
                    ]
                ]
            // Right: Edit Selected
            TextBlock.create [
                TextBlock.dock Dock.Top
                TextBlock.text "TITLE"
                TextBlock.background "Yellow"
                ]
            TextBlock.create [
                TextBlock.dock Dock.Top
                TextBlock.text "SUBSECTION"
                TextBlock.background "Orange"
                ]
            TextBlock.create [
                TextBlock.text "MAIN EDITOR"
                ]
            ]
        ]

This creates a layout with a left section where perhaps we can select an item, and a few additional controls, and a right section with its own controls:

This looks terrible, but this isn’t the point. In its current state, it is already difficult to follow the overall screen organization. For instance, take the following element:

TextBlock.create [
    TextBlock.dock Dock.Top
    TextBlock.text "TITLE"
    TextBlock.background "Yellow"
    ]

It is docked to the top, but relative to what? To figure that out, you need to navigate all the way up to the previous child of the DockPanel (and possibly its predecessors):

DockPanel.create [
    DockPanel.dock Dock.Left
    // omitted
    ]
TextBlock.create [
    TextBlock.dock Dock.Top
    // omitted
    ]

This is a lot of mental gymnastics just to figure out where a control goes. It does not help that the previous child, the inner DockPanel, contains many elements. We have to navigate through a lot of code to find the relevant docking information. The overall layout intent is not made obvious at all.

Refactoring

As I see it, there are 2 separate problems at play:

Docking multiple elements, in particular using different docking directions, can be difficult to follow, because the behavior of any element depends on the entire chain of previous elements within the DockPanel.
The more code there is inline, the harder it gets to see the relevant information about the structure.

The second one sounds easy: if there is too much code inline, extract it. In our case, we could for instance extract the whole left section into its own view:

module Selection =

    let view (state: State) (dispatch: Msg -> unit) =
        DockPanel.create [
            DockPanel.dock Dock.Left
            DockPanel.minWidth 150
            DockPanel.children [
                TextBlock.create [
                    TextBlock.dock Dock.Top
                    TextBlock.text "TITLE"
                    TextBlock.background "Red"
                    ]
                TextBlock.create [
                    TextBlock.dock Dock.Bottom
                    TextBlock.text "FOOTER"
                    TextBlock.background "Orange"
                    ]
                ListBox.create [
                    ListBox.dataItems (Array.init 20 (fun i -> $"Item {i}"))
                    ]
                ]
            ]

This allows us to refactor the view like so:

let view (state: State) (dispatch: Msg -> unit) =
    DockPanel.create [
        DockPanel.children [
            // Left: Selection
            Selection.view state dispatch

            // Right: Edit Selected
            TextBlock.create [
                TextBlock.dock Dock.Top
                TextBlock.text "TITLE"
                TextBlock.background "Yellow"
                ]
            // omitted
            ]
        ]

While the view is now de-cluttered, this is arguably even worse than before. In the main view, all we see is a call to Selection.view, with no information about how it is docked. If we want to know how the TextBlock will be positioned, we need to navigate even further away in the code than before, inside the Selection.view function.

The problem here is that Selection.view should not contain information about docking - it is not its responsibility to decide where it should appear in the containing element! So what can we do here?

If the Selection.view is not responsible for how it is docked, that responsibility should be moved up to its containing element. Let’s refactor, adding a bit of indirection:

module Selection =

    let view (state: State) (dispatch: Msg -> unit) =
        DockPanel.create [
            DockPanel.children [
                TextBlock.create [
                    TextBlock.dock Dock.Top
                    TextBlock.text "TITLE"
                    TextBlock.background "Red"
                    ]
                // omitted
                ]
            ]

let view (state: State) (dispatch: Msg -> unit) =
    DockPanel.create [
        DockPanel.children [
            // Left: Selection
            Border.create [
                Border.dock Dock.Left
                Border.minWidth 150
                Border.child (
                    Selection.view state dispatch
                    )
                ]

            // Right: Edit Selected
            TextBlock.create [
                TextBlock.dock Dock.Top
                TextBlock.text "TITLE"
                TextBlock.background "Yellow"
                ]
            // omitted
        ]

Instead of directly using Selection.view, we introduce a Border in the parent DockPanel, which carries the relevant docking information, as well as anything else that pertains to its layout in the parent DockPanel, like minWidth in our example.

The next refactoring involves doing something similar for the right section. I won’t go into the details, and leave it as the proverbial “exercise to the reader”. Once completed, the result would look along these lines, which I believe is markedly better than the original version:

let view (state: State) (dispatch: Msg -> unit) =
    DockPanel.create [
        DockPanel.children [
            // Left: Selection
            Border.create [
                Border.dock Dock.Left
                Border.minWidth 150
                Border.child (
                    Selection.view state dispatch
                    )
                ]
            // Right: Edit Selected
            Border.create [
                Border.child (
                    Editor.view state dispatch
                    )
                ]
            ]
        ]

Parting thoughts

The approach I described is not particularly complicated or fancy, but I wanted to document it, for myself and possibly others. While I realized relatively quickly that my UI was devolving into an un-manageable mess of DockPanels, it took me longer than it should have to figure out what was wrong about it, and how to resolve the issue.

The key insight was that when extracting view code, I needed to remove all information pertaining to its layout in the containing control.

I knew that having controls dictating their layout behaving in their container was off, but realizing that I needed to insert a control in-between to carry that information took me a while. It might simply be that adding more controls did not seem like an obvious path to simplifying an already over-complicated UI!

The result is a pretty simple pattern:

use a DockPanel to define a few broad areas,
wrap each area in a Border containing the corresponding controls, and the correspondong layout information.

The Border control works pretty well for our purposes. First, we are defining broad layout areas, so there is a good chance that if we want to use actual visual borders to delineate organization, this is where we will need them. Then, unlike most other layout controls, a Border has a single child. This will enforce that its content have to be a single, self contained control, and leads to thinking in groups of related controls, rather than individual disconnected ones. Finally, this leads to much easier UI reorganization: reorganizing the layout within a DockPanel is straightforward because that is what the Borders highlight, and moving the controls around or even re-using them in different spots in the application is easy because they are self-contained and layout agnostic.

This is what I got for today!

Micro optimizing F# code with a dash of imperative code

2025-01-22T00:00:00+00:00

In addition to re-designing my Nelder-Mead solver to improve usability, I have also recently dedicated some time looking into performance improvements. This is usually not my primary concern: I tend to focus first on readability and correctness first, and address performance issues later.

However, in the case of a solver, performance matters. In my specific case, the solver works as a loop, iteratively updating a candidate solution until it is good enough. Anything that can speed up that loop will directly speed up the overall solver, so it is worth making sure the code is as efficient as can be.

One particular code area I worked on is the solver termination rule. The changes I made resulted in a significant speedup (roughly 10x), at the expense of style: the final version does not look like idiomatic F# at all. In this post, I will go over these changes.

Solver termination

First, let’s talk about what the code does. Without going into too much detail, the Nelder-Mead solver tries to find an array of numbers that minimizes a function. It does so by keeping a collection of candidates (arrays of numbers), and iteratively manipulates that collection in a loop, attempting to reduce the value of the target function until it decides to stop searching further.

One of the criteria for termination is whether all the candidates are sufficiently close to each other.

Let’s illustrate with an example: suppose we are searching for the values $x$ and $y$ that minimize $f(x,y)=x^2+y^2$. To do this, the solver will work with a collection of 3 arrays of 2 elements, for instance

Candidate 1: $C_1 = [ x_1 = 1.0, y_1 = 1.5 ]$
Candidate 2: $C_2 = [ x_2 = 1.1, y_2 = 1.7 ]$
Candidate 3: $C_3 = [ x_3 = 1.0, y_3 = 1.2 ]$

If we are searching for a solution within a given tolerance, say, we want the solution to be within 0.01 of the correct value, the candidates should be near each other. One way to express this is to say that we want $x_1, x_2, x_3$ to be within 0.01 of each other, and $y_1, y_2, y_3$ to be within 0.01 of each other.

In this particular example, our $x$ values, $1.0, 1.1, 1.0$ are within $0.1$ of each other, but the $y$ values, $1.5, 1.7, 1.2$ are within $0.5$ of each other. If we wanted a tolerance of $0.1$ the candidates would not be close enough to stop, and we would continue searching.

In other words, the termination rule I am looking at can be stated as:

if $max(x_1, x_2, x_3) - min(x_1, x_2, x_3) > tolerance$, continue search.
if $max(y_1, y_2, y_3) - min(y_1, y_2, y_3) > tolerance$, continue search.

Initial version

My initial implementation was a direct, naive translation in F#:

module Original =

    let minMax f xs =
        let projection = xs |> Seq.map f
        let minimum = projection |> Seq.min
        let maximum = projection |> Seq.max
        (minimum, maximum)

    let terminate (tolerance: float) (candidates: float [][]) =
        let dim = candidates[0].Length
        seq { 0 .. dim - 1 }
        |> Seq.forall (fun i ->
            let min, max =
                candidates
                |> minMax (fun candidate -> candidate.[i])
            max - min < tolerance
            )

We take our candidates, an array of array of floats, and iterate by column, computing the minimum and maximum, checking if for every column we are within the bounds set by tolerance.

Let’s set up a benchmark, using BenchmarkDotNet to evaluate the terminate function of an array of 4 arrays of 3 random-generated values:

type Termination () =

    let rng = Random 0
    let sample =
        Array.init 4 (fun _ ->
            Array.init 3 (fun _ -> 100.0 * rng.NextDouble())
            )

    [<Benchmark(Baseline = true)>]
    member this.Original () =
        Original.terminate 0.0001 sample

| Method   | Mean     | Error   | StdDev  | Ratio |
|--------- |---------:|--------:|--------:|------:|
| Original | 433.6 ns | 4.32 ns | 4.04 ns |  1.00 |

This is our baseline - let’s see if we can do better!

Take 1: replace sequences with arrays

My first thought was to replace sequences by arrays in the minMax function, because generally arrays are fast. This is a trivial change:

module Version1 =

    let minMax f xs =
        let projection = xs |> Array.map f
        let minimum = projection |> Array.min
        let maximum = projection |> Array.max
        (minimum, maximum)

    let terminate (tolerance: float) (candidates: float [][]) =
        // no change here

We can now compare the original to version 1:

type Termination () =

    // no change here

    [<Benchmark(Baseline = true)>]
    member this.Original () =
        Original.terminate 0.0001 sample

    [<Benchmark>]
    member this.Version1 () =
        Version1.terminate 0.0001 sample

This produces the following benchmark result:

| Method   | Mean     | Error   | StdDev  | Ratio | RatioSD |
|--------- |---------:|--------:|--------:|------:|--------:|
| Original | 450.2 ns | 7.46 ns | 6.98 ns |  1.00 |    0.02 |
| Version1 | 326.6 ns | 6.44 ns | 7.67 ns |  0.73 |    0.02 |

Not much to say here, except that this is not a negligible improvement, we shaved off 27%.

Take 2: imperative code

Can we do better? Call it a hunch, but I wondered if iterating over rows instead of columns would pay off. Let’s try that out:

module Version2 =

    let terminate (tolerance: float) (candidates: float [][]) =
        let dim = candidates[0].Length
        let mins = Array.create dim (System.Double.PositiveInfinity)
        let maxs = Array.create dim (System.Double.NegativeInfinity)
        for candidate in candidates do
            let args = candidate
            for i in 0 .. (dim - 1) do
                if args.[i] < mins.[i]
                then mins.[i] <- args.[i]
                if args.[i] > maxs.[i]
                then maxs.[i] <- args.[i]
        let deltas = (mins, maxs) ||> Array.map2 (fun min max -> max - min)
        deltas |> Array.forall (fun delta -> delta < tolerance)

We create 2 arrays to store the minimum and maximum values of each column, and iterate over the candidates, replacing the minimum and maximum values as we go. The style here is resolutely imperative, and relies on mutation. Does it work?

| Method   | Mean      | Error    | StdDev   | Ratio |
|--------- |----------:|---------:|---------:|------:|
| Original | 430.77 ns | 1.117 ns | 0.933 ns |  1.00 |
| Version1 | 320.75 ns | 5.777 ns | 5.674 ns |  0.74 |
| Version2 |  50.55 ns | 0.595 ns | 0.556 ns |  0.12 |

It most definitely does work! We are now over 8x faster than the original.

Why is this faster

Now the interesting question here is, why is it so much faster?

The short answer is, I am not sure. As I said earlier, I took that direction on a hunch, and performance is not something I can say I am particularly good at.

That being said, my hunch was not completely random. With a lot of hand-waving, the thinking was that perhaps computing by columns would result in cache misses that could be avoided by processing data following the existing arrays.

I could have stopped here - just take the win and move on. However, I was curious, and this also made me realize that I didn’t even know how to go about approaching that type of issue in general.

There are probably other ways to do this, but I ended up coming across a post by Adam Sitnik, which, besides being a good read, showed how BenchmarkDotNet can display performance counters. As we are already using BenchmarkDotNet here, this made it easy to try out.

After including a couple of performance counters in the benchmark, I got the following results:

Method	Ratio	BranchInstructions/Op	TotalIssues/Op	CacheMisses/Op	BranchMispredictions/Op
Original	1.00	1,489	5,022	10	4
Version1	0.71	1,184	3,842	7	3
Version2	0.11	149	616	1	0

Again, I am a novice at performance optimization. However, even without fully understanding the details, it seems that my guess about cache misses is plausible: We see 10 times less cache misses in Version 2 compared to the Original, which is in line with the improvement ratio. That being said, the other counters exhibit similar improvements, too - and I know too little of the topic to interpret this. Regardless, my interpretation is that the code change in version 2 performs much better, because it is written in a manner that is more “friendly” to hardware optimizations.

Parting thoughts

While I suspected that re-orienting my iterations from columns to rows would make a difference, the scale of the improvement caught me by surprise. I did not fundamentally change the algorithm, and yet, it yielded an almost 10-fold speedup.

That type of micro-optimization is not something I do often. A speedup like this is certainly nice, but from a different angle, we are talking execution times below milliseconds. This will matter only if the corresponding operation is executed very often, which happens to be the case in my algorithm.

This was also a reminder that, while I have been writing plenty of half-decent code, happily ignoring what happens at the hardware level, it can pay off to understand better what is going on at that lower level! Perhaps it’s time for me to learn a bit more about that.

Converting an F# pipeline into a C# fluent interface

2025-01-08T00:00:00+00:00

In my previous post, I went over one of the changes I made to my library, Quipu, to make it more C# friendly. In this installment, I will go over another design change, turning the initial F# version, which used a classic pipeline, into a Fluent Interface.

For reference, here is how the original F# pipeline looks like:

let f (x, y) = pown (x - 1.0) 2 + pown (y - 2.0) 2 + 42.0
let solverResult =
    NelderMead.objective f
    |> NelderMead.withTolerance 0.000_0001
    |> NelderMead.startFrom (Start.around (100.0; 100.0))
    |> NelderMead.minimize

This looks pretty similar to a Fluent Interface. It is not, though: it is a classic F# pipeline, chaining functions using the pipe-forward operator. From the F# side, this feels like a fluent interface, but for a C# consumer, it is more or less unusable.

Can we turn this into an actual C# friendly Fluent Interface? Yes we can, and this is what I will go over in this post.

Fluent Interface, Take One

First, if we mimicked what the F# code does, how would a C# Fluent Interface look like? Probably something along these lines:

Func<Double,Double,Double> f =
    (x, y) => Math.Pow(x - 1.0, 2) + Math.Pow(y - 2.0, 2) + 42.0;
var solverResult =
    NelderMead
        .Objective(f)
        .WithTolerance(0.0000001)
        .StartFrom(Start.Around(100.0, 100.0))
        .Minimize();

As it turns out, this is exactly the current C# Quipu API. So how did we go from an F# pipeline to this?

Let’s start from the F# side, taking one of the pipeline steps for illustration:

type NelderMead () =
    static member withTolerance (tolerance: float) (problem: Problem) =
        { problem with
            Configuration = {
                problem.Configuration with
                    Termination = Termination.tolerance tolerance
                }
        }

Source code

Sidebar: Why is NelderMead a class and not a module? And why is withTolerance a static method, and not a function on a module? I ended up using a class because, for other functions, I needed overloads.

The signature of the withTolerance function is

withTolerance: float -> Problem -> Problem

If we already had an instance of a Problem, say, initialProblem, we could apply withTolerance using the pipe-forward operator, which will return a new, updated Problem:

initialProblem
|> NelderMead.withTolerance 0.000_001

As long as we have functions that look along these lines:

someProblemTransformation: argument1 -> ... -> Problem -> Problem

… we can keep chaining them together, passing an initial Problem through a series of transformations that will eventually give us a Problem.

Stated differently, our original pipeline can be rewritten in the following equivalent code, fully expanding each step:

let f (x, y) = pown (x - 1.0) 2 + pown (y - 2.0) 2 + 42.0
let problem0 = NelderMead.objective f
let problem1 = NelderMead.withTolerance 0.000_0001 problem0
let problem2 = NelderMead.startFrom (Start.around [ 100.0; 100.0]) problem1
let solverResult = NelderMead.minimize problem2

All we are doing is passing around a Problem and transforming it.

Can we do the same with C#? We can, by using essentially the same idea. All we need is a method on an instance, which returns a new instance of the same type. We could for instance add a method on the Problem type, and do something like this:

type Problem = {
    // omitted for readability
    }
    with
    member this.WithTolerance (tolerance: float): Problem =
        { this with
            // slightly simplified for readability
            Tolerance = tolerance
        }

WithTolerance returns a Problem, so we can now chain the calls like so:

var problem1 = problem0.WithTolerance(0.001);
var problem2 = problem1.WithTolerance(0.01);
var problem3 = problem2.WithTolerance(0.1);

Or, omitting the intermediate variables, and calling WithTolerance directly on the Problem that the previous step returned:

var problem3 =
    problem0
        .WithTolerance(0.001)
        .WithTolerance(0.01)
        .WithTolerance(0.1);

Of course, this example is a little absurd (you would not set the tolerance three times in a row, to three different values), but it illustrates the point. If we have methods on an instance that return an instance of the same type, we have a Fluent Interface.

Fluent Interface, Take Two

While the general idea works, I wasn’t entirely satisfied with it. My issue was that the Problem type is not meant to be front-and-center. Leaving the type public is fine, so you can directly manipulate it in case you want to do something unusual, but by default you should not have to touch it.

In addition to this, Problem is a record which contains “non-obvious” types (IVectorFunction, IStartingPoint). Instantiating a Problem manually requires understanding how all these types work, and will be at best error prone and unpleasant (in particular for C#).

The F# pipeline completely hides Problem from the user, can we do something similar for C# consumers?

Ignoring for now how to instantiate a Problem, one approach would be to do something like this. Remove the WithTolerance method from Problem, and move it to the NelderMead class instead:

// the constructor expects an instance of Problem
type NelderMead(problem: Problem) =
    member this.WithTolerance(tolerance: float) =
        // we update the Problem, using the existing F# method
        let updatedProblem =
            problem
            |> NelderMead.withTolerance tolerance
        // and instantiate a new NelderMead, re-wrapping the updated Problem
        NelderMead(updatedProblem)

Instead of an empty constructor earlier, we expose a single constructor that expects an instance of a Problem. Because we want to chain method calls, we return a NelderMead from the WithTolerance method, so we can do the following:

NelderMead(problem0)
    .WithTolerance(0.001)
    .WithTolerance(...)

We are still left with one problem, though. We need to pass a well-formed Problem in the constructor. How can we avoid that?

The F# pipeline gets around this by using factory methods. The first call in our original pipeline creates a Problem, using a static method objective:

let f (x, y) = pown (x - 1.0) 2 + pown (y - 2.0) 2 + 42.0
let solverResult =
    NelderMead.objective f
    |> NelderMead.withTolerance 0.000_0001
    // more steps omitted

We can easily achieve the same effect from the C# side, by hiding the default constructor, and exposing a similar factory method:

type NelderMead private (problem: Problem) =

    static member Objective(f: System.Func<float,float,float>) =
        NelderMead.objective f.Invoke
        |> NelderMead

    member this.WithTolerance(tolerance: float) =
        problem
        |> NelderMead.withTolerance tolerance
        |> NelderMead

Applying the same trick to the other steps of the pipeline leads to the following API:

Func<Double,Double,Double> f =
    (x, y) => Math.Pow(x - 1.0, 2) + Math.Pow(y - 2.0, 2) + 42.0;
var solverResult =
    NelderMead
        .Objective(f)
        .WithTolerance(0.0000001)
        .StartFrom(Start.Around(100.0, 100.0))
        .Minimize();

… which is a Fluent Interface that mimicks the original pipeline, but is also usable from the C# side.

Parting thoughts

A couple of final comments before closing shop!

First, as of the latest version (0.5.2), the F# and C# APIs are separated in 2 different namespaces, Quipu for F#, Quipu.CSharp for C#. I initially used a single class, as in this post, but as a result, the NelderMead type had a lot of methods, mixing code formatting conventions (withTolerance and WithTolerance for example). I can see only one drawback to introducing this separation: you need to open the correct namespace depending on your preferred language. This seemed like an acceptable price to pay for the benefit of an uncluttered API.

Speaking of formatting, I also wanted the code to follow the expected standards for both F# and C#. I ended up using the [<CompiledName>] attribute on the Start type, like so:

type Start =
    [<CompiledName("Around")>]
    static member around (startingPoint: seq<float>) =
        // omitted code

As a result, the code looks as you would expect in both languages:

NelderMead.objective f
|> NelderMead.startFrom (Start.around (100.0; 100.0))

NelderMead
    .Objective(f)
    .StartFrom(Start.Around(100.0, 100.0))

Finally, the goal was to design a C#-friendly API, and the best way to check if that goal is achieved is to experience potential painpoints yourself, by using your own code (aka dog-fooding). I ended up writing a battery of unit tests in C#, which is a simple but effective way to do that.

One thing I was wondering about is how I could also confirm API parity between the two versions. The thought here is that if I write a unit test in F#, it would be nice to automatically also run the same test, using the equivalent C# code. I am still mulling over that one, it is an interesting problem, but one I can leave to think about later :)

That’s what I got for today! I am still planning to make some changes to the library, but I expect these to be much less drastic than the recent ones. Anyways, Quipu is usable as-is today - if you have questions, feedback or requests, let me know! And in the meantime, I hope you found something of interest in this post.

Making a F# library C# friendly

2024-12-28T00:00:00+00:00

During December, I have been aggressively redesigning my library, Quipu. I initially wrote Quipu because I needed a Nelder-Mead solver in .NET, and could not find one ready to use. And, because I intended to use it from F#, I wrote Quipu in a style that wasn’t particularly C# friendly.

As I was going through the code base with my chainsaw, I thought it would be an interesting exercise to try and make it pleasant to use from C# as well. This post will go through some of the process.

First, what is Quipu about? Quipu is an implementation of the Nelder-Mead algorithm, and searches for arguments that minimize a function. As an example, suppose you were given the function f(x,y) = (x-1)^2 + (y-2)^2 + 42, and wanted to know what values of x and y give you the lowest possible value for f. With Quipu, now in C#, this is how you would go about it:

#r "nuget: Quipu, 0.5.2"
using Quipu.CSharp;
using System;

Func<Double,Double,Double> f =
    (x, y) => Math.Pow(x - 1.0, 2) + Math.Pow(y - 2.0, 2) + 42.0;

var solverResult =
    NelderMead
        .Objective(f)
        .Minimize();

if (solverResult.HasSolution)
{
    var solution = solverResult.Solution;
    Console.WriteLine($"Solution: {solution.Status}");
    var candidate = solution.Candidate;
    var args = candidate.Arguments;
    var value = candidate.Value;
    Console.WriteLine($"f({args[0]:N3}, {args[1]:N3}) = {value:N3}");
}

This produces the following result, which happens to be correct:

Solution: Optimal
f(1.000, 2.000) = 42.000

I would also like to think that this C# code looks reasonably pleasant, whereas the original version (pre version 0.5.*) definitely was not. Let’s go over some of the changes I made to the original code!

Side note: my C# is pretty rusty at that point, if you have any thoughts or feedback on how to make this better, I am all ears!

The original version

The original F# version looked along these lines:

let f (x, y) = pown x 2 + pown y 2

let solution =
    NelderMead.objective f
    |> NelderMead.withTolerance 0.001
    |> NelderMead.startFrom (Start.around [ 100.0; 100.0 ])
    |> NelderMead.solve

The solver returned a Solution, a discriminated union shaped like this:

type Solution =
    | Optimal of (float * float [])
    | SubOptimal of (float * float [])
    | Unbounded
    | Abnormal of (float [][])

The intent of these 4 cases was to capture 4 possible outcomes: the solver

found an Optimal solution, with the corresponding value and arguments,
found a SubOptimal solution, with the corresponding value and arguments,
found the solution is Unbounded,
encountered a problem along the way, returning the latest state of the solver.

This isn’t perfect, but from an F# standpoint, it was decently usable (I built it for myself after all). However, from a C# standpoint, this is more or less unusable, and checks every “don’t do this” box in the F# component design guidelines for libraries for use from other .NET languages. Specifically, for your public-facing API:

Don’t return naked Discriminated Unions,
Don’t return naked Tuples,
Don’t use currying,
Use .NET naming conventions.

Let’s see how we can fix that, starting with the biggest culprit, Solution.

Reshaping the Solution

If you have ever tried to work with an F# discriminated union from the C# side, you know that the Solution type will be super unpleasant to work with. However, arguably, this design is also not great from an F# standpoint.

First, in Optimal of (float * float []), what is this tuple supposed to represent? Using a tuple there is not very clear: Let’s clarify, using a record instead:

type Evaluation = {
    Arguments: float []
    Value: float
    }

type Solution =
    | Optimal of Evaluation
    | SubOptimal of Evaluation
    | Unbounded
    | Abnormal of (float [][])

Much better. However, as it turns out, this representation in 4 flat cases, while not wrong, is a little misleading. There are really 2 cases here: either the solver reached a “usable” conclusion, or something went off the rails (Abnormal). Optimal, SubOptimal and Unbounded all describe the best solution the solver found, after completing its search. In the Unbounded case, we omitted the Evaluation because you would typically not be interested in it, but we could provide one in all three cases, and re-structure the Solution along these lines:

type Evaluation = {
    Arguments: float []
    Value: float
    }

type Status =
    | Optimal
    | Suboptimal
    | Unbounded

type Solution =
    | Successful of (Status * Evaluation)
    | Abnormal of (float [][])

Note: I initially did not include the Evaluation in the Unbounded case, I think because my thinking was biased by linear programming. In linear programming, an unbounded solution implies unbounded arguments, which is not necessarily the case for non-linear functions. As an example, log(x) is unbounded, but the arguments are finite: log(0) = -infinity.

We still have a tuple in Successful, let’s clean that up:

type Solution = {
    Status: Status
    Candidate: Evaluation
    }

type SolverResult =
    | Successful of Solution
    | Abnormal of (float [][])

Much better. The Abnormal case is still a bit gross, but I need to think about it some more, so I’ll leave it as-is for the time being.

We are still returning a naked Discriminated Union, though, which was what we wanted to avoid in the first place. Well, we can give it some clothing, by adding a couple of methods to our SolverResult, for instance:

type SolverResult =
    | Successful of Solution
    | Abnormal of (float [][])
    with
    member this.HasSolution =
        match this with
        | Successful _ -> true
        | Abnormal _ -> false
    member this.Solution =
        match this with
        | Successful solution -> solution
        | Abnormal _ -> failwith "No solution found."

Which will give us the ability to work with it fairly comfortably from the C# side of the house:

if (solverResult.HasSolution)
{
    var solution = solverResult.Solution;
    Console.WriteLine($"Solution: {solution.Status}");
    var candidate = solution.Candidate;
    var args = candidate.Arguments;
    var value = candidate.Value;
    Console.WriteLine($"f({args[0]:N3}, {args[1]:N3}) = {value:N3}");
}

From the F# side, we can still use pattern-matching, like so:

match solverResult with
| Successful solution ->
    printfn $"Solution: {solution.Status}"
    let candidate = solution.Candidate
    let args = candidate.Arguments
    let value = candidate.Value
    printfn $"f(%.3f{args[0]}, %.3f{args[1]}) = %.3f{value}"
| Abnormal _ ->
    printfn "Something went wrong here..."

Parting thoughts

I’ll stop here for today, and go over turning the F# pipeline into a C# fluent interface in another post.

I found the exercise of looking at my F# code from a C# usability perspective very valuable. Arguably, the result is better overall, including for F#.

Essentially, the whole exercise consisted of 2 operations:

Replacing tuples by records,
Adding properties or methods on discriminated unions to make their contents accessible without pattern matching.

I was unsure about whether I should use the Try... pattern on SolverResult, to indicate that the result may or may not have a solution. In the end, I found using a pair of properties HasSolution and Solution was pretty clear, but perhaps TryGetSolution would be safer?

Another thing I was unsure about is whether to entirely hide the discrimated union, by doing something like

type SolverResult =
    private
    | Successful of Solution
    | Abnormal of (float [][])

Keeping the discriminated union public gives me the ability to pattern match in F#, however it also creates some light cruft on the C# side.

In a similar vein, the SolverResult type looks awfully close to a Result. Without the constraint of C# friendliness, we might as well just use a Result<Solution, ...>. This would also give us useful functions like Result.map, Result.bind and friends for free. I am not sure if I can get the best of both worlds, thoughm because returning a plain Result is unacceptable from a C# usability standpoint.

Finally, this wasn’t too hard, because fundamentally the SolverResult can be reduced to just 2 cases. The Abnormal branch, which I am still thinking about, should be trickier. Currently, Abnormal returns a float [][], the current candidates the solver was evaluating when it encountered an issue. However, the solver could fail in situations where there isn’t even a candidate yet. As an example, consider this:

let f (x, y) = pown (x - 1.0) 2 + pown (y - 2.0) 2 + 42.0
let solverResult =
    NelderMead.objective f
    |> NelderMead.startFrom (Start.around 10.0)
    |> NelderMead.minimize

In the current version, this will throw, because the objective function is in 2 dimensions, whereas the requested starting point is in 1 dimension:

System.Exception: Invalid starting point dimension: 1, expected 2.

I would much prefer to capture that issue in the Abnormal branch of the SolverResult, and will likely do so in upcoming iterations. However, this means that the data in the Abnormal case will need to cover cases with potentially very different shapes and data. This is a great fit for a discriminated union, but won’t work that well for something C# friendly.

Anyways, that’s it for today!

More SIMD vectors exploration

2024-10-13T00:00:00+00:00

Since my earlier post looking into SIMD vectors in .NET, I attempted a few more experiments, trying to understand better where they might be a good fit, and where they would not.

The short version: at that point, my sense is that SIMD vectors can be very handy for some specific scenarios, but would require quite a bit of work to be usable in the way I was hoping to use them. This statement is by no means meant as a negative on SIMD; rather, it reflects my realization that a SIMD vector is quite different from a mathematical vector.

All that follows should also be taken with a big grain of salt. SIMD is entirely new to me, and I might not be using it right. While on that topic, I also want to thank @xoofx for his very helpful comments - much appreciated!

Anyways, with these caveats out of the way, let’s dive into it.

My premise approaching SIMD was along these lines: “I write a lot of code that involves vectors. Surely, the Vector class should be a good fit to speed up some of that code”.

To explore that idea, I attempted to write a few classic vector operations I often need, both in plain old F# and using SIMD vectors, trying to benchmark how much performance I would gain. In this post, I’ll share some of the results, and what I learnt in the process.

You can find the whole code here on GitHub.

Context: what am I trying to do here?

First, what do I mean by “code that involves vectors”? Most of my work involves
numerical algorithms, be it machine learning, optimization, or simulation. These can often be represented in a general manner as operations on mathematical vectors, involving a few core operations that appear over and over again. Below are a few examples for illustration:

distance: computing the difference (or similarity) between 2 entities, represented as vectors of values / features,
linear combination: computing the average position of a collection of entities, represented as vectors of values / features,
translation: moving from a candidate solution to a better one,
statistics: computing aggregate values over a sample of observations, such as the average, standard deviation, or log likelihood.

For instance, I have written code to compute the Euclidean distance multiple times in different projects, something along these lines (ignoring details such as what happens if v1 and v2 do not having matching lengths):

let distance (v1: float[], v2: float[]) =
    (v1, v2)
    ||> Array.map2 (fun x y -> (x - y) ** 2)
    |> Array.sum
    |> sqrt

We take 2 arrays of numbers, compute the difference between each of their elements, square it, sum it all together and return the square root. By using arrays, we get a very general function that it will work for any array length - we get the same re-usable operation regardless of the array length.

From a mathematical standpoint, we are using arrays of floats here as a representation of a vector. The same operation, viewed from a mathematician standpoint, could be written along the lines of:

$ (v_1, v_2) \rightarrow { \sqrt { (v_1 - v_2) \cdot (v_1 - v_2) } } $

My point here is that while the F# example above is fairly general, it is still a very manual implementation of 2 algebra operations:

the difference between 2 vectors, and
the dot-product of 2 vectors.

These 2 operations are not immediately obvious in the code - it would be nice to write the distance as an operation on vectors, using these “core” vector operators (difference and dot-product) instead, something along these lines:

let distance (v1: float[], v2: float[]) =
    let V1 = vector v1
    let V2 = vector v2
    (V1 - V2) .* (V1 - V2)
    |> sqrt

This was what motivated me to look into the SIMD-accelerated Vector class in .NET. I was hoping for a way to both accelerate my code using SIMD, and write code directly using algebra operators.

An important constraint here is that I want library code, code that I can plug into existing code to leverage vectors when appropriate. In that frame, I can’t impose SIMD Vector on the consumer. I want to be able to seamlessly pass in arrays, and return arrays. The SIMD Vector part should be transparent to the consumer.

Fixed size Vectors

My first attempt into this was the exact example I showed before, a distance function. With an assist from @xoofx, this is where I landed:

let distance (v1: float[], v2: float[]) =

    let s1 = MemoryMarshal.Cast<float, Vector<float>>(ReadOnlySpan(v1))
    let s2 = MemoryMarshal.Cast<float, Vector<float>>(ReadOnlySpan(v2))

    let mutable total = 0.0
    for i in 0 .. (s1.Length - 1) do
        let v1 = s1.[i]
        let v2 = s2.[i]
        let diff = v1 - v2
        total <- total + Vector.Dot(diff, diff)
    sqrt total

The good news first: this is vastly faster than the original version. For vectors of size 8, it takes ~2% of the time the naive F# implementation:

| Method           | Mean       | Error     | StdDev    | Ratio | RatioSD |
|----------------- |-----------:|----------:|----------:|------:|--------:|
| classic          | 212.753 ns | 3.3103 ns | 2.9345 ns |  1.00 |    0.02 |
| simdV3           |   3.343 ns | 0.0967 ns | 0.0950 ns |  0.02 |    0.00 |

With vectors of size 4,000, we get even better results, running under 1% of the original version:

| Method           | Mean         | Error       | StdDev      | Ratio | RatioSD |
|----------------- |-------------:|------------:|------------:|------:|--------:|
| classic          | 115,976.9 ns | 2,315.62 ns | 2,166.03 ns | 1.000 |    0.03 |
| simdV3           |     967.4 ns |    13.64 ns |    11.39 ns | 0.008 |    0.00 |

Needless to say, at that point, my interest was piqued - who wouldn’t want a 98% speed improvement in their code?

However, some issues are already showing up. First, a Vector<float> is quite different from a mathematical vector: it has a fixed size, which is architecture dependent.

On my machine, a Vector<float> has a size of 4. This has 2 implications:

First, I need to re-write vector operations into an equivalent operation breaking it down by blocks of 4 small vectors of values, which I need to aggregate back up. This requires making sure the operation is associative. As an example, in the distance function, I kept the square root calculation “outside”, because $ \sqrt { x + y } \neq \sqrt { x } + \sqrt { y } $.

Even if the operation is associative mathematically, it might not be from a numeric computation standpoint, because of rounding errors. As an example, addition is associative: $ a + (b + c) = (a + b) + c $. However, depending on how you perform addition on floats, you might get different results, as we can show with a simple example:

open System

let rng = Random 0

let data = Array.init 16 (fun _ -> rng.NextDouble())

// directly summing all the numbers together:
let sum = data |> Array.sum
// summing the numbers by groups of 4,
// then summing the groups together:
let sumByBlocks =
    data
    |> Array.chunkBySize 4
    |> Array.map (fun chunk -> chunk |> Array.sum)
    |> Array.sum

printfn $"Equal: {sum = sumByBlocks} ({sum}, {sumByBlocks})"

Equal: False (9.108039789417779, 9.108039789417777)

Granted, this is a small difference, at the 15th decimal. However, it only took 16 values and creating groups of 4 to find a discrepancy, which is exactly what using SIMD vectors would do. In other words, even for simple operations like addition or multiplication, we cannot guarantee that a SIMD version of the operation would produce the same result as the array version. Whether this matters depends on context - but at the same time, errors do accumulate.

Second, the SIMD version of distance above is incomplete. It will work great, as long as the size of the 2 arrays are perfect multiples of 4. If not, it will crash, because the tail end of the array does not form a perfect block of 4 values, which is needed to construct a Vector<float>.

We can address this issue, by making sure that we only process complete blocks of size 4 using SIMD vectors, and handle the remaining tail end as a regular array. As an example, for arrays of size 10, we would do something like this:

input array: [ 0; 1; 2; 3; 4; 5; 6; 7; 8; 9 ]
2 SIMD vectors using SIMD code: [ 0; 1; 2; 3 ], [ 4; 5; 6; 7 ]
1 remainder array using naive code: [ 8; 9 ]
aggregate the results

This is perfectly feasible, but the resulting distance function is starting to look a bit messy:

let full (v1: float[], v2: float[]) =

    let remainingBlocks = v1.Length % Vector<float>.Count
    let fullBlocks =
        (v1.Length - remainingBlocks) / Vector<float>.Count

    let s1 = MemoryMarshal.Cast<float, Vector<float>>(ReadOnlySpan(v1))
    let s2 = MemoryMarshal.Cast<float, Vector<float>>(ReadOnlySpan(v2))

    let mutable total = 0.0
    for i in 0 .. (fullBlocks - 1) do
        let v1 = s1.[i]
        let v2 = s2.[i]
        let diff = v1 - v2
        total <- total + Vector.Dot(diff, diff)

    if remainingBlocks > 0
    then
        for i in (v1.Length - remainingBlocks) .. (v1.Length - 1) do
            total <- total + (pown (v1.[i] - v2.[i]) 2)

    sqrt total

Good news: the performance is still excellent. Bad news: the code has gotten more complex, and performs the same operation using 2 different approaches, completely obscuring the underlying algebra. It is arguably worth it, given the speedup, but it is far from my original hope of code that looks like algebra.

Going beyond distance calculations

In spite of these minor issues, at that point I was still quite interested in exploring further. While I like code to look pretty, for that type of speedup, I will happily accept compromises!

However, as I attempted to explore other functions I use regularly, I wasn’t quite as successful as with my first example, and even ran into some issues I do not fully understand.

Note: the following examples all ignore the problem of vectors that are not clean multiples of Vector<float>.Count. My goal here was to get a sense for how much performance I might gain at best by using SIMD.

The first case was performing a translation, taking a step from a vector towards another vector. My starting point, the naive F# version, looks like this:

let naive (origin: float[], target: float[], coeff: float) =
    let dim = origin.Length
    Array.init dim (fun col ->
        origin.[col] + coeff * (target.[col] - origin.[col])
        )

The motivation for this one was my Nelder-Mead solver, Quipu, which relies heavily on that operations. The idea here is to take a starting point, origin, and take a step of a certain size, coeff, towards a target, to evaluate if moving in that direction gives us a better objective function value.

I attempted multiple SIMD versions, the best one I got was this one:

let take1 (origin: float[], target: float[], coeff: float) =

    let origins = MemoryMarshal.Cast<float, Vector<float>>(ReadOnlySpan(origin))
    let targets = MemoryMarshal.Cast<float, Vector<float>>(ReadOnlySpan(target))

    let result = Array.zeroCreate<float> origin.Length
    let blockSize = Vector<float>.Count

    let multiplier = 1.0 - coeff
    for i in 0 .. (origins.Length - 1) do
        let o = origins.[i]
        let t = targets.[i]
        let movedTo = Vector.Multiply(multiplier, o) -  t
        movedTo.CopyTo(result, i * blockSize)
    result

| Method  | Mean      | Error    | StdDev   | Ratio | RatioSD |
|-------- |----------:|---------:|---------:|------:|--------:|
| classic |  85.90 ns | 0.430 ns | 0.359 ns |  1.00 |    0.01 |
| simdV1  |  43.66 ns | 0.914 ns | 1.783 ns |  0.51 |    0.02 |

Still a decent improvement over the naive version, but nothing close to the massive speedup we saw on the distance calculation. My intuition is that there are 2 relevant differences here:

The SIMD operations are less efficient than in the distance case, where the dot product does a lot in a single operation.
More importantly, besides the individual operations on elements, we now also have to copy back the results in the array we are returning.

As a side note, I would be super interested to hear if there is a better way to copy back data to an array than what I did!

A 50% improvement in speed is nothing to sneeze at. However, this hints at different gains to be expected, depending on whether the operation returns a vector or a scalar, a value aggregated / folded over the input vector.

Another operation I looked into was computing the average of an array of values. The code is very similar to what we landed on for the distance:

let naive (v: float[]) =
    v
    |> Array.average

let average (v: float[]) =

    let vectors = MemoryMarshal.Cast<float, Vector<float>>(ReadOnlySpan v)
    let mutable total = 0.0
    for i in 0 .. (vectors.Length - 1) do
        let v = vectors.[i]
        total <- total + Vector.Sum(v)
    total / float v.Length

The performance is exactly what we would expect from SIMD:

| Method  | Mean      | Error     | StdDev    | Ratio |
|-------- |----------:|----------:|----------:|------:|
| classic | 28.843 us | 0.3332 us | 0.3117 us |  1.00 |
| simd    |  7.207 us | 0.0267 us | 0.0223 us |  0.25 |

This is an aggregate over the data, which involves computing a sum. Instead of adding elements one by one, we sum them 4 by 4, and as a result the computation takes only 25% of the original.

However, just as I thought I had a decent understanding of what to expect from aggregates, I tried to implement another operation I use a lot, the Log-Likelihood. It is largely similar to the distance and average, in that it computes an aggregate over the entire array, and so I was expecting a comparable performance improvement:

let naive (v: float[]) =
    v
    |> Array.sumBy (fun x -> log x)
    |> fun total -> - total

let take1 (v: float[]) =

    let s = MemoryMarshal.Cast<float, Vector<float>>(ReadOnlySpan(v))

    let mutable total = 0.0
    for i in 0 .. (s.Length - 1) do
        let v = s.[i]
        total <- total - Vector.Sum(Vector.Log(v))
    total

As it turns out, my expectations were totally wrong:

| Method  | Mean      | Error     | StdDev    | Ratio | RatioSD |
|-------- |----------:|----------:|----------:|------:|--------:|
| classic |  2.280 us | 0.0443 us | 0.0510 us |  1.00 |    0.03 |
| simdV1  | 25.672 us | 0.4196 us | 0.3720 us | 11.27 |    0.29 |

The SIMD version is 11 times slower than the naive version!?

I do not understand what is going on here. The likely culprit is Vector.Log. In order to use it, I had to upgrade to the dotnet 9 preview, because dotnet 8.0 did not offer it. Perhaps the implementation in preview is not quite there yet, or perhaps the instruction is not supported on my CPU. Beyond the performance issue, what I don’t like is that I have no idea where to start to understand the root cause, or what tools could be helpful here.

The final function I attempted was a linear combination over a collection of arrays. A good example of where you might use it would be computing the middle position of a collection of points (their barycenter). If you had n such points, represented by vectors $V_1, V_2, … V_n$ their average position would be $ \frac {1} {n} \times (V_1 + V_2 + … V_n) $.

More generally, a linear combination of n vectors would be something like $ c_1 \times V_1 + c_2 \times V_2 + … c_n \times V_n $, where $c_i$ is a scalar and $V_i$ is a vector.

The naive F# version would look something like this, iterating by columns:

let naive (vectors: (float * float[]) []) =
    let dim = (vectors.[0] |> snd).Length
    Array.init dim (fun col ->
        vectors
        |> Seq.sumBy (fun (coeff, v) -> coeff * v.[col])
        )

However, I could not manage to get something similar working using SIMD vectors. This is likely due to my lack of familiarity with Spans, but I got stuck on trying to create a collection I could work with in a similar fashion. Any hints on how to get that working would be super welcome!

So what? Parting words.

So where does this leave me?

First, I was lucky picking up the distance calculation as a starting point. This showed me that SIMD has the potential for very large calculation speedups. Had I started with another example, with less impressive results, I would probably not have spent that much time digging :)

My main take at the moment is that Vector<float> is quite different from what I expected a vector to be. Specifically, its fixed-size nature makes it tricky to compose efficiently. We can write specialized functions to perform one task efficiently, but what I would like to be able to do is work with composable primitives. As an example, consider this earlier example, translation:

let take1 (origin: float[], target: float[], coeff: float) =

    let origins = MemoryMarshal.Cast<float, Vector<float>>(ReadOnlySpan(origin))
    let targets = MemoryMarshal.Cast<float, Vector<float>>(ReadOnlySpan(target))

    let result = Array.zeroCreate<float> origin.Length
    let blockSize = Vector<float>.Count

    let multiplier = 1.0 - coeff
    for i in 0 .. (origins.Length - 1) do
        let o = origins.[i]
        let t = targets.[i]
        let movedTo = Vector.Multiply(multiplier, o) -  t
        movedTo.CopyTo(result, i * blockSize)
    result

Fundamentally, what we are doing here is $(1-coeff) \times origin - target$. This requires 2 operations: scalar x vector, and vector substraction. We could achieve that writing code along these lines:

let sub (v1: float [], v2: float []) =

    let result = Array.zeroCreate<float> v1.Length
    let blockSize = Vector<float>.Count

    let s1 = MemoryMarshal.Cast<float, Vector<float>>(ReadOnlySpan(v1))
    let s2 = MemoryMarshal.Cast<float, Vector<float>>(ReadOnlySpan(v2))

    for i in 0 .. (s1.Length - 1) do
        let diff = s1.[i] - s2.[i]
        diff.CopyTo(result, i * blockSize)
    result

let mult (scalar: float, v: float []) =

    let result = Array.zeroCreate<float> v.Length
    let blockSize = Vector<float>.Count

    let s = MemoryMarshal.Cast<float, Vector<float>>(ReadOnlySpan(v))

    for i in 0 .. (s.Length - 1) do
        let multiplied = scalar * s.[i]
        multiplied.CopyTo(result, i * blockSize)
    result

let take4  (origin: float[], target: float[], coeff: float) =

    sub (mult (1.0 - coeff, origin), target)

This works, but the performance, unsurprisingly, is not good, a bit worse than the naive F# version:

| Method  | Mean      | Error    | StdDev   | Ratio | RatioSD |
|-------- |----------:|---------:|---------:|------:|--------:|
| classic |  78.55 ns | 1.613 ns | 1.920 ns |  1.00 |    0.03 |
| simdV1  |  43.34 ns | 0.921 ns | 1.164 ns |  0.55 |    0.02 |
| simdV4  |  84.86 ns | 1.202 ns | 1.065 ns |  1.08 |    0.03 |

The problem here is that each time we perform an operation (sub, mult), we incur a cost, converting from arrays to SIMD vectors and back. What we would need here is a mechanism to keep chaining together SIMD Vector operations when appropriate, without getting in-and-out of the SIMD world in-between.

I suspect this can be achieved, and I might give that a try in a future post. In the meanwhile, I will stop here for today, and use SIMD only for hand-written specialized operations!

You can find the code for this post here on GitHub.

Should I use dotnet SIMD Vectors?

2024-09-01T00:00:00+00:00

Even though a lot of my work involves writing computation-heavy code, I have not been paying close attention to the System.Numerics namespace, mainly because I am lazy and working with plain old arrays of floats has been good enough for my purposes.

This post is intended as a first dive into the question “should I care about .NET SIMD-accelerated types”. More specifically, I am interested in understanding better Vector<T>, and in where I should use it instead of basic arrays for vector operations, a staple of machine learning.

Spoiler alert: some of my initial results surprised me, and I don’t understand yet what drives the speed differences between certain examples. My intent here is to share what I found so far, which I found interesting enough to warrant further exploration later on.

Anyways, let’s dive in. As a starting point, I decided to start with a very common operation in Machine Learning, computing the Euclidean distance between 2 vectors.

You can find the whole code here on GitHub.

First, what is the Euclidean distance? Given 2 real-valued vectors $x$ and $y$, where:

$x = (x_1, x_2, .. x_n)$

and

$y = (y_1, y_2, .. y_n)$

the distance between $x$ and $y$ is

$d(x, y) = \sqrt { (x_1 - y_1) ^ 2 + (x_2 - y_2) ^ 2 … + (x_n - y_n) ^ 2}$

One way to write this in F#, using float [] to represent vectors, is as follows:

let naive (v1: float[], v2: float[]) =
    (v1, v2)
    ||> Array.map2 (fun x y -> (x - y) ** 2)
    |> Array.sum
    |> sqrt

For simplicity I assume here that v1 and v2 have the same length.

So my goal here is two-fold: rewrite this using Vector<float>, and hopefully glean some insight on where this might be a good or a bad idea.

What are these Vectors?

The reason I am hoping to get some performance improvements is that, per the documentation,

The Vector structure provides support for hardware acceleration.

Let’s try first to construct a vector:

open System.Numerics

let vectorize (v: float []) =
    Vector<float>(v)

[| 0.0 .. 1.0 .. 10.0 |]
|> vectorize

This produces the following:

val it: Vector<float> = <0, 1, 2, 3> {Item = ?;}

That is most definitely not what the mathematician in me would expect! I got a vector all right, but it contains only 4 elements, instead of 11 in the original array. What is going on?

Per the documentation again:

The count of Vector instances is fixed, but its upper limit is CPU-register dependent.

In other words, a Vector<T> is quite different from a float [] or a mathematical vector. Its size is fixed, and depends on the type T:

> Vector<float>.Count;;
val it: int = 4

> Vector<single>.Count;;
val it: int = 8

> Vector<byte>.Count;;
val it: int = 32

Note also that a Vector<float> needs to be exactly 4 elements, if I understand things correctly. As an example, the following code crashes:

[| 0.0; 1.0; 2.0 |]
|> vectorize

All this has serious practical implications. If I want to write code that works with vectors of arbitrary size, like my naive F# distance function, I will have to break it down into chunks of 4 floats, write a function that operates on these chunks and still allow me to aggregate back to the correct overall result. And, of course, I want the overall speed to be faster, otherwise the entire exercise would be pointless.

Let’s consider the first question - can we use divide-in-fours and conquer to compute the distance? We can (with a caveat, more on that later), because:

$((x_1 - y_1) ^ 2 + … + (x_n - y_n) ^ 2) = ((x_1 - y_1) ^ 2 + (x_2 - y_2) ^ 2 + (x_3 - y_3) ^ 2 + (x_4 - y_4) ^ 2) + … +$

In other words, we can compute a sum by computing the sum of groups of 4, and then sum these together. Note that, by contrast, the square root cannot be applied on groups of 4, because in general

$\sqrt { (x + y) } \neq \sqrt { x } + \sqrt { y }$

In other words, we should be able to rewrite our distance function using vectors of size 4, but we need to be a little careful.

Now to the second point - why would I expect any speedup here? The answer is SIMD, or Single Instruction Multiple Data, what the documentation refers to as hardware acceleration. This is not my area of expertise, but my notice understanding is along these lines: SIMD enables applying the same operation to multiple data in one processor instruction. As a naive example, computing 1 + 2 + 3 + 4 would be performed as a single operation on a block of 4, instead of 3 operations (1 + 2, + 3, + 4).

Distance using Vector

Without further due, let’s try to rewrite the distance function, using Vector<T> instead of float []. My first attempt looked like this:

let take1 (v1: float[], v2: float[]) =
    let size = v1.Length
    let mutable total = 0.0
    for i in 0 .. (size - 1) / 4 do
        let s = 4 * i
        let v1 = Vector<float>(v1.[s .. s + 3])
        let v2 = Vector<float>(v2.[s .. s + 3])
        let diff = v1 - v2
        total <- total + Vector.Dot(diff, diff)
    sqrt total

Note: in addition to the previously mentioned issue around not checking if v1 or v2 have the same size, this code will also crash if the size of v1 or v2 is not a clean multiple of 4. Good enough for now, this is not intended for production :)

I break the arrays in chunks of 4, create vectors, compute their difference, and use what is called the vector dot product to compute the sum of the squared differences. Note how I kept sqrt outside, as the final operation.

Does this work? According to BenchmarkDotNet, it does:

| Method           | Mean       | Error     | StdDev    | Ratio | RatioSD |
|----------------- |-----------:|----------:|----------:|------:|--------:|
| classic          | 218.557 ns | 4.1251 ns | 6.1742 ns |  1.00 |    0.04 |
| simdV1           |  66.053 ns | 1.1213 ns | 0.9364 ns |  0.30 |    0.01 |

In spite of the overhead of splitting the work in chunks of 4 and re-aggregating the results, the speedup is notable - almost 4x faster. I tried it out on arrays of various sizes, from 4 to 100,000, and the results were roughly consistent.

A speedup by up to a factor of 4 is what I was expecting, given that we are operating on blocks of 4. This is pretty good, a x3.3 speedup is nothing to sneeze at. In particular if an operation is repeated often enough in an algorithm it might be worth rewriting it this way. On the other hand, this clearly has a cost attached - the modified version is significantly more complex than the original, and would still require additional work to handle cleanly arrays of arbitrary sizes.

A faster version

On a hunch, I wondered if using a Span could help, to avoid creating so many arrays in this function. There was also a bit of a hint in one of the constructors, Vector(values: ReadOnlySpan<float>). This line of thought led to take2:

let take2 (v1: float[], v2: float[]) =
    let size = v1.Length
    let s1 = ReadOnlySpan(v1)
    let s2 = ReadOnlySpan(v2)
    let mutable total = 0.0
    for i in 0 .. (size - 1) / 4 do
        let s = 4 * i
        let v1 = Vector<float>(s1.Slice(s, 4))
        let v2 = Vector<float>(s2.Slice(s, 4))
        let diff = v1 - v2
        total <- total + Vector.Dot(diff, diff)
    sqrt total

I was hoping for some marginal improvement - the result was unexpected:

| Method           | Mean       | Error     | StdDev    | Ratio | RatioSD |
|----------------- |-----------:|----------:|----------:|------:|--------:|
| classic          | 218.557 ns | 4.1251 ns | 6.1742 ns |  1.00 |    0.04 |
| simdV1           |  66.053 ns | 1.1213 ns | 0.9364 ns |  0.30 |    0.01 |
| simdV2           |   4.211 ns | 0.0865 ns | 0.0675 ns |  0.02 |    0.00 |

I was not expecting a x52 speedup!

To be perfectly honest, I don’t understand why this is so much faster. I can see how using Vector.Dot as a single operation would be better than many products and sums, but this is a very large speedup. It looks too good to be true, and got me wondering if perhaps there was something wrong with the way I setup my benchmarks, but after some checks, I can’t see anything amiss there.

Assuming my measurements are correct, that level of improvement piqued my interest. Again, there was a cost in writing that function using SIMD, but in the right spots in an algorithm, this can be worth the effort.

This success got me excited, and I tried it on a couple of different operations I commonly perform. The results were not as good, and at times even way worse than the naive implementation. I don’t see yet the patterns that influence what will or will not work, so… more investigations is needed!

Are the naive and SIMD versions equivalent?

A small point I wanted to bring up is that the SIMD version is not 100% equivalent to the original function. Using the same inputs, the calculated distances are very close, but not identical.

My guess (to be confirmed) is that by performing operations on groups of 4, and then aggregating, rounding can be subtly different.

Depending on the circumstances, this may or may not be acceptable. In the context of machine learning, I will typically compute a distance to know if 2 things are closer or further apart. I will happily take a x52 speedup, at the cost of a little precision lost. I imagine someone whose responsibility is to run financial models may care greatly about a small change far down the decimals, because it could have meaningful effects.

Anyways, that’s what I got for today! The tl;dr version is:

While requiring some effort to use, the SIMD accelerated Vector does seem to potentially bring bigger performance improvements than what I was expecting,
Where big improvements can be expected is not clear to me at all so far, and I will need to dig further,
Either I got very lucky and picked up a case that works very well by accident, or there is an error in my benchmark.

Hope you found something interesting in this post. If you are interested in the code, you can find it on GitHub. Cheers!

Quipu 0.2.2, a Nelder-Mead solver with a side of NaN

2024-04-20T00:00:00+00:00

The main reason I created Quipu is that I needed a Nelder-Mead solver for a real-world project. And, as I put Quipu through its paces on real-world data, I ran into some issues, revolving around “Not a Number” floating point values, aka NaN.

tl;dr: the latest release of Quipu, version 0.2.2, available on nuget, should handle NaN values decently well, and has some minor performance improvements, too.

In this post, I will go over some of the changes I made, and why. Fixing the main issue made me realize that I didn’t know floating point numbers as well as I thought, even though I have been using them every working day for years. I will take some tangents to discuss some of my learnings.

So let’s dig in. My goal with Quipu was to implement the Nelder-Mead algorithm in F#. The purpose of Nelder-Mead is to find a numeric approximation of values that minimize a function. As an illustration, if we took the function $f(x) = x ^ 2$, we would like to know what value of $x$ produces the smallest possible value for $f(x)$, which happens to be $x = 0$ in this case.

Quipu handles that case just fine:

open Quipu.NelderMead

let f x = x ** 2.0
f
|> NelderMead.minimize
|> NelderMead.solve

val it: Solution = Optimal (0.0, [|0.0|])

So far, so good. Now, what about a function like $f(x) = \sqrt{x}$?

That function is interesting for 2 reasons:

$f(x)$ has a minimum, for $x = 0$.
$f(x)$ is defined only for $x \ge 0$: it is a partial function.

Sadly, the previous version of Quipu, version 0.2.1, failed to find it. It would go into an infinite loop instead.

The Weird World of Floating Point Numbers

Why is that? Assuming we are working with real numbers (as opposed to imaginary ones), from the mathematician standpoint, the function $\sqrt{x}$ is not defined for strictly negative real numbers. Negative numbers are not part of the function domain: a negative number is not a “valid input”, and so there is no output for such a number.

However, in code, we don’t work with real numbers. We use floating point numbers. As a result, this will run:

> sqrt -1.0;;
val it: float = nan

From that standpoint, nan, or Not a Number, could be thought of as an implicit encoding of the function domain of definition. Where a mathematician would say “$f$ is defined only for this subset of real numbers”, with floating point numbers, we have “if $f(x) = nan$, then $x$ is not part of the domain of definition”.

At first glance, one would think that floating point numbers are more or less equivalent to real numbers. However, floating point numbers are an interesting beast. If you look up System.Double, you will notice a few fields:

NaN
PositiveInfinity, NegativeInfinity
MaxValue, MinValue

PositiveInfinity and NegativeInfinity are sensible, and correspond to the extended real number line.

MaxValue and MinValue make sense from a practical standpoint, but are amusing:

> let x = System.Double.MaxValue;;
val x: float = 1.797693135e+308
> x = x + 1.0;;
val it: bool = true
> x + x
val it: float = infinity

… which reminded me of this toot:

As a side note, I could not quite figure out what the rules were to go from MaxValue to PositiveInfinity.

But the one that is really interesting is NaN. If floating point numbers were representing real numbers, then by definition NaN could not be part of it, because, well, NaN is not a number. NaN makes the whole idea of floats representing reals a very weird can of worms. For instance, what are we saying when we write, for instance, NaN + NaN? How is that akin to a real number?

So NaN is weird, but it is also convenient. Contrast floats with integers: where 1 / 0 will throw an expensive exception, 1.0 / 0.0 will return NaN, fast. Speed is good - the price we have to pay for it is, it is up to us to remember that floats are a lie that could result in NaN potentially anywhere, and it is up to us to deal with it.

My mental picture for floats at that point is that they are not that far off an Option type, where NaN is the None case, and everything else is a “proper number”. Overall, they propagate through float function in a way that is similar to Option.map: once a NaN enters the flow of calculations, it will flow through and remain a NaN.

This is not entirely true. An odd tidbit of floating point trivia: nan ** 0.0 is equal to… 1.0. While it is true that any real number raised to the power 0 is 1, why NaN has been included here is a little bizarre!

Anyways, after this long digression on floating point numbers, let’s go back to the original topic, the solver bug. If you are interested in the topic of floats, I enjoyed reading this section on the design rationale of IEEE 754.

The bug and the fix

So to summarize the long meandering tangent above: floating point numbers NaN signal that a function inputs are outside of its domain of definition, and can arise anywhere floating point calculations are involved.

In the case of the Nelder-Mead algorithm, this is something we want to take into account, in case the function we are trying to minimize is partially defined, like $f(x) = \sqrt{x}$.

We can break down how the algorithm works in a few steps:

1) It maintains a set of candidate points, the simplex,

2) It tries to replace the worst point with a better one, to move to a “more promising search area”,

3) If that fails, the points are possibly surrounding the optimum value, so it shrinks them towards the best candidate and narrows down the “search area”,

4) When the “search area” is small enough, it stops the search.

If, as in the case of $f(x) = \sqrt{x}$, the function is partially defined, we will run into a couple of issues. We cannot reach step (3), because if we have points around 0 (the optimum value), then some points will be negative. These points will be outside the domain of definition (NaN), and we won’t be able to evaluate if that point is better or worse than others.

In other words, we need to ensure that at every step, every point in our simplex remains within the domain of definition, so we can evaluate whether it is better or worse.

This also means that our simplex will never be surrounding the optimum value. However, assuming the function is not too degenerate, it can work at finding a local minumum. Instead of finding a good area and shrinking, it will move towards a better area, until it gets too close to the boundaries of the domain, shrink, then move again closer towards the optimum, taking a smaller step, and possibly get close enough to the optimum to stop.

One interesting aspect of Nelder-Mead is how the steps are taken. Where a method like gradient descent decides on the direction and amplitude of the step based on the objective function, Nelder-Mead proceeds differently:

1) It tries a few candidate steps that depend only on the simplex. The direction and amplitude of the step does not depend on the objective function.

2) It evaluates each candidate step using the objective function.

This is helpful. It implies that all we have to do is make sure that in (2) we never take a step outside of the domain of definition, which only requires checking that the value of the objective function is not NaN.

Another potential issue is making sure that the simplex itself always remains “clean”, that is, we need to ensure that points in the simplex never contains NaN values. The nice thing here is that, if you look at the way the candidate steps are computed, they are all linear combinations of the simplex points. As adding and multiplying numbers that are not NaN will always produce a value that is not NaN, all we need to do is check once that the initial values contain no NaN. If that is the case, then mechanically every step taken will also result in a NaN-free simplex.

And that is pretty much what I did. I added a pre-check to enforce a valid initial simplex, and tracked down every evaluation of the objective function, removing candidate steps that would lead outside of the domain of definition.

Does it work? I am pretty sure it will not always work (Nelder-Mead does not guarantee a global optimum anyways), but it does work on some examples, like our starting problem:

let f x = sqrt x
f
|> NelderMead.minimize
|> NelderMead.startFrom (StartingPoint.fromValue [ 1.0 ])
|> NelderMead.solve

val it: Solution = Optimal (1.490116119e-08, [|2.220446049e-16|])

That’s what I got for today! Hope you found something interesting in this post. If you are interested in the code or the specific changes I made, you can find it on GitHub. Cheers!

Network maximum flow in F#

2024-02-26T00:00:00+00:00

An old math problem I had not seen since my university days resurfaced the other day, the Maximum Flow problem. It came up in the context of analyzing some industrial process. For illustration purposes, let’s say we are producing sausages, following these steps: we grind some meat, add some seasoning, then stuff and tie the sausage casings, and split them into delicious sausage links.

We could represent this process as a graph, like so:

``` mermaid
graph TD;
    grind_meat --> season_meat;
    season_meat --> stuff_casing;
    stuff_casing --> cut_links;

Now the question is, how many sausages per minute could we produce?

Assuming each operation is performed by a separate person, this is not very complicated. We are going to be as slow as the slowest link. So if for instance we could

grind meat for 20 sausages / minute,
season meat for 15 sausages per minute,
stuff 5 sausages per minute, and
cut 20 sausages per minute,

we would end up running at 5 sausages / minute at best, the bottleneck being stuffing.

Now we might be able to get a better throughput with some parallelization. For instance, we could organize production like so:

``` mermaid
graph TD;
    grind_meat --> season_meat_1;
    grind_meat --> season_meat_2;
    season_meat_1 --> stuff_casing1;
    season_meat_1 --> stuff_casing2;
    season_meat_2 --> stuff_casing2;
    season_meat_2 --> stuff_casing3;
    stuff_casing1 --> cut_links_1;
    stuff_casing2 --> cut_links_1;
    stuff_casing3 --> cut_links_1;

This is still not overly complicated, but it is beginning to be hairy, and you can imagine how with a few more processes added, the question “how much work can I process through this network” will soon become impractical to handle by hand.

This is essentially what the Maximum Flow problem is about. Given a directed graph, with capacity limitations, how much throughput (flow) can we achieve? In the rest of this post, I’ll go through one way you could answer that question, using Linear Programming.

Representing the network

Let’s start by representing our process as a network, with Nodes (each operation we need to perform) and their capacity, and Edges (how the operations are connected sequentially).

There are multiple representations we could take, we will go with this one:

type NodeID = | NodeID of int

type Node = { Capacity: float }

type Edge = {
    Orig: NodeID
    Dest: NodeID
    }
    with
    member this.Name = $"{this.Orig}-{this.Dest}"

let edge (node1, node2) = { Orig = node1; Dest = node2 }

Armed with this, we can now represent our sausage factory:

let nodes =
    [
        // Grinder
        NodeID 1, { Capacity = 20.0 }
        // Seasoning
        NodeID 2, { Capacity = 15.0 }
        NodeID 3, { Capacity = 15.0 }
        // Stuffing
        NodeID 4, { Capacity = 5.0 }
        NodeID 5, { Capacity = 5.0 }
        NodeID 6, { Capacity = 5.0 }
        // Links
        NodeID 7, { Capacity = 20.0 }
    ]
    |> Map.ofList

let network = [
    edge (NodeID 1, NodeID 2)
    edge (NodeID 1, NodeID 3)
    edge (NodeID 2, NodeID 4)
    edge (NodeID 2, NodeID 5)
    edge (NodeID 3, NodeID 5)
    edge (NodeID 3, NodeID 6)
    edge (NodeID 4, NodeID 7)
    edge (NodeID 5, NodeID 7)
    edge (NodeID 6, NodeID 7)
    ]

Setting up the MaxFlow problem as a Linear Programming problem

Now that we have a network, let’s see how much flow we can push through it.

We are trying to push as much as possible through each edge, under 2 constraints:

Capacity: we cannot push more to a node that it can handle,
Conservation: the total flow that enters a node must exit that node.

The conservation constraint has a caveat: it does not apply to a Source or a Sink. Nodes that have no predecessor (Sources) receive no flow, and nodes that have no successors (Sinks) have no flow out.

Let’s setup that problem as a linear programming one, using the Google OR Tools library, by first loading the package in our script:

#r "nuget: Google.OrTools, 9.8.3296"
open Google.OrTools.LinearSolver

Our first step will be to instantiate a solver:

let solver = Solver.CreateSolver("GLOP")

Our variables here will be the flow that goes through each edge. Let’s create one variable per edge, which must be a positive number:

let variables =
    network
    |> List.map (fun edge ->
        let var = solver.MakeNumVar(0.0, infinity, edge.Name)
        edge, var
        )
    |> Map.ofList

Here I create one variable per edge. Each variable can take any value between 0 and +infinity. For convenient manipulation later, I add them all into a map.

Let’s tackle the Capacity constraint next, which we can express as follows: for any node, the total flow of edges that enter the node must be less than its capacity:

nodes
|> Map.iter (fun nodeID node ->
    let capacityConstraint = solver.MakeConstraint($"CAPACITY {nodeID}")
    capacityConstraint.SetBounds(0.0, node.Capacity)
    network
    |> List.filter (fun edge -> edge.Dest = nodeID)
    |> List.iter (fun edge ->
        capacityConstraint.SetCoefficient(variables.[edge], 1.0)
        )
    )

Here I create a constraint for each node, taking every edge that enters that node by filtering the edges first, and summing up the flow going through each of these edges (variable.[edge]).

Almost there! We just have the Conservation constraint left. For each node that has edges coming in and exiting, the flow entering must equal the flow exiting. Let’s go:

nodes
// keep only nodes that have incoming and outgoing edges
|> Map.filter (fun nodeID _ ->
    network
    |> List.exists (fun edge -> edge.Dest = nodeID)
    &&
    network
    |> List.exists (fun edge -> edge.Orig = nodeID)
    )
|> Map.iter (fun nodeID node ->
    let capacityConstraint = solver.MakeConstraint($"CONSERVATION {nodeID}")
    capacityConstraint.SetBounds(0.0, 0.0)
    // incoming flow
    network
    |> List.filter (fun edge -> edge.Dest = nodeID)
    |> List.iter (fun edge ->
        capacityConstraint.SetCoefficient(variables.[edge], 1.0)
        )
    // outgoing flow
    network
    |> List.filter (fun edge -> edge.Orig = nodeID)
    |> List.iter (fun edge ->
        capacityConstraint.SetCoefficient(variables.[edge], -1.0)
        )
    )

Here, rather than stating “flow in = flow out”, we re-arrange into an equivalent expression, “flow in - flow out = 0”.

Solving the MaxFlow problem with Linear Programming

We have variables, we have constraints - all that is left to do is ask the solver to perform its magic and find optimal values for the variables:

let objective = solver.Objective()
objective.SetMaximization()

variables
|> Map.iter (fun _ variable ->
    objective.SetCoefficient(variable, 1.0)
    )

let solution = solver.Solve()

Which produces the following result:

val solution: Solver.ResultStatus = OPTIMAL

We have an optimal solution! But what is that solution? Let’s inspect the variable values:

variables
|> Map.iter (fun edge var ->
    let flow = var.SolutionValue()
    printfn $"{edge.Orig} - {edge.Dest}: {flow}"
    )

Which produces the following results:

NodeID 1 - NodeID 2: 5
NodeID 1 - NodeID 3: 10
NodeID 2 - NodeID 4: 5
NodeID 2 - NodeID 5: 0
NodeID 3 - NodeID 5: 5
NodeID 3 - NodeID 6: 5
NodeID 4 - NodeID 7: 5
NodeID 5 - NodeID 7: 5
NodeID 6 - NodeID 7: 5

Can we visualize this as a graph? Sure we can, let’s convert this into a quick-and-dirty mermaid chart:

variables
|> Seq.map (fun kv ->
    let edge = kv.Key
    let var = kv.Value
    let flow = var.SolutionValue()
    let (NodeID orig) = edge.Orig
    let (NodeID dest) = edge.Dest
    $"{orig}-- {flow} -->{dest}"
    )
|> String.concat ";\n"
|> fun graph ->
   $"```mermaid
graph TD;
{graph}
```"

… which produces the following visual representation of our solution:

```mermaid
graph TD;
1-- 5 -->2;
1-- 10 -->3;
2-- 5 -->4;
2-- 0 -->5;
3-- 5 -->5;
3-- 5 -->6;
4-- 5 -->7;
5-- 5 -->7;
6-- 5 -->7

Conclusion

Here you have it, one way to solve the MaxFlow problem, using Linear Programming. This exercise reminded me of why I enjoy Linear Programming so much. The hard work is figuring out exactly what the problem is and how to state it, once that is done, the work is done. We don’t have to worry about the gory details of how to actually solve it, that is the solver job.

As a side note, the problem I solved here is a slight variation of the Max Flow problem. The canonical problem has capacity constraints on the edges and not the nodes, but they are fundamentally the same.

Two final comments before closing shop for today. First, and I have not checked this, I think the approach would also work for a network with loops or even entirely closed, or a network with multiple Sources and Sinks. Then, interestingly, while we have an explicit solution to the problem, we do not have a direct answer to the original question, namely “what is the total flow we can push through this network”. To answer that question, you would have to compute the total flow in across all Sinks, or the total flow out across all Sources. This still leaves open one weird edge case - closed circuits.

Anyways, that’s it for today!

Study notes: constraints in Quipu Nelder-Mead solver

2023-11-23T00:00:00+00:00

In my previous post, I went over the recent changes I made to my F# Nelder-Mead solver, Quipu. In this post, I want to explore how I could go about handling constraints in Quipu.

First, what do I mean by constraints? In its basic form, the solver takes a function, and attempts to find the set of inputs that minimizes that function. Lifting the example from the previous post, you may want to know what values of $(x,y)$ produce the smallest value for $f(x,y)=(x-10)^2+(y+5)^2$. The solution happens to be $(10,-5)$, and Quipu solves that without issues:

#r "nuget: Quipu, 0.2.0"
open Quipu.NelderMead

let f (x, y) = (x - 10.0) ** 2.0 + (y + 5.0) ** 2.0
NelderMead.minimize f
|> NelderMead.solve

val it: Solution = Optimal (2.467079917e-07, [|9.999611886; -4.999690039|])

However, in many situations, not every value will do. There might be restrictions on what values are valid, such as “x must be positive”, or “y must be less than 2”. These are known as constraints, and typically result in an inequality constraint, in our case something like $g(x,y) \leq 0$. How could we go about handling such constraints in our solver?

In this post, I will look into some possible approaches to minimize a function under a set of constraints. I will do it the hard way, manually, hoping that the exercise will provide some direction on how to modify the library to make that easy in the future.

First take: a crude penalty

Let’s keep the original function, $f(x,y)=(x-10)^2+(y+5)^2$, but imagine that we have one constraint: $x \leq 5$. Our original solution $(10,-5)$ is not valid in that case: $x > 5$, or, in technical terms, the constraint is not satisfied.

For any value of $x > 5$, we have a problem. One approach here is to add a penalty to our function, such that any value that does not satisfy a constraint will cause the objective to increase. In that case, the Nelder-Mead solver will avoid movements towards these values. Let’s try that:

let g (x, y) =
    f (x, y)
    +
    // we incorporate the constraint in the objective
    (if x <= 5.0 then 0.0 else infinity)

We keep the original objective function, $f$, but we add in a penalty term as well, creating a modified objective function, $g$. If the constraint is not satisfied, apply a penalty of $+\infty$, otherwise ignore the constraint and simply return $0$. Does this work?

let solution1 =
    g
    |> NelderMead.minimize
    |> NelderMead.solve

val it: Solution = Optimal (25.00000157, [|4.999999857; -5.000363939|])

It does! The optimal solution is now $(5,-5)$, which does indeed satisfy the constraint. We could easily expand on this idea, adding a penalty function for any other constraint we might have.

Are we done, then? Well, not quite. By default, Quipu will start its search around $0$, here $(0,0)$. However, what happens if we started around, say, $(20,0)$?

let problem =
    g
    |> NelderMead.minimize
    |> NelderMead.startFrom (StartingPoint.fromValue [ 20.0; 0.0 ])
    |> NelderMead.solve

Sadly, the solver goes into an endless loop that never terminates. The problem here is that when we start around $(20,0)$, we are in a region where the constraint is not satisfied. Every search direction results in $+\infty$, and the solver has nowhere to go - every direction looks equally bad.

In other words, if we happen to start from a position where constraints are not satisfied, we are going to run into trouble.

Another related problem: this approach will not work well to handle equality constraints. Besides inequality constraints, a common constraint type is an equality. For instance, we might want something like $x+y=20$.

A common trick in optimization to handle equality constraints is to turn them into 2 inequalities. A perhaps counter-intuitive way to state $x+y=20$ is the following: $x+y \leq 20$ and $x+y \geq 20$. While this might appear weird, it is convenient. If we can handle inequality constraints, we get equality constraints for free, by converting equalities into pairs of inequalities.

However, this will be causing our penalty function issues. By definition, unless we are exactly on the values that satisfy our constraint, one of the two inequalities will result in a penalty of $+\infty$. Like in the previous situation we discussed, every move by the solver will look equally terrible.

Second take: better penalties

So what can we do? One approach is to use a progressive penalty. We want a function that will return $0$ when the constraint is satisfied, and a value that becomes increasingly larger as we move further away from it being satisfied.

We could for instance do something like this:

let simplePenalty (x, y) =
    f (x, y)
    +
    (if x <= 5.0 then 0.0 else ((x - 5.0) ** 2.0))

Now the penalty term will return $0$ if the constraint is satisfied, and $(x-5)^2$ otherwise. For values close to $5$, the penalty will be small, but as $x$ moves further away from $5$, the penalty will become steeper and steeper.

Let’s try this out, starting our search from the point that was giving us trouble before, $(20,0)$:

simplePenalty
|> NelderMead.minimize
|> NelderMead.startFrom (StartingPoint.fromValue [ 20.0; 0.0 ])
|> NelderMead.solve

val it: Solution = Optimal (12.50000014, [|7.500152792; -4.999694746|])

Does this work? Well, sort of, but not really. On the one hand, the solver does not get stuck, and returns an optimal solution, $(7.5,-5)$. On the other hand, the solution is neither optimal (it should be $(5,-5)$), nor the constraint satisfied either ($7.5 > 5$). Instead of no answer, we get a pretty bad answer.

The issue here is that the constraint is “soft”. A minor violation of the constraint will result in a small penalty. In other words, if our solution does not satisfy the constraint, but is close to the limit, the penalty is small enough to be acceptable, so to speak.

What we could do then is make the penalty steeper. Let’s make it 100 times steeper:

let steeperPenalty (x, y) =
    f (x, y)
    +
    (if x <= 5.0 then 0.0 else 100.0 * ((x - 5.0) ** 2.0))

val it: Solution = Optimal (24.75247568, [|5.049540943; -5.000552666|])

Still not quite right, but much better. How about 10,000 steeper?

Optimal (24.99750049, [|5.000501938; -4.999554925|])

As we crank up the aggressiveness of the penalty, we get solutions that are closer and closer to the correct answer. This suggests a possible strategy: solve iteratively, starting with a soft constraint, and make it progressively steeper, until we are close enough.

Here is a quick sketch of how this might look like. First, we create a penalty that takes in a coefficient, describing how aggressive the penalty is:

let penalty coeff =
    let f (x, y) =
        f (x, y)
        +
        (if x <= 5.0 then 0.0 else coeff * ((x - 5.0) ** 2.0))
    f

Then, we solve our problem, starting with a coefficient of 1, and increasing it by a factor 10 each iteration, starting from the solution identified during the previous pass:

let rec solve (i: int, startingPoint: seq<float>) =
    printfn $"Iteration {i}"
    let coeff = 10.0 ** i
    let solution =
        penalty coeff
        |> NelderMead.minimize
        |> NelderMead.startFrom (StartingPoint.fromValue startingPoint)
        |> NelderMead.solve
    if i >= 5
    then solution
    else
        let nextStart =
            match solution with
            | Optimal (_, x) -> x
            | _ -> failwith "Ooops"
        printfn $"{List.ofArray nextStart}"
        solve (i + 1, nextStart)

solve (0, [ 20.0; 0.0 ])

Iteration 0
[7.500152791643328; -4.999694746077196]
Iteration 1
[5.454595839229248; -4.999507451495937]
Iteration 2
[5.049548981640678; -5.000000777860209]
Iteration 3
[5.00499712795882; -5.000337947630191]
Iteration 4
[5.000501780625028; -5.000266170674201]
Iteration 5

This is a sketch, and would need some refinements. In particular, stopping after 5 iterations is totally arbitrary. We should probably stop once the constraints are all within certain bounds (and figure out pesky details like what to do if we never manage to satisfy the constraints…).

With that caveat, things do appear to work as expected. As we make the constraint iteratively stiffer, $x$ gets progressively closer and closer to $5$. I also tried out an equality constraint, and the results were what I expected.

For the sake of completeness, I also need to point out an odd result. If you run the algorithm for a little longer, you might observe that the $y$ values oscillate between $5$ and $4.06$. I am not sure what is going on at that point.

Parting words

As I was doing some reading on constrained optimization, I came across another approach, barrier functions. Where penalty functions add a penalty to the objective when a constraint is not satisfied, barrier functions create a penalty inside the feasible domain. The closer you approach a penalty, the steeper the penalty.

This is an interesting approach, but after some thinking, I believe it won’t work for Nelder-Mead. A barrier should work well if the search algorithm relies on gradients, because the step size depends on the gradient. However, Nelder-Mead does not rely on gradients (which is one of its advantages). While the step direction depends on the function, the step size depends only on the geometry of the current simplex. As a result, a barrier would have no direct impact: the standard algorithm could still take steps leading outside of the feasible domain, where all constraints are satisfied, and we would encounter the same exact issue we had with our original, crude penalty function.

I imagine you could modify the algorithm to perhaps take more adaptive steps, but in the meantime, the penalty direction seems more promising. I will probably take a stab at incorporating constraints in the current solver using penalties in the next few weeks - we’ll see how that goes!

In the meantime, you can find the current code here:

Code on GitHub.

Version 0.2 of the Quipu Nelder-Mead solver

2023-11-11T00:00:00+00:00

Back in April ‘23, I needed a simple solver for function minimization, and published a basic F# Nelder-Mead solver implementation on NuGet. I won’t go over the algorithm itself, if you are curious I wrote a post breaking down how the Nelder-Mead algorithm works a while back.

In a nutshell, the algorithm takes a function, and finds the set of inputs that produces the smallest output for that function. The algorithm is not foolproof, but it is very useful, and has the benefit of being fairly simple.

After dog-fooding my library for a bit, I found some rough spots, and decided it was time to make improvements. As a result, the API has changed a bit - hopefully for the better! In this post, I’ll go over some of these changes.

Basic usage

Imagine that you are interested in the following function:

$ f(x,y)=(x-10)^2+(y+5)^2 $

Specifically, you would want to know what values of $(x,y)$ produce the smallest value for $f$.

This is how you would go about it with Quipu in an F# script:

#r "nuget: Quipu, 0.2.0"
open Quipu.NelderMead

let f (x, y) = (x - 10.0) ** 2.0 + (y + 5.0) ** 2.0
NelderMead.minimize f
|> NelderMead.solve

This produces the following output:

val it: Solution = Optimal (2.467079917e-07, [|9.999611886; -4.999690039|])

The solver has found an Optimal solution, for $x=9.999,y=-4.999$, which yields $f(x,y)=2.467 \times 10^{-7}$, very close to the correct answer, $f(10,-5)=0$.

Improvements: search starting point

There were a few reasons I wanted to make some changes to the API.

First, I wanted better control over the search starting point.

In the basic usage example, the search will start with a simplex centered on 0, with vertices on a sphere of radius 1. The new version allows you to specify a starting point, which will generate a regular simplex on a sphere of arbitrary radius. Stated more simply, you can now specify in which region you want the search to begin. Pass it a starting point and a radius, and the search will begin with n vertices located on a sphere of the requested radius:

NelderMead.minimize f
|> NelderMead.startFrom (StartingPoint.fromValue ([1.0; 2.0], 0.1))
|> NelderMead.solve

This is useful in situations where you want to start in a specific region. You can specify where to start, and how wide or tight the original search simplex should be.

This improves on version 0.1, where the search for a function of $n$ arguments was initiated using a set of $2n+1$ vertices, where $n+1$ are sufficient.

Under the hood, this will call the following function:

Simplex.create ([| 1.0; 2.0 |], 0.1)

… creating the following regular simplex, centered on $(1,2)$:

val it: Simplex =
  Vectors
  (2,
   [|[|1.025881905; 1.903407417|]; [|0.9034074174; 2.025881905|];
     [|1.070710678; 2.070710678|]|])
    {dimension = 2;
     size = 3;}

Improvements: termination

Version 0.1 stopped the search when all values of $f$ were within precision bounds. I decided to tighten the criterion, requiring that every argument should also be within the same bounds.

The reason I made that change was that the original approach could result in an premature termination. In situations where the function being minimized is “flat” around the optimum, the search could stop early, with a wide simplex. Tightening the rules forces the simplex to contract around the minimum.

As an example, in the basic usage, the tolerance is set to $0.001$. We can relax this:

NelderMead.minimize f
|> NelderMead.withConfiguration
    { Configuration.defaultValue with
        Termination = {
            Tolerance = 0.1
            MaximumIterations = None
        }
    }
|> NelderMead.solve

This produces the following result, where $(x,y)$ and $f$ are within $0.1$ of the correct value:

Optimal (0.001308370319, [|10.03105359; -5.01854845|])

Tighten up the tolerance like so:

NelderMead.minimize f
|> NelderMead.withConfiguration
    { Configuration.defaultValue with
        Termination = {
            Tolerance = 0.000_001
            MaximumIterations = None
        }
    }
|> NelderMead.solve

… and the search produces much tighter results, within the new tolerance:

Optimal (1.78601232e-13, [|10.00000009; -4.999999587|])

Parting words

There are still a few improvements I want to make, but I believe the code is now in a much better state that previously! If you are interested in perusing the code, you can find it here:

Code on GitHub

I think my next steps will be focused on

Improving the detection of abnormal situations,
Improving the performance of the core algorithm.

Besides that, one thing I’d like to try out is adding constraints to the problem, something along the lines of $argmin_{x,y}(f(x,y))$, subject to a list of inequality constraints like $3 \times x - y^2 \geq 10$.

I imagine that’s something I should be able to do with penalty / barrier functions. However, I haven’t had much experience with that approach, and I can also already see in my mind all sorts of complications arising!

At any rate, this is where I will stop for today. Hope you found something of interest in this post, and perhaps you’ll even have a use for this library!

Data Science in F# 2023: an Ode to Linear Programming

2023-10-29T00:00:00+00:00

In September, I had the great pleasure of attending the Data Science in F# conference in Berlin. I gave a talk and a workshop on Linear Programming, and figured I would make the corresponding material available, in case anybody is interested:

Linear Programming is perhaps an unusual topic for a data science conference. It is certainly a departure from my usual focus on Machine Learning with F#! I wanted to talk about Linear Programming, and its extension, Mixed Integer Linear Programming, because in my view, that technique is criminally under-appreciated. In particular, I have seen many projects start with the premise that “we need to use Machine Learning (or AI) to solve this”, when in fact Linear Programming would have offered a better, faster and cheaper solution. This talk and workshop are my attempt at re-habilitating LP, and hopefully helping you not overlook this old but very powerful technique!

As a side note, in case you could not make it to the conference, I encourage you to check out the FsLab blog, where information about the other talks should be published soon!

Game of Life in Avalonia, MVU / Elmish style, take 2

2023-06-28T00:00:00+00:00

This is a follow-up to my recent post trying to implement the classic Conway Game of Life in an MVU style with Avalonia.FuncUI. While I managed to get a version going pretty easily, the performance was not great. The visualization ran OK until around 100 x 100 cells, but started to degrade severely beyond that.

After a bit of work, I am pleased to present an updated version, which runs through a 200 x 200 cells visualization pretty smoothly:

As a side note, I wanted to point out that the size change is significative. Increasing the grid size from 100 to 200 means that for every frame, the number of elements we need to refresh grows from 10,000 to 40,000.

In this post, I will go over what changed between the two versions.

You can find the full code here on GitHub

Upgrading from Avalonia.FuncUI 0.5.0 to 1.0.0-rc.1.1.1

The first change I made was simply to upgrade from JaggerJo.Avalonia.FuncUI version 0.5.0 to the recently published pre-release Avalonia.FuncUI version 1.0.0-rc.1.1.1.

How I picked the original version was mostly by accident. I got a little confused between the various forks and documentation sources for the library, and I think I landed on that one because of the templates.

Regardless, the update was pretty straightforward. I replaced the dependencies, which brought Avalonia up from version 0.10.12 to 11.0.0.rc1.1. This required 2 changes to the original code:

1) Minor changes in `Program.fs`

This part launches the application. See this commit for details, nothing particularly interesting going on here.

2) Changes to the asynchronous update

That change was more interesting. In my original version, I triggered updates by emitting a delayed asynchronous command, like so:

Cmd.OfAsync.perform
    (fun () -> async { do! Async.Sleep config.RefreshIntervalMilliseconds })
    ()
    (fun () -> NextGeneration)

This compiled just fine in the updated version, but exploded at runtime. Based on the exceptions, I suspected that the source of the issue was an operation not running on the UI thread. After a bit of tinkering, and reading an older post on writing non-blocking user-interfaces in F# by Tomas Petricek, I ended up modifying the code into this:

let update (msg: Msg) (state: State): State * Cmd<Msg> =
    match msg with
    // omitted for brevity
    | NextGeneration ->
        // omitted for brevity
        let ctx = SynchronizationContext.Current
        let cmd =
            Cmd.OfAsync.perform
                (fun () -> async {
                    do! Async.Sleep config.RefreshIntervalMilliseconds
                    do! Async.SwitchToContext ctx
                    return Msg.NextGeneration
                    }
                )
                ()
                id
        { state with
            Cells = updated;
            Generation = state.Generation + 1
        },
        cmd

Note: I could also have used a subscription with a timer, as outlined in some of the samples. However, I was interested in trying out this approach, as an example of background async processing.

This already produced minor performance improvements, but it was still not where I wanted it to be. So I grabbed dotTrace again for some profiling.

Careful with F# lists

Among other things, profiling lead me to a hotspot in Avalonia.FuncUI itself (slightly reformatted here):

let diffContentMultiple (lastList: IView list, nextList: IView list) : ViewDelta list =
    nextList
    |> List.mapi (fun index next ->
        if index + 1 <= lastList.Length then
            Differ.diff(lastList.[index], nextList.[index])
        else
            ViewDelta.From next
    )

The intent of this function goes something like this: if a UI element contains a list of nested UI elements (IView), compare the view before (lastList) and after (nextList) the view update. Compute the differences if there is an element in both (Differ.diff), otherwise, if new elements have been added to the list, compute ViewDelta for the new elements.

Now, typically there won’t be many nested elements. However, in my case, that list is pretty massive (40,000 elements for a 200 x 200 grid), and this is where things begin to fall apart, for 2 reasons. An F# list is a linked list, and as a result:

Accessing an item by index in a List scales with the index of the list,
Computing the length of a list scales with the length of the list.

Let’s illustrate with a crude benchmark in the scripting environment, reproducing the situation with 2 simplified examples:

#time "on"

let list_10 = [ 1 .. 10 ]
let list_1_000 = [ 1 .. 1_000 ]
let list_100_000 = [ 1 .. 100_000 ]

let index list =
    list
    |> List.mapi (fun i x -> list.[i])
    |> ignore

let length list =
    list
    |> List.mapi (fun i x -> list.Length)
    |> ignore

> index list_10;;
Real: 00:00:00.002, CPU: 00:00:00.000, GC gen0: 0, gen1: 0, gen2: 0

> index list_1_000;;
Real: 00:00:00.002, CPU: 00:00:00.000, GC gen0: 0, gen1: 0, gen2: 0

> index list_100_000;;
Real: 00:00:05.219, CPU: 00:00:04.500, GC gen0: 0, gen1: 0, gen2: 0

> length list_10;;
Real: 00:00:00.002, CPU: 00:00:00.000, GC gen0: 0, gen1: 0, gen2: 0

> length list_1_000;;
Real: 00:00:00.003, CPU: 00:00:00.031, GC gen0: 0, gen1: 0, gen2: 0

> length list_100_000;;
Real: 00:00:10.297, CPU: 00:00:09.656, GC gen0: 0, gen1: 0, gen2: 0

These are rough measurements, using the timer in fsi. Even if the measurements might not be entirely accurate, the big picture is clear. Everything is fine for lists of 10 or 1,000 elements, but we fall off a cliff for 100,000 elements, going from milliseconds to seconds. The problem is two-fold: as the lists get longer,

we make the same calls more and more often,
the calls themselves get slightly worse for longer lists.

Long story short, I submitted a proposed improvement, and a fun discussion ensued with JaggerJo and Numpsy, exploring alternatives. And the result is now part of Avalonia.FuncUI version 1.0.0-rc.1.1.1!

Parting words

I had a lot of fun digging into this issue, especially because it made such an improvement in that little Game of Life implementation! I usually don’t spend that much time performance tuning, but I find it enjoyable to hone in on one very narrow problem, and dissect the hell out of it.

I will probably do another pass at looking for performance hot spots. In general it’s an interesting problem, basically efficiently identifying the diff between 2 lists of arbitrary sizes. However, I suspect it’s going to be harder to find similarly clean hotspots - after all, I found that one only because of that specific Game of Life example, which happens to push the number of UI elements beyond what you would typically expect :)

And… thanks again to JaggerJo and Numpsy for a fun discussion!

If you have comments or questions, hit me up on Mastodon!

You can find the full code here on GitHub

WIP: Game of Life in Avalonia, MVU / Elmish style

2023-06-17T00:00:00+00:00

A couple of days ago, I came across a toot from Khalid Abuhakmeh, showcasing a C# + MVVM implementation of the Game of Life on Avalonia. I have been experimenting with Avalonia funcUI recently, and thought a conversion would be both a fun week-end exercise, and an interesting way to take a look at performance.

Long story short, I took a look at his repository as a starting point, and proceeded to rewrite it in an Elmish style, shamelessly lifting the core from his code. The good news is, it did not take a lot of time to get it running, the less good news is, my version has clear performance issues.

In this post, I will go over how I approached it so far, and where I think the performance issues might be coming from. In a later post, I’ll try to see if I can fix these. As the French saying goes, “A chaque jour suffit sa peine”.

You can find the full code here on GitHub

Modeling the Game of Life, F# remix

Overall I deliberately kept the design close to Khalid’s version – in part out of laziness, in part to facilitate comparison.

At its core, my model is a 2D array of cells. The main difference with the C# model is that a Cell is represented as a Discriminated Union:

type Cell =
    | Dead
    | Alive of age: int

A Cell is either Dead or Alive, in which case we track for how many generations it has been alive for. As a result, our State is simply a 2D array of cells, where the position of the cell is its indices:

type State = {
    Generation: int
    Running: bool
    Cells: Cell [,]
    }

Calculating the next generation follows simple rules:

A Dead cell will come alive if it has exactly 3 live neighbors,
A Live cell will stay alive if it has exactly 2 or 3 live neighbors.

That part can be expressed like so:

match cells.[row, col] with
| Dead ->
    if liveNeighbors = 3
    then Alive 0
    else Dead
| Alive age ->
    if liveNeighbors = 2 || liveNeighbors = 3
    then Alive (age + 1)
    else Dead

The painful part was counting the number of liveNeighbors. We need to check all 8 adjacent cells, ignoring the ones that fall off the board at the edges. This is probably not the smartest way to go about it, but I ended up creating a list of offsets from the current cell:

let neighbors =
    [
        -1, -1
        -1, 0
        -1, 1
        0, -1
        0, 1
        1, -1
        1, 0
        1, 1
    ]

… which allows me to iterate over the offsets and count the live neighbors:

let nextGeneration (cells: Cell [,]) (row: int, col: int) =
    let isAlive (row, col) =
        if row < 0 || col < 0 || row >= cells.GetLength(0) || col >= cells.GetLength(1)
        then false
        else cells.[row, col] <> Dead
    let liveNeighbors =
        neighbors
        |> Seq.sumBy (fun (dx, dy) ->
            if isAlive (row + dx, col + dy)
            then 1
            else 0
            )
    match cells.[row, col] with
    | Dead ->
        if liveNeighbors = 3
        then Alive 0
        else Dead
    | Alive age ->
        if liveNeighbors = 2 || liveNeighbors = 3
        then Alive (age + 1)
        else Dead

That’s pretty much it for the model itself. The view rendering follows Khalid’s approach pretty closely, a UniformGrid with one Rectangle per cell:

UniformGrid.create [

    UniformGrid.margin 5

    UniformGrid.columns state.Columns
    UniformGrid.rows state.Rows

    UniformGrid.width (state.Columns * config.CellSize |> float)
    UniformGrid.height (state.Rows * config.CellSize |> float)

    UniformGrid.children [
        for row in 0 .. state.Rows - 1 do
            for col in 0 .. state.Columns - 1 do
                match state.Cells.[row, col] with
                | Dead -> deadCell
                | Alive age ->
                    if age < 2
                    then youngCell
                    else oldCell
        ]
    ]

Where deadCell is defined as

let deadCell =
    Rectangle.create [
        Rectangle.width config.CellSize
        Rectangle.height config.CellSize
        Rectangle.fill "Black"
        ]

One piece that is perhaps interesting is the update loop itself. The way I approached it is by sending delayed messages back to the update function, like so (omitting some details for clarity):

let update (msg: Msg) (state: State): State * Cmd<Msg> =
    match msg with
    | NextGeneration ->
        let updated =
            state.Cells
            |> Array2D.mapi (fun row col _ ->
                nextGeneration state.Cells (row, col)
                )
        { state with
            Cells = updated;
            Generation = state.Generation + 1
        },
        waitAndUpdate

Whenever a NextGeneration message arrives, the new state is computed, and emites a command, waitAndUpdate:

let waitAndUpdate =
    Cmd.OfAsync.perform
        (fun () -> async { do! Async.Sleep config.RefreshIntervalMilliseconds })
        ()
        (fun () -> NextGeneration)

Essentially, we sleep for the RefreshIntervalMilliseconds, and upon completion we fire another message, NextGeneration, which goes back to the update function, triggering the delayed computation of another generation, followed by another NextGeneration message.

Performance

Khalid mentioned somewhere that his MVVM version got

a 250x250 UniformGrid showing the game of life at a reasonable pace

I can’t say the same of my current version. At the moment, things start to crumble around 100x100, with an unresponsive UI.

A good starting point when looking at a code issue is “my code has issues”. So, as a sanity check, I did a quick and dirty benchmark for how long it took to generate 1,000 generations, for a 250 x 250 population, no UI involved. This takes around 12 seconds on my machine. I am sure I can squeeze some improvements there, but with 12-ish milliseconds for a generation update, this is not the source of the issue.

The next step was profiling with dotTrace: run for 3 minutes, and see what happens:

I am not an expert on profiling, but my sense from what I am seeing here is that rendering is dying under pressure. What jumps out to me from a casual inspection is: half the time spent in lock contention, and there is a whole lot of UI freeze, and calls to Avalonia.Rendering.DeferredRenderer.Render(), and to a lesser extent DrawPath, CreatePaint, DrawGeometry.

So… what next?

What I think is happening is, updates are happing too fast for rendering to keep up. Assuming a full redraw, each generation requires a refresh of:

50 x 50: 2,500 rectangles,
100 x 100: 10,000 rectangles,
150 x 150: 22,500 rectangles,
200 x 200: 40,000 rectangles,
250 x 250: 62,500 rectangles.

Given that the loop produces a new updated grid to render at fixed intervals, mechanically, at some point, new states will come in faster than they can be rendered. As the number of cells increases as a square of the grid size, it is to be expected that rendering will collapse. However, it would be nice to defer that unavoidable demise further than 100 x 100 :)

The part that I find interesting is, I am not entirely sure yet how to improve performance. This is speculation at that point, but here are some of my current thoughts:

There might be a few low hanging fruits, for instance perhaps making sure that I am re-using brushes and not re-creating them un-necessarily.
However, overall speed probably hinges on re-drawing only the Rectangles that have changed. If a Cell has not changed state, do not redraw it.

For the last part, I will need to dig a little deeper into funcUI and its virtual DOM. My conceptual understanding is that behind the scenes, upon every view update, the engine computes a diff between the current and the new view, and redraws what requires redrawing. Stated differently: I am not directly in control of caching or smart UI updates. That’s the part I need to understand better, so that I can:

Create objects that are easy to compare,
Help the engine perform comparisons. I noticed in particular a couple functions (View.createWithKey, View.withKey, View.withOutlet) which I suspect have something to do with giving identifiers for view elements, presumably for comparison purpose (this is total speculation on my part),
Perhaps even look at potential improvements in the library itself.

Anyways, this is where I will leave things at for today! Shout out to @khalidabuhakmeh for inspiring this, and making his repo accessible, this is a fun problem, and a great benchmark to explore performance questions. As a side note, this does not change my interest in Avalonia funcUI one bit. In general, a business-y UI will rarely require redrawing tens of thousands of elements per second.

I will come back to this problem over the next few weeks, and would love to hear your thoughts on how to approach this!

If you have comments or questions, hit me up on Mastodon!

You can find the full code here on GitHub

First look at Avalonia with Elmish: wrapping OxyPlot charts

2023-05-29T00:00:00+00:00

In the recent weeks, I came across a use case which sounded like a good fit for a desktop application, which got me curious about the state of affairs for .NET desktop clients these days. And, as I was looking into this, I quickly came across Avalonia, and specifically Avalonia.FuncUI. Cross platform XAML apps, using F# and the Elmish loop? My curiosity was piqued, and I figured it was worth giving it a try.

In this post, I will go over my first steps trying the library out. My ambitions are limited: first, how hard is it to get something running? Then, how hard is it to take an existing Avalonia library (in this case, the charting library OxyPlot), and bolt it into an Elmish style Avalonia app?

You can find the full code here on GitHub

Getting started

Let’s get this party started, beginning with installing the template:

dotnet new --install JaggerJo.Avalonia.FuncUI.Templates

Here we go:

Success: JaggerJo.Avalonia.FuncUI.Templates::0.5.0 installed the following templates:
Template Name                      Short Name        Language  Tags
---------------------------------  ----------------  --------  --------------------------
Avalonia FuncUI App                funcui.basic.mvu  F#        Console/Avalonia/UI/Elmish
Avalonia FuncUI App                funcui.basic      F#        Console/Avalonia/UI/Elmish
Avalonia FuncUI App (with extras)  funcUI.full.mvu   F#        Console/Avalonia/UI/Elmish
Avalonia FuncUI App (with extras)  funcUI.full       F#        Console/Avalonia/UI/Elmish

We get 2 templates, basic and full, with 2 flavors, “plain” or mvu. As far as I can tell, the MVU flavor creates a canonical Model-View-Update app, aka an Elmish app, whereas the “plain” flavor uses Components, which I have not had time yet to dig into.

I am interested in Elmish, so let’s go with that:

dotnet new funcUI.full.mvu --name LearningAvalonia

Template created, we can now run the default app created by the template:

cd LearningAvalonia
dotnet run

… and it works:

We have a desktop app running, and it was pretty painless.

How does this work?

My goal here is not to understand in depth how everything works. What I want is to start forming a picture of how the pieces fit together, in reference to the Elmish I know, that is, Elmish in Fable.

Let’s take a look at (a subset of) what the template created:

LearningAvalonia
|_ Counter.fs
|_ Shell.fs
|_ Program.fs
|_ Styles.xaml

Program.fs is the entry point. Looks like mostly application setup, let’s skip to Shell.fs. At the bottom of the file, we find this:

type MainWindow() as this =
    inherit HostWindow()
    do
        // code omitted for brevity

        Elmish.Program.mkProgram (fun () -> init) update view
        |> Program.withHost this
        |> Program.run

This is familiar! We have the starting point of our Elmish loop, with the init, update and view functions. The Shell hooks up two sub-pages, each in its own tab, the Counter and the About pages. Let’s dive straight into what is happening in Counter.fs:

module Counter =

    // open statements omitted for brevity

    type State = { count : int }
    let init = { count = 0 }

    type Msg = Increment | Decrement | Reset

    let update (msg: Msg) (state: State) : State =
        match msg with
        | Increment -> { state with count = state.count + 1 }
        | Decrement -> { state with count = state.count - 1 }
        | Reset -> init

If you have used Elmish before, this should be very familiar. What about the view function, then?

Avalonia.funcUI has its own DSL, to declaratively create the UI. The pattern is pretty straightforward:

StackPanel.create [
    StackPanel.dock Dock.Bottom
    StackPanel.margin 5.0
    StackPanel.spacing 5.0
    StackPanel.children [
        Button.create [
            Button.onClick (fun _ -> dispatch Reset)
            Button.content "reset"
            ]
    ]

StackPanel.create expects a list of IAttr<StackPanel>, and creates a IView<StackPanel>, the UI element itself. We can nest UI components further by using StackPanel.children, which expects a list of IView. If you have used Feliz or Fulma, this should be quite familiar.

Using OxyPlot: preparing the scene

Avalonia.funcUI comes loaded with many of the standard Controls you would expect. One question I was interested in, though, is the following: how easy is it to consume an existing Avalonia library in an Elmish app?

As an example, I figured I would try out OxyPlot, a charting library that offers Avalonia support. For illustration purposes, let’s add a simple tab to the app, where we will:

Generate a random series of points whenever we click a button,
Render these points as a line series.

Let’s start with the easy part, namely adding that tab. First, we will add a new file, anywhere above Shell.fs, and call it Chart.fs, and set up a crude MVU app:

namespace LearningAvalonia

module Chart =

    open System
    open Elmish
    open Avalonia.Controls
    open Avalonia.FuncUI.DSL

    let createSeries () =
        let rng = Random ()
        Array.init 20 (fun i -> float i, rng.NextDouble ())

    type State = {
        Series: (float * float) []
        }

    let init () : State =
        { Series = createSeries () }

    type Msg =
        | CreateNewSeries

    let update (msg: Msg) (state: State) : State * Cmd<Msg> =
        match msg with
        | CreateNewSeries ->
            { Series = createSeries () },
            Cmd.none

    let view (state: State) (dispatch: Msg -> unit)=
        TextBlock.create [
            TextBlock.text "TODO"
            ]

We can now bolt that into the Shell, hosting that app in a new tab. First, we need to add Chart.State and Chart.Msg to the overall app:

type State = {
    aboutState: About.State
    counterState: Counter.State
    chartState: Chart.State
    }

type Msg =
    | AboutMsg of About.Msg
    | CounterMsg of Counter.Msg
    | ChartMsg of Chart.Msg

We bolt the corresponding parts in the init and update functions:

let init =
    let aboutState, aboutCmd = About.init
    let counterState = Counter.init
    let chartState = Chart.init ()
    {
        aboutState = aboutState
        counterState = counterState
        chartState = chartState
    },
    Cmd.batch [ aboutCmd ]

let update (msg: Msg) (state: State): State * Cmd<_> =
    match msg with
    | AboutMsg bpmsg ->
        // omitted for brevity
    | CounterMsg countermsg ->
        // omitted for brevity
    | ChartMsg chartMsg ->
        let updatedState, _ = Chart.update chartMsg state.chartState
        { state with chartState = updatedState },
        Cmd.none

And we can now add a new tab, like so:

let view (state: State) (dispatch) =
    DockPanel.create [
        // omitted for brevity
        TabControl.viewItems [
            // omitted for brevity
            TabItem.create [
                TabItem.header "Charts"
                TabItem.content (Chart.view state.chartState (ChartMsg >> dispatch))
                ]

This is done. The application runs, and produces a new tab, Charts, which currently only displays TODO.

Using OxyPlot: adding a chart

Chart.fs contains a model, with a series of numbers. What I want now is to take this series, and display them as a chart using OxyPlot.

Let’s add first the corresponding package to our project:

dotnet add package OxyPlot.Avalonia

First, how does OxyPlot work? I never used it before, so it took a bit of digging in the docs. Fast forward a bit, I found in the OxyPlot Avalonia samples a relevant example, ScatterDemo. The xaml file indicates that we want an OxyPlot PlotView, which expects a Model. The xaml.cs file gives some further hints: that Model should be a ScatterModel, which contains Series of DataPoint.

Now the other question is, how do we get all that to work with the DSL?

What I would like is something like this, where plotModel is an OxyPlot ScatterModel:

PlotView.create [
    PlotView.model plotModel
    ]

The Avalonia.funcUI docs contain an example of how to do just that. So let’s get to work, and create some bindings. In Chart.fs, I’ll create first a new module, PlotView:

[<AutoOpen>]
module PlotView =

    open Avalonia.FuncUI.Builder
    open Avalonia.FuncUI.Types

    open OxyPlot
    open OxyPlot.Avalonia

    let create (attrs: IAttr<PlotView> list): IView<PlotView> =
        ViewBuilder.Create<PlotView>(attrs)

    type PlotView with
        static member model<'T when 'T :> PlotView> (value: PlotModel) : IAttr<'T> =
            AttrBuilder<'T>.CreateProperty<PlotModel>(PlotView.ModelProperty, value, ValueNone)

All I need to do now is create a PlotModel I can feed in my view. Let’s do this, inside the Chart module, where we now need to open a few more references:

open OxyPlot
open OxyPlot.Avalonia
open OxyPlot.Series

let createPlotModel (series: (float * float) []) =
    let points =
        series
        |> Array.map (fun (x, y) ->
            DataPoint(x, y)
            )

    let series = LineSeries()
    series.StrokeThickness <- 1.0
    series.Color <- OxyColors.Blue
    series.MarkerSize <- 2.0
    series.MarkerStroke <- OxyColors.Blue
    series.MarkerType <- MarkerType.Circle

    points
    |> Array.iter (fun x -> series.Points.Add x)

    let plotModel = PlotModel()
    plotModel.Series.Add series
    plotModel.Title <- "OxyPlot Chart"
    plotModel

We are about done, in our view we can replace the TODO text block by our PlotView:

let view (state: State) (dispatch: Msg -> unit) =
    PlotView.create [
        PlotView.model (state.Series |> createPlotModel)
        ]

And we are almost done. If you run the code at that point, the tab will show nothing. What is going on? That one took me a bit to figure out. Like any self respecting software engineer, I barely read the OxyPlot Avalonia docs, which call out very clearly that you need to add some xaml styling to your application. This is easy enough, we just need to add the following line to our Styles.xaml file:

<Styles
    xmlns="https://github.com/avaloniaui"
    xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml">

    <StyleInclude Source="resm:OxyPlot.Avalonia.Themes.Default.xaml?assembly=OxyPlot.Avalonia"/>

    <Style Selector="Button /template/ ContentPresenter">
        <Setter Property="CornerRadius" Value="5" />
    </Style>
    // omitted

dotnet run, and now we get this:

As a final touch, let’s add a button to that page, which will regenerate a new chart every time we click it:

let view (state: State) (dispatch: Msg -> unit)=
    DockPanel.create [
        DockPanel.lastChildFill true
        DockPanel.children [
            Button.create [
                Button.dock Dock.Bottom
                Button.content "Generate New Chart"
                Button.onClick (fun _ -> CreateNewSeries |> dispatch)
                ]
            PlotView.create [
                PlotView.model (state.Series |> createPlotModel)
                ]
            ]
        ]

Parting words

That is where I will leave it for today.

My experience so far with Avalonia funcUI has been very pleasant. Based on what I have seen so far, I will definitely keep investigating. I love the Elmish / MVU UI model, and it was pretty easy to go from what I knew, Elmish with Fable, to Avalonia.

I really wanted to check how difficult it would be to wrap an existing library in the DSL, and it was not too complicated overall, the docs provide plenty of hints. One interesting difficulty was that most of the docs presume users want to use MVVM with C#, and as a result, it required looking at documentation that also involved some XAML, something I had not looked at in a long, long time :)

Anyways, I had a fun times with this! And hopefully you found something useful in this post.

Big shout-out to Josua Jäger, Jordan Marr, SleepyFran and Angel Munoz for the really nice work on this library, and the samples, which were super helpful in getting started!

If you have comments or questions, hit me up on Mastodon!

You can find the full code here on GitHub

Quipu, a simple Nelder Mead solver in F#

2023-04-15T00:00:00+00:00

Some time back, I wrote a small post digging into the mechanics behind the Nelder Mead solver. As it turns out, I had a use for it recently, and after copy-pasting my own code a few times, I figured it would make my life easier to turn that into a NuGet package, Quipu.

So what does it do, and why might you care?

A code example might be the quickest explanation here. Suppose that, for whatever reason, you were interested in the function f(x) = x ^ 2, and wanted to know for what value of x this function reaches its minimum.

That is easy to solve with the Quipu Nelder-Mead solver:

open Quipu
open Quipu.NelderMead

let f x = x ** 2.0
let solution =
    NelderMead.solve 
        Configuration.defaultValue
        (Objective.from f) [ 100.0 ]
printfn $"{solution}"

… which produces the following result:

Optimal (0.0001556843433, [|0.01247735322|])

The function f reaches a minimum of 0.0001, for x = 0.0124.

NelderMead.solve expects 3 arguments:

The Configuration describes how the solver should behave,
The Objective is the function we are trying to minimize,
The starting value, [ 100.0 ], is our initial guess.

Now the mathematically inclined reader might point out that surely, this is not correct. f reaches a minimum of 0.0, for x = 0.0. The Nelder-Mead algorithm is a numerical method which will produce an approximation for the answer.

If the accuracy is insufficient, you can set up a tighter tolerance:

let config = {
    Configuration.defaultValue with
        Termination = {
            Tolerance = 0.000_0001
            MaximumIterations = None
        }
    }

let closerSolution =
    NelderMead.solve config (Objective.from f) [ 100.0 ]

printfn $"{closerSolution}"

Optimal (6.663562871e-08, [|0.000258138778|])

This is closer, and the minimum value, 6.663e-8, is within 0.000_0001, or 1e-07, of the correct answer, 0.0.

While we are discussing caveats, Nelder-Mead is not guaranteed to find the global minimum. It might give you a local minimum only.

So what would happen if we gave the solver a function that does not have a minimum, like f(x) = x?

let f x = x
let solution =
    NelderMead.solve 
        Configuration.defaultValue
        (Objective.from f) [ 100.0 ]
printfn $"{solution}"

Unbounded

The solver returns Unbounded as a solution, that is, the problem has no minimum.

In circumstances where abnormal situations are encountered (for instance, nan value during the search), the solver will return Abnormal, with the values that caused the error.

What if you had a more complicated function, say, g(x, y) = sin x * cos y?

let g (x, y) = sin x * cos y
let solution =
    NelderMead.solve 
        Configuration.defaultValue
        (Objective.from g) [ 0.0; 0.0 ]
printfn $"{solution}"

Optimal (-0.9995738601, [|-1.59440106; -0.01718172454|])

Note how the starting value is now [ 0.0; 0.0 ]. Because g expects 2 arguments, we need to provide an initial value for both.

Functions of 3 arguments follow the same pattern. After 4, you are on your own, and will need to do a little manual wrapping, converting the function into a form Objective.from can handle: (int: dimension, f: float [] -> float), like so:

// convert f(a,b,c,d) = sin a + cos b + (c * d) ^ 2
// into a function that takes an array of floats:
let h (args: float[]) =
    sin args.[0] + cos args.[1] + (args.[2] * args.[3]) ** 2.0

// call Objective.from (4, h), where 4 is the dimension,
// that is, the number of arguments we expect in the array:
let solution =
    NelderMead.solve
        Configuration.defaultValue
        (Objective.from (4, h)) [ 0.0; 0.0; 0.0; 0.0 ]
printfn $"{solution}"

Optimal
  (-1.99962865, [|-1.559102568; 3.117602262; 0.7363555181; 0.005298690767|])

And… that’s what I got at the moment! It is version 0.1.0 for a reason: it works on my machine, for the problem I needed it for. There is obviously quite a bit that can be improved around usability, too. So your mileage may vary, but it was useful to me, so I figured I would share!

If you have comments or questions, hit me up on Mastodon!

Full code here on GitHub

Study notes: function minimization with DiffSharp

2023-01-08T00:00:00+00:00

This post is intended primarily as a note to myself, keeping track as my findings as I dig into automatic differentiation with DiffSharp. Warning: as a result, I won’t make a particular effort at pedagogy – hopefully you’ll still find something of interest in here!

The main question I am interested in here is, how can I use DiffSharp to find the minimum of a function? I will take a look first at basic gradient descent, to get us warmed up. In a future installment I plan to explore using the built-in SGD and Adam optimizers for that same task.

The full code is here on GitHub, available as a .NET interactive notebook.

Test function

The function we will be using in our exploration is the following:

$f(x,y)=0.26 \times (x^2+y^2) - 0.48 \times (x \times y)$

This function, which I lifted this function from this blog post, translates into this F# code:

let f (x: float, y: float) =
    0.26 * (pown x 2 + pown y 2) - 0.48 * x * y

Graphically, this is how the function looks like:

This function has a global minimum for (x = 0.0, y = 0.0), and is unimodal, that is, it has a single peak (or valley in this case). This makes it a good test candidate for function minimization using gradient descent.

To visualize the surface of a function of 2 variables, we use the following utility function:

let surface ((xMin, xMax), (yMin, yMax)) f =
    let xStep = (xMax - xMin) / 100.0
    let yStep = (yMax - yMin) / 100.0
    let xs = [| xMin .. xStep .. xMax |]
    let ys = [| yMin .. yStep .. yMax |]
    let z =
        Array.init ys.Length (fun yi ->
            Array.init xs.Length (fun xi -> f (xs.[xi], ys.[yi]))
            )
    Chart.Surface (
        z,
        X = xs,
        Y = ys,
        Opacity = 0.5,
        Contours = Contours.initXyz (Show=true),
        ShowScale = false
        )

… which we can use to plot our function f over the range x in (-10.0; 10.0) and y in (-10.0; 10.0):

f |> surface ((-10.0, 10.0), (-10.0, 10.0)) |> Chart.show

Basic Gradient Descent

The idea of Gradient Descent is simple: to minimize a function f, starting from a position x, compute the gradient of the function at x, and take a step opposite of the gradient to go downhill.

This is easy enough to express with DiffSharp. The parameter lr here is the learning rate, a positive number describing how large of a step we want to take:

let gradientStep (lr: float) x f =
    let g = dsharp.grad f x
    x - lr * g

Let’s confirm that this works on our example, which we rewrite in terms of Tensor instead of float (more on that later):

let objective (input: Tensor) =
    let x = input.[0]
    let y = input.[1]
    0.26 * (pown x 2 + pown y 2) - 0.48 * x * y

We can compute the value of our function at the point (5.0, 5.0):

objective (dsharp.tensor [ 5.0; 5.0 ]) |> float

… which produces the value 1.0000009536743164

Let’s take a gradient step, and evaluate the function again:

let updated =
    objective
    |> gradientStep 0.25 (dsharp.tensor [ 5.0; 5.0 ])
updated
|> objective
|> float

The value of the objective function at our updated position is now 0.9800996780395508, which is lower than the initial value, 1.0000009536743164. We did indeed move downhill.

Armed with this, we can write Gradient Descent as an infinite sequence of steps, repeatedly taking gradient steps and updating our position:

let gradientDescent lr init f =
    init
    |> Seq.unfold (fun x ->
        let updated = gradientStep lr x f
        let objectiveValue = f updated
        Some ((updated, objectiveValue), updated)
        )

At each step, we generate the updated position, as well as the new value of the objective function. As an example, we can view the first 5 iterations of gradient descent on f, starting at position (5.0, 5.0):

objective
|> gradientDescent 0.25 (dsharp.tensor [ 5.0; 5.0 ])
|> Seq.take 5
|> Seq.map (fun (coeffs, value) ->
    (coeffs.[0] |> float, coeffs.[1] |> float),
    value |> float
    )

(X, Y)                      Objective
(4.949999809, 4.949999809), 0.980099678
(4.900499821, 4.900499821), 0.9605951309
(4.851494789, 4.851494789), 0.9414796829
(4.802979946, 4.802979946), 0.9227437973
(4.754950047, 4.754950047), 0.904381752

We can plot the decrease of the function over 100 iterations:

objective
|> gradientDescent 0.25 (dsharp.tensor [ 5.0; 5.0 ])
|> Seq.take 100
|> Seq.mapi (fun i (coeffs, value) -> i, float value)
|> Chart.Line
|> Chart.withXAxisStyle "Iteration"
|> Chart.withYAxisStyle "Objective"

Visualizing gradient descent on the function surface

Can we visualize how the algorithm behaves for different values of lr, the learning rate? Let’s do this. In addition to the surface itself, we need to plot the position of a sequence of coordinates over that surface.

Let’s write a function to plot such a trajectory, taking in a sequence of positions, and the function that defines the surface:

let trajectory positions f =
    let coordinates =
        positions
        |> Seq.map (fun (x, y) -> x, y, f (x, y)
        )
    Chart.Scatter3D (
        coordinates,
        mode = StyleParam.Mode.Lines_Markers,
        Marker = Marker.init(Size = 3)
        )

let named name = Chart.withTraceInfo(Name = name)

All we have to do then is create 3 sequences of gradient descent, each using a different value for lr, the learning rate, and compose them into one chart, like so:

let traj1 =
    objective
    |> gradientDescent 0.25 (dsharp.tensor [ -5.0; 10.0 ])
    |> Seq.take 1000
    |> Seq.mapi (fun i (pos, _) -> i, (pos.[0] |> float, pos.[1] |> float))
    |> Seq.filter (fun (i, pos) -> i % 1 = 0)
    |> Seq.map snd

let traj2 =
    objective
    |> gradientDescent 0.10 (dsharp.tensor [ -5.0; 10.0 ])
    |> Seq.take 1000
    |> Seq.mapi (fun i (pos, _) -> i, (pos.[0] |> float, pos.[1] |> float))
    |> Seq.filter (fun (i, pos) -> i % 1 = 0)
    |> Seq.map snd

let traj3 =
    objective
    |> gradientDescent 2.0 (dsharp.tensor [ -5.0; 10.0 ])
    |> Seq.take 100
    |> Seq.mapi (fun i (pos, _) -> i, (pos.[0] |> float, pos.[1] |> float))
    |> Seq.filter (fun (i, pos) -> i % 1 = 0)
    |> Seq.map snd    

[
    f |> surface ((-10.0, 10.0), (-10.0, 10.0))
    f |> trajectory traj1 |> named "lr = 0.25"
    f |> trajectory traj2 |> named "lr = 0.10"
    f |> trajectory traj3 |> named "lr = 2.00"
]
|> Chart.combine
|> Chart.withXAxisStyle("X", Id = StyleParam.SubPlotId.Scene 1, MinMax = (-10.0, 10.0))
|> Chart.withYAxisStyle("Y", Id = StyleParam.SubPlotId.Scene 1, MinMax = (-10.0, 10.0))
|> Chart.withZAxisStyle("Z", MinMax = (0.0, 120.0))
|> Chart.withSize (800, 800)
|> Chart.show

… which produces a chart like this one:

The chart highlights two interesting things:

First, the sequences generated with learning rates of 0.25 and 0.1 are very similar. They follow the same general path, first following the steepest hill down the valley, then taking a turn to follow the much gentler slope of the “inner valley”. The main difference between the two is in how quickly they progress: a learning rate of 0.25 takes larger steps each iteration, progressing faster to the minimum of the function f.

Second, the sequence generated with a learning rate of 2.0 looks quite different. Instead of descending regularly towards the minimum, it bounces back and forth between the two sides of the valley. What is happening here is, the step we are taking is too large, and we end up over-shooting beyond the point where we are descending. This is a known issue with gradient descent. We compute the gradient at our current point, which describes how the slope looks like in the immediate neighborhood of that point. The further away we go from our current point, the less likely it is that the surface there still looks the same.

Which leaves us with an annnoying quandary. In order for gradient descent to work, we need to set a learning rate, and setting that value is problematic. On the one hand, we want to take a large learning rate, so we can converge to the minimum faster. On the other hand, if we pick a learning rate that is too large, we risk not converging at all.

Parting notes

That’s where I will stop for today!

In a next installment, I plan to follow up on the same topic, trying to use the built-in Adam and SGD optimizers, instead of basic gradient descent. These two approaches build on gradient descent, adding some modifications around adapting the learning rate iteratively.

Anyways, I hope that you got something out of this post. If you have questions or comments, hit me up on Mastodon or Twitter. In the meantime, have fun coding, be nice to each other, and hope you all have a wonderful year 2023 ahead!

Full code here on GitHub

Simulating the Wrapinator 5000

2022-12-04T00:00:00+00:00

It is that time of the year again! The holidays are approaching, and the F# Advent calendar is in full swing. My contribution this year might not be for the broadest audience, sorry about that :) But if you are into F#, probability theory, and numeric optimization, this post is for you - hope you enjoy it! And big shout out to Sergey Tihon for making this happen once again.

You can find the full code for this post here on GitHub.

With the Holidays approaching, Santa Claus, CEO of the Santa Corp, was worried. In preparation for the season’s spike in activity, Santa had invested in the top-of-the-line gift wrapping machine for the Elves factory, the Wrapinator 5000. This beast of a machine has two separate feeders, one delivering Paper, the other Ribbon, allowing the elves to wrap gifts at a cadence never achieved before.

So why worry? Mister Claus, being no fool, had also invested in monitoring, and the logs for the Wrapinator 5000 showed quite a few failures. Would the gift wrapping production lines hold up during the Merry Season?

Mister Claus fiddled anxiously with his luscious beard, alone in his office. And then, being a Man of Science, he did what any self-respecting CEO would do, and decided it was time to build a simulation model of his Wrapinator 5000. With a simulation model in hand, he could analyze his Elves factory, evaluate potential alternative operating policies, and most importantly, get that peace of mind he so desperately longed for.

Simulating the Wrapinator 5000, take 1

At its core, the Wrapinator 5000 has 2 components: one that delivers Wrapping Paper, and one that delivers Ribbon. While that technological marvel delivers wrapped gifts at an amazing speed, it also crashes from time to time. Both the Paper and the Ribbon feeders over-heat sometimes, requiring costly down time to reset both components and restart the machine.

Mister Claus is quite fond of iterative design. He starts his favorite editor, and decides to start with implementing a simplified version of the Wrapinator 5000, to get a feel for the problem.

Let’s start by modeling the failure causes: each cause has a name, a time to failure (the time it takes from a cold start until it crashes), and a time to fix (how long it takes to repair it once it crashed).

type FailureCause = {
    Name: string
    TimeToFailure: Random -> TimeSpan
    TimeToFix: Random -> TimeSpan
    }

Both time to failure and time to fix are somewhat random, so we model them as functions, taking a System.Random (the built-in .NET random number generator), which we will use to generate a random duration, a System.TimeSpan.

To get warmed up a little, let’s build a simple simulation here. We have 2 causes of failure, let’s start with assuming that all times are uniformly distributed:

let causes = [|
    {
        Name = "Ribbon"
        TimeToFailure =
            fun rng -> TimeSpan.FromHours (rng.NextDouble())
        TimeToFix =
            fun rng -> TimeSpan.FromHours (rng.NextDouble())
    }
    {
        Name = "Paper"
        TimeToFailure =
            fun rng -> TimeSpan.FromHours (rng.NextDouble())
        TimeToFix =
            fun rng -> TimeSpan.FromHours (rng.NextDouble())
    }
    |]

How would we go about simulating a tape of incidents using that? First, let’s model how an Incident looks like:

type Incident = {
    Cause: int
    FailureTime: DateTime
    RestartTime: DateTime
    }

Mister Claus is a bit lazy here, and decides to just use an int to indicate what FailureCause triggered the incident, referring to its index in the causes array.

Suppose that our Wrapinator 5000 started cold, what would be the next failure? In that case, both feeders are running and will fail after their TimeToFailure elapsed, and what we will observe is the first one that fails:

let nextFailure (rng: Random) (causes: FailureCause []) =
    causes
    |> Array.mapi (fun index failure ->
        index,
        failure.TimeToFailure rng,
        failure.TimeToFix rng
        )
    |> Array.minBy (fun (_, timeToFailure, _) ->
        timeToFailure
        )

We can now simulate an infinite tape representing the incidents occurring on the Wrapinator 5000: we start at some time, until our first failure occurs. When that happens, we repair the machine, based on the component that fail, we reset the two components as “fresh”, we generate an Incident, and we restart, until another failure occurs:

let simulate (rng: Random) (failures: FailureCause []) =

    let startTime = DateTime(2022, 12, 24)

    startTime
    |> Seq.unfold (fun currentTime ->
        let failureIndex, nextFailure, timeToFix =
            nextFailure rng failures
        let failureTime = currentTime + nextFailure
        let restartTime = failureTime + timeToFix
        let incident = {
            Cause = failureIndex
            FailureTime = failureTime
            RestartTime = restartTime
            }
        Some (incident, restartTime)
        )

Let’s simulate our Wrapinator 5000, with that simplified setting:

let rng = Random 0

let tape =
    causes
    |> simulate rng

let sample =
    tape
    |> Seq.take 5
    |> Seq.iter (fun incident -> printfn "%A" incident)

… we get the following tape out:

{ Cause = 0
  FailureTime = 12/24/2022 12:43:34 AM
  RestartTime = 12/24/2022 1:32:36 AM }
{ Cause = 0
  FailureTime = 12/24/2022 1:44:58 AM
  RestartTime = 12/24/2022 2:18:30 AM }
{ Cause = 1
  FailureTime = 12/24/2022 2:36:01 AM
  RestartTime = 12/24/2022 3:04:03 AM }
{ Cause = 0
  FailureTime = 12/24/2022 3:42:01 AM
  RestartTime = 12/24/2022 4:10:11 AM }
{ Cause = 1
  FailureTime = 12/24/2022 4:50:49 AM
  RestartTime = 12/24/2022 5:09:41 AM }

Here we have it - a simulation model! With Seq.unfold, we can generate an infinite tape of incidents, using failure causes following any distribution we can think of.

Mister Claus is quite pleased with himself – This is a good start.

And then he frowns. Claus can use any distribution for a FailureCause, but… which one should he use? And then, a hint of a smile forms under that glorious snow-white moustache. The logs! He has days and days of logs of that machine running and experiencing incidents, surely, he can use that to estimate some distribution!

The Shadow of a Distribution

Before going further, Mister Claus decides to take a look at that simulated tape he just generated. Let’s plot the time between failures for Cause 0, failures caused by the Ribbon feeder.

That is not too hard. We care about how long it took between 2 failures, so we reconstruct pairs of consecutive incidents, filter it down to keep only Ribbon failures, and compute the time elapsed from the last machine restart until the failure occurred:

let sample =
    tape
    |> Seq.pairwise
    |> Seq.filter (fun (_, incident) -> incident.Cause = 0)
    |> Seq.take 1000
    |> Seq.map (fun (previousIncident, incident) ->
        (incident.FailureTime - previousIncident.RestartTime).TotalHours
        )

A picture is worth a 1000 words - let’s create a histogram, to visualize how these times are distributed, using Plotly.NET:

sample
|> Chart.Histogram
|> Chart.withTitle "Ribbon: time to failure"
|> Chart.withXAxisStyle "time (hours)"
|> Chart.withYAxisStyle "number of failures"
|> Chart.show

This is interesting. The Ribbon time to failure was defined as fun rng -> TimeSpan.FromHours (rng.NextDouble()): in other words, that time is uniformly distributed between 0 and 1 hours (it is equally likely to fail at any time between 0 and 1). And yet, what we observe here is most definitely not a uniform distribution, which should be flat. What is going on here?

What is going on is something a little subtle. When we observe the tape, we do not observe just the failure of the Ribbon. The 2 failures are “racing” against each other. When the Ribbon fails, we are really observing 2 things at once:

The Ribbon Feeder failed at the time indicated,
The Paper Feeder would have failed as well, but would have failed later.

The tape is a function of 2 distributions: each observation is the result of a race between 2 independent distributions. We see the one which happens first. Intuitively, the shape of the chart makes sense. We observe very few failures at the tail end. This is reasonable, because to observe a failure of the Ribbon Feeder that happens after, say, 0.8 hours, we need that failure to take that much time, and we also need the Paper Feeder to take even more time than the Ribbon Feeder to fail.

Note: that histogram presents another oddity. The curve looks like a triangle, except for the first bin, where we observe very few failures. I am not entirely sure what is going on there, I suspect it is a binning artifact.

Mister Claus frowns again. If the logs do not look anything like the distribution that generated each incident, how is he going to estimate these distributions?

And then a lightbulb clicks. Mister Claus remembers reading a blog post about Maximum Likelihood Estimation some time ago. Perhaps this might work! If he could express the likelihood of observing that log / tape of incidents, as a function of these failure cause distributions, then he could use Maximum Likelihood Estimation (MLE) to figure out which parameters are the most likely to have produced such a tape.

Mister Claus feels a surge of confidence. What an emotional roller coaster this is!

Simulating the Wrapinator 5000, take 2: Weibull failures

First, let’s spice up that simulation a bit, and switch from Uniform to Weibull distribution. We will keep the “why Weibull” to a minimum here; the blog post mentioned before, and the Wikipedia pages are pretty good entry points.

Weibull distributions have 2 parameters, k (the Shape parameter) and lambda (the Scale parameter). Weibulls are commonly used for time to failure in reliability models. A value of k < 1.0 describes a process that will tend to fail early (high “infant mortality”), whereas a value of k > 1.0 describes a process where as the component ages, the probability of failure keeps increasing.

Let’s implement our own Weibull:

type Weibull = {
    /// Shape parameter
    K: float
    /// Scale parameter
    Lambda: float
    }
    with
    member this.Simulate (rng: Random) =
        let p = rng.NextDouble ()
        this.Lambda * (- log (1.0 - p)) ** (1.0 / this.K)
    member this.CDF time =
        1.0
        - exp (- ((time / this.Lambda) ** this.K))
    member this.PDF time =
        (this.K / this.Lambda)
        *
        ((time / this.Lambda) ** (this.K - 1.0))
        *
        exp (- ((time / this.Lambda) ** this.K))

We represent the distribution as a record, holding the 2 parameters k and lambda, and add 3 methods, which are straight up implementations from the Wikipedia page:

PDF, or Probability Density Function: the probability (density) to observe a failure at exactly time,
CDF, or Cumulative Distribution Function: the probability that a failure occurred before a certain time,
Simulate: generate a sample of that Weibull, using the Inverse Cumulative Distribution.

Now, we will assume that the Ribbon and Paper feeders time to failure follow a Weibull distribution, and we will pick (completely arbitrarily) parameters for these:

let weibullRibbon = {
    K = 1.2
    Lambda = 0.8
    }

let weibullPaper = {
    K = 0.6
    Lambda = 1.2
    }

Let’s plot the CDF for both of these:

let times = [ 0.2 .. 0.2 .. 5.0 ]

[
    Chart.Line (
        xy = (times |> List.map (fun t -> t, weibullRibbon.CDF t)),
        Name = "Ribbon"
        )
    Chart.Line (
        xy = (times |> List.map (fun t -> t, weibullPaper.CDF t)),
        Name = "Paper"
        )
]
|> Chart.combine
|> Chart.withXAxisStyle "Time (hours)"
|> Chart.withYAxisStyle "Proba already failed"
|> Chart.show

We can now replace our Uniform causes with Weibull distributions:

let hours = TimeSpan.FromHours

let causes = [|
    {
        Name = "Ribbon"
        TimeToFailure = weibullRibbon.Simulate >> hours
        TimeToFix = fun rng -> TimeSpan.FromHours (rng.NextDouble())
    }
    {
        Name = "Paper"
        TimeToFailure = weibullPaper.Simulate >> hours
        TimeToFix = fun rng -> TimeSpan.FromHours (rng.NextDouble())
    }
    |]

Note: we left the TimeToFix as uniform distributions, because our focus will be entirely the TimeToFailure here.

And with that small change, we are ready to simulate a tape. No change in the code, we just use different distributions for the causes:

let rng = Random 0

let tape =
    causes
    |> simulate rng

let sample =
    tape
    |> Seq.take 5
    |> Seq.iter (fun incident -> printfn "%A" incident)

… and get a different tape:

{ Cause = 0
  FailureTime = 12/24/2022 12:59:33 AM
  RestartTime = 12/24/2022 1:48:35 AM }
{ Cause = 0
  FailureTime = 12/24/2022 2:02:44 AM
  RestartTime = 12/24/2022 2:36:16 AM }
{ Cause = 1
  FailureTime = 12/24/2022 2:48:30 AM
  RestartTime = 12/24/2022 3:16:32 AM }
{ Cause = 0
  FailureTime = 12/24/2022 4:04:35 AM
  RestartTime = 12/24/2022 4:32:46 AM }
{ Cause = 0
  FailureTime = 12/24/2022 5:57:41 AM
  RestartTime = 12/24/2022 6:57:25 AM }

Structurally, that tape is similar to the one we had previously. The only key difference is that the failure times are now driven by 2 different Weibull distributions.

Note that we know exactly what Weibull distributions were used to generate that tape. Mister Claus, on the other hand, does not. All he has is the tape. The question here is, using just the tape, could he reconstruct what values of k and lambda we used? Let’s dive into this, with some Maximum Likelihood fun!

Maximum Likelihood Estimation

All Mister Claus has available are logs, which look like this:

failure 1: cause, time, restart time
failure 2: cause, time, restart time
failure 3: cause, time, restart time
...

What we are after is, given that tape, can we infer what values of k and lambda are behind the distribution of time to failure for each cause. In our example, cause 0 is Ribbon failure, cause 1 is Paper failure. Because we know what values were used in the simulation, we know what the correct answer is. We would like to write some code that takes that tape as an input, and return 4 values:

For Cause 0 (the Ribbon feeder), we expect to get back k ~ 1.2 and lambda ~ 0.8:

let weibullRibbon = {
    K = 1.2
    Lambda = 0.8
    }

For Cause 1 (the Paper feeder), we expect to get back k ~ 0.6 and lambda ~ 1.2:

let weibullPaper = {
    K = 0.6
    Lambda = 1.2
    }

Let’s consider one of the failures from the tape, say:

failure 42: cause 1, failed at 16:00, fixed at 16:47

Because we are interested in the time it took for the failure to occur, we need to know when the machine last started, which is the restart time after the previous failure:

failure 41: cause 0, failed at 15:05, fixed at 15:15
failure 42: cause 1, failed at 16:00, fixed at 16:47

The time between failures is 16:00 - 15:15, that is, 45 minutes.

Now the question is, if we assume that the Ribbon and Paper time to failure each follow a Weibull distribution, what is the probability of observing that particular event in the tape?

Let’s denote these 2 distributions as

Ribbon: Weibull_0 (k_0, lambda_0)
Paper: Weibull_1 (k_1, lambda_1)

The cause of failure 42 was 1, that is, the Paper failed, after 45 minutes. For this to happen, 2 things need to be true:

The Paper failed at exactly 45m. The probability of this event is Probability (Weibull_1) = 45 minutes, which is given by its Probability Density Function, or PDF: PDF (Weibull_1) = 45 minutes.
The Ribbon did NOT fail before 45m. The probability of this event is Probability (Weibull_0) > 45m, which is given by 1 - its Cumulative Distribution Function, or CDF: 1.0 - CDF (Weibull_0) = 45m.

The probability of 2 independent events is their product, so the probability of observing a Paper failure occurring exactly at 45 minutes is:

(1.0 - CDF (Weibull_0)) * (PDF (Weibull_1))

Note: the same approach generalizes to more failure causes. In that case, the probability to observe a particular event is the PDF of that event, multiplied by the CDF of every event that did NOT occur.

Armed with this, we can now compute the likelihood of observing a particular event i in the tape, with a time to failure t:

$Likelihood(i,t) = PDF_i(t) \times \prod_{j \neq i}{(1-CDF_j(t))}$

Armed with this, we can now determine the likelihood of observing a particular failure in our sample. All we need to do is plug in the formula for the corresponding PFD and CDF for the Weibull distribution.

However, what we are after is the likelihood of observing the full tape we have available, given a set of values for $k_0, lambda_0$ and $k_1, lambda_1$. That is not too complicated: again, assuming observations are independent, the probability of observing the whole tape is the product of the probabilities of observing each individual event.

In other words, if we have a tape like this one:

observation_1: cause_1 = 0, time_1 = 25
observation_2: cause_2 = 1, time_2 = 48
observation_3: cause_3 = 0, time_3 = 43
etc ...
observation_n: cause_n = 0, time_n = 27

Then the likelihood of observing that tape (given $k_0, lambda_0$ and $k_1, lambda_1$) will be

$Likelihood(tape)=Likelihood(observation_1) \times Likelihood(observation_2) \times … \times Likelihood(observation_n)$

The beauty here is that we have now a function, the Likelihood, which allows us to quantify how likely it is that a particular set of values $k_0, lambda_0$ and $k_1, lambda_1$ would have generated a particular tape. This is great, because we can use the likelihood function to answer the following question: what are the 4 values of $k_0, lambda_0$ and $k_1, lambda_1$ that are the most likely to have generated the tape we are observing. In other words, if we can find the 4 values that maximize the likelihood function, we will have solid estimates for our 2 Weibull distributions.

Before going further, let’s make that problem a bit easier to work with. First, we can use the classic log-likelihood “trick”, and convert this expression into a log likelihood:

$ln(Likelihood(tape)) = ln(Likelihood(observation_1)) + … + ln(Likelihood(observation_n))$

This is useful, because this function will reach its maximum for the same arguments, but we are now dealing with a sum instead of a product.

Let’s dig a bit deeper here, and inspect $ln(Likelihood(observation))$:

$ln(Likelihood(observation=i,t))=ln(PDF_i(t) * \prod_{j \neq i}{(1-CDF_j(t))})$

Again, we are dealing with a product, and because $ln(a \times b)=ln(a)+ln(b)$, we can transform this into a sum:

$ln(Likelihood(observation=i,t))=ln(PDF_i(t)) + \sum_{j \neq i}{ln(1-CDF_j(t))})$

Why do we care? We care, because this makes our maximization problem separable. If we consider for instance $k_0, lambda_0$, these 2 arguments will appear only in one PDF or CDF term, and the rest of the expression will be a constant with respect to $k_0, lambda_0$.

Practically, what this means is that we can simplify our maximization problem. Instead of maximizing one complicated function of 4 arguments $k_0, lambda_0$ and $k_1, lambda_1$, we can maximize independently 2 simpler functions, one that depends only on $k_0, lambda_0$, and one that depends only on $k_1, lambda_1$.

Likelihood Surface

Before attacking the maximization itself, let’s take a step back from math and revert to F# code for a little, to illustrate what is happening in code, rather than in equations.

Fundamentally, what the last point means is that for each FailureCause, we can take their parameters k and lambda, and estimate the likelihood of having generated the tape we observe.

In the end, the likelihood function boils down to this. In the tape, if we observe the cause we care about, use the PDF, otherwise, use (1 - CDF). We can prepare our tape of Incident(s) for the cause we care about, extracting the time between failures, and flagging with a boolean whether or not the cause we observe is the one we care about:

let prepare (index: int) (tape: Incident []) =
    tape
    |> Array.pairwise
    |> Array.map (fun (previousIncident, incident) ->
        incident.Cause = index,
        (incident.FailureTime - previousIncident.RestartTime).TotalHours
        )

The boolean here indicates essentially whether or not the cause we care about “won” the race, and occurred first. If it did, we want to use the PDF, otherwise, we use (1 - CDF). This results in the following function, the likelihood that 2 values (k, lambda) were the ones generating our tape:

let likelihood (k, lambda) (sample: (bool * float) []) =
    let weibull = { K = k; Lambda = lambda }
    sample
    |> Array.sumBy (fun (observed, time) ->
        if observed
        then weibull.PDF time |> log
        else (1.0 - weibull.CDF time) |> log
        )

In theory, out of the infinitely many possible pairs of values (k, lambda), one of them will give us a maximum value. That pair is the one that is the most likely to have generated the sample, and, as a result, it should also be close to the actual value we used to simulate that sample.

Let’s see if that actually works, by plotting the likelihood as a Plotly surface for a range of values of k and lambda, essentially doing a visual grid search:

let ribbonSample =
    sample
    |> Estimation.prepare 0
    |> Array.truncate 100

let ks = [ 0.5 .. 0.05 .. 2.0 ]
let lambdas = [ 0.5 .. 0.05 .. 2.0 ]

let z =
    [
        for k in ks ->
            [ for lambda in lambdas -> likelihood (k, lambda) ribbonSample ]
    ]

Chart.Surface (
    z,
    X = ks,
    Y = lambdas,
    Contours = TraceObjects.Contours.initXyz(Show = true)
    )
|> Chart.withTitle "Ribbon: log likelihood"
|> Chart.withXAxisStyle ("k", Id = StyleParam.SubPlotId.Scene 1)
|> Chart.withYAxisStyle ("lambda", Id = StyleParam.SubPlotId.Scene 1)
|> Chart.withZAxisStyle "log likelihood"
|> Chart.show

The resulting chart displays, for values of k and lambda between 0.5 and 2.0, what the log likelihood is. The higher the “altitude”, the more likely it is that the corresponding pair of coordinates generated the sample tape:

That surface is convex, and forms a nice hill, with a peak in roughly the correct area, around k ~ 1.3, lambda ~ 0.8.

Similarly, we can plot the log likelihood for Paper, which also produces a convex hill, with a peak at a different position.

First, this confirms that the idea has legs. Then, from a numeric optimization standpoint, this is good news. If we have a convex surface, all we need is a hill climbing algorithm. We can start from any value of k and lambda, for instance (1.0, 1.0), and take small steps that always go uphill.

One such hill climbing algorithm is Gradient Descent, or, rather, Gradient Ascent in this case. Starting from values (k = 1.0, lambda = 1.0), compute the partial derivative of the log likelihood, and take a small step towards the direction with a positive gradient.

Let’s do this.

MLE using Gradient Ascent with DiffSharp

The tricky part here is the step “compute the partial derivative”. Manually computing the partial derivative of the log-likelihood function would be quite painful. Fortunately, thanks to DiffSharp, an F# automatic differentiation library, we can mostly ignore that issue, and let the library do the heavy lifting for us. This is what we will do here.

I won’t cover that part in detail, because I went through something similar in this post. You can find the whole code performing the MLE using gradient descent here.

How does it work when we run that code against our tape? Let’s check:

let sample =
    tape
    |> Seq.take 100
    |> Seq.toArray

let ribbon =
    sample
    |> Estimation.prepare 0
    |> Estimation.estimate

printfn "Ribbon: %A" ribbon

After some iterations, we get our estimate for what good parameters for the Ribbon failure distribution might be:

Ribbon: { K = 1.217164993
  Lambda = 0.8133975863 }

Similarly, we get the following estimates for the Paper failures:

Paper: { K = 0.6178998351
  Lambda = 1.249123335 }

The values we used to generate that tape were:

let weibullRibbon = {
    K = 1.2
    Lambda = 0.8
    }

let weibullPaper = {
    K = 0.6
    Lambda = 1.2
    }

Pretty close, I would say!

Conclusion

That is as far as we will go today!

I realize that this topic is probably a tad esoteric for most. However, I found it personally very interesting. I never really got into Maximum Likelihood Estimation techniques in the past, in large part because they involve calculus, which is something I am not good at. I find it quite impressive how, with the help of DiffSharp, it took fairly little code to make it all work.

On the probability front, I was quite surprised when I realized that the problem was separable. The result is interesting to me, for 2 reasons. First, we end up using the full tape of failures for every event. Even when we do not observe the event type we care about, we have usable information, because we know that the event in question did not “win the race”. Then, fundamentally the log likelihood for each distribution depends only on the PDF and CDF for that distribution, and nothing else. As an interesting result, the approach can be generalized to any mixture of distributions, as long as we have a PDF and CDF for it.

As a side-note, shout out to the awesome F# crew at Simulation Dynamics. Many of the ideas presented in this post emerged from discussions with them :)

Anyways, I hope that you got something out of this post. If you have questions or comments, hit me up on Twitter or Mastodon. In the meantime, have fun coding, be nice to each other, and wish you all wonderful holidays!

Full code here on GitHub

Maximum Likelihood Estimation of Weibull reliability with DiffSharp

2022-08-28T00:00:00+00:00

This post is a continuation of my exploration of DiffSharp, an F# Automatic Differentiation library. In the previous post, I covered some introductory elements of Maximum Likelihood Estimation, through a toy problem, estimating the likelihood that a sequence of heads and tails had been generated by a fair coin.

In this post, I will begin diving into the real-world problem that motivated my interest.

The general question I am interested in is about reliability. Imagine that you have a piece of equipment, and that from time to time, a component of that piece of equipment experiences failures. When that happens, you replace the defective component with a new one, restart the equipment, and proceed until the next failure.

The log for such a process would then look something like this:

Jan 07, 2020, 08:37  Component failure
Jan 17, 2020, 13:42  Component failure
Feb 02, 2020, 06:05  Component failure
Feb 06, 2020, 11:17  Component failure

If you wanted to make improvements to the operations of your equipment, one useful technique would be to simulate that equipment and its failures. For instance, you could evaluate a policy such as “we will pre-emptively replace the Component every week, before it fails”. By simulating random possible sequences of failures, you could then evaluate how effective that policy is, compared to, for instance, waiting for the failures to occur naturally.

However, in order to run such a simulation, you would need to have a model for the distributions of these failures.

The log above contains the history of past failures, so, assuming nothing changed in the way the equipment is operated, it is a sample of the failure distribution we are interested in. We should be able to use it, to estimate what parameters are the most likely to have generated that log. Let’s get to it!

Environment: dotnet 6.0.302 / Windows 10, DiffSharp 1.0.7

Full code on GitHub

Weibull time to failure

What we are interested in here is the time to failure, the time our equipment runs from the previous component replacement to its next failure. A classic distribution used to model time to failure is the Weibull distribution.

The Weibull distribution is not the only option available, but it has interesting properties. It is a continuous probability distribution, over positive numbers, and is defined by 2 parameters, one describing its shape, k, the other its scale, lambda. Let’s examine these properties, through an F# code implementation:

type Weibull = {
    Lambda: float
    K: float
    }
    with
    member this.Density (x: float) =
        if x <= 0.0
        then 0.0
        else
            (this.K / this.Lambda)
            *
            (x / this.Lambda) ** (this.K - 1.0)
            *
            exp ( - ((x / this.Lambda) ** this.K))
    member this.Cumulative (x: float) =
        if x <= 0.0
        then 0.0
        else
            1.0
            -
            exp ( - ((x / this.Lambda) ** this.K))
    member this.InverseCumulative (p: float) =
        this.Lambda 
        *
        ( - (log (1.0 - p))) ** (1.0 / this.K)

Let’s examine the impact of the two parameters lambda and k graphically, using Plotly.NET:

#r "nuget: Plotly.NET.Interactive, 3.0.0"
open Plotly.NET

First, let’s plot the cumulative distribution for 3 values of lambda, 0.5, 1.0 and 2.0:

[ 0.5; 1.0; 2.0 ]
|> List.map (fun shape -> 
    let weibull = { Lambda = shape; K = 1.0 }
    [ 0.0 .. 0.1 .. 5.0 ]
    |> List.map (fun t -> t, weibull.Cumulative t)
    |> fun data -> Chart.Line(data, Name = $"Lambda = {shape}")
    )
|> Chart.combine
|> Chart.withXAxisStyle "Time to failure"
|> Chart.withYAxisStyle "Cumulative probability"
|> Chart.withTitle "Weibull: impact of scale parameter Lambda"

What the chart shows is the probability that after a certain amount of time has elapsed, the component has failed already. The scale parameter lambda stretches the curve: for lambda = 0.5, it will take half the time it takes a process with lambda = 1.0 to reach the same probability of having failed already. In other words, a lower value of lambda describes a process that fails faster.

How about the shape parameter k? Let compare 3 values, 0.5, 1.0 and 2.0:

[ 0.5; 1.0; 2.0 ]
|> List.map (fun k -> 
    let weibull = { Lambda = 1.0; K = k }
    [ 0.0 .. 0.1 .. 5.0 ]
    |> List.map (fun t -> t, weibull.Cumulative t)
    |> fun data -> Chart.Line(data, Name = $"K = {k}")
    )
|> Chart.combine
|> Chart.withXAxisStyle "Time to failure"
|> Chart.withYAxisStyle "Cumulative probability"
|> Chart.withTitle "Weibull: impact of shape parameter K"

The parameter k describes the overall shape of the distribution, and has important implications:

k = 1.0: the failure rate is constant over time (Weibull reduces to an Exponential distribution)
k < 1.0: the failure rate decreases over time, or, equivalently, we have a high rate of early failures (“infant mortality”),
k > 1.0: the failure rate increases over time, for instance for equipment that degrades with age.

As a result, the Weibull distribution is a good candidate to model failures, because it can represent a wide range of real-world behaviors, with just 2 parameters. The drawback, though, is that unlike the earlier example of the coin toss, there is no closed-form solution to estimate the parameters k and lambda given sample data.

Grid search estimation of Weibull failure parameters

Before bringing in the heavy machinery with DiffSharp, let’s get warmed up with solving the problem using grid search.

What we are trying to do here is to find the parameters k and lambda of a Weibull distribution that are the most likely to have generated a log of failures. In other words, we take as given that the underlying process is a Weibull distribution, and want to find the parameters that would fit the data best.

First, we need to transform the log a little. The original log example showed failures and their timestamp. What we are interested in is not timestamps, but time between failures. Let’s assume that we have done that transformation, which leaves us with a “tape” of time spans between consecutive failures.

In order to validate that our approach works, we need some benchmark. Again, we will use simulation: we will take a Weibull distribution, with set parameters, and use it to simulate a sequence of failures. As a result, we will be able to check how far off our estimates are from the true values of the parameters that actually generated that sample.

First, let’s simulate a tape:

let simulate (rng: System.Random, n: int) (weibull: Weibull) =
    Array.init n (fun _ ->
        rng.NextDouble ()
        |> weibull.InverseCumulative
        )

let rng = System.Random(0)
let sample =
    { Lambda = 0.8; K = 1.6 }
    |> simulate (rng, 100)

sample

For illustration, the first 5 results of that simulation look like this:

9405168968236842
1146238390817407
0139531031208946
7049619724501476
3198973954704749

What this tape represents is a first failure after 0.9405 units of time, followed by another after 1.1146 units of time, and so on and so forth.

We can now write a grid search over the combination of parameters k and lambda that maximizes the log-likelihood, like so:

[
    for lambda in 0.1 .. 0.1 .. 2.0 do
        for k in 0.1 .. 0.1 .. 2.0 do
            let w = { Lambda = lambda; K = k }
            (lambda, k),
            sample 
            |> Array.sumBy (fun t -> 
                log (w.Density(t))
                )
]
|> List.maxBy snd

We search for all combinations of k and lambda between 0.1 and 2.0, by increments of 0.1. For each combination, we create the corresponding Weibull, and compute the log likelihood that this particular distribution has generated the sample observations (the sum of the logarithms of the corresponding Weibull density), and return the combination that gives us the largest log likelihood.

In this example, we get lambda = 0.9, k = 1.6, which is decently close to the true parameters we used to generate the sample, lambda = 0.8, k = 1.6. In other words, the method seems to work.

Using DiffSharp to estimate the Weibull failure parameters

Grid seach has the benefit of simplicity, but has also drawbacks. First, as mentioned in the previous post, the space of combinations we need to explore grows fast with the number of parameters. In this case, we are exploring 20 values per parameter, or 20 x 20 = 400 combinations for 2 parameters. If we were interested in n parameters, we would have to generate 20 ^ n combinations, which is not ideal. Furthermore, we capped the search at a maximum value of 2.0 - but in general, k or lambda could take any positive value, and if these happened to be higher than 2.0, we would miss them.

Let’s use automatic differentiation with DiffSharp instead! We will follow more or less the same path as in the previous post, creating the log-likelihood function in F#, and using gradient ascent to find its maximum value by changing the 2 parameters k and lambda.

Rather than reiterating the whole process, I will just highlight the differences here. The only meaningful change is in the probability model itself:

let probabilityModel () =

    // We start with an initial guess for our Weibull,
    // with lambda = 1.0, k = 1.0.
    let lambda =
        1.0
        |> dsharp.scalar
        |> Parameter
    let k =
        1.0
        |> dsharp.scalar
        |> Parameter

    let parameters =
        [| lambda; k |]

    // We create the Probability Density function,
    // specifying that we want to differentiate it
    // with respect to the Lambda and K parameters.
    differentiable
        parameters
        (fun (time: float) ->
            if time <= 0.0
            then dsharp.scalar 0.0
            else
                (k.value / lambda.value)
                *
                ((time / lambda.value) ** (k.value - 1.0))
                *
                (exp ( - ((time / lambda.value) ** k.value)))
            )

We initialize the algorithm with a starting guess for a Weibull distribution with parameters lambda = 1.0, k = 1.0, and rewrite the Weibull density function we had earlier, as a function of these two parameters, so we can compute its partial derivative with respect to these 2 parameters.

And… that’s pretty much it. We can leave the maximizeLikelihood function we wrote last time unchanged, plug in our simulated sample, and wait for the magic to happen:

let config = {
    LearningRate = 0.001
    MaximumIterations = 100
    Tolerance = 0.001
    }

let rng = Random 0

let sample =
    { Lambda = 1.5; K = 0.8 }
    |> simulate (rng, 100)

probabilityModel ()
|> maximizeLikelihood config sample

… which produces the following estimates:

lambda = 1.8769636154174805, k = 0.8026720285415649

For completeness, we can write a small harness, generating multiple samples for different Weibull distributions, to evaluate how good or bad the estimates are:

let evaluation (rng: Random) (weibull: Weibull) =
    let sample =
       weibull
        |> simulate (rng, 100)
    let estimate =
        probabilityModel ()
        |> maximizeLikelihood config sample
    estimate

Array.init 10 (fun _ ->
    let lambda = 0.5 + 2.0 * rng.NextDouble()
    let k = 0.5 + rng.NextDouble()
    let weibull = { Lambda = lambda; K = k }
    weibull, evaluation rng weibull
    )

In general, the estimates do not exactly match the true values, which is expected. However, they fall fairly close. The one thing I noticed (and this might be a fluke, given the relatively small sample size) is that the estimates for lambda, the scale parameter, appeared to be less reliable for larger values of lambda.

Conclusion and Parting Notes

Enough for today! If you are interested in looking at the full code, here is a link to the .NET interactive notebook on GitHub.

Not many comments or thoughts this time. Going from the toy problem of the coin to a more complex one was actually very straightforward. The only work required was to express the Weibull density function as a DiffSharp function, which was not difficult at all. For that matter, it seems that it should be possible to make the code more easily re-usable. All we need for Maximum Likelihood Estimation is a density function, which can be applied to the sample observations, so if we had a sample like seq<'Obs>, the density should be constrained to be of the form Model<'Obs, float> (where the float is a probability).

Next time, we will keep exploring reliability problems, taking on a more complex situation: what if instead of a single source of failure, we had multiple competing ones?

Anyways, hope you found this post interesting! Ping me on Twitter if you have comments or questions, and… happy coding!

First look at the new DiffSharp

2022-08-21T00:00:00+00:00

This post is intended as an exploration of DiffSharp, an Automatic Differentiation, or autodiff F# library. In a nutshell, autodiff allows you to take a function expressed in code - in our case, in F# - and convert it in an F# function that can be differentiated with respect to some parameters.

For a certain niche population, people who care about computing gradients, this is very powerful. Basically, you get gradient descent, a cornerstone of machine learning, for free.

DiffSharp has been around for a while, but has undergone a major overhaul in the recent months. I hadn’t had time to check it out until now, but a project I am currently working on gave me a great excuse to look into these changes. This post will likely expand into more, and is intended as an exploration, trying to figure out how to use the library. As such, my code samples will likely be flawed, and should not be taken as guidance. This is me, getting my hands on a powerful and complex tool and playing with it!

With that disclaimer out of the way, let’s dig into it. In this installment, I will take a toy problem, a much simpler version of the real problem I am after, and try to work my way through it. Using DiffSharp for that specific problem will be total overkill, but will help us introduce some ideas which we will re-use later, for the actual problem I am interested in, estimating the parameters of competing random processes using Maximum Likelihood Estimation.

Environment: dotnet 6.0.302 / Windows 10, DiffSharp 1.0.7

An unfair coin

Let’s consider a coin, which, when tossed in the air, will land sometimes Heads, sometimes Tails. Imagine that our coin is unbalanced, and tends to land more often than not on Heads, 65% of the time:

type Coin = {
    ProbabilityHeads: float
    }

let coin = { ProbabilityHeads = 0.65 }

Supposed now that we tossed that coin in the air 20 times. What should we expect?

Well, it depends. We could observe 12 heads, or 15, or even 20 or 0. Let’s simulate such a run, representing Heads as 1, and Tails as 0:

open System

let simulate (rng: Random, n: int) (coin: Coin) =
    Array.init n (fun _ ->
        if rng.NextDouble() <= coin.ProbabilityHeads
        then 1
        else 0
        )

let seed = 1
let rng = seed |> Random

let sample = coin |> simulate (rng, 20)

… which gives us a particular sequence we might observe:

val sample: int[] =
  [|1; 1; 1; 0; 0; 1; 1; 0; 1; 1; 1; 1; 1; 0; 0; 0; 1; 1; 0; 0|]

For that particular example, we observe 12 Heads and 8 Tails:

> sample |> Array.countBy id;;
val it: (int * int)[] = [|(1, 12); (0, 8)|]

Nothing earth shattering so far. Now let’s consider this question: if all you saw was the sample we generated, should you believe that the coin is fair, or unbalanced?

That question can be restated slightly differently: based on the sample you are observing, what is the most likely value for p, the probability that the coin we used lands Heads? Is it 50% (a fair coin), or something else?

Note: we will ignore anything like prior beliefs you might have about that coin.

Your guess for that value is probably 60%, 12 Heads / (12 Heads + 8 Tails), and it would be a pretty good guess, which happens to be well founded theoretically. A more interesting question perhaps then is, why would this be a good guess?

Maximum Likelihood Estimation

There is more that one way you could arrive to that value of 60%. Let’s start from a few considerations. First, any coin could have given that specific sequence, but some coins are much less likely to generate it.

Given a particular coin with a probability p of landing Heads, what is the probability of observing a particular sequence of Heads and Tails? For an isolated coin toss, the probability of observing Heads is p, and Tails is 1.0 - p.

Now, quick recap: the probability of 2 independent events is the product of their probabilities, so for instance the probability of observing Heads, Tails with that coin would be P(Heads) * P(Tails), that is, p * (1.0 - p). By extension, assuming that each coin toss in the sequence is independent from the others, the probability of the whole sequence (the joint probability) becomes the product of the probabilities of each individual result.

So, given a particular sequence, and a possible coin, we can compute the probability to observe that sequence, like so:

let probabilityOfOutcome outcome coin =
    if outcome = 1
    then coin.ProbabilityHeads
    else 1.0 - coin.ProbabilityHeads

let probabilityOfSequence sample coin =
    sample
    |> Array.map (fun outcome ->
        probabilityOfOutcome outcome coin
        )
    |> Array.reduce (*)

We can now answer the question: given any possible coin that we could find in the universe, how likely is it that this particular coin would have generated the sample we observed:

{ ProbabilityHeads = 0.5 } |> probabilityOfSequence sample
val it: float = 9.536743164e-07

{ ProbabilityHeads = 0.6 } |> probabilityOfSequence sample
val it: float = 1.426576072e-06

It is more likely that a coin with p = 0.6 generated our sample, than a coin with p = 0.5. This leads to an approach: out of all the values of p that could have generated our sample, our parameter, pick the one that is the most likely to have generated the sample. This is, in essence, Maximum Likelihood Estimation.

Numerically, how could we go about this? As a first pass, we could perform a grid search. Try out many possible coins that could have generated that sample, and pick the one that gives us the highest likelihood, like so:

[ 0.05 .. 0.05 .. 0.95 ]
|> List.map (fun p ->
    let coin = { ProbabilityHeads = p }
    p, probabilityOfSequence sample coin
    )

val it: (float * float) list =
  [(0.05, 1.619678787e-16); (0.1, 4.3046721e-13); (0.15, 3.535464773e-11);
   (0.2, 6.871947674e-10); (0.25, 5.967194738e-09); (0.3, 3.063651608e-08);
   (0.35, 1.076771087e-07); (0.4, 2.817928043e-07); (0.45, 5.773666325e-07);
   (0.5, 9.536743164e-07); (0.55, 1.288404948e-06); (0.6, 1.426576072e-06);
   (0.65, 1.280868763e-06); (0.7, 9.081268533e-07); (0.75, 4.833427738e-07);
   (0.8, 1.759218604e-07); (0.85, 3.645500658e-08); (0.9, 2.824295365e-09)]

Based on this analysis, trying out a subset of all the coins of the universe, we see that the most likely candidate is a coin with p = 0.6, which gives us a likelihood of 1.426576072e-06.

Before going further, let’s look at a small technical issue. Our sample here has only 20 observations, and yet the probabilities we computed are already vanishingly small. This should not come as a surprise: we are multiplying together probabilities, which by definition are smaller than 1.0, so their product will becoming smaller and smaller as the sample size increases. It is not a problem just yet in our small example, but if we were to run the same calculation on large samples, we are going to run into precision errors, fast. Can we avoid this?

We can, with a small trick. The log of a product is the sum of the individual logs, that is,

log(p1 * p2 * ... pn) = log(p1) + log(p2) + ... + log(pn)

Why is this useful? First, we are dealing with probabilities, which are positive, so we can safely compute their log. Then, what we are interested here is the parameter p that gives us the largest likelihood, and, as the log function is increasing, it will not change their ranking.

So, instead of computing the likelihood of a sample given parameters, we will transform it into its log-likelihood, which will turn everything into a sum instead of a product:

let logLikelihood sample coin =
    sample
    |> Array.sumBy (fun outcome ->
        probabilityOfOutcome outcome coin
        |> log
        )

We can now re-do our grid search:

[ 0.05 .. 0.05 .. 0.95 ]
|> List.map (fun p ->
    let coin = { ProbabilityHeads = p }
    p, logLikelihood sample coin
    )

val it: (float * float) list =
  [(0.05, -36.35913364); (0.1, -28.47390524); (0.15, -24.06559125);
   (0.2, -21.09840336); (0.25, -18.93698891); (0.3, -17.3010732);
   (0.35, -16.04412882); (0.4, -15.08209377); (0.45, -14.36478836);
   (0.5, -13.86294361); (0.55, -13.56210558); (0.6, -13.46023334);
   (0.65, -13.56797199); (0.7, -13.91188176); (0.75, -14.54253976);
   (0.8, -15.55322592); (0.85, -17.12718703); (0.9, -19.68500693)]

The conclusion remains the same, but we got rid of the vanishingly small numbers problem.

Now what?

First, let’s be clear: what I will do next is overkill and a bit silly. The correct estimator is the number of Heads divided by the number of coin tosses. We could attempt to prove it and be done with this problem, with an efficient algorithm, just dividing 2 numbers.

Indead, what I will do is, in the immortal words of my high school math teacher, use a Jackhammer to push in a thumbtack. My motivation here is two-fold. I want to build up towards an approach that will work for more complex situations than “just coin tosses”. The approach will be absurd for the problem at hand, but will help prepare the ground for more general problems, where the maximum likelihood is hard to work with, and does not have a neat, obvious solution. Then, by doing so, I will have a great excuse to apply DiffSharp.

With that out of the way, let’s grab that Jackhammer and get to work :)

Implementing Maximum Likelihood Estimation

The grid search approach has the benefit of being simple, and pretty effective in this case. However, it has limitations. First, we are testing a small subset for the values of our parameter p. What if the best value was 0.6238432? Then, this will not scale well for more complex problems, which might have more than just one parameter. The space of values we would have to explore will increase as a power of the number of parameters, making our search very inefficient.

As an alternative, we could use Gradient Descent, or, rather, Gradient Ascent.

What we are trying to do here is to find the value of the parameter p which gives us the largest log-likelihood value for the sample. We have a function log likelihood(p, sample), and we want to maximize it. One way of doing that is gradient ascent:

Take a starting value of p, perhaps p_0 = 0.5
Compute the derivative of log likelihood(p_0, sample), with respect to p
If the derivative is positive, increasing p from p_0 will increase the log likelihood
If the derivative is negative, decreasing p from p_0 will increase the log likelihood
Update p to p_1 = p_0 + small constant * derivative(p_0), i.e. take a small step to increase the log likelihood
rinse & repeat, starting from p_1

The only difficulty here is the step “Compute the derivative of log likelihood(p_0, sample), with respect to p”. This is where DiffSharp comes in.

Let’s do this, and use DiffSharp at last. All we need to do here is express the log likelihood function in a way that DiffSharp can work with. If we have that, then we can let it do the heavy lifting and compute the derivatives for us.

Note: this part is mostly lifted from the differentiable programming DiffSharp code sample. I took the sample, and tried to remove as much as I could to figure out what was happening.

First, let’s load DiffSharp in our scripting environment:

#r "nuget: DiffSharp-cpu"
open DiffSharp
open DiffSharp.Model

The first element will be to create a function that we can differentiate, and use to compute a log likelihood. This is what I ended up doing:

let differentiable 
    (parameters: seq<Parameter>)
    (f: 'Input -> 'Output) =
        Model<'Input, 'Output>.create [] parameters [] f

let probabilityModel () =
    let init = { ProbabilityHeads = 0.5 }
    let parameter =
        init.ProbabilityHeads
        |> dsharp.scalar
        |> Parameter
    differentiable
        [ parameter ]
        (fun outcome ->
            if outcome = 1
            then parameter.value
            else 1.0 - parameter.value
            )

The differentiable function is a small utility wrapper. Its purpose is to take a function f, and connect it to a list of Parameter, returning a Model, which wraps the original function, but also knows which parameters DiffSharp can use for differentiation.

The probabilityModel () function illustrates this, creating the core model we will use. We start with an initial value, a fair coin that has a 50% probability of landing Heads. That probability is the Parameter we want to “manipulate”, so we create a Parameter from it, using its constructor.

Note how we convert the probability, a float, using dsharp.scalar. The core data model for DiffSharp is tensors. As a first approximation, think of a Tensor as an Array, but an array that could be a regular Array, or an Array2D, or an array of any dimension. The Parameter constructor expects a Tensor, which is what we do: dsharp.scalar creates a Tensor of dimension 0, a single value.

We instantiate a Model next: we pass in our single Parameter, and create on the fly a function that takes an integer, the coin toss outcome we observed. If that outcome is 1, we return p, the current probability parameter in our model, otherwise we return 1.0 - p. In other words, we more or less replicated our earlier function probabilityOfOutcome, with one nuance: we declared that there was one Parameter, the probability, that could be changed and used for differentiation.

Now let’s write a function to maximize the log likelihood of a model! That part is more or less directly lifted up from the DiffSharp code sample, with minor modifications:

type Config = {
    LearningRate: float
    MaximumIterations: int
    Tolerance: float
    }

let maximizeLikelihood (config: Config) sample (density: Model<_,_>) =

    let logLikelihood (density: Model<_,_>) =
        sample
        |> Array.sumBy (fun outcome ->
            density.forward outcome
            |> dsharp.log
            )

    let tolerance =
        config.Tolerance
        |> dsharp.scalar

    let rec learn iteration =
        // evaluate the log likelihood and propagate back to density
        density.reverseDiff()
        let evaluation: Tensor = logLikelihood density
        evaluation.reverse()
        // update the parameters of density
        let p = density.parametersVector
        density.parametersVector 
            <- p.primal + config.LearningRate * p.derivative
        printfn $"Iteration {iteration}: Log Likelihood {evaluation}, Parameters {p}, Updated: {density.parametersVector}"
        // stop iterating, or keep going
        if 
            dsharp.norm p.derivative < tolerance 
            || 
            iteration >= config.MaximumIterations
        then density.parametersVector
        else learn (iteration + 1)
    learn 1

The Config type is simply a record storing configuration parameters tidily in one place.

The interesting part is what happens in the maximizeLikelihood function. That function expects 3 arguments: the configuration, a sample (in our case, an array of 0s and 1s), and density, a DiffSharp Model that will return the probability density of observing a particular individual outcome in the sample, given its current parameters.

First, we create the logLikelihood function: given a Model, we iterate over the sample, and for each observation / outcome, we use density.forward to compute the probability of observing that outcome. The result is a tensor, which we convert to a log using dsharp.log - and we sum all that together: we have the log-likelihood of observing our sample, given a Model.

The recursive learn function is where Dark Magic happens. What I think is happening here goes along these lines. density.reverseDiff() declares that the density model is now open to accept updates. We compute evaluation using logLikelihood and the current model, and (with a lot of hand-waving), evaluation.reverse() propagates back the relevant partial derivatives information to the parameters of density, our model.

The next line is a direct implementation of gradient update: we replace the values of the model parameters, by their current value (primal), plus a small step (the learning rate) towards the derivatives:

density.parametersVector <- p.primal + config.LearningRate * p.derivative

And that’s pretty much it - the rest of the function either terminates if the maximum number of iterations has been reached or the change is smaller than some tolerance threshold, or repeats the update.

Does it work? Let’s try it out. All we need at that point is to bolt the pieces together:

let config = {
    LearningRate = 0.01
    MaximumIterations = 50
    Tolerance = 0.01
    }

probabilityModel ()
|> maximizeLikelihood config sample

… which will result in the following:

Binding session to 'C:/Users/mathias/.nuget/packages/diffsharp.backends.reference/1.0.7/lib/netstandard2.1/DiffSharp.Backends.Reference.dll'...
Iteration 1: Log Likelihood tensor(-13.8629):rev, Parameters tensor([0.5000]):rev, Updated: tensor([0.5800])
Iteration 2: Log Likelihood tensor(-13.4767):rev, Parameters tensor([0.5800]):rev, Updated: tensor([0.5964])
Iteration 3: Log Likelihood tensor(-13.4608):rev, Parameters tensor([0.5964]):rev, Updated: tensor([0.5994])
Iteration 4: Log Likelihood tensor(-13.4602):rev, Parameters tensor([0.5994]):rev, Updated: tensor([0.5999])
Iteration 5: Log Likelihood tensor(-13.4602):rev, Parameters tensor([0.5999]):rev, Updated: tensor([0.6000])

The gradient update stops after 5 iterations, with an estimate of p = tensor([0.6000]).

Conclusion and Parting Notes

This is where I will stop for today. As is probably clear from my comments in the DiffSharp part, I will need to do some more digging. However, with some heavy hand-waving… we did a thing! And the thing worked! And all in all, it was fairly easy to get it working.

For the next installment, I plan to expand on what we did here, but on a “real” problem, survival analysis, where computing the log likelihood and its gradient are much trickier.

In the meantime, here are a few thoughts early in this journey:

Pretty Printer bug? I strongly suspect that there is a bug somewhere around pretty-printers in the version of DiffSharp I am using here, version 1.0.7. I haven’t had time to look at the source code yet, but I experienced multiple exceptions that took down the entire F# scripting environment / process. These seem to occur around displaying a Model. As a workaround, I avoided returning models in scripts, which is why probabilityModel () takes a unit argument in the code above :)

Tensors: I suspect it will take a bit for me to get used to Tensors everywhere. On one hand, using tensors makes a lot of practical sense in this domain. Tensors provide a flexible abstraction for representing things like vectors, matrices, numbers, and more - and this the bread-and-butter of numeric analysis. On the other hand, as a result, everything takes a Tensor and returns a Tensor, without much hinting at what tensor shape might actually work. The flexibility seems to come at the expense of some clarity, and some runtime errors.

Along similar lines, I don’t have a good grasp yet of what behaviors I should expect from Tensors. As a small example, as far as I can tell, tensor |> dsharp.log will apply the log function to every element of the tensor, but tensor |> dsharp.map (dsharp.log) appears to do the same. It’s not difficult to figure out what is going on here, and I suspect the first version is “better”, but this also hints at how tensors and arrays are different. Maybe I will do a post just on tensors and what I understand about them at some point.

Anyways, hope you found this post interesting! Ping me on Twitter if you have comments or questions, and… happy coding!

Breaking down the Nelder Mead algorithm

2022-03-31T00:00:00+00:00

The Nelder-Mead algorithm is a classic numerical method for function minimization. The goal of function minimization is to find parameter values that minimize the value of some function. That description might sound abstract, but it deals with a very practical and common problem. For the Excel fans out there, the Goal Seek function is a concrete example of what function minimization is about. You want Excel to find values that make another cell equal to some value. This is a minimization problem: you are trying to make the difference between the calculated value and the target value as small as possible, by tweaking some input values.

That problem arises in many places. Regression (find parameters of a prediction function to minimize the overall prediction error), hyper-parameters optimization in machine learning, the list goes on and on.

Unfortunately, there isn’t a universal method to solve the problem. Nelder Mead is one method, and a classic (1965!). One interesting aspect of the method is that it does not rely on gradients / derivatives, but uses a heuristic that compares the value of the function at different points (the “simplex”), and progressively moves towards improvements.

It is also a method I never had a chance to really dig into, so today I figured I would break down the algorithm to figure out how it actually works. So let’s dive in!

The idea behind Nelder Mead

Note: This is my understanding of the algorithm, based on walking through this outline, and implementing accordingly. There might be errors, please let me know if you find any!

Nelder Mead starts with a collection of candidate values, the Simplex. In the example below, we have a simplex with 3 points, and we are trying to find a new point that is lower on the curve. We can compute the value of our function at each of these 3 points, and as a result we have a best current point, a worst current point, and a second-worst point.

Note: the 3 points do not have to be ordered the way they are on the picture above. The worst point could be the candidate in the middle, or on the right.

Note: the algorithm also works with functions that take any number of arguments. I focused on a function with a single argument as an example here, because I found it made it easier to follow graphically what each of the steps was attempting to do.

Each iteration, the algorithm will attempts to move the position of the current worst candidate. The movement will be relative to the Centroid of the remaining simplex, that is, the “center of gravity” of the other candidates. To decide what movement to take, the algorithm performs some tests:

Reflection: First, we try to move the worst candidate to the other side of the centroid. We compute the reflected candidate, a position that mirrors our worst candidate across the centroid. if that is better than our second worst candidate, but not better than the best candidate, we have a decent improvement: we simply replace our worst, and repeat.

Expansion: If the reflected candidate is even better than our current best, this is a promising direction. We try to push even further in the same direction, and compute an expanded candidate. If the expanded candidate is even better, we take it and replace our current worst, otherwise we replace it with the reflected candidate, and repeat.

If the reflected candidate is better than our current worst, but not better than our second worst, this is still a promising direction. We try a shorter move in the same direction: instead of expanding, we compute a contracted outside candidate, moving less aggressively towards the reflected direction. If that is better than the reflected candidate, we use it and repeat:

If it is not an improvement, moving towards the reflected direction does not help. Instead, we shrink: we take the whole simplex, and move every point towards the current best candidate.

Finally, if the reflected candidate is even worse than our current worst, then we attempt a move in the opposite direction, and compute a contracted inside candidate. If that is an improvement over our current worst, we take it. Otherwise, we have no good move available, and shrink the simplex:

So, as I understand it, the algorithm does not directly search for a direct improvement of the candidate, like gradient descent. Instead, it searches for a promising area for an improvement, and updates the search area, moving the worst corner / edge of the simplex iteratively, taking large steps into a promising direction when it finds one, and otherwise shrinking the search area.

Which leads us to termination: when do you stop? In the version I looked at, the algorithm stops when all candidates in the simplex have values close to each other. This would happen if the search area was close to a minimum: in that case, we would expect a flat surface at the bottom of a valley, so to speak.

A rough implementation of Nelder Mead

Now that we took a look at the logic behind the algorithm… does it actually work?

To check that, we need an implementation. I took a stab at it, paying no attention to performance or style. My goal here was clarity, to make sure I understood what was going on first. There are a lot of low-hanging fruits to make the code better, I’ll revisit that later.

Without further due, here is my first take at the algorithm. The update function takes 2 arguments:

the function f that we are trying to minimize, with the expected inputs dimension dim, that is, the number of arguments it expects,
the current simplex, an array of array of floats, our current candidates.

update will take the current state of the simplex, and return an updated simplex, where the worst candidate will have been modified according to the rules described before, or the entire simplex will have been shrunk.

Note that I represented the function as float [] -> float. The float [] are the function arguments: I went for an array, because I wanted to handle functions that could take more than one argument. As an illustration, a function that adds 2 numbers would be expressed as:

let add (xs: float []) = x[0] + x[1]

Anyways, here we go: Nelder Mead update, take one:

let update (dim: int, f: float [] -> float) (simplex: (float []) []) =

    // 1) order the values, from best to worst
    let ordered =
        simplex
        |> Array.sortBy f

    // 2) calculate centroid
    let size = simplex.Length
    // drop the worst candidate
    let bestCandidates = ordered[.. size - 2]
    // calculate average point (centroid)
    let centroid =
        Array.init dim (fun col ->
            bestCandidates
            |> Array.averageBy(fun pt -> pt[col])
            )

    // 3) reflection
    let worst = ordered[size - 1]
    let alpha = 1.0
    let reflected =
        Array.init dim (fun col ->
            centroid[col] + alpha * (centroid[col] - worst[col])
            )
    let secondWorst = ordered[size - 2]
    let best = ordered[0]
    if
        f reflected < f secondWorst
        &&
        f reflected >= f best
    then
        // replace worst by reflected
        ordered[size - 1] <- reflected
        ordered

    // 4) expansion
    elif
        f reflected < f best
    then
        let gamma = 2.0
        let expanded =
            Array.init dim (fun col ->
                centroid[col] + gamma * (reflected[col] - centroid[col])
                )
        if f expanded < f reflected
        then
            ordered[size - 1] <- expanded
        else
            ordered[size - 1] <- reflected
        ordered

    // 5) contraction
    elif f reflected < f worst
    then
        let rho = 0.5
        let contractedOutside =
            Array.init dim (fun col ->
                centroid[col] + rho * (reflected[col] - centroid[col])
                )
        if f contractedOutside < f reflected
        then
            ordered[size - 1] <- contractedOutside
            ordered
        else
        // 6) shrink
            let sigma = 0.5
            let shrunk =
                ordered
                |> Array.map (fun pt ->
                    Array.init dim (fun col ->
                        best[col] + sigma * (pt[col] - best[col])
                        )
                    )
            shrunk
    elif f reflected >= f worst
    then
        let rho = 0.5
        let contractedInside =
            Array.init dim (fun col ->
                centroid[col] + rho * (worst[col] - centroid[col])
                )
        if f contractedInside < f worst
        then
            ordered[size - 1] <- contractedInside
            ordered
        else
        // 6) shrink
            let sigma = 0.5
            let shrunk =
                ordered
                |> Array.map (fun pt ->
                    Array.init dim (fun col ->
                        best[col] + sigma * (pt[col] - best[col])
                        )
                    )
            shrunk
    // 6) shrink
    else
        failwith "All cases should have been covered"

All we need at that point is a function to handle algorithm termination, and a function to create our initial simplex. Let’s go:

let terminate (tolerance: float) (f: float [] -> float) (simplex: float [][]) =
    // We stop when for every point in the simplex,
    // the function values are all close to each other.
    let evaluations = simplex |> Seq.map f
    let min = evaluations |> Seq.min
    let max = evaluations |> Seq.max
    max - min < tolerance

Given a simplex, we extract the smallest and largest function evaluations. If these are within some bounds (the tolerance), we are done.

How about initialization? We’ll go for some fairly naive approach here: given a starting point provided by the user, we will create a bunch of candidates, varying each value of the starting point by + or - 1:

let initialize (dim: int, f: float [] -> float) (startingPoint: float []) =
    [|
        yield startingPoint
        for d in 0 .. (dim - 1) ->
            let x = startingPoint |> Array.copy
            x[d] <- startingPoint[d] + 1.0
            x
        for d in 0 .. (dim - 1) ->
            let x = startingPoint |> Array.copy
            x[d] <- startingPoint[d] - 1.0
            x
    |]

Trying it out: does it actually work?

Does this thing actually work? Let’s wrap what we have in a small function, and try it out on a couple of examples:

let solve (tolerance: float) (dim: int, f: float [] -> float) (start: float []) =
    if start.Length <> dim
    then failwith $"Invalid starting point dimension: {start.Length}, expected {dim}."
    let simplex = initialize (dim, f) start
    simplex
    |> Seq.unfold (fun simplex ->
        let updatedSimplex = update (dim, f) simplex
        let solution =
            updatedSimplex
            |> Array.map (fun pt -> pt, f pt)
            |> Array.minBy snd
        Some ((solution, updatedSimplex), updatedSimplex)
        )
    |> Seq.takeWhile (fun (solution, simplex) ->
        simplex |> terminate tolerance f |> not
        )
    |> Seq.iter (fun ((solution, evaluation), _) ->
        printfn "%A: %.4f" solution evaluation
        )

Let’s try out a few simple 1 dimension examples first.

The function f(x) = x^2 has a minimum at 0.0. Let’s set the tolerance to 0.000,001 and see what happens, starting with an initial guess of 100.0.

let tolerance = 0.000_001
solve tolerance (1, fun x -> pown x[0] 2) [| 100.0 |]

[|96.5|]: 9312.2500
[|93.25|]: 8695.5625
[|86.625|]: 7503.8906
// snipped for brevity
[|-0.0003410830395|]: 0.0000
[|0.0003086419019|]: 0.0000

In about 30 iterations, we have a good solution approximation.

Let’s try f(x) = cos(x) next, starting at 0.0:

solve tolerance (1, fun x -> cos x[0]) [| 0.0 |]

In about 30 iterations, we have a solution, 3.141963005, which is pretty close to the correct answer, Pi:

[|1.0|]: 0.5403
[|2.25|]: -0.6282
[|2.75|]: -0.9243
// snipped for brevity
[|3.141963005|]: -1.0000
[|3.141963005|]: -1.0000

Let’s test it out on something more serious, using some of the classic test functions for optimization:

let beale (v: float[]) =
    let x, y = v[0], v[1]
    pown (1.5 - x + x * y) 2
    + pown (2.25 - x + x * y * y) 2
    + pown (2.625 - x + x * y * y * y) 2

solve tolerance (2, beale) [| 0.0; 0.0 |]

The Beale function has a known minimum at (3.0, 0.5), which the algorithm finds:

[|1.5; 0.0|]: 1.8281
[|1.5; 0.0|]: 1.8281
[|1.5; 0.0|]: 1.8281
[|1.5; 0.0|]: 1.8281
[|1.5; 0.0|]: 1.8281
[|3.623046875; 0.62109375|]: 0.0337
// snipped for brevity
[|3.002150137; 0.500610984|]: 0.0000
[|3.000936994; 0.5000857414|]: 0.0000
[|2.999118655; 0.4998541196|]: 0.0000
[|2.999118655; 0.4998541196|]: 0.0000

A last one for the road, the Booth function:

let booth (v: float []) =
    let x, y = v[0], v[1]
    pown (x + 2.0 * y - 7.0) 2
    + pown (2.0 * x + y - 5.0) 2

solve tolerance (2, booth) [| 0.0; 0.0 |]

Again, we find its minimum at (1.0, 3.0) in a few iterations:

[|0.0; 2.75|]: 7.3125
[|1.5; 1.875|]: 3.0781
[|1.25; 2.8125|]: 0.1133
// snipped for brevity
[|1.000358243; 3.000211252|]: 0.0000
[|1.000757956; 2.999423248|]: 0.0000
[|0.9999284495; 3.000386917|]: 0.0000

So far, so good. On our 4 examples, the algorithm did work. Will it always work? No. The function may not have a minimum, it may not be well-behaved for every input value, it may not be smooth. It may also get stuck in a local minimum if we are unlucky with our initial starting point guess. Many things could go wrong, but still: on the limited set of examples we tried out, it behaved quite nicely.

Parting words

This is where we will stop for today!

The implementation for the algorithm is pretty naive. As I mentioned before, this is a first cut: I tried my best to focus on a direct, literal transcription of the algorithm, without making any effort at optimization or style. I will probably take a stab at improving it in a follow up post. In no particular order, here is a list of things that could be improved:

Extract the reflection parameters Alpha, Gamma, Rho, Sigma,
Turn all 4 reflections into a single function,
Avoid un-necessary function evaluations,
Try to avoid un-necessary sorting of the simplex candidates,
Try to clarify the logic, removing if branches.

The solve function should also be improved, to handle situations like:

Function with no minimum (limit number of iterations),
Functions that are not defined over all numbers.

That being said, overall, we have a decent starting point - it should make for an interesting redesign exercise!

Other than that, I was pleasantly surprised at how well the algorithm works. This is particularly interesting, because the approach is fairly simple. It does not use anything complicated mathematically: all it does is, try to take a step to improve the worst candidate, probing along that direction to figure out how big that step should be. I found the overall approach interesting too, by contrast with gradient descent: instead of trying to directly find a solution, it tries to find a search area that contains a potential solution, and progressively shrink it.

Anyways, hope you found this post interesting! Ping me on Twitter if you have comments or questions, and… happy coding!

5 obscure charting tips with Plotly.NET

2022-01-23T00:00:00+00:00

For the longest time, my go-to charting library for data exploration in F# was XPlot. It did what I wanted, mostly: create “standard” charts using Plotly to visualize data and explore possible interesting patterns. However, from time to time, I would hit limitations, preventing me from using some of the more advanced features available in Plotly.

Fortunately, there is a new game in town with Plotly.NET. Thanks to the wonderful work of @kMutagene and contributors, we can now create a very wide range of charts in .NET, via Plotly.js.

At that point, I have made the switch to Plotly.NET. In this post, rather than go over the basics, which are very well covered in the documentation, I will dig into some more obscure charting features. Part of this post is intended as “notes to self”: Plotly has a lot of options, and finding out how to achieve some of the things I wanted took some digging in the docs. Part of it is simply a fun exploration of charts that are perhaps less known, but can come in handy.

Without further due, let’s start!

1: Splom charts

When you have 2 continuous variables and want to identify a possible relationship between them, scatterplots are your friend. For illustration, imagine you had a dataset of wines, where for each wine you know the type (red or white), and a bunch of chemical measurements:

type Wine = {
    Type: string
    FixedAcidity: float
    VolatileAcidity: float
    CitricAcid: float
    ResidualSugar: float
    Chlorides: float
    FreeSulfurDioxide: float
    TotalSulfurDioxide: float
    Density: float
    PH: float
    Sulphates: float
    Alcohol: float
    Quality: float
    }

Are PH and Fixed Acidity related? Let’s check:

Chart.Scatter(
    dataset |> Seq.map (fun x -> x.PH, x.FixedAcidity),
    StyleParam.Mode.Markers
    )
|> Chart.withXAxisStyle("PH")
|> Chart.withYAxisStyle("Fixed Acidity")

It looks like there is a relationship indeed: when fixed acidity is high, PH tends to be lower.

Are there other interesting relationship between variables? This is a great question, but, with 12 variables, we would need to create and inspect 55 distinct scatterplots. That is a bit tedious.

Enter the Scatterplot Matrix, or SPLOM in short:

Chart.Splom(
    [
        "alcohol", dataset |> Seq.map (fun x -> x.Alcohol)
        "chlorides", dataset |> Seq.map (fun x -> x.Chlorides)
        "citric acid", dataset |> Seq.map (fun x -> x.CitricAcid)
        "density", dataset |> Seq.map (fun x -> x.Density)
        "fixed acidity", dataset |> Seq.map (fun x -> x.FixedAcidity)
    ]
    )

A SPLOM displays all the scatterplots between variables in a grid, giving us a quick visual scan for whether obvious relationships exist. It will not scale well to wider datasets (if we have many columns/features), but for a dataset like this one, with a limited number of features, it is very convenient.

2: Violin and Boxplot charts

Suppose we wanted to examine the relationship between the alcohol level of a wine, and its quality, that is, how it was rated by people. These are both numeric variables, so let’s create another scatterplot:

Chart.Scatter(
    dataset |> Seq.map (fun x -> x.Quality, x.Alcohol),
    StyleParam.Mode.Markers
    )
|> Chart.withXAxisStyle("Quality")
|> Chart.withYAxisStyle("Alcohol")

That is not a very enlightening chart. The problem here is that ratings are integers: Each wine receives a grade between 0 and 10. As a result, all the dots are clumped on the same vertical lines, each one corresponding to one of the ratings.

Instead of a scatterplot, we could use a Violin chart here:

Chart.Violin(
    dataset |> Seq.map (fun x -> x.Quality, x.Alcohol)
    )
|> Chart.withXAxisStyle("Quality")
|> Chart.withYAxisStyle("Alcohol")

What the chart shows is how the alcohol level is distributed, for each of the quality levels. What I see on this chart is that, for wines that have received a higher rating, the distribution is thicker at the top. In other words, people tend to prefer wines with a higher alcohol level.

Boxplot charts serve a similar purpose:

Chart.BoxPlot(
    dataset |> Seq.map (fun x -> x.Quality, x.Alcohol)
    )
|> Chart.withXAxisStyle("Quality")
|> Chart.withYAxisStyle("Alcohol")

Instead of representing the full distribution, the chart displays 5 values for each group: a box with the median, the 25% and 75% percentiles, and the min and max values. In plain English, the chart shows where most of the observations fell (the box), and how extreme it could get (the min and max).

A nice feature of Plotly.NET is the ability to stack charts with a shared X Axis. As an example, imagine we wanted to see if the pattern we found before (more alcohol, happier customers) applies equally to red and white wines. One way we could check that is to split the data by wine type, and stack boxplots, like so:

[
    Chart.BoxPlot(
        dataset 
        |> Seq.filter (fun x -> x.Type = "red") 
        |> Seq.map (fun x -> x.Quality, x.Alcohol)
        ) 
    |> Chart.withYAxisStyle("Red / Alcohol")

    Chart.BoxPlot(
        dataset 
        |> Seq.filter (fun x -> x.Type = "white") 
        |> Seq.map (fun x -> x.Quality, x.Alcohol)
        ) 
    |> Chart.withYAxisStyle("White / Alcohol")
]
|> Chart.SingleStack(Pattern= StyleParam.LayoutGridPattern.Coupled)
|> Chart.withXAxisStyle("Quality")

We can now see both charts side-by-side, and confirm that the pattern appears to hold, regardless of whether the wine is red or white.

3: 2D Histogram and Contour charts

Let’s consider another pair of variables, Alcohol Level and Fixed Acidity, starting with a Scatterplot:

Chart.Scatter(
    dataset |> Seq.map (fun x -> x.Alcohol, x.FixedAcidity),
    StyleParam.Mode.Markers
    )
|> Chart.withXAxisStyle("Alcohol")
|> Chart.withYAxisStyle("Fixed Acidity")

Again, this scatterplot is a bit difficult to parse, because we have a large clump of observation all bunched together. Instead of looking at the individual dots, what might help would be to see where we have dense clumps of points.

Chart.Histogram2D (
    dataset |> List.map (fun x -> x.Alcohol), 
    dataset |> List.map (fun x -> x.FixedAcidity),
    NBinsX = 20,
    NBinsY = 20
    )
|> Chart.withXAxisStyle("alcohol")
|> Chart.withYAxisStyle("fixed acidity")

This chart divides the data in a grid of 20 x 20 equal cells along each variable, and counts how many observations fall into each cell. Think of it as a grid of histograms seen from above, where the color indicates how high the column rises.

Expanding on this idea, we could imagine that this grid represents altitudes. The Contour chart does just that:

Chart.Histogram2DContour(
    dataset |> List.map (fun x -> x.Alcohol), 
    dataset |> List.map (fun x -> x.FixedAcidity),
    NBinsX = 20,
    NBinsY = 20,
    NCountours = 20
    )
|> Chart.withXAxisStyle("alcohol")
|> Chart.withYAxisStyle("fixed acidity")

As for the Histogram2D, we put all the datapoints in a 20 x 20 grid, and count the observations. The chart then renders this as an altitude map, showing where most of the observations are, and creating isolines for fictional altitude levels, interpolated from the data.

In this case, we can see that most observations are concentrated at a peak around 9.5 alcohol, 6.5 fixed acidity, and stretch along a ridge corresponding to a fixed acidity level of around 6.5. In other words, the 2 variables appear to be unrelated: for all alcohol levels, the changes in fixed acidity are similar.

4: Line Shape

For our 2 last examples, we will leave the wine dataset aside.

Imagine that you are tracking the behavior of a device, which is either on or off. The log for such a device would look like time stamps, and perhaps 0 and 1s, indicating when the device stopped or restarted.

We can easily simulate something along these lines:

let rng = Random(0)
let startTime = DateTime(2022, 1, 1)

let performanceSeries =
    (startTime, 0.0)
    |> Seq.unfold (fun (time, value) -> 
        let nextTime = time.AddMinutes (rng.NextDouble())
        let nextValue =
            if value = 0.0 then 1.0 else 0.0
        Some ((time, value), (nextTime, nextValue))
        )
    |> Seq.take 10
    |> Seq.toArray

This produces a performanceSeries like this:

2022-01-01 00:00:00Z, 0
2022-01-01 00:00:43Z, 1
2022-01-01 00:01:32Z, 0
2022-01-01 00:02:18Z, 1
2022-01-01 00:02:52Z, 0
etc ...

Let’s plot that series:

Chart.Scatter(
    performanceSeries, 
    StyleParam.Mode.Lines_Markers
    )

This is easy enough to create, but is not painting a correct picture of what is happening. Our device can only be in one of two states: 0 or 1, but the chart connects all the dots with straight line. As a result, it is difficult to see for how long the device was active or inactive. Can we do better?

Chart.Scatter(
    performanceSeries, 
    StyleParam.Mode.Lines_Markers, 
    Line = Line.init(Shape = StyleParam.Shape.Hv)
    )

What does the Shape parameter do? Shape comes in a few different flavors, in this case HV for “horizontal, vertical”. From a data point, start horizontally until the next value is reached, and there make a vertical move.

5: Density and Cumulative charts

Let’s finish up with a different problem. Imagine you were regularly playing a game involving 20-sided dice, and were asked the following question: is it better to roll twice and take the best roll, or to roll once, and add 2 to the result?

Let’s build a simulation, rolling 10,000 times for each option:

let advantageRolls = 
    Array.init 10000 (fun _ -> 
        let roll1 = rng.Next(1, 21)
        let roll2 = rng.Next(1, 21)
        max roll1 roll2
        )

let bonusRolls =
    Array.init 10000 (fun _ -> 
        let roll = rng.Next(1, 21)
        roll + 2
        )

The Chart.Histogram function will plots the distribution of the data as a histogram, for instance:

Chart.Histogram(advantageRolls)

Chart.Histogram(bonusRolls)

These are densities: they display how many observations fall in each bucket (or bin). This is useful (we can see that the results are clearly very different), but not very convenient to compare how much better one option might be compared to the other. What we would like is something along the lines of “what are the chances of getting more than a certain value”.

As it turns out, this has a name. What we want is the Cumulative Distribution, the probability of getting less than a certain value. Let’s do that, using HistNorm to convert the raw values into percentages:

Chart.Histogram(
    advantageRolls, 
    Cumulative = TraceObjects.Cumulative.init(true),
    HistNorm = StyleParam.HistNorm.Percent
    )

This is much better: now we can directly read that we have an 80.98% chance of getting 18 or less, or, alternatively, an almost 20% chance of getting a 19 or 20.

Can we plot the 2 cumulatives together? With a bit of work, we can:

[
    Chart.Histogram(
        advantageRolls,
        Name = "Advantage",
        Opacity = 0.5,
        OffsetGroup = "A",
        Cumulative = 
            TraceObjects.Cumulative.init(
                true,
                StyleParam.CumulativeDirection.Decreasing
                ),
        HistNorm = StyleParam.HistNorm.Percent
        )
    Chart.Histogram(
        bonusRolls,
        Name = "Bonus +2",
        Opacity = 0.5,
        OffsetGroup = "A",
        Cumulative = 
            TraceObjects.Cumulative.init(
                true,
                StyleParam.CumulativeDirection.Decreasing
                ),
        HistNorm = StyleParam.HistNorm.Percent
        )
]
|> Chart.combine

We are using a few tricks here. First, we set the Cumulative to a decreasing direction: instead of showing the probability of rolling less than a given number, our chart displays now the probability of getting more than a given number. As a result, we can directly read “what is the chance of rolling more than 15”, for instance.

The second trick is the use of OffsetGroup. There might be a better way to achieve this, but I wanted to have the two curves on top of each other. By assigning them to the same offset group, they end up being superposed.

Because we set the curves to a 50% Opacity, we see at the top of the curve the strategy that has the best probability of succeeding, by level. Interestingly, the chart shows that the question “which one is better” is an ill-formed question, and depends on the goal. In most cases, the “Advantage” strategy (roll twice, keep the best) dominates. However, if you need to roll a 19 or anything higher, you should take the “Bonus +2” strategy.

As a side note, what I’d really like is not a histogram, but a line / scatterplot that represents the cumulative, without binning. I can create this by preparing the data myself and using a scatterplot, but if someone knows of a way to directly produce this using Plotly.NET, I would love to hear about it!

Conclusion

That is what I got today! I realize that this post might be a bit of a hodge-podge, but hopefully this will either encourage you to give Plotly.NET a spin if you haven’t yet, or given you ideas otherwise :)

Ping me on Twitter if you have comments or questions, and… happy coding!

Picking from Random Tables

2022-01-07T00:00:00+00:00

Once again, I started a weekend project on a minor problem that ended up being more involved than expected. This time, the topic is random tables. Random tables are used often in role playing games, to create random items or ideas on the fly, based on a dice roll.

The process of rolling physical dice is fun, but can be slow, so I started coding some of these random tables to help me keep the flow going during games. As an example, this page creates “random citizens” you might encounter in the fictional city of Doskvol. Every roll will produce a new citizen, like this one for instance:

In general, these are not too complicated. However, some generators can become quite tricky. As an example, “The Perilous Wilds” has complex tables like this one:

Ability (roll 1d12)
---
bless/curse
entangle/trap/ensnare
// omitted entries
MAGIC TYPE
drain life/magic
immunity: ELEMENT
read/control minds
roll twice on this table

I have had a lot of fun so far trying to model these tables in F#, so I figured perhaps sharing my exploration would make an interesting topic!

Picking from simple tables

Conceptually, a Table is a finite collection of entries, which we want to randomly pick from. Tables come in two flavors: “flat tables” (every entry has the same chance to be selected), and weighted tables (entries have different weights, describing their relative probability of being picked).

Let’s start with “flat tables”. All we need here is a random generator, and a list of entries:

let uniform (rng: Random) (uniform: List<_>) =
    let i = rng.Next(0, uniform.Length)
    uniform.[i]

Note: from a performance standpoint, an array would be better, but I will stick with lists here. Performance is not really a concern here, and lists have a nicer syntax for a DSL.

let alignment = [
    "chaotic"
    "evil"
    "neutral"
    "good"
    "lawful"
    ]
let rng = Random ()

… which we can use to produces random alignments, like so:

> uniform rng alignment;;
val it: string = "evil"

How about weighted tables? That is a little more work. We need to have a strictly positive weight for each entry, and pick accordingly. After some internal debate, I decided to wrap the Weights into their own type, to enforce that they are indeed positive:

type Weight =
    private | W of int
    with
    static member create w =
        if w <= 0
        then failwith $"Invalid weight {w}: pick weight must be positive."
        else W w
    member this.Value =
        this
        |> function | W w -> w

We can now use weights to pick from a weighted list, like so: we roll a number, and walk down the list until the roll is higher than the running total of the weights.

let weighted (rng: Random) (weighted: list<Weight * _>) =
    let total =
        weighted
        |> List.sumBy (fun (w, _) -> w.Value)
    let roll = rng.Next (0, total) + 1
    let rec search acc (entries: list<Weight * _>) =
        match entries with
        | [] -> failwith "no entry to pick from table"
        | (weight, value) :: tl ->
            let acc = acc + weight.Value
            if acc >= roll
            then value
            else search acc tl
    search 0 weighted

For convenience, we also create a function, weight, to simplify our syntax:

let weight (i: int) = Weight.create i

At that point, we can create weighted lists:

let size = [
    weight 1, "tiny"
    weight 2, "small"
    weight 3, "medium"
    weight 2, "large"
    weight 1, "huge"
    ]

… and pick from them:

> weighted rng size;;
val it: string = "medium"

A quick sanity check confirms that the distribution looks plausible:

List.init 100000 (fun _ -> weighted rng size)
|> List.countBy id

val it: (string * int) list =
  [("large", 22343); ("medium", 33445); ("small", 21999); ("tiny", 11095);
   ("huge", 11118)]

As a final step, let’s wrap the 2 types of tables into one type, Distribution:

type Distribution<'T> =
    | Uniform of list<'T>
    | Weighted of list<Weight * 'T>
    with
    member this.Length =
        match this with
        | Uniform xs -> xs.Length
        | Weighted xs -> xs.Length

This allows us now to write a convenience function, pick, which will pick at random based on the type of table / distribution:

let from (rng: Random) (distribution: Distribution<_>) =
    match distribution with
    | Uniform distribution -> uniform rng distribution
    | Weighted distribution -> weighted rng distribution

Picking from more complex tables

We can now pick from simple tables. However, the sample table we started with is a bit more complex than what we can currently handle:

Ability
---
1  bless/curse
2  entangle/trap/ensnare
// omitted entries

How can we approach this? I would read this table as follows: “On a 1, the result is bless or curse”. That is, with equal probability, I should get bless or curse. So what I would like to write is something along these lines:

let ability = [
    Or [ "bless"; "curse" ]
    Or [ "entangle"; "trap"; "ensnare" ]
    ]

The problem, though, is that if we do that, we can’t add a simple string entry to the list anymore. Let’s create a new type, then, wrapping simple entries as a case of a Discriminated Union. For good measure, we will also add the And case, which seems like an obvious extension:

type Entry<'T> =
    | Item of 'T
    | And of list<Entry<'T>>
    | Or of list<Entry<'T>>

We can now write “hybrid” tables, like so:

let ability = [
    Item "some ability"
    Or [ "bless"; "curse" ]
    ]

Due to the recursive nature of our representation, we can also write potentially even more intricate expressions, like this one:

let complexTable = [
    Item "human"
    And [ Or [ Item "human"; Item "goblin" ]; Item "undead" ]
    ]

… where the second entry describes a creature that could be either an undead human, or an undead goblin.

So how do we pick from that type of list now? All we need is an evaluation function like this:

let rec eval (rng: Random) (entry: Entry<'T>) =
    match entry with
    | Item item -> List.singleton item
    | And entries -> entries |> List.collect (eval rng)
    | Or entries -> entries |> Pick.uniform rng |> eval rng

> complexTable |> uniform rng |> eval rng
val it: string list = ["goblin"; "undead"]

Note: I debated creating a type to represent non-empty lists, because the picker will fail for an empty Or case, but that was a bit more work than what I felt like. A simpler fix is to match on the list of entries, and return an empty list in the empty case.

Tables of Tables

There are still some rough edges, but we are getting somewhere! Let’s tackle the next glaring problem with our approach, namely:

Ability (roll 1d12)
---
// omitted entries
8  MAGIC TYPE
// omitted entries

What the MAGIC TYPE entry means is, “when you roll a 8, pick from the table MAGIC TYPE”.

So the ABILITY table needs to know somehow about the MAGIC TYPE table. How do we do that?

One possible direction would be to embed that table directly in our expression, like this:

let ability = [
    Or [ "bless"; "curse" ]
    Or [
        Or [
            Item "divination"
            Item "enchantment"
            ]
        ]
    ]

However, that is starting to look unwieldy. Also, some tables can be called from multiple other tables, so rather than repeating these tables in a giant tree, we will assume that the picking takes place within a context, with named tables that we can re-use.

Let’s rework a bit our code:

type TableRef = | Ref of string

type Entry<'T> =
    | Item of 'T
    | And of list<Entry<'T>>
    | Or of list<Entry<'T>>
    | Table of TableRef

type NamedTable<'T> = {
    Name: string
    Entries: Distribution<Entry<'T>>
    }

type Context<'T> = {
    RNG: Random
    Tables: Map<TableRef, NamedTable<'T>>
    }

Armed with that reorganization, we can rewrite our eval function:

[<RequireQualifiedAccess>]
module Table =

    let eval ctx table =
        let rec eval (ctx: Context<'T>) (entry: Entry<'T>) =
            match entry with
            | Item item -> List.singleton item
            | And entries -> entries |> List.collect (eval ctx)
            | Or entries -> entries |> Pick.uniform ctx.RNG |> eval ctx
            | Table ref -> 
                ctx.Tables.[ref].Entries 
                |> Pick.from ctx.RNG 
                |> eval ctx
            |> List.distinct
        eval ctx (Table (Ref table))

… which we can use to run our example:

let ability = {
    Name = "ability"
    Entries =
        Uniform [
            Or [ Item "bless"; Item "curse"]
            Or [ Item "entangle"; Item "trap"; Item "ensnare" ]
            Table (Ref "magic type")
            // omitted entries
            ]
    }

let magicType = {
    Name = "magic type"
    Entries =
        Uniform [
            Item "divination"
            Item "enchantment"
            // omitted entries
            ]
    }

let ctx = {
    RNG = Random ()
    Tables = [
        ability
        magicType
        ]
        |> List.map (fun t -> Ref t.Name, t)
        |> Map.ofList
    Merge = fun (a, b) -> a + b
    }

> Table.eval ctx "ability";;
val it: string list = ["bless"]
> Table.eval ctx "magic type";;
val it: string list = ["divination"]

Note: there are some glaring issues with the design. First, ctx.Tables.[ref].Entries will crash if the table name does not exist. Then, we could introduce an infinite loop if there is a circular reference between tables. I will assume for now that tables are created without cycles.

Roll Twice

This one is a classic of tables! Let’s add that to our expressions, generalizing the idea:

type Entry<'T> =
    | Item of 'T
    // omitted code
    | Repeat of int * Entry<'T>

We can modify the eval function accordingly:

let rec eval (ctx: Context<'T>) (entry: Entry<'T>) =
    // omitted code
    | Repeat (n, entry) ->
        List.init n (fun _ -> entry |> eval ctx)
        |> List.collect id

Armed with this, we can now represent what we need:

let ability = {
    Name = "ability"
    Entries =
        Uniform [
            Or [ Item "bless"; Item "curse"]
            Or [ Item "entangle"; Item "trap"; Item "ensnare" ]
            Table (Ref "magic type")
            // omitted entries
            Repeat (2, Table (Ref "ability"))
            ]
    }

As a side note, this is why the eval function returns a list<'T>, and not just a 'T: picking from a list can return more than one item. For that matter, it could theoretically produce an infinite list of elements, if we happened to pick the Repeat entry over and over and over again.

As another side note, this also introduces the possibility of infinite loops. As a trivial example, the following table will never finish evaluating:

let ouroboros = { 
    Name = "ouroboros"
    Entries = Flat [ Repeat (2, Table (Ref "ouroboros")) ]
    }

The tricky case of Immunity to Element

Are we done? Almost! Our original sample table has one entry we do not quite handle yet:

Ability (roll 1d12)
---
// omitted entries
10 immunity: ELEMENT
11 read/control minds
12 roll twice on this table

I really struggled with immunity: ELEMENT. What it means is “when you roll a 10, roll on the ELEMENT table, and return immunity to the picked element”, for instance “immunity to Fire”.

What makes this case different is that we are not just picking a list of 'T’s, we are merging the result of the pick with something else. The way I approached this was by introducing a new case in our expressions,

type Entry<'T> =
    | Item of 'T
    // omitted code
    | Merge of (Entry<'T> * Entry<'T>)

In our specific example, the expression would be, for instance:

Merge (Item "immunity", Table (Ref "element"))

In the general case, evaluating the 2 entries will result in 2 lists, which we need to merge. What we want is the cross-product of the 2 evaluations, something along these lines:

| Merge (entry1, entry2) ->
    eval ctx entry1
    |> List.collect (fun value1 ->
        eval ctx entry2
        |> List.map (fun value2 ->
            // merge value1, a 'T and value2, a 'T
            // into a 'T
            merge (value1, value2)
            )
        )

So we need a function to merge 2 values of a given type, into 1 value of the same type, something with a signature along these lines:

('T * 'T) -> 'T

In our specific example, we can easily write such a function, we just need to combine 2 strings into 1, for instance like this:

let merge (txt1: string, txt2: string) = $"{txt1} {txt2}"

The question here is, where should this function live? Who knows how to merge “things”?

My initial train of thought was to make that a property of the “thing” itself, perhaps through an interface, say, IMergeable, perhaps through a Statically Resolved Type Parameter. After a few attempts in that direction, I backtracked. The code was getting unwieldy, and it felt a bit off. In the end, how you merge strings (for instance) is not a property of the string, it is context dependent.

What I landed on is making that function part of the Context:

type Context<'T> = {
    RNG: Random
    Tables: Map<TableRef, NamedTable<'T>>
    Merge: 'T * 'T -> 'T
    }

We can plug that right into our eval function:

| Merge (entry1, entry2) ->
    eval ctx entry1
    |> List.collect (fun value1 ->
        eval ctx entry2
        |> List.map (fun value2 ->
            ctx.Merge (value1, value2)
            )
        )

On the upside, it works. At the same time, something bugs me about this solution. Perhaps it is just a personal hang-up about making functions part of a Record, perhaps there is something more to it. In the back of my mind, I imagine somewhere there is a Category Theorist with a hint of a smile, thinking “what the poor man needs is a bifunctor coequalizer” (or something equally awesome sounding). I know next to nothing about the topic, but if you have thoughts on how to make this better (with or without Category Theory!), I am all ears :)

Parting words

First, I hope that you got something out of this meandering exploration of modeling random tables! As usual, what started out as a “surely, this will be a small weekend project” ended up being both more complex, and more interesting than what I anticipated.

If you are interested in the code, you can find the current state of affairs on GitHub. I plan to keep going at a leisurely pace, and at the moment I am interested in the following questions:

Incorporate dice rolls in Expressions, to support things like “roll 1d6 times on the treasure table”,
Compose complex entities from Tables, for instance, generating random monsters,
Render results in a web page using a generic template with Fable,
Potentially write parsers for tables,
Potentially explore conditional probabilities (change the distribution on a Table based on earlier rolls).

That’s what I have for today’s installment! In the meanwhile, may 2022 bring a lot of happy coding, and ping me on Twitter or leave a comment if you have thoughts or questions!

Playing Audio with an F# Discord bot

2021-12-05T00:00:00+00:00

This post is a follow up to that one. As mentioned earlier, my overarching goal is to build a Discord bot to help play “atmosphere” soundtracks during D&D games. Last time, we went over creating a simple Discord bot in F# to support basic text commands. This time, we’ll add sound.

How it works overall

Our application builds on what we did last time. We will use DSharpPlus to create a console application that exposes commands we can trigger from a Discord server. The part we need to add is a way to stream sound to Discord. To do that, we will use Lavalink, a java program that supports searching and streaming audio sources. The NuGet package DSharpPlus.Lavalink handles integration with Lavalink already, so most of the work is done for us already, all we have to do is bolt the parts together. Rather than repeating the DSharpPlus docs, I will highlight the parts where I had some issues.

To run the complete solution locally, you will need to:

Run Lavalink on your machine,
Run BardicInspiration on your machine: it will connect to Lavalink, and respond to Discord commands, searching audio tracks via Lavalink and streaming them to your Discord server.

Connecting to Lavalink

That part is fairly straightforward. We add the package DSharpPlus.Lavalink to our project, and made the following changes in Program.fs: add 2 new references:

open DSharpPlus.Net
open DSharpPlus.Lavalink

… and, after we connect our client to Discord, connect to our local Lavalink server:

printfn "Connecting to Discord"
discord.ConnectAsync()
|> Async.AwaitTask
|> Async.RunSynchronously

printfn "Connecting to Lavalink"
let hostname = "127.0.0.1"
let port = 2333
let password = "youshallnotpass"

let lavalinkEndpoint = ConnectionEndpoint(hostname, port)
let lavalinkConfig = LavalinkConfiguration ()
lavalinkConfig.Password <- password
lavalinkConfig.RestEndpoint <- lavalinkEndpoint
lavalinkConfig.SocketEndpoint <- lavalinkEndpoint

let lavalink = discord.UseLavalink()

let lavalinkConnection =
    lavalink.ConnectAsync lavalinkConfig
    |> Async.AwaitTask
    |> Async.RunSynchronously

The hostname, port and password should match the values you used in the application.yml file that configures your Lavalink server instance.

In the final code version, I extracted all that in the AppSettings.json file, like this:

{
    "Token":"your discord token",
    "Lavalink": {
        "Hostname": "127.0.0.1",
        "Port": 2333,
        "Password": "youshallnotpass"
    }
}

Searching for Audio and Streaming to a Voice Channel

That part is also fairly straightforward. For our bot to stream audio, it needs to join a voice channel on our server. We’ll add a command to DiscordBot.fs, /join, that does just that:

[<Command "join">]
[<Description "Join the General voice channel">]
member this.Join (ctx: CommandContext) =
    unitTask {
        // find General voice channel
        let channelID, channel =
            ctx.Guild.Channels
            |> Seq.find (fun kv ->
                kv.Value.Type = ChannelType.Voice
                &&
                kv.Value.Name.ToLowerInvariant () = "general"
                )
            |> fun kv -> kv.Key, kv.Value
        let lavalink = ctx.Client.GetLavalink ()
        let node = lavalink.ConnectedNodes.Values |> Seq.head
        let! connection = node.ConnectAsync(channel)
        return ()
        }

From the current CommandContext, we go through the existing Channels for the Guild (the server where the command originated from), and grab the first one that is a Voice channel, and named General, and we establish a Lavalink connection. I ran into weird issues there. By default, a Discord server has a Voice Channel named General, but for some reason, I never managed to find a channel with such a name. Using general instead appears to work. Why? No idea.

Note: you will also need to give your bot permission to use audio, and not just messages. See the OAuth2 URL Generator section in our previous post.

At that point, typing /join in your server will add Bardic Inspiration to the General Voice Channel. Let’s add a command to play some music next:

[<Command "play">]
[<Description "Search and play the requested track">]
member this.Play (ctx: CommandContext, [<RemainingText>] search: string) =
    unitTask {
        let lavalink = ctx.Client.GetLavalink ()
        let node =
            lavalink.ConnectedNodes
            |> Seq.find (fun node ->
                node.Value.ConnectedGuilds.ContainsKey(ctx.Guild.Id)
                )
            |> fun kv -> kv.Value
        let connection = node.GetGuildConnection(ctx.Guild)
        let! loadResult = node.Rest.GetTracksAsync(search)
        let track = loadResult.Tracks |> Seq.head
        do! connection.PlayAsync(track)
        }

The search argument is a search string for what you want to play. Lavalink works against a variety of sources, which you can configure in application.yml (YouTube, SoundCloud, …). The command is now be ready to go, like so: /play https://youtu.be/dQw4w9WgXcQ.

Looping tracks

At that point, we have the basics in place. However, this isn’t exactly what I need. When I am on Game Master duty for a Role Playing game, what I typically want is to start an atmosphere audio track (crowded inn, ominous dungeon, epic battle music…), and keep that on repeat until the adventure moves to a different atmosphere.

The change I want is along these lines: /play track1 should start track1, and keep playing it every time the track finishes, unless I type /play track2, which should stop track1 and start looping track2.

Getting that to work took a bit of effort. The good news is, DSharpPlus.Lavalink exposes events like PlaybackFinished, which triggers when a track finishes, and the EventArgs carry an enum describing the reason, TrackEndReason (the track finished because it played to the end, because another track was started, because it was stopped…).

This is exactly what we need: we want to subscribe to that event, and:

If the track Finished uninterrupted, play it again,
Otherwise do nothing.

The less good news is, the event itself is not standard. As I naively tried to add a handler to connection.PlaybackFinished, I was greeted with an interesting error:

The event 'PlaybackFinished' has a non-standard type. If this event is declared in another CLI language, you may need to access this event using the explicit add_PlaybackFinished and remove_PlaybackFinished methods for the event. If this event is declared in F#, make the type of the event an instantiation of either 'IDelegateEvent<_>' or 'IEvent<_,_>'.

OK then. Let’s try to get that to work, and use add_PlaybackFinished. What does that one expect? Let’s check its signature:

member add_PlaybackFinished:
   value: AsyncEventHandler<LavalinkGuildConnection,TrackFinishEventArgs>
       -> unit

One step closer, the only unclear piece is AsyncEventHandler. Where is that coming from and what does it want? After some more digging, AsyncEventHandler appears to be defined in Emzi0767.Utilities, and is defined as:

type AsyncEventHandler<'TSender,'TArgs (requires :> AsyncEventArgs)> =
   delegate of
      sender: 'TSender *
      e     : 'TArgs (requires :> AsyncEventArgs )
           -> Task

Let’s implement a handler that matches the signature:

member this.OnTrackFinished =
    AsyncEventHandler<LavalinkGuildConnection, EventArgs.TrackFinishEventArgs>(
        fun (conn: LavalinkGuildConnection) (args: EventArgs.TrackFinishEventArgs) ->
            unitTask {
                printfn $"Finished track {args.Track.Title} ({args.Reason})."
                match args.Reason with
                | EventArgs.TrackEndReason.Finished ->
                    printfn $"Looping: restarting track {args.Track.Title}."
                    do! args.Player.PlayAsync(args.Track)
                | _ -> ignore ()
                }
        )

And we can now refine our /play command like this:

[<Command "join">]
[<Description "Join the General voice channel">]
member this.Join (ctx: CommandContext) =
    unitTask {
        // find General voice channel
        let channelID, channel =
            ctx.Guild.Channels
            |> Seq.find (fun kv ->
                kv.Value.Type = ChannelType.Voice
                &&
                kv.Value.Name.ToLowerInvariant () = "general"
                )
            |> fun kv -> kv.Key, kv.Value

        let lavalink = ctx.Client.GetLavalink ()
        let node = lavalink.ConnectedNodes.Values |> Seq.head

        let! connection = node.ConnectAsync(channel)

        connection.add_PlaybackFinished(this.OnTrackFinished)
        connection.add_PlaybackStarted(this.OnTrackStarted)
        }

… and we are done. Is this pretty? No. Is there a way to do this more cleanly? Probably. Do I care? Not really - it works, let’s move on :)

Conclusion

That’s where we will stop for today. I added a few commands to the bot (stop, pause, and resume the current track, and leave the server), which follow the same patterns. I am sure some details could be cleaned up, but this is good enough for my purposes: I have a Discord bot that I can run on my machine to switch between audio loops during D&D games.

Completed code on GitHub

If you need a replacement for the Groovy bot (which is why I got started with this project in the first place), building and running the code locally with your own token should be relatively straightforward. Got questions or comments? ping me on twitter, and in the meanwhile… happy coding!

Create a basic Discord bot in F#

2021-10-30T00:00:00+00:00

I have been using Discord a lot lately, mainly because I needed a space to meet for role-playing games remotely during the Black Plague. One nice perk of Discord is its support for bots. In particular, I used a bot called Groovy, which allowed streaming music from various sources like YouTube during games, and was great to set the tone for epic moments in a campaign. Unfortunately, Groovy wasn’t complying with the YouTube terms of service, and fell to the ban hammer. No more epic music for my epic D&D encounters :(

As the proverb goes, “necessity is the mother of invention”. If there is no bot I can readily use, how difficult could it be to create my own replacement, in F#?

In this post, I will go over the basics of creating a Discord bot in F#, using the DSharpPlus library. Later on, I will follow up with a post focusing on streaming music.

The bot we will write here will be pretty basic: we will add a fancier version of hello world, with a command inspire that we can trigger from Discord:

/inspire @bruenor

.. which will cast Bardic Inspiration on @bruenor, a user on our server, responding with a message

Bardic Inspiration! @bruenor, add 3 (1d6) to your next ability check, attack, or saving throw.

Prerequisites / Setup

For us to use a bot in Discord, we will need 2 things:

a Discord server where you have enough admin privileges to add the bot (you can create your own server for free),
an App registered in Discord (our bot), so we can get a token to connect our code to Discord, and a link to add the bot to our server.

To create the app, go to the Discord developers page, where you can create an Application. Once that application is created, go to the Bot section. In there you will find a link to a Token, which will be used to authenticate our code later on.

To add your bot to a server, in the Discord developers page, go to the OAuth2 section, and go to the OAuth2 URL Generator section. In the section labeled Scopes, select bot. You should see a url like this one appear:

https://discord.com/api/oauth2/authorize?client_id=YOUR_APP_CLIENT_ID&permissions=0&scope=bot

Note the argument permissions=0. To give your bot permission to perform some actions, select below the bot permissions you want, in our case, Sent Messages, which will convert the url to

https://discord.com/api/oauth2/authorize?client_id=YOUR_APP_CLIENT_ID&permissions=2048&scope=bot

Once that is done, copy that url in your browser, which will ask you to select the server(s) where you would like this bot to be added.

At that point, we are set: we have all the hooks we need, all that is missing is code for our bot to do something.

Setting up our Bot

Our bot will be a basic console app. Let’s get that wired up. In VS Code, we’ll create that console app:

dotnet new console --language F# --name BardicInspiration

To avoid hard-coding our bot token in code, let’s put it in an AppSettings.json file, adding the nuget packages Microsoft.Extensions.Hosting, Microsoft.Extensions.Configuration and Microsoft.Extensions.Configuration.Json to our project, and making sure that AppSettings.json is copied during build and publish in the BardicInspiration.fsproj file.

Code: Initial console app setup

Now that we have a token, let’s connect to Discord, using DSharpPlus. We’ll add 2 more packages, DSharpPlus and DSharpPlus.CommandsNext, and modify our program to create a Discord client, using our bot token:

[<EntryPoint>]
let main argv =
    printfn "Starting"

    let token = appConfig.["Token"]
    let config = DiscordConfiguration ()
    config.Token <- token
    config.TokenType <- TokenType.Bot

    let client = new DiscordClient(config)

    1

Code: Creating a Discord client

Wiring up our first Command

We are now ready to add a command. Commands in DSharpPlus use the DSharpPlus.CommandsNext package, and must be hosted in a class that inherits from BaseCommandModule. Let’s create a separate file for our bot commands, DiscordBot.fs, and create our bot:

open DSharpPlus.CommandsNext

type BardBot () =

    inherit BaseCommandModule ()

Let’s add our first command. Commands are methods or functions, decorated with attributes. Following along the C# docs for DSharpPlus, translating into F#, I got my first command working:

[<Command>]
let inspiration (ctx: CommandContext) =
    async {
        do!
            ctx.TriggerTypingAsync()
            |> Async.AwaitTask

        let rng = Random ()
        let emoji =
            DiscordEmoji.FromName(ctx.Client, ":game_die:").ToString()

        do!
            rng.Next(1, 7)
            |> sprintf "%s Bardic Inspiration! Add %i to your next ability check, attack, or saving throw." emoji
            |> ctx.RespondAsync
            |> Async.AwaitTask
            |> Async.Ignore
        }
    |> Async.StartAsTask
    :> Task

We’ll revisit that later, to see if we can make things a bit simpler. At a high level, a command is decorated with the [<Command>] attribute, takes in a CommandContext, which provides contextual information (which server or channel is it coming from, which user sent the command…) and possibly arguments, and returns a Task.

Now that our inspiration command is ready, let’s bolt that to our bot, in Program.fs:

let client = new DiscordClient(config)

let commandsConfig = CommandsNextConfiguration ()
commandsConfig.StringPrefixes <- ["/"]

let commands = client.UseCommandsNext(commandsConfig)
commands.RegisterCommands<BardBot>()

client.ConnectAsync()
|> Async.AwaitTask
|> Async.RunSynchronously

Task.Delay(-1)
|> Async.AwaitTask
|> Async.RunSynchronously

We set the prefix of commands to /, so we can invoke them like /inspiration, and register our BardBot with the client - and we start the whole thing up, connecting our client to Discord.

Code: First Command

At that point, if you build and run the program, and added the bot to your server, it should work:

Puttings some bells and whistles on that Command

At that point, we have a working Command, which is great. However, we also have some small issues.

First, while using a function works perfectly fine, it will prevent us from using command overloads, if that is something we wanted to support. So I rewrote the command, making a few changes:

[<Command "inspire">]
[<Description "Cast bardic inspiration">]
member this.Inspiration (ctx: CommandContext) =

With that change, we could now support an alternate version, where we can cast Bardic Inspiration on a specific user, like this:

[<Command "inspire">]
[<Description "Cast bardic inspiration on someone!">]
member this.Inspiration (ctx: CommandContext, [<Description "Who do you want to inspire?">] user: DiscordMember) =

I added a few more attributes, which illustrate some interesting points:

[<Command "inspire">] explicitly defines how the command will be named in Discord, instead of relying on the function or method name,
[<Description "Cast bardic inspiration on someone!">] provides help in Discord about the command itself,
[<Description "Who do you want to inspire?">] provides help around the argument user.

… which can then be used in Discord like so:

Note also in the method signature how user is a DiscordMember. DSharpPlus will use that information to try and parse the command argument directly into a user for us.

From Async to Task

The other small issue is the friction between async and Task. F# 6 includes native support for task, which would be perfect here, but at the time of writing, .NET 6 is still in release candidate, so I decided to use Ply instead for now. After adding the Ply package, we can now rewrite our method like so:

[<Command "inspire">]
[<Description "Cast bardic inspiration on someone!">]
member this.Inspiration (ctx: CommandContext, [<Description "Who do you want to inspire?">] user: DiscordMember) =
    unitTask {
        do!
            ctx.TriggerTypingAsync()

        let emoji = DiscordEmoji.FromName(ctx.Client, ":drum:").Name
        let roll = Random().Next(1, 7)
        let userName = user.Mention

        let! _ =
            sprintf "%s Bardic Inspiration! %s, add %i (1d6) to your next ability check, attack, or saving throw." emoji userName roll
            |> ctx.RespondAsync

        return ()
        }

And we are done! We have a fully functioning Discord Bot, with a command:

Code: Final State of Affairs

Conclusion

Well, that’s it for today! If you are interested in writing Discord bots, hope this blog post helps you get started on the right foot. In the next installment, I plan on going over how to add music streaming to that bot. In the meanwhile, ping me on twitter if you have have questions or comments, and… happy coding!

Graph Layout with Spring Embedders in F#

2021-04-05T00:00:00+00:00

I have been obsessing over the problem of graphs layouts lately. To provide a bit of context, the starting point for that obsession was role-playing games. When running an adventure, you often need to quickly find various pieces of information, and how they are connected, for instance “Who is the leader of the Lampblacks”, or “What are notable locations in the Six Towers district”. This type of information clearly forms a graph. It would be nice to be able to navigate that information quickly, to figure out how various entities are connected.

This is how I got interested in building up a knowledge base for a game I am running (the wonderful Blades in the Dark), and displaying the information as a graph.

Before diving into the code, as a teaser, here is how the result looks like at the moment:

Or you can try it live here.

I can search for entries, select them, and as I do, the relationships between them is added to the graph, automatically highlighting existing connections.

Graph Layout with Spring Embedders

The part I found interesting was the automatic graph layout. The goal here is to take a graph, a set of nodes (or vertices) which may or may not have edges connecting them, and display them in a manner that is hopefully informative and pleasing to the eye.

As it turns out, this is not an entirely trivial problem.

What we want is a representation where:

entities that are connected appear close to each other,
nodes are nicely spread out.

A classic technique to solve this problem is called spring embedders. If you want a great and fairly accessible overview of the topic, I recommend reading “Spring Embedders and Force Directed Graph Drawing Algorithms”, by Stephen G. Kobourov. In a nutshell, the idea is to add physical forces such as springs between connected nodes, to represent the tensions that exist in the network, and let them play out until the system reaches some equilibrium.

The chart below, taken from the same article mentioned above, illustrates the idea. We place the nodes randomly on the chart, and add springs between the nodes that are connected. Springs will pull together nodes that are too far apart, and push away nodes that are too close to each other. If we let the springs progressively adjust, we should end up with a balanced layout like this one:

The algorithm I ended up using is the second one in the article, the Fruchterman-Reingold algorithm, with a slight modification (more on this later). In this version, instead of springs, the 2 forces at play in the graph are:

a repulsion force, which pushes every pair of nodes away from each other, and gets weaker as nodes get further apart from each other,
an attraction force between connected nodes, similar to an elastic band, pulling them towards each other.

I implemented the SPRING algorithm as well (the first one presented in the article), but I got better results with Fruchterman-Reingold, which I will focus on here. You can find the full implementation in the Calder repository.

Implementation: Forces

At the heart of the algorithm, we have nodes that are located in a certain position, and forces that apply to them, pushing or pulling them into a direction. Let’s start by modelling that.

We can represent a position by coordinates X and Y, like this:

type Point = {
    X: float
    Y: float
    }

Similarly, we can represent a direction by the differences in the X and Y positions, DX and DY, like this:

type Direction = {
    DX: float
    DY: float
    }

In our model, a node at some Point will be subjected to multiple forces, each described by a Direction. We would like to be able to easily add them together, and perhaps perform some operations like multiplying a Direction by a number. Let’s expand a bit our Direction type to do that:

type Direction = {
    DX: float
    DY: float
    }
    with
    static member (*) (scalar: float, direction: Direction) =
        {
            DX = scalar * direction.DX
            DY = scalar * direction.DY
        }
    static member (+) (dir1: Direction, dir2: Direction) =
        {
            DX = dir1.DX + dir2.DX
            DY = dir1.DY + dir2.DY
        }
    static member Zero = { DX = 0.0; DY = 0.0 }
    member this.Length =
        pown this.DX 2 + pown this.DY 2
        |> sqrt

Thanks to the infix operators, we can now do things like this:

let dir1 = { DX = 0.0; DY = 1.0 }
let dir2 = { DX = 1.0; DY = -2.0 }
let total = dir1 + 2.0 * dir2
total.Length // float = 3.605551275

We added the Zero property, so we can safely do things like summing up list of directions, and gracefully handle the case of an empty list.

In a similar fashion, we can expand Point a little like this:

type Point = {
    X: float
    Y: float
    }
    with
    static member (+) (pt: Point, direction: Direction) =
        { X = pt.X + direction.DX; Y = pt.Y + direction.DY }
    static member (-) (pt1: Point, pt2: Point) =
        { DX = pt2.X - pt1.X; DY = pt2.Y - pt1.Y }

What does this buy us? First, we can now add a Direction to a Point, and get the position of the resulting Point. Then, we can substract 2 points, giving us the direction between them.

With this out of the way, we can now starting to play with forces. I ended up representing a Force as an interface, with a single method, applyFrom:

type Force =
    abstract member applyFrom: origin: Point -> target: Point -> Direction

The idea here is that I want to apply a force to a Point, the target, from a particular origin, another Point. The result should be a Direction, describing where that force pushes or pulls, and how strongly (the length of the direction).

Let’s apply this to the Fruchterman-Reingold algorithm. Two nodes that are connected attract each other, by a force fa(d) = d^2, proportional to the square of their distance d. That is easy enough to implement, using object expressions:

let attraction = {
    new Force with
        member this.applyFrom origin target =
            let direction = target - origin
            let length = direction.Length
            let strength = (pown length 2)
            strength * direction
    }

Let’s illustrate on a simple example, where p1 and p2 are two connected nodes:

let p1 = { X = 0.0; Y = 0.0 }
let p2 = { X = 1.0; Y = 2.0 }

p1 |> attraction.applyFrom p2

… which gives us:

val it : Direction = { DX = 5.0; DY = 10.0 }

Similarly, from p2:

p2 |> attraction.applyFrom p1

… we get

val it : Direction = { DX = -5.0; DY = -10.0 }

In other words, p1 and p2 exert opposite but equal forces on each other, pulling the nodes towards each other. The repulsion force is quite similar, so we won’t go into further details. You can find the corresponding code in the Auto.fs file.

Implementation: Graph and Layout

Now that we have a model for the physics of forces, we need a graph to apply them to. I ended up separating things into 3 parts:

a Graph is simply a collection of nodes and edges,
a ForceGraph is a graph where each node and edges has forces attached,
a Layout is the current position of every node of a Graph.

The Graph type is pretty straightforward, it is a set of nodes (of generic type 'Node), and edges:

type Graph<'Node when 'Node: comparison> = {
    Nodes: Set<'Node>
    Edges: Set<Edge<'Node>>
    }
    with
    static member empty<'Node> () =
        { Nodes = Set.empty<'Node>; Edges = Set.empty<Edge<'Node>> }
    static member addNode (node: 'Node) (graph: Graph<'Node>) =
        { graph with Nodes = graph.Nodes |> Set.add node }
    static member addEdge (node1: 'Node, node2: 'Node) (graph: Graph<'Node>) =
        let edge = Edge.create(node1, node2)
        { graph with Edges = graph.Edges |> Set.add edge }

I went back and forth with Edges, and landed on this:

type Edge<'Node when 'Node: comparison> =
    private | Edge of 'Node * 'Node
    with
    static member create (node1: 'Node, node2: 'Node) =
        if node1 < node2
        then Edge (node1, node2)
        else Edge (node2, node1)
    member this.Node1 = match this with | Edge (node1, _) -> node1
    member this.Node2 = match this with | Edge (_, node2) -> node2

The issue I was trying to avoid here is that an edge between Node1 and Node2 is the same as the edge between Node2 and Node1 (we assume an undirected graph here). Representing an Edge as, for instance, a record with 2 nodes would force us to check both possible positions of the nodes to see if 2 edges are equal. Here, we hide the internals of the Edge, and guarantee that 2 nodes will always be stored in the same position: the only way to instantiate an edge is by calling the factory method create, where we ensure they are ordered consistently:

let edge1 = Edge.create (1, 2)
let edge2 = Edge.create (2, 1)
edge1 = edge2 // true

The ForceGraph type is simply an extension of this, reorganizing the information so we can quickly retrieve all the forces that apply on a particular node:

type ForceGraph<'Node when 'Node: comparison> = {
    Nodes: Map<'Node, Force>
    Edges: Map<'Node, Map<'Node, Force>>
    }

Each node has a force attached (presumably a repulsion force). Edges are re-organized in terms of nodes: we store the force exerted by an edge as 2 separate forces, representing the force a node receives from the other end of the edge.

And that’s pretty much it. With that in hand, we can now define a Layout like this:

type Layout<'Node when 'Node: comparison> =
    {
        Nodes: Map<'Node, Point>
    }

… and compute, for a particular Layout, what force applies to a node:

let nodeForce (graph: ForceGraph<_>) layout node =

    let position = layout.Nodes.[node]

    let nodesRepulsion =
        graph.Nodes
        |> Seq.sumBy (fun kv ->
            let force =
                if kv.Key = node
                then Neutral
                else
                    kv.Value
            position
            |> force.applyFrom (layout.Nodes.[kv.Key])
            )

    let edgesAttraction =
        graph.Edges
        |> Map.find node
        |> Seq.sumBy (fun kv ->
            let force = kv.Value
            let origin = layout.Nodes.[kv.Key]
            position
            |> force.applyFrom origin
            )

    nodesRepulsion + edgesAttraction

We compute the attraction exerted by every node in the graph, sum these all together, and do the same for every edge, and… we are done. Given a specific Graph and Layout, we can compute what force applies to each node, and update their position, following one of the algorithms described in the paper.

In its simplest form, you can use Calder like this:

// create the graph
Graph.empty ()
|> Graph.addNode 1
|> Graph.addNode 2
|> Graph.addNode 3
|> Graph.addNode 4
|> Graph.addEdge (1, 2)
|> Graph.addEdge (1, 3)
|> Graph.addEdge (1, 4)
|> Graph.addEdge (2, 3)
// and solve it using defaults
|> Auto.solve

… which will create the following layout:

Parting Thoughts

I’ll leave it at that for today, with two parting comments.

First, if you look at the implementation of ForceGraph, you will see that it is slightly different from what I presented above, with an additional field, Center:

type ForceGraph<'Node when 'Node: comparison> = {
    Nodes: Map<'Node, Force>
    Edges: Map<'Node, Map<'Node, Force>>
    Center: Option<Force>
    }

What is that about? The short version of it is, I realized at some point that the Fruchterman-Reingold layout algorithm was producing pretty bad results when the graph was disjoint (that is, some sub-graphs had no connections to others). It makes total sense given the algorithm: a node without any connection will be pushed away without any attraction force keeping it close to the rest. To address that issue, I ended up adding an (optional) central force, which pulls all nodes towards the center of gravity of the layout.

The second comment is that I keep being impressed by Fable. I am very incompetent in all things web related, and was expecting my code to perhaps cause issues when used in a Fable Elmish app. Turns out, everything worked just as advertised. My F# code compiled without complaints, and… I was surprised at how fast everything ran.

Anyways, that’s it for today, hope you found something of interest in this post! The whole code is on github in case you are curious, and… let me know if you have questions or comments, and stay safe out there!

Santa's Mailbox

2019-12-04T00:00:00+00:00

This post is part of the F# Advent Calendar 2019. Check out other posts in this series, under the #fsadvent hashtag, and… happy holidays everybody :)

It is that time of the year again for Santa, Inc. - a time of celebration for most, but for Mister Claus, a time of intense and stressful activity. Every year, keeping up with all these letters coming from kids everywhere, and assigning them to the Elves crew, is a problem. Mister Claus is a diligent CEO, and keeps up with current trends in technology. Perhaps this F# thing he keeps hearing about might help him handle all these letters?

Setting up the Problem

Instead of cute handwritten kids letters, we will take a much less cute, but conceptually similar problem. Imagine that, at regular intervals, we receive a batch of work items (the letters), which we need to process. We will represent each item as a Job, storing its batch number and number within the batch, and a Value, representing the job that needs doing:

type Job = { 
    Batch: int
    Number: int
    Value: int 
    }

What is the Value for? We want something that keeps the ~~Elves~~ CPUs busy. Not being particularly imaginative today, we will just take that number, and factorize it into its prime factors:

let factorize x = 
    let rec factors acc fact rest = 
        if fact > rest
        then acc
        else 
            if rest % fact = 0
            then factors (fact :: acc) fact (rest / fact)
            else factors acc (fact + 1) rest
    factors [ 1 ] 2 x

We can test that out:

> factorize 60;;
val it : int list = [5; 3; 2; 2; 1]

And indeed, 60 is equal to 1 * 2 * 2 * 3 * 5. Good. Now, all we need is a number that takes some time to factorize, so we have a nice, CPU bound task, as a proxy for our Elves doing busy work responding to the letters. With a bit of fiddling around, we ended up with 2130093701, a large prime which takes about 5.5 seconds to factorize on Santa’s machine:

> #time "on";;
> factorize 2130093701;;

Real: 00:00:05.695, CPU: 00:00:05.703, GC gen0: 0, gen1: 0, gen2: 0
val it : int list = [2130093701; 1]

We can now simulate a busy December for Santa, Inc, with a producer that will create new batches at regular intervals, each batch containing a random number of identical tasks:

module Producer =

    type Config = {
        MaxBatch: int
        Interval: int
        }

    let start (config: Config) = 
        let rng = Random 0
        let rec loop batch =
            async {
                let batchSize = rng.Next(0, config.MaxBatch + 1)
                printfn "New jobs arriving: batch %i, %i" batch batchSize
                let jobs = 
                    Array.init batchSize 
                        (fun i -> 
                            { 
                                Batch = batch
                                Number = i
                                Value = 2130093701
                            }
                            )
                do! Async.Sleep (config.Interval * 1000)
                return! loop (batch + 1)
            }
        loop 0 |> Async.Start

We can now configure our producer, so that every 5 seconds, we have a new batch of 0 to 10 jobs coming in:

let config : Producer.Config = { 
    Interval = 5
    MaxBatch = 10 
    }

config |> Producer.start

… which will result in something like this:

New jobs arriving: 7
New jobs arriving: 8
New jobs arriving: 8

This was a lot of setup! But, what is the problem we want to solve here, exactly?

The problem is the following: in our particular example, every 5 seconds, we are getting somewhere between 0 and 10 work items, each taking about 5 seconds to solve. Clearly, if only one ~~Elf~~ CPU is handling this, we won’t be able to keep up. The poor children! What can Mister Claus do here to make sure they get a response back before Christmas is over?

Bad Mailbox: A Sad Christmas Story

Mister Claus is no fool, and realizes that, with an average of 5 tasks arriving every 5 seconds, each batch will take nearly half a minute to process. That’s no task for a single ~~Elf~~ CPU, he needs to put many of them to work.

To avoid blocking new letters arriving every 5 seconds, we will post them into a MailboxProcessor. And, because we are lazy (not the computer sciency type), we will try to process them using Array.Parallel:

let processJob (job: Job) = 
    let task = new Task(fun _ ->        
        printfn "Started batch %i job %i" job.Batch job.Number
        let timer = Stopwatch ()
        timer.Start ()
        let _ = factorize job.Value
        let elapsed = timer.ElapsedMilliseconds / 1000L
        printfn "Completed batch %i job %i in %i secs)" job.Batch job.Number elapsed
        )
    task.Start()

module Parallel = 

    let mailbox = MailboxProcessor<Job[]>.Start(fun inbox ->
        let rec loop () = 
            async {
                let! jobs = inbox.Receive ()
                jobs |> Array.Parallel.iter (processJob)
                return! loop ()
            }
        loop () 
        )

All we need to do then is hook that up in our producer, so that every time we have jobs, they get sent to the mailbox. Let’s do it, and add Parallel.mailbox.Post jobs inside our loop:

module Producer =

    // same as before

    let start (config: Config) = 
        let rng = Random 0
        let rec loop batch =
            async {
                let batchSize = rng.Next(0, config.MaxBatch + 1)
                printfn "New jobs arriving: batch %i, %i" batch batchSize
                let jobs = 
                    Array.init batchSize 
                        (fun i -> 
                            { 
                                Batch = batch
                                Number = i
                                Value = 2130093701
                            }
                            )
                Parallel.mailbox.Post jobs
                do! Async.Sleep (config.Interval * 1000)
                return! loop (batch + 1)
            }
        loop 0 |> Async.Start

Santa is optimistic - he deploys the code in production Friday night, and starts running his mailbox, with 4 busy CPUs at work. Everything looks good, tasks are completed in about 5 seconds each:

Started batch 0 job 6
Started batch 0 job Started batch 0 job 0
Started batch 1
0 job 3
Started batch 0 job 2
Completed batch 0 job 1 in 5Completed batch 0 job 0 in 5 secs)
 secs)
New jobs arriving: batch 1, 8
Started batch 0 job 4
Started batch 1 job 7
Completed batch 0Completed batch 0 job 6 in 5 secs)
 job 3 in 5 secs)
...

Alas! On Monday, as he comes back from a merry weekend, he finds Elves running all over the place. Soon, as he looks over the logs, his happy “Ho! Ho! Ho!” becomes muffled; and Mister Claus start to grumble, and then curse loudly:

New jobs arriving: batch 96Completed batch , 92Completed batch 9Completed batch Completed batch Completed batch  job 92
92 job 1 in 22 secs)
Completed batch 92 job Completed batch 93 job 1 in 22 secs)
Started batch 96 job 1
93 job 93 job  job Started batch Started batch 3Started batch Started batch Started batch 9640 in 4 in 96 job  in 22Completed batch 93Completed batch 9296Started batch 96 in 0 in 96 job Completed batch 8
 secs)

22 seconds to handle a 5-seconds Job! This does not look good. And look at this log - what a sorry mess. Santa is not happy, and goes back to the drawing board.

Throttling the Mailbox

Mister Claus goes into his office, and, as he tries to figure out what is happening, he finds it really hard to follow what is going on in the logs, with all these Elves trying to write down what they are doing at the same time. So he starts by creating a small log using another MailboxProcessor:

module Log = 

    let logger = MailboxProcessor<string>.Start(fun inbox ->        
        let rec loop () = 
            async {
                let! msg = inbox.Receive ()
                printfn "%s" msg
                return! loop ()
            }
        loop () 
        )

    let log msg = 
        sprintf "%A|%s" (DateTime.Now) msg
        |> logger.Post

After some more thinking, Mister Claus realizes that maybe it is not such a hot idea to start so many parallel maps before the previous batches have been completed. Perhaps some throttling would help? He fires VS Code and Ionide, and rewrites that mailbox:

module Queued = 

    type Message = 
        | Batch of Job []
        | Completed of Job

    let processJob (inbox: MailboxProcessor<Message>) (job: Job) = 
        let task = new Task(fun _ ->                    
            sprintf "Started batch %i job %i" job.Batch job.Number 
            |> Log.log
            let timer = Stopwatch ()
            timer.Start ()
            let _ = factorize job.Value
            let elapsed = timer.ElapsedMilliseconds / 1000L
            sprintf "Completed batch %i job %i in %i secs" job.Batch job.Number elapsed 
            |> Log.log
            Completed job |> inbox.Post
            )
        task.Start()

    let mailbox = MailboxProcessor<Message>.Start(fun inbox ->
        
        let parallelism = 4
        let mutable inFlight = 0
        let queue = Queue<Job> ()

        let rec loop () = 
            async {
                let! msg = inbox.Receive ()
                match msg with 
                | Batch jobs ->
                    jobs |> Array.iter (queue.Enqueue)
                | Completed job -> 
                    inFlight <- inFlight - 1

                let rec dequeue () = 
                    if (inFlight < parallelism && queue.Count > 0)
                    then
                        let job = queue.Dequeue ()
                        inFlight <- inFlight + 1
                        processJob inbox job
                        dequeue ()

                dequeue ()
                sprintf "Queue: %i, In Flight: %i" queue.Count inFlight
                |> Log.log
                return! loop ()
            }
        loop () 
        )

The mailbox will now run only 4 tasks at the same time at most. When a new Batch of jobs arrives, they go into a queue. If less that 4 jobs are currently running, jobs are dequeued and processed, increasing the count of jobs “in flight”. When the job is Completed, a message is sent back to the mailbox, decreasing the count of jobs currently in flight, and signaling that new jobs can be started.

Mister Claus deploys his updated code, and anxiously looks at the logs:

12/2/2019 3:49:31 PM|Started batch 22 job 9
12/2/2019 3:49:36 PM|New jobs arriving: batch 40, 5 jobs
12/2/2019 3:49:37 PM|Completed batch 22 job 6 in 5 secs
12/2/2019 3:49:37 PM|Queue: 91, In Flight: 4
12/2/2019 3:49:37 PM|Queue: 90, In Flight: 4
12/2/2019 3:49:37 PM|Started batch 24 job 0
12/2/2019 3:49:37 PM|Completed batch 22 job 7 in 5 secs
12/2/2019 3:49:37 PM|Queue: 89, In Flight: 4

What a beautifully formatted log! This pleases Mister Claus greatly. Tasks now get completed at a steady pace, taking 5 seconds each. Unfortunately, this also highlights a serious issue: the queue is building up over time. As batch 40 arrives, the Elves are still busy working on batch 22, and can’t keep up. The shoulders of Mister Claus slump again: The children! What about the children? Is this Christmas doomed?

A Smarter Mailbox

In hindsight, Mister Claus realizes that this was obvious. If he receives an average of 5 letters per batch and processes 4 at most between batch arrivals, the queue is going to get backed up. Now tasks are being processed as fast as possible, but there is a price to pay: New tasks get stuck in the queue, potentially for a very, very long time. Potentially until after Christmas!

You don’t get to stay in business for centuries by giving up at the first headwind. Back to the drawing board for Mister Claus! After giving the problem more thought, Mister Claus has a moment of insight: his two initial approaches are the two sides of the same coin. If he wants to run tasks as quickly as possible, some will have to wait in the queue. If he wants to process them immediately, then there is a risk of overwhelming the machine by doing too much work at once.

But then, if this is a trade-off, perhaps a compromise is possible? In the end, what matters is not how quickly we run the task itself. What we want is to get as many tasks as possible entirely completed per time interval, from their arrival in the queue all the way to completion.

In other words, we want to maximize throughput, which combines two elements:

How long does it take to process an individual task, end to end?
How many tasks are we processing concurrently?

The second part is important, because we care about overall system throughput. In the end, if processing tasks one-by-one takes 5 seconds, but processing them two at a time takes 9 seconds each, we are better off with the second option, which will complete more tasks during the same time window.

How could we measure how effective our system is, then? If we complete a particular task, end-to-end, in S seconds, then we are completing 1/S of that task per second: A task that takes 5 seconds is 20% completed (1/5) in 1 second. However, if we have T tasks concurrently in flight, each of them is moving forward in parallel: Our system is completing T/S tasks per second.

Now that Mister Claus knows how to measure how productive his Elves are, he still has a problem. Assuming there is an ideal level of concurrency, how can he find it?

There is, of course, the old-school option of just trying it out. Run the mailbox at various levels of concurrency, measure the throughput, and pick the one that works best. It is a viable approach; However, this is also going to be a painful process. On top of that, the ideal level will be specific to the machine we used, and won’t necessarily work for another machine. Mister Claus ponders some more, and wonders - wouldn’t it be nice if the machine could learn what works best, all by itself? After all, as the mailbox is running, it can observe its throughput, so all it should take is a mechanism to observe that throughput at various levels, and adjust concurrency automatically, searching for the level that gives us the best results.

Mister Claus is excited. He puts on his noise-cancelling headphones, and starts banging on his keyboard again. First, we need to measure how long a Job stays in the system. That’s easy, we just need to keep track of the arrival time:

type Timed<'T> = { 
    Arrival: DateTime
    Item: 'T
    }

type Message = 
    | Batch of Job []
    | Completed of Timed<Job>

Then, we need to keep track of the throughput for each concurrency level, and update it as we observe new tasks being completed. We will use a simple strategy to estimate the throughput for each level: when a task completes, we will measure its duration:

If we have no estimate for that level yet, we will use that duration as a starting point,
If we already have an estimate, we will update it like this: let updated = alpha * duration + (1.0 - alpha) * estimate

alpha, the learning rate, is a number between 0.0 and 1.0. With a value of 0.0, we ignore the new estimate, and always keep the original estimate, learning nothing over time. With a value of 1.0, we ignore the past estimate, and always replace it with the latest observation. Anything in between decides how aggressively we want to update our throughput estimation based on recent observations - the higher the number, the more we take into account new observations, and the faster our estimate will change.

That should take care of estimating the throughput for a given level, but how do we go about trying out different levels? Again, we will go for a simple strategy:

If there is a better throughput one level up or down, we move up or down towards that,
Sometimes, we just randomly move up or down, to explore and try out what happens.

The first part is straightforward: if moving concurrency level up or down is an improvement, we just do it. The second part is more interesting: by randomly exploring various levels of concurrency, we should be able to learn about each of them. We should also be able to revisit levels we tried before, and update their througput estimation, if circumstances have changed.

Mister Claus starts to put all of this together, with some quick-and-dirty code:

module Throughput = 

    type Config = {
        LearningRate: float
        ExplorationRate: float
        }

    let update config (concurrency, elapsed) (throughput: Map<int, float>) =
        let measure = float concurrency / elapsed
        match throughput |> Map.tryFind concurrency with
        | None -> throughput.Add (concurrency, measure)
        | Some value -> 
            let updated = 
                (1.0 - config.LearningRate) * value
                + config.LearningRate * measure
            throughput.Add (concurrency, updated)

    let rng = Random 0

    let setLevel config (level: int) (throughput: Map<int, float>) =
        let explore = rng.NextDouble () < config.ExplorationRate
        // with a certain probability, we randomly explore
        if explore
        then
            if rng.NextDouble () < 0.5
            then (max 1 (level - 1))
            else level + 1
        // otherwise we adjust up or down if better
        else
            let current = throughput |> Map.tryFind level
            let lower = throughput |> Map.tryFind (level - 1)
            let higher = throughput |> Map.tryFind (level + 1)
            match current with
            | None -> level
            | Some current ->
                match lower, higher with
                | None, None -> level
                | None, Some high -> 
                    if high > current then level + 1 else level
                | Some low, None -> 
                    if low > current then level - 1 else level
                | Some low, Some high -> 
                    if low > current && low > high then level - 1
                    elif high > current then level + 1
                    else level

And that’s pretty much it - all that is needed is updating our mailbox loop:

    let mailbox (config: Throughput.Config)= 
        MailboxProcessor<Message>.Start(fun inbox ->
        
            let mutable inFlight = 0
            let queue = Queue<Timed<Job>> ()

            let rec loop (throughput, parallelism) = 
                async {
                    let! msg = inbox.Receive ()
                    
                    // update observed throughput
                    let throughput = 
                        match msg with 
                        | Batch _ -> throughput
                        | Completed job -> 
                            let elapsed = (DateTime.Now - job.Arrival).TotalSeconds
                            throughput |> Throughput.update config (inFlight, elapsed)   
                    // handle the work
                    match msg with 
                    | Batch jobs ->
                        jobs 
                        |> Array.iter (fun job -> 
                            { Arrival = DateTime.Now; Item = job } 
                            |> queue.Enqueue
                            )
                    | Completed _ -> 
                        inFlight <- inFlight - 1

                    // adjust level of parallelism
                    let parallelism = 
                        throughput |> Throughput.setLevel config parallelism
                    
                    let rec dequeue () = 
                        if (inFlight < parallelism && queue.Count > 0)
                        then
                            let job = queue.Dequeue ()
                            inFlight <- inFlight + 1
                            processJob inbox job
                            dequeue ()
                            
                    dequeue ()
                    
                    sprintf "Queue: %i, In Flight: %i, Parallelism: %i" queue.Count inFlight parallelism 
                    |> Log.log

                    return! loop (throughput, parallelism)
                }

            let throughput = Map.empty<int,float> 
            loop (throughput, 1) 
            )

You can find the complete code here as a gist

Trying Our Mailbox

Mister Claus wires everything up, and anxiously pores over the log:

> 12/3/2019 3:07:42 PM|New jobs arriving: batch 0, 7 jobs
12/3/2019 3:07:42 PM|Started batch 0 job 0
12/3/2019 3:07:42 PM|Queue: 6, In Flight: 1, Parallelism: 1
12/3/2019 3:07:47 PM|New jobs arriving: batch 1, 8 jobs
12/3/2019 3:07:47 PM|Queue: 14, In Flight: 1, Parallelism: 1

Unsurprisingly, the queue starts to build up pretty quickly.

12/3/2019 3:09:02 PM|New jobs arriving: batch 16, 9 jobs
12/3/2019 3:09:02 PM|Queue: 80, In Flight: 2, Parallelism: 2
12/3/2019 3:09:05 PM|Completed batch 2 job 4 in 5 secs (total 73)
12/3/2019 3:09:05 PM|Queue: 79, In Flight: 2, Parallelism: 2

CPU time is still at 5 seconds per job, but now jobs spend over a minute in the queue: Completed batch 2 job 4 in 5 secs (total 73) indicates a job taking 73 seconds total, with 5 seconds running the task proper.

10 minutes in, and Mister Claus is getting worried. The queue has stopped growing, but the system barely keeps up, and it takes now about 4 minutes to complete jobs:

12/3/2019 3:17:36 PM|New jobs arriving: batch 96, 9 jobs
12/3/2019 3:17:36 PM|Queue: 172, In Flight: 26, Parallelism: 26
12/3/2019 3:17:36 PM|Queue: 181, In Flight: 26, Parallelism: 26
12/3/2019 3:17:36 PM|Started batch 66 job 0
12/3/2019 3:17:37 PM|Completed batch 62 job 2 in 36 secs (total 243)

Hooray! Parallelism has been cranked all the way up to 38, and we are starting to make a dent in the queue. Things are looking up:

12/3/2019 3:21:36 PM|Completed batch 93 job 4 in 16 secs (total 272)
12/3/2019 3:21:36 PM|New jobs arriving: batch 121, 3 jobs
12/3/2019 3:21:36 PM|Queue: 94, In Flight: 37, Parallelism: 37
12/3/2019 3:21:36 PM|Queue: 96, In Flight: 38, Parallelism: 38
12/3/2019 3:21:36 PM|Started batch 101 job 3

And, lo and behold, 20 minutes in, things are looking pretty good: the queue is now empty, and jobs are in-and-out in around 20 seconds:

12/3/2019 3:29:20 PM|New jobs arriving: batch 165, 7 jobs
12/3/2019 3:29:20 PM|Queue: 0, In Flight: 22, Parallelism: 40
12/3/2019 3:29:20 PM|Started batch 165 job 6
12/3/2019 3:29:20 PM|Started batch 165 job 0
12/3/2019 3:29:20 PM|Started batch 165 job 1
12/3/2019 3:29:25 PM|Completed batch 162 job 4 in 20 secs (total 21)

If we plot the behavior of our mailbox over time, here is what we see. The queue builds up for a while, and then goes down, as it finds a good concurrency level that allows it to make a dent. Later on, we see a temporary spike again. This is not unexpected: we can encounter temporary high activity periods.

In terms of time in the system, as the queue builds up, we see the overall processing time go up, mostly spent in the queue. As the concurrency increases, the time spent processing the task itself also slowly degrades. Once the mailbox catches up and the queue is resorbed, the number of tasks in flight reduces. The time spent in the queue is negligible, and the end-to-end processing time stabilizes at a low, relatively steady level.

Conclusion

Hooray - with a bit of F#, we rescued Christmas! In and of itself, this is already a nice result. Nobody likes a sad Christmas story.

Beyond that, hopefully you found something interesting in this post! For me, there are two bits of particular interest. First, I thought it would be fun to showcase the mailbox processor, an F# feature that doesn’t get too much press. I wish the mailbox processor was a bit easier to us, but even then, it is a nice tool to have in the arsenal. As a side note, I would like to say a big thank you to Jeremie Chassaing, who kindly took the time to show me how to use them some time ago.

Then, perhaps the mechanics behind the self-adjusting mailbox will inspire you! They are a very crude adaptation of ideas borrowed from reinforcement learning. In particular, I find the exploration vs. exploitation approach fascinating. It makes intuitive sense that learning requires making random and potentially bad decisions; And yet, I am always a bit surprised to see how such a simple technique can actually work. More generally, there is one thing that I hope came across in this example: machine learning techniques don’t have to be complicated, and can be used to solve many problems besides recognizing whether or not there is a hotdog in a picture.

Note also that, while the approach works in our particular example, this isn’t a silver bullet. First, if too much work is coming in, no amount of adaptation will save you: Too much to handle is too much to handle. Then, if the complexity of tasks varies a lot, or if there is a large delay when observing throughput, it might take a while for the system to learn a good level of concurrency.

Finally… I am sure both the code and algorithm can be improved! For instance, I noticed that over longer periods of time, the concurrency level seems to have a tendency to keep increasing, even with a low number of tasks in flight; a mechanism should probably be added to handle that. So, I would love to hear your thoughts or suggestions! The complete code for the final example is available here as a gist. And, if there is enough interest in the idea, I’d be open to try and turn it into a library?

That’s it for now! In the meanwhile, enjoy the Holidays, and until then, keep your eyes out for the other posts in the F# Advent Calendar 2019!

Give me Monsters! (Part 9)

2019-05-18T00:00:00+00:00

After a long period of silence, time to get back to our series on modelling D&D using F#! In our last installment, we plugged our code into Fable Elmish, to create a crude application simulating and visualizing combat.

The main reason I didn’t write for so long was that, as I put things together, I realized there were flaws in the design. I made heavy changes during the December holidays to address some of them, but found it hard to break it down in smaller steps that would fit a blog post after the fact. I don’t see a reason why things would magically get easier if I wait longer, so I’ll bite the bullet and try to explain these changes today.

Design issues

What were the issues I ran into?

Our initial version was a direct implementation of a naive interpretation of the rules, which state that

On your turn, you can move a distance up to your speed and take one action.

This roughly translated to a model where each creature, on their turn, could issue one or more commands, updating the state (World), one command at a time:

type Command = 
    | Move of Direction
    | Action of Action
    | Done

So what was the problem with that?

First, there was no end state, a problem that became obvious as it was now possible to easily play out an entire fight to the bitter end. What should happen when every creature is dead, for instance? In the initial version, a new command was expected each turn, with no end to combat.

Then, our interpretation of the rules was a bit simplistic. The rules state that a creature can take one Action on their turn. One piece that is left unsaid here is that they can also take a Reaction: depending on the Action taken, a creatures can potentially react, out of their turn. The most common example is the Opportunity Attack, which states that

You can make an Opportunity Attack when a hostile creature that you can see moves out of your reach. To make the opportunity attack, you use your reaction to make one melee attack against the provoking creature. The attack occurs right before the creature leaves your reach.

This is problematic on many levels. Instead of simply following the initiative order to determine which creature has their turn and can perform actions, we also need to accommodate out-of-turn reactions from other creatures, and keep track of which creatures still have a Reaction available. Furthermore, this also breaks our nice and simple model, where each command is immediately executed: if an action triggers a reaction, the action will not be processed until the reaction has been completely executed. In the case of the Opportunity Attack, for instance, if a creature moves away from a hostile creature and triggers such an attack, the movement is not executed until the attack has been fully resolved. As a possible result, the creature moving could be killed, for instance, in which case their Move action doesn’t even take place.

To make things worse, a Reaction could also trigger another Reaction. It is an unlikely scenario, but it is possible. For instance, the Fighter class has two manoeuvers available, Parry (a reaction that reduces the damage taken from a successful melee attack / PHB p74), and Riposte (a reaction that allows to make a melee attack against a creature that just failed theirs, PHB p74). We could now have a full cascade of reactions to handle, for instance in a scenario like this one:

“The Fighter moves, triggering an Opportunity Attack from the Goblin. That Goblin Attack is successful, and the Fighter decides to react with Parry. The Opportunity Attack is now reduced by the Parry, but doesn’t save the Fighter who dies, invalidating their initial Move action”.

Our initial take is clearly not going to cut it. Time to go back to the drawing board, and redesign our model a bit.

Actions and Reactions

So how could we go about modeling this?

The first issue (the end state) suggests that we need to distinguish between 2 situations: combat is either finished, or not. If combat is not finished, we are in the situation covered by our initial model, and someone needs to make a decision. If not, we are done, and may be interested in the combat outcome. This suggests a type along these lines:

type ActionNeeded = {
    // who needs to act?
    Creature: CreatureID
    // what choices do they have?
    Alternatives: list<Action>
    }

type CombatState = 
    | CombatFinished of CombatOutcome
    | ActionNeeded of ActionNeeded

How about reactions? This is where things become hairy. We probably want something similar to ActionNeeded, but we will need to know more than just who can take a reaction and what choices they have. To illustrate why, let’s revisit the Parry and Riposte examples. Both of them are triggered by an attack, but we need to know whether or not the attack is successful. At the same time, the result of the triggering action is not processed until the reaction is taken: we need to keep track of that result, which is “unconfirmed” until the impact of the reaction has been applied. Furthermore, as we saw earlier, the trigger for a Reaction could be either an Action, or a Reaction.

The approach I took here was to build up a chain for Reactions, keeping track of what triggered it, and is still waiting to be confirmed:

type CombatState = 
    | CombatFinished of CombatOutcome
    | ActionNeeded of ActionNeeded
    | ReactionNeeded of ReactionNeeded * WaitingForConfirmation

… where WaitingForConfirmation looks like this:

type WaitingForConfirmation = 
    | Action of UnconfirmedActionResult
    | Reaction of UnconfirmedReactionResult * WaitingForConfirmation

In essence, WaitingForConfirmation is a very specialized linked list. It cannot be empty, and will be either a single Action (in which case we store its unconfirmed result), or a chain of Reactions leading eventually to the original Action. Without going into too much detail, this is (slightly simplified) how our complicated scenario, involving the Fighter and the Goblin, would look like:

ReactionNeeded (
    // the fighter can take the parry reaction, or pass
    { CreatureID = fighter; Alternatives = [ parry; pass ] },
    // this is a Reaction
    Reaction (
        // Reaction to the opportunity attack of the monster, tentatively successful
        { CreatureID = goblin; Reaction = opportunityAttack; Outcome = successfulAttack },
        // which itself is a reaction to the original Move action
        Action { CreatureID = fighter; Action = Move North; Outcome = Move North }
        )
    )

That takes care of part of our problem. In our Elmish application, we can ask for what Action a creature decides to take by displaying the ActionNeeded, and handle the corresponding message. If that Action triggers a Reaction, we simply build up the corresponding ReactionNeeded, and keep building up until no new Reaction is triggered, keeping track of the entire chain of events leading to it in the WaitingForConfirmation part. Progress!

Processing Actions and Reactions

Once I got that piece sorted out, I realized there was another problem. In the original approach, each time a creature took an action, the result was immediately computed. This created a straightforward sequence of operations: determine who needs to act and what their alternatives are, make a decision in the user interface, update the state of the world, and repeat until combat is over.

Unfortunately, that sequence breaks down once Reactions are involved, because a decision taken is not always immediately executed. Let’s consider again the complex Parry Reaction example:

1) Fighter decides to Move 2) This triggers a potential Opportunity Attack: Move result is on hold 3) Goblin decides to take the Opportunity Attack reaction 4) This triggers a potential Parry Reaction: attack result is on hold 5) Fighter decides to take the Parry Reaction 6) No further Reaction is triggered: Fighter Parry Reaction is executed 7) Goblin Opportunity Attack is modified accordingly and executed 8) Fighter Move is executed 9) Action is complete, either Combat is over or someone needs to take an Action

The core of the issue shows up in steps 6, 7 and 8. Here, 3 actions are being executed in succession, without any user input happening in between. This is a problem with the original design: we decide in the UI which action to take, and we immediately execute it. Both go hand in hand, and we need to disconnect them.

The way I approached it was by introducing a second model, Transition, representing each of the possible states of combat. The version shown below is a slight simplification of the code currently in use, in part to make it easier to follow, in part because I am not sure I got it 100% right just yet:

type Transition = 
    | AttemptAction of (CreatureID * Actions.Action)
    | ConfirmAction of UnconfirmedActionResult
    | ExecuteAction of (CreatureID * Outcome)
    | ActionCompleted
    | ActionCancelled
    | ReactionTriggered of (CreatureID * ReactionNeeded)
    | AttemptReaction of (CreatureID * Reactions.Reaction)
    | ConfirmReaction of UnconfirmedReactionResult
    | ReactionCompleted
    | ReactionCancelled of CreatureID
    | ExecuteReaction of (CreatureID * Outcome)

How is this useful? It helps, because we can now write a function execute which, given a GlobalState and a Transition, can move to the next Transition, and will continue to do so until it cannot, because it needs some information / input.

As an illustration, here is a sketch of what happens when processing a new Action: we start in the AttemptedAction state, where we know that a creature wants to take an Action. We determine the tentative outcome of that action, and verify whether or not anyone can take a Reaction. If not, we move to ExecuteAction, where we apply the effect to the GlobalState, and move then to ActionCompleted, where we determine who needs to take an Action next, and return the corresponding CombatState.ActionNeeded, waiting for a decision to be made. The situation is a bit more hairy when Reactions are involved, but follow the same pattern: each step, the execute function moves from one Transition to the next, until some input is needed, in what case it returns the proper ActionNeeded or ReactionNeeded, or until combat is over.

All we need to do at that point is wire it up in the Elmish update function: given a Message describing what decision has been made by a creature in their turn, we call the execute function, which will recursively walk through Transitions and update the state accordingly, until we reach an ActionNeeded or ReactionNeeded state, and ask for input again in the UI.

Conclusion

Hopefully, this post will help figure out some of the code changes I made in December and January. I left quite a few low-level details out, and tried to focus primarily on how these changes came to be, and the overall approach. The code works: in its current state, Opportunity Attacks works properly, and I even tested out Parry to confirm that it could handle deeper reaction chains. That being said, the code is also a bit messy at that point, and the design could benefit from a bit of cleanup, I will do that over the next few weeks.

Next time, I will take a stab at explaining the other major change I made around the same time, adding an automated mode so that the game could play itself, with each agent making decisions following a strategy. Until then, please let me know if you have comments or questions :)

Give me Monsters! (Part 8)

2018-12-15T00:00:00+00:00

In the previous installment of this series, we ended up with a primitive model for turn-based battles in Dungeons & Dragons, covering some of the rules related to movement. The model we came up with represents actions taken by creatures as commands, which we use to update the state of the world. One nice thing about this model is how easy it is to test it out, in the scripting environment or otherwise. However, it would be nice to observe what is going on visually. This will be our goal for today: take our existing domain model, and plug that into Fable Elmish to visualize our rules in action.

Warning: I claim zero expertise in Fable, Elmish or not. For that matter, I would rate my skills in web stuff as “inexistent”. All this to say that the Fable related code is likely going to have some flaws - would love to hear from people who actually know what they are doing, how I could do better ;)

Rules

Before diving into Fable, let’s do a bit of cleanup. You might have noticed an Arrow of Doom starting to take place in our update function, with increasingly deeply nested if/then/else statements, each of them checking whether a particular rule is satisfied by the command that was just passed.

That update function is already over 70 lines long, and it’s only going to get worse as we add more rules. Furthermore, what the code is doing is becoming less and less clear. We don’t like doom, at least not in our code base - let’s simplify this.

One way to look at the issue is, we are mixing together two things: we check in the function whether certain conditions are met, and if they are, we apply the command to update the state of the world. If something fails, we throw an exception.

Let’s take a different angle, and separate the process in 2 phases: first, validate the command, by checking if it passes all the rule checks, and then, update the model. And, while we are at it, let’s remove these ugly exception.

To achieve this, we will explicitly represent each Rule, and validate whether or not a command satisfies that rule, returning a Result type, which will be either Ok(command) if it is valid, and Error(message) otherwise.

So let’s do this. The first rule we have embedded in our update function is the following:

let update (creatureID: CreatureID, cmd: Command) (world: World) = 
    if world.Active <> creatureID
    then 
        sprintf "Error: it is not %A's turn." creatureID
        |> failwith    
    else

… which simply states that a creature must be active to act, otherwise it is not its turn. Let’s model Rule(s) as an interface, and use an Object Expression to create an instance implementing that particular rule:

module Rules = 

    type Rule = 
        abstract member Validate: 
            World -> CreatureID * Command -> Result<CreatureID * Command, string>

    let ``A creature must be active to act`` =
        { new Rule with
            member this.Validate world (creatureID, command) =
                if world.Active <> creatureID
                then 
                    sprintf "%A / %A failed: %s" command creatureID "it is not the creature's turn"
                    |> Error
                else Ok (creatureID, command)
        }

Note: I could also have modeled rules as straight functions type Rule = World -> CreatureID * Command -> Result<CreatureID * Command, string>, instead of going for an interface, which is not really buying us much here. I am not sure why I went that route, perhaps I’ll change the code later to just use functions.

At that point, we can simply use that rule, and check if a command emitted by a creature is valid, given the current state of the world:

open Rules
``A creature must be active to act``.Validate world (CreatureID 1, Move N)
// Ok (CreatureID 1, Move N)
``A creature must be active to act``.Validate world (CreatureID 2, Move N)
// Error "Move N / CreatureID 2 failed: it is not the creature's turn"

Implementing the 3 other embedded rules following the same pattern is straightforward - we end up with a list of 4 rules:

let rules = [
    ``A creature must be active to act``
    ``A creature cannot move if it has not enough movement left``
    ``A creature cannot move to a space occupied by another creature``
    ``A creature can take at most one action per turn``
    ]

So how is this useful? We can now chain them ala Railway Oriented Programming, using Result.bind:

Ok (CreatureID 1, Move N)
|> Result.bind (``A creature must be active to act``.Validate world)
|> Result.bind (``A creature cannot move if it has not enough movement left``.Validate world)
// etc...

Starting from the assumption that the command is Ok, we pass it through every rule for validation, and will either get back our command, validated, or an Error message describing the first failing rule that was encountered.

This is still not particularly pretty. However, with a bit of machinery, we can wrap all that up in a single function, taking the full list of rules we have implemented, and checking if all of them pass by applying a fold:

let validate world (creatureID, command) =
    (Ok (creatureID, command), rules)
    ||> Seq.fold (fun state rule -> 
        state
        |> Result.bind (rule.Validate world)
        )

With that out of the way, all we have to do now is progressively add rules as we implement them, include them in the rule list, and we are done: validation will be taken care of. We can also nicely clean up the update function, removing all the checks and simply executing the command, which is assumed to have been validated beforehand.

Plugging the Domain into Fable Elmish

Let me start by re-iterating again that I am a total Fable beginner; so please, don’t take any of the following as ‘best practices’, and if you have comments/suggestions on how to improve things… I would love to hear them!

With that out of the way, let’s get cranking. The minimal Fable2 sample is, as its name suggest, a minimal Fable app, nicely documented and ready to go, so I lazily copied over the whole thing in its own folder in the project, to use as a starting point.

If you dig into that sample, you will see that an Elmish application boils down to 2 parts:

a Model that represents the state of your application, and Messages that represent what actions can change that state,
3 functions, init, update and view, which respectively initialize the Model, update the Model in reaction to a Message received, and render the Model on screen.

This sounds like a pretty natural fit with our domain. We already have the Model and Message parts (our World and CreatureID * Command types), all we need then is to write out the 3 functions init, update and view.

First, we have a nice domain model, completely agnostic of any UI concerns, and we would like to keep it that way. To do that, we will simply add a file, Domain.fs, to the Fable solution, copy all of our current script into it, and wrap it in a module, Domain. And, because our application has now multiple files, we will give both Domain.fs and App.fs a namespace, MonsterVault.

Time to plug things in. Where the original Elmish application defined Model and Msg as

type Model = int
type Msg = 
    | Increment 
    | Decrement

… we simply swap it out for our domain:

open MonsterVault.Domain

type Model = World
type Msg = CreatureID * Command

For the time being, we will keep using the “test” world we used in our script, populated with 2 test creatures:

let init () = world

The update function is equally easy to write. We need a function that, given a state of the World and a CreatureID * Command, gives us back the state of the world after the command has been applied. One question here is, what should we do for invalid commands? For the time being, we will do the simplest thing we can: when a command fails, we will just return the world as it was before. The drawback here is that we won’t have any notification of what caused the command to fail, but it will be good enough for now:

let update (creatureID, command) world =
    match Rules.validate world (creatureID, command) with
    | Error(msg) ->
        // the command fails: ignore it and keep the world as it was
        world  
    | Ok(creatureID, command) -> 
        update world (creatureID, command)    

Almost there! Our final step will be to render the state of the world, and provide a mechanism for a user to send commands. Let’s do that:

let view (model: Model) dispatch =

    let sendCommand cmd =
        (model.Active, cmd)
        |> dispatch

    div []
        [ 
            div [] [ str (string model) ]

            div [] [ str "Movement" ]

            button [ OnClick (fun _ -> sendCommand (Move N)) ] [ str "N" ]
            button [ OnClick (fun _ -> sendCommand (Move NW)) ] [ str "NW" ]
            button [ OnClick (fun _ -> sendCommand (Move W)) ] [ str "W" ]
            button [ OnClick (fun _ -> sendCommand (Move SW)) ] [ str "SW" ]
            button [ OnClick (fun _ -> sendCommand (Move S)) ] [ str "S" ]
            button [ OnClick (fun _ -> sendCommand (Move SE)) ] [ str "SE" ]
            button [ OnClick (fun _ -> sendCommand (Move E)) ] [ str "E" ]
            button [ OnClick (fun _ -> sendCommand (Move NE)) ] [ str "NE" ]

            div [] [ str "Actions" ]

            button [ OnClick (fun _ -> sendCommand (Action Dash)) ] [ str "Dash" ]

            div [] [ str "Other" ]

            button [ OnClick (fun _ -> sendCommand (Done)) ] [ str "Done" ]
        ]

We render the Model as a raw string, and add one button for each of the commands we support. And… that’s it. npm install, npm start, and we have an application running in the browser:

This is not pretty, but… it works, and it gives us what we need, essentially a primitive debugger. We can now try out our model, and verify that the state is what we expect it to be when we execute commands.

Making Things Less Ugly

Before closing this episode, let’s see if we can make things a bit less ugly. We will make a couple of changes. First, combat takes place on a battle grid - it would be nice to see how things look. Then, it would also be convenient to see the result of a command; in particular, in cases where it fails, getting some feedback on what went wrong would be useful.

I won’t go into a step-by-step explanation of the changes, and will just outline the main modifications - the code, which you can find here, is relatively self-explanatory.

The first change was to modify a bit our Model type, to include both the World and a Journal, a list of the most recent events that occurred:

type Model = {
    World: World
    Journal: string list
    }

Whenever we update the model, we will now append what happened - either the command, if it succeeded, or the error message otherwise, to the Journal, and keep the 5 most recent ones:

let update (msg: Msg) (model: Model) =
    match Rules.validate (model.World) msg with
    | Error(error) -> 
        { model with 
            Journal = 
                error :: model.Journal 
                |> List.truncate 5
        }
    | Ok (creatureID, command) -> 
        let world = update model.World (creatureID, command)
        { model with
            World = world
            Journal = 
                (sprintf "%A: %A" creatureID command) :: model.Journal
                |> List.truncate 5
        }

The second series of changes pertains to rendering the battle map. If we want to display that map on a grid, we need to know its size. For that matter, as we expand our model, we will also need to carry information about the terrain itself, such as walls, obstacles, trees, and whatnot. Easy enough, we just add a BattleMap field to the World itself, which we will later on flesh out as needed:

type BattleMap = {
    Width: int
    Height: int
    }

type World = {
    BattleMap: BattleMap
    // rest unchanged
    }

Rendering the map can then be done using SVG, representing each tile on the battle grid as 15 px square, using different colors to mark empty tiles, the active creature, and other creatures:

let tileSize = 15

let tileAt (model:Model) (x,y) color =
    let map = model.World.BattleMap
    let width = map.Width
    let height = map.Height
    rect [ 
        SVGAttr.X (tileSize * (width - x - 1))
        SVGAttr.Y (tileSize * (height - y - 1))
        SVGAttr.Width (tileSize - 2)
        SVGAttr.Height (tileSize - 2)
        SVGAttr.Rx 2
        SVGAttr.Ry 2
        SVGAttr.Fill color 
        ] [ ]

let battleMap (model:Model) dispatch =

    let map = model.World.BattleMap
    let width = map.Width
    let height = map.Height

    svg [                    
            SVGAttr.Width (width * tileSize)
            SVGAttr.Height (height * tileSize)
        ]
        [
            let map = model.World.BattleMap
            for x in 0 .. (map.Width - 1) do
                for y in 0 .. (map.Height - 1) do
                    yield tileAt model (x,y) "LightGray"

            for creature in model.World.Creatures do
                let state = creature.Value
                let color = 
                    if creature.Key = model.World.Active
                    then "Red"
                    else "Orange"
                yield tileAt model (state.Position.West, state.Position.North) color
        ]

And that’s pretty much it. After a bit of additional cleanup and screen re-organization, we end up with something that, while still very crude, is beginning to look like something:

What Next?

That’s where we will stop for today! This post was less focused on the D&D rules than the previous ones in the series, and more on setting ourselves up so we can easily implement more rules and see how they play out.

For me, the highlight of that experience was discovering Fable-Elmish. I suspect my code isn’t all that great (feedback and suggestions welcome!), and that’s OK. The larger point here is that I managed to take my domain as-is and pretty much plug it right in, without having to change anything. It took about 15 minutes, and it just worked. For somebody like me who doesn’t work with web applications at all, it was borderline shocking how easy the whole process was. Big thanks to the Fable community, it is beautiful work, and a pleasure to work with so far!

Now that we have that in place, where next?

I could dive more into movement and terrain, and things like visibility and line of sight. It is a fun topic in its own right, but I think I will leave that on the backburner for now. Instead, I think my focus will be on two aspects: modeling creature attacks, and automated play.

Observing creatures moving around a map is not all that exiting. Adding attacks will spice things up a bit, and give us a chance to revisit and incorporate into our domain some of the material we covered in earlier posts.

As for automated play, one of my end goals here is to see if I can set up and run simulated battles, to evaluate how balanced a particular encounter is, and perhaps even have creatures learn what strategy they should follow. As a first step towards that lofty end goal, I think I need to change the design a bit, and introduce something like a WorldView, representing what information each creature has available at a given time, and a list of the actions they can perform. With that in place, we should then be able to treat each creature as an agent, deciding based on the information it has available what to do, by following a certain strategy/policy.

Anyways, this will be it for today, hope you find something interesting (or maybe even useful…) in this post! In the meanwhile, as always, you can find the current state of the code here on GitHub - let me know if you have comments or questions :)

Lorentz Attactor visualization with Fable Elmish

2018-12-05T00:00:00+00:00

Yesterday, I needed a bit of a break after a long day, and decided to try and visualize the Lorentz attractor in Fable. As it turns out, it wasn’t complicated, and I was pretty proud of the result, so I shared a gif on Twitter:

Sure, I could try to build something useful with @FableCompiler. Or, I could just animate the Lorentz attractor. It's entirely useless, but I could watch this thing go for hours! #fsharp pic.twitter.com/1QKGX0N6pn
— Mathias Brandewinder (@brandewinder) December 5, 2018

People of The Internet expressed interest in knowing more about this, so here we go: let’s talk about the Lorentz Attractor, F# and Fable.

The Lorentz Attractor

First, let’s start with some personal history. A long time ago, long before I knew anything about computers, I was quite interested in dynamical systems, that is, describing and understanding how systems behave over time - which is how I came across the Lorentz attractor. What makes this system interesting is that it is a fully deterministic system which, for certain settings, exhibits a chaotic behavior, which results in a beautiful shape.

Let’s talk a bit about mechanics. Per the Wikipedia entry, the Lorentz system is a system of differential equations, which describes a trajectory of a point in 3 dimensions. The differential equations are as follow:

dx/dt = sigma * (y - x)
dy/dt = x * (rho - z) - y
dz/dy = x * y - beta * z

… where

x, y and z are the 3 coordinates describing our current location,
sigma, rho and beta are constant parameters,
dx/dt, dy/dt and dz/dt is the instantaneous speed of the system along the 3 axes.

As an illustration, if we set the parameters to sigma = 10.0, beta = 8.0/3.0 and rho = 28.0, and start at position x = 10.0, y = 10.0, and z = 10.0, we can determine that the speed in the x direction is dx/dt = 10.0 * (10.0 - 10.0) = 0.0. Similarly, the speed in the y direction is 10.0 * (28.0 - 10.0) - 10.0 = 170.0.

We can’t plot the exact trajectory of the system. However, if we know the position x, y, z of the system at time t, we can approximate where it will be if we take a short step in time. If my current x position is 10.0 and my current speed dx/dt is 0.0, then after a small time the x position should not have moved. Similarly, starting at y = 10.0, dy/dt = 170.0, so I would expect that after a short time dt, say 0.01, the new y position should be approximately y + (170.0 * 0.01) = 11.7.

That’s all we need to build a simulation of a Lorentz system in F#:

let lorentz =
    let sigma = 10.
    let beta = 8. / 3.
    let rho = 28.
    fun (x, y, z) ->
        let dx = sigma * (y-x)
        let dy = rho * x - y - x * z
        let dz = x * y - beta * z
        dx, dy, dz

let nextLorentz step (x, y, z) = 
    let dx, dy, dz = lorentz (x, y, z)
    x + dx * step,
    y + dy * step,
    z + dz * step

For instance, starting from position (10., 10., 10.), we can simulate 10 steps:

(10., 10., 10.) 
|> Seq.unfold (fun position -> 
    Some (position, nextLorentz 0.01 position))
|> Seq.take 10
|> Seq.toList

… which produces the following sequence:

[(10.0, 10.0, 10.0); (10.0, 11.7, 10.73333333);
   (10.17, 13.30966667, 11.61711111); (10.48396667, 14.8427098, 12.66091458);
   (10.91984098, 16.3024273, 13.87939494);
   (11.45809961, 17.68135065, 15.28947688);
   (12.08042472, 18.96092154, 16.90770427);
   (12.7684744, 20.11130876, 18.74739201);
   (13.50275784, 21.09161256, 20.81536886);
   (14.26164331, 21.85081978, 23.10824173)]

Isometric Projection

We have a working Lorentz system now, but this isn’t pretty. Can we visualize this?

One problem here is that this sequence unfolds in 3 dimensions, and our screen is sadly 2 dimensional. We need a way to project onto the screen.

The diagram below illustrates how one would probably go about representing the point (1., 1., 1.) on the 2-dimensional surface of a sheet of paper:

With a bit of trigonometry, and hoping I didn’t do any calculation mistake here, the X and Y positions of the projected point on the sheet can be reconstructed as:

X = x * cos (x_axis_angle) + y * cos (y_axis_angle) + z * cos (z_axis_angle)`
Y = x * sin (x_axis_angle) + y * sin (y_axis_angle) + z * sin (z_axis_angle)`

Which translates quite naturally to F#:

open System
let PI = Math.PI

let xAngle = 3. * PI / 4.
let yAngle = PI / 4.
let zAngle = PI / 2.

let project (x, y, z) =
    let X = 
        x * cos xAngle +
        y * cos yAngle +
        z * cos zAngle
    let Y =
        x * sin xAngle +
        y * sin yAngle +
        z * sin zAngle
    X, Y

Putting it all together in Fable

Warning: if you are looking for best practices, this is not the place to find it. I am entirely incompetent in all things web, and just slapped things together to get pretty pictures moving.

We now have all the tools we need, time to do some pretty graphics, using Fable Elmish. All I did was clone the Fable2 samples repo, go to the minimal project, follow the instructions to get it to build, and start hacking at it.

Instead of plotting the entire trajectory, what I wanted to do was to keep a “trace” of, say, the 200 hundred last positions, dropping the last point every time a new one was calculated. I define Dot3D as a 3D dot, a tuple of 3 floats, and maintain in the Model an array of dots I want to display, as well as how many of them I should keep in Trace, and the size of the surface I want to project onto, so I can rescale the image appropriately:

type Dot3D = float * float * float

type Model = {
    Trace: int
    Dots: Dot3D []
    Width: float
    Height: float
    }

We define one message, NextDot, which signals that a new dot is being added, and initialize our model:

type Msg =
    | NextDot

let init () : Model = 
    {
        Trace = 300 
        Dots = [| 10., 10., 10. |]
        Width = 440.
        Height = 380.
    }

The update, quick-and-dirty style, computes a new dot, adds it to the collection, and drops the tail:

let update (msg:Msg) (model:Model) =
    match msg with
    | NextDot -> 
        let previous = model.Dots.[0]
        let next = nextLorentz 0.01 previous 
        { model with 
            Dots = 
                Array.append
                 [| next |] 
                 (model.Dots |> Array.truncate model.Trace)
        }

And, because that’s the only thing I know how to work with, we can plot our dots as white circles on a black rectangle, using SVG:

let view (model:Model) dispatch =
        
    div 
        []
        [ 
            svg 
                [ SVGAttr.Width(model.Width); SVGAttr.Height(model.Height) ] 
                [
                    yield 
                        rect [ SVGAttr.Width(model.Width); SVGAttr.Height(model.Height); SVGAttr.Fill("black")] []

                    for dot in model.Dots ->
                        dot
                        |> project
                        |> scale (model.Width, model.Height)
                        |> fun (x, y) ->
                            circle [ 
                                SVGAttr.Cx(x)
                                SVGAttr.Cy(y); 
                                SVGAttr.R(1);  
                                SVGAttr.Fill("white") 
                                ] []
                ]
        ]

Finally, we need a new point to be generated on a timer, so we add that:

let timer initial = 
    let sub dispatch =
        window.setInterval(
            (fun _ -> dispatch NextDot),
            10
            )
        |> ignore
    
    Cmd.ofSub sub

// App
Program.mkSimple init update view
|> Program.withReact "elmish-app"
|> Program.withSubscription timer
|> Program.withConsoleTrace
|> Program.run

… and we are done.

If you want to play with this or see it in action, I created a gist here with the full code. You can just copy the code and paste it into the awesome Fable REPL, and it should just work.

That’s it! Let me know if you have questions and comments :)

Give me Monsters! (Part 7)

2018-12-03T00:00:00+00:00

Welcome back to our ever-expanding series attempting to model D&D 5e rules in F#! In our previous episode, we began to dive in the representation of turn-based combat. We left off with a sketch of a design, where we keep track of the state of affairs in a World entity, updating the position of each creatures by applying a Move command to it.

We also left a few open issues that need to be addressed. The most glaring issue at that point is that, in our current model, every creature can move in any direction, at any moment. This isn’t right: according to the rules,

On your turn, you can move a distance up to your speed. You can use as much or as little of your speed as you like on your turn. […] You can break up your movement on your turn, using some of your speed before and after your action.

To make that happen, we need to incorporate turns (which creature can currently make decisions), and movement (how many feet a creature is allowed to move).

Taking Turns

The first thing we will tackle is turns. Let’s start with the easy part: in order to determine if a creature can pass a command, we need to know whose turn it is. That’s easy, all we need is to add that information to the World:

type World = {
    Active: CreatureID
    Creatures: Map<CreatureID, Position>
    }

We will punt on making any serious decision around error handling for now, and simply throw an exception if a creature acts out of turn:

let update (creatureID: CreatureID, cmd: Command) (world: World) = 
    
    if world.Active <> creatureID
    then 
        sprintf "Error: it is not %A's turn." creatureID
        |> failwith
    else
    // rest unchanged

Not particularly elegant, but it will do for now. We can revisit once we have a better overall sense for error cases.

Now that we know whose turn it is, we need a way to handle change. How do we know a creature is done with their turn, and who comes up next? Per the rules,

You can use as much or as little of your speed as you like

… which means that we cannot, for instance, wait until all of a creature’s movement is used to finish a turn. Not moving, or not doing anything at all, is a valid course of action for a creature on their turn. Therefore, we will need an explicit signal from the creature that they are Done. Let’s incorporate that in the commands, then:

type Command = 
    | Move of Direction
    | Done

In other words, until a creature states that they are done with their turn, we assume they are not.

What should happen when a creature is Done? Combat follows what is called the Initiative Order:

The DM ranks the combatants in order […] (called the initiative order) in which they act during each round. The initiative order remains the same from round to round.

So each creature is ranked when combat begins, and every time a creature finishes their turn, the next one comes up, cycling back to the head of the initiative list when the last one is done. That sounds like a good fit for a list:

type World = {
    Initiative: CreatureID list
    Active: CreatureID
    Creatures: Map<CreatureID, Position>
    }

All we need to do then is handle the Done command in our update function.

let update (creatureID: CreatureID, cmd: Command) (world: World) = 
    
    if world.Active <> creatureID
    then 
        sprintf "Error: it is not %A's turn." creatureID
        |> failwith
    else
        match cmd with
        | Move(direction) ->
            // omitted, same as before
        | Done ->
            let activeIndex = 
                world.Initiative 
                |> List.findIndex (fun id -> id = creatureID)
            let nextUp = (activeIndex + 1) % world.Initiative.Length
            let nextActive = world.Initiative.Item nextUp
            { world with 
                Active = nextActive
            }

We look up the position of the creature in the initiative list, and increase it by 1, modulo the number of creatures, so we cycle back to the head of the list when the end is reached.

Note: I debated using an array instead of a list here, because it is better suited for index-based lookups. However, given that I expect that list to be very short, I ended up sticking with the immutable list.

Progress! At that point, by passing a Done command for a creature, we can move through the Initiative Order, and keep track of who is up. We can now take on movement rules.

Movement

The main rule we are missing now is this one:

On your turn, you can move a distance up to your speed.

Instead of nitpicking the units inconsistency between distance and speed in that statement, let’s focus on the intended meaning here, namely “during its turn, a creature can move up to its total allowed movement per turn”.

To implement that rule, we need to know how many feet of Movement a creature is allowed per turn. We also need to convert a Move, which is cell-based, into a distance. With that in place, we can then compute after each Move how much movement the creature has left, and decide whether a movement is permissible.

We have two things at play here. The Movement a creature can take won’t change, it is a given. On the other hand, how much movement a creature has left in their turn is going to change. Let’s separate these two aspects, with a creature statistics, and its current state:

[<RequireQualifiedAccess>]
module Creature = 

    type Statistics = {
        Movement: int
        }

    type State = {
        MovementLeft: int
        Position: Position
        }

We can now incorporate that into our World, which now stores in 2 separate maps the current state of each creature, and its statistics:

type World = {
    Initiative: CreatureID list
    Active: CreatureID
    Creatures: Map<CreatureID, Creature.State>
    Statistics: Map<CreatureID, Creature.Statistics>
    }

By convention, as mentioned in our previous post, we are operating on a square grid, with cells of 5 x 5 ft., which we name cellSize. As a result, a creature can move only if it has more that 5 feet of movement left. If that is a case, we perform the movement, and update the movement they have left.

Let’s add this in the update function:

let cellSize = 5

let update (creatureID: CreatureID, cmd: Command) (world: World) = 
    // omitted for brevity    
    let currentState = world.Creatures.[creatureID]

    match cmd with
    | Move(direction) ->
        let movementLeft = currentState.MovementLeft
        if movementLeft < cellSize
        then
            sprintf "Error: %A does not have enough movement left" creatureID
            |> failwith 
        else
            let destination = 
                currentState.Position 
                |> move direction
            let updatedState = 
                { currentState with 
                    Position = destination 
                    MovementLeft = currentState.MovementLeft - cellSize
                }
            { world with
                Creatures = 
                    world.Creatures 
                    |> Map.add creatureID updatedState
            }
    // rest unchanged

We have a small problem, though. Every time a creature makes a Move, their movement decreases accordingly. However, the movement they have left never goes back up. As a result, once they have consumed their movement, they are stuck. This is not right - every turn, creatures get their full movement back. Let’s fix this, and reset MovementLeft when they are Done:

let update (creatureID: CreatureID, cmd: Command) (world: World) = 
    // omitted for brevity    
    match cmd with
        // omitted for brevity    
        | Done ->
            let creatureStats = world.Statistics.[creatureID]
            let creatureState = 
                { currentState with 
                    MovementLeft = creatureStats.Movement 
                }
            let activeIndex = 
                world.Initiative 
                |> List.findIndex (fun id -> id = creatureID)
            let nextUp = (activeIndex + 1) % world.Initiative.Length
            let nextActive = world.Initiative.Item nextUp
            { world with 
                Active = nextActive
                Creatures = 
                    world.Creatures 
                    |> Map.add creatureID creatureState     
            }

Cleanup

We have a working model at that point. Given an initial state of the World, we can simulate the movement of creatures, following (some of) the rules of movement. However, that initial state of the world will be unpleasant to set up. We need to manually set up the Initiative Order, the Active creature, and 2 maps with each of the creatures’ statistics and initial state. On top of that, nothing prevents us from creating inconsistent states, say, an active creature that is not listed in initiative, or an incomplete map for state or statistics.

Let’s fix that. The minimal information we need to set the world up is the list of creatures, in initiative order, their statistics, and their starting position. Given that information, we can determine the active creature (the first in the list), and their initial state (their position, with full movement available):

[<RequireQualifiedAccess>]
module Creature = 

    // omitted for brevity
    let initialize (stats: Statistics, pos: Position) =
        {
            MovementLeft = stats.Movement
            Position = pos
        }

type World = {
    // omitted for brevity
    }
    with
    static member Initialize(creatures: (CreatureID * Creature.Statistics * Position) list) =
        let initiative = 
            creatures 
            |> List.map (fun (creatureID, _, _) -> creatureID)
        {
            Initiative = initiative
            Active = initiative |> List.head
            Creatures = 
                creatures 
                |> List.map (fun (creatureId, stats, pos) -> 
                    creatureId,
                    Creature.initialize (stats, pos)
                    ) 
                |> Map.ofList 
            Statistics = 
                creatures 
                |> List.map (fun (creatureId, stats, _) -> 
                    creatureId,
                    stats
                    ) 
                |> Map.ofList 
        }

As a final touch, because we can, let’s add a sprinkle of Units of Measure, to disambiguate how movement works:

[<Measure>]type ft

let cellSize = 5<ft>

[<RequireQualifiedAccess>]
module Creature = 

    type Statistics = {
        Movement: int<ft>
        }

    type State = {
        MovementLeft: int<ft>
        Position: Position
        }

We can now set our world up, and act on it, without too much pain:

let creature1 = 
    CreatureID 1, 
    { Creature.Movement = 30<ft> },
    { North = 0; West = 0 } 
    
let creature2 = 
    CreatureID 2, 
    { Creature.Movement = 20<ft> },
    { North = 5; West = 5 } 

let world = 
    [
        creature1
        creature2
    ]
    |> World.Initialize 

world 
|> update (CreatureID 1, Move N)
|> update (CreatureID 1, Move N)
|> update (CreatureID 1, Done) 
|> update (CreatureID 2, Move SE) 
|> update (CreatureID 2, Done)
|> update (CreatureID 1, Move N) 

(*
val it : World =
  {Initiative = [CreatureID 1; CreatureID 2];
   Active = CreatureID 1;
   Creatures =
    map
      [(CreatureID 1, {MovementLeft = 25;
                       Position = {North = 3;
                                   West = 0;};
                       ActionTaken = None;});
       (CreatureID 2, {MovementLeft = 20;
                       Position = {North = 4;
                                   West = 4;};
                       ActionTaken = None;})];
   Statistics =
    map [(CreatureID 1, {Movement = 30;}); (CreatureID 2, {Movement = 20;})];}
*)

A Dash of Action

We have the basics of a model for movement in place. It is not complete yet, but it is getting there! We could stop here, but let’s push ourselves, and go a bit further, with the Dash action. Per the rules again,

When you take the Dash action, you gain extra movement for the current turn. The increase equals your speed, after applying any modifiers. With a speed of 30 feet, for example, you can move up to 60 feet on your turn if you dash.

How could we go about that?

First, Dash is an Action. Restating the rules slightly, this means that a creature can choose to take Dash as their one Action in a turn, which will double the movement they would have available otherwise. To make that work, we need to add a new command for Dash, and, when a creature uses it as an Action, make sure that they haven’t taken other actions before, and modify the movement they have left accordingly. Let’s do this.

First, we create a new type, Action, and model whether or not an action has been taken by incorporating it as an Option in the creature state:

type Action = 
    | Dash

[<RequireQualifiedAccess>]
module Creature = 

    // omitted for brevity
    type State = {
        MovementLeft: int<ft>
        Position: Position
        ActionTaken: Action option
        }
    
    let initialize (stats: Statistics, pos: Position) =
        {
            MovementLeft = stats.Movement
            Position = pos
            ActionTaken = None
        }

Then, we expand our commands, adding the case where a creature decides to take an Action:

type Command = 
    | Move of Direction
    | Action of Action
    | Done

And finally, we modify the update function. If the command is Action Dash, we check that no action has been taken yet, and simply increase the movement the creature has left in the turn by its total movement, and, when a creature is Done with its turn, we reset its state to ActionTaken = None.

let update (creatureID: CreatureID, cmd: Command) (world: World) = 
    
    // omitted for brevity
    let currentState = world.Creatures.[creatureID]

    match cmd with
    | Move(direction) ->
        // omitted for brevity
    | Action(action) ->
        match currentState.ActionTaken with
        | Some(_) -> 
            sprintf "Error: %A has already taken its action" creatureID
            |> failwith
        | None ->
            match action with
            | Dash ->
                let creatureStats = world.Statistics.[creatureID]
                let creatureState = 
                    { currentState with 
                        MovementLeft = currentState.MovementLeft + creatureStats.Movement
                        ActionTaken = Some Dash
                    }
                { world with
                    Creatures = 
                        world.Creatures 
                        |> Map.add creatureID creatureState
                }
    | Done ->
        let creatureStats = world.Statistics.[creatureID]
        let creatureState = 
            { currentState with 
                MovementLeft = creatureStats.Movement 
                ActionTaken = None
            }
        // omitted for brevity

And that’s pretty much it! Now we can Move and Dash:

world 
|> update (CreatureID 1, Move N)
|> update (CreatureID 1, Move N)
|> update (CreatureID 1, Action Dash)

(*
val it : World =
  { // omitted
   Creatures =
    map
      [(CreatureID 1, {MovementLeft = 50;
                       Position = {North = 2;
                                   West = 0;};
                       ActionTaken = Some Dash;});
*)

What Next?

Our model for movement is in reasonably good shape at that point, but we are missing a few ingredients. First, we are completely ignoring terrain. What if there are walls or obstacles? How about a swampy terrain, where progression might be slowed? Depending on how much complexity we want to handle, that part shouldn’t be overly hard to add to our World (famous last words).

Then, so far we have been ignoring creatures around us. That part is a bit tricky. Entering the space occupied by a creature is sometimes possible (for example, a small creature can go through the space occupied by a much larger creature), but staying there is not allowed, which should make for some fun with rules validation.

To illustrate the challenge, consider a creature entering the space of a larger creature. Because it cannot stay there at the end of its turn, deciding whether that move is or isn’t possible would require checking that leaving that space will still be possible before the turn ends. The other intricate issue ahead is Attacks of Opportunity. Essentially, any time a creature moves away from direct contact with a hostile creature, that hostile creature can attack them, out of turn, which breaks the natural list-based initiative order.

In other words, the devil is in the details, and it seems that we have a couple of devilish details that will need handling soon. Where I think I’ll go next is, try to reach some reasonable closure around movement, and wrap the code we have in a simple Fable Elmish application, so we can actually see what is happening. In the meanwhile, you can find the code we discussed today here on GitHub.

Give me Monsters! (Part 6)

2018-11-12T00:00:00+00:00

It’s been a while since I posted any update in this series, but we are back! Besides life and work getting in the way, I also needed to give some thought on where I wanted to take this next. We have a reasonable draft model to represent Monsters at that point, but I feel it’s time to take a slightly different direction.

The driving question behind this whole project was, how can we check if an encounter between Adventurers and Monsters is balanced? To do this, I think the easiest approach is to simulate encounters. Put together some Monsters and Adventurers, let them fight it out, repeatedly, and see what happens.

This requires two distinct pieces:

an engine responsible for enforcing the rules, to determine what actions a creatures can take, and resolve what the results are,
some form of AI, to make reasonable decisions for the creatures, so we can simulate how an encounter might unfold.

The engine modeling the game itself is a prerequisite to build the AI system, so that is what we will start with. Once we have that piece in place, we should be able to deal with the AI part, and hopefully refactor the code we wrote so far to plug it in.

The Rules of Engagement

First, what are we trying to model here, exactly?

A typical Dungeons & Dragons game alternates between 2 fairly different “modes”: Combat, and what I will call free-form role playing. During free-form playing, the general rules apply, but they take a back seat to story telling. By contrast, when an encounter turns into Combat, the rules become fairly rigid, akin to a wargame. The flow is broken down in Rounds, and follows Initiative Order: each protagonist gets a Turn, representing 6 seconds of real time, during which they can take a limited set of actions, typically combining some Move, and some combat-related action(s).

Our focus here will be to model Combat.

We briefly touched on the topic in our previous post; let’s revisit it a bit, to set the frame. During Combat, we have 2 groups of creatures (at least), Monsters and Adventurers. When Combat begins, each of them gets assigned a position in Initiative Order, based on dice rolls and their Dexterity.

Note: there is an interesting assymmetry between Monsters and Adventurers Initiative. While each Adventurer is slotted based on his/her roll, a group of identical monsters gets one roll, and will be assigned initiative as a whole group. As a result, a whole group of monsters could go first (or last), which I suspect would result in very extreme results with large groups, with potential for a fast TPK.

Note: we will leave aside the possibility of confrontations with more than 2 groups involved.

On their Turn, each creature can do a couple of things. It can Move to any of the 8 adjacent squares (if reachable), for as long as its movement is not exhausted. During its turn, if the conditions allow it, it can take one Action, at any time between the Move “steps”: Attack, Hide, Dash, … In addition, some creatures may have the option to take a Bonus Action.

Finally, and without going into detail yet, two things will need to be taken into account. First, not every creature sees the same thing at the same time. Some creatures might be hidden from some others, and some creatures have different abilities to see in the dark. Then, during movement, coming in contact, or traversing the zone occupied by another creature has implications, too.

Preliminary Thoughts on Overall Design

So, how do we approach this?

Given the turn-based nature of combat, a command-based approach seems like a natural fit. At any given time, one creature is up, and, based on the state of the world, can take one of many possible actions (Move or Action). Based on the result, it can either take another action, or it exhausted what it could do during its turn, and the next creature in initiative order can start.

In other words, what we are after is something like an update function, along these lines (any similarity with things Elmish is obviously a coincidence):

World -> Command -> World

Or, in plain English, “Given the current state of the World, and a Command representing what a Creature wants to do, give me back the state of the World after executing the Command”.

Before diving into code, a couple of additional thoughts. First, we will need to be explicit about who is taking action. Move North is ambiguous - which creature is moving? In other words, we expect that commands will look along the lines of (CreatureID * Command), that is, who wants to do what.

Then, our goal is to build a system which we can ultimately use to simulate strategies for any creature. Now what a creature can do depends on its current situation; for instance, if there is a wall north of me, I can’t move north. In that context, it would be very convenient to know what actions a creature is allowed to perform, so we don’t have to try potentially illegal ones to figure out what we can actually do.

Note: credit where credit is due, I think I heard a similar idea in a talk by Scott Wlaschin demonstrating how to do Tic-Tac-Toe, the Enterprise way.

On a related note, creatures operate on asymmetric information. They do not see the world in its entirety, and operate on different information. Some might be hidden from others, some might not know how strong another is, and so on. If we want to properly simulate strategies for creature, we will need to know what information each creature has, to determine the appropriate action it should take.

In other words, at some point, we will probably need to provide something like a WorldView for each creature, that is, what they know about the world, and what exact list of commands they can chose from.

Modeling Movement

Enough talking - let’s jump into coding, and see if that teaches us anything. As a first step, we will focus on movement. We will begin with the most naive implementation possible, and refine as we go.

Each creature in D&D has a speed statistic, which describes how many feet it can move during a turn, under standard circumstances. Combat traditionally takes place on a map divided in a grid, either square or, less commonly, hexagonal. We will use a square grid, with cells of 5 x 5 ft., largely because it is much easier to work with.

A creature is located on a cell (or multiple cells, for large ones), and can potentially move to any of the 8 adjacent cells, if it has enough remaining movement to do so. Movement is taken step-by-step / cell-by-cell, so that if the overall move is interrupted, say, by a trap being triggered or any other event, the location of the creature is known, and it can chose what to do next.

Note: from a geometry standpoint, this is somewhat flawed: all moves are considered equivalent, even though diagonal moves correspond to a longer distance traveled. As a result, a circle of diameter 20 ft. becomes a square of side 20 ft. Anyways.

Let’s model that. A straighforward approach would be to represent the 8 possible directions first:

type Direction = 
    | N
    | NW
    | W
    | SW
    | S
    | SE
    | E
    | NE

… which we can then use to determine the position of a creature, expressed in cell coordinates, after one of these moves:

type Position = {
    North: int
    West: int
    }

let move (dir: Direction) (pos: Position) = 
    match dir with
    | N -> { pos with North = pos.North + 1 }
    | NW -> 
        { pos with 
            North = pos.North + 1
            West = pos.West + 1
        }
    | W -> { pos with West = pos.West + 1 }
    // etc...

Let’s try this out:

{ North = 0; West = 0 }
|> move N
|> move NW
|> move W

// val it: Position = { North = 2; West = 2 }

This is a decent start. However, if we want to keep track of multiple creatures, we are missing a piece here, namely the world. First, we will need some form of identifier for creatures:

type CreatureID = | CreatureID of int

For each creature, we will need to know its current position. Let’s do that:

type World = {
    Creatures: Map<CreatureID, Position>
    }

And we can now write a first version of our update function:

let update (cmd: CreatureID * Direction) (world: World) = 
    
    let creatureID, direction = cmd
    let currentPosition = world.Creatures.[creatureID]
    let updatedPosition = currentPosition |> move direction 
    
    { world with
        Creatures = 
            world.Creatures 
            |> Map.add creatureID updatedPosition
    }

Note: Map behaves essentially like an immutable dictionary, with the Map.add function performing an “insert or update” operation.

Let’s test this out:

let world = {
    Creatures = [
        CreatureID 1, { North = 0; West = 0 }
        CreatureID 2, { North = 5; West = 5 }
        ]
        |> Map.ofList
    }

world 
|> update (CreatureID 1, N)
|> update (CreatureID 2, W) 

(*
val it : World =
    { Creatures = map [
        (CreatureID 1, { North = 1; West = 0; })
        (CreatureID 2, { North = 5; West = 6; })
        ]
    }
*)

Progress! Let’s do a bit of cleanup here. We are going to add more commands as we grow this thing, so passing in a Direction is probably not what we want. Let’s fix this:

type Command = 
    | Move of Direction

let update (creatureID: CreatureID, cmd: Command) (world: World) = 
    
    let currentPosition = world.Creatures.[creatureID]

    match cmd with
    | Move(direction) ->
        let updatedPosition = currentPosition |> move direction         
        { world with
            Creatures = 
                world.Creatures 
                |> Map.add creatureID updatedPosition
        }

// omitted for brevity

world 
|> update (CreatureID 1, Move N)
|> update (CreatureID 2, Move SE) 

What Next?

We got the very basics of movement in place - what next?

There are a lot of obvious issues we need to address. Some graceful error handling would be nice: in our example, update (CreatureID 42, N) will throw a gnarly System.Collections.Generic.KeyNotFoundException - we should be able to do better. There is also a looming ambiguity between distances, expressed in feet, and coordinates on the grid.

However, these are somewhat tactical details. The piece I want to tackle first is the proper handling of turns and movement. Specifically, here is a list of potentially tricky issues we need to address:

Which creature is currently allowed to move? How about if the creature doesn’t want to move? A creature doesn’t have to use its full movement, so we will need to signal the end of a turn (probably with a Done command), and identify who comes next in initiative order.
Which of the 8 possible movements is allowed? This depends on how much movement is left, but also on the terrain or obstacles such as walls.
Extending movement with the Dash action, or potentially bonus action.
Entering another creature’s space.

In other words, plenty of questions to tackle! We will explore that further in our next post. In the meanwhile, the code we discussed today can be found here on GitHub.

Give me Monsters! (Part 5)

2018-09-15T00:00:00+00:00

Let’s face it, one of the main purposes of Monsters in D&D is to serve as battle fodder for Adventurers. It’s time to explore the bottom section of the Monster stats, and talk Weapons and Combat.

Warning: I have tried my best to make the contents of this series understandable without too much knowledge of the D&D 5e rules. This post goes into more arcane details than the previous ones, because the rules of combat are pretty intricate, and the details matter. I guess that is unavoidable: anything non trivial domain modeling effort will require diving into nitty-gritty details at some point.

From a domain modeling standpoint, this part is a bit messy. We have a sub-section labeled “Actions”, but the items listed there are not actions - a Scimitar or a Shortbow are weapons. To make things even more confusing, right above, we have a section that isn’t even labeled, but contains actions - Nimble Escape allows the Goblin to take special Bonus Actions, Disengage or Hide.

So… what should we make of this?

Combat and Attacks

Let’s take a step back. In D&D 5e, when Combat occurs, specific rules apply. During each Round, creatures involved take their Turn, following Initiative Order. During their Turn, a creature can Move, take one “standard” Action (Hide, Dodge, Attack…), and potentially a Bonus Action. They can also take a Reaction out-of-turn, based on what other creatures do.

As a possible Action, a creature can Attack another, using either the Weapons it has equipped, or some natural ability, for instance, Bite and Claw attacks for a Black Bear, which are represented in the same fashion as Weapons.

In that context, here is what the Goblin stat block is telling us:

Nimble Escape modifies the structure of the default turn, granting Goblins additional actions they can perform,
Goblins typically carry a Scimitar and a Shortbow, which they can use to make an Attack as an Action.

Today, we will focus on modeling Attacks with Weapons. Later on, we will look at turns, and ideally, explore whether we can use that to simulate battles, and maybe even identify winning fighting strategies for monsters with a sprinkle of machine learning.

So let’s dig deeper into Attacks using Weapons, starting by an examination of the Goblin sheet.

The Scimitar and Shortbow lines both display similar indications, +4 to hit, and Hit: (1d6 + 2). These are used to resolve the result of an Attack. An Attack starts with an Attack Roll: roll a d20, add a modifier (in this case, +4), and compare it to the AC of the target. If the roll is greater or equal to the AC, it is a hit, which will cause damage determined by a 1d6 + 2 roll, to be deduced from the targets’ hit points.

The two lines also have some differences. The Scimitar is marked as a Melee attack, that is, close-combat, while the Shortbow is a Ranged attack, that is, made at a distance. Both define a range (how far the attack can reach), but the Shortbow has 2 numbers, 80/320 ft., describing the short and long distances for a bow shot. Finally, each weapon deals a different type of damage, Slashing vs. Piercing.

Weapon Attacks

Where are all these bits of information coming from?

Let’s assume the rules governing Monsters and Adventurers are mostly the same, and look into how an Attack gets resolved, in the simple cases. To determine if a Melee Attack hits, a d20 roll is rolled, and two modifiers applied: the STR modifier, and, if the Adventurer is Proficient with the Weapon (or type of weapon), the Adventurer Proficiency Bonus, which depends on their level. The damage dealt is resolved with a Damage Roll, determined by the Weapon itself, to which the STR modifier is added. In the case of a Ranged Attack, the rules are similar, but use DEX instead of STR.

In other words, to determine the result of an attack, we need to know the attacker Abilities and their Level, whether a Melee or Ranged Weapon is being used, and what the Weapon Damage is.

Let’s take a stab at coding this, returning the attack bonus and damage roll for an attack:

let proficiencyBonus level =
    if level <= 4 then 2
    elif level <= 8 then 3
    elif level <= 12 then 4
    elif level <= 16 then 5
    else 6

type Attack = 
    | Melee
    | Ranged

type Weapon = {
    Damage: Roll
    Attack: Attack
    }

let attackModifiers (abilities:Abilities) (level:int) (weapon:Weapon) =
    let hit = 
        proficiencyBonus level 
        +
        match weapon.Attack with
        | Melee -> modifier abilities STR
        | Ranged -> modifier abilities DEX
    let damage = 
        match weapon.Attack with
        | Melee -> weapon.Damage + modifier abilities STR
        | Ranged(_) -> weapon.Damage + modifier abilities DEX
    hit, damage

We should now be able to try this out on our Goblin. We have one small issue here, namely that Monsters do not have an explicit Level defined. However, as we noted in a previous episode, we could use the number of Hit Dice as a proxy, which would be consistent with the rules governing adventurers. Let’s see how this works out, assuming a Goblin is proficient with both the Scimitar and the Shortbow:

let scimitar = {
    Damage = Roll (1,d6)
    Attack = Melee
    }

let shortbow = {
    Damage = Roll (1, d6)
    Attack = Ranged
    }

attackModifiers goblin.Abilities goblin.HitDice scimitar
// val it : int * Roll = (1, Add [Roll (1,D 6); Value -1])

attackModifiers goblin.Abilities goblin.HitDice shortbow
// val it : int * Roll = (4, Add [Roll (1,D 6); Value 2])

This is almost correct (or, as less charitable people might put it, it’s wrong). We get the expected results for the Shortbow (+4 to hit, hit: 1d6 + 2 damage), but the Scimitar is off. What are we missing?

More Weapons

To answer this, we will need to dig deeper into Weapons. Per the PHB pp 146-147, each Weapon can have multiple properties - let’s list a few that are directly relevant to attacks:

Finesse
Heavy
Light
Thrown
Two-Handed
Versatile

In addition to this, the PHB also breaks down weapons between Simple and Martial, which describes classes of weapons a creature is proficient with.

While Weapon Properties appear in the PHB as a flat list, these are clearly not all on the same level. How should we organize this? One way to approach this is to consider which ones are incompatible with each other - they probably belong to a Discriminated Union - and which are not - they might fit in a Record.

So how can we go about a data model for Monsters and Weapons, to determine the resolution of an attack?

The first issue we’ll need to address is that the signature for our earlier attackModifiers function won’t work, because different attacks are possible with a single Weapon. First, a Weapon that has the Thrown property can be used both for Melee and Ranged attacks. Then, for a Melee Weapon, there are options, too - some are Versatile, allowing to make attacks with one or two hands, and Light Weapons can be used for Two-Weapon Fighting, using a second weapon Off-Hand.

This is complicated. First things first, a signature along the lines of what we had previously, Monster -> Weapon -> AttackResult won’t do. We could specify what type of attack we are attempting, but we would need to handle the fact that the attack could be impossible. In that frame, we could try something like Monster -> Weapon -> AttackType -> AttackResult option. The angle we will take instead is to generate all the attacks that could be made, that is, someting like Monster -> Weapon -> AttackResult list.

One benefit of that approach is that we can now separately generate the list of melee and ranged attacks, each in their own function, and merge them together into a list of all possible attacks. Let’s start with Ranged attacks, because they are a bit simpler.

As we saw earlier, the Attack descriptions share common characteristics; the only difference, from a data structure standpoint, is that a Ranged Attack has two ranges, while a Melee attack only has one. Let’s represent the differences with a Discriminated Union:

[<RequireQualifiedAccess>]
module Weapon = 

    type MeleeInfo = {
        Range: int
        }

    type RangedInfo = {
        ShortRange: int
        LongRange: int
        }

type Attack = 
    | Melee of Weapon.MeleeInfo
    | Ranged of Weapon.RangedInfo

Let’s look at the common parts next. We discussed earlier the hit bonus and damage roll; in addition, we need to know if the attack is made with one or two hands (we will call that Grip), and the damage type (Piercing, Slashing, etc…):

type DamageType = 
    | Acid 
    | Bludgeoning 
    // omitted for brevity

type AttackGrip = 
    | SingleHanded
    | TwoHanded

type AttackInfo = {
    Weapon: string
    Grip: AttackGrip
    HitBonus: int
    Damage: Roll
    DamageBonus: int
    DamageType: DamageType
    }

All we have to do now is pull the data we need from the Monster and the Weapon, to fill in the blanks. Let’s start fleshing out the Weapon part:

module Weapon = 

    type Proficiency = 
        | Simple 
        | Martial 

    type Grip = 
        | SingleHanded
        | TwoHanded

    type RangedInfo = {
        ShortRange: int
        LongRange: int
        }

    type Usage = 
        | Melee of MeleeInfo
        | Ranged of RangedInfo

type Weapon = {
    Name: string
    Proficiency: Weapon.Proficiency
    Grip: Weapon.Grip
    Damage: Roll
    DamageType: DamageType
    Usage: Weapon.Usage
    }

In addition to Abilities and Level, we need one extra piece of information from the attacker, its proficiency:

let rangedAttacks 
    (abilities:Abilities)
    (proficiency:Weapon.Proficiency) 
    (level:int) 
    (weapon:Weapon) =

        let ability = modifier abilities DEX
        let proficiency = 
            match weapon.Proficiency, proficiency with
            | Weapon.Martial, Weapon.Simple -> 0
            | _ -> proficiencyBonus level
        let attackGrip = 
            match weapon.Grip with
            | Weapon.SingleHanded -> SingleHanded
            | Weapon.TwoHanded -> TwoHanded

        match weapon.Usage with
        | Weapon.Ranged(info) -> 
            [
                { 
                    Weapon = weapon.Name
                    Grip = attackGrip
                    HitBonus = ability + proficiency
                    Damage = weapon.Damage
                    DamageBonus = ability
                    DamageType = weapon.DamageType
                }
            ]
            |> List.map (fun attack -> Ranged(info), attack)
        | _ -> []

We compute the ability modifier, based on DEX for a ranged attack, determine whether the proficienty bonus applies, and whether the attack is one- or two-handed. If the Weapon can be used for a ranged attack, we create a list, with a single item describing the attack made, and otherwise we return an empty list.

Even More Weapons

Are we done with ranged attacks? Well, not quite - we are missing two cases.

First, some weapons, such as a Spear or a Javelin, have the Thrown property, which means that they can be used both for Melee and Ranged attacks. We will handle this by introducing a third case to Usage, Thrown, which will combine in a tuple both RangeInfo and MeleeInfo. This also has implications on the ability bonus: instead of DEX, the hit bonus for a Thrown Weapon uses STR.

Well, not quite. Some weapons also have the Finesse property. In that case, the attacker can pick either DEX or STR for the attack roll. We will simply add a Finesse property - a bool - to the Weapon, and update our rangedAttacks function:

module Weapon = 

    // omitted for brevity

    type ThrownInfo = {
        Melee: MeleeInfo
        Ranged: RangedInfo
        }

    type Usage = 
        | Melee of MeleeInfo
        | Ranged of RangedInfo
        | Thrown of MeleeInfo * RangedInfo

let rangedAttacks 
    (abilities:Abilities)
    (proficiency:Weapon.Proficiency) 
    (level:int) 
    (weapon:Weapon) =

        let ability = 
            match weapon.Finesse with
            | true ->  [ STR; DEX ] 
            | false -> 
                match weapon.Usage with
                | Weapon.Thrown(_) -> [ STR ]
                | _ -> [ DEX ]
            |> Seq.maxBy (modifier abilities)
            |> modifier abilities

        // omitted for brevity

        match weapon.Usage with
        | Weapon.Thrown(_,info)
        | Weapon.Ranged(info) -> 
            // omitted for brevity

The main change here is that instead of using DEX by default, based on the weapon, we extract a list of the abilities we could use, DEX and/or STR, and select the one that gives us the best damage.

And Even More Weapons

Now that we have the ranged attacks covered, let’s dig into melee attacks, and how they are different.

The first difference is that melee weapons that have the Versatile property can be used with one or two hands, dealing more damage in that case. We will follow the same convention as the PHB, and represent a Versatile weapon as a single-handed weapon, with an optional two-handed damage roll:

module Weapon = 

    type Grip = 
        | SingleHanded of Versatile: Roll option
        | TwoHanded

The second difference is that a Light single-handed weapon can be used in combination with another light weapon, to perform an Off-Hand attack, with a smaller damage bonus. To handle this, we need a few additional elements to describe the Weapon and the Attack:

module Weapon = 

    type Handling = 
        | Light 
        | Normal 
        | Heavy 

    type Grip = 
        | SingleHanded of Versatile: Roll option
        | TwoHanded

type Weapon = {
    Name: string
    Proficiency: Weapon.Proficiency
    Handling: Weapon.Handling
    Grip: Weapon.Grip
    Finesse: bool
    Damage: Roll
    DamageType: DamageType
    Usage: Weapon.Usage
    }
    
type AttackGrip = 
    | SingleHanded
    | TwoHanded
    | OffHand

Two quick comments here. First, while that term doesn’t exist in the rules, we included a Normal Handling category besides Light and Heavy. A discriminated union is collectively exhaustive and mutually exhaustive: no matter what the situation, we should be in one and only one of the cases. As it turns out, some weapons are neither light nor heavy, and we need to describe them, too. It’s not uncommon for people to describe only how an item is unusual, without naming the “normal” case - watch out for this! The other point perhaps worth noting is how we separated Weapon.Grip from AttackGrip. On the surface, they might appear as one thing (can a weapon be used with one or two hands), but they appear in slighty different contexts, and forcing them into a single representation would force us to handle cases that should not even be possible.

Side note: if you are wondering how to handle creatures that have more than 2 hands, per this RPG StackExchange discussion, a creature could wield multiple weapons, but is limited to attacking with at most 2 light weapons. That’s one complication avoided!

This is where returning a list of attacks will start paying off, because the same exact weapon could be used to perform 2 different melee attacks - or even 3 in theory, for a Light Versatile weapon.

So let’s put this together, with a meleeAttacks function, displayed below without further comment:

let meleeAttacks 
    (abilities:Abilities)
    (proficiency:Weapon.Proficiency) 
    (level:int) 
    (weapon:Weapon) =

        let ability = 
            match weapon.Finesse with
            | true ->  [ STR; DEX ] 
            | false -> [ STR ]
            |> Seq.maxBy (modifier abilities)
            |> modifier abilities
        let proficiency = 
            match weapon.Proficiency, proficiency with
            | Weapon.Martial, Weapon.Simple -> 0
            | _ -> proficiencyBonus level

        match weapon.Usage with
        | Weapon.Thrown(info,_)
        | Weapon.Melee(info) -> 
            [
                match weapon.Grip with
                | Weapon.SingleHanded(versatile) ->
                    yield { 
                        Weapon = weapon.Name
                        Grip = SingleHanded
                        HitBonus = ability + proficiency
                        Damage = weapon.Damage
                        DamageBonus = ability
                        DamageType = weapon.DamageType
                        }
                    match versatile with
                    | None -> ignore ()
                    | Some(versatileRoll) ->
                        yield { 
                            Weapon = weapon.Name
                            Grip = TwoHanded
                            HitBonus = ability + proficiency
                            Damage = versatileRoll
                            DamageBonus = ability
                            DamageType = weapon.DamageType
                            }
                    match weapon.Handling with
                    | Weapon.Light -> 
                        yield { 
                            Weapon = weapon.Name
                            Grip = OffHand
                            HitBonus = ability + proficiency
                            Damage = weapon.Damage
                            DamageBonus = min ability 0
                            DamageType = weapon.DamageType
                            }
                    | _ -> ignore () 
                | Weapon.TwoHanded ->
                    yield { 
                        Weapon = weapon.Name
                        Grip = TwoHanded
                        HitBonus = ability + proficiency
                        Damage = weapon.Damage
                        DamageBonus = ability
                        DamageType = weapon.DamageType
                        }
            ]
            |> List.map (fun attack -> Melee(info), attack)
        | _ -> []

Attacks at Last

That is a bit of a wall of code. Fortunately, we are mostly done at that point. All we have to do is to merge all attacks available in a single function, and wire up monsters, to see what attacks they can do with their weapons:

let attacks 
    (abilities:Abilities)
    (proficiency:Weapon.Proficiency) 
    (level:int) 
    (weapon:Weapon) =
        [
            yield! meleeAttacks abilities proficiency level weapon
            yield! rangedAttacks abilities proficiency level weapon
        ]

type Monster = {
    // omitted for brevity
    HitDice: int
    Abilities: Abilities
    Equipment: Weapon list
    Proficiency: Weapon.Proficiency
    }
    with
    // omitted for brevity
    static member Attacks (monster:Monster) =
        let attacks = 
            attacks monster.Abilities monster.Proficiency monster.HitDice
        monster.Equipment
        |> List.collect attacks

… and we are done. Let’s try it out:

let scimitar = {
    Name = "scimitar"
    Proficiency = Weapon.Simple
    Handling = Weapon.Light
    Grip = Weapon.SingleHanded(None)
    Finesse = true
    Damage = Roll (1, d6)
    DamageType = Slashing
    Usage = Weapon.Melee { Range = 5 }
    }

let shortbow = {
    Name = "shortbow"
    Proficiency = Weapon.Simple
    Handling = Weapon.Light
    Grip = Weapon.SingleHanded(None)
    Finesse = false
    Damage = Roll (1, d6)
    DamageType = Piercing
    Usage = Weapon.Ranged { ShortRange = 80; LongRange = 320 }
    }

let javelin = {
    Name = "javelin"
    Proficiency = Weapon.Simple
    Handling = Weapon.Normal
    Grip = Weapon.SingleHanded(None)
    Finesse = false
    Damage = Roll (1, d6)
    DamageType = Piercing
    Usage = 
        Weapon.Thrown ( 
            { Range = 5 }, 
            { ShortRange = 30; LongRange = 120 }
        )
    }

let goblin = {
    Name = "Goblin"
    HitDice = 2
    Size = Small
    CreatureType = Humanoid
    Alignment = Social.Neutral, Evil
    Protection = 
        Equipment { 
            Armor = Some Leather 
            Shield = true
            }
    Speed = 30
    Abilities = {
        Scores = {
            STR = 8
            DEX = 14
            CON = 10
            INT = 10
            WIS = 8
            CHA = 8
            }
        Bonuses = [ ]
        }
    Equipment = [ scimitar; shortbow ]
    Proficiency = Weapon.Simple
    }

let goblinBoss = {
    goblin with
        Name = "Goblin Boss"
        HitDice = 6
        Protection = Equipment { 
            Armor = Some ChainShirt 
            Shield = true
            }               
        Abilities = {
            goblin.Abilities with
                Bonuses = [
                    { Ability = STR; Bonus = 2 }
                    { Ability = CHA; Bonus = 2 }
                    ]
        }
        Equipment = [ scimitar; javelin ]
    }

goblin |> Monster.Attacks
(*
[(Melee {Range = 5;}, {Weapon = "scimitar";
                         Grip = SingleHanded;
                         HitBonus = 4;
                         Damage = Roll (1,D 6);
                         DamageBonus = 2;
                         DamageType = Slashing;});
   (Melee {Range = 5;}, {Weapon = "scimitar";
                         Grip = OffHand;
                         HitBonus = 4;
                         Damage = Roll (1,D 6);
                         DamageBonus = 0;
                         DamageType = Slashing;});
   (Ranged {ShortRange = 80;
            LongRange = 320;}, {Weapon = "shortbow";
                                Grip = SingleHanded;
                                HitBonus = 4;
                                Damage = Roll (1,D 6);
                                DamageBonus = 2;
                                DamageType = Piercing;})]
*)
goblinBoss |> Monster.Attacks
(*
[(Melee {Range = 5;}, {Weapon = "scimitar";
                         Grip = SingleHanded;
                         HitBonus = 5;
                         Damage = Roll (1,D 6);
                         DamageBonus = 2;
                         DamageType = Slashing;});
   (Melee {Range = 5;}, {Weapon = "scimitar";
                         Grip = OffHand;
                         HitBonus = 5;
                         Damage = Roll (1,D 6);
                         DamageBonus = 0;
                         DamageType = Slashing;});
   (Melee {Range = 5;}, {Weapon = "javelin";
                         Grip = SingleHanded;
                         HitBonus = 3;
                         Damage = Roll (1,D 6);
                         DamageBonus = 0;
                         DamageType = Piercing;});
   (Ranged {ShortRange = 30;
            LongRange = 120;}, {Weapon = "javelin";
                                Grip = SingleHanded;
                                HitBonus = 3;
                                Damage = Roll (1,D 6);
                                DamageBonus = 0;
                                DamageType = Piercing;})]
*)

This is almost right. We get the same results as the Monster Manual, except for the Goblin Boss Hit Bonus, which we over-estimate by 1 point in every single case. I think the source of the issue is probably the proficiency bonus; I assumed that the number of Hit Dice for a monster played the same role as the Level for an adventurer. This seems to work out in many cases, but I observed the same discrepancy for the Hobgoblin Captain, which also has 6 Hit Dice. I will leave the issue open for now - I still hope somehow that Hit Dice can be mapped to a proficiency bonus, just following a different scale from the one linking level to proficiency for adventurers.

Parting Words

I will stop here for today - you can find the code in current state here. We are not done with weapons and attacks, but this was a bit of a dense post, and I need to do some thinking on where to move from here.

Besides the issue mentioned above, there are a few challenges ahead. First, some monsters use “natural” attacks, such as Claws or Bite. This is similar to the natural armor issue we discussed in the previous post. While some creatures can choose which weapon to use, some others can’t - it would make no sense for a bear to drop their claws, and pick up a sword to fight. In other words, some creatures have the ability to carry and use equipment, and some do not. I am not sure how to represent this just yet.

Then, there are some gaps in our model. As an example, some magical weapons deal more than one type of damage, or deal additional damage to specific creatures. This suggests that a richer model for weapon damage is needed, perhaps with a list of conditions and the corresponding damage.

Finally, we ignored one aspect of the rules here. A Small creature using a Heavy weapon will make an attack roll at a Disadvantage. Advantage and Disadvantage should probably be incorporated in the model for dice rolls we fleshed out in our 3rd post. However, I didn’t feel ready to do so just yet. Given how pervasive dice rolls are in the game, before committing to any design change, I would like to explore more of the domain first, to get a better sense for how this might impact different areas.

In other words, we are far from done! As an intermediate goal, I hope to arrive to a representation of monsters that is good enough for me to simulate battles between various groups of adventurers and monsters, and evaluate how balanced different encounters are. So… stay tuned, more posts will be coming on the topic!

Give me Monsters! (Part 4)

2018-08-12T00:00:00+00:00

In our previous episode, we took at stab at modeling Hit Points, which lead us to exploring the representation of dice rolls as expressions. Today, we’ll relax a bit, and finish up the missing parts of the top section of the Monster description:

What are we missing at that point? The creature type (“small humanoid”), Alignment (“neutral evil”), the Armor Class, and Speed. Let’s add that in, and improve our Markdown renderer in the process.

The Low Hanging Fruits

But first, where were we? Our Monsters are currently represented by the following record type:

type Monster = {
    Name: string
    Size: Size
    HitDice: int
    Abilities: Abilities
    }
    // omitting members for brevity

Including Speed is straightforward - all we need is an additional label, Speed, of type int.

How about Alignment? A creatures’ alignment describes its attitude, on two different axes, which, as far as I can tell, don’t have a proper canonical name. A creature can be Good, Neutral or Evil, and it can be Lawful, Neutral or Chaotic. Any combination is possible, and the “Neutral-Neutral” combination is typically simply referred to as Neutral.

Choices between exclusive “or” options are a good hint that we will need some Discriminated Unions, aka sum types. I’ll name these 2 axes “Social” and “Moral”:

type Social = 
    | Lawful 
    | Neutral 
    | Chaotic 

type Moral = 
    | Good 
    | Neutral 
    | Evil 

A creatures’ alignment can be any combination of these two - this is a good fit for a Tuple, aka product type:

type Alignment = Social * Moral

I could also have used a Record here, something like type Alignment = { Social:Social; Moral:Moral }, which would arguably be a bit more explicit. I ended up keeping the Tuple, because the creation of an alignment ends up being a bit lighter: let alignment = Lawful, Good.

The creature description is (mostly) straightforward. Each creature belongs to one of a given set of Creature Types - again, a good case for a Discriminated Union:

type CreatureType = 
    | Aberration 
    | Beast 
    // omitted for brevity
    | Plant 
    | Undead 

Side note: I will ignore the Creature Tag for now (“goblinoid” in our example). It isn’t directly useful at that point, and I couldn’t figure out if there was a relationship between the Tag and the Creature Type, that is, whether there were any rules around what combinations are possible. A Goblinoid Plant doesn’t seem to make much sense :)

Armor Class

Almost there - the last missing piece is the Armor Class (aka AC), which describes how good a creature is at avoiding getting hit.

For Adventurers, the Armor Class depends on two things: Dexterity, and what Armor and/or Shield) is worn. As we can see in our Goblin example, the same general rules appear to apply to Monsters. However, the correspondence is only partial. Monsters come in different shapes, and some Monsters - say, a Bear - cannot wear an Armor or a Shield. Furthermore, looking through the Monster Manual, some Monsters without armor appear with either just an Armor Class number, with no further indication (for instance, a basic frog), or a Natural Armor (for instance, a boar).

This is guesswork, but my interpretation is that the first case describes a creature with no armor, following the same AC rules as an un-armored Adventurer, that is, 10 + DEX modifier, whereas the second describes creatures with natural defenses that provide a bonus in addition to their DEX modifier.

So how could we go about modeling this?

First, it looks like we have two different cases to handle: a Creature either can or cannot wear protective equipment. This smells like potentially another Discriminated Union. In the first case, they can wear one of the possible Armor types, and potentially a Shield. In the second case, they can have an AC bonus.

Let’s first list the canonical types of Armor available, as defined in the rules:

type Armor = 
    | Padded 
    | Leather 
    // omitted for brevity
    | Splint 
    | Plate 

… and then what the Creature wears:

type ProtectiveGear = {
    Armor: Armor option
    Shield: bool
    }

We use an Option for Armor, because a Creature doesn’t necessary wear Armor, even if they can. We’ll keep the Shield as a plain bool for now, because all we need to know is whether or not the creature wears one, which translates into a straight AC bonus.

Armed with this (sorry for the bad pun) we can now represent our two cases with a Discriminated Union:

type Protection = 
    | Natural of Bonus : int
    | Equipment of ProtectiveGear

We can at that point replicate the Armor Class calculations from the rules:

let armorClass protection dex =
    match protection with
    | Natural(bonus) -> 10 + dex + bonus
    | Equipment(gear) ->
        match gear.Armor with
        | None -> 10 + dex
        | Some(armor) ->
            match armor with
            | Padded -> 11 + dex
            | Leather -> 11 + dex
            | StuddedLeather -> 12 + dex
            | Hide -> 12 + min 2 dex
            // omitted for brevity
            | Plate -> 18
        |> match gear.Shield with
            | true -> (+) 2
            | false -> id

… and incorporate all that new information into our Monsters:

type Monster = {
    Name: string
    Size: Size
    CreatureType: CreatureType
    Alignment: Alignment
    Protection: Protection
    Speed: int
    HitDice: int
    Abilities: Abilities
    }
    with
    static member HitPoints (monster:Monster) = 
        monster.HitDice * hitPointsDice monster.Size
        + monster.HitDice * modifier monster.Abilities CON
    static member AC (monster:Monster) =
        armorClass monster.Protection (modifier monster.Abilities DEX)

Monster Stats to Markdown

Let’s see if we can update our Markdown rendering. We already have the Abilities block ready from episode 2 - let’s add the rest.

One way to look at the Monster description is as a sequence of sections/paragraphs. In Markdown, paragraphs breaks are denoted by a double space and a line break, so we could generate our document by creating a sequence of strings with Markdown formatting - the paragraphs - and concatenate them like this:

let paragraphs (blocks:string seq) = 
    blocks 
    |> String.concat "  \n"

[
    "This is paragraph one"
    "This is paragraph two"
]
|> paragraphs

All we need to do then is create a couple utility functions to handle formatting, and render each of the sections. We won’t go through all of the details (you can take a look at the code here), but will illustrate a couple of relevant pieces.

Let’s start the sheet with the Monster name formatted as a title, using title case:

[<RequireQualifiedAccess>]
module Markdown = 

    let textInfo = CultureInfo("en-US",false).TextInfo
    let titleCase (txt:string) = txt |> textInfo.ToTitleCase

    // omitted: abilities block, done in episode 2 

    let monsterSheet (monster:Monster) =
        [
            sprintf "# %s" monster.Name |> titleCase      

            monster.Abilities |> abilities 
        ]
        |> paragraphs

Let’s check that it works with our Goblin:

let goblin = {
    Name = "Goblin"
    HitDice = 2
    Size = Small
    CreatureType = Humanoid
    Alignment = Social.Neutral, Evil
    Protection = 
        Equipment { 
            Armor = Some Leather 
            Shield = true
            }
    Speed = 30
    Abilities = {
        Scores = {
            STR = 8
            DEX = 14
            CON = 10
            INT = 10
            WIS = 8
            CHA = 8
            }
        Bonuses = [ ]
        }
    }

goblin |> Markdown.monsterSheet

… which produces the following Markdown:

Goblin

STR	DEX	CON	INT	WIS	CHA
8	14	10	10	8	8
-1	+2	0	0	-1	-1

Progress! From there on, all we need is to incrementally add each of the pieces we want rendered. Let’s just take the Armor Class block, for illustration purposes. In our Goblin example, what we want is the following:

Armor Class 15 (Leather Armor, Shield)

We already have a function armorClass that will compute the AC value for a Monster, the only part missing is the equipment description. That part is a bit unpleasant if we want to faithfully replicate the Monster Manual formatting:

For natural armor, we only want to display something if there is a non-zero bonus,
For gear, we want to display the equipment as a comma-separated list, if there is equipment,
If there are any items to display, they should be capitalized and parenthesized.

Our solution is not particularly elegant, but it works. We will separate the rendering in 2 parts: first, generate a list of items we might have to display, then, format that list if it contains something.

let commaSeparated (blocks:string seq) = 
    blocks 
    |> String.concat ", "
    
let parenthesized (txt:string) = sprintf "(%s)" txt

// generate a list of the protective gear worn
let protectiveGear (gear:ProtectiveGear) =
    [
        match gear.Armor with
        | None -> ignore ()
        | Some(armor) ->
            yield
                match armor with
                | Padded -> "padded"
                | Leather -> "leather armor"
                // omitted for brevity
                | Plate -> "plate"
        if gear.Shield then yield "shield"    
    ]

let armorClass (monster:Monster) =
    let ac = Monster.AC monster
    let equipment = 
        // generate list of items to display, if any
        match monster.Protection with
        | Natural(bonus) -> 
            if bonus = 0 
            then [ ]
            else [ "natural armor" ]
        | Equipment(gear) -> protectiveGear gear
        // for a non-empty list, apply formatting
        |> function
        | [] -> ""
        | items -> 
            items 
            |> commaSeparated
            |> titleCase
            |> parenthesized
    sprintf "**Armor Class** %i %s" ac equipment 

We can now inject this into our monsterSheet function:

let monsterSheet (monster:Monster) =
    [
        sprintf "# %s" monster.Name |> titleCase      
        monster |> armorClass
        monster.Abilities |> abilities 
    ]
    |> paragraphs

The rest of the Markdown generation is more of the same - we won’t go into more details. Interested readers can check the code here. As for the result, this is how our Goblin gets rendered - we are getting somewhere:

Goblin

Small Humanoid, neutral evil
Armor Class 15 (Leather Armor, Shield)
Hit Points 7 (2d6+0)
Speed 30 ft.

STR	DEX	CON	INT	WIS	CHA
8	14	10	10	8	8
-1	+2	0	0	-1	-1

Parting Comments

I’ll leave it at that for this episode, but I wanted to make a couple of quick comments, because I am not 100% satisfied with the code, which I will probably have to revisit at a later point.

First, the model doesn’t cover some of the more obscure rules. Just to give two quick examples:

some creatures can be used as mounts, which can be outfitted with specific types of armor,
some creatures were unconventional armor, for instance, Frost Giants wear “Patchwork Armor” (Monster Manual, page 155).

The second issue is the more interesting of the two, in that it brings up the following question: a Discriminated Union is closed by design, so how do you go about handling potential extensions?

Then, the Armor Class model is incomplete. It would typically not be an issue for most monsters, but AC could also be modified by Magic Items. A Shield, or, even worse, an item that is neither Armor nor Shield (such as a Ring of Protection), could provide extra AC. In other words, we should refine our model, and attach additional properties to items carried by the Monster.

Speaking of carrying items, there is another notion missing from our model. A Creature could carry an item but not have it equipped. A reasonable example is a Shield; one could carry it, but choose not to equip it, so as to use a two-handed weapon. In the context of representing a Monster, it’s not a major issue, which is why we will leave it at that for now, but that’s also something we will likely revisit later, to better represent the disctinction between what one carries and what has currently equipped, as well as potential constraints on what can be equipped.

As a final thought, one piece I am not entirely happy with is the creation of a variant, by changing the armor of a base monster. Records make that process very easy (let variation = { original with // whatever changes }), and I couldn’t figure out a way to make anything as smooth around Protection, because of the Discriminated Union. If I want to, say, create a Goblin Boss from a Goblin, I have to fully specify his equipment, like so:

let goblinBoss = {
    goblin with
        Name = "Goblin Boss"
        Protection = Equipment { 
            Armor = Some ChainShirt 
            Shield = true
            }
        // omitted for brevity

It is not awful, but it is not pretty, either. I am not sure yet what to do about that one - suggestions welcome!

That’s it for today - you can find the current state of affairs described in this post here on GitHub. Where will the Adventure lead us next time? Nobody knows, not even I - so stay tuned :)

Give me Monsters! (Part 3)

2018-07-31T00:00:00+00:00

Now that we have a reasonably working Abilities block, let’s take a stab at a slightly more challenging section of the Stat Block, the Hit Points.

Hit Points represent the “life force” of a creature, so to speak. Mechanically, this is how much damage a creature can take until it dies, and is expressed in dice rolls (2d6 for a Goblin), and a default average number, if one doesn’t want to roll the dice (7 for a Goblin). What this means is that, when creating a Goblin, you could either give him 7 hit points, or roll and add 2 6-sided dice, which would result in hit points between 2 and 12.

Things can get a tad more complicated - for instance, Constitution influences hit points. A creature with high CON will get a bonus (more on this later), resulting in expressions likes 4d10+8, which translates to roll 4 10-sided dice, sum them, and add 8 to the result.

Beyond Hit Points, dice rolls play a central role in D&D, and show up everywhere (see for instance the Hit description for the Goblin’s Scimitar and Shortbow, under Actions). We need a reasonably general way to model them.

Dice Rolls

One fun aspect of D&D is its usage of uncommon dice shapes. Besides the iconic 20-sided dice, dice rolls involve 4, 6, 8, 10 and 12-sided dice.

Source: Scott Ogle / Wikimedia.

Side note: I will use “dice” for both singular and plural forms. My apologies to the purists!

The mechanical resolution of situations in D&D involves rolling different types of dice and adding them together, potentially in combination with numbers / modifiers, as in 4d6+2d10+8.

So how would we go about modeling that? First, we need dice:

type Dice = | D of Sides : int

We can now create dice of any type: let myD8 = D 8.

What we need next is a way to express formulas such as 4d6+2d10+8. Stated differently, we want to create expressions. Scanning through the way we previously described rolls, these involve either dice rolls or numbers, and can be combined by addition. That’s fairly straightforward:

type Roll = 
    | Roll of int * Dice
    | Value of int
    | Add of Roll list

We have now all we need to represent expressions like 4d6+2d10+8:

let example = Add [ Roll(4, D 6); Roll(2, D 10); Value 8 ]

We may be able to do better in terms of elegance, but our expressions aren’t too far off from what we intended to represent. And the nice thing about having expressions built using discriminated unions like this is that we can inspect and manipulate them in all sorts of ways, for instance, to render them:

type Roll = 
    | Roll of int * Dice
    | Value of int
    | Add of Roll list
    static member Render (roll:Roll) =
        match roll with
        | Roll(times,D(sides)) -> sprintf "%id%i" times sides
        | Value(value) -> sprintf "%i" value
        | Add(rolls) -> 
            rolls 
            |> List.map Roll.Render 
            |> String.concat "+"

Add [ Roll(4, D 6); Roll(2, D 10); Value 8 ] |> Roll.Render
// val it : string = "4d6+2d10+8"

We mentioned earlier that the average value of a roll was commonly used for Hit Points. That might come in handy in other situations, so let’s add that, too:

type Roll = 
    | Roll of int * Dice
    | Value of int
    | Add of Roll list
    static member Average (roll:Roll) =
        let rec average (roll:Roll) =
            match roll with
            | Roll(times,D(sides)) -> (times * (sides + 1)) / 2
            | Value(value) -> value
            | Add(rolls) ->
                rolls |> List.sumBy average
        average roll

Roll(2, D 6) |> Roll.Average
// val it : int = 7

Note: I am assuming here that all dice have a lowest possible value of 1

From a mathematical standpoint, this definition of the average is intriguing. A typical definition of the average gives 3.5 for a 6-sided dice. However, D&D is purely integers based, and rounds down by default, hence our implementation. As an interesting side-effect, average 2d6 is not equal to average 1d6 + average 1d6!

Prettier Dice Rolls

Compared to the way rolls appear in D&D, our expressions are a bit heavy-looking. The main reason is that, as a list can contain only items of one type, we cannot mix-and-match rolls and integers, which we have to wrap in Value.

Let’s make that prettier, and kill 2 birds with one stone (DEX ability check, difficulty Very Hard), by overloading the + operator. First, whenever we see a Roll before and after the + operator, we will concatenate the rolls into one Add [ ... ]:

type Roll = 
    | Roll of int * Dice
    | Value of int
    | Add of Roll list
    // omitted for brevity
    static member (+) (v1:Roll,v2:Roll) = 
        match v1,v2 with
        | Add(rolls1), Add(rolls2) -> Add(rolls1 @ rolls2)
        | Add(rolls1), roll2 -> Add(rolls1 @ [ roll2 ])
        | roll1, Add(rolls2) -> Add(roll1 :: rolls2)
        | roll1, roll2 -> Add [ roll1 ; roll2 ]

Roll(2, D 6) + Value 10 + Roll(4, D 10)
// val it : Roll = Add [Roll (2,D 6); Value 10; Roll (4,D 10)]

Progress! In the example above, can we get rid of Value 10, and simply use 10 instead? Sure, all we need is to wrap the integer into a Value:

type Roll = 
    | Roll of int * Dice
    | Value of int
    | Add of Roll list
    // omitted for brevity
    static member (+) (v1:Roll,v2:Roll) = 
        match v1,v2 with
        | Add(rolls1), Add(rolls2) -> Add(rolls1 @ rolls2)
        | Add(rolls1), roll2 -> Add(rolls1 @ [ roll2 ])
        | roll1, Add(rolls2) -> Add(roll1 :: rolls2)
        | roll1, roll2 -> Add [ roll1 ; roll2 ]
    static member (+) (roll:Roll,num:int) = roll + Value num
    static member (+) (num:int,roll:Roll) = Value num + roll

Roll(2, D 6) + 10 + Roll(4, D 10)
// val it : Roll = Add [Roll (2,D 6); Value 10; Roll (4,D 10)]

This looks pretty decent at that point, and I would normally stop there. However, I got curious and wondered if I could go a bit further, and simplify Roll(4, D 8) into 4*d8, which turned out to be easier than anticipated:

type Dice = 
    | D of Sides : int
    static member ( *) (times:int,dice:Dice) = Roll(times,dice)
and Roll = 
    | Roll of int * Dice
    | Value of int
    | Add of Roll list
    // omitted
    static member (+) (v1:Roll,v2:Roll) = 
        match v1,v2 with
        | Add(rolls1), Add(rolls2) -> Add(rolls1 @ rolls2)
        | Add(rolls1), roll2 -> Add(rolls1 @ [ roll2 ])
        | roll1, Add(rolls2) -> Add(roll1 :: rolls2)
        | roll1, roll2 -> Add [ roll1 ; roll2 ]
    static member (+) (roll:Roll,num:int) = roll + Value num
    static member (+) (num:int,roll:Roll) = Value num + roll

let d4 = D 4
let d6 = D 6
let d8 = D 8
let d10 = D 10
let d12 = D 12
let d20 = D 20

2 * d6 + 10 + 4 * d10 
// val it : Roll = Add [Roll (2,D 6); Value 10; Roll (4,D 10)]

Hit Points

We are now armed with a reasonable representation of dice rolls, time to go back to Hit Points!

I could not find a canonical formula describing how a monster hit points are computed. However, scanning through the Monster Manual, it turns out that empirically, all monsters follow a similar pattern:

Hit Points = multiplier * dice type + bonus.

The type of dice matches the creature Size, and the bonus is directly related to its CON modifier: bonus = CON modifier * multiplier.

This is somewhat consistent with the rules driving character Hit Points, which are computed by adding their CON modifier to a certain type of dice (determined by the Class), and multiplying by their Level. There are also assymmetries here: Monsters do not have a notion of Level, and, unlike Adventurers, the type of dice used is given by their race, and not their Class, which isn’t defined. There are also a few other differences (maximum hit points at level 1, rounding up in average hit points calculation). In other words, while the overall logic is similar, there doesn’t seem to be an obvious way to compute hit points for Monsters and Adventurers in a consistent manner.

At any rate, we have enough to create a model for a Monster Hit Points. First, we need to convert a Monster Size into the appropriate type of dice:

type Size = 
    | Tiny
    | Small 
    | Medium 
    | Large 
    | Huge 
    | Gargantuan

let hitPointsDice (size:Size) =
    match size with
    | Tiny -> d4
    | Small -> d6 
    | Medium -> d8
    | Large -> d10
    | Huge -> d12
    | Gargantuan -> d20

All that’s left to do is to create a type Monster, which will incorporate Abilities, and the additional information we need:

type Monster = {
    Name: string
    Size: Size
    HitDice: int
    Abilities: Abilities
    }
    with
    static member HitPoints (monster:Monster) = 
        monster.HitDice * hitPointsDice monster.Size
        + monster.HitDice * modifier monster.Abilities CON

We added a value HitDice, which plays the same role as Level for an Adventurer. We can now modify our example, and define monsters and variants along these lines, using Hobgoblins this time (Monster Manual, p186), to illustrate the impact of the CON modifier:

let hobgoblin = {
    Name = "Hobgoblin"
    HitDice = 2
    Size = Medium       
    Abilities = {
        Scores = {
            STR = 13
            DEX = 12
            CON = 12
            INT = 10
            WIS = 10
            CHA = 9
            }
        Bonuses = [ ]
        }
    }

let hobgoblinCaptain = {
    hobgoblin with
        Name = "Hobgoblin Captain"
        HitDice = 6
        Abilities = {
            hobgoblin.Abilities with
                Bonuses = [
                    { Ability = STR; Bonus = 2 }
                    { Ability = DEX; Bonus = 2 }
                    { Ability = CON; Bonus = 2 }
                    { Ability = INT; Bonus = 2 }
                    { Ability = CHA; Bonus = 4 }
                    ]
        }
    }

hobgoblin |> Monster.HitPoints
// val it : Roll = Add [Roll (2,D 8); Value 2]
hobgoblin |> Monster.HitPoints |> Roll.Average
// val it : int = 11
hobgoblinCaptain |> Monster.HitPoints
// val it : Roll = Add [Roll (6,D 8); Value 12]
hobgoblinCaptain |> Monster.HitPoints |> Roll.Average
// val it : int = 39

First, reassuringly, our results match the Monster Manual. This doesn’t prove the code correct, but at least it isn’t blatantly wrong. Then, it’s rather nice to see how, once we are past the initial effort of modeling rolls by creating our own expressions, everything starts to flow nicely. We can now express fairly clearly how Hit Points are computed (monster.HitDice * hitPointsDice monster.Size + monster.HitDice * modifier monster.Abilities CON), the hit dice changes from Hobgoblin to Hobgoblin captain automatically propagate into the computation, and anywhere we encounter rolls, we should be able to reuse what we wrote.

Anyways, that’s enough adventuring for one day! The current state of affairs described in this post is here on GitHub, let me know if you have questions or comments. Not sure yet what I’ll do in the next installment, we’ll see where the code leads us :)

Give me Monsters! (Part 2)

2018-07-25T00:00:00+00:00

Time to start creating monsters! We will begin with the Abilities section of the Stat Block.

First, what are Abilities? Every creature is described by 6 Ability Scores, which describe by a number from 1 to 20 (or possibly more) how able the creature is, across 6 dimensions:

STR (Strength)
DEX (Dexterity)
CON (Constitution)
INT (Intelligence)
WIS (Wisdom)
CHA (Charisma)

Ability scores have a dual usage: as raw scores, and as Ability Modifiers, which indicate a bonus or malus for that ability (see the rules for details). As an example, the Goblin has an INT score of 10, which is perfectly average and gives a modifier of 0; his DEX is 14, giving him a +2 bonus, and a CHA of 8, with a malus of -1.

We need to store 6 values, one for each Ability Score. That seems like a good case for a record:

type Scores = {
    STR: int
    DEX: int
    CON: int
    INT: int
    WIS: int
    CHA: int
    }

Modifiers

How would we go about getting the corresponding modifiers?

There are 2 parts to the problem: converting a score to a modifier, and getting the modifier for each ability. We could of course mechanically transcribe the rules, and convert along these lines:

let scoreToModifier (score:int) = 
    if score <= 1 then -5
    elif score <= 3 then -4
    elif score <= 5 then -3
    // more of it, omitted for brevity

This is a bit silly, however: there is a clear pattern here, with modifiers moving by 1 as scores move by 2. So instead, we’ll go for a compact, albeit perhaps less immediately readable version:

let scoreToModifier score = 
    (score / 2) - 5
    |> min 10
    |> max -5

As an aside, D&D conveniently uses the rule “always round down”, which happens to fit quite nicely with the way integer operations are handled in .NET.

To extract modifiers from Ability Scores, we would like to be able to request the modifier for any Ability. This sounds like a good case for a discriminated union:

type Ability = 
    | STR
    | DEX
    | CON 
    | INT 
    | WIS
    | CHA

Armed with this, all we need now is to write a function, which, given an Ability, will retrieve the correct score, and convert it to a modifier:

let modifier scores ability =
    match ability with
    | STR -> scores.STR
    | DEX -> scores.DEX
    | CON -> scores.CON
    | INT -> scores.INT 
    | WIS -> scores.WIS
    | CHA -> scores.CHA
    |> scoreToModifier

We can replicate the Goblin case now:

let goblin = {
    STR = 8
    DEX = 14
    CON = 10
    INT = 10
    WIS = 8
    CHA = 8
    }

modifier goblin STR // -1

Basic Markdown rendering

One of the reasons I want to create my own model of monsters, is to easily create cards for them, formatted the way I want. Let’s take a stab at that, formatting the Abilities using Markdown.

Using a table to display the Abilities seems reasonable; we would represent our Goblin along these lines:

STR | DEX | CON | INT | WIS | CHA
:---: | :---: | :---: | :---: | :---: |  :---:
8 | 14 | 10 | 10 | 8 | 8
-1 | +2 | 0 | 0 | -1 | -1

To achieve this, we need to iterate over the list of abilities, in a predictable order, extract and format the score and the modifier, and join them with a column separator, |. We’ll need a couple of small things here. First, we need a list to iterate on. Then, we cannot access the score for a specific Ability yet. Finally, we would like to be explicit about modifiers, and preprend a + sign in front of positive multipliers, for easier reading.

Let’s get to work. First, let’s write a score function, and refactor modifier accordingly:

let score scores ability =
    match ability with
    | STR -> scores.STR
    | DEX -> scores.DEX
    | CON -> scores.CON
    | INT -> scores.INT 
    | WIS -> scores.WIS
    | CHA -> scores.CHA

let modifier scores ability =
    ability
    |> score scores
    |> scoreToModifier

Let’s also define a canonical list of Abilities:

let abilities = [ STR; DEX; CON; INT; WIS; CHA ]

… and attack the markdown part:

[<RequireQualifiedAccess>]
module Markdown = 

    let signed (value) = 
        if value > 0
        then sprintf "+%i" value
        else sprintf "%i" value

    let abilities (scores:Scores) =
        [
            abilities 
            |> List.map (sprintf "%A") 
            |> String.concat " | "
            
            abilities 
            |> List.map (fun _ -> ":---:") 
            |> String.concat " | "
            
            abilities 
            |> List.map (score scores >> sprintf "%i") 
            |> String.concat " | "
            
            abilities 
            |> List.map (modifier scores >> signed) 
            |> String.concat " | "
        ]
        |> String.concat "  \n"

And we are done - we can now run this:

goblin |> Markdown.abilities

… which produces the following:

STR	DEX	CON	INT	WIS	CHA
8	14	10	10	8	8
-1	+2	0	0	-1	-1

Going a bit further

We have enough here to represent a creature’s abilities, and could stop here. However, the representation of an Adventurer or Monster by its abilities scores hides a small issue, namely that raw scores are sometimes modified by score bonuses.

Let me provide two examples. In the case of Adventurers, some races come with Ability Score Increases. For instance, any Elf will receive a +2 bonus on its DEX score. In the case of Monsters, it is common to create “variants” of a Monster by modifying their standard Ability Scores. For instance, one could create a “Goblin Boss” (Monster Manual, p166), which has a STR of 10 instead of 8, and a CHA of 10 instead of 8.

If we bake both the original score and the bonus together into the Ability Score, we loose some information which could be valuable when modifying a creature.

How could we avoid that? The approach I took was to separate explicitly these two parts, along these lines:

type ScoreBonus = {
    Ability: Ability
    Bonus: int
    }

type Abilities = {
    Scores: Scores
    Bonuses: ScoreBonus list
    }

let score abilities ability =
    let baseScore = 
        let scores = abilities.Scores
        match ability with
        | STR -> scores.STR
        | DEX -> scores.DEX
        | CON -> scores.CON
        | INT -> scores.INT 
        | WIS -> scores.WIS
        | CHA -> scores.CHA
    let bonuses = 
        abilities.Bonuses 
        |> List.sumBy (fun bonus -> 
            if bonus.Ability = ability 
            then bonus.Bonus 
            else 0)
    baseScore + bonuses 

This allows me then to do things like this, where I can define a Goblin Boss as “A Goblin, with a STR and CHA bonuses”:

let goblin = {
    Scores = {
        STR = 8
        DEX = 14
        CON = 10
        INT = 10
        WIS = 8
        CHA = 8
        }
    Bonuses = [ ]
    }

let goblinBoss = {
    goblin with
        Bonuses = [
            { Ability = STR; Bonus = 2 }
            { Ability = CHA; Bonus = 2 }
            ]
    }

In other words, I can now create a template for a canonical Monster, and create a variant, by specifying what changes should be applied to the original.

I will likely revisit this aspect of the model at a later point, because conceptually, there is something different about racial abilities and modified monsters. In the second case, I could apply any modification I want, whereas in the first, the bonus is set by the rules, and explicitly depends on the creature race. However, this will do for now, and we will leave it there!

If you want to take a look at the code in a more convenient manner, the current state of affairs is here on GitHub. Let me know if you have questions or comments, and next time, we’ll probably dig into Hit Points and modeling dice rolls and how to represent them as expressions!

Give me Monsters! (Part 1)

2018-07-23T00:00:00+00:00

I have been going through a bit of coding demotivation lately. Nothing dramatic, I simply did not feel like writing code, and most of my creative energy has gone into other activities, most notably Dungeons & Dragons (D&D in short).

And then, unexpectedly, I got excited again. Long story short, I take my new Dungeon Master duties seriously, and have been spending quite a bit of time preparing the campaign for my Adventurers. For those of you not familiar with D&D, the game works along these lines: a group of Adventures (the players) are immersed in a fictional universe (think Lord of the Rings), where they can decide to do whatever they please. One person plays the role of the Dungeon Master (or DM), responsible for the universe around them, constructing an (hopefully) engaging storyline, narrating events, reacting to the Adventurers’ choices and resolving their outcomes based on a fairly dense rule set.

So what does this have to do with programming?

In essence, D&D is about story-telling. However, keeping a story flowing while simultaneously making sure the rules are followed can be challenging. As a result, I have been digging deep in the manuals, trying to deconstruct them and get a good understanding of the underlying logic. Within that larger context, I have been thinking quite a bit about how to create fun encounters with monsters. I nearly wiped out my Adventurers within their first 30 minutes, because the monsters they encountered were too strong; I over-compensated later on, and gave them under-powered foes. Neither situation is satisfying: a good battle should be challenging, but, if the Adventurers make reasonable decisions, it should not be impossible to survive.

Preparing balanced encounters by hand is complex and tedious, so I started to wonder if I could encode the rules, to help me focus on the story part, without getting too bogged down by the mechanical aspects.

And, as I started playing with the idea, three things happened. First, I had fun coding again! Then, I realized that this was a rather interesting domain modeling problem, perhaps less far from conventional business modeling than it appears. And finally, other people seemed interested as well:

Because I really have nothing better to do with my life, I started coding the D&D monsters creation rules in F#. It's a fun - and non-trivial - domain modeling exercise!
— Mathias Brandewinder (@brandewinder) July 20, 2018

So… as I am just getting started on this, I figured I could just try and publicly document my efforts at modeling monster creation as I progress. I don’t know yet how the final result might look like, I will probably fumble along the way, but, in the spirit of Dungeons & Dragons, the fun is in the adventure iteself more than in its result, so… let’s do this!

Monster Stats Block

Where do we start? We won’t start in the traditional smoke-filled, dimly lit tavern as a starting point; instead we will focus on the monster stats block, which summarizes the description of a monster, from a mechanical standpoint:

Goblin Stat Block on the Roll20 Compendium

Every monster, in the canonical rules, is represented following that general structure. At a high level, the document is broken down in sections:

a minimal “verbal” description of the monster (“a goblin is a small humanoid, with an evil neutral Alignment”),
some combat-related characteristics (Armor Class, Hit Points and Movement),
the creature 6 Abilities,
a list of “skills” / characteristics, and a description of the monster danger level, the Challenge Rating (CR),
a separate list of “skills” (in this case Nimble Action),
a list of Actions that it can take in combat, typically attacks.

I used Bold here to denote terms that have a well-defined meaning in the rules, and “quotes” for terms I use loosely.

Let’s make a couple of comments here.

First, while every monster in the canon follows a similar structure, some parts differ slightly from monster to monster. As an example, the “skills” section for the Goblin lists Skills and Senses. Other monsters might include additional sections, such as Vulnerabilities, and might not include some others (Skeletons have no Skills listed, for instance).

Spotting irregularities is important when modeling a domain; assuming they are not mere accidents, they indicate something we are missing to understand the underlying model. Is there a reason for the irregularity here?

My interpretation is the following: every monster shares the same set of underlying “skill classes” (for the lack of a better word at that point). They all have a list of skills, senses, vulnerabilities and whatnot, but when a particular list is empty, rather than waste space rendering an empty list, the category is omitted altogether in the stat block. In other words, for a given monster, the stat block displays only the characteristics that differ from the norm, and omits everything else.

Similarly, while typically monsters only have Actions, some also have Reactions, and, presumably, Bonus Actions, in a fashion similar to Adventurers.

This is reasonable: after all, Adventurers and Monsters are both creatures living in the same world, governed by the same rules. What makes a hero or a monster is in the eye of the beholder. Practically, what this means is that if we are to reconstruct the rules that govern monsters, we will likely end up reconstructing the same rules used for character creation. Which brings up another irregularity: while players have a level, there is no such notion for monsters; Conversely, monsters have a Challenge Rating, with no equivalent for adventurers. What should we make of that?

What is the moral of the story so far? From our observation of stat blocks, which is a representation / projection of what we are interested in (the monster), we noted some irregularities in the structure. The stat block implicitly embeds the same rules used to create characters - which we will have to replicate - and highlights only the specific traits of each monster. To reconstruct the implicit ontology (if that words means what I believe it does!), we will have to inspect monsters as different as possible. There is also plenty of language ambiguity, as indicated by my use of “quoted text”. What appears to be sections in the document seem to mix and match elements of different nature, with no obvious name to bind them together.

Next time, we’ll begin diving into actual code; and, given the potentially problematic areas identified so far, we’ll start by the easier parts and warm up with the pieces that appear reasonably simple - namely, the Abilities section. If you want to take a sneak peak, you can already take a look at what’s in the repository at that point!

CNTK: études in F# (sequential models)

2018-01-14T00:00:00+00:00

In my previous post, I introduced CNTK and how to use it from F#, with some comments on how the .Net API design makes it unpleasant to work with. In this post, I’ll present one direction I have been exploring to address these, to build models by stacking up layers into sequential models.

Let’s start by taking a step back, and briefly explaining what a sequential model is. In our previous post, we stated that the purpose of CNTK was to learn parameters of a Function, to minimize the error observed between known input and output data. That Function is a model, which transforms an input (what we observe) into a output (what we want to predict). The example we used was a simple linear combination, but CNTK supports arbitrarily complex models, created by combining together multiple functions into a single one.

Sequential models are one specific way of combining functions into a model, and are particularly interesting in machine learning. Imagine that you are trying to recognize some pattern in an image, say, a cat. You will probably end up with a pipeline of transformations of filters, along the lines of:

Original Image: pixels -> Gray Scale -> Normalize -> Filter -> … -> 0 or 1: is it a Cat?

As an F# developer, this probably looks eerily familiar, reminescent of pipelining with the |> operator:

[ 1; 2; 3; 4; 5 ] 
|> List.map grayScale 
|> List.map normalize 
|> List.map someOtherOperation
...

Can we achieve something similar with CNTK, to make the creation of models by stacking transformation layers on top of each other? Let’s give it a try.

Composing Functions

Let’s look into how CNTK works, to understand better where the analogy works, and where it breaks down.

First, what we are after is the creation of a model, a CNTK Function that operates on a Variable input of a specific shape. So a model should be of type Variable -> Function.

In a perfect world, if functions in CNTK behaved the way they behave in F#, we could simply bolt them together by direct composition, as in function1 >> function2. However, the world is not perfect, and CNTK functions do not “return” anything, so that won’t do. However, CNTK lets us convert a Function to its output Variable, by explicitly creating a new variable, like so: new Variable(myFunction). In that frame, if we had two models foo : Variable -> Function and bar : Variable -> Function, we could compose them together along these lines:

let baz : Variable -> Function =
    fun input ->
        let valueOfFoo = new Variable(foo value)
        bar valueOfFoo

In other words, assuming that the shape of what foo computes is compatible with the shape bar expects as an input, we can compose them into a bigger model, which will take in the original input, and pass it through both functions. Progress.

Note: one difference with F# composition is that we have no type-checking on whether or not the functions can be composed. We are operating on one type, Variable, so as long as blocks conform to the signature Variable -> Function, they will compose. If the shapes happen to not match, we will get a runtime exception.

We are not entirely done, however. In my previous post, I voiced some gripes about the design choice to have DeviceDescriptor (what device the computation should run on) leaking everywhere. Any time you need to create a new Parameter for the model, a DeviceDescriptor that is consistent with the rest of the computation needs to be supplied.

For the sake of clarity, let’s consider an example model, slightly simplified from our previous post, where, given an input Variable that is expected to be a simple vector, we create a Parameter vector of same size, and return the product of the two:

let device = DeviceDescriptor.CPUDevice

let predictor (input:Variable) =
    let dim = input.Shape.[0]
    let weights = new Parameter(NDShape.CreateNDShape [dim], DataType.Double, 0.0, device, "weights")
    let product = CNTKLib.TransposeTimes(input, weights)

predictor is a model as previously defined - it takes a Variable and returns a Function. The issue here is that device is embedded in the weights. As a result, if we were to create and combine multiple models, we would have no guarantee that they use compatible devices. Furthermore, if we decided to run on a GPU instead of a CPU, we would have now to change the construction of our model. This is not satisfying: the model is just the specification of a mathematical computation, and should not care about devices. What I would like is a computation, which I can then direct to run on whichever device I please.

Can we solve that? We certainly can. In this case, I want a computation that, when directed to a device, will provide a function that can be run. All we need is a function that, given a device, will return a model. In other words, we can define a type Computation:

type Computation = DeviceDescriptor -> Variable -> Function

We can now define blocks of computations, which can be sequentially combined:

[<RequireQualifiedAccess>]
module Layer = 

    let stack (next:Computation) (curr:Computation) : Computation =
        fun device ->
            fun variable ->
                // compute output of current computation...
                let intermediate = new Variable(curr device variable)
                // ... and feed it to the next computation
                next device intermediate

What this allows us to do now is to define “standard computations” - common layers one would want to combine in a linear/sequential fashion - and stack then into a model, which, once provided a specific device, will be runnable:

let model : Computation = 
    computation1
    |> Layer.stack computation2
    |> Layer.stack computation3
    ...

Note: one issue with this approach is that we cannot optionally name the composed blocks. Unfortunately, things must be named at the moment they are instantiated in CNTK (as far as I can tell, you cannot rename a Function, Variable or Parameter once it exists). I couldn’t find a good solution for this yet.

Note: stack might not be the best choice of name, because it has a very specific meaning in machine learning. At the same time, compose seems overly generic - suggestions welcome.

Note: instead of |> Layer.stack, I could also create a custom operator. I have stayed away from that for a few reasons. First, if that function fits an existing operator, I would like to use the right one - but I don’t know if that is the case. Then, in general, my experience has been that operators tend to be initimidating. And finally, creating that operator should be a straightforward addition.

Illustration: MNIST Convolutional Neural Network

Let’s make this less abstract, by applying it to one concrete example, the C# example CNN model on the MNIST digit recognition problem.

I won’t attempt to explain in detail what each layer does, because this isn’t the main point here (see this page for a good overview). I will also leave some code details out, for the same reason. The entire code is available here, in the CNTK.Sequential.fsx and examples/MNIST-CNN.Seq.fsx files.

If you inspect the C# sample, you’ll notice that the prediction model combines a few operations:

Input scaling,
Convolution, using a Kernel and a number of output features,
Activation (ReLU),
Pooling, computing the Max value over a Window, using a Stride,
Dense layer, with a given number of neurons.

What we need then is to express each of these as a Computation, which is not overly complicated. Here are 2 examples, one trivial, one slightly less so:

[<RequireQualifiedAccess>]
module Activation = 

    let ReLU : Computation = 
        fun device ->
            fun input ->
                CNTKLib.ReLU(input)

[<RequireQualifiedAccess>]
module Conv2D = 
    
    type Kernel = {
        Width: int
        Height: int
        }

    type Conv2D = {
        Kernel: Kernel 
        InputChannels: int
        OutputFeatures: int
        Initializer: Initializer
        }

    let convolution (args:Conv2D) : Computation = 
        fun device ->
            fun input ->
                let kernel = args.Kernel
                let convParams = 
                    device
                    |> Param.init (
                        [ kernel.Width; kernel.Height; args.InputChannels; args.OutputFeatures ], 
                        DataType.Float,
                        args.Initializer)

                CNTKLib.Convolution(
                    convParams, 
                    input, 
                    shape [ 1; 1; args.InputChannels ]
                    )           

I can then use these “blocks” to define my model:

let network : Computation =
    Layer.scale (float32 (1./255.))
    |> Layer.stack (Conv2D.convolution 
        {    
            Kernel = { Width = 3; Height = 3 } 
            InputChannels = 1
            OutputFeatures = 4
            Initializer = Custom(CNTKLib.GlorotUniformInitializer(0.26, -1, 2))
        }
        )
    |> Layer.stack Activation.ReLU
    |> Layer.stack (Conv2D.pooling
        {
            PoolingType = PoolingType.Max
            Window = { Width = 3; Height = 3 }
            Stride = { Horizontal = 2; Vertical = 2 }
        }
        )
    |> Layer.stack (Conv2D.convolution
        {    
            Kernel = { Width = 3; Height = 3 } 
            InputChannels = 4 // matches previous conv output
            OutputFeatures = 8
            Initializer = Custom(CNTKLib.GlorotUniformInitializer(0.26, -1, 2))
        }
        )
    |> Layer.stack Activation.ReLU
    |> Layer.stack (Conv2D.pooling
        {
            PoolingType = PoolingType.Max
            Window = { Width = 3; Height = 3 }
            Stride = { Horizontal = 2; Vertical = 2 }
        }
        )
    |> Layer.stack (Layer.dense numClasses)

The syntax could be made even lighter, by supplying good default values for the parameter records. For instance, using:

Note: the syntax could be made a bit lighter, by supplying good default parameter records, and doing something like Layer.stack (Conv2D.convolution { defaultConv with OutputFeatures = 4 }).

I also made some other changes to the original example, to separate more cleanly between model specification and training, and hide some of the gory details. First, I define a specification:

let imageSize = 28 * 28
let numClasses = 10
let input = CNTKLib.InputVariable(shape [ 28; 28; 1 ], DataType.Float)
let labels = CNTKLib.InputVariable(shape [ numClasses ], DataType.Float)

let network : Computation =
    // omitted for brevity

let spec = {
    Features = input
    Labels = labels
    Model = network
    Loss = CrossEntropyWithSoftmax
    Eval = ClassificationError
    }

… and then I configure how to train that particular model on a dataset, specifying what device I want to use for training:

let ImageDataFolder = Path.Combine(__SOURCE_DIRECTORY__, "../data/")
let featureStreamName = "features"
let labelsStreamName = "labels"

let learningSource: DataSource = {
    SourcePath = Path.Combine(ImageDataFolder, "Train_cntk_text.txt")
    Streams = [
        featureStreamName, imageSize
        labelsStreamName, numClasses
        ]
    }

let config = {
    MinibatchSize = 64
    Epochs = 5
    Device = DeviceDescriptor.CPUDevice
    Schedule = { Rate = 0.003125; MinibatchSize = 1 }
    }

let minibatchSource = textSource learningSource InfinitelyRepeat

let trainer = Learner ()
trainer.MinibatchProgress.Add(basicMinibatchSummary)

let predictor = trainer.learn minibatchSource (featureStreamName,labelsStreamName) config spec
let modelFile = Path.Combine(__SOURCE_DIRECTORY__,"MNISTConvolution.model")

predictor.Save(modelFile)

Running that code will go through the entire process of creating a model, training it, and saving it. It works completely from the scripting environment in VS Code, takes less than 100 lines of code, and is, in my opinion, quite readable.

Parting notes

Some of the issues I voiced about the current design of the C# / .Net CNTK API (version 2.3.1) were that it was very low-level, didn’t make composition easy, and leaked low-level details such as what device to run on. In this post, I presented one of the directions I have been exploring, to

Compose layers / computation blocks into a sequential model, and
Separate model specification and training, deferring the decision of what device to target.

I consider the code a good sketch - some details need to be refined or improved still, and there are quite possibly some bugs. However, in its current state, it works, and is fairly usable, which is why I added it to master in the CNTK.FSharp repository. You can find the complete code here; the plumbing is in CNTK.Sequential.fsx, and the illustration example is in examples/MNIST-CNN.Seq.fsx.

What are the limits of this approach? As I see it, the main one is that not every model is sequential. For instance, the LSTM example is not going to fit. This approach does one thing nicely, but doesn’t help with composing more complex expressions.

In future posts, I will explore other potential directions. In the meanwhile, I’d love to hear your comments on this. Happy coding :)

Baby steps with CNTK and F#

2017-12-23T00:00:00+00:00

So what have I been up to lately? Obsessing over CNTK, the Microsoft deep-learning library. Specifically, the team released a .NET API, which got me interested in exploring how usable this would be from the F# scripting environment. I started a repository to try out some ideas already, but, before diving into that in later posts, I figure I could start by a simple introduction, to set some context.

First, what problem does CNTK solve?

Imagine that you are interested in predicting something, and that you have data available, both inputs you can observe (the features), and the values you are trying to predict (the labels). Imagine now that you have an idea of the type of relationship between the input and the output, something along the lines of:

labels ≈ function(features, parameters).

To make this more concrete, that function could be quite complex, and involve multiple layers of input transformation into the final output (“deep learning”), or it could be quite simple, for instance a traditional linear regression, something along the lines of:

car price ≈ car years * coefficient1 + car engine size * coefficient2 + constant.

In this particular case, we have 2 features (car years and car engine size), 1 label (car price), and 3 parameters (coefficient1, coefficient2 and constant) - and we would like to find “good” values for the 3 parameters so that the predicted value is in general close to the correct value.

The purpose of CNTK is to:

let you specify a function connecting input and output,
let you specify how to read example data to learn from,
learn good parameter values from the example data,
let you learn parameters on CPU or GPU, for large datasets and complex functions.

With that in mind, let’s take a look at a very basic example, a simple linear regression. Using CNTK here is complete overkill, and not worth the overhead; I would not use it for something that simple. Our goal here is simply to illustrate the basics of how CNTK works, from F#. In future posts, we will look into scenarios where CNTK is actually useful. As a secondary goal, I want to discuss some of the aspects that make building a nice F# API on top of the current .NET one tricky.

Loading CNTK into the F# scripting environment

First order of business: let’s load this thing into VS Code.

CNTK has a few packages on Nuget, based on what environment you want to run on. In our case, we will focus on a CPU-only scenario, using the CNTK.CPUOnly 2.3.1 package.

We assume that the Ionide-fsharp and Ionide-Paket extensions are installed in VS Code. Open the Folder where you want to work, and run the Paket: Init command (CTRL+SHIFT+P reveals the available commands). This will create a paket.dependencies file in the folder, where you can now specify what packages are needed, like this:

framework:net46
source https://www.nuget.org/api/v2
nuget CNTK.CPUOnly

Run Paket: Install next, and let Paket do its magic, and download the required packages. Once the operation completes, you should see a new folder, packages, with the following structure:

packages
  CNTK.CPUOnly
    lib
      net45
        x64
          Cntk.Core.Managed-2.3.1.dll
    support
      x64
        Debug
        Dependency
        Release

Let’s start creating the script we will be working with now, by adding an F# script file CNTK.fsx to our folder. Unfortunately, CNTK depends on a few native libraries to run properly. As a result, the setup is a bit more involved than the usual #r "path/to/library.dll. We’ll follow @cdrnet approach to load native libraries described here, and add to the PATH every folder that contains the dlls we need, so Cntk.Core.Managed-2.3.1.dll can find them:

Note: I put the full code used in the post on a gist here

open System
open System.IO

Environment.SetEnvironmentVariable("Path",
    Environment.GetEnvironmentVariable("Path") + ";" + __SOURCE_DIRECTORY__)

let dependencies = [
        "./packages/CNTK.CPUOnly/lib/net45/x64/"
        "./packages/CNTK.CPUOnly/support/x64/Dependency/"
        "./packages/CNTK.CPUOnly/support/x64/Dependency/Release/"
        "./packages/CNTK.CPUOnly/support/x64/Release/"    
    ]

dependencies 
|> Seq.iter (fun dep -> 
    let path = Path.Combine(__SOURCE_DIRECTORY__,dep)
    Environment.SetEnvironmentVariable("Path",
        Environment.GetEnvironmentVariable("Path") + ";" + path)
    )    

#I "./packages/CNTK.CPUOnly/lib/net45/x64/"
#I "./packages/CNTK.CPUOnly/support/x64/Dependency/"
#I "./packages/CNTK.CPUOnly/support/x64/Dependency/Release/"
#I "./packages/CNTK.CPUOnly/support/x64/Release/"

#r "./packages/CNTK.CPUOnly/lib/net45/x64/Cntk.Core.Managed-2.3.1.dll"
open CNTK

Creating a Function

We can now start using CNTK in our script. Let’s build a function that takes 2 floats as input, and returns a float as an output, multiplying each of the inputs by a parameter.

A core element in CNTK is the NDShape, for n-dimensional shape. Think of an NDShape as an n-dimensional array. A vector of size 5 would be an NDShape of dimension [ 5 ] (rank 1), a 12x18 image a NDShape [ 12; 18 ] (rank 2), a 10 x 10 RGB image a NDShape [ 10; 10; 3 channels ] (rank 3), and so on. In our case, the input is an array of size 2, and the output an array of size 1:

let inputDim = 2
let outputDim = 1
let input = Variable.InputVariable(NDShape.CreateNDShape [inputDim], DataType.Double, "input")
let output = Variable.InputVariable(NDShape.CreateNDShape [outputDim], DataType.Double, "output")

Which produces the following output:

val inputDim : int = 2
val outputDim : int = 1
val input = Variable
val output = Variable

Note how the numeric type of the Variable, DataType.Double, is passed in as a argument, and not generic. Note also how the numeric types are aligned with the C# convention; that is, a DataType.Double is an F# float, and a DataType.Float is an F# single.

We can ask a Variable about its shape, for instance input.Shape:

val it : NDShape = CNTK.NDShape { Dimensions = seq [2]; (* more stuff *) Rank = 1; }

Let’s create our Function now:

let device = DeviceDescriptor.CPUDevice

let predictor =
    let dim = input.Shape.[0]
    let weights = new Parameter(NDShape.CreateNDShape [dim], DataType.Double, 0.0, device, "weights")
    // create an intermediate Function
    let product = CNTKLib.TransposeTimes(input, weights)    
    let constant = new Parameter(NDShape.CreateNDShape [ outputDim ], DataType.Double, 0.0, device, "constant") 
    CNTKLib.Plus(new Variable(product), constant)

val device : DeviceDescriptor
val predictor : Function

A couple of comments here. Our predictor creates a named Parameter weights of dimension and type matching the input Variable, with values initialized at 0.0. We multiply the two shapes together, by calling CNTKLib.TransposeTimes, computing x1 * w1 + x2 * w2, which returns a Function. We then create another Parameter for our constant, and sum them up, using CNTKLib.Plus.

Note how we have to explicitly convert product into a Variable in the final step, using new Variable(product). CNTKLib.Plus (and the other functions built in CNTKLib) expects 2 Variable arguments. Unfortunately, a Function is not a Variable, and they do not derive from a common class or interface. The .NET API supports implicit conversion between these 2 types, which works well in C#, where you could just sum these up directly, like this: CNTKLib.Plus(product, constant). F# doesn’t support implicit conversion, and as a result, this requires an annoying amount of explicit manual conversion to combine operations together.

Note also how we passed in device, a DeviceDescriptor, to the Parameter constructor. A CNTK Function is intended to run on a device, which must be specified. In this case, we could have omitted the device, in what case it would have picked up by default CPU.

Working with CNTK Functions

Now that we have a Function - what can we do with it?

Unsuprisingly, we can pass input to a function, and compute the resulting value. We will do that next. However, before doing that, it’s perhaps useful to put things in perspective, to understand why this isn’t as straightforward as you might expect from something named a function. Once an F# function has been instantiated, its whole purpose is to transform an input value into an output value. The intent of a CNTK Function is subtly different: the objective here is to take a function, and modify its Parameters so that when passed in some input, the output it produces is close to some desired output, the Labels. In other words, we want a Function to be “trainable”: we want to be able to pass it known input/output pairs, and adjust the function parameters to fit the data better.

With that said, let’s evaluate our predictor function. To do that, we will need to do 3 things:

Supply values to fill in the “input” placeholder shape,
Specify what values we want to observe - we might be interested in the output, but also the weights, for instance,
Specify what device we want the function to run on.

Let’s do that:

open System.Collections.Generic

let inputValue = Value.CreateBatch(NDShape.CreateNDShape [inputDim], [| 3.0; 5.0 |], device)
let inputMap = 
    let map = Dictionary<Variable,Value>()
    map.Add(input, inputValue)
    map

let predictedOutput = predictor.Output
let weights = 
    predictor.Parameters () 
    |> Seq.find (fun p -> p.Name = "weights")
let constant = 
    predictor.Parameters () 
    |> Seq.find (fun p -> p.Name = "constant")
let outputMap =
    let map = Dictionary<Variable,Value>()
    map.Add(predictedOutput, null)
    map.Add(weights, null)
    map.Add(constant, null)
    map

predictor.Evaluate(inputMap,outputMap,device)

To evaluate a Function, we pass it the input we care about, a Dictionary<Variable,Value>, which we fill in with input, the Variable we defined earlier. We provide (completely arbitrarily) a value of [3.0;5.0] as an input value. In a similar fashion, we specify what we want to observe: the predicted value, predictor.Output, as well as the 2 named parameters we created, “weights” and “constant”, which we also retrieve from the Function itself. In this case, we set the Value to null, because we have no input to supply. Finally, we run predictor.Evaluate, which will take the inputMap and fill in the missing values in the outputMap.

We can now review the outputs:

let currentPrediction = 
    outputMap.[predictedOutput].GetDenseData<float>(predictedOutput) 
    |> Seq.map (fun x -> x |> Seq.toArray)
    |> Seq.toArray

let currentWeights = 
    outputMap.[weights].GetDenseData<float>(weights) 
    |> Seq.map (fun x -> x |> Seq.toArray)
    |> Seq.toArray

let currentConstant = 
    outputMap.[constant].GetDenseData<float>(constant) 
    |> Seq.map (fun x -> x |> Seq.toArray)
    |> Seq.toArray

This is not pretty, but… we have values.

val currentPrediction : float [] [] = [| [| 0.0 |] |]
val currentWeights : float [] [] = [| [| 0.0; 0.0 |] |] 
val currentConstant : float [] [] = [| [| 0.0 |] |] 

The values we get back are pretty unexciting, but at least they are what we would expect to see. Given that both weights and constant were initialized at 0.0, the function should produce a currentPrediction of 0.0 * 3.0 + 0.0 * 5.0 + 0.0, which is indeed 0.0.

Two quick notes here. First, because a value could be of any DataType, we have to manually specify a type when retrieving the values, as in GetDenseData<float>. Then, this is a very stateful model: when we fill in values for the input in the inputMap, we pass in the input instance we initially created to construct the Function. In a similar fashion, we are retrieving values from the instances we passed into the outputMap.

Training a model

This was pretty painful. So what is our reward for that pain?

As I stated earlier, one defining feature of a Function is that it can be trained. What we mean by that is the following: we can take a Function, supply it batches of input and desired output pairs, and progressively adjust the internal Parameter(s) of the Function so that the values computed by the Function become close(r) to the desired output.

Let’s start with a simple illustration. Suppose for a minute that, for our input [ 3.0; 5.0 ], we expected a result of 10.0. Currently, our weights and constant are set to 0.0. By modifying these 3 values, we should be able to tune our predictor to get an answer of 10.0.

This is, of course, a silly example. There are many ways I could change the parameters to produce 10.0 - I could set the constant to 10.0, or the second weight to 2.0, or infinitely many other combinations. To get something meaningful, I would need many different input/output pairs. However, we’ll start with this, strictly to illustrate the mechanics involved.

Training a Function involves 3 elements:

Supplying a batch of input / output pairs (features and labels),
Defining a measure of fit, that is, how to measure if a value is close to the desired value,
Specifying how parameters should be adjusted to improve the function.

let batchInputValue = Value.CreateBatch(NDShape.CreateNDShape [inputDim], [| 3.0; 5.0 |], device)
let batchOutputValue = Value.CreateBatch(NDShape.CreateNDShape [outputDim], [| 10.0 |], device)

let batch =
    [
        input,batchInputValue
        output,batchOutputValue
    ]
    |> dict

let loss = CNTKLib.SquaredError(new Variable(predictor), output, "loss")
let evaluation = CNTKLib.SquaredError(new Variable(predictor), output, "evaluation")

let learningRatePerSample = new TrainingParameterScheduleDouble(0.01, uint32 1)
let learners = 
    ResizeArray<Learner>(
        [
            Learner.SGDLearner(predictor.Parameters(), learningRatePerSample)
        ]
        )

let trainer = Trainer.CreateTrainer(predictor, loss, evaluation, learners)

for i in 0 .. 10 do
    let _ = trainer.TrainMinibatch(batch, true, device)
    trainer.PreviousMinibatchLossAverage () |> printfn "Loss: %f"
    trainer.PreviousMinibatchEvaluationAverage () |> printfn "Eval: %f"

First, we create a batch of input/output values ([ 3.0; 5.0 ] and [ 10.0 ]), and link them to the input and output Variable(s) we created. Then we define what measure we want to use to determine if a prediction is close or not from the target value. In this case, we use the built-in CNTKLib.SquaredError, which computes the square difference between the predicted value (new Variable(predictor)) and the target value (output). For instance, with the initial weights and constant, the predicted value will be 0.0, and we specified that the desired value was 10.0, so the loss function will evaluate to (0.0 - 10.0)^2, that is, 100.0 - and a perfect prediction of 10.0 would result in a loss of 0.0. Finally, without going into much detail, we specify in learners which strategy to apply when updating the function parameters. In this case, we use the built-in Stochastic Gradient Descent (SGD) strategy, with a learning rate of 0.01 (how aggressively to update the parameters) and a batch size of 1, using only one input/output pair at a time when performing adjustments.

We feed all that into a Trainer, and perform 10 updates (trainer.TrainMinibatch), using the same example input/output each time, and writing out the current value of the loss function:

Loss: 100.000000
Eval: 100.000000
Loss: 9.000000
Eval: 9.000000
// omitted intermediate results for brevity 
Loss: 0.000000
Eval: 0.000000
Loss: 0.000000
Eval: 0.000000

As you can observe, the prediction error decreases rapidly, from 100.0 initially (as expected), to basically 0.0 after only 10 steps.

Let’s make this a bit more interesting, by feeding different examples to the model:

let realModel (features:float[]) =
    3.0 * features.[0] - 2.0 * features.[1] + 5.0

let rng = Random(123456)
let batch () =        
    let batchSize = 32        
    let features = [| rng.NextDouble(); rng.NextDouble() |]
    let labels = [| realModel features |]
    let inputValues = Value.CreateBatch(NDShape.CreateNDShape [inputDim], features, device)
    let outputValues = Value.CreateBatch(NDShape.CreateNDShape [outputDim], labels, device)
    [
        input,inputValues
        output,outputValues
    ]
    |> dict

Here we simply create a “true” function, realModel, which we use to generate synthetic data. We then modify our previous example, to feed 1,000 different examples for training:

#time "on"

for _ in 1 .. 1000 do
    
    let example = batch ()
    trainer.TrainMinibatch(example,true,device) |> ignore
    trainer.PreviousMinibatchLossAverage () |> printfn "Loss: %f"

On my machine, extracting the weights and constant from the Function after training yields 3.0019, -1.9978 and 4.9975 - pretty close to the correct values of 3.0, -2.0 and 5.0 that we used in realModel.

Note: I put the full code used in the post on a gist here

Parting thoughts

First, I want to re-iterate that the example we went through is not showcasing a good example of where and how to use CNTK. It is intended primarily as an illustration of CNTK’s building blocks and how they work together. For a trivial linear regression example like this one (shallow learning, if you will), you would be better served with a standard library such as Accord.NET. CNTK becomes interesting if you have a deeper, more complex model, and a larger dataset - we’ll explore this in later posts.

As a side-note, my initial intent was to use real batches for the final example, passing in multiple examples at once, but for reasons I couldn’t figure out yet, the code kept crashing.

My second goal was to explore the design of the current .NET API, as a preliminary step before trying to build an F#-scripting friendly layer on top of it.

In its current state, the CNTK .NET library is fairly low-level, and rather unpleasant to work with from F#. Ideally, one would like to be able to create re-usable blocks and compose them easily, along the lines of the Keras model, using a DSL to, for instance, define a network by stacking standard transformation layers on top of each other.

Such a DSL seems quite possible to achieve in F#, but requires taking into account a few design considerations. First, the choice to use implicit conversion between Variable and Function makes composition of functions in F# painful. This choice is reasonable for C#, but requires re-wrapping every Function into a Variable to string operations together on the F# side.

One aspect I am not a fan of in the library is how the DeviceDescriptor leaks all the way down. With the current model, I could create 2 parameters, one on CPU, one on GPU, and combine them together, which doesn’t make a lot of sense. In an ideal world, I would like to define a Function independently of any device, and only then decide whether I want to train that model on a CPU or a GPU.

Finally, the fact that a Variable or a Function cannot be named after it was instantiated, as far as I can tell, introduces complications in composing blocks together. If naming was separate from instantiation, we could create a function like named : string -> Function -> Function, which could be inserted anywhere.

I haven’t had much time yet to dig into the data readers; so far, most of my efforts have gone into exploring possible directions to address the questions above. If you are interested, the master branch of my repository contains working, straight conversions of the C# examples published by the CNTK team; the results of my explorations can be found in the 3 branches experiment-varorfun, experiment-interpreter and experiment-stacking.

I hope you found something of interest in this post! If you have feedback or suggestions, I would be quite interested to hear about them :) In the meanwhile, I will keep exploring - expect more on the topic in the near future!

Notes from the San Francisco F# Dugnad

2017-12-15T00:00:00+00:00

We had our first ever F# Dugnad at the San Francisco F# meetup last week! The event worked pretty well, and I figured I could share some quick notes on what we did, what worked, and what could be improved.

The origin story for this event is two-fold. First, the question of how to encourage people to start actively contributing to open source projects has been on my mind for a while. My personal experience with open source has been roughly this. I have always wanted to contribute back to projects, especially the ones that help me daily, but many small things get in the way. I clone a project, struggle for a bit (“how do I build this thing?”), and after some time, I give up. I also remember being terrified when I sent my first pull request - this is a very public process, with the risk of looking foolish in a very public way.

The second element was me coming across the wonderful Dugnad tradition in Norway.

A Dugnad is an event that traditionally takes place twice a year. Everybody from the neighborhood gathers and fixes the communal space together for an afternoon - clean up a park, repaint, fix whatever needs fixing … - and enjoy drinks and hot-dogs afterwards. I love the idea: it directly improves the environment for everyone with little effort, it creates a sense of common ownership and responsibility, and it is a wonderful way for people from the same community to connect with each other.

This got me wondering whether transposing the idea to open source software could work. After all, open source is our community space, and getting together for a few hours to “fix the neighborhood” seemed like a reasonable idea.

Setup

The setup was pretty simple. We organized a meetup a Saturday afternoon, 13:00 to 17:00, so we would have enough time to actually get things done. The good people at @RealtyShares were kind enough to host us, with a comfortable meeting room with tables and power outlets, and even some tacos (writing code takes some fuel!).

Open source contributions as a group activity at the F# Dugnad yesterday with @dplattsf @foxyjackfox @sergeyz @Thuris @yankeefinn & Tracy, was a lot of fun :) Big thanks to @realtyshares for hosting! #fsharp pic.twitter.com/7hIZpA5Hl5
— Mathias Brandewinder (@brandewinder) December 10, 2017

We wanted to be able to jump right in, without getting lost trying to figure out what to work on during the Dugnad itself. To do that, we started discussions a couple of weeks early on, over our meetup Slack, asking people to propose projects, or, even better, specific issues they wanted to take on, submitting them in the comments section of the Meetup page.

Starting that discussion early on helped zoom in on realistic tasks to take on. It also resulted in people coming in better prepared, having already cloned projects and done some of the basics beforehand, or even discussed with project maintainers to get some input on what they had in mind, and what might be useful to work on.

The meeting itself was fairly straightforward. We had 8 attendees, we started with a quick round of introductions - who are you, and if you want to work on something specifically, tell us about it so others can help out. And then… we got to work, some of us individually, some of us in groups. We periodically asked around, to see where everybody was at, and if anyone could help.

And then we went for drinks :)

Results

My informal hope was that each of us would have one pull request by the end of the day. I can’t swear everyone got one in, but I know a few were made.

I ended up teaming up with @Thuris and @sergeyz, and we worked on XPlot. It’s a library I use quite a bit; it allows you to create charts on-the-fly directly from the F# scripting environment, and pop them in the browser.

What we worked on was the documentation, which I suspected was unfriendly to beginners. As a first step, I challenged my 2 team-mates to create a basic histogram as quickly as possible, following the documentation, while I was sadistically watching them struggle and taking notes on the stumbling blocks. I’ll put it that way - this was painful to watch.

Based on that experience, we wrote a small tutorial. The goal is to have a fail-safe example, going from zero to seeing an actual chart in the browser, under 5 minutes flat. Our pull request is nothing earth shattering, but I hope it will help people coming to the library quickly get a sense for how to use it, and what to expect from it. Also, it was a lot of fun working with that team :)

Parting thoughts

Having a Slack channel up was quite helpful to exchange links or code snippets. One suggestion was to create a channel in the fsharp.org Slack.
Some groups forked the repositories into our Meetup github organization, and used that as a shared space to work together. The practical benefits are limited, but symbolically it was a nice way to signal that this was the collective work of a group.
Having multiple people in the same room ended up being super helpful in unblocking others. In a group of 8, chances are someone knows how to solve the problem you are struggling with.
Working in teams was very effective in getting newcomers over the stress of the first contribution, and demystifying the whole thing.
The simple fact that each of us had blocked 4 hours dedicated to that particular task helped; It makes it much less likely to just give up and do something else.
Saturday is a bit of a constraint. On the other hand, it takes time to get up to speed, and getting a group to code for a few hours during a weekday evening seems difficult.
“When do we do it again” came up immediately after we finished. That session ended up being a great warm-up, and people are now comfortable with the projects and ready to make more “serious” contributions.

Long story short: this was a lot of fun, and we will do it again! The current idea is to have these on a quarterly basis, with possibly smaller ones in between during a weekday evening. I encourage other user groups to try it out, and, perhaps one day, we can organize a worldwide F# Dugnad… In the meanwhile, if you have comments or questions, ping me!

Azure Functions tip: working locally with F# Scripts

2017-06-01T00:00:00+00:00

I have been working with Azure Functions quite a bit lately. As a result, with more and more functions to develop and maintain, figuring out what a sane workflow might look like has gained some urgency. This post is not particularly deep, and is intended mainly as notes on things I have been trying out to get a decent local development experience with Azure Functions using F# scripts.

First, what is the problem?

While the development experience of Azure Functions in the Azure portal is decent, given the constraints, this is clearly not acceptable for anything beyond work “in the small”. What works for a small script quickly becomes painful for larger function apps: the editor is slow, offers limited support (no Intellisense…), and the workflow ends up being essentially “try out code and hope it works”, with no source control.

What we really want is, not that: we want a decent editor, and the ability to run code locally before committing it to source control and shipping it.

The first two step towards that direction is to use one of the supported continuous deployment options, and the Azure Functions command line tools (CLI).

The continuous deployment part is straightforward, with numerous options available: once the setup is complete, any time code changes are pushed to GitHub (for instance), they are automatically deployed to the Function App. Once that is done, we have code that we can edit locally. Progress.

However, we cannot run that code locally - yet. This is where the CLI tools come in. While slightly out of date, the following post provides a good walkthrough. With the CLI, you can create a scaffold locally for the various out-of-the-box trigger templates, matching what you would get in the portal, and you can run them locally, against a local server running on your machine.

Side note: the CLI tools are now azure-functions-core-tools on npm.

Side note: I am using Azure Functions Core Tools (1.0.0-beta.97). As hinted in the name, this is beta, with the corresponding expectation that things may change.

At that point, you can edit the code in whatever editor you fancy, save it, run it locally, and push to GitHub when you are satisfied. More progress.

So what is wrong, then?

The problem at that point is that, if you open your script in your editor, it is entirely broken. Let’s illustrate on a trivial case, and create an F# http trigger function from the command line:

mkdir demofunction
cd demofunction
func init
func new

Pick F#, HttpTrigger, and name that function http. At that point, the scaffold has been created for you:

… and you can run that function locally:

func run http -c "{\"name\": \"foo\"}"

Side note: make sure that NuGet.exe is in your PATH, otherwise it seems the function might have trouble restoring packages it depends upon.

In other words, everything works. But if you open the file run.fsx, the F# script that contains the code we are running, a sad sight awaits you:

Our script is broken. Based on our imports, the TraceWriter type is unrecognized, and so is req.GetQueryNameValuePairs(). This is displeasing, aesthetically and practically. We are left with no IntelliSense again, and we cannot run that script in the F# interactive.

Side note: I am aware that Visual Studio tooling has been improving fast. Nothing against Visual Studio, but I’d like to make sure I can run my code without relying on it, so my goal here will be to run everything from Code.

The issue here is that Azure Functions magically loads a bunch of assemblies behind the scenes when running a function. The upside is obvious: we don’t need to deal with those pesky plumbing details when writing a function, and can focus on what we want the function to do instead. The downside is that without more information about how the magic works, the script isn’t self-contained.

Can we fix that? Clearly, the CLI has no problem running the code, so these magic dependencies must be somewhere on our machine.

After a bit of speleology, I found where all of this was hidden. In your user profile (in my case, C:/Users/Mathias/AppData/Roaming/), you should find the following folder:

...Roaming/npm/node_modules/azure-functions-core-tools/bin/

… which contains all the “magic” dependencies:

Given that information, we can easily straighten up our run.fsx script:

#if INTERACTIVE

open System

#I @"C:/Users/Mathias/AppData/Roaming/npm/node_modules/azure-functions-core-tools/bin/"

#r "Microsoft.Azure.Webjobs.Host.dll"
open Microsoft.Azure.WebJobs.Host

#r "System.Net.Http.dll"
#r "System.Net.Http.Formatting.dll"
#r "System.Web.Http.dll"
#r "Newtonsoft.Json.dll"

#else

#r "System.Net.Http"
#r "Newtonsoft.Json"

#endif

// rest of the original script unchanged afterwards 
open System.Net
open System.Net.Http
open Newtonsoft.Json

This isn’t particularly elegant or clever, but it does the job. The original script hasn’t changed, but we can now take the entire script, and run it through the F# interactive.

Side note: the reason I ended up with this slightly complicated setup, using 2 branches #interactive and #else, was to address some version compatibility between the dlls that were loaded.

As an example, we can, for instance, bypass the CLI, and test out our Run function entirely locally.

We create a fake TraceWriter first:

type Log (level) =
    inherit TraceWriter(level:System.Diagnostics.TraceLevel)
    new () = Log(Diagnostics.TraceLevel.Verbose)
    override this.Trace(event) = printfn "%A" event

… which allows us to create a request, send it to the Run function, and check whether it does what we expect:

let req = new HttpRequestMessage(HttpMethod.Post,Uri("http://www.example.com"))
req.Content <- new StringContent("{\"name\":\"FSI\"}")
req.SetConfiguration(new Web.Http.HttpConfiguration())

let log = Log()

Run(req,log) 
|> fun resp -> resp.Content.ReadAsStringAsync() 
|> Async.AwaitTask 
|> Async.RunSynchronously

… which produces the following:

06/01/2017 11:44:50 Info F# HTTP trigger function processed a request.  
val it : string = ""Hello FSI""

How about NuGet packages, then?

In the same vein as when you work from the portal, you can add NuGet dependencies by editing the project.json file, like this:

{
  "frameworks": {
    "net46":{
      "dependencies": {
        "FSharp.Interop.Dynamic": "3.0.0",
        "FSharp.Data": "2.3.3"
      }
    }
  }
}

Running the function through the CLI will trigger a NuGet package restore. The same trick can then be used to reference the packages, with one difference. Instead of going alongside the default dependencies, they are downloaded into (in my case) C:\Users\Mathias\.nuget\packages. You can find out that location by checking the end of the project.json.lock file, which should contain something like:

  "packageFolders": {
    "C:\\Users\\Mathias\\.nuget\\packages": {}
  }
}

That’s where I will stop on the topic for today. Two quick things before closing:

First, I recommend taking a look at this blog post by Krzysztof Cieslak, where he explores a different direction to address similar questions, essentially bypassing the project.json mechanism, and relying on Paket instead to manage dependencies. I tried to stay as close as possible of the original approach followed by the Azure Functions team, but his take opens up interesting possibilities.

Then, even though I am a big fan of scripts in general, I tend to use them primarily in the small. At some point, once your code base grows, you are better off having a “real” project. In that frame, I am currently exploring pre-compiled F# functions as an alternative to scripts - more on this soon, probably :)

Hope you found something useful or interesting in this post! And, if you have comments or ideas on this topic, I’d love to hear about it. In the meanwhile… happy coding!

Creating an Azure Functions solution diagram

2017-04-01T00:00:00+00:00

One aspect of Azure Functions I found intriguing is that each function contains both its code, and a description of the environment it is expecting to run in, contained in its function.json file. What’s interesting about this, is that as a result, scanning a function app (a collection of functions) provides a fairly complete self-description of the application and its environment, which we should be able to visualize.

In this post, we’ll explore that idea, and sketch out an approach to automatically generate diagrams, visualizing bindings and code dependencies for a code base. We will only support a subset of the full functionality available in Azure Functions, mainly because we are lazy, and create graphs such as the one below, using F# and GraphViz.

Anatomy of an Azure Function App

Let’s start first with the information we have available. A typical Azure Function App is structured along these lines:

Application
|_ /foo
   FooCode.fsx 
   function.json
|_ /bar
   BarCode.csx
   function.json
   project.json

What we have here is a function app that comprises two functions, foo and bar, identified by their containing folder name. Inside each function folder, we’ll find some code files, exactly one function.json file describing the function bindings, and possibly a project.json file listing package dependencies.

How does a function.json look like? Here is a slightly simplified version from @fsibot:

{
  "bindings": [
    {
      "type": "timerTrigger",
      "name": "timer",
      "schedule": "0 */2 * * * *",
      "direction": "in"
    },
    {
      "type": "blob",
      "name": "previousID",
      "path": "incontainer/lastid",
      "connection": "fsibotserverless_STORAGE",
      "direction": "in"
    },
    {
      "type": "queue",
      "name": "mentionsQueue",
      "queueName": "mentions",
      "connection": "fsibotserverless_STORAGE",
      "direction": "out"
    }
  ],
  "disabled": false
}

The bindings describe how the function interacts with the environment. Each binding has a type (what type of resource is involved), a name (how the resource appears as a named argument in the function), and a direction (in or out). One of the bindings is a Trigger (causing the function to run), identified by a type ending with Trigger, as in timerTrigger. Finally, depending on the type of resource, additional information is provided, for instance a queue name and storage account connection.

Similarly, what NuGet packages a function uses is described in a project.json file, which looks along these lines:

{
  "frameworks": {
    "net46":{
      "dependencies": {
        "linqtotwitter": "4.1.0",
        "Newtonsoft.Json": "9.0.1"
      }
    }
  }
}

The end goal

So what we want to do here is extract out the information we care about, to create a GraphViz file that we can then process to produce a nice visualization.

GraphViz uses a simple format to represent graphs, which can then be rendered using various graph layout models. A GraphViz model comprises nodes and edges. In our case, we have 3 types of nodes (functions, bindings and packages), and directed edges, representing the direction of the relationship. We also want to distinguish between Triggers and basic in bindings.

Rather than going into a lengthy explanation, I’ll provide an example illustrating what we are after, which should be self-explanatory:

digraph app {
  // functions nodes
  node [shape=circle,style=filled,color=yellow]
    "foo"
    "bar"
  // bindings nodes
  node [shape=box,style=filled,color=orange]
    "Timer"
    "Queue myQueue"
  // packages nodes
  node [shape=box,style=filled,color=lightblue]
    "awesome.library 1.2.3"
  // triggers edges
  edge [ style=bold ]
    "Timer" -> "foo" [ label="timer" ]  
    "Queue myQueue" -> "bar" [ label="inputmessage" ]
  // bindings & functions edges
  edge [ style=solid ]
    "foo" -> "Queue myQueue" [ label="outmessage" ]
  // packages edges
  edge [ style=dotted ]
    "awesome.library 1.2.3" -> "foo"
}

I can then simply take this file, and run it through GraphViz, to generate a graph. For instance, dot "graph-file-path" -Tpng -o "output-file-path.png" produces the .png chart we presented earlier on:

Extracting the functions

I will assume here that we have a local clone of the Function App, and will use fsibot-serverless as an example.

In that case, all we need to do is iterate over the directories. If a directory contains a function.json file, it is a function, named after the folder.

open System.IO

let candidates root = 
    root
    |> Directory.EnumerateDirectories
    |> Seq.filter (fun dir ->
        Directory.EnumerateFiles(dir)
        |> Seq.map FileInfo
        |> Seq.exists (fun file -> file.Name = "function.json")
        )
    |> Seq.map DirectoryInfo

Let’s try that out on our example:

let root = @"C:/Users/Mathias Brandewinder/Documents/GitHub/fsibot-serverless/"
let functions = 
    candidates root 
    |> Seq.iter (fun dir -> printfn "%s" dir.Name)

>
check-mentions
follow-users
process-mention
send-tweet

It appears that we are in business.

Extracting out the bindings from JSON

Now that we have folders that correspond to a function, let’s extract the bindings from the function.json file. There are 2 parts to the task: grabbing data from a JSON file, and transforming it into some representation for bindings we can work with reasonably easily.

We will limit ourselves to a small subset of the available bindings, and explicitly handle only Timers, Queues and Blobs.

Every binding can be decomposed into 2 parts. We always have 3 properties, name, type and direction, and, depending on the specific resource, we have some additional information available.

We will represent that in a rather straightforward manner:

type Direction =
    | Trigger
    | In
    | Out

type Properties = Map<string,string>

type Binding = {
    Argument:string
    Direction:Direction
    Type:string
    Properties:Properties
    }
    with member this.Value key = this.Properties.TryFind key

A binding can be only one of 3 things: a trigger, an in- or an out-bound binding. This is a natural fit for a Discriminated Union, Direction. Each Binding will contain the three fields that are guaranteed to be present, and we will store all the extra information as key-value pairs in a Map, associating the property name and its value as strings.

All we need to do then is parse the function.json file and create an array of bindings. For that purpose, we’ll use the JSON parser from FSharp.Data:

#I "./packages/"
#r "FSharp.Data/lib/net40/FSharp.Data.dll"

open FSharp.Data
open FSharp.Data.JsonExtensions

let bindingType (``type``:string, dir:string) =
    if ``type``.EndsWith "Trigger"
    then 
        Trigger, ``type``.Replace("Trigger","")
    else 
        if (dir = "in") then In, ``type``
        elif (dir = "out") then Out, ``type``
        else failwith "Unknown binding"

let extractBindings (contents:string) =
    contents
    |> JsonValue.Parse
    |> fun elements -> elements.GetProperty "bindings"
    |> JsonExtensions.AsArray
    |> Array.map (fun binding -> 
        // retrieve the properties we care about
        let ``type`` = binding?``type``.AsString()
        let direction = binding?direction.AsString()
        let name = binding?name.AsString()
        // retrieve the "other" properties
        let properties = 
            binding.Properties
            |> Array.filter (fun (key,value) -> 
                key <> "type" && key <> "name" && key <> "direction")
            |> Array.map (fun (key,value) -> key, value.AsString())
            |> Map
        // detect the direction and type
        let direction, ``type`` = bindingType (``type``,direction)
        // create and return a binding
        {
            Type = ``type``
            Direction = direction
            Argument = name
            Properties = properties
        }
        )

Let’s test that out, on one of the more involved function.json files from fsibot-serverless - which produces the following:

val bindingsExample : Binding [] =
  [|{Argument = "timer";
     Direction = Trigger;
     Type = "timer";
     Properties = map [("schedule", "0 */2 * * * *")];};
    {Argument = "previousID";
     Direction = In;
     Type = "blob";
     Properties =
      map
        [("connection", "fsibotserverless_STORAGE");
         ("path", "incontainer/lastid")];};
    // omitted for brevity

Everything appears to be working so far - let’s move on.

Parsing out package dependencies

Parsing out packages isn’t much more complicated. First, we’ll create a type for Packages:

type Package = {
    Name:string
    Version:string
    }

… and drill into the contents of project.json until we find what we need:

let extractDependencies (contents:string) =

    contents
    |> JsonValue.Parse
    |> fun elements -> elements.GetProperty "frameworks"
    |> fun elements -> elements.GetProperty "net46"
    |> fun elements -> elements.GetProperty "dependencies"
    |> fun elements -> elements.Properties
    |> Array.map (fun (package,version) -> 
        { 
            Name = package 
            Version = version.AsString()
        }
        )

Let’s make sure that this works, on one of the fsibot examples:

val dependenciesExample : Package [] =
  [|{Name = "linqtotwitter";
     Version = "4.1.0";}; {Name = "Newtonsoft.Json";
                           Version = "9.0.1";}|]

Done!

Extracting the Function App graph

At that point, we have all the pieces we need: from a directory, we can extract all the potential functions, their bindings, and the packages they depend upon. All we need to do now is generate a file that follows the format GraphViz expects, and we are done.

We create a simple type to store all the information we care about in a function app, and go to town:

type AppGraph = {
    Bindings: (string * Binding) []
    Dependencies: (string * Package) []
    }

let extractGraph (root:string) =

    let functions = candidates root

    let bindings = 
        functions
        |> Seq.map (fun dir ->
            let functionName = dir.Name
            Path.Combine (dir.FullName,"function.json")
            |> File.ReadAllText
            |> extractBindings
            |> Array.map (fun binding -> 
                functionName, binding)
            )
        |> Seq.collect id
        |> Seq.toArray

    let dependencies = 
        functions
        |> Seq.map (fun dir ->
            let functionName = dir.Name
            let project = Path.Combine (dir.FullName,"project.json")
            if File.Exists project
            then
                project
                |> File.ReadAllText
                |> extractDependencies
                |> Array.map (fun package -> 
                    functionName, package)
            else Array.empty
            )
        |> Seq.collect id
        |> Seq.toArray

    {
        Bindings = bindings
        Dependencies = dependencies
    }

Given a root folder, we identify all possible functions, and then proceed to extract two lists of pairs, one for bindings, associating a function name and a binding, and one for dependencies, associating a function name with a package.

Rendering the Function App graph

All we have left to do now is going over the data in an AppGraph, and creating a GraphViz file, containing 3 types of nodes (functions, bindings and packages), and 4 types of edges (triggers, in and out bindings, and dependencies).

GraphViz maps nodes and edges by name, so we want to make sure our names are consistent; for safety, we also want to make sure all names are surrounded by quotes, to avoid name parsing issues for GraphViz. Let’s create first a couple of utility functions:

let quoted (text:string) = sprintf "\"%s\"" text
let indent = "    "

let bindingDescription (binding:Binding) =
    match binding.Type with
    | "timer" -> "Timer"
    | "queue" -> "Queue " + (binding.Properties.["queueName"])
    | "blob" -> "Blob " + (binding.Properties.["path"])
    | _ -> binding.Type
    |> quoted

let packageDescription (package:Package) =
    sprintf "%s (%s)" package.Name package.Version
    |> quoted

let functionDescription = quoted

We can now create, for instance, the function nodes:

let renderFunctionNodes format (graph:AppGraph) =
    let functionNames = 
        graph.Bindings
        |> Seq.map (fst >> functionDescription)
        |> Seq.distinct
    Seq.append
        [ format ]
        functionNames 
        |> Seq.map (fun name -> indent + name) 
    |> String.concat "\n"

Nothing particularly elegant here - we pickup unique function names from the bindings we identified, format them consistently, and pre-pend formatting information for these nodes (the node [shape=circle,style=filled,color=yellow] in our earlier example).

I’ll skip the rendering of the other nodes, which follows exactly the same pattern.

In a similar fashion, we create the edges between triggers and functions:

let renderTriggers format (graph:AppGraph) =
    let triggers =
        graph.Bindings
        |> Seq.filter (fun (_,binding) -> binding.Direction = Trigger)
        |> Seq.map (fun (fn,binding) -> 
            sprintf "%s -> %s [ label = %s ]" 
                (bindingDescription binding)
                (functionDescription fn)
                (binding.Argument |> quoted)
            )
        |> Seq.distinct

    Seq.append
        [ format ]
        triggers 
        |> Seq.map (fun name -> indent + name) 
    |> String.concat "\n"

… and all we have to do now is fill in a template to create a nicely formatted GraphViz file:

type GraphFormat = {
    FunctionNode:string
    BindingNode:string
    PackageNode:string
    Trigger:string
    InBinding:string
    OutBinding:string
    Dependency:string
}

let renderGraph (format:GraphFormat) (app:AppGraph) =
    let functionNodes = renderFunctionNodes format.FunctionNode app
    let bindingrNodes = renderBindingNodes format.BindingNode app
    let packageNodes = renderPackageNodes format.PackageNode app
    let triggers = renderTriggers format.Trigger app
    let ins = renderInBindings format.InBinding app
    let outs = renderOutBindings format.OutBinding app
    let dependencies = renderDependencies format.Dependency app

    sprintf """digraph app {
%s
%s
%s    
%s
%s
%s    
%s    
}""" functionNodes bindingrNodes packageNodes triggers ins outs dependencies

Illustration: fsibot-serverless

So how well does this work? Let’s try it out on fsibot-serverless. First, we’ll create a format for the graph:

let graphFormat = {
    FunctionNode = "node [shape=doublecircle,style=filled,color=orange]"
    BindingNode = "node [shape=box,style=filled,color=yellow]"
    PackageNode = "node [shape=box,style=filled,color=lightblue]"
    Trigger = "edge [ style=bold ]"
    InBinding = "edge [ style=solid ]"
    OutBinding = "edge [ style=solid ]"
    Dependency = "edge [ arrowhead=none,style=dotted,dir=none ]"
    }

… and then proceed with the full analysis:

let root = @"C:/Users/Mathias Brandewinder/Documents/GitHub/fsibot-serverless/"

root
|> extractGraph 
|> renderGraph graphFormat 
|> fun content -> 
    File.WriteAllText(__SOURCE_DIRECTORY__ + "/fsibot", content)

As a result, we get the following GraphViz file:

digraph app {

    node [shape=doublecircle,style=filled,color=orange]
    "check-mentions"
    "follow-users"
    "process-mention"
    "send-tweet"

    node [shape=box,style=filled,color=yellow]
    "Timer"
    "Blob incontainer/lastid"
    "Queue mentions"
    "Queue friends"
    "Queue tweets"

    node [shape=box,style=filled,color=lightblue]
    "linqtotwitter (4.1.0)"
    "Newtonsoft.Json (9.0.1)"
    "FSharp.Compiler.Service (9.0.1)"    

    edge [ style=bold ]
    "Timer" -> "check-mentions" [ label = "timer" ]
    "Queue friends" -> "follow-users" [ label = "userName" ]
    "Queue mentions" -> "process-mention" [ label = "input" ]
    "Queue tweets" -> "send-tweet" [ label = "input" ]

    edge [ style=solid ]
    "Blob incontainer/lastid" -> "check-mentions" [ label = "previousID" ]

    edge [ style=solid ]
    "check-mentions" -> "Blob incontainer/lastid" [ label = "updatedID" ]
    "check-mentions" -> "Queue mentions" [ label = "mentionsQueue" ]
    "check-mentions" -> "Queue friends" [ label = "friendsQueue" ]
    "process-mention" -> "Queue tweets" [ label = "responseQueue" ]    

    edge [ arrowhead=none,style=dotted,dir=none ]
    "linqtotwitter (4.1.0)" -> "check-mentions"
    "Newtonsoft.Json (9.0.1)" -> "check-mentions"
    "linqtotwitter (4.1.0)" -> "follow-users"
    "FSharp.Compiler.Service (9.0.1)" -> "process-mention"
    "Newtonsoft.Json (9.0.1)" -> "process-mention"
    "linqtotwitter (4.1.0)" -> "send-tweet"
    "Newtonsoft.Json (9.0.1)" -> "send-tweet"    

}

… which we can then feed into the GraphViz command line, with dot path/to/fsibot -Tpng -o path/to/fsibot.png, which creates the following diagram:

That diagram could be improved, of course, but as is, I find it pretty informative already. First, we get immediately a decent overview of the application flow, from check-mentions to process-mention and send-tweet. We can also spot some sort of state persistence happening in check-mentions, with updatedID being pushed to a blob, and previousID being pulled back out from the same blog. We can also see that 3 functions rely on linqtotwitter, whereas process-mentions (where code is being run through the FSharp Compiler Service) has no direct relationship to Twitter, and could perhaps even be isolated into its own App.

Conclusion & random tidbits

That’s as far as I will go on this for now. Before closing, I wanted to comment on a couple of things.

First, while this doesn’t support all the available bindings, it shouldn’t be very hard to add most of them - most of what is needed is adding the missing cases in bindingDescription, to format them adequately. One case that might end up being tricky is bindings that refer to each other (for instance, reading from a table based on a queue message).

Along that line of thought, one potential issue here is that nodes are identified by their name, but name collisions are possible. The identity of a binding comes from its type, and its “additional fields”. As an example, queueName doesn’t uniquely identify a queue; I could have 2 queues with the same name, pointing to a different storage account, but with this implementation, they would appear as one node on the graph.

Beyond that, it could be interesting to extend the graph, and include a few more pieces of information. As an example, we could represent what storage account each of the Azure Storage bindings belongs to, to clarify dependencies. We could also represent precompiled dlls, in a fashion similar to package dependencies.

On a completely different direction, my initial approach was quite different. Without going into too much detail, there were two major differences: I tried to use the JSON type provider, and to represent Bindings using Discriminated Unions, along these lines:

type BindingResources = 
    | Timer of TimerSchedule
    | Queue of QueueInformation
    | Blob of BlobInformation

As it turns out, both ideas didn’t work very well. In the end, the DUs didn’t seem appropriate - because they are closed, whereas bindings are extensible - and they added a lot of friction. The Type Provider didn’t fit very well either, and in the end, representing bindings essentially as a bag of string pairs turned out to be much easier.

Finally, I wanted to give a quick shout-out to @thoriumi, who has done some work wrapping up GraphViz from F#.

That’s it - while the code I presented here wasn’t particularly fancy, I hope you found something interesting in this post! And if you want me to post the whole script somewhere, just let me know :)

Creating an Azure Function in F# from the ground up (Part 2)

2017-03-06T00:00:00+00:00

In our last post, we went through setting up a simple Azure Function App through the portal. Starting from a local script that retrieved exchange rates from Yahoo and posted an update on Slack, we converted part of the code, using a Timer function to automatically make web requests every 15 seconds.

Today, we will finish turning our script into a Function App, illustrating as many useful tips as we can in the process. Among others, we’ll see how to consume NuGet packages, use queues (and more generally bindings) to allow communication between functions, and upload and reference arbitrary files.

Creating a function triggered by a Queue

So far, we have ported the first half of our script, pulling exchange rate data from Yahoo every 15 seconds. What we have left to do is to port the second half, creating a nicely-formatted message and posting it to Slack. Let’s do that now.

Of course, we could simply add that code to our existing function, and execute it all in one single script. However, this is a bit smelly. The two activities are distinct responsibilities: perhaps we will later send an update to things other than Slack; perhaps we will create other functions to retrieve different rates, and also post them to Slack. Let’s decouple the two activities, and create a separate function, which will just post to Slack.

Clearly this new function cannot be a Timer trigger. What we want here is a function which, whenever a new exchange rate has been retrieved, will execute and do its thing.

We will achieve that by using a different trigger, a Queue trigger: when a message is found in a queue, grab the message, and do something with it.

In the Portal, create a new function in F#, selecting the QueueTrigger-FSharp template this time. The screen we are presented with is mostly the same as the TimerTrigger screen we discussed in the previous post, with a couple of differences:

We still need to supply a name for the function - here post-rate - but instead of defining a CRON schedule, we have to define two things:

a Queue name, the name of the queue where the function should be looking for messages,
a Storage account connection, specifying where that queue is located, or, more specifically, its storage account.

Instead of using its default name, let’s rename the queue to latest-rate, which is more explicit. For the storage account, instead of the default selection, AzureWebJobsDashboard, we’ll choose “new” (on the right side of the drop-down box). This reveals all the existing storage account we own that are located in the same zone as our app, with an option to create a different one if we wanted to do so.

We already have a storage account, which was provisioned when we created the whole Function App, the sampleexchangerate account. There isn’t much of a point in creating a new one, so let’s use it.

Note: AFAIK, AzureWebJobsDashboard is simply an alias for the default storage account that was created with the app; I could also have kept it as-is, and changed it mainly to show that other accounts could be used.

Hit Create, and here we go - we have a new function template ready for us to play with, with a run.fsx script, and its function.json file.

Understanding the Queue Triggered Function

The template script itself is pretty straightforward:

let Run(inputMessage: string, log: TraceWriter) =
    log.Info(sprintf "F# Queue trigger function processed: '%s'" inputMessage)

The Run function expects a string called inputMessage, the message that will be pulled from the queue as a raw string, and a TraceWriter to log activity.

The function.json file is equally simple:

{
  "bindings": [
    {
      "name": "inputMessage",
      "type": "queueTrigger",
      "direction": "in",
      "queueName": "latest-rate",
      "connection": "sampleexchangerate_STORAGE"
    }
  ],
  "disabled": false
}

As for our earlier Timer example, it directly reflects what we specified in the Portal user interface. Let’s make a small change here, and rename inputMessage as newRateMessage, which is more explicit.

Save, and take a look at the logs:

2017-02-18T15:08:31.632 Function compilation error
2017-02-18T15:08:31.632 error AF003: Missing a trigger argument named 'newRateMessage'.

We now have a mismatch between the bindings and the code; let’s fix it, by renaming the first argument of the Run function, and the argument passed into the log.Info, from inputMessage to newRateMessage:

let Run(newRateMessage: string, log: TraceWriter) =
    log.Info(sprintf "F# Queue trigger function processed: '%s'" newRateMessage)

Everything is now back in order:

2017-02-18T15:10:52.546 Compilation succeeded.

Great, we now have a Function ready to run. Can we try it out? As it turns out, yes we can. Click on the Test button in the upper-right section of the screen, and you’ll see something like this - a Request body window where you can type in a message, which will be enqueued and processed.

Replace the default text “sample queue data” by, for instance “Hello F#”, hit “Run”, and you should see something like this:

The Result windows show a “Status 202: message accepted”, and if you inspect the logs, you’ll see the following entry:

2017-02-18T15:17:14.893 Function started (Id=9943762b-93cb-476e-8a1b-8cbe9ec3735f)
2017-02-18T15:17:14.908 F# Queue trigger function processed: 'Hello F#'
2017-02-18T15:17:14.908 Function completed (Success, Id=9943762b-93cb-476e-8a1b-8cbe9ec3735f)

We are in business. If a message show up in the queue, it will be picked up and run through the script. Let’s go ahead now, and copy/paste/tweak the code from our local script into the Function, to post something into Slack:

open System.Text
#r "System.Net.Http"
open System.Net.Http

let Run(newRateMessage: string, log: TraceWriter) =

    log.Info(sprintf "F# Queue trigger function processing: '%s'" newRateMessage)

    let slackMessage = sprintf """{"text":"%s"}""" newRateMessage

    let client = new HttpClient()
    let url = "https://hooks.slack.com/services/your-key-goes-here"
    let message = new StringContent(slackMessage, Encoding.UTF8)

    client.PostAsync(url,message) |> ignore

    log.Info(sprintf "F# Queue trigger function processed: '%s'" newRateMessage)

… now let’s Test the function again with a “Hello F#” message, and take a look at our #exchange_rate channel on Slack - success!

Connecting Functions via Queues

Great. So now we have 2 small functions, each of them performing a separate piece of the overall task. What we need to do now is connect them together.

The only missing piece is for the first function to post a message to the same “updated-rate” queue the second function is watching. In the portal, let’s head back to the “retrieve-rate” function, and choose Integrate.

We already defined the trigger for that function, which we see in the Triggers section. We also have 2 other sections available, Inputs and Outputs. This is where you can specify other data the function could make use of (inputs), or produce (outputs).

In our case, as the post-rate function is already watching for a queue, what we would like is for the retrieve-rate function to post something to that queue, as an output. Let’s make that happen: select New Output, Azure Queue Storage, and Select:

All we have to do at that point is specify what queue we want to talk to, latest-rate, and the corresponding storage account (sampleexchangerate_STORAGE) and give a name to the message, rateMessage:

If you inspect the function.json at that point, you’ll see it has been updated to reflect our changes:

{
  "bindings": [
    {
      "name": "timer",
      "type": "timerTrigger",
      "direction": "in",
      "schedule": "*/15 * * * * *"
    },
    {
      "type": "queue",
      "name": "rateMessage",
      "queueName": "latest-rate",
      "connection": "sampleexchangerate_STORAGE",
      "direction": "out"
    }
  ],
  "disabled": false
}

In addition to our timerTrigger, we have now a queue binding. Note that the name doesn’t include “Trigger”, which is what distinguishes the trigger from other bindings. Note also the "out" direction, which signals that this is an output.

Finally, let’s use that binding in our function, to post a message to the queue. First, we need to add the message to the Run function signature.

let Run(timer: TimerInfo, rateMessage: byref<string>, log: TraceWriter) =
    log.Info(
        sprintf "F# Timer trigger function executed at: %s" 
            (DateTime.Now.ToString()))

    let client = new WebClient()
    let result = 
        client.DownloadString(url)
        |> parse 
        |> float

    rateMessage <- (sprintf "Latest rate is %f" result)

    sprintf "%f" result            
    |> log.Info 

There are a couple of interesting things to note here. First, even though the rateMessage is an output, it is not handled as a function return value, but passed by reference. In other words, we pass a reference to rateMessage in the Run function signature, making it available in that function scope. We can then assign it the value we want to see pushed as a message to the queue, as a raw string. By the same mechanism, we could then add more outputs to the function, say, pushing different messages to different queues, or writing to a blob.

You can also enqueue a batch of messages to a Queue, using an ICollector to collect multiple messages at once.

Save & Run - boom! The retrieve-rate function pulls exchange rates every 15 seconds from Yahoo, and posts it to the latest-rate queue, the post-rate function will pick up that message and post to Slack, which we can confirm:

Ladies and gentlemen, drum roll - we have a working app.

Note that we didn’t have to manually create that queue. All we did was declare “I will use a queue called latest-rate”; the function provisioned the corresponding queue automatically.

Disabling a function

Let’s face it, getting a Slack notification every 15 seconds is a bit annoying. Fortunately, we can temporarily disable a function. On the left-hand side of the dashboard, under the retrieve-rate function section, select Manage:

The Function State switch allows you to Enable and Disable that individual function, putting it temporarily off line if needed. Incidentally, this is also where you can go and entirely delete a function. Let’s click Disabled - this should immediately turn off the torrent of messages flooding our channel. If you go check the function.json file, you’ll also see that it changed, and shows now "disabled": true. You could also directly edit that file, with the same effect.

Using NuGet packages

We have a working function app already, and could stop there. However, we haven’t fully replicated the functionality of our original script. How would we go about using a NuGet package, such as FSharp.Data, to extract out the rate from the xml document we get back from Yahoo using a Type Provider?

Azure Functions use project.json files to manage Nuget dependencies. In the Develop section of the retrieve-rate function, let’s select View Files, and Add a new file, project.json:

The contents should be pretty self-explanatory:

{
  "frameworks": {
     "net46":{
       "dependencies": {
         "FSharp.Data": "2.3.2"
      }
    }
  }
}

We specify the .NET framework version (4.6), and reference the NuGet package FSharp.Data as a dependency, with the specific version we want to use. Save, and take a look at the logs, where you should see something along these lines going on:

2017-03-04T14:20:04.630 Restoring packages.
2017-03-04T14:20:04.630 Starting NuGet restore
...
2017-03-04T14:20:10.485 Installing FSharp.Data 2.3.2.
2017-03-04T14:20:18.375 Committing restore...
...
2017-03-04T14:20:18.469 Restore completed in 12390ms.

Changes in the project.json file are detected, triggering a NuGet restore and installing the dependencies. Once the operation is complete, you should see a 4th file added to our folder, project.lock.json - and we should be able to reference FSharp.Data in our script, and use the XML type provider, instead of our quick-and-dirty parser. Let’s try that out:

open System
#r "System.Xml.Linq"
open FSharp.Data

// sample XML message
[<Literal>]
let sampleRate = """<query xmlns:yahoo="http://www.yahooapis.com/v1/base.rng" yahoo:count="1" yahoo:created="2017-02-11T19:56:24Z" yahoo:lang="en-US">
<results>
<rate id="GBPUSD">
<Name>GBP/USD</Name>
<Rate>1.2486</Rate>
</rate>
</results>
</query>"""

type Rate = XmlProvider<sampleRate>

let url = """http://query.yahooapis.com/v1/public/yql?q=select * from yahoo.finance.xchange where pair in ("GBPUSD")&env=store://datatables.org/alltableswithkeys"""

let getRate () = 
    let response = Rate.Load(url)
    response.Results.Rate.Rate

let Run(timer: TimerInfo, rateMessage: byref<string>, log: TraceWriter) =
    log.Info(
        sprintf "F# Timer trigger function executed at: %s" 
            (DateTime.Now.ToString()))

    let result = getRate ()

    rateMessage <- (sprintf "Latest rate is %f" result)

    sprintf "%f" result            
    |> log.Info  

Done! We ditched the reference to System.Net and WebClient, got rid of the parser, using FSharp.Data instead to directly give us statically typed results straight out of Yahoo.

Extracting and referencing the XML Sample

Let’s make another small improvement here. Hard-coding the XML sample right there inline is a bit displeasing to the eye, perhaps we should extract it into a separate file, and point the Type Provider to it.

Creating the file is easy; just as we did for the project.json file, let’s add a new file in the function folder, alongside our current 4 files, name it, say, sample.xml, and paste in our XML sample.

Referencing the file is equally easy; just as you would in a good old regular script, define a path, relative to the source directory, and pass it to the Type Provider:

// omitted for brevity

[<Literal>]
let sampleRate = __SOURCE_DIRECTORY__ + "/sample.xml"
type Rate = XmlProvider<sampleRate>

Save and Run… and we are done.

What else could we do to make this code prettier?

One sore spot left is the message we are passing around. So far, we have been pushing around a raw string ““Latest rate is 123.456”; that is primitive at best. It would be much nicer to pass around a message with the information we care about, presented in a structured, self-explanatory manner, and let the second function decide how that should be formatted and posted to Slack.

The obvious candidate here is to use an F# Record type, something like:

type Message = {
    Rate: decimal
}

How are we going to pass that message around? Let’s take the easiest route first: we will define the type separately in each function, and use JSON.Net to serialize to/deserialize from the Queue.

As it turns out, JSON.Net is available out of the box in functions, so we don’t need to add it to the project.json dependencies. Instead, we can directly reference it in our scripts with #r.

Let’s modify retrieve-rate first, including JSON.Net and defining our Message type:

open System
#r "System.Xml.Linq"
open FSharp.Data
#r "Newtonsoft.Json"
open Newtonsoft.Json

type Message = {
    Rate: decimal
}

… and changing the code inside Run to now enqueue a JSON-serialized Message:

    let result = getRate ()
    let message = 
        { Rate = result } 
        |> JsonConvert.SerializeObject
        
    rateMessage <- message

Nice and crisp. Let’s now change the code on the receiving end of the queue, in post-rate, in a similar fashion:

// omitted for brevity

#r "Newtonsoft.Json"
open Newtonsoft.Json

type Message = {
    Rate: decimal
}

let Run(newRateMessage: string, log: TraceWriter) =

    log.Info(sprintf "F# Queue trigger function processing: '%s'" newRateMessage)
    
    let message = 
        JsonConvert.DeserializeObject<Message>(newRateMessage)

    let slackMessage = 
        message.Rate
        |> sprintf """{"text":"Rate : %f"}""" 
    
    // rest unchanged

This is better - at least I think so.

Now what if we thought “this Message type is duplicated across two scripts, perhaps we should share it instead”? I’ll leave aside the question of whether or not avoiding that duplication is a good thing, and go ahead with that plan, as an example of what you could do if you wanted to share files across multiple functions in the same Function App.

So what we would like is for both scripts to rely on the same unique definition of Message. Let’s define that type in a file, saved somewhere on our local machine:

File Domain.fs

namespace Domain

type Message = {
    Rate: decimal
}

If we manage to upload it somewhere accessible by both functions, we should be able to then simply reference it with #load in both scripts.

To do that, we will be using Kudu. In the portal, below your list of functions, you’ll find a little menu Function app settings, which opens a boatload of choices.

The one we care about is under the Deploy section, Go to Kudu. Let’s click and go to Kudu, then - a new browser window will pop up, with a file explorer (with 3 folders, data, logFiles, and site), and a console:

What’s happening here, is that we are on our “Serverless” server. We can use the command line, and navigate through the file system. Let’s navigate into site > wwwroot > retrieve-rate via the file explorer:

Look what we found there - the 5 files that define our retrieve-rate function. Also, note how the console reflects our navigation, with an explicit path to our location.

You could also navigate around via the command line, using cd wwwroot and the like.

There is no reason to include Domain.fs in either of the function folders - that code should belong to neither. Let’s navigate one level up from the functions, in D: > site > wwwroot, and upload our file there, for instance by simply drag-and-drop’ing it over the file explorer section:

At that point, we can replace in both scripts the Message type definition by the following:

#load @"D:\home\site\wwwroot\Domain.fs" 
open Domain

It’s not pretty, but it achieves what we were after: both functions are using the same Message type, loading it from a single shared file. More interestingly, we could upload and use anything we want to share, for instance our own dll.

I won’t discuss this topic deeper here, but I recommend taking the time to explore a bit the folder structure; this is quite helpful in figuring out how Azure Functions work behind the scenes.

Using Configuration

While we are in the Function app settings section, let’s quickly illustrate another useful feature. In the post-rate script, the URL we use to post to Slack is hard-coded in the script itself. That’s not great - it would be much nicer to pull it from a configuration file.

As it turns out, this is pretty straightforward. Under the Manage section, you’ll find an option to go to App service settings; let’s head there.

Among the many available choices, pick Application settings.

There you’ll find a configuration file, storing key/value pairs, which already contains the AzureWebJobsDashboard connection information to the Azure storage account we saw earlier.

Let’s add a new entry named SlackURL, associated with the URL to our Slack channel, and save.

All that’s left to do now is to replace the hard-coded value in post-rate:

// code omitted for brevity
open System.Configuration

let Run(newRateMessage: string, log: TraceWriter) =

    // omitted for brevity

    let client = new HttpClient()
    let message = new StringContent(slackMessage, Encoding.UTF8)
    let appSettings = ConfigurationManager.AppSettings  
    let url = appSettings.["SlackURL"]    

Continuous Deployment

Let’s cover a last topic for the road today: continuous deployment.

One nice aspect of Azure Functions is that there is virtually nothing to do to deploy code. Save your changes, and your code is immediately running in production. The downside is, we had to work from within the Azure Portal. The development experience is pretty decent, given the constraints, but it’s still not the tool I would pick as my first choice - and as a process, there are glaring issues.

In this post, I’ll leave aside the topic of how you would go about developing a function on your local machine, instead of in the online editor, in part because the tools involved are still in preview at the moment. I’ll probably revisit that question later on; in the meanwhile, if you are interested, take a look at the Azure Functions CLI.

The other obvious problem is the lack of versioning. We are currently more or less patching live code on our Serverless Server, and hoping for the best. At a minimum, source control would be nice.

The good news here is that Azure Functions continuous deployment support is quite nice. In the end, a Function App is just a collection of folders, one per function, each containing a couple of files. All we need is to ship the root folder, and all the nested contents and folders.

Out of the box, many scenarios are supported. We’ll go for GitHub.

First, we’ll create a naked GitHub repository, exchange-rate-azure-function.

Next, we need to retrieve the code we currently have, and move it to the repository. We can do that via Kudu: navigate to D:\home\site>, and download the wwwroot folder. The only change I made there was to remove the project.lock.json file from retrieve-rate.

I suspect that next step is not necessary, but I also deleted both functions from the Function App in the portal.

Finally, we’ll point the Function App to the GitHub repository, so that every time code is pushed, a deployment is triggered. In the Function app settings section, under Deploy, select Configure continuous integration. This will open a couple of options:

We’ll pick GitHub, select the appropriate repository and branch, and provide some credentials; at that point, we should be done. Let’s confirm that, and push the code to the repository. Quickly after, if we go back to the Azure Portal, you’ll see that the functions are back, with a minor change:

At the top of the screen, we have a note, stating the following:

Read only - because you have started editing with source control, this view is read only. You can edit these settings in function.json

From now on, instead of working through the Portal, you can edit the files locally; push your changes, and they will be immediately propagated to your Function App.

Note that the configuration file is not part of the repository, allowing you to share the code without sharing all your “secrets” at the same time.

Conclusion

That’s where we we leave things for now. As a quick recap, here is what we did: we took a small but non trivial F# local script, and with minimal changes, we turned it into an Azure Function application, connecting two functions with a queue. In the process, we illustrated a couple of features (using NuGet packages, uploading files, storing secrets in configuration, deploying from GitHub) which you’ll probably need if you want to build anything interesting with Functions.

This is obviously not a complete tutorial on Azure Functions. I plan on writing more on the topic in the near future, in particular around local development, and development workflow more generally. There are two things that I hope came through though. First, Azure Functions are dead-simple to use, and applicable in a lot of scenarios; then, they are a great fit with F#, making it possible to rapidly sketch out and run both the domain and architecture of a full application.

At any rate, I hope this will help you get started with Azure Functions and F# on the right foot; and if you have specific questions or requests… ping me!

Creating an Azure Function in F# from the ground up (Part 1)

2017-02-11T00:00:00+00:00

If you follow me on Twitter, you may have noticed a recurring topic lately: Azure Functions. I have found it both useful for many use cases, and simply fun to work with; and it fits pretty nicely with F#. I recently gave a talk at NDC London (the video should be online at some point), where I demoed a small example, trying to fit in as many features as I could, in as little time and code as possible. Someone took up my offer to write a tutorial from the ground up, so I figured, let’s take that example and turn it into a post. It is a demo, so what it does is not particularly useful by itself, but it illustrates many of the features and tricks I found useful, and should be a good starting point to write “real” code.

The app: sending exchange rate updates on Slack

What we will build is an app which will post, on a regular cadence, the latest available USD/GBP exchange rate on Slack. The reason I picked that example is two fold. First, the exchange rate changes often, which will help verify that things are indeed working. Then, we’ll be able to showcase how easy it is to integrate functions to put together a working application.

Before starting with the code itself, we will need two things: exchange rates, and Slack.

For the exchange rate, we will use Yahoo, while it’s still there. Yahoo has a free API for exchange rates, available at the following URL:

http://query.yahooapis.com/v1/public/yql?q=select * from yahoo.finance.xchange where pair in ("GBPUSD")&env=store://datatables.org/alltableswithkeys

This returns an xml document, which looks like this:

<query xmlns:yahoo="http://www.yahooapis.com/v1/base.rng" yahoo:count="1" yahoo:created="2017-02-11T19:56:24Z" yahoo:lang="en-US">
    <results>
        <rate id="GBPUSD">
            <Name>GBP/USD</Name>
            <Rate>1.2486</Rate>
            <Date>2/10/2017</Date>
            <Time>10:02pm</Time>
            <Ask>1.2489</Ask>
            <Bid>1.2486</Bid>
        </rate>
    </results>
</query>

So the first part of our job will be to regularly call that URL, and extract the Rate from the xml document.

Posting to Slack isn’t very difficult either. I created my own personal Slack at mathias-brandewinder, where I can talk to myself quietly, as well as test examples like this one. I then created a webhook, by going to https://mathias-brandewinder.slack.com/apps/manage, selecting Custom Integrations, Incoming WebHooks, and pick a channel to post to. I created a channel #exchange_rate for the occasion. Once the setup is done, you get a WebHook URL, which looks like https://hooks.slack.com/services/S0meL0ngCrypt1cK3y, where you can now POST JSON messages.

So the second part of our job will be to take that rate, create a JSON message and POST it.

Local version

Before diving into Azure Functions, let’s write the F# code we will need to achieve this, and get things to work locally, with simple F# scripts.

Making a request to Yahoo is fairly straightforward:

open System.Net

let url = """http://query.yahooapis.com/v1/public/yql?q=select * from yahoo.finance.xchange where pair in ("GBPUSD")&env=store://datatables.org/alltableswithkeys"""
let client = new WebClient()
let result = client.DownloadString(url)
printfn "%s" result

Running this produces something along these lines:

<?xml version="1.0" encoding="UTF-8"?>
<query xmlns:yahoo="http://www.yahooapis.com/v1/base.rng" yahoo:count="1" yahoo:created="2017-02-11T20:20:10Z" yahoo:lang="en-US
"><results><rate id="GBPUSD"><Name>GBP/USD</Name><Rate>1.2486</Rate><Date>2/10/2017</Date><Time>10:02pm</Time><Ask>1.2489</Ask><
Bid>1.2486</Bid></rate></results></query><!-- total: 9 -->
<!-- prod_gq1_1;paas.yql;queryyahooapiscomproductiongq1;e8805764-ed45-11e6-912b-f0921c12e67c -->

We can extract the rate part from this with some old-fashioned, quick-and-dirty code like this:

let parse (s:string) = 
    let o = "<Rate>"
    let c = "</Rate>"
    
    let st = s.IndexOf(o) + 6
    let en = s.IndexOf(c) - st

    s.Substring(st,en)

result |> parse |> float

Or we can go a bit fancier (we are in 2017, after all), and use the FSharp.Data XML Type Provider:

#r "System.Xml.Linq.dll"
#r @"packages/FSharp.Data/lib/net40/FSharp.Data.dll"
open FSharp.Data

[<Literal>]
let sampleRate = """<query xmlns:yahoo="http://www.yahooapis.com/v1/base.rng" yahoo:count="1" yahoo:created="2017-02-11T19:56:24Z" yahoo:lang="en-US">
<results>
<rate id="GBPUSD">
<Name>GBP/USD</Name>
<Rate>1.2486</Rate>
</rate>
</results>
</query>"""

type Rate = XmlProvider<sampleRate>
let rate = Rate.Load(url)
rate.Results.Rate.Rate

That’s pretty much all we need for the rate. How about Slack? Going quick-and-dirty again, this isn’t much harder:

open System.Text
#r "System.Net.Http.dll"
open System.Net.Http

let slackMessage = sprintf """{"text":"current USD/GBP rate is %f"}""" 123.455

let client = new HttpClient()
let url = "https://hooks.slack.com/services/your-key-goes-here"
let message = new StringContent(slackMessage, Encoding.UTF8)

client.PostAsync(url,message) |> ignore

Run this, and boom! Here we are, we got an incoming message in Slack:

Setting up the Azure Function App

Now that we have all the pieces working, how do we get this to run on Azure Functions?

The first thing we need is to create a Function App. A Function App is a container, where one or more functions will live. To do that, we’ll head to the Azure Portal. Click on the + sign, pick Function App from Microsoft, and Create.

You’ll be presented with a few options to set up:

Give the app a name and resource group a name - in our case, “sample-exchange-rate”, and “sample_exchange_rate”, pick the location where you want it deployed (West US in this case). I like also to give the Storage Account a human-friendly name (in this case sampleexchangerate), instead of the default random one; it makes it easier to figure out what a storage account is there for later on.

As an aside, the reason all names follow inconsistent conventions is that the rules for what is and isn’t a valid name for various Azure resources are different, which is pretty annoying.

The Hosting Plan gives you the choice between Consumption Plan and App Service Plan. Unless you have good reasons to do something different, you probably want Consumption Plan; what this means in a nutshell is, you will pay only for the time your function(s) run and the memory they use, and Azure will handle scaling automatically for you.

Finally, I recommend also selecting “Pin to dashboard”, which will create a convenient shortcut to your app on the Portal dashboard.

We are now ready to go - click Create, and wait for the deployment to complete:

Writing our first function

Within a couple of minutes, your Function App should be ready to use, and you’ll be presented with this screen, where the fun part begins.

Let’s begin with retrieving exchange rates from Yahoo. What we want is to automatically run the code we previously wrote, on a fixed schedule. To do this, we will use a timer-triggered Azure Function:

We will name that function “retrieve-rate”, and set it to run every 15 seconds, by configuring its schedule, using a CRON-style format:

Once the function is created, you will be presented with an online development environment, with an F# script run.fsx generated from a template; click on the “Logs” button on the top-right corner, which will reveal a window with Logs - your function is already running! The script is being triggered and runs every 15 seconds, writing out to the log like clockwork.

The template code is probably the simplest Function you could write:

open System

let Run(myTimer: TimerInfo, log: TraceWriter) =
    log.Info(
        sprintf "F# Timer trigger function executed at: %s" 
            (DateTime.Now.ToString()))

We have a Run function, which takes two arguments, a (Microsoft.Azure.WebJobs) TimerInfo and a TraceWriter we use for logging. We’ll leave it at that for now, and discuss this a bit more later.

For now, if that function is already running… let’s see if we can get our original local script to run, too, by doing a bit of copy-paste:

open System
open System.Net

let url = """http://query.yahooapis.com/v1/public/yql?q=select * from yahoo.finance.xchange where pair in ("GBPUSD")&env=store://datatables.org/alltableswithkeys"""

let Run(myTimer: TimerInfo, log: TraceWriter) =
    log.Info(
        sprintf "F# Timer trigger function executed at: %s" 
            (DateTime.Now.ToString()))

    let client = new WebClient()
    let result = client.DownloadString(url)
    
    sprintf "%s" result            
    |> log.Info

Save, and take a look at the logs:

2017-02-11T22:27:47.848 Script for function 'retrieve-rate' changed. Reloading.
2017-02-11T22:27:49.598 D:\home\site\wwwroot\retrieve-rate\run.fsx(9,14): warning FS52: The value has been copied to ensure the original is not mutated by this operation or because the copy is implicit when returning a struct from a member and another member is then accessed
2017-02-11T22:27:49.598 D:\home\site\wwwroot\retrieve-rate\run.fsx(6,9): warning FS1182: The value 'myTimer' is unused
2017-02-11T22:27:49.598 Compilation succeeded.
2017-02-11T22:28:00.014 Function started (Id=54dfc25e-c99b-44e2-bfc0-3f3a92483911)
2017-02-11T22:28:00.014 F# Timer trigger function executed at: 2/11/2017 10:28:00 PM
2017-02-11T22:28:00.045 <?xml version="1.0" encoding="UTF-8"?>
<query xmlns:yahoo="http://www.yahooapis.com/v1/base.rng" yahoo:count="1" yahoo:created="2017-02-11T22:27:59Z" yahoo:lang="en-US"><results><rate id="GBPUSD"><Name>GBP/USD</Name><Rate>1.2486</Rate><Date>2/10/2017</Date><Time>10:02pm</Time><Ask>1.2489</Ask><Bid>1.2486</Bid></rate></results></query><!-- total: 8 -->
<!-- prod_gq1_1;paas.yql;queryyahooapiscomproductiongq11;c2b8d2cb-ea59-11e6-912b-f0921c12e67c -->
2017-02-11T22:28:00.045 Function completed (Success, Id=54dfc25e-c99b-44e2-bfc0-3f3a92483911)
2017-02-11T22:28:15.005 Function started (Id=039d9230-a3ac-4f70-ba61-44a126b8d08d)

Looks like things are working. Code changes have been detected, the code is compiled, and starts running, pulling exchange rates from Yahoo. Success!

Let’s use our parse function, to extract the rate as a number, and not a raw string:

open System
open System.Net

let parse (s:string) = 
    let o = "<Rate>"
    let c = "</Rate>"
    
    let st = s.IndexOf(o) + 6
    let en = s.IndexOf(c) - st

    s.Substring(st,en)

let url = """http://query.yahooapis.com/v1/public/yql?q=select * from yahoo.finance.xchange where pair in ("GBPUSD")&env=store://datatables.org/alltableswithkeys"""

let Run(myTimer: TimerInfo, log: TraceWriter) =
    log.Info(
        sprintf "F# Timer trigger function executed at: %s" 
            (DateTime.Now.ToString()))

    let client = new WebClient()
    let result = 
        client.DownloadString(url)
        |> parse 
        |> float

    sprintf "%f" result            
    |> log.Info 

And… done.

Before going any further, let’s click on the View Files button next to Logs:

What we have is a folder, named “retrieve-rate” (the name of our function), with 2 files: run.fsx, which we already looked at, and function.json. That file contains the bindings for our function:

{
  "bindings": [
    {
      "name": "myTimer",
      "type": "timerTrigger",
      "direction": "in",
      "schedule": "*/15 * * * * *"
    }
  ],
  "disabled": false
}

That’s the minimum setup for a function: a script (F# or not), which contains the code to run, and a function.json file, which defines the trigger, an event which, when it happens, will cause the script code to be executed.

In the function.json file, we have a list of bindings, with, in our case, only one binding defined, of type timerTrigger, named myTimer, going in the function. This is where the myTimer: TimerInfo argument in the Run function comes in. When we initially setup the function, all we did was creating that file, which we could now edit directly here. If you change the schedule to "schedule": "*/5 * * * * *", Save and Run, your function will now run every 5 seconds. If you change the name of the binding from myTimer to timer, Save and Run, you’ll see an error pop in the logs:

2017-02-11T22:46:54.826 Function compilation error
2017-02-11T22:46:54.826 error AF003: Missing a trigger argument named 'timer'.

That’s because the name of the argument in the Run function should match the trigger we defined. Modify Run to let Run(timer: TimerInfo, log: TraceWriter) =, and everything will be back in order.

What next

That’s where I will stop for today. So far, we have covered the setup and creation of a Function App via the Azure portal, and shown how easy it was to just take an existing F# script, and, with barely a modification, get it to run on a schedule.

This was just scratching the surface, and we still have work to do. Next time, we will expand our app to post to Slack. In the process, we will look more into bindings and triggers, and how to connect functions together. We’ll also show how to use existing nuget packages, such as FSharp.Data, and how to make any file available to our functions. So… stay tuned for the next post!

New relase of @fsibot, now on Azure Functions

2017-01-10T00:00:00+00:00

About 2 years ago, I wrote a little application, @fsibot. @fsibot is a Twitter bot which, when it receives a Tweet that is a valid F# expression, will evaluate it and return the result to the sender. Got to code FizzBuzz in an interview? Impress your audience, and send a Tweet from your cell phone to @fsibot:

@brandewinder 1,2,Fizz,4,Buzz,Fizz,7,8,Fizz,Buzz,11,Fizz,13,14,FizzBuzz,16,17,Fizz,19,Buzz,Fizz,22,23,Fizz,Buzz,26,Fizz,28,29,FizzBuzz [...]
— fsibot (@fsibot) January 10, 2017

It was very fun to write, rather pointless, but turned out to be an interesting exercise, which taught me a lot. And, in spite of its simplicity, it’s a decent sample app, which touches on many aspects a real-world app might encounter.

After some hiccups early on, @fsibot has been running pretty smoothly, until I noticed issues recently. Rather than trying to figure out what the hell was going on, I decided to port it over Azure Functions, which sounded like a better fit for it. While at it, I also made a couple of changes to the bot. If you are interested, you can find the code on GitHub.

New features

@fsibot “Classic” was designed to evaluate F# expressions. This ended up creating some frustration, because the behavior was unexpectedly different from the F# Interactive experience people were used to. In particular, while typing printfn "hello" in FSI produces a nice and friendly hello, @fsibot would respond with a much less pleasant null. @fsibot also required expressions to be written in the “non light” syntax, which is not that common.

Long story short, @fsibot now supports expressions and interactions (thanks @tomaspetricek for the helpful FCS pointers!), and, minus some security-related restrictions, behaves more or less the same way FSI does. You can now use pretty much everything, from printfn to #time or creating your own discriminated unions, as long as it fits in under 132 characters:

@brandewinder hello

type Foo =
| Bar of int
| Baz of string
val f : _arg1:Foo -> unit
val it : unit = ()
— fsibot (@fsibot) January 8, 2017

No IntelliSense yet, but @fsibot now also returns potentially helpful error messages for invalid code:

@brandewinder The type 'string' does not match the type 'int'
The type 'string' does not match the type 'int'
— fsibot (@fsibot) January 9, 2017

Under the hood: Azure Functions

Before talking about the why, I should probably start with what Azure Functions are. In a nutshell, an Azure Function is a script, which will run whenever a particular triggering event occurs. Triggers can be many things, from a timer, to an http request, or a message showing up in a queue. At a minimum, a function boils down to 2 files in a folder, the script, and bindings, a function.json file describing what triggers the function, and potentially other resources it might talk to. If needed, a function can also use a project.json file, listing the nuget dependencies the code requires. Functions can be composed together in a larger unit, a Function App.

This lent itself very well to the problem at hand. If you take a look at the code on GitHub, you will see 3 folders, each containing one function:

check-mentions is a timer-triggered function. Every 2 minutes, it looks for new Tweets mentioning @fsibot, and sends them to a queue. The function also reads and writes the ID of the latest Tweet processed in a blob, to make sure the same Tweet is not processed twice.
process-mention is bound to that same queue. Whenever a message is found, it analyzes it, tries to run it through the F# Compiler Services, and sends the result to another queue for further processing.
send-tweet picks up from that queue, composes a Twitter response, and sends it to the original author.

That’s pretty much it - the whole application now fits in 3 folders, with a grand total of 11 fairly small (and hackish) files.

Why Azure Functions?

So why did I pick Azure Functions?

The obvious reason is price. My original setup used a couple of TopShelf windows services, running on the cheapest VM I could get on Azure, which was costing me about 12 USD / month. This isn’t insanely expensive, but, let’s face it, given the limited usage of @fsibot, I was paying mostly for a machine doing nothing.

By contrast, with Azure Functions, you pay only for the time your code is running, which is perfect for my use case. At $0.20 per million executions, my coffee budget suddenly got a nice boost.

@fsibot was my first foray into Azure Functions. In hindsight, I have also found them to be a great fit with F#. I tend to use F# scripts quite a lot to sketch out designs. Feedback is immediate, and the language simplicity lets me focus quickly on the code, and doesn’t get in the way. At the same time, there is a small effort required to move from script to production: Azure Functions fills just that gap. I can now take that script all the way, and easily fill in the missing pieces, with minimal efforts. Need a queue? Just declare it, and it’s there for you to use. Scaling, build, deployment? Just connect your GitHub repository, and it’s done. I can focus on what matters, the code, without getting bogged down in plumbing details. Lovely.

This turned out to be a huge productivity improvement over my previous setup. Maintaining a VM, two services and a queue did create a lot of friction; as an extra bonus, RDPing into a minuscule VM to trouble-shoot issues isn’t something I wish on anyone. By contrast, in spite of a few rough edges - at the time I begun, Functions were in preview - the process is now extremely smooth: I have a grand total of 11 files to maintain, I edit them in Code, push, and I am done.

What next?

There are a couple of improvements I’d like to make, and yes, the code is quite hacky in places, but it’s good enough to ship, so let’s ship it! I’d love your feedback - try it out, and let me know what you think, and if there is something you’d like to see added or changed.

And otherwise, I encourage you to take a look at Azure Functions. In a way, I have found F# and Functions to share similar qualities: writing code is productive, and… simply fun. On top of that, the team “gets” open-source: everything is in the open, they listen, and the experience improves literally every day. And F# support is quite nice! So again, try it out, and let them know what you think.

Finally, I am considering writing a more detailed post, explaining how I wrote @fsibot on Functions, step-by-step, from the ground up. The code base is not overly complex, so I am not entirely sure if this is useful. If you’d like to see such a post, ping me in the comments or on Twitter!

Code on GitHub

Using the ALGLIB random forest with F#

2016-09-25T00:00:00+00:00

The intent of this post is primarily practical. During the Kaggle Home Depot competition, we ended up using the Random Forest implementation of ALGLIB, which worked quite well for us. Taylor Wood did all the work figuring out how to use it, and I wanted to document some of its aspects, as a reminder to myself, and to provide a starting point for others who might need a Random Forest from F#.

The other reason I wanted to do this is, I have been quite interested lately in the idea of developing a DSL to specify a machine learning model, which could be fed to various algorithms implementation via simple adapters. In that context, I thought taking a look at ALGLIB and how they approached data modelling could be useful.

I won’t discuss the Random Forest algorithm itself; my goal here will be to “just use it”. In order to do this, I will be using the Titanic dataset from the Kaggle “Learning From Disaster” competition. I like that dataset because it’s not too big, but it hits many interesting problems: missing data, features of different types, … I will be using it two ways, for classification (as is usually the case), but also for regression.

Let’s dive in the ALGLIB random forest. The library is available as a nuget package, alglibnet2. To use it, simply reference the assembly #r @"alglibnet2/lib/alglibnet2.dll"; you can then immediately train a random forest, using the alglib.dfbuildrandomdecisionforest method - no need to open any namespace. The training method comes in 2 flavors, alglib.dfbuildrandomdecisionforest and alglib.dfbuildrandomdecisionforestx1. The first one is a specialization of the second one, which takes an additional argument; therefore, I’ll work on the second, most general version.

Signature of dfbuildrandomdecisionforestx1

The signature of dfbuildrandomdecisionforestx1 is the following:

let info,forest,report = 
    alglib.dfbuildrandomdecisionforestx1(
        trainingset, // training data
        samplesize, // how many observations
        features, // how many features/variables
        classes, // how many classes; 1 represents regression
        trees, // how many trees to build; recommended: 50 to 100
        featuresincluded, // how many features retained when splitting
        learningproportion // how much of the sample to use for each tree. Recommended: 0.05 (high noise) to 0.66 (low noise)
        )

We’ll illustrate shortly how the inputs should be prepared. The function produces 3 outputs:

info: an integer return code. 1 signals success, -2 or -1 are supposed to signal issues (more on that in a second).
forest: a random forest (alglib.decisionforest), which can be used to produce predictions.
report: an alglib.dfreport that contains various quality metrics.

The Titanic dataset

The dataset (which you can download from here) we will use comes as a CSV file, “titanic.csv”, which contains the following columns:

Name	Type	Notes
PassengerId	int	Unique ID for passenger
Survived	bool	survival, encoded as 0 (no) or 1 (yes)
Pclass	int	1, 2 or 3 for 1st, 2nd and 3rd class
Name	string	name, title
Sex	string	“male” or “female”
Age	float
SibSp	int	number of siblings or spouses travelling together
Parch	int	number of parents or children travelling together
Ticket	string	ticket number/identifier
Fare	decimal	price paid for ticket
Cabin	string	cabin number/identifier
Embarked	string	Boarding port: S, C or Q for Southampton, Cherbourg or Queenstown

We consume the dataset using the fsharp.data CSV Type Provider, in the simplest fashion:

#r @"fsharp.data/lib/net40/fsharp.data.dll"
open FSharp.Data
type Titanic = CsvProvider<"titanic.csv">
type Passenger = Titanic.Row
let sample = Titanic.GetSample().Rows

Setting up a regression

Let’s start first with a regression. In this case, we will try to predict Fare - how much each passenger paid - using the data we have available.

The training set format is a bit unusual. ALGLIB expects a 2D array, where the first columns are the input variables X, and the last column is the value we are trying to predict, Y.

We can for instance prepare a training set this way:

let trainingset = 
    sample
    |> Seq.map (fun row ->
        [|
            // the inputs x
            row.Age
            float row.Parch
            float row.SibSp
            // the output y
            float row.Fare
        |])
    |> array2D

This will produce something like this:

val trainingset : float [,] = [[22.0; 0.0; 1.0; 7.25]
                               [38.0; 0.0; 1.0; 71.2833]
                               [26.0; 0.0; 0.0; 7.925]
                               [35.0; 0.0; 1.0; 53.1]
                               [35.0; 0.0; 0.0; 8.05]
                               [nan; 0.0; 0.0; 8.4583]
                               [54.0; 0.0; 0.0; 51.8625]

Note the presence of a nan (“Not a number”) in row 6 - we have missing values.

We can now attempt to train a regression model:

let samplesize = trainingset.GetUpperBound(0)
let features = 3
let classes = 1 // regression
let trees = 10
let featuresincluded = 2
let learningproportion = 0.50
    
let info,forest,report = 
    alglib.dfbuildrandomdecisionforestx1(
        trainingset,
        samplesize,
        features,
        classes,
        trees,
        featuresincluded,
        learningproportion
        )

Some points of note here:

features represents the number of columns that are input values
when set to 1, classes indicates a regression
trees represents how many trees we want in the forest, that is, how deep / long we want to train. The documentation recommends 50 to 100. From experience, higher is possible, but an OutOfMemoryException is also a possibility :)
featuresincluded: this is the extra parameter from the other function available. It drives how many of the available features should be randomly selected at each split. This is done automatically in the other case.
learningproportion: this is a tuning parameter, the documentation recommends values between 0.05 (for very noisy datasets) and 0.66 (for clean datasets). This determines how much of the training set is used for each tree, and lower values should help prevent over-fitting.

Running the regression

Running the regression produces… well, on my machine, with the current setup, the computation never returns. If I change the learningproportion to 0.1 instead, I get this:

alglib+alglibexception: Exception of type 'alglib+alglibexception' was thrown.
   at alglib.dforest.dfsplitr(Double[]& x, Double[]& y, Int32 n, Int32 flags, Int32& info, Double& threshold, Double& e, Double[]& sortrbuf, Double[]& sortrbuf2)
   // more stack trace from hell.

So much for using error codes. My experience with the library has been that if there is something wrong with the input, it will either explode or never return. Perhaps I am doing something wrong?

The 2 issues you may hit when preparing the data are:

invalid indexing: for instance, setting samplesize to a value larger than the sample size will result in System.IndexOutOfRangeException: Index was outside the bounds of the array..
missing data / nan: this is the problem we are hitting here. The training set is expected to be a float [,], but if it contains nan values, for either input or output, you’ll run into problems.

Let’s address this, with a quick-and-dirty filter:

open System 
let number x = not (Double.IsNaN x || Double.IsInfinity x)

let trainingset = 
    sample
    |> Seq.map (fun row ->
        [|
            // the inputs x
            row.Age
            float row.Parch
            float row.SibSp
            // the output y
            float row.Fare
        |])
    |> Seq.filter (fun row -> row |> Seq.forall (number))
    |> array2D

Side-note: is there a more elegant way to check if a float is a “normal number”?

This eliminates every row that contains one or more invalid input, and alglib.dfbuildrandomdecisionforestx1 runs like a champ now. The info flag is 1, signaling success. The report results are as follows:

> report;;
val it : alglib.dfreport =
  alglib+dfreport {avgce = 0.0;
                   avgerror = 20.11038675;
                   avgrelerror = 0.9471424989;
                   innerobj = alglib+dforest+dfreport;
                   oobavgce = 0.0;
                   oobavgerror = 29.25122031;
                   oobavgrelerror = 1.277852568;
                   oobrelclserror = 0.0;
                   oobrmserror = 57.16207433;
                   relclserror = 0.0;
                   rmserror = 39.4817227;}

You get the expected metrics in the report (average error, root mean square error, …), in two flavors. The values prefixed with oob indicate out-of-bag, and I suspect the other ones are on data that has been used for training (that is, the complement of out-of-bag). I am not 100% sure about this one. In general, out-of-bag is the better indicator for what performance you should expect from your model when using it on new data points.

Generating predictions

You can now use the forest to generate predictions, by calling alglib.dfprocess. dfprocess is expecting a forest, and a vector of input values, and will compute the output value. The output value is expected by reference, and is not a float, but a float[] (more on this when we discuss classification later). In our case, our model has 3 features / variables, so we should pass in a float[] of size 3.

let mutable output = Array.empty<float>
let input = [| 30.0; 0.0; 1.0 |]
alglib.dfprocess(forest,input,&output)
printfn "Prediction: %A" output 
> 
Prediction: [|33.45812375|]

In other words, for a passenger that is 30 years old, travelling with 0 parents or children and 1 siblings or spouses, our model predicts that his ticket has cost him 33.45.

This is obviously a bit gross. Taylor wrote a nice wrapper for this, making this process a bit more palatable:

let predict (input:float[]) =
    let mutable result = Array.empty<float>
    alglib.dfprocess(forest, input, &result)
    result.[0]

predict [| 30.0; 0.0; 1.0 |]
> 
val it : float = 33.45812375

Interestingly, while training doesn’t like missing values, it seems dfprocess deals with it quite well:

predict [| Double.NaN; Double.NaN; Double.NaN |]
> 
val it : float = 183.445

I tried out a couple of variants (predict [| 30.0; 0.0; Double.NaN |], predict [| Double.NaN; 0.0; 1.0 |]), and in each case got a different prediction. I assume ALGLIB is picking up the most likely value when the input is missing, but I don’t know for sure what the algorithm is doing there.

Categorical and Ordinal input

So far, we have used only input values that were numerical. However, one of the nice properties of random forests is that they are quite flexible, and can handle virtually any type of input.

Let’s try to incorporate sex, and the port of embarkation - Southampton, Cherbourg or Queenstown. ALGLIB has a very good description of how they encode variables. Categorical (or, in their parlance, Nominal) variables are encoded either as:

0 or 1 for variables with 2 states,
“1-of-N” for variables with 3 states or more.

So incorporating sex would simply entail adding a column with 0.0 or 1.0 values for either case, and encoding the port of embarkation would use a 3-state vector, [1.0;0.0;0.0] for Southampton, [0.0;1.0;0.0] for Cherbourg, and [0.0;0.0;1.0] for Queenstown.

This ignores the possibility of missing data, however. We can take 3 strategies here (as well as for numerical values):

we do not think missing data conveys useful information, and filter it out as we did,
we think missing value conveys useful information, in what case we can simply add another state. For instance, port of embarkation would take 4 states, the 4th one being “unknown port of embarkation”, represented as [0.0;0.0;0.0;1.0],
we can attempt to replace missing values by “reasonable ones”. In general I tend to dislike making up data, but at the same time, in the case of a dataset where all rows contain mostly good data with some missing, we would end up discarding a lot of rows, which can be a problem.

We could for instance model our data like this, without making any attempt at elegance:

let trainingset = 
    sample
    |> Seq.map (fun row ->
        [|
            // the inputs x
            row.Age
            float row.Parch
            float row.SibSp
            // modelling a simple categorical,
            // discarding unknown / missing data
            (if row.Sex = "male" then 1.0 elif row.Sex = "female" then 0.0 else Double.NaN)
            // modelling a categorical with missing values
            (if row.Embarked = "S" then 1.0 else 0.0)
            (if row.Embarked = "C" then 1.0 else 0.0)
            (if row.Embarked = "Q" then 1.0 else 0.0)
            (if row.Embarked = "" then 1.0 else 0.0)
            // the output y
            float row.Fare
        |])
    |> Seq.filter (fun row -> row |> Seq.forall (number))
    |> array2D

let samplesize = trainingset.GetUpperBound(0)
let features = 8
let classes = 1 // regression
let trees = 10
let featuresincluded = 4
let learningproportion = 0.5

Note that we increased both features and featuresincluded.

Side-note: an interesting point with the port of embarkation is that if we encountered not a missing value, but an unexpected one, the variable would be encoded as [0.0;0.0;0.0;0.0].

Just for kicks, here is the report we get for that model:

  alglib+dfreport {avgce = 0.0;
                   avgerror = 16.9561193;
                   avgrelerror = 0.80103117;
                   innerobj = alglib+dforest+dfreport;
                   oobavgce = 0.0;
                   oobavgerror = 27.7157343;
                   oobavgrelerror = 1.263475249;
                   oobrelclserror = 0.0;
                   oobrmserror = 56.29947845;
                   relclserror = 0.0;
                   rmserror = 33.70286595;}

The out-of-bag RMSE dropped from 57.16 to 56.29. Looks like these features are not very helpful…

One last thing worth considering is ordinal values. A good example on this dataset is Class. Class is not quite a numerical value (how far apart they are is meaningless), but the order matters: first class is (in some sense) greater than second, which itself is greater than third.

Both encodings - as a Categorical, or as a Numerical - are valid. One possible benefit of representing Class as Numerical is that it can implicitly create “groupings”. Because 1 < 2 < 3, it would make sense to lump together “1 and 2” vs. “3”, or “1” vs. “2 and 3”, which is how continuous values are handled in a tree, dividing them by segments.

Classification

Let’s try now to use the random forest as a classifier. The only differences here are with the last column in the training set, which will now contain the “index” of the class, and the form of the output.

Let’s begin with a classic exercise, and predict who survives on the Titanic.

let trainingset = 
    sample
    |> Seq.map (fun row ->
        [|
            // the inputs x
            row.Age
            float row.Parch
            float row.SibSp
            // modelling a simple categorical,
            // discarding unknown / missing data
            (if row.Sex = "male" then 1.0 elif row.Sex = "female" then 0.0 else Double.NaN)
            // modelling a categorical with missing values
            (if row.Embarked = "S" then 1.0 else 0.0)
            (if row.Embarked = "C" then 1.0 else 0.0)
            (if row.Embarked = "Q" then 1.0 else 0.0)
            (if row.Embarked = "" then 1.0 else 0.0)
            // the output y
            (if row.Survived then 1.0 else 0.0)
        |])
    |> Seq.filter (fun row -> row |> Seq.forall (number))
    |> array2D

We simply encode survival as 1.0 or 0.0; all we need to do then is change classes to 2 (we have 2 cases) and run the model:

let samplesize = trainingset.GetUpperBound(0)
let features = 8
let classes = 2 // classification
let trees = 10
let featuresincluded = 4
let learningproportion = 0.5
    
let info,forest,report = 
    alglib.dfbuildrandomdecisionforestx1(
        trainingset, // training data
        samplesize, // how many observations
        features, // how many features/variables
        classes, // how many classes; 1 represents regression
        trees, // how many trees to build; recommended: 50 to 100
        featuresincluded, // how many features retained when splitting
        learningproportion // how much of the sample to use for each tree. Recommended: 0.05 (high noise) to 0.66 (low noise)
        )

What predictions do we get now?

let mutable output = Array.empty<float>
let input = [| 30.0; 0.0; 1.0; 0.0; 1.0; 0.0; 0.0; 0.0 |]
alglib.dfprocess(forest,input,&output)
printfn "Prediction: %A" output 
> 
Prediction: [|0.7; 0.3|]

Instead of a bare-bones class prediction, we get a full probability distribution on the possible outcomes: 70% chances of not making it, and 30% of surviving. This is quite nice (for us, not for that hypothetical passenger, obviously).

Similarly, we could try, say, to predict the port of embarkation. In this case, we have 3 classes (Southampton, Cherbourg or Queenstown). Without any attempt at elegance, let’s encode this, creating values 0, 1 and 2 for each case, and changing classes to 3:

let trainingset = 
    sample
    |> Seq.map (fun row ->
        [|
            // the inputs x
            row.Age
            float row.Parch
            float row.SibSp
            // modelling a simple categorical,
            // discarding unknown / missing data
            (if row.Sex = "male" then 1.0 elif row.Sex = "female" then 0.0 else Double.NaN)
            // the output y
            (if row.Embarked = "S" then 0.0 
             elif row.Embarked = "C" then 1.0
             elif row.Embarked = "Q" then 2.0
             else Double.NaN)
        |])
    |> Seq.filter (fun row -> row |> Seq.forall (number))
    |> array2D

// note the NaNs

let samplesize = trainingset.GetUpperBound(0)
let features = 4
let classes = 3 // classification
let trees = 10
let featuresincluded = 2
let learningproportion = 0.5

If we now ask for predictions, for, say, a 30-years old male travelling without children or parents, with a spouse or sibling, we get:

let mutable output = Array.empty<float>
let input = [| 30.0; 0.0; 1.0; 0.0 |]
alglib.dfprocess(forest,input,&output)
printfn "Prediction: %A" output 
> 
Prediction: [|0.4; 0.6; 0.0|]

That person most likely embarked in Cherbourg, with 60% chance, or in Southampton, with 40% chance.

Note: if the classes do not match the number of cases in the last column, alglib.dfbuildrandomdecisionforestx1 will return a flag of -2.

Parting thoughts

In my opinion, in spite of some quirks, the ALGLIB random forest is quite nice, and potentially very useful. What I like about it is that it is a full-fledged random forest; this is an extremely versatile algorithm, which, in my experience, “always works”. What I mean by that is, other algorithms will potentially give you better results - but a random forest is fast, easy to set up, and will produce decent predictions, and handle with minimal effort both regression and classification problems, incorporating data in all shapes and forms.

The quirky parts are around the API. I would have expected the function alglib.dfbuildrandomdecisionforestx1 to always return, indicating with return codes if something went wrong. This is obviously not the case; I might be misunderstanding some aspects, and would love to hear from you if you know something about this.

The way alglib.dfprocess uses byref to produce outputs is a bit unsettling, and some of the choices around the alglib.dfbuildrandomdecisionforestx1 function signature are a bit odd to me. Why do I need to pass the size of the training set, when it can be computed from the data we are passing in? Similarly, why do I need to specify how many variables are used? The documentation hints at the possibility of having more than one column for regression outputs, but I had no success with that.

Still - these are details. I’ll take the quirks, for a library that does what I want, and there are things I like about the modelling choices. Getting a full distribution on the possible classification outputs instead of a single prediction is nice; even though in both cases the most likely output is the same, it is quite different to know that the model thinks a particular outcome has a 99.9% chances of happening, vs. only 50.1%.

That’s it - hope you got something out of this guided tour of the ALGLIB random forest.

Gradient Boosting using Automatic Differentiation

2016-09-03T00:00:00+00:00

Today, we’ll close our exploration of Gradient Boosting. First, we looked into a simplified form of the approach, and saw how to combine weak learners into a decent predictor. Then, we implemented a very basic regression tree. Today, we will put all of this together. Instead of stumps, we will progressively fit regression trees to the residuals left by our previous model; and rather than using plain residuals, we will leverage DiffSharp, an F# automatic differentiation library, to generalize the approach to arbitrary loss functions.

I won’t go back over the whole setup again here; instead I will just recap what we have at our disposition so far. Our goal is to predict the quality of a bottle of wine, based on some of its chemical characteristics, using the Wine Quality dataset from the UCI Machine Learning repository. (References: P. Cortez, A. Cerdeira, F. Almeida, T. Matos and J. Reis. Modeling wine preferences by data mining from physicochemical properties. In Decision Support Systems, Elsevier, 47(4):547-553, 2009.)

Gist available here

We are using a couple of types to model our problem:

type Wine = CsvProvider<"data/winequality-red.csv",";",InferRows=1500>

type Observation = Wine.Row
type Feature = Observation -> float
type Example = Observation * float
type Predictor = Observation -> float

To predict wine quality, we extracted 10 features from the dataset:

let features = [
    ``Alcohol Level``
    ``Chlorides``
    ``Citric Acid``
    ``Density``
    ``Fixed Acidity``
    ``Free Sulfur Dioxide``
    ``PH``
    ``Residual Sugar``
    ``Total Sulfur Dioxide``
    ``Volatile Acidity``
]

We have available a basic regression tree implementation, learnTree, which, given a sample, a list of Feature, will learn a tree to a given depth.

Using Trees instead of Stumps

Our goal now is to revisit our initial simplified boosting implementation, but use a regression tree instead of stumps. In other words, in the original version, at each iteration, we were trying to find the stump that fitted the residuals best; now we want to find the tree that fits the residuals best.

The problem statement suggests an obvious direction: we don’t really care what approach we are using, we simply want to learn the best possibly predictor given a sample. It could be stumps, or trees, or whatever you fancy. Let’s create a type to represent that:

type Learner = Example seq -> Predictor

Given a set of examples, that is, observations, and the value to predict, a Learner will do its magic, and return to us the best Predictor it can find.

All we need to do then is rearrange a bit our original code, and inject an arbitrary Learner:

let learn (sample:Example seq) (learner:Learner) (depth:int) =

    let rec next iterationsLeft predictor =
        
        // we have reached depth 0: we are done
        if iterationsLeft = 0 
        then predictor
        else
            // compute new residuals,
            let newSample = 
                sample 
                |> Seq.map (fun (obs,y) -> obs, y - predictor obs)

            // learn a predictor against residuals,
            let newPredictor = learner newSample

            // create new predictor
            let newPredictor = fun obs -> predictor obs + newPredictor obs

            // ... and keep going
            next (iterationsLeft - 1) newPredictor

    // initialize with a predictor that 
    // predicts the average sample value
    let baseValue = sample |> Seq.map snd |> Seq.average
    let basePredictor = fun (obs:Observation) -> baseValue

    next depth basePredictor

That’s pretty much it. If we want to learn a Tree, the only thing we need is to create a function with the appropriate signature; given that the trees appeared to overfit after depth 3, that’s the limit we will give them:

let treeLearner (sample:Example seq) = 
    learnTree (evenSplitter 5,sumOfSquaresCost) sample features 3
    |> predict

The treeLearner function has signature sample:seq<Example> -> (Observation -> float), so all we need to do now is to “inject” it into our learn function.

[ 1 .. 5 ]
|> List.map (fun depth ->
    let model = learn redSample treeLearner depth
    depth, averageSquareError redSample model)

In this case, we run our learning procedure at deeper and deeper levels, recording the depth and prediction quality at each step:

val it : (int * float) list =
  [(1, 0.472892841); (2, 0.4591086941); (3, 0.4564827282); (4, 0.4553268525);
   (5, 0.4550962347)]

The results are not amazing, but that’s OK, our goal here is not to create the best model for that particular problem. We just want to confirm that things are working, and this appears to be the case: as we increase depth, the average prediction error does go down.

Pseudo-Residuals and Gradients

You might have wondered by now “why is this called Gradient Boosting”? So far, there hasn’t been a single reference to a gradient. Where does this fit in?

Note that at each step of the algorithm, we are fitting a predictor to the residuals left by the current best predictor. In other words, for observation i, with a current best predictor $ F(x) $, we are computing residuals $ r_i $ as

\[r_i = y_i - F(x_i)\]

This makes sense on an intuitive level: we are trying to learn a new model that will adjust for whatever our current best predictor “misses”. However, there is another way to look at this. If you consider the loss function:

\[L(y_i,F(x_i)) = \frac 12 \times (y_i - F(x_i))^2\]

… then the residuals as we are computing them happen to be the gradient of that particular loss function.

This is interesting, for 2 reasons. First, this connects gradient boosting to gradient descent: what we have been doing so far can be seen as gradient descent, implicitly using the sum-of-square residuals (or SSR), as a loss function, and trying at each step to find a predictor that most closely matches the gradient. Then, this allows us to generalize our algorithm. Rather than using the “plain residuals”, we can decide on any arbitrary loss function, and compute the pseudo residuals at each step as the gradient of the loss function we are interested in.

This also opens a new problem: if we do not use the SSR as a loss function, simply stacking up the predictors we get at each iteration will not necessarily give us the smallest overall loss. So instead of building our aggregate predictor as

\[F_m(x) \leftarrow F_{m-1}(x) + h_m(x)\]

where $ F_m(x) $ is our best predictor at stage m and $ h_m(x) $ is the predictor we fitted against the residuals, we need to now construct,

\[F_m(x) \leftarrow F_{m-1}(x) + \gamma \times h_m(x)\]

… where $ \gamma $ is the value that minimizes the loss function for $ F_m(x) $.

Replacing residuals by pseudo-residuals

Let’s leave it at that for theory, and see if we can get this to work. As a first step, we will stick with SSR as a loss function, so that we can ignore “the gamma problem”, and simply use our current algorithm, replacing the manual residuals computation by using the gradient.

Fortunately, the gradient computation is a simple problem to solve here, thanks to an awesome F# library, DiffSharp. In a nutshell, DiffSharp will take any F# function, and automatically differentiate it for you.

For simplicity, I used version 0.6.3 of DiffSharp here (by setting up the Paket dependenty to nuget diffsharp < 0.7.0). Versions 0.7 and higher support BLAS/LAPACK, which yields better performance, but is potentially more complicated. I went for ease.

Let’s add a reference to DiffSharp to our script first:

#r "fsalg/lib/fsalg.dll"
#r "diffsharp/lib/diffsharp.dll"
open DiffSharp.Numerical

What does this buy us? Let’s define a Loss type to represent a loss function:

type Loss = float -> float

The Loss will take as an input y - predictor x, and return the corresponding loss / penalty. For instance, we can define

let squareLoss : Loss = fun x -> 0.5 * pown x 2

The beauty of DiffSharp is that I can take that function, and differentiate it:

let diffSquareLoss = diff squareLoss

>
val diffSquareLoss : (float -> float)

I immediately get back a function, which I can plot:

[ - 5.0 .. 0.1 .. 5.0 ]
|> List.map (fun x -> x, diffSquareLoss x)
|> Chart.Line 
|> Chart.Show

This is not the most thrilling chart, but proves our point. If we were to use squareLoss as a Loss function, then differentiating it gives us back the residuals themselves. All we have to do then is to replace our manual residuals computation, by injecting a Cost function and computing the pseudo-residuals using DiffSharp:

type Loss = float -> float

let draftBoostedLearn (sample:Example seq) (learner:Learner) (loss:Loss) (depth:int) =

    let pseudoResiduals = diff loss

    let rec next iterationsLeft predictor =
        
        // we have reached depth 0: we are done
        if iterationsLeft = 0 
        then predictor
        else
            // compute new residuals,
            let newSample = 
                sample 
                |> Seq.map (fun (obs,y) -> 
                    obs, 
                    pseudoResiduals (y - predictor obs))

            // learn a tree against residuals,
            let residualsPredictor = learner newSample

            // create new predictor
            let newPredictor = 
                fun obs -> 
                    predictor obs + residualsPredictor obs

            // ... and keep going
            next (iterationsLeft - 1) newPredictor

    // initialize with a predictor that 
    // predicts the average sample value
    let baseValue = sample |> Seq.map snd |> Seq.average
    let basePredictor = fun (obs:Observation) -> baseValue

    next depth basePredictor

If we pass in the squareLoss function, we should get exactly the same results as before. Let’s confirm this:

let squareLoss : Loss = fun x -> 0.5 * pown x 2

[ 1 .. 5 ]
|> List.map (fun depth ->
    let model = draftBoostedLearn redSample treeLearner squareLoss depth
    depth, averageSquareError redSample model)

The evaluation of our model at various depths is identical to what we had previously - it looks like we are in business:

> 
val it : (int * float) list =
  [(1, 0.472892841); (2, 0.4591086941); (3, 0.4564827282); (4, 0.4553268525);
   (5, 0.4550962347)]

Optimal model combination

Let’s tackle now the problem of finding the “right” value gamma to combine our predictors. What we want is the following: given 2 predictors f1 and f2 and a Loss function, we need to find a value gamma, such that f1 + gamma * f2 minimizes the value of the loss, summed across a sample.

Let’s start with the easy one: combining predictors. That’s straightforward:

let combination f1 f2 gamma : Predictor =
    fun obs -> f1 obs + gamma * f2 obs

If f1 and f2 are given, combination is simply a function of gamma. What we need is an algorithm that will find a value of gamma that minimizes Loss. Let’s use a slightly simplified version of the gradient descent implementation provided on the DiffSharp page:

let gradientDescent f x0 eta epsilon =
    let rec desc x =
        let g = diff f x
        if abs g < epsilon
        then x
        else
            desc (x - eta * g)
    desc x0

Explaining gradient descent would take us a bit more time than we want to spend here; in a nutshell, the algorithm takes a function and, starting from an initial value, follows the direction of steepest descent, given by the gradient. The step size is given by the parameter eta, and, once the changes become small and fall under a given threshold value epsilon, the algorithm stops.

The nice thing here is that, thanks to DiffSharp, we have a generic algorithm that will identify the minimum value for any function. As an example of usage,

let foo x = pown x 2
let min_foo = gradientDescent foo 10. 0.1 0.0001

… will find the minimum 0.0 of $ f(x) = x^2 $ , starting from x = 10.0.

All we need to do then is to use gradient descent to find the “best gamma”:

let optimalGamma (sample:Example seq) f1 f2 (penalty:Loss) =

    let combine gamma = combination f1 f2 gamma
    let costOf gamma =
        sample
        |> Seq.sumBy (fun (obs,y) ->
            combine gamma obs - y |> penalty)

    gradientDescent costOf 1.0 0.001 0.01

We create a combine function, with a single argument gamma, and a costOf function that computes, for a given value of gamma, the total cost (as measured by the loss function) summed across the sample. We can then pass that function costOf to our gradient descent implementation - if everything goes according to plan, this will spit out the optimal value of gamma.

I set the values for eta and epsilon to 0.001 and 0.01 quite arbitrarily here. Poorly chosen values for eta can cause issues: if it is too large, gradient descent will not converge. I simply tuned it by hand to work on my example - be warned that if you want to use this code, you may have to adjust it!

Let’s re-arrange again our learning algorithm, and incorporate that bit:

let boostedLearn (sample:Example seq) (learner:Learner) (loss:Loss) (depth:int) =

    let pseudoResiduals = diff loss

    let rec next iterationsLeft predictor =
        
        // we have reached depth 0: we are done
        if iterationsLeft = 0 
        then predictor
        else
            // compute new residuals,
            let newSample = 
                sample 
                |> Seq.map (fun (obs,y) -> 
                    obs, 
                    pseudoResiduals (y - predictor obs))

            // learn a tree against residuals,
            let residualsPredictor = learner newSample

            // find optimal gamma
            let gamma = optimalGamma sample predictor residualsPredictor loss

            // create new predictor
            let newPredictor =
                fun obs -> 
                    predictor obs + gamma * residualsPredictor obs

            // ... and keep going
            next (iterationsLeft - 1) newPredictor

    // initialize with a predictor that 
    // predicts the average sample value
    let baseValue = sample |> Seq.map snd |> Seq.average
    let basePredictor = fun (obs:Observation) -> baseValue

    next depth basePredictor

If everything is working as we expect, nothing should have changed. Let’s confirm that:

[ 1 .. 5 ]
|> List.map (fun depth ->
    let model = boostedLearn redSample treeLearner squareLoss depth
    depth, averageSquareError redSample model)

> 
val it : (int * float) list =
  [(1, 0.472892841); (2, 0.4591086941); (3, 0.4564827282); (4, 0.4553268525);
   (5, 0.4550962347)]

Example using the Huber loss function

So what did we gain here? So far, nothing: the net result is an added dependency, and a slower and more complex algorithm.

Stated that way, this might not appear as a great success. However, we now have the ability to plug in virtually any loss function we want.

Why would you want to do that? Using the sum-of-squares as a loss function has its benefits, but it won’t always be what you want. One of its drawbacks is that it penalizes very heavily outliers. If you have a couple of observations in your sample which your model struggles to predict, and cause large errors, using SSR as a loss function will put a very large penalty on these, and will try its best to reduce the error, at the expense of the overall sample.

That is one reason why it is sometimes convenient to use different loss functions. As an example, let’s consider the Huber loss function (thanks @evelgab for the pointer!):

\[L_{\delta}(x) = \begin{cases} \frac 12 x^2 & \text{for } \lvert x \rvert \le \delta \\ \delta (\lvert x \rvert - \frac 12 \delta) & \text{otherwise} \end{cases}\]

In a nutshell, what this function does is the following: for errors under a certain level delta, it applies a square penalty; beyond that level, the penalty becomes linear. In other words, small errors will get the same penalty as with the SSR, but after a certain point, the cost stops growing as aggressively. As a result, large outliers will not get slammed as hard as with SSR.

Let’s implement that function in F#:

let huber delta x = 
    if abs x <= delta
    then 0.5 * pown x 2
    else delta * (abs x - 0.5 * delta)

… and take a look at its profile:

[ - 5.0 .. 0.1 .. 5.0 ]
|> List.map (fun x -> x, huber 1.0 x)
|> Chart.Line 
|> Chart.Show

Another angle on the Huber function, perhaps more intuitive, is to consider what the pseudo-residuals would look like under Huber loss. Taking a value of 1.0 for delta, this is what we get:

let diffHuber = diff (huber 1.0)

[ - 5.0 .. 0.1 .. 5.0 ]
|> List.map (fun x -> x, diffHuber x)
|> Chart.Line 
|> Chart.Show

What this chart shows is that when errors go beyond +/- 1.0 the pseudo residuals flattens out. As a result, when we try to fit a predictor to the pseudo-residuals, it will treat large and very large prediction errors as equivalent.

This loss function is much more complex than the SSR. And yet, all we had to do is to write it, and DiffSharp differentiated it without blinking. We can take that function, pass it to our learning algorithm, and let diffSharp handle the differentiation work:

let huber delta x = 
    if abs x <= delta
    then 0.5 * pown x 2
    else delta * (abs x - 0.5 * delta)

let huberPredictor = boostedLearn redSample treeLearner (huber 1.0) 5

And… that’s it - it just works. No need to change anything, the algorithm will now use that loss function to compute the pseudo-residuals and gammas, all by itself.

Conclusion

That concludes our exploration of gradient boosting.

First, I want to state that the code presented here is far from optimal. Zero consideration has been given to performance, gradient descent might violently diverge, and it’s quite plausible that bugs are present. In other words, you’ve been warned, use this for inspiration, and not in production :)

My objective here was purely to explore Gradient Boosting, building the algorithm from the ground up to better understand how it works. I am glad I did; first, I find the algorithm quite interesting. It is both quite general, and fairly simple conceptually: fit your model, look at what the model didn’t catch (the residuals), try to fit another model to that, and combine the models together. I also found the idea of looking at the residuals in terms of gradient very insightful - definitely an a-ha moment.

The other interesting part to me was DiffSharp. I had spent some time with the library in the past, but hadn’t quite realized how flexible it is. When I first started writing this post, I initially used the pseudo-Huber loss function, because I assumed DiffSharp would need a continuous function to work with. I was quite surprised when, “just for fun”, I tried to differentiate the regular version I had written in plain F#, and it just worked. I guess the moral of the story is, make sure to do things “just for fun” with code - there is something waiting to be learnt there!

That’s it for me - I hope you got something out of the exercise, too!

Gist available here

GSD with F#, or how I ported my blog to Jekyll

2016-08-28T00:00:00+00:00

One of the reasons I use F# so much is that it’s an awesome scripting language to Get Stuff Done. Case in point: this blog. I recently decided to switch from BlogEngine.NET to Jekyll, which meant porting over nearly 9 years of blog posts (about 300), extracting html-formatted content from SQL and converting it to markdown. After a couple of weeks of manual process, I realized that at the current cadence, it would take me about a year to complete, and that by then I would probably have lost my mind out of boredom. Time for some automation with F# scripts!

Source: xkcd

My goal here was not to do anything fancy or elegant. I just wanted to get a dumb task over with, with minimum effort. Any code I would have to write would need to pass the following basic test: “will I be done faster with code, including the time it takes me to write it?”. In other words, quick-and-dirty hackery is perfectly OK; or, stated differently, don’t look for best practices in this post.

Extracting posts with the SQL Type Provider

First step: I need access to the data. All contents are stored in an antediluvian SQL Server instance somewhere on GoDaddy (don’t judge, we all have made some mistakes in our youth), so no luck using the shiny F# SQL Client - we’ll go for the F# SQL Provider instead.

All we need is a connection string:

#r "packages/sqlprovider/lib/fsharp.data.sqlprovider.dll"
open FSharp.Data.Sql

[<Literal>]
let connectionString = """Data Source=TOP-SECRET-CONNECTION-STRING"""

type sql = SqlDataProvider<Common.DatabaseProviderTypes.MSSQLSERVER,connectionString>
let context = sql.GetDataContext()

let posts = 
    context.Dbo.BePosts
    |> Seq.take 10
    |> Seq.toArray

We are now in good shape: we can start querying posts, and accessing all the relevant data:

Creating a post

Next, we need to take a blog post, and create a markdown document that complies with Jekyll expectations. Posts go into the _posts folder, the file name follows the pattern 2016-08-28-gsd-with-fsharp.md, and the content is organized along these lines:

---
layout: post
title: GSD with F#, or how I ported my blog to Jekyll
tags:
- F#
- Type-Provider
- Blog
---

Above the fold content goes here...

<!--more-->

... and the rest goes there.

Let’s leave the content part aside for a moment. All we need is to

create a file name from the original publish date and slug,
fill in the template with the original title and the formatted tags,
save that text file in the correct folder.

Let’s start with a couple of utility functions:

open System
open System.IO
open System.Globalization

let textInfo = CultureInfo("en-US",false).TextInfo

let formatTag (tag:string) =
    tag.Trim() 
    |> textInfo.ToTitleCase 
    |> fun text -> text.Replace(" ","-")

let extractTags (post:sql.dataContext.``dbo.be_PostsEntity``) =
    post.``dbo.be_PostTag by PostID``
    |> Seq.toList
    |> List.map (fun tag -> tag.Tag)
    |> List.map formatTag

let formatDate (date:DateTime) = date.ToString("yyyy-MM-dd")

let postsPath = @"C:\Users\Mathias Brandewinder\Documents\GitHub\mathias-brandewinder.github.io\_posts"

We use System.Globalization.CultureInfo to capitalize the tags consistently, so that extractTags can now take a Post from the SQL Provider, and convert all the attached tags to a list of capitalized strings. At that point, we are ready to go:

let processPost (post:sql.dataContext.``dbo.be_PostsEntity``) =

    let postDate = post.DateCreated
    let postTitle = post.Title
    let postTags = extractTags post
    let postSlug = post.Slug

    let formattedTags = 
        postTags 
        |> List.map (fun tag -> sprintf "- %s" tag) 
        |> String.concat "\n"

    let header = sprintf "---\nlayout: post\ntitle: %s\ntags:\n%s\n---" postTitle formattedTags

    let content = "TODO"

    let newPost = header + "\n" + content
    let newPostName = (formatDate postDate) + "-" + postSlug + ".md"
    let newPostFile = Path.Combine(postsPath, newPostName)

    File.WriteAllText(newPostFile,newPost)

We take in a post, extract all the information we need, basically fill in the blanks in the template, and save it.

Is it pretty? Nope. Does it get the job done? Yes.

There are minor flaws (I’d prefer the tag Fsharp to be formatted as FSharp for instance), but this is good enough, I am fine with fixing this by hand. Moving on.

Converting html to markdown

The last missing piece here is the post content itself. post.PostContent gives us back a string, the html formatted contents. We could probably leave most of it as-is, but this would be a bit sad. The beauty of markdown is that it is fairly human-readable even in raw form, so I’d much prefer to convert from html to plain markdown.

This is not too complicated. Posts mostly follow the same structure, and, at the top level, are a sequence of either:

“Chapter” header <h2> / </h2>,
Paragraph <p> / </p>,
Code block, delimited by <pre class="brush: fsharp; ..."> / </pre>.

Within paragraphs, besides plain text, we can also find:

Images, with the image location and some extra information <img src="http://url/pic.jpg" ...,
Links, with the text and url <a href="http://link-url"> / </a>.

When I hear the sentence “it can be either a Foo, a Bar or a Baz”, I take this as a cue to consider Discriminated Unions. The specific topic of html and markdown also brought back memories of a talk on Domain Specific Languages with F# by Tomas Petricek, which inspired me to try the following:

type Block =
    | RawText of string
    | Link of string * string // txt, url
    | Image of string * string // alt, url

type Language =
    | CSharp
    | FSharp
    | VB
    | Other

type Content =
    | Paragraph of Block list
    | Header of string
    | Code of Language * string
    | Problem of string

This could of course be improved upon, but, once again, this is good enough, and represents fairly cleanly in code what I described before: the Content of a post can be a simple Header, a Code section, a Paragraph, which itself is a list of blocks (raw text, link or image) - or a Problem if we encounter something malformed.

All that’s left to do is to parse a post, in two passes: break it down first in a list of Content blocks, and then break down each Paragraph further into a list of Blocks.

Let’s start with the first pass, and ignore images and links for the moment. This is roughly what I started with:

let (|BlockBetween|_|) (openToken:string,closeToken:string) (txt:string) =
    if txt.Length = 0
    then None
    elif txt.StartsWith openToken
    then
        let endAt = txt.IndexOf closeToken
        let block = txt.Substring(0, endAt + closeToken.Length)
        let rest = txt.Substring(endAt + closeToken.Length)
        Some(block,rest)
    else None

What this Active Pattern allows me to do is to pass a pair of tokens/delimiters, such as <h2> and </h2>, and apply the pattern to a string, to extract out a matching string, and the rest of the text, like this:

match "<h2>This is a header</h2>and this is more stuff" with
| BlockBetween ("<h2>","</h2>") (content,rest) -> Some(content,rest)
| _ -> None

… which produces the following result:

val it : (string * string) option =
  Some ("<h2>This is a header</h2>", "and this is more stuff")

All I have to do now is to recursively walk down the document, and progressively process the post contents, until there is nothing left to do, along these lines:

let paragraphTokens = ("<p>","</p>")
let codeTokens = ("<pre ","</pre>")
let headerTokens = ("<h2>","</h2>")

let rec pageComponents acc (txt:string) =

    match txt with

    | BlockBetween paragraphTokens (block,rest) -> 
        let blocks = parseParagraph block
        pageComponents ((Paragraph blocks) :: acc) rest

    | BlockBetween codeTokens (block,rest) -> 
        let code = parseCode block
        pageComponents (code :: acc) rest

    | BlockBetween headerTokens (block,rest) -> 
        let header = parseHeader block
        pageComponents (header :: acc) rest

    | Malformed ["<p>";"<pre ";"<h2>"] (block,rest) -> 
        pageComponents ((Problem block) :: acc) rest

    | _ -> acc |> List.rev    

I’ll skip on the details (ask me in the comments if you want to know more); basically, we try to recognize either a paragraph, code, headers, or problematic blocks, apply the appropriate parser (parseParagraph for a paragraph, parseCode for code, etc…) to it (more on that in a second), append the result to a list and move to the remaining chunk of text until there is nothing left to do. At that point, we have converted a raw block of text in a list of well-defined Content.

Parsing stuff

I confess that when I began this, I hadn’t fully thought through how I would go about extracting information from images or links. When I hit that point, it quickly became apparent that my cheap BlockBetween approach was not going to cut it. Situations such as an image within a link within a paragraph quickly become very nasty. I briefly contemplated Regex - also not a great idea.

And then I remembered that fsharp.Data has an Html parser. Suddenly, life was good again.

This allowed me to do things along these lines:

#r "packages/fsharp.data/lib/net40/fsharp.data.dll"
open FSharp.Data

let parseHeader (txt:string) =
    HtmlNode.Parse(txt) 
    |> List.head 
    |> HtmlNode.innerText 
    |> Header

We pass a string (expected to be a well-formed <h2> header) to HtmlNode.Parse, which returns a list of HtmlNodes; we take the first one (the head), grab its innerText, and construct a Header (one of the 4 cases of Content).

For headers, the benefits are marginal. However, when dealing with links, this begins to pay off:

let parseLink (node:HtmlNode) =
    let imgs = node.Descendants ["img"]
    if (Seq.isEmpty imgs)
    then
        let txt = node.InnerText ()
        let url = node.AttributeValue("href")
        Link(txt,url)
    else
        let img = imgs |> Seq.head
        let txt = img.AttributeValue("alt")
        let url = img.AttributeValue("src")
        Image(txt,url)

In this case, we search inside an HtmlNode for potential images (descendants marked img); if there isn’t one, this is a pure link, and we grab the href attribute value, and construct a Link; otherwise, this is an image wrapped in a link, and we retrieve the alt and src attributes to form an Image.

I won’t go into more detail here. Some of the code is pretty ugly, and I am probably not using that parser in the best way possible - the main goal here was to quickly get something that was mostly working. My hope is to give you enough of a sense for what this parser does, so that if you encounter a similar problem, you’ll go check it out, but read the awesome documentation instead of relying on my horrendous, hacky code :)

Anyways - at that stage, conveniently ignoring a couple of details, we are about done. Once the raw html content has been converted into a list of Content, all we need is to convert each of them into its markdown representation. As a quick example, a Block can be either raw text, a link, or an image - all it takes is a bit of pattern matching to spit out a string:

let blockWriter (block:Block) =
    match block with
    | RawText(txt) -> txt
    | Link(txt,url) -> sprintf "[%s](%s)" txt url
    | Image (alt, url) -> sprintf "![%s](%s)" alt url

Using the same idea at the Content level with a contentWriter function, we just have to take the raw html content, break it into a list of Content using our pageComponents function, apply a List.map contentWriter to convert everything to markdown string, concatenate, et voila! Most of the time, we have a well-formed markdown string, which we can now inject as content in our post template.

Conclusion

This is as far as I’ll go on this today. I obviously used a bit of hand-waving here and there, but hope that the main ideas are clear enough to be of some use. What I left out is so specific to my blog, that I doubt it would be directly applicable anywhere else (or so hacky that I would be ashamed to make it public…). If you want to know more, just ask in the comments!

One reason I thought the experience worth sharing is that it shows F# in action, solving an extremely banal, practical problem. F# is too often described as a language suitable to tackle specialized technical problems (finance, machine learning, scientific computing…) - which is absolutely correct, but entirely misses the fact that it is also an incredibly productive scripting language to get boring stuff done. All it took me was a lazy weekend afternoon to write a quick script pulling data out of SQL, downloading images, and writing a DSL and parser converting html documents into markdown files. Nothing fancy about any of this! I am sure you could be equally productive here with Python or PowerShell, but, at the same time, F# is rarely mentioned as a “glue” scripting languages for rapid prototyping or automation, whereas, in my opinion, it is one area where the language really shines.

Incidentally, this also means that I am done porting over my blog. At some point in the near future, once I have given it a once-over, I will retire the old one - and will exclusively post here from now on, on a true, hand-crafted hipster blog!

@hmemcpy no magic plugin for me, had to parse/convert everything to markdown myself. True artisanal, hand-crafted hipster blog :)
— Mathias Brandewinder (@brandewinder) August 15, 2016

Resources

Basic Regression Tree

2016-08-14T00:00:00+00:00

In our previous installment, we began exploring Gradient Boosting, and outlined how by combining extremely crude regression models - stumps - we could iteratively create a decent prediction model for the quality of wine bottles, using one Feature, one of the chemical measurements we have available.

In and of itself, this is an interesting result: the approach allows us to aggregate mediocre indicators together into a predictor that is better than its individual parts. However, so far, we are using only a tiny subset of the information available. Why restrict ourselves to a single Feature, and not use all of them? And, if the approach works with something as weak as a stump, perhaps we can do better, by aggregating less trivial prediction models?

This will be our goal today: we will create a Regression Tree, which we will in a future installment use in place of stumps in our Boosting procedure.

Regression Trees

Full code for this post available here as a Gist

The Stump model is rather simple: we take a Feature and a split value, the threshold. If the input value is under that threshold, we predict the average output value computed across examples under the threshold, otherwise, we do the opposite:

Or, in code:

type Wine = CsvProvider<"data/winequality-red.csv",";",InferRows=1500>

type Observation = Wine.Row

type Feature = Observation -> float

type Example = Observation * float

type Predictor = Observation -> float

let learnStump (sample:Example seq) (feature:Feature) threshold =
    let under = 
        sample 
        |> Seq.filter (fun (obs,lbl) -> feature obs <= threshold)
        |> Seq.averageBy (fun (obs,lbl) -> lbl)
    let over = 
        sample 
        |> Seq.filter (fun (obs,lbl) -> feature obs > threshold)
        |> Seq.averageBy (fun (obs,lbl) -> lbl)
    fun obs ->
        if (feature obs <= threshold)
        then under
        else over

A regression tree extends the idea further. Instead of limiting ourselves to a single threshold, we can further divide each group, and create trees like this one for instance:

Nothing forces us to keep the tree symmetrical, or to use a single Feature, though. This would be a perfectly acceptable tree as well:

The nice thing about trees is, they are pretty flexible, and very easy to interpret. With a tree, we can incorporate multiple features and their interactions. In our example, we are really modelling Quality as a surface, instead of a simple line in the stump example:

The resulting model can be expressed in a very understandable form:

If the Alcohol Level is over 10.5, the Quality is 5.5; Otherwise, check the Volatile Acidity. If it is below 0.8, the Quality is 6.0, otherwise it is 3.0.

Creating a Tree

How can we go about representing and learning a Tree?

As it turns out, the representation is fairly straightforward. A Tree can be seen as a recursive data structure: either we reached a terminal Leaf, which gives us a prediction, or we reach a Branch, where, based on a Feature and associated split value, we will find 2 new Trees, one for values under the split value, another for values above the split.

That is a match in heaven for a Discriminated Union:

type Tree =
    | Leaf of float
    | Branch of (Feature * float) * Tree * Tree

Creating manually the “complex” tree we described above can be done along these lines:

let exampleTree =
    // we start with a branch
    Branch(
        // we split on Alcohol level, 10.5
        (``Alcohol Level``, 10.5),
        // if alcohol level is under 10.5, 
        // we have another branch
        Branch(
            // we split on Volatile Acidity, 0.8
            (``Volatile Acidity``, 0.8),
            // if acidity is under 0.8, 
            // we predict 6.0
            Leaf(6.0),
            // otherwise we predict 3.0
            Leaf(3.0)
        ),
        // if alcohol is over 10.5,
        // we predict 5.5
        Leaf(5.5)
    )

How do we go about making predictions with a Tree? We simply walk it down recursively:

let rec predict (tree:Tree) (obs:Observation) =
    match tree with
    | Leaf(prediction) -> prediction
    | Branch((feature,split),under,over) ->
        let featureValue = feature obs
        if featureValue <= split
        then predict under obs
        else predict over obs

Let’s try it out on our example:

predict exampleTree (reds.Rows |> Seq.head)

> val it : float = 6.0

Note that, if we use partial application:

let examplePredictor = predict exampleTree

… we get back a function, examplePredictor, which happens to have exactly the signature we defined earlier for a Predictor:

val examplePredictor : (Observation -> float)

As a result, we can immediately re-use the sumOfSquares error function we wrote last time, and evaluate how good our tree is fitting the dataset:

let sumOfSquares (sample:Example seq) predictor = 
    sample
    |> Seq.sumBy (fun (obs,lbl) -> 
        pown (lbl - predictor obs) 2)

let redSample = 
    reds.Rows 
    |> Seq.map (fun row -> row, row.Quality |> float)

sumOfSquares redSample examplePredictor 

val it : float = 1617.0

The result is pretty terrible - but then, I picked the tree values randomly. Can we automatically learn a “good” Tree?

Learning a Tree

If you recall, the approach we followed to learn a “good” stump was the following: for a given Feature, try out various possible split values, and pick the one that gives us the smallest error, defined as the sumOfSquares between the predicted and actual values.

We can use the same idea for a Tree. Instead of stopping once we found a good split, we will simply repeat the same process, and look for a good split in each of the two samples we got after the split. Also, instead of searching for a split on a single Feature, we will now consider all of them, and select the best split across all available Features.

That smells like recursion. As a first pass, we will re-use some of the code we wrote last time, the learnStump and evenSplits functions, and whip together a quick-and-dirty tree learning function, disregarding any performance consideration:

let rec learnTree (sample:Example seq) (features:Feature list) (depth:int) =
    
    if depth = 0
    then
        // we reached maximum depth, and
        // predict the sample average.
        let avg = sample |> Seq.averageBy snd
        Leaf(avg)
    else
        let (bestFeature,bestSplit) = 
            // create all feature * split combinations
            seq {
                for feature in features do
                    let splits = evenSplits sample feature 10
                    for split in splits -> feature,split
            }
            // find the split with the smallest error
            |> Seq.minBy (fun (feature,split) -> 
                let predictor = learnStump sample feature split
                sumOfSquares sample predictor)
        // split the sample following the split
        let under = 
            sample 
            |> Seq.filter (fun (obs,_) -> 
                bestFeature obs <= bestSplit)
        let over = 
            sample 
            |> Seq.filter (fun (obs,_) -> 
                bestFeature obs > bestSplit)
        // learn the corresponding trees
        let underTree = learnTree under features (depth - 1)
        let overTree =  learnTree over features (depth - 1)
        // and create the corresponding branch
        Branch((bestFeature,bestSplit),underTree,overTree)

Let’s try this out, with a Tree that should be equivalent to the first stump we created last time:

let originalStump = learnTree redSample [ ``Alcohol Level`` ] 1
sumOfSquares redSample (predict originalStump)

val it : float = 864.4309287

Good news - we get the same result. Now let’s crank it up a notch:

let deeperTree = learnTree redSample [``Alcohol Level``;``Volatile Acidity``] 4
sumOfSquares redSample (predict deeperTree)

val it : float = 680.1290569

This is significantly better that the best result we achieved by ensembling stumps, 811.4601191.

Cleaning up our act (a bit)

We have a decent-looking Tree learning algorithm. However, not everything is perfect. For instance, emboldened by our success, we could try to increase the depth a bit.

let explodingTree = learnTree redSample [``Alcohol Level``] 5

System.ArgumentException: The step of a range cannot be zero.
Parameter name: step
// long list of F# complaints follows

Uh-oh. What is happening here?

As we recurse deeper in the Tree, we split the samples further and further, and have less and less data to train our stump on. One thing which might happen for instance is that we are left only with examples sharing the same label. In that situation, generating even splits is going to cause issues, because the width in [ min + width .. width .. max - width ] (our evenly-spaced splits) will be 0.0.

This indicates a first problem, namely, that there might not be any good split to use for a given sample.

Beyond that, the design is also a bit problematic. The choice of 10 even splits is quite arbitrary; we might want to use 3, or 42 even splits, or use different strategies altogether (splits of same size, every possible distinct value, …). Our evenSplits function is hard-coded deep inside the algorithm - it would be much nicer if we could inject any split function as an argument.

In a similar vein, assuming we are comfortable with using stumps / binary splits, the choice of our error metric is also quite arbitrary. We might want to use something else that the sum of squared prediction errors (Manhattan distance, variance reduction, …). Again, that function is buried deep inside - we would like to use any reasonable cost function we think relevant to the problem.

Finally, we are picking the split that yields the best cost. However, that split is not guaranteed to be an improvement. As an example, every observation in the sample could have the same label, in which case no split will improve our predictions. If the resulting cost is the same as before, it is pointless to split, and we might as well spare the algorithm a useless deeper search.

In short,

we are not guaranteed to have splits for every sample,
we should split only when strict cost improvements are found,
we would like to decide what splits to use,
we would like to decide what cost metric to use.

We are probably going slightly overboard here; the only real problem we have is the first one. At the same time, why not have a bit of fun!

I am going to start with defining a couple of type aliases and utilities:

let underOver (sample:Example seq) (feat:Feature,split:float) =
    let under = sample |> Seq.filter (fun (obs,_) -> feat obs <= split)
    let over =  sample |> Seq.filter (fun (obs,_) -> feat obs > split)
    under,over

type Splitter = Example seq -> Feature -> float list

type Cost = Example seq -> float

underOver simply takes a sample, and partitions it into 2 samples, based on a feature and a split value. Splitter is a function that, given a sample and a Feature, will produce a (potentially empty) list of values we could split on. Cost simply measures how good a sample is.

Given these elements, we can now rewrite our learnTree function along these lines:

let rec learnTree (splitter:Splitter,cost:Cost) (sample:Example seq) (features:Feature list) (depth:int) =
    
    if depth = 0
    then
        let avg = sample |> Seq.averageBy snd
        Leaf(avg)
    else
        let initialCost = cost sample        
        let candidates = 
            // build up all the feature/split candidates,
            // and their associated sample splits
            seq {
                for feature in features do
                    let splits = splitter sample feature
                    for split in splits -> 
                        let under,over = underOver sample (feature,split)  
                        (feature,split),(under,over)
            }
            // compute and append cost of split
            |> Seq.map (fun (candidate,(under,over)) ->
                candidate,(under,over), cost under + cost over)
            // retain only candidates with strict cost improvement
            |> Seq.filter (fun (candidate,(under,over),splitCost) ->
                splitCost < initialCost)

        if (Seq.isEmpty candidates)
        then
            let avg = sample |> Seq.averageBy snd
            Leaf(avg)
        else
            let ((bestFeature,bestSplit),(under,over),spliCost) = 
                candidates 
                |> Seq.minBy (fun (_,_,splitCost) -> splitCost)

            let underTree = learnTree (splitter,cost) under features (depth - 1)
            let overTree =  learnTree (splitter,cost) over features (depth - 1)

            Branch((bestFeature,bestSplit),underTree,overTree)

Trying it out

Does it work? Let’s try it out:

let evenSplitter n (sample:Example seq) (feature:Feature) = 
    let values = sample |> Seq.map (fst >> feature)
    let min = values |> Seq.min
    let max = values |> Seq.max
    if min = max 
    then []
    else
        let width = (max-min) / (float (n + 1))
        [ min + width .. width .. max - width ]

let sumOfSquaresCost (sample:Example seq) = 
    let avg = sample |> Seq.averageBy snd
    sample |> Seq.sumBy (fun (_,lbl) -> pown (lbl - avg) 2) 

let stableTree = learnTree (evenSplitter 10,sumOfSquaresCost) redSample [``Alcohol Level``;``Volatile Acidity``] 10

sumOfSquares redSample (predict stableTree)

This time, nothing explodes - and the value we get is

val it : float = 331.1456491

The nice thing here is that at that point, all it takes to create and try new trees is a specification for the cost and split functions, and a list of features. We can, for instance, create a Tree using every feature we have available:

let features = [
    ``Alcohol Level``
    ``Chlorides``
    ``Citric Acid``
    ``Density``
    ``Fixed Acidity``
    ``Free Sulfur Dioxide``
    ``PH``
    ``Residual Sugar``
    ``Total Sulfur Dioxide``
    ``Volatile Acidity``
]

let fullTree = learnTree (evenSplitter 5,sumOfSquaresCost) redSample features 10

The results are pretty decent, too:

Out of curiosity, I also performed a crude training vs. testing analysis, to get a feel for potential over-fitting issues.

The result we observe is typical of trees: as we increase depth, the error on the training sample steadily decreases, indicating that deeper tree fit the data better and better. However, the testing sample tells a different story: for a little while, error on the training and testing samples match fairly closely, but after we reach a certain depth (here, 3), they start diverging. While our tree fit the training sample better and better, that improvement doesn’t generalize to other samples, as we can see on the testing sample; at that point, we are over-fitting. In our particular case, this means that we shouldn’t put much trust in trees deeper than 3.

Conclusion

At that point, we have a working regression tree algorithm. It’s not perfect; in particular, we largely ignored any performance consideration. Or, stated more bluntly, performance is terrible ;) Still, the result has a couple nice features, the code is fairly simple, and… it works!

Trees are quite an interesting topic, which we only covered very superficially here. Still, we will leave it at that for now, and focus back on our initial goal, gradient boosting. All we needed was something a bit better than stumps to iteratively fit residuals. We have that now, with regression tree that allow us to learn a predictor using every feature we have available. In our next installments, we will look at replacing stumps with trees, and see where that leads us.

Gist available here

Mathias Brandewinder blog

RANSAC: estimating a model using very noisy data (part 1)

How much of a burden is management?

Parting thoughts

Adding Goal Seek to Quipu (and helping Santa with it!)

Expressing the problem

Solving the problem with Quipu

How does it work?

Parting thoughts

Count distinct items with the CVM algorithm

Naive F# implementation of the CVM algorithm

Why does it even work?

Hamlet

Parting thoughts

Study notes: Softmax function

What is the Softmax function

What is the Softmax function useful for

Interesting properties and semi-random thoughts

Editing a list in Avalonia FuncUI

Adding and Removing items

Editing Items

Dynamic filtering

Parting thoughts

Handling list view selection in Avalonia FuncUI

The ListBox in Avalonia FuncUI

Displaying the Selected Item

Changing the Selected Item

Parting thoughts

Releasing Quipu version 1.0.0, a .NET Nelder-Mead solver

What does it do?

What’s next?

Is there a cost to try catch blocks?

Benchmarking

Parting thoughts

Field notes on integrating a LLM in a Business Workflow

Context

SQL Injection As A Service

Stringly Typed Code

Selecting an Option

Reliability and Testing

Languages

Parting thoughts

Maximum Likelihood estimation with Quipu, part 2

Is this overkill?

Censored observations

Unknown limit

Parting thoughts

Maximum Likelihood estimation with Quipu, part 1

The setup

The problem

Solution with Quipu

Parting thoughts

Delaunay triangulation with Bowyer-Watson: initial super triangle, revisited

Parting thoughts

Delaunay triangulation: hitting an impasse

Parting thoughts

Delaunay triangulation: Bowyer-Watson algorithm

Implementing the algorithm

Adding all the points

Wrapping it all up

Parting thoughts

Delaunay triangulation with Bowyer-Watson: circumcircle

Circumcircle of a Triangle

Parting thoughts

Delaunay triangulation with Bowyer-Watson: initial super triangle

Super Triangle

Visual check

Parting thoughts

Async Commands with Avalonia FuncUi

Basic scaffold

Async Problems

Using Cmd.OfAsync or Cmd.OfTask

Parting thoughts

Maintainable Avalonia FuncUI screen layouts with DockPanels and Borders

DockPanel layout

DockPanel of Doom

Refactoring

Parting thoughts

Micro optimizing F# code with a dash of imperative code

Solver termination

The `ListBox` in Avalonia FuncUI

1) Minor changes in `Program.fs`