C on Greg Foletta - Bits and Blobs

Simulating and Visualising the Central Limit Theorem

Wed, 13 Aug 2025 00:00:00 +0000

I completed a Computer Science degree at uni, and bundled a lot of maths subjects in as electives: partial differential equations, vector calculus, discrete maths, linear algebra. For some reason however I always avoided statistics subjects. Maybe there’s a story to be told about a young person finding uncertainty uncomfortable, because twenty years later I find statistics, particularly the Bayian flavour, really interesting.

One problem with a self-directed journey is that there’s foundational knowledge that has come to me in dribs and drabs, and one of the most foundational is the Central Limit Theorem (CLT). In this post I want to interrogate and explore the CLT using simulation and visualisation in an attempt to understand how it works in practice, not in theory. This is predominantly a process to help me better understand the CLT; you’re just here for the ride. Hopefully that ride can help you get where you need to go as well.

It’s been awhile since I’ve included any code in a post, so where it makes sense I’ll show the generating R code, with a liberal sprinking of comments so it’s hopefully not too inscrutable.

A Brief Recap

I don’t want this to be like an online recipe with pages of back story before you get to the meat and bones, but a brief summary of the CLT before we begin is unavoidable. In plain English the CLT can be described as such:

“If you take repeated samples of size n from a distribution and calculate the sample mean for each, as n gets approaches infinity, the distribution of sample means approaches a normal distribution.”

For the classic CLT there’s a couple of assumptions about the source distribution:

The sample is drawn independently (no autocorrelation like in a time series).
All the data points are drawn from the same distribution (“independent and identically distributed” or i.i.d).
The distribution has a finite mean and variance (e.g. no Cauchy or Pareto distributions).

There are other versions of the CLT in which some of these assumptions are relaxed, but we’ll focus on the ‘classic’ version.

Putting it math terms:

$$ \frac{\bar{X}_n - \mu}{\sigma/\sqrt{n}} \overset{d}\longrightarrow \mathcal{N}(0, 1) $$

Simulating

We’re not the kind of people to just accept something because someone threw some fancy Greek symbols at us. We want to simulate it to give ourselves some confidence it works in practice.

Let’s create a tibble of ten-thousand random values from six different distributions, which we’ll call our ‘population’:

# 10,000 draws from six different distributions
population_data <- tibble(
uniform = runif(10000, min = -20, max = 20),
normal = rnorm(10000, mean = 0, sd = 4),
binomial = rbinom(10000, size = 1, prob = .5),
beta = rbeta(10000, shape1 = .9, shape2 = .5),
exponential = rexp(10000, .4),
chisquare = rchisq(10000, df = 2),
)

uniform	normal	binomial	beta	exponential	chisquare
Six 'Population' Distributions - Ten-Thousand Values - First Five Rows
-15.243338	-0.7022216	0	0.9473270	2.34764246	2.8571390
-9.788476	-3.2383413	1	0.0730441	6.00295709	0.9272733
-11.432831	-2.0977844	0	0.5160286	0.91033272	3.1607328
18.142428	2.5360707	1	0.9428468	3.08170008	1.9489974
-7.078033	-1.7224620	0	0.6134417	0.08687766	2.5317882

This ‘wide’ tibble is good for sampling from, but we’ll also transform it into a long version which will have other uses (note the ’_l’ suffix).

# Long version of random data
population_data_l <-
population_data |>
pivot_longer(cols = everything(), names_to = 'distribution')

distribution	value
Six Distributions - Post 'pivot_longer() - First Value of Each
beta	0.9473270
binomial	0.0000000
chisquare	2.8571390
exponential	2.3476425
normal	-0.7022216
uniform	-15.2433376

Here’s a histogram of each of the population distributions:

Let’s define a function take_random_sample_mean() which takes a sample from all of the population distributions and calculates the mean. If we use this function repeatedly, we should end up with a data set that demonstrates the central limit theorem.

Let’s take 20,000 sample means of size 60, bind it all together into a single data frame, and shape it into a long version.

# Define a function to take a random sample from our data
take_random_sample_mean <- function(data, sample_size) {
slice_sample(.data = data, n = sample_size) |>
summarise(across(everything(), list(sample_mean = mean, sample_sd = sd)))
}
# Draw 20,000 means of size 60 from our random data
sample_size <- 60
sample_means <-
map(1:20000, ~take_random_sample_mean(population_data, sample_size = sample_size)) |>
# Bind the sample means into a single tibble
list_rbind() |>
# Move to a long version of the data
pivot_longer(
everything(),
names_to = c('distribution', '.value'),
names_pattern = '(\\w+)_(\\w+_\\w+)'
)

Here’s the resulting histograms of the samples with only the x-axis free to change scale. The beta and binomial look pretty normal, and the others might be as well, but the differences in variance make it difficult to tell.

If you recall the formula at the start, to get to a standard normal we also need to subtract the population mean and divide by the population standard deviation over the square-root of n. Using the long version of the population data we can calculate the population mean and SD statistics:

population_data_stats <-
population_data_l |>
group_by(distribution) |>
summarise(
population_mean = mean(value),
population_sd = sd(value),
n = n()
)

distribution	population_mean	population_sd	n
Random Means - Statistics
beta	0.64352237	0.3105243	10000
binomial	0.50260000	0.5000182	10000
chisquare	2.03125146	2.0189741	10000
exponential	2.48144359	2.5049145	10000
normal	-0.03205698	3.9813502	10000
uniform	-0.09148261	11.6405771	10000

Joining each of those statistics into the sample means by their distribution allows us to nicely standardise.

# CLT Calculation
clt <-
sample_means |>
# Join in the popultion mean, sd, and n
left_join(population_data_stats, by = 'distribution') |>
# Scale to the standard normal
mutate(
clt = (sample_mean - population_mean) / (population_sd / sqrt(sample_size) )
)

That’s better: they now at least all look the same, except for the binomial which ends up having higher counts because of its discrete rather than continuous values. While you can kind of guess that they’re normal from a histogram, we can get a better sense quantile-quantile plot. The standard normal quantiles are on the x-axis, and our sample mean quantiles are on the y-axis.

They all track pretty closely to a standard normal, however the chi-square and exponential do tend to diverge slightly at the ends. We’ll dive a bit deeper into that later in the post.

Let’s summarise: we took twenty-thousand sample means of size sixty from six wildly different distributions, and we were able to see that the distributions of these sample means approximately followed a normal distribution. This is the essence of the central limit theorem, which allows us to use statistical methods for normal distributions on problems that involve population distributions that aren’t normal.

In Practice, With Mistakes

That’s all well and good if you’ve got the population mean and standard deviation, but in most cases you’re not going to have that. You’re also likely not going to have the resources to take twenty-thousand different samples.

Let’s take a a pretty classic example of interviewing six people about about something (weight, height, voting intentions, etc) and take the average: your sample mean. What the CLT can give you is an interval around your sample mean that would give you the a confidence interval (we’ll use the classic 95%) that the true mean of the population is somewhere in the interval.

So you use a bit of algebra and move some terms around in the CLT formula and you get this:

$$ \bar{X} \pm z_.025 \cdot \ \frac{s}{\sqrt{n}}
$$

where $\bar{X}$ is your sample mean, $z_.025$ is the critical value (aka qnorm() in R) and $s$ is the sample standard deviation. The sample standard deviation over the square root n is more commonly known as the standard error.

More simply, we take the sample mean and add/subtract the 97.5 quantile from a normal distribution times the standard error to get our 95% interval. Some may have noted a small mistake I’ve made here, which I’’ll leave in but will soon come to light.

We’re in frequentist territory here, so while it’s tempting to say “there’s a 95% probability that the true mean is in the interval”, we shouldn’t. Why? Because to a frequentist, the true mean $\mu$ is a fixed value: it’s either in the interval or it’s not, we can’t assign a probability to the population mean. What we should say is that if we were to repeat the sampling process many times, in the long run we should see the true mean within this confidence interval 95% of the time. We can simulate this to see if that is true.

We use a sample size of 6, taking the mean of these 6 samples from each of our population distributions 10,000 times.

# Ten-thousand random sample means of size six
small_sample_size <- 6
repeated_samples <-
map(1:10000, ~take_random_sample_mean(population_data, sample_size = small_sample_size)) |>
# Bind the samples into a single tibble
list_rbind() |>
# Wide to long tibble
pivot_longer(
everything(),
names_to = c('distribution', '.value'),
names_pattern = '(\\w+)_(\\w+_\\w+)'
) |>
# Join with our population mean 
left_join(population_data_stats, by = 'distribution')

For each of the samples from the distributions we calculate the 95% confidence interval. Because we know the true population mean, we can determine whether it is or is not within the interval. Then we calculate the percentage of samples for which the population mean fell within the 95% interval.

conf_intervals <-
repeated_samples |>
# Calculate CIs and whether CI contains the true population mean
mutate(
upper_ci = sample_mean + qnorm(0.975) * sample_sd / sqrt(small_sample_size),
lower_ci = sample_mean - qnorm(0.975) * sample_sd / sqrt(small_sample_size),
within_ci = population_mean < upper_ci & population_mean > lower_ci
) |>
# Determine percentage of CI that contain the true mean
group_by(distribution) |>
summarise(percent_within_ci = mean(within_ci))

Distribution	% Within CI
normal	89.36%
uniform	88.95%
beta	87.87%
chisquare	83.32%
exponential	82.87%
binomial	77.90%

Uh oh! We’re way off our 95% here, what happened?

This is the mistake I was talking about earlier: we used a normal to calculate the CIs. We estimated the population standard deviation $\sigma$ using our sample standard deviation $s$. With our small sample size of 6, our CLT formula follows a t-distribution, not a normal.

We’ll re-run our confidence intervals, but this time we use qt(), the t-distribution quantile function instead of qnorm().

conf_intervals <-
repeated_samples |>
mutate(
upper_ci = sample_mean + qt(p = 0.975, df = small_sample_size - 1) * (sample_sd / sqrt(small_sample_size)),
lower_ci = sample_mean - qt(p = 0.975, df = small_sample_size - 1) * (sample_sd / sqrt(small_sample_size)),
within_ci = population_mean < upper_ci & population_mean > lower_ci
) |>
group_by(distribution) |>
summarise(percent_within_ci = mean(within_ci))

Distribution	% Within CI
binomial	96.83%
normal	95.05%
uniform	93.88%
beta	92.59%
chisquare	88.91%
exponential	88.47%

That looks a bit better! The binomial is higher than 95% due to its discrete nature (can’t smoothly hit all possible values), the normal and uniform distributions are close to our 95% value, but our heavily skewed beta, exponential a chi-square still aren’t up to scratch. With those heavily skewed population distributions, we need more samples before the central limit theorem ‘kicks in’.

Let’s re-run using the dataset from the start of the post, which used s sample size of 60.

conf_intervals <-
# Using our original sample size of 60
sample_means |>
left_join(population_data_stats, by = 'distribution') |>
mutate(
upper_ci = sample_mean + qnorm(0.975) * (sample_sd / sqrt(sample_size)),
lower_ci = sample_mean - qnorm(0.975) * (sample_sd / sqrt(sample_size)),
within_ci = population_mean < upper_ci & population_mean > lower_ci
) |>
group_by(distribution) |>
summarise(percent_within_ci = mean(within_ci))

Distribution	% Within CI
binomial	94.86%
normal	94.52%
beta	94.40%
uniform	94.36%
chisquare	93.60%
exponential	92.97%

Better, but even with a sample size of 60, the skewed distirbutions are still slightly under the mark.

This begs the question: how do the sample means of these skewed distributions behave as the sample size increased? What we can do is repeatedly sample, but increase the sample size each time. We’ll go up in powers of two from 1 to 1024 samples.

increasing_sample_size <-
# Sample sizes increasing in powers of 2 (1, 2, 4, 8, ...)
map(
2^(0:10),
# Anonymous function
\(y) {
# 1000 sample means
map(1:1000, ~take_random_sample_mean(population_data, sample_size = y)) |>
# Bind them all together
list_rbind() |>
# Wide to long per distribution
pivot_longer(
everything(),
names_to = c('distribution', '.value'),
names_pattern = '(\\w+)_(\\w+_\\w+)'
) |>
# Add in our population means and SDs
left_join(population_data_stats, by = 'distribution') |>
# Add sample size as a column
mutate(sample_size = y) |>
# Normalise to -> N(0,1)
mutate(clt = (sample_mean - population_mean) / (population_sd / sqrt(sample_size) ))
}
) |>
list_rbind()

With this data we can create an animation of a Q-Q plot for the uniform versus exponential distributions, showing how the distribution of sample means changes as the sample size increases. You’ll see the distribution approaching the standard normal distribution.

ou’ll see the distribution of sample means from the uniform distribution approaches a normal much faster than the expontential. It’s very subjective, but I think the uniform stsrts looking reasonably good at a sample size of 8. The exponential however takes much longer to converge to a normal.

Summary

The central limit theorem is something I’ve read about many times and had a reasonable grasp on, but I was always wondering about how it behaved with different population distributions. Running simulations and visualising how it behaved in different scenarios has given me (and hopefully yourselves) a much clearer view on how it works, and probably more importantly where it doesn’t work well.

BOM On Target: Assessing the Bureau's Forecast Accuracy

Sun, 29 Jun 2025 00:00:00 +0000

In this article we’re going to be taking a look at the forecast accuracy of Australia’s Bureau of Metorology (BOM), but before starting a quick preface.

I had trepidation writing this article, and it almost didn’t get off the ground. I’m not a meteorologist, and I’m also a data science dilettante. Wading into this particular field without foundational knowledge felt very arrogant, and to be frank I was worried I’d make a fool out of myself. But after having a chat with one of my great friends who has a Phd in meteorology, she assuaged some of my apprehensions, so here we are. Although there’s still plenty of room for foolishness!

This post came about after searching and being unable to find historical information on the BOM’s forecasting performance. It may be that I just missed it somewhere, so if someone knows where this may be, please reach out.

TL;DR

This is a hefty article, so here’s a quick rundown of what we’ll cover before diving in:

Building temperature and 1-6 day temperature forecast datasets from 526 locations around Australia.
Determining and visualising the accuracy of these forecasts.
Creating a ‘jaggedness’ metric per site.
Using Bayesian methods to build a model for predicting forecast accuracy.
Assessing the model’s performance on in-sample and out-of-sample data.

Let’s go…

Weather Stations

In previous articles I’ve gone into detail about the data acquisition process, I think because it’s quite a an enjoyable process. This time however I’m going to keep it brief and give you a quick overview about how I got the data, and what the data is.

I needed three pieces of data:

A list of BOM weather stations
The temperature at those weather stations over a period of time
The temperature forecasts at each of those stations

Number one was easy, as the BOM provides a list of weather stattions, including their name, latitude, longitude. This list get’s filtered down from ~6,500 total active weather stations to 526 that have a world meteorological organisation (WMO) ID. Here’s their locations around Australia:

Temperature Data

To acquire the temperature and forecast data, I wrote a script which reaches out to the BOM and retrieves the temperature and the forecasts for the clostest city/town to each of the weather stations. This ran every ten minutes, which appears to be the update interval for most temperature on the BOM website.

Here’s a view of the temperature data, broken down state by state:

That’s a total of 4251931 million temperature readings over ~8 weeks. If you squint you should be able to a general downward trend of the temperature as we move through Autumn towards Winter.

I could easily go off on a number of tangents with this data, but I’ll just pull out the locations with the highest and lowest mean temperatures during this period: Unsurprisingly we’ve got a city in the north of the country, and a mountain in the very south. Take note of the different shapes of these graphs, we’ll discuss this later on in the article.

Forecast Data

The BOM provides a 3-hourly temperature forecasts for each location (e.g. 1:00AM, 4:00AM, … 10:00PM) out to 7 days. As with the temperature, I’ve acquired this from their website every ten minutes for each location. This means we get 8 (hourly forecasts) * 7 (days) * 526 (locations) = 29,456 forecasts every ten minutes. Most of these are identical, as the forecast hasn’t changed. I’ve pruned this data back into two datasets:

A changed forecast set, which contains rows of data where the forecast temperature for a date/time/location has changed from the previous forecast.
A day-lagged forecast set, which contains the forecasts which are eactly 1,2,3,…6 days out from the date/time we acquired the data.

Visualising the forecast data over time becomes messy very quickly, so instead let’s take a look at how often the BOM updates their models. This uses the changed forecast dataset, and is a histogram of the hour in the day in which the changed forecast was published to the website:

That spike in the late afternoon? Another data point to take note of, as it will be pertinent later on in this post.

Forecast Accuracy

For each of the aforementioned data sets, we join them with the recorded temperature data. For each date/time we’ve got multiple forecasts ranging from 3 hours to 7 days out, and then the actual temperature that was recorded at that date/time. This allows us to calculate the forecast accuracy as (forecast temp - recorded temp).

Let’s get to the crux of this article: forecast accuracy. There’s a small fly in the ointment, in that the published forecast temperatures integers, whereas the temperatures have a single decimal place. So a decision: do we round the recorded temperatures to whole numbers as well, or keep them as reals? I’ve made the decision here to continue to use the decimal temperatures, rather than round/ceil/floor to turn them into integers as well. All we can do is work with that data we’ve got, and the less assumptions or changes the better.

To start, here’s an interactive view of both the 1 day and 6 day forecast overlaid across the recorded temperature for one site (Essendon Airport in Melbourne). Initially it’s a bit messy, but if you zoom in and click the legend to add/remove the each of the forecasts you get an idea about how it’s changed, and how far off each one was.

Let’s look at some statistics across all of the weather stations: the mean error, the mean absolute error, the standard deviation of the error, and the 95% quantiles for the error.

Forecast Duration	Mean Error	Mean Absolute Error	Standard Deviation of Error	95% Quantile
Forecast Error Statistics by Forecast Duration
86400s (~1 days)	0.09	1.35	1.75	-3.6, 3.5
172800s (~2 days)	0.11	1.41	1.83	-3.7, 3.7
259200s (~3 days)	0.12	1.51	1.97	-4, 4
345600s (~4 days)	0.11	1.63	2.12	-4.3, 4.3
432000s (~5 days)	0.09	1.72	2.24	-4.6, 4.5
518400s (~6 days)	0.12	1.88	2.44	-5, 5

The mean error doesn’t tell us about the accuracy (as negative and positive errors cancel each other out), but more about the bias in the model. It’s showing as that across all forecasts there’s a slight bias towards over-estimating the temperature, but only by a tenth of a degree or so.

The mean absolute error of changes from 1.33 degrees a day out, so 1.88 degrees six days out. The standard deviation increasing tells us that the errors are more spread out as well.

A histogram of the errors shows their distribution and how that changes over time. I’ve overlaid a normal distribution with a fixed mean of 0 and standard deviation of 2 to act as a reference point:

This shows the mean error slightly shifting to the right and the distribution spreading out as the standard deviation increases. The distribution looks sort of normal, and for the first two standard deviations it tracks really well. You’ll notice this with the table above, where the mean +- 2 x std.dev lines up well with the 95% quantiles.

But we can’t assume it’s normal across the board. This is best visualised with a quantile-quantile (QQ) plot.

This shows that these the forecast error distriubtions, like we mentioned before, track the normal for the first two standard deviation. Outside of that they have fatter tails than a normal, i.e. you’ll find more observations inside 3 or 4 standard deviations than you would in a normal distribution.

Instead of looking at whole days between the forecast and the recorded temperature, we can switch to the changed data set which contains all of the changed forecasts over time. This gives a more granulart view of the times between when the forecast was made, and the actual recorded temperature. There’s two things that immediately jump out at me: the is first is both the variance and mean absolute error over time appear to be much greater for Victoria, Tasmania, and South Australia as opposed to the others. The second is that there appears to be a cyclical nature to the forecast error. Setting aside what I’ll call the ‘southern state’ issue, we’ll investigate the cyclical nature.

Straight away this looks to be a difference in forecast error based on whether it’s day or night. I wouldn’t have thought that this kind of bias would have come through in the forecast durations. But if you recall the previous histogram that showed when the BOM published its updated models, this wasn’t uniformly distributed. Rather, most of the changes to forecasts occurred between 2pm and 6pm. Therefore the forecast duration - the difference between the forecast change and the forecast time - will be ‘tethered’ from this time and the day/night cycle will show in the forecast durations.

Let’s code the forecast’s time as either ‘night’ based on whether the time is after 7pm and before 7am, and ‘day’ for all others. This makes sense for the time period of the data. Interestingly if we look at a density plot of the forecast error we see a difference in variation between night and day.

This, combined with the fact that most of the forecasts are published at a certain time of the day, is why there is a cyclical pattern in the forecast duration graph. We won’t delve into this any further, but the question to of course ask is why would this be the case? I’m not going to dive any deeper into this in this post, but it’s something to think about.

Forecast Error Modelling

Can we find a way to model the forecast error as a function of some other parameters? The first parameter is obvious: forecast duration. Looking at the mean absolute error over the forecast duration, it increased as the forecast duration increased. This shouldn’t be surprising, as the quote goes “prediction is very hard, especially about the future”.

But when we looked at the graph, there was a second source of variation. It appeared that the southern states - Victoria, Tasmania, South Australia - had a higher variation in mean absolute error as compared to the northern states.

This is where I’m in danger of cosplaying as a meteorologist and being completely off the mark, but lets have a go. Looking back at the graph of the lowest mean temperature and the start of this article, taken from Tasmania in the south of Australia, what you may have noticed is that the profile of the lowest mean temperature looked different. To me eye it looked rougher and moved up and down far more as compared to the highest mean, which was from a location in the far north of Australia.

Could this type of variation have an influence on the forecast accuracy? Can we quantify it?

The ‘Jaggedness’ Index

My guess would be as we go south, certain meteorological features that I would only be guessing at (weather coming off the Southern Ocean?) make the rises and falls in temperature less ‘smooth’ more varied, and thus more unpredictable.

My thought is to create a ‘jaggedness’ index for each of the locations and each of the day-lagged forecast.

$$ J = \frac{1}{n - 1} \sum_{i=2}^{n} \left| t_i - t_{i-1} \right| $$

Where $t_i$ is the i’th temperature observation at a site, and $n$ is the total number of observations. In plain English: the sum of the absolute differences between consecutive temperature observations, divided by the number of pairs of observations.

To give this some perspective, here are the temperatures over time for the locations with the highest and lowest jaggedness indexes:

Site	Jaggedness
Min/Max Site Jaggedness
LOW ISLES LIGHTHOUSE, QLD	0.1252697
KHANCOBAN AWS, NSW	0.4207670

We can now plot each locations index against its mean absolute error, and we’ll transition of the day forecast durations.

We can see a reasonably linear relationship between this jaggedness index and the mean forecast error. Let’s use these two features - duration and jaggedness - as parameters into a simple linear model and see if we can come up with a model that predicts the mean absolute forecast error.

Modeling

To be honest, the jaggedness index isn’t a great predictor, because you can only calculate it once you’ve got the temperature, and once you’ve got the temperature you can just calculate the forecast error directly! But let’s just have a go, start simple, and see where we end up.

We’ll use Stan to create a simple linear model with two parameters: the jaggedness as a continuous variable, and the day-lagged forecast duration as a categorical index. Here’s the full specification of the model:

data {
//Training data
int<lower=1> n;
vector[n] jaggedness;
array[n] int <lower=1, upper=6> duration;
vector[n] mean_forecast_error;
//Out of sample test set
vector[n] jaggedness_t;
array[n] int <lower=1, upper=6> duration_t;
vector[n] mean_forecast_error_t;
}
parameters {
vector[6] alpha;
vector[6] beta_jaggedness;
real<lower=0> sigma;
}
model {
// Weakly informative priors
beta_jaggedness ~ normal(0, 5);
alpha ~ normal(0, 5);
sigma ~ exponential(1);
// Likelihood
for (i in 1:n) {
mean_forecast_error[i] ~ normal(alpha[duration[i]] + beta_jaggedness[duration[i]] * jaggedness[i], sigma);
}
}
generated quantities {
//Posterior predictive check
vector[n] y_rep;
//Out of sample test set
vector[n] y_test;
for (i in 1:n) {
//Posterior predictive checks
y_rep[i] = normal_rng(
alpha[duration[i]] + beta_jaggedness[duration[i]] * jaggedness[i],
sigma
);
//Out of sample checks
y_test[i] = normal_rng(
alpha[duration_t[i]] + beta_jaggedness[duration_t[i]] * jaggedness_t[i],
sigma
);
}
}

After sampling from the posterior (and performing some of the standard checks like trace plots and histograms that I’m not going to show here), we get our alpha and beta parameters (intercept and slope) for each of the indexes (where index 1 = 1 day forecast, index 2 = 2 day forecast, etc), as well as some other statistics about the distributions of each parameter. For completeness here’s a table of all of the parameters;

Variable	Mean	Median	Std. Dev	Lower 2.5%	Upper 97.5
Model Parameter: Posterior Distribution Statistics
sigma	0.31	0.31	0.00	0.30	0.32
alpha[1]	0.78	0.78	0.06	0.66	0.91
alpha[2]	0.76	0.76	0.06	0.64	0.89
alpha[3]	0.76	0.76	0.06	0.63	0.88
alpha[4]	0.81	0.81	0.06	0.69	0.93
alpha[5]	0.85	0.85	0.06	0.73	0.97
alpha[6]	0.82	0.81	0.06	0.69	0.94
beta_jaggedness[1]	2.14	2.14	0.24	1.66	2.59
beta_jaggedness[2]	2.43	2.43	0.24	1.96	2.89
beta_jaggedness[3]	2.84	2.84	0.23	2.40	3.29
beta_jaggedness[4]	3.08	3.08	0.24	2.62	3.54
beta_jaggedness[5]	3.27	3.27	0.23	2.83	3.73
beta_jaggedness[6]	4.02	4.02	0.23	3.55	4.47

I’m not going to go through each one, but let’s take a look at index [6]: the six day forecast. The parameters tell us the following information:

alpha[6] - for a location with zero jaggedness (the intercept), you would expect on average a mean forecast error of 0.82, with a credible interval between .7 and .94.
beta_jaggedness[6] - for each increase of jaggedness by 1, you would expect on average the mean forecast error to go up by 4 degrees, with a 95% credible interval of between 3.56 and 4.46.

Tables are hard to interpret, so instead what we’ll do is plot all a line for each of the parameters drawn from the posterior, which shows the range of values the model believes parameters could be. As before, we transition through each of the forecast durations:

Some reasonably tight credible intervals for the parameters. But there’s one parameter left we haven’t looked at: sigma, the residual standard deviation. It’s a measure of how far the observed data deviates from our fitted values We’ve used a single parameter, so it doesn’t vary across the forecast indexes/durations.

We can check how well our model has done by performing posterior predictive checks. In our Stan model we generated random data for each of the observations using all of the alpha, beta, and sigma values drawn from the posterior. We’ve then limited the data to those values that are within the 95% credible interval, and plotted each one in green. We’ve then overlaid the real observations in orange over the top.

Most of our data lies within the bands of the generated data, which is good. However there’s a couple of things that don’t look quite right: the first is that there’s a bias in the model. Almost all of the values which don’t fit are above the bands, rather than below. Our model, which uses normal residuals/errors, assumes that the errors should be approximately symmetric, which they are not.

Secondly, those values above the bands are a long way from where the model would expect them to be. So our model doesn’t do a great job of predicting the mean forecast error based on jaggedness for those sites.

If we calculate the 95% interval of our generated values from the model, then calculate the percentage of recorded values that fall in that range, we get the following results:

Forecast Duration	Percentage
Real Values Within 95% Credible Interval
Training Data Set
1 day	96.6%
2 day	96.6%
3 day	95.8%
4 day	95.6%
5 day	95.6%
6 day	93.2%

That’s good, at least the range of the posterior predictive distribution is close to our observed data. But it also shouldn’t be too surprising: the model was trained off this data.

The real test of the model is how it performs on out of sample data. I’ve held out ~3 weeks of temperature/forecast accuracy data from the time period immediately after the training set. Each location is still using the jaggedness calculated from the training temperatures. Let’s take a look at how it performs:

Forecast Duration	Percentage
Real Values Within 95% Credible Interval
Test (Out-of-Sample) Data Set
1 day	93.2%
2 day	93.0%
3 day	91.8%
4 day	89.5%
5 day	89.2%
6 day	85.9%

Not bad, but not great. Outside of the three day forecast it starts to fall away.

Summary

Phew, that one just kept going and going! A recap: we gathered 8 weeks of temperature and temperature forecasts from around Australia, and looked at how well the forecasts performed depending on how far out the forecast was. We then created a summary statistic - jaggedness - and attempted to create a linear model for predicting forecast accuracy based on this, as well as forecast duration. It did OK, but it’s probably a little simplistic, and perhaps not much use in the long term.

A couple of weeks ago my wife asked me “why are you even doing this?”. Good question. I think there are two reasons:

The first is that I just wanted to know the answer. How exactly does the BOM perform at forecasting temperature? Now we’ve got some data, and some outputs. It’s a small sample, and we don’t know how it changes over time, but it’s something we can point to. Whether it’s qualitatively good or bad I don’t know, I’ll leave those kind of judgements to the reader.

The second reason is that, it doing these kinds posts, I get to put into practice things I’ve read about in an interesting way and consolidate a lot of knowledge. Here’s a few of the things I’ve got a better idea of now:

The read_fwf() function in the readr package
The req_perform_parallel() function in the httr2 package for speeding up bulk requests to websites.
Writing systemd timers
Timezone files in Linux
Using indexes for categorical variables in Stan models.
Using a test set in a Stan model.

To me, those reasons are as good as any.

Byte-size: An Ode to Web Scraping with R

Mon, 03 Mar 2025 00:00:00 +0000

Last week I needed to pull some data from a website. I was building out a data pipeline to generate the end-of-season awards for Little Athletics, but I ran into a problem. Like dependable friend, R came to the rescue with a simple, elegant solution. This post is a ‘byte-size’ ode to this dependable friend.

Beauty and Terseness

I’ll get to the challenge I ran into shortly, but first we’ll take a look at what basic web scraping looks like. Suppose you want to get all the headlines from The Age’s website. You look at the source and see that all the <a> tags have an attribute data-testid equal to article-link. Here’s the pipeline that acheives this:

request('http://theage.com.au') |>
req_perform() |>
resp_body_html() |>
html_elements(xpath = "//a[@data-testid='article-link']") |>
html_text() |>
tibble(.name_repair = ~c('headline')) |>
filter(headline != "") |>
slice_head(n = 10) |>
gt()

headline
Target Time
Get 2-for-1 Comedy Festival tickets*
The Morning Edition podcast
The 100 most expensive Melbourne public schools revealed
$4b on a new station in Melbourne’s west – has Victoria lost its budgetary mind?
Daily atrocities spew out of the Oval Office. It’s still not enough to lure Australian voters back to the known
Trump administration upends US foreign policy, holds secret talks with Hamas
Trump’s speech was full of wild claims. Here are seven that weren’t true
US lands new blow on Ukraine after Oval Office stoush
The number one reason why people are leaving Melbourne

There we go, five lines of R and you’ve got the headlines, plus a couple more to get it into a nicer structure. What makes it so simple? I think it comes down to two things: number one is R’s pipe operator, which menas you don’t have to pepper your code with temporary variables. Second is R’s vectorisation, which means you don’t need to worry about any loops. I also tip my hat to the relatively new httr2 package which makes web requests fit much better into a pipeline.

The Challenge

The challenge I ran into last week was that, while the data I needed was structured, it wasn’t in HTML, XML, or even JSON, it was actually JavaScript. Here’s an abridged sample of what was returned in one of the API calls:

sessions_NMRKeilor = [
{"SessNbr":"1","SessPtr":"24","SessName":"Sat Morning - Field","SessDay":"1","SessTime":"30600"},
{"SessNbr":"2","SessPtr":"25","SessName":"Sat Morning - Track","SessDay":"1","SessTime":"32400"},
{"SessNbr":"3","SessPtr":"46","SessName":"Sat Afternoon - Field","SessDay":"1","SessTime":"46800"},
...
]

Not sure what to do, I fetch the data:

js_content <-
request('https://lavic.resultshub.com.au/php/resultsFileFetch.php?season=2024&series=regions&round=3&venue=undefined') |>
req_perform() |>
resp_body_string()

The mind initially goes to dark places: can I solve this with a regex? Maybe filter out the variable assignment portions and parse as JSON? Pulling myself together, I think “this is just JavaScript, is there a way I can simply evaluate it?”. Some research shows that there’s an R library that provides API access into Google’s V8 JavaScript implementation. This should allow me to evaluate the JavaScript code we received:

jscontext <- v8()
jscontext$eval(js_content)

From there I can get the variable I need, and the library converts this from JSON to a clean data frame:

jscontext$get('sessions_NMRKeilor') |>
gt()

SessNbr	SessPtr	SessName	SessDay	SessTime
1	24	Sat Morning - Field	1	30600
2	25	Sat Morning - Track	1	32400
3	46	Sat Afternoon - Field	1	46800
4	30	Sat Afternoon - Track	1	46800
5	43	Sun Morning - Field	2	30600
6	38	Sun Morning - Track	2	30600
7	47	Sun Afternoon - Field	2	46800
8	45	Sun Afternoon - Track	2	47700

That’s it: web request to JavaScript evaluation to structured R data in a few lines; a thing of beauty.

A Day in the Life: The Global BGP Table

Tue, 12 Nov 2024 00:00:00 +0000

Update: This article was discussed on Hackernews

Much has been written and a lot of analysis performed on the global BGP table over the years, a significant portion by the inimitable Geoff Huston. However this often focuses on is long term trends, like the growth of the routing table or the adoption of IPv6 , dealing with time frames of of months or years.

I was more interested in what was happening in the short term: what does it look like on the front line for those poor routers connected to the churning, foamy chaos of the interenet, trying their best to adhere to Postel’s Law? What we’ll look at in this article is “a day in the life of the global BGP table”, exploring the intra-day shenanigans with an eye to finding some of the ridiculous things that go on out.

We’ll focus in on three key areas:

General behaviour over the course of the day
Outlier path attributes
Flappy paths

As you’ll see, we end up with more questions than answers, but I think that’s the hallmark of good exploratory work. Let’s dive in.

Let the Yak Shaving Begin

The first step, as always, is to get some data to work with. Parsing the debug outputs from various routers seemed like a recipe for disaster, so instead I did a little yak-shaving. I went back to a half-finished project BGP daemon I’d started writing years ago and got it into a working state. The result is bgpsee, a multi-threaded BGP peering tool for the CLI. Once peered with another router, all the BGP messages - OPENs, KEEPALIVES, and most importantly UPDATEs - are parsed and output as JSON.

For example, heres one of the BGP updates from the dataset we’re working with in this article:

{
"recv_time": 1704483075,
"id": 12349,
"type": "UPDATE",
"nlri": [ "38.43.124.0/23" ],
"withdrawn_routes": [],
"path_attributes": [
{
"type": "ORIGIN", "type_code": 1,
"origin": "IGP"
},
{
"type": "AS_PATH", "type_code": 2,
"n_as_segments": 1,
"path_segments": [
{
"type": "AS_SEQUENCE",
"n_as": 6,
"asns": [ 45270, 4764, 2914, 12956, 27951, 23456 ]
}
]
},
{
"type": "NEXT_HOP", "type_code": 3,
"next_hop": "61.245.147.114"
},
{
"type": "AS4_PATH", "type_code": 17,
"n_as_segments": 1,
"path_segments": [
{
"type": "AS_SEQUENCE",
"n_as": 6,
"asns": [ 45270,4764, 2914, 12956, 27951, 273013 ]
}
]
}
]
}

Collected between 6/1/2024 and 7/1/2024, the full dataset consists of 464,673 BGP UPDATE messages received from a peer (many thanks to Andrew Vinton) with a full BGP table. Let’s take a look at how this full table behaves over the course of the day.

Initial Send, Number of v4 and v6 Paths

When you first bring up a BGP peering with a router you get a big dump of of UPDATEs, what I’ll call the ‘first tranche’. It consists of all paths and associated network layer reachability information (NLRI, or more simply ‘routes’) in the router’s BGP table. After this first tranche the peering only receives UPDATEs for paths that have changed, or withdrawn routes which no longer have any paths. There’s no structural difference between the first tranche and the subsequent UPDATEs, except for the fact you received the first batch in the first 5 or so seconds of the peering coming up.

Here’s a breakdown of the number of distinct paths received in that first tranche, separated by IP version:

It’s important to highlight that this is a count of BGP paths, not routes. Each path is a unique combination of path attributes with associated NLRI information attached, sent in a distinct BGP UPDATE message. There could be one, or one-thousand routes associated with each path. In this first tranche the total number of routes across all of these paths is 949483.

A Garden Hose or a Fire Hose?

That’s all we’ll look at in the first tranche, we’ll focus our attention from this point on to the rest of the updates received across the day. The updates aren’t sent as a real-time stream, but in bunches based on the Route Advertisement Interval timer, which for this peering was 30 seconds. Here’s a time-series view of the number of updates received during the course of the day:

For IPv4 paths you’re looking on average at around 50 path updates every 30 seconds. For IPv6 it’s slightly lower, at around 47 path updates. While the averages are close, the variance is quite different, a standard deviation of 64.3 and 43 for v4 and v6 respectively.

Instead of looking at the total count of updates, we can instead look at the total aggregate IP address change. We do this by adding up the total amount of IP addresses across all updates for every 30 second interval, then take the log2() of the sum. So for example: a /22, a /23 and a /24 would be $log_2(2^{32-22} + 2^{32-23} + 2^{32-24})$

Below is the log2() IPv4 address space, viewed as a time series and as a density plot. It shows that on average, every 30 seconds, around 2^16 IP addresses (i.e a /16) change paths in the global routing table, with 95% of time time the change in IP address space is between $2^{20.75}$ (approx. a /11) and $2^{13.85}$ (approx. a /18).

What is apparent in both the path and IP space changes over time is that there is some sort of cyclic behaviour in the IPv4 updates. To determine the period of this cycle we can use an ACF or autocorrelation plot. We calculate the correlation between the number of paths received at time $y_t$ versus the number received at $y_{t-{1,t-2,…,t-n}}$ lags. I’ve grouped the updates together into 1 minute intervals, so 1 lag = 1 minute.

There is a strong correlation in the first 7 or so lags, which intuitively makes sense to me as path changes can create other path changes as they propagate around the world. But there also appears to be strong correlation at lags 40 and 41, indicating some cyclic behaviour every forty minutes. This gives us the first question which I’ll leave unanswered:

What is causing the global IPv4 BGP table have a 40 minute cycle?.

Prepending Madness

If you’re a network admin, there’s a couple of different ways you can influence how traffic enters your ASN. You can use longer network prefixes, but this doesn’t scale well and you’re not being a polite BGP citizen. You can use the MED attribute, but it’s non-transitive so it doesn’t work if you’re peered to multiple AS. The usual go-to is to modify the AS path length by prepending your own AS one or more times to certain peers, making that path less preferable.

In chaos of the global routing table, some people take this prepending too far. This has in the past caused large, global problems. Let’s take a look at the top 50 AS path lengths for IPv4 and IPv6 updates respectively:

What stands out is the difference between IPv4 and IPv6. The largest IPv4 path length is 105, which is still pretty ridiculous given the fact that the largest non-prepended path in this dataset has a length of 14. But compared to the IPv6 paths it’s outright sensible: top of the table for IPv6 comes in at a whopping 599 ASes! An AS path is actually made up of one or more AS sets or AS sequences, each of which have a maximum length of 255. So it’s taken three AS sequences to announce those routes.

Here’s the longest IPv4 path in all it’s glory with its 105 ASNs. It originated from AS149381 “Dinas Komunikasi dan Informatika Kabupaten Tulungagung” in Indonesia.

[1] "45270 4764 9002 136106 45305 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381 149381"

We see that around 6 hours and 50 minutes later they realise the error in their ways and announce a path with only four ASes, rather than 105:

recv_time	time_difference	id	as_path_length	type	nlri
2024-01-06 06:31:18	NA	66121	105	UPDATE	103.179.250.0/24
2024-01-06 13:21:35	6.84	280028	4	UPDATE	103.179.250.0/24

Here’s the largest IPv6 path, with its mammoth 599 prefixes; I’ll let you enjoy scrolling to the right on this one:

[1] "45270 4764 2914 29632 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 8772 200579 200579 203868"

Interestingly it’s not the originator that’s prepending, but as8772 ‘NetAssist LLC’, an ISP out of Ukraine prepending to make paths to asn203868 (Rifqi Arief Pamungkas, again out of Indonesia) less preferable.

Why is there such a difference between the largest IPv4 and IPv6 path lengths? I had a couple of different theories, but then looked at the total number of ASNs in all positions for those top 50 longest paths, and it became apparent what was happening:

Looks like they let the junior network admin at NetAssist on to the tools too early!

Path Attributes

Each BGP update consist of network layer reachability information (routes) and path attributes. For example AS_PATH, NEXT_HOP, etc. There are four kinds of attributes:

Well-known mandatory
Well-known discretionary
Optional transitive
Optional non-transitive

Section 5 of RFC4271 has a good description of all of these.

What we can do is take a look at the number of attributes we’ve seen across all of our IPv4 paths, placing this on on a log scale to make it easier to view:

The well-known mandatory attributes, ORIGIN, NEXT_HOP, and AS_PATH, are present in all updates, and have the same counts. There’s a few other common attributes (e.g. AGGREGATOR), and some less common ones (AS_PATHLIMIT and ATTR_SET). However some ASes have attached attribute 255 - the reserved for development attribute - to their updates.

At the time of receiving the updates my bgpsee daemon didn’t save value of these esoteric path attributes. But using routeviews.org we can see that some ASes are still announcing paths with this attribute, and we can observe the raw bytes of its value:

- AS265999 attrib. 255 value: 0000 07DB 0000 0001 0001 000A FF08 0000 0000 0C49 75B3
- AS10429 attrib. 255 value: 0000 07DB 0000 0001 0001 000A FF08 0000 0003 43DC 75C3
- AS52564 attrib. 255 valuue: 0000 07DB 0000 0001 0001 0012 FF10 0000 0000 0C49 75B3 0000 0000 4003 F1C9

Three different ISPs, all announcing paths with this strange path attribute, and raw bytes of the attribute having a similar structure.

This leads us to the second question which I’ll leave here unanswered:

what vendor is deciding it’s a good idea to use this reserved for development attribute, and what are they using it for?.

Flippy-Flappy: Who’s Having a Bad Time?

Finally, let’s see who’s having a bad time: what are the top routes that are shifting paths or being withdrawn completely during the day. Here’s the top 10 active NLRIs with the number of times the route was included in an UPDATE:

nlri	update_count
140.99.244.0/23	2596
107.154.97.0/24	2583
45.172.92.0/22	2494
151.236.111.0/24	2312
205.164.85.0/24	2189
41.209.0.0/18	2069
143.255.204.0/22	2048
176.124.58.0/24	1584
187.1.11.0/24	1582
187.1.13.0/24	1580

Looks like anyone on 140.99.244.0/23 was having a bad time during this day. This space is owned by a company called EpicUp… more like EpicDown! *groan*.

Graphing the updates and complete withdraws over the course of the day paints a bad picture

The top graph looks like a straight line, but that’s because this route is present in almost every single 30 second block of updates. There are 2,879 30-second blocks and it’s present as either a different path or a withdrawn route in 2,637 of them, or 92.8%!

We know the routes is flapping, but how is it flapping, and who is to blame? The best way to visualise this is a graph, with the ASNs in all paths to that network as nodes and edges showing the pairs of ASNs in the paths. I’ve colourised the edges by how many updates were seen with each pair of ASes, binned into groups of 300:

What a mess! You can make out the primary path down the centre through NTT (2914) and Lumen/Level3 (3356), but for whatever reason (bad link? power outages? router crashing?) the path is moving between these tier 1 ISPS and others, including Arelion (1299) and PCCW (3419). While it’s almost impossible to identify the exact reason for the route flapping using this data only, what it does show is the amazing peering diversity of modern global networks, and the the resiliency of a 33 year old routing protocol.

Just The Beginning

There’s a big problem with a data set like this: there’s just too much to look at. I needed to keep a lid on it so this article didn’t balloon out to 30,000 words, but there’s another five rabbit holes I could have gone down. That’s not including the the questions I’ve left unanswered.

With the global BGP table, you’ve got a summary of an entire world encapsulated in a few packets. Your BGP updates could could be political unrest, natural phenomena like earthquakes or fires, or simply a network admin’s fat finger. You’ve got the economics of internet peering, and you’ve got the human element of different administrators with different capabilities coming together to bring up connectivity. And somehow it manages to work, well, most of the time. There’s something both bizarre and beautiful about seeing all of that humanity encapsulated and streamed as small little updates into your laptop.

Cracking Open SCEP

Wed, 10 Jul 2024 00:00:00 +0000

Most of the posts on this site tend to be long form, a result of me finding it hard to leave stones unturned. This leads to big gaps between posts; in fact the the radio silence over the past nine months is because I’ve had two in draft form and haven’t been able to get them over the line.

As an antidote to this I’ve put together something a little more bite-size. In this post we’re going to crack open a Simple Certificate Enrollment Protocol (SCEP) request. We’ll do this on the command line, using the openssl tool peer underneath the hood, and get a good understanding of some of the structures, and the verification and encryption processes.

The SCEP Request

Here’s a screenshot of a packet capture taken during a SCEP request for a new certificate:

This SCEP request is actually two requests: the first returns an X509 CA certificate, and the second is the certificate request. We’ll see how the X509 certificate is used later on, but if we focus in on the second one we see the bulk of the request is passed in the message query parameter. I’ve copied the contents of this to a file named scep_message:

# Size in bytes
wc -c scep_message
4089
# First 64 bytes
cut -c1-64 scep_message
MIILLAYJKoZIhvcNAQcCoIILHTCCCxkCAQExDzANBglghkgBZQMEAgMFADCCBM8G

This message parameter contins the singing request, wrapped up like an onion (sometimes including the tears), with layer after layer of different encodings and structures. This first message parameter is URI encoded, then base64 encoded, so we decode these store what I’ll call the ‘raw’ SCEP in a file called scep_raw.

# Remove the URI and base64 encoding
< scep_message perl -MURI::Escape -e 'print uri_unescape(<STDIN>)' | base64 -d > scep_raw

Signing

Before moving on, a quick view of the PKI layout:

The CN of the certificate request is BlogPostCert.
I’ve created a sub-CA with a CN of Blog Post Sub CA that will sign the request.
This sub-CA is signed by the root CA which has a CN of foletta.xyz Root CA.

Now we can get into the meat and bones. After URI/base64 decoding, the next wrapper is Cryptographic Message Syntax (CMS) encapsulated data. Originally part of the PKCS standards defined by RSA security (PKCS7 to be exact), CMS is now an IETF standard under RFC 5652 . It provides a way to digitally sign, digest, authenticate, or encrypt arbitrary message content.

Using the openssl cms command with the -print argument, we look at the structure of this first CMS wrapper. I’ve redacted some of the less-relevant content and added some comments:

# Print the CMS structure
openssl cms -in scep_raw -cmsout -inform DER -print

CMS_ContentInfo:
contentType: pkcs7-signedData (1.2.840.113549.1.7.2)
d.signedData:
version: 1
digestAlgorithms:
algorithm: sha512 (2.16.840.1.101.3.4.2.3)
parameter: NULL
encapContentInfo:
eContentType: pkcs7-data (1.2.840.113549.1.7.1)
eContent:
# The verified content (removed for brevity)
certificates:
# This is an inline certificate, partner of the private key that signed the content
d.certificate:
cert_info:
version: 2
serialNumber: 0x3945353734443130303430394339423632364233303838354342353735443100
signature:
algorithm: sha512WithRSAEncryption (1.2.840.113549.1.1.13)
parameter: NULL
# We see this is a temporary, self-signed certificate
issuer: C=AU, ST=Victoria, L=Melbourne, O=foletta.xyz, OU=IT, CN=BlogPostCert
# We get a week to sign the request
validity:
notBefore: Jul 8 22:24:59 2024 GMT
notAfter: Jul 15 00:24:59 2024 GMT
subject: C=AU, ST=Victoria, L=Melbourne, O=foletta.xyz, OU=IT, CN=BlogPostCert
key: X509_PUBKEY:
algor:
algorithm: rsaEncryption (1.2.840.113549.1.1.1)
parameter: NULL
public_key: (0 unused bits)
# Removed for brevity
issuerUID: <ABSENT>
subjectUID: <ABSENT>
extensions:
<ABSENT>
sig_alg:
algorithm: sha512WithRSAEncryption (1.2.840.113549.1.1.13)
parameter: NULL
signature: (0 unused bits)
# Signature to verify removed for brevity
crls:
<ABSENT>
# The signing information to allow the content to be verified
signerInfos:
version: 1
d.issuerAndSerialNumber:
# Issuer and serial number of the certificate required to verify.
# This matches the above inline certificate
issuer: C=AU, ST=Victoria, L=Melbourne, O=foletta.xyz, OU=IT, CN=BlogPostCert
serialNumber: 0x3945353734443130303430394339423632364233303838354342353735443100
digestAlgorithm:
algorithm: sha512 (2.16.840.1.101.3.4.2.3)
parameter: NULL
signedAttrs:
# Removed for brevity
signatureAlgorithm:
algorithm: rsaEncryption (1.2.840.113549.1.1.1)
parameter: NULL
signature:
# Signature used to verify (removed for brevity).
unsignedAttrs:
<ABSENT>

The main question I had was what signs this content? The answer we see from the above output is that it’s signed by the requestor’s newly generated private key. But as there’s no certificate yet (that’s the whole point of the request), the requestor creates a temporary self-signed certificate containing the public key, and includes it in the CMS data. This allows the SCEP server to authenticate the data that’s been transferred.

This self-signed certificate will come in handy later, so it’s extracted using the -verify and -signer arguments:

# Extract the self signed certificate
openssl cms -verify -in scep_raw -inform DER -signer self_signed.cer -noverify -out /dev/null
# View the self-signed cert
openssl x509 -in self_signed.cer -noout -text

Certificate:
Data:
Version: 3 (0x2)
Serial Number:
39:45:35:37:34:44:31:30:30:34:30:39:43:39:42:36:32:36:42:33:30:38:38:35:43:42:35:37:35:44:31:00
Signature Algorithm: sha512WithRSAEncryption
Issuer: C = AU, ST = Victoria, L = Melbourne, O = foletta.xyz, OU = IT, CN = BlogPostCert
Validity
Not Before: Jul 8 22:24:59 2024 GMT
Not After : Jul 15 00:24:59 2024 GMT
Subject: C = AU, ST = Victoria, L = Melbourne, O = foletta.xyz, OU = IT, CN = BlogPostCert
Subject Public Key Info:
Public Key Algorithm: rsaEncryption
Public-Key: (2048 bit)
Modulus:
# Removed for brevity
Exponent: 65537 (0x10001)
Signature Algorithm: sha512WithRSAEncryption
Signature Value:
# Removed for brevity

Encryption

The keen eyed will have noticed that the eContentType was pkcs7-data. I.e. inside this CMS encapsulation is another CMS encapsulation, except this one is responsible for encrypting the certificate request.

Using the -verify command we can verify the signature and extract the content, piping to openssl again to view the structure of the encrypted CMS. The seemingly contradictory -noverify disables verification of the signing certificate of the message (while still checking the actual signature) as we can’t verify that self-signed certificate.

# Verify, extract, and pipe out contents
openssl cms -verify -in scep_raw -inform DER -noverify |
# Print second CMS structure
openssl cms -inform DER -cmsout -print

CMS_ContentInfo:
contentType: pkcs7-envelopedData (1.2.840.113549.1.7.3)
d.envelopedData:
version: 0
originatorInfo: <ABSENT>
recipientInfos:
d.ktri:
version: 0
d.issuerAndSerialNumber:
# CN of the issuer and serial of the certificate/keypair required to decrypt the contents
issuer: C=AU, ST=Victoria, L=Melbourne, CN=foletta.xyz Root CA/emailAddress=greg@foletta.org
serialNumber: 13257416122132238758
keyEncryptionAlgorithm:
algorithm: rsaEncryption (1.2.840.113549.1.1.1)
parameter: NULL
encryptedKey:
# 255 byte random key, encrypted with the RSA certificate
encryptedContentInfo:
contentType: pkcs7-data (1.2.840.113549.1.7.1)
contentEncryptionAlgorithm:
# Note the symmetric cipher below
algorithm: des-ede3-cbc (1.2.840.113549.3.7)
# I *think* this is the initialisation vector for 3DES
parameter: OCTET STRING:
0000 - 01 ed 63 51 42 91 6e a0- ..cQB.n.
encryptedContent:
# Content encrypted with the symmetric key
unprotectedAttrs:
<ABSENT>

The two main sections are encryptedKey and encryptedContent. The content-encryption key is randomly generated and used to encrypt the data with a symmetric cipher (3DES), then the key itself is encrypted using the public key of the signing CA that was requested in the first step. I have a copy of the private key of the signing CA (“Blog Post SubCA”), so we can decrypt the content and look at the request.

The Signing Request

Using the -decrypt option and the sub-CA certificate/private key, we can decrypt the second CMS to take a look at the certificate signing request, again redacted for brevity:

# Extract, verify and pipe out content
openssl cms -in scep_raw -verify -inform DER -noverify |
# Decrypt and pipe out content
openssl cms -inform DER -decrypt -recip Blog_Post_SubCA.cer -inkey Blog_Post_SubCA.key |
# Parse certificate request
openssl req -inform DER -noout -text

Certificate Request:
Data:
Version: 1 (0x0)
Subject: C = AU, ST = Victoria, L = Melbourne, O = foletta.xyz, OU = IT, CN = BlogPostCert
Subject Public Key Info:
Public Key Algorithm: rsaEncryption
Public-Key: (2048 bit)
Modulus:
# Removed for brevity
Exponent: 65537 (0x10001)
Attributes:
challengePassword :8qKfdeen
Requested Extensions:
Signature Algorithm: sha256WithRSAEncryption
Signature Value:
# Removed for brevity

In the core we’ve got a bog-standard certificate request ready for signing, with no fancy requested extensions. The only attribute is the SCEP challenge password.

A quick aside: as per RFC 4210, the signer is able to change any field in this CSR except the public key.

SCEP Response

The response from the SCEP server containing the certificate is similar to the request:

The verification CMS, signed using the public key in the certificate request, allowing to requestor to verify it with their generated private key
The encrypted CMS, with a key encrypted by self-signed certificate that was sent in the request, allowing the requestor to decrypt using it’s generated private key.

The difference is at the core is a degenerate case of the SignedData, with no signers and content, just the certificates. In our case, it has our newly-signed certificate, as well as the certificate of the CA that signed it. The requestor now has the certificate to use as a server certficate on a web-server, or as a client certificate to authenticate themselves to a service.

# Extract, verify, and pipe response
openssl cms -verify -in scep_response -inform der |
# Decrypt and pipe response
openssl cms -decrypt -inform der -recip self_signed.cer -inkey blog.key |
# View 'degenerate' signed data certificates
# I can't get CMS to open it, so I use pkcs7
openssl pkcs7 -inform der -noout -print_certs -text

# This first certificate is the signed response to our request
Certificate:
Data:
Version: 3 (0x2)
Serial Number: 5037000822208222218 (0x45e7058f8512540a)
Signature Algorithm: sha256WithRSAEncryption
Issuer: C=AU, ST=Victoria, L=Melbourne, O=foletta.xyz, OU=IT, CN=Blog Post Sub CA
Validity
Not Before: Jul 8 22:25:03 2024 GMT
Not After : Jul 8 22:25:03 2025 GMT
Subject: C=AU, ST=Victoria, L=Melbourne, O=foletta.xyz, OU=IT, CN=BlogPostCert
Subject Public Key Info:
Public Key Algorithm: rsaEncryption
Public-Key: (2048 bit)
Modulus:
# Removed for brevity
Exponent: 65537 (0x10001)
X509v3 extensions:
# We can't use this certificate to issue other certificates
X509v3 Basic Constraints: critical
CA:FALSE
# Identifier of the public key of this certificate
X509v3 Subject Key Identifier:
7A:DC:05:7B:2C:A8:E3:F8:9C:E6:40:72:6B:50:4F:81:85:C0:9C:6B
# Identifier of the public key of the CA that signed this certificate
X509v3 Authority Key Identifier:
keyid:7D:10:79:F8:A3:27:D5:8A:31:1C:82:1C:29:40:DF:AD:6B:61:44:D1
DirName:/C=AU/ST=Victoria/L=Melbourne/CN=foletta.xyz Root CA/emailAddress=greg@foletta.org
serial:B7:FB:CD:B8:E7:3A:91:A6
Signature Algorithm: sha256WithRSAEncryption
Signature Value:
# Removed for brevity
# This certificate is a copy of the sub-CA that signed the certificate, with the bulk removed for brevity
Certificate:
Data:
Version: 3 (0x2)
Serial Number:
b7:fb:cd:b8:e7:3a:91:a6
Signature Algorithm: sha256WithRSAEncryption
Issuer: C=AU, ST=Victoria, L=Melbourne, CN=foletta.xyz Root CA/emailAddress=greg@foletta.org
Validity
Not Before: Jul 1 02:27:55 2024 GMT
Not After : Sep 26 06:21:46 2032 GMT
Subject: C=AU, ST=Victoria, L=Melbourne, O=foletta.xyz, OU=IT, CN=Blog Post Sub CA
# Rest of the CA certificate follows from here

Summary

Not sure if this ended up being ‘bite-size’ in the end, but it was an enjoyable challenge to take the request and response and peel back the layers. The openssl application has got an immense amount of functionality fronted by a pretty hard-to-use interface. I find challenges like this are the best way to get familiar with its incantations, as opposed to copy and pasting commands in from the internet.

Keeping Them Honest

Wed, 25 Oct 2023 00:00:00 +0000

Last month my car, a Toyota Kluger, was hit while parked in front of my house. Luckily no one was injured and while annoying, the person had insurance. The insurance company came back and determined that the car had been written off and I would be paid out the market value of the car. The question in my mind was ‘what is the market value?’ How could I keep the insurance company honest and make sure I wasn’t getting stiffed?

In this post I’ll go through an attempt to find out the market price for a Toyota Kluger. We’ll automate the retrieval of data and have a look at its features, create a Bayesian model, and see how this model performs in predicting the sale price of a Kluger.

More than anything, this was a chance to put into practice the Bayesian theory I’ve been learning in books like Statistical Rethinking and Bayes Rules! books. With any first dip of the toe, there could be assumptions I make that are incorrect, or things that are outright wrong. I’d appreciate feedback and corrections.

Finally, I won’t be showing as much of the code as I’ve done in previous posts. If you’d like to dive under the hood, you can find the source for this article here.

TL;DR

A word of warning before anyone gets too invested: this article is slightly anticlimactic. We do find that the sale price of a Kluger will reduce by around .6% for every 1,000 km driven, but there’s still a lot of variability that we dont capture, making our prediction intervals too wide to be of any use. There’s a other factors that go into determining a price that we need to take into account in our model.

But this isn’t the end, it’s just the start. Better to start off with a simple model, assess, and slowly increase the complexity, rather than throwing a whole bathtub of features at the model straight up. It also leaves me with material for another article!

Data Aquisition

The first step is to acquire some data on the current market for Toyota Klugers. A small distinction is that data will be the for sale price of the car, rather than the sold price, but it still should provide us with a good representation of the market.

We’ll pull the data from a site that advertises cars for sale. The site requires Javascript to render, so a simple HTTP GET of the site won’t work. Instead we need to render the page in a browser. We’ll use a docker instance of the webdriver Selenium, interfacing into this with the R package RSelenium to achieve this. This allows us to browse to the site from a ‘remotely controller’ browser, Javascript and all, and retrieve the information we need.

We connect to the docker instance, setting the page load strategy to eager. This will speed up the process as we won’t be waiting for stylesheets, images, etc to load.

rs <- remoteDriver(remoteServerAddr = '172.17.0.2', port = 4444L)
rs$extraCapabilities$pageLoadStrategy <- "eager"
rs$open()

Each page of Klugers for sale is determined by a query string offsetting into the list of Klugers in multiples of 12. We generate the offsets (12, 24, 36, …) and from this the full URI of each page. We then navigate to each page, read the source, and parse into a structured XML document.

kluger_source <-
tibble(
# Generate offsets
offset = 12 * c(0:100),
# Create URIs based on offsets
uri = glue("{car_site_uri}/cars/used/toyota/kluger/?offset={offset}")
) |>
mutate(
# Naviate to each URI, read and parse the source
source = map(uri, ~{
rs$navigate(uri)
rs$getPageSource() |> pluck(1) |> read_html()
} )
)

With the raw source in our hands, we can move on to extracting the pieces of data we need from each of them.

Data Extraction

Let’s define a small helper function xpt() to make things a little more concise.

# XPath helper function, xpt short for xpath_text
xpt <- function(html, xpath) {
html_elements(html, xpath = xpath) |>
html_text()
}

Each page has ‘cards’ which contain the details of each car. We ran into an issue is where not all of them have an odometer reading, which is the critical variable we’re going to use in our modelling later. To get around this, slightly more complicated XPath is required: we find each card by first finding all the odometer <li> tags, then using the ancestor:: axes we find the card <div> that it sits within. The result: we have all cards which have odometer readings.

From there, it’s trivial to extract specific properties from the car sale.

kluger_data <-
kluger_source |>
# Find the parent card <div> of all odometer <li> tags.
mutate(
cards = map(source,
~html_elements(.x,
xpath = "//li[@data-type = 'Odometer']/ancestor::div[@class = 'card-body']"
)
)
) |>
# Extract specific values from the card found above
mutate(
price = map(cards, ~xpt(.x, xpath = ".//a[@data-webm-clickvalue = 'sv-price']")),
title = map(cards, ~xpt(.x, xpath = ".//a[@data-webm-clickvalue = 'sv-title']")),
odometer = map(cards, ~xpt(.x, xpath = ".//li[@data-type = 'Odometer']")),
body = map(cards, ~xpt(.x, xpath = ".//li[@data-type = 'Body Style']")),
transmission = map(cards, ~xpt(.x, xpath = ".//li[@data-type = 'Transmission']")),
engine = map(cards, ~xpt(.x, xpath = ".//li[@data-type = 'Engine']"))
) |>
select(-c(source, cards, offset)) |>
unnest(everything())

Here’s a sample our raw data:

Kluger Market Data

Now some housekeeping: the price and odometer are strings with a dollar sign, so we need to convert these integers. We also create a new megametre variable (i.e. thousands of kilometers) which will the variable we use in our model. The year, model, and drivetrain are extracted out of the title of the advert using regex.

kluger_data <-
kluger_data |>
mutate(
odometer = parse_number(odometer),
odometer_Mm = odometer / 1000,
price = parse_number(price),
year = as.integer( str_extract(title, "^(\\d{4})", group = TRUE) ),
drivetrain = str_extract(title, "\\w+$"),
model = str_extract(title, "Toyota Kluger ([-\\w]+)", group = TRUE)
)

Kluger Market Data

Taking a Quick Look

Let’s visualise key features of the data. The one I think will be most relevant is how the price is affected by the odometer reading.

Nothing too surprising here, there more kilometers, the less the sell price. But what we notice is the shape: it looks suspiciously like there’s some sort of negative exponential relationship between the the odometer and price. What if, rather than looking odometer versus price, we look and odometer versus log(price):

There’s some good news, and some bad news here. The good news is that the log transform has given us a linear relationship between the two variables, simplifying our modelling.

The bad news comes is that the data looks to be heteroskedastic, meaning its variance changes across the odometer ranges. This won’t affect our linear model’s parameters, but will affect our ability to use the model to predict the price. We’ll persevere nonetheless.

There’s nice interpretation of the linear model when using a log transformation. When you fit a line $y = \alpha + \beta x$, the slope $\beta$ is “the change in y given a change of one unit of the x”. But when you fit a line to to $log(y) = \alpha + \beta x$, for small $\beta$, $e^\beta$ is ‘the percentage change in y for a one unit change of x’.

Where’s the the other variance coming from? Here’s the same view, but we split it out by model:

It barely needs to be stated, but the Kluger model has an impact on the sale price.

Modelling

Let’s start the modelling by thinking about the generative process for the price. Our observed variables odometer, year, model, and drivetrain are likely going to have an affect on price. There are some unobserved variables, such as the condition of the car its popularity that would also have an affect. There’s some confounds that may need to be dealt with as well: year directly affects price, but also goes through the odometer (older cards are more likely to have more kilometres). Model affects price, but also goes through the drivetrain (certain models have certain drivetrains).

The best way to visualise this is using the directed acyclic graph (DAG):

While I do have these variables available to me, I’d like to start with the most simple model I can: log of the price predicted by the odometer (in megametres). In doing this I’m leaving a lot of variability on the table, so the model’s ability to predict is likely going to be hampered. But better to start simple and build up.

At this point I could rip out a standard linear regression, but where’s the sport in that? Instead, I’ll use this as an opportunity to model this in a Bayesian manner.

Bayesian Modeling

I’m going to be using Stan to perform the modelling, executing it from R using the cmdstanr package. Here’s the Stan program:

data {
int<lower=0> n;
vector[n] odometer_Mm;
vector[n] price;
}
parameters {
real a;
real b;
real<lower=0> sigma;
}
model {
log(price) ~ normal(a + b * odometer_Mm, sigma);
}
generated quantities {
array[n] real y_s = normal_rng(a + b * odometer_Mm, sigma);
real price_pred = exp( normal_rng(a + b * 60, sigma) );
}

It should be relatively easy to read: the data is our observed odometer (in megametres) and price, the parameters we’re looking to find are a (for alpha, the intercept), b (for beta, the slope), and sigma (our variance). Our likelihood is a linear regression with a mean basedon on a, b and the odometer, and a standard deviation of sigma.

There’s a conspicuous absence of priors for our parameters. If the priors are not specified, they’re improper priors, and will be considered flat $Uniform(- \infty, +\infty)$, with the exception of sigma for which we have defined a lower bound of 0 in the data section. Flat priors aren’t ideal, as there is some prior information I think we can build into the model (\ \ is unlikely to be positive). But I’m going to do a bit of hand-waving and not put stake in the ground at this stage.

We’ll talk about the generated quantities a little later; these are used for validating the predictive capability of the model.

Let’s run the model with the data to get an estimate of our posterior distributions:

kluger_fit <- kluger_model$sample(
data = compose_data(kluger_data),
seed = 123,
chains = 4,
parallel_chains = 4,
refresh = 500,
)

Running MCMC with 4 parallel chains...
Chain 1 Iteration: 1 / 2000 [ 0%] (Warmup)
Chain 2 Iteration: 1 / 2000 [ 0%] (Warmup)
Chain 3 Iteration: 1 / 2000 [ 0%] (Warmup)
Chain 4 Iteration: 1 / 2000 [ 0%] (Warmup)
Chain 2 Iteration: 500 / 2000 [ 25%] (Warmup)
Chain 3 Iteration: 500 / 2000 [ 25%] (Warmup)
Chain 1 Iteration: 500 / 2000 [ 25%] (Warmup)
Chain 4 Iteration: 500 / 2000 [ 25%] (Warmup)
Chain 2 Iteration: 1000 / 2000 [ 50%] (Warmup)
Chain 2 Iteration: 1001 / 2000 [ 50%] (Sampling)
Chain 3 Iteration: 1000 / 2000 [ 50%] (Warmup)
Chain 3 Iteration: 1001 / 2000 [ 50%] (Sampling)
Chain 4 Iteration: 1000 / 2000 [ 50%] (Warmup)
Chain 1 Iteration: 1000 / 2000 [ 50%] (Warmup)
Chain 1 Iteration: 1001 / 2000 [ 50%] (Sampling)
Chain 4 Iteration: 1001 / 2000 [ 50%] (Sampling)
Chain 2 Iteration: 1500 / 2000 [ 75%] (Sampling)
Chain 3 Iteration: 1500 / 2000 [ 75%] (Sampling)
Chain 4 Iteration: 1500 / 2000 [ 75%] (Sampling)
Chain 1 Iteration: 1500 / 2000 [ 75%] (Sampling)
Chain 2 Iteration: 2000 / 2000 [100%] (Sampling)
Chain 2 finished in 3.9 seconds.
Chain 3 Iteration: 2000 / 2000 [100%] (Sampling)
Chain 3 finished in 4.3 seconds.
Chain 4 Iteration: 2000 / 2000 [100%] (Sampling)
Chain 4 finished in 4.9 seconds.
Chain 1 Iteration: 2000 / 2000 [100%] (Sampling)
Chain 1 finished in 5.3 seconds.
All 4 chains finished successfully.
Mean chain execution time: 4.6 seconds.
Total execution time: 5.4 seconds.

Assessing the Model

What’s Stan done for us? It’s used Hamiltonian Monte Carlo to take samples from an estimate of our posterior distribution for each of our parameters a, b, and sigma. Now we take a (cursory) look at whether the sampling has converged, or whether some of the sampling has wandered off into a strange place.

The trace plot is the first diagnositc tool to pull out. We want these to look like “fuzzy caterpillars”, showing that each chain is exploring the distribution in a similar way, and isn’t wandering off on its own for too long.

These look pretty good. That’s as much diagnostics as we’ll do for the sake of this article; for more serious tasks you’d likely look at additional convergence tests such as effective sample size and R-hat.

Taking the draws/samples from the posterior and plotting as a histogram we see the distribution of values that each of our four chains has come up with:

The first thing to notice it that, on the whole, each one looks Gaussian. Secondly, each of the chains has a similar shape, meaning they’ve all explored similar parts of the posterior. The intercept a has a mean approximately 11.13, and the slope b has a mean of approximately -0.0063. These are on a log scale, so exponentiating each of these values tells us that the average price with zero on tne odometer is ~$66k, and for every 1,000km the average price is ~99.3% what it was before the 1,000km were driven.

We’re not dealing with point estimates as we would with a linear regression, we’ve got an (estimate) of the posterior distribution. As such, so there’s no single line to plot. Sure we can take the mean, but we could also use the median or mode as well. To visualise the regression we take each of our draws and plot it as a line, effectively giving us the confidence intervals for the a and b parameters.

The confidence intervals are not very wide (which we saw in the histograms above). Looking at the 89% interval of the slope parameter we see it’s between -0.0061194 and -0.0064036. Exponentiating this and turning into percentages, we find that the plausible range for the decrease in price per 1,000km driver is between 0.610% and 0.638%.

The bad news is news we really already knew: the variance sigma around our line is large and it looks to be non-constant across the odometer values. A check to see how well this performed is posterior prediction, in which we bring sigma into the equation.

Recall the following line in our Stan program:

array[n] real y_s = normal_rng(a + b * odometer_Mm, sigma);

What we’re doing here is using the parameter posterior distributions, our model, and generating random draws to create a posterior predictive distribution for each odometer value. The idea is that, if our model is ‘good’, we should get values back that look like the data we’re modelling. In the plot below, I’ve filtered out values below 4.5% and below 94.5% to give an 89% prediction interval.

What we find is that the the predictive value of our simple linear model is not great. At odometer values close to zero it’s too conservative, with the all the prices falling well inside our predicted bands in light blue. At the other end of the scale the model is too confident, with many of the real observationsfalling outside of our predictive bands.

Another way to look at this is to look at the densities for both our model and the real values as the odometer values change. You can think of this as sitting on the above graph’s x-y plane, moving backwards along the odometer and looking at 10,000km slices of odometer values:

This gives us a nice comparison of the models proablity density compared to the real data. At the start all of the data fits inside the 89% PI, and as we move along odometer values, the log(price) gets wider and falls outside outside of the modoels predicted area.

Despite these obvious flaws, let’s see how the model performs answering our original question: “what is the market sell price for a Toyota Kluger with 60,000kms on the odometer?” I’m using this line from the generated values section of the Stan model:

real price_pred = exp( normal_rng(a + b * 60, sigma) );

This uses parameters drawn from the posterior distribution, but fixes the odometer value at 60 megametres, and exponentiates to give us the price rather than log(price).

Here’s the resulting distribution of prices with an 89% confidence interval (5.5% and 94.5% quaniles):

That’s a large spread, with an 89% interval between $33,878.97 and $65,575.44. That’s too large to be of any use to us in validating the market value the insurance company gave me for my car.

Summary

We’ve been on quite a journey in this article: from gathering and visualising data, to trying and validating new Bayesian modelling approach, to finally generating prediction intervals for the Kluger prices. All this, and at the end we’ve got nothing to show for it?

Well, not quite. Yes we’ve got a very simple model that doesn’t perform very well, but it is a foundation. From this, we can start to bring in other predictors that influence price. The next step might be to look at a hierarchical model that brings in the model of the Kluger. Maybe we can also find some data on the condition of the car? Sounds like a good idea for another post!

Telling a Spatial Story

Thu, 09 Mar 2023 00:00:00 +0000

My friend Jen is writing a thesis and recently reached out to me to see if I could help. She had an upcoming presentation up wanted to add some visualisation to it to better tell the story. I jumped at the opportunity as it was an opportunity to familiarise myself with an area I hadn’t previously explored: geospatial data.

In this short article I’ll take you through the creation of the visualisation. What I hope it shows is that the transition from raw data to something that tells a story can be done elegantly and with a relatively small amount of code.

What’s the Story?

Jen’s thesis is on post-war migration into the inner-northern suburbs of Melbourne, Australia. Using census data from the 50s, 60s, and 70, she wanted to communicate this migration, specifically the increase in concentrations on a per suburb basis and how how migration changed geographically over these decades.

Jen had provided me with the data, and I thought the best way to communicate this was to present the data on the geography of Melbourne, animating the changes between each census year.

Step 1: The Data

Jen sent me the migration data in an Excel spreadsheet, an I manually changed it into a tidy format. Were I doing this on an ongoing basis I would have scripted this tidying for reproducibility, but due to time constraints the manual method was quicker and easier.

Here’s the first few rows of the data showing the year of the census, the suburb, and the total number and percentage of the population born overseas.

migrant_data <-
read.xlsx('data/migrant_population_growth.xlsx', sheet = 'Tidied') %>%
as_tibble()
migrant_data |>
arrange(Suburb) |>
head(10)

## # A tibble: 10 × 4
## Year Suburb Total Percentage
## <dbl> <chr> <dbl> <dbl>
## 1 1961 Altona 3973 0.246
## 2 1966 Altona 7186 0.287
## 3 1971 Altona 8777 0.287
## 4 1971 Broadmeadows 20355 0.201
## 5 1954 Brunswick 6603 0.123
## 6 1961 Brunswick 15746 0.297
## 7 1966 Brunswick 19013 0.366
## 8 1971 Brunswick 20352 0.395
## 9 1954 Caulfield 12727 0.153
## 10 1971 Caulfield 16696 0.204

The next step was to get the geospatial data for suburbs. Thankfully the Australian government has shapefile data available. Here’s a render of the full content of the geospatial data:

vic_localities <- read_sf('data/VIC_LOC_POLYGON_shp GDA2020/vic_localities.shp')
vic_localities %>%
ggplot() +
geom_sf(size = .1)

These borders are local government areas for the entire state of Victoria, Australia. The borders of these localities aren’t going to be exactly the same now as they were when the censuses were performed, but it’ll be good enough for our purposes. We’re only interested in the inner-Melbourne area, so we crop this to the relevant latitudes and longitudes:

inner_melb_localities <-
vic_localities %>%
st_crop(xmin=144.7, xmax=145.1, ymin=-37.95, ymax=-37.6)

With our two key pieces of data in place, we can start to put them together.

Step 2 - Data Wrangling

Next step is to merge our migration data with our geospatial data using the suburb as our key, however it’s a little more complex that a simple join. As we want to ensure for every year we have all of the geospatial information so as to render the full map, we need to do a bit of group()ing and nest()ing.

The way I’ve tackled this is as such:

Group by each year.
Nest the data based on these groups.
Perform a join on this nested data with the spatial data.
This way we ensure that for each year, the spatial data for each suburb is present and the map is complete.
Unnest the data
For suburbs that don’t have any data for a particular census, we assign them 0 in the Percetnage and Total columns.
- I talked to Jen about this, and she made a decision in the short term to replace these with 0.
- Were more rigor required for the visualisation, other options would need to be considered to better portray this missing data.
Convert to a geospatial object.

Below is the full pipeline, interspersed with comments to help understand what’s happening in each stage:

migrant_data_geo <-
migrant_data %>%
group_by(Year) %>%
nest() |>
# On a per census year basis, join each year's data with the spatial data
mutate(
geo = map(data, ~{ right_join(.x, inner_melb_localities, by = c('Suburb' = 'LOC_NAME')) })
) %>%
unnest(geo) |>
arrange(Suburb) %>%
# Replace the NAs due to missing data with zero
mutate(
Percentage = replace_na(Percentage, 0),
Total = replace_na(Total, 0),
) %>%
select(-data) %>%
ungroup() %>%
# Convert back to a 'simple features' (geosptatial) object
st_as_sf()

Step 3 - Rendering

The final step is the easiest: the rendering. The map is rendered with the fill of each polygon representing the percentage of population born overseas. This is then animated, with the fill transitioning smoothly between each Year

migrant_data_geo_animation <-
migrant_data_geo %>%
ggplot() +
geom_sf(aes(fill = Percentage)) +
labs(
title = "Melbourne - Percentage Residents Born Overseas",
subtitle = "Census Year: {closest_state}"
) +
theme(
plot.title = element_text(size = 10),
plot.subtitle = element_text(size = 8),
legend.title = element_text(size = 8),
legend.text= element_text(size = 6)
) +
scale_fill_distiller(name = "Percent", trans = 'reverse', labels = percent) +
transition_states(Year, transition_length = 3, state_length = 5)

What we have in the end is what I handed over to Jen for her presentation: an animation showing the change in overseas-born population in inner-city Melbourne from 1954 to 1971.

Is That It?

Is this visualisation perfect? Far from it. There’s probably two areas where it could be improved. The first (and least important) is the aesthetics of it; I think it could simply look better. Better fonts, better arrangement, different colours.

But more importantly I think there that there are choices to be made about how the information is presented. The suburbs with no information have been zeroed out, is that the right choice? Does the colour scale accurately convey the change, or does it need to have multiple colours in it? Do the suburbs need to be labelled? What exactly is the definition of “inner-north Melbourne”?

All of those are decisions best made by someone with domain-specific knowledge, not necessarily by the person who’s generating the visualisation. Regardless, if we’re looking at this through an 80/20 lens, I contiue to be amazed about the 80 that can be generated with only a few lines of R code.

A Brief Tour of Lebesgue Curves

Sun, 30 Oct 2022 00:00:00 +0000

Before we start a note: this post is a sidebar for another article I’m currently writing. There aren’t any grand conclusions or deep insights, it’s more exploratory.

Whilst writing an article on memory allocations, I needed a way to map a one-dimensional number (the memory location) on to two-dimensional space. By doing this I could visualise where in memory these allocation were occurring.

My initial reaction was to reach for the space-filling Hilbert curve à la the XKCD “Map of the Internet”, but whist researching I discovered the Lebesgue Curve, also known as the Z-order or Morton curve. At first glance it looked to have reasonable locality, and its inherent binary nature meant it appeared easier to implement.

In this article I’ll implement the Lebesgue curve and explore some of its properties.

Lebesgue Curve

The Lebesgue curve maps an one-dimensional integer into integers in two or more dimensions. In can also be used in reverse to map two or more integers back into a single integer. If we get a bit fancy with our notation, we can define the Lebesgue function $l$ as:

$$ l : \mathbb{N} \to \mathbb{N^2} $$

where $\mathbb{N}$ is the set of natural numbers, including 0.

The algorithm is relatively simple:

Take an $n$ bit integer $Z$
Mask the even bits $[0, 2, \ldots, n - 2]$ into $x$
Mask the odd bits $[1, 2, \ldots, n - 1]$ into $y$
Collapse/shift the masked bits down so that they are “next” to each other
- This results in an $\frac{n}{2}$ bit integer

In the C++ code below I’ve defined the lebesgue_coords() function that implements the above algorithm. It’s certainly not the most optimal implementation (it iterates through all the bits even if they’re 0), but it should have clarity. I’ve then vectorised it in the lebesgue() function that returns a list of $x$ and $y$ coordinates for each $z$ integer, and exported using Rcpp so it can be used in the R environment:

#include <Rcpp.h>
using namespace Rcpp;
//The x,y vertice generated from the single z value
struct vert { unsigned long x; unsigned long y; };
//Lebesgue calculation for a single z value
struct vert lebesgue_coords(unsigned long z) {
struct vert coords;
unsigned long shift_mask;
//Mask out even bits
 coords.x = z & 0x55555555;
//Mask out odd bits, then shift back
 coords.y = (z & 0xaaaaaaaa) >> 1;
//This bit compresses the masked out bits.
 //i.e. 1010101 -> 1111
 shift_mask = 0xfffffffc;
do {
//Extract the top bits, then shift them down one
 long int x_upper = (coords.x & shift_mask) >> 1;
long int y_upper = (coords.y & shift_mask) >> 1;
//Clear out the top bits from x and re-introduce
 //the shift top bits, thereby compressing them together
 coords.x = x_upper | (coords.x & ~shift_mask) ;
coords.y = y_upper | (coords.y & ~shift_mask);
} while (shift_mask <<= 1);
return coords;
}
// [[Rcpp::export]]
List lebesgue(IntegerVector z) {
int i;
struct vert v;
IntegerVector x,y;
for (i = 0; i < z.size(); i++) {
v = lebesgue_coords(z[i]);
x.push_back(v.x);
y.push_back(v.y);
}
return List::create(Named("x") = x, Named("y") = y);
}

With this function we can have a look at how this function works across the integers $[0,255]$. You should be able to see the fractal-like behaviour, with clusters of 4, 16, 64, etc:

lebesgue_points <-
tibble(z = 0 : 255) |>
mutate(l = as_tibble(lebesgue(z))) |>
unnest(l)
print(lebesgue_points)

# A tibble: 256 × 3
z x y
<int> <int> <int>
1 0 0 0
2 1 1 0
3 2 0 1
4 3 1 1
5 4 2 0
6 5 3 0
7 6 2 1
8 7 3 1
9 8 0 2
10 9 1 2
# … with 246 more rows

Locality

I mentioned at the start that the Lebesgue has ‘good locality’, but what exactly does this mean? There are multiple ways to define it, with a more rigorous take in this paper. I’ll be a little more little more hand-wavy and define it as “points that are close together in one-dimensions should be close together in two dimensions.”

We’ll look at consecutive numbers - which have a distance of 1 in one-dimension - and compare their distance in two dimensions. More formally, we’ll determine see how far away $(x_{z},y_{z})$ is away from $(x_{z-1}, y_{z-1})$ using good old fashioned Pythagoras to determine the distance:

$$ d = \sqrt{(x_2 - x_1)^2 + (y_2 - y_1)^2} $$ Let’s take a look at the average distance between the $z$ values $[0,255]$:

lebesgue_locality <-
lebesgue_points |>
mutate(
coord_distance = sqrt(
(x - lag(x,1))^2 +
(y - lag(y,1))^2
)
) |>
filter(!is.na(coord_distance))
lebesgue_locality |>
summarise(mean_distance = mean(coord_distance))

# A tibble: 1 × 1
mean_distance
<dbl>
1 1.56

So on average, each point is 1.56 times further away in the two dimensional representation that in the one-dimensional representation. But as we all (should) know, an average is a summary and hides specifics. Taking a look at $z$ versus the distance paints a more accurate picture of the underlying process:

Locality is good, except every so often we get a spike of distance between points. This spike is where we’re moving between our different power-of-two regions: $2^4, 2^6, 2^8, \ldots$. For a different perspective, we map our two-dimensional points with colour and size conveying the distance:

We see the large outlier, but in general most points are reasonably close to each other. More importantly it should be good enough for my original purposes.

Additive Properties

Finally, we’ll look at some additive properties that yielded an interesting result. As part of the aforementioned article I am using the Lebesgue curve in, a really useful property would have been this:

$$ l(a + b) = l(a) + l(b) $$ Unfortunately I quickly determined that this was not the case:

lebesgue(0:10 + 3)$x == lebesgue(0:10)$x + lebesgue(3)$x

 [1] TRUE TRUE FALSE TRUE TRUE FALSE FALSE FALSE TRUE TRUE FALSE

As I played around with different ranges and different addends, I couldn’t discern the pattern. The next move was to visualise it to try and better understand the interaction.

We do this in the code below. The crossing() is a handy function to know, generating which generates all 128x128 combinations of the integers 0 through 127. For each of these pairs, we determine whether adding each combination inside the function versus individually leads to a true or false result. The result of this boolean is then visualised on each point on the graph:

equality <-
crossing(a = 0:127, b = 0:127) |>
mutate(
x = (lebesgue(a + b))$x == (lebesgue(a)$x + lebesgue(b)$x),
y = (lebesgue(a + b))$y == (lebesgue(a)$y + lebesgue(b)$y)
) |>
pivot_longer(cols = c(x, y), names_to = 'coord', values_to = 'equality')
print(equality)

# A tibble: 32,768 × 4
a b coord equality
<int> <int> <chr> <lgl>
1 0 0 x TRUE
2 0 0 y TRUE
3 0 1 x TRUE
4 0 1 y TRUE
5 0 2 x TRUE
6 0 2 y TRUE
7 0 3 x TRUE
8 0 3 y TRUE
9 0 4 x TRUE
10 0 4 y TRUE
# … with 32,758 more rows

I must admit, I was a bit stunned when I saw this pop out; it was not at all what I expected. You can see some interesting fractal behaviour, with each boolean pattern being repeated in larger and larger sections. It looks a little like a Sierpiński triangle, but I’m not sure if there’s any relation. It may be somewhat anticlimactic, but I haven’t delved any deeper into this. That gets added to the ever-growing todo list.

Summary

In this article we had a brief, exploratory look at the space-filling “Lebesgue” curve. We looked at how it’s implemented, some of its locality behaviour, and some interesting results under addition. In a future article we’ll use this algorithm to help visualise the dynamic memory allocations of a process.

Free WiFi with Randomness

Sun, 02 Oct 2022 00:00:00 +0000

There’s a few different pictures making their way around social media showing a complicated definite integral, and asking guests to evaluate it to get the password for free WiFi. Here’s an example:

I loved calculus back at uni, but uni was a fair while ago now and I’m more than a little dusty. I briefly attempted integrating the equation, looking up some terms I could remember (integration by parts? product rule?). But then I thought: if I’m sitting in a cafe trying to get WiFi, I’m going to want a quick and dirty numerical solution, not some beautiful mathematical ‘proof’.

So in this article I’m going to show you that quick and dirty solution. We’re going to use randomness via the Monte Carlo method to find a numerical solution to the definite integral, hopefully getting us access to that sweet free WiFi.

The Function

Let’s first define the function that is to be integrated in R, calling it $f()$:

f <- function(x) {
(x^3 * cos(x/2) + 1/2) * sqrt(4 - x^2)
}

We’ll than calculate $f(x)$ for values of x between [-2,2], using a small increments between each x value to ensure we’re got reasonable accuracy for our subsequent calculations.

coords <-
tibble(
x = seq(from = -2, to = 2, by = 0.000001)
) |>
mutate(y = f(x))

Let’s take a look at what the function looks like:

There’s two areas we’ll need to take into consideration when integrating: from -2 to around -1.2, and from -1.2 to 2. We need to remember that when integrating, regions above the x-axis evaluate to positive numbers, but regions below evaluate to negative numbers. When calculating the total, we’ll have to subtract that left region away from the right region.

We’re going to need the minimum and maximum values of $f(x)$ in our calculation, so let’s pull them out:

min_max <-
coords |>
summarise(
min_y = min(y),
max_y = max(y)
)
min_max

# A tibble: 1 × 2
min_y max_y
<dbl> <dbl>
1 -2.89 4.03

We can now move on to integrating this function.

Integration with Randomness

How are we going calculate a numerical answer to this integral? We’ll use randomness to help us:

Draw a number of random x and y values from a uniform distribution.
Calculate f(x) for each of the x random values.
Determine whether f(x) above/below the random y and above/below the x-axis (both depending on the region).
Find the ratio of points inside the areas versus points outside.
Multiply this ratio by the total rectangular size of the area to find the definite integral area.

As a first step, let’s find the total area:

total_area <- (2 - -2) * (min_max[['max_y']] - min_max[['min_y']])
total_area

[1] 27.66986

As mentioned before, we’ll have to be wary of the area under the x-axis. We’ll use an encoding scheme where points outside are encoded as 0, points inside the positive area are encoded as 1, and points inside the negative area are encoded as -1. When can then simply take the mean() of these encoded values to determine the ratio of the area.

Here’s a first pass with 50,000 points to show how it works. I’ve omitted the graph rendering code:

ratio <-
tibble(
x = runif(50000, -2, 2),
y = runif(50000, min_max[['min_y']], min_max[['max_y']]),
fx = f(x)
) |>
mutate(
integral_encoding = case_when(
# Above the x-axis, below the curve
fx > 0 & y < fx & y > 0 ~ 1,
# Below the x-axis, above the curve
fx < 0 & y > fx & y < 0 ~ -1,
# Everything else
TRUE ~ 0
)
)

We see the random points, and their associated encoding which tells us which area they’re in. 50,000 points probably isn’t enough for an accurate answer, so we’ll do another run with 100,000,000 points. I’ve omitted the code in this run, but the results are in ratio. We then summarise the mean of the encoding, giving us our ratio.

integral_ratio <-
ratio |>
summarise(
ratio = mean(integral_encoding)
) |>
pull(ratio)

The calculated ratio is (drumroll):

integral_ratio

[1] 0.1134934

Just above 11%. Multiplying this by the total area gives us the answer we need:

total_area * integral_ratio

[1] 3.140347

Immediately we something interesting about that number: it’s very close to Pi. Remember we’re here for a quick and dirty way to get the WiFi password, so my first guess would be the first 10 digits of Pi.

Why didn’t we get the value? Setting aside any mistakes I may have made in my calculations above, I’d guess that the number of random points isn’t enough to get good enough precision. The reason I’ve not gone larger is I run out of memory trying to generate anything more than 100,000,000.

I’ve been a little deceptive, as there’s actually a quick and easy way to approximate the definite integral in base R. It doesn’t make for a very exciting article on its own:

integrate(f, -2, 2)

3.141593 with absolute error < 2e-09

Clearly this implementation is far superior, being faster and using less memory. A brief investigation leads me to believe it’s using adaptive quadrature under the hood.

What’s the Point?

You may rightfully say “your method is slow, uses lots of resources, and isn’t even that accurate in the end: why use it?". And you’d be correct, we could use the in-built integation function, or even use a 2-dimensional grid rather than random points. It’s probably not the best method.

But for more complicated integrals in higher dimensions, things become increasingly difficult. The integrate() function doesn’t work, and the compute resources required to use the grid method would increase exponentially by the dimension.

By using randomness, a reasonable approximation of a definite integral can still be achieved using less compute resources and despite the complexity of the problem.

Summary

In this post we looked at a numerical approach to calculating a definite integral. We generated random points and encoded them as to whether they were inside or outside of the integral area. We then used the ratio of this encoding and multiplied it by the total area of the region in question to get the answer.

If you’re out and about in need of free WiFi and you see this question (or a question like it) posed to get access, don’t be intimidated: go for the quick and dirty numerical approach. Either that, or get the first 10 digits of Pi from your phone and give that a crack.

Git Under the Hood

Sun, 29 May 2022 00:00:00 +0000

While I’m not a programmer per se, I do use git almost daily and find it a great tool for source control and versioning of plain text files. But I don’t think there can be any doubt that it is not the easiest tool to use. But despite its unintuitive user interface, under the hood git is quite simple and elegant. I believe that if you can understand the fundamental constructs git uses to store, track, and manage files, then the using git becomes a lot easier.

In this article we’re going to take a look under the covers and investigate git’s fundamental constructs. We’ll start off with its storage model and look at blobs, trees and commits. We’ll see how branches are implemented, and finally we’ll unpack the git index file to understand what happens during the staging of a commit.

There’s already loads of articles out there on git internals, so what’s different about this one? Two things:

We’re going to avoid the lower level ‘plumbing’ git commands and limit ourselves to the five most common ‘porcelain’ commands: git {init, add, commit, branch, checkout}. All other work will be done using standard command line utilities.
Using the R packages git2r and tidygraph, we’ll dynamically build up a picture of the connections between git’s objects to help understand how they are tied together.

As always, the source code for this article is available up on github.

Initialisation

We’ll start by initialising a git repository, which creates a .git directory and some initial files. Git holds all of the files and metadata it needs for source control in this directory. To clarify things we’ll prune back as many of the initial files as possible, while still ensuring git recognises it as a valid repository.

# Initialise the repository (quietly)
git init --quiet
# Remove some of the created files and directories
rm -rf .git/{hooks,info,config,branches,description}
rm -rf .git/objects/{info,pack}
rm -rf .git/refs/{heads,tags}
tree .git

.git
├── HEAD
├── objects
└── refs
2 directories, 1 file

With a nice clean slate we can move on to our first object: the blob.

Blobs

The first fundamental git object we’ll look at is the blob. If we create a file and add it to the staging area, we see what has changed in the .git directory.

# Create a file
echo "Root" > file_x
# Add it to the staging area
git add file_x
tree .git

.git
├── HEAD
├── index
├── objects
│   └── 93
│   └── 39e13010d12194986b13e3a777ae5ec4f7c8a6
└── refs
3 directories, 3 files

There’s two new files - an index and an object. We’ll get to the index later in the article, but for now let’s focus on the object. Checking it’s format we find that it’s compressed data:

file .git/objects/93/39e13010d12194986b13e3a777ae5ec4f7c8a6

.git/objects/93/39e13010d12194986b13e3a777ae5ec4f7c8a6: zlib compressed data

Decompressing and looking inside, we see the file is in a structured as a “type, length, value” or TLV. The type is ‘blob’, the length is the size of the of the data (excluding the type), and the value the contents of the file we created:

pigz -cd .git/objects/93/39e13010d12194986b13e3a777ae5ec4f7c8a6 | hexdump -C

00000000 62 6c 6f 62 20 35 00 52 6f 6f 74 0a |blob 5.Root.|
0000000c

How is the path to the blob object created? It’s simply the SHA1 hash of the blob itself. The first two hexadecimal digits are used as a folder, with the remaining digits used as the object file name. We can show this by recreating the object, taking the hash, and noting it’s the same as our object’s path:

# The hash matches the object's path
echo "blob 5\0Root" | shasum

9339e13010d12194986b13e3a777ae5ec4f7c8a6 -

It can therefore be helpful to understand git as a form of content addressable storage: the location of the data that is under its control is based on the content of the data itself. Let’s explore this further: we’ll add two files with the same contents, one in the root directory and one in a subdirectory.

# Cerate a subdir
mkdir subdir
# Add two files, one in the root, one in the subdir
echo "Root & Sub" > file_y
echo "Root & Sub" > subdir/file_z
# Add the files to the staging area
git add file_y subdir
tree .git

.git
├── HEAD
├── index
├── objects
│   ├── 93
│   │   └── 39e13010d12194986b13e3a777ae5ec4f7c8a6
│   └── cc
│   └── 23f67bb60997d9628f4fd1e9e84f92fd49780e
└── refs
4 directories, 4 files

While we’ve added three files but there’s only two objects. Blobs only contain raw data, with no reference to files or directories. There’s only two pieces of unique data, and thus two objects. The file/directory information is stored in tree objects which we will take a look at in the next section.

Over the course of the article we’re going to build up a graph of the objects in the git repository to gain a visual representation of the structure. Here’s our starting point: two blobs, the first four characters of their hash, and their contents:

The two little blobs of data look pretty lonely out there. What they need is some context, and this is where the tree object comes in.

Tree

As we’ve seen, there’s no file or directory information in the blob object. The storage of this information is the role of the tree object. Let’s perform our first commit and see what’s changed in the repository:

git commit --quiet -m "First Commit"
tree .git

.git
├── COMMIT_EDITMSG
├── HEAD
├── index
├── logs
│   ├── HEAD
│   └── refs
│   └── heads
│   └── master
├── objects
│   ├── 36
│   │   └── 58bfd8a7cda8ee50181497ab8ec4e699428877
│   ├── 4e
│   │   └── eafbc980bb5cc210392fa9712eeca32ded0f7d
│   ├── 67
│   │   └── 21ae08f27ae139ec833f8ab14e3361c38d07bd
│   ├── 93
│   │   └── 39e13010d12194986b13e3a777ae5ec4f7c8a6
│   └── cc
│   └── 23f67bb60997d9628f4fd1e9e84f92fd49780e
└── refs
└── heads
└── master
11 directories, 11 files

A lot has changed and at first glance it may be a bit overwhelming, but focus in on the objects subdirectory. There’s an additional three objects on top of the two blob objects we saw before. What are they? If you’ll forgive me, I’ll use a very ugly set of commands to pull out the type and length from each of the objects:

# May god have mercy on my soul
find .git/objects -type f -exec sh -c \
"echo -n '{} -> ' && pigz -cd {} | perl -0777 -nE 'say unpack qw(Z*)'" \;

.git/objects/cc/23f67bb60997d9628f4fd1e9e84f92fd49780e -> blob 11
.git/objects/36/58bfd8a7cda8ee50181497ab8ec4e699428877 -> commit 175
.git/objects/4e/eafbc980bb5cc210392fa9712eeca32ded0f7d -> tree 101
.git/objects/67/21ae08f27ae139ec833f8ab14e3361c38d07bd -> tree 34
.git/objects/93/39e13010d12194986b13e3a777ae5ec4f7c8a6 -> blob 5

So in addition to our two blobs, we’ve got two trees and a commit. Our starting point for will be the first of the tree objects. Unlike the others, trees contain some binary information rather than UTF-8 strings. I’ll use Perl’s unpack() function so decode this into hexadecimal:

pigz -cd .git/objects/4e/eafbc980bb5cc210392fa9712eeca32ded0f7d |\
perl -nE 'print join "\n", unpack("Z*(Z*H40)*")'

tree 101
100644 file_x
9339e13010d12194986b13e3a777ae5ec4f7c8a6
100644 file_y
cc23f67bb60997d9628f4fd1e9e84f92fd49780e
40000 subdir
6721ae08f27ae139ec833f8ab14e3361c38d07bd

Like the blob we have the type and length of the object. Following this there’s an entry for each of the two files and the subdirectory that reside in the root directory. The digits preceding the file name are the mode, capturing the type of filesystem object (regular file/symbolic link/directory) and its permissions. Git doesn’t track all combinations of permissions, only whether the file is user executable or not.

Each of the the two file entries point to the hashes of the blob objects, but the subdirectory points to the hash of another tree object. Looking inside that tree object:

pigz -cd .git/objects/67/21ae08f27ae139ec833f8ab14e3361c38d07bd |\
perl -nE 'print join "\n", unpack("Z*(Z*H40)*")'

tree 34
100644 file_z
cc23f67bb60997d9628f4fd1e9e84f92fd49780e

We see this has an entry for the file_z in the subdirectory, and this points to the same hash as the file_y entry in the previous tree. A graph should make this clearer:

At the top is the root of the tree, with vertices to the two blobs (file_x and file_y) and a tree (the subdirectory). The second tree is has a single vertex to a blob (file_z). The root and subdirectory trees both point to the same blob, because both files have the same contents.

With blobs and trees we’ve built up a pseudo-filesystem, but how does this help us with source control? The object that ties all of this together is the commit.

Commit

Our third object - and the one most visible to the end user - is the commit. We’re going to open our commit up, but as we’ll learn about shortly, the hash of the commit (and thus the path to the object) depends partially on the time the commit was made. As I generate this article dynamically, there’s a little bit of overhead to get the commit object:

# Get the commit object
COMMIT_DIR=$(cut -c 1-2 .git/refs/heads/master)
COMMIT_OBJ=$(cut -c 3- .git/refs/heads/master)
# Open it up
pigz -cd .git/objects/$COMMIT_DIR/$COMMIT_OBJ |\
perl -0777 -nE 'print join "\n", unpack("Z*A*")'

commit 175
tree 4eeafbc980bb5cc210392fa9712eeca32ded0f7d
author Greg Foletta <greg@foletta.org> 1654027280 +1000
committer Greg Foletta <greg@foletta.org> 1654027280 +1000
First Commit

Again we have the type and length of the object at the start, then there’s a few different pieces of information.

The first is reference to a tree object. This is the tree object that represents the root directory of the repository. The next is the author of the commit, with their name, email address, commit time and the UTC offset. As the person who authored the commit doesn’t necessarily have to be the person who committed it to the repository, there’s also a line for the committer. Following this is the commit message, which is free text input entered at the time of the commit.

Let’s place this on our graph:

The commit points to the tree object representing the root directory. But this first commit is a special commit, missing a piece of information: parents. Every other commit in this repository from this point onwards will point to one or more parent entries. This creates a directed acyclic graph (DAG), allowing any commit to be traced back to the first commit. As every commit’s hash is dependent on its parents’ hash, the graph is also a form of Merkle tree.

If we change the contents of file_z, stage, and create a second commit, will allow us to see this additional information in the commit object:

# Change the contents, add, and create a second commit
echo "Root Changed" > file_x
git add file_x
git commit -q -m "Second Commit"
# Determine the path to the second commit object
COMMIT_DIR=$(cut -c 1-2 .git/refs/heads/master)
COMMIT_OBJ=$(cut -c 3- .git/refs/heads/master)
# Unpack the contents of the commit
pigz -cd .git/objects/$COMMIT_DIR/$COMMIT_OBJ |
perl -0777 -nE 'print join "\n", unpack("Z*A*")'

commit 224
tree 6e09d0dbb13d342d66580c40a49dd1583958ccc8
parent 3658bfd8a7cda8ee50181497ab8ec4e699428877
author Greg Foletta <greg@foletta.org> 1654027282 +1000
committer Greg Foletta <greg@foletta.org> 1654027282 +1000
Second Commit

We can then place the second commit onto our graph, omitting the link back to the parent (we’ll get to that in the next section):

What we see here represents the core of how git stores data. The commits represent ‘snapshots’ of the state of the files and directories in the repository. In this particular scenario commits point to different root tree objects, each of which point to different objects representing the file_x. But they share the same tree object representing the subdirectory and the blob representing file_y.

There’s no ‘diffs’ calculated between commits; if one byte changes in a file, a new blob is created, resulting in a new tree (or trees), resulting in a new commit. In terms of the space-time trade-off, git chooses space over time, resulting in a simple model of data changes over time.

The problem is, our commits are still addressed via a 160 bit hash. This is all well and good for a computer, but we’d like something a bit more human friendly. This is the role of branches.

Branches and HEAD

Branches are relatively simple: they are a human-friendly, named pointer to a commit hash. Local branches (as opposed to remote branches, which we won’t cover in this article) are stored in .git/refs/heads/, and right now the current master¹ branch points to the hash of our second commit:

cat .git/refs/heads/master

89ec2b06b21f25cdbd763924c751c8b24886d5c2

We also need to briefly mention HEAD. This file tracks which commit is currently ‘active’, i.e. the checked out files match those in the commit. We see HEAD currently refers to our master branch²:

cat .git/HEAD

ref: refs/heads/master

If we create a new branch, it will recurse on what HEAD points to until it finds a commit:

# Create a new branch
git branch branch_2
# List the branches and the hashes they point to
find .git/refs/heads/* -type f -exec sh -c 'echo -n "{} -> " && cat {}' \;

.git/refs/heads/branch_2 -> 89ec2b06b21f25cdbd763924c751c8b24886d5c2
.git/refs/heads/master -> 89ec2b06b21f25cdbd763924c751c8b24886d5c2

When a new commit is issued, the current branch is moved to point to the new commit (and head will indirectly point to the commit through this branch):

# Checkout a branch and commit on it
git checkout -q branch_2
echo $RANDOM > file_x
git commit -q -am "Third Commit (branch_2)"
# The 'new_branch' branch now points to a different commit.
find .git/refs/heads/* -type f -exec sh -c 'echo -n "{} -> " && cat {}' \;

.git/refs/heads/branch_2 -> 54d46328e009399d656f158c04df8ad9c2b24cf6
.git/refs/heads/master -> 89ec2b06b21f25cdbd763924c751c8b24886d5c2

If we checkout the master branch and creating a new commit, we ca visualise how the two branches have diverged:

# Commit back on the master branch
git checkout -q master
echo $RANDOM > file_x
git commit -q -am "Fourth Commit (master)"

The third and fourth commits are both descendants of the third commit. Adding in our branches to the graph we see they point to the tip of this graph:

There’s nothing stopping us from creating more branches, even if they point to the same location:

# Create new branches
git branch branch_3
git branch branch_4

The key takeaway is that branches provide a human-friendly way of navigating the git’s commit DAG.

Index

The final file we’re going to look at is the index. While it has a few purposes, we’ll focus on it’s main role as the ‘staging area’. The exact structure is available here, and I’ve converted this into Perl unpack() language:

perl -0777 -nE '
# Extract out each file in the index
my @index = unpack("A4 H8 N (N4 N2 n B16 N N N H40 B16 Z*)");

say "Index Header: " . join " ", @index[0..2];
say "lstat() info: " . join " ", @index[3..12];
say "Object & Filepath: " . join " ", @index[13..16];
' .git/index

Index Header: DIRC 00000002 3
lstat() info: 1654027283 118849971 1654027283 118849971 64769 7734889 0 1000000110100100 1000 1000
Object & Filepath: 6 511c5ae2b662376b23658fe922231d824d4e03e6 0000000000000110 file_x

The first line shows the the four byte ‘DIRC’ signature (which stands for ‘directory cache’), the version number, and the number of entries (files in the index). We’ve only unpacked one of the files.

The first fields contain information from the lstat(2) function: last changed and modified time, the device and inode, permissions, uid and gid, and file size. These values allow git to quickly determine if files in the working tree have been modified.

Then comes the hash of the object, a flags field (which includes the length of path), and the path to the object.

If we recall back in the blobs section, when we added a file to the staging are via git add, the index was created. Let’s modify file_x and add it to the staging area:

echo "Index Modification" > file_x
git add file_x

Now we’ll re-take a look at the index:

ctime, mtime: 1654027286 1654027286
object, filepath: db12d29ef25db0f954787c6d620f1f6e9ce3c778 file_x

The create and modify times have changed, and so has the object that file_x points to. If a git commit is issued, the tree underlying the commit is based upon the current state of this index. When a different branch is checked out, the index is rebuilt so that the files in index point to the correct blobs for that particular commit.

Conclusion

In this article we dived in to the internals of git. We’ve looked at git’s data model and learned about the raw blobs of data, the trees that hold the filesystem information, and the commits that point the root of the tree. We’ve seen how commits have parents, creating a directed acyclic grapg of differing states of the repository.

Branches were shown to be quite simple, human-readable pointers to commit hashes, allowing us to navigate around git’s commit graph. Finally we cracked open index, which is a staging area for the next commit.

It’s perhaps a sad indictment when you have to understand the internals of something in order to use it. This could be bad design, the inherent complexity of the problem domain, or perhaps a little bit of both. Nevertheless git is a widely used tool that’s incredibly powerful, and investing some time to understand it will surely pay dividends down the line when want to manage configuration, code, or almost any other type of text-based content.

The default branch, which is now configurable in git version 2.28 and above ↩︎
HEAD doesn’t doesn’t have to refer to a branch, it can refer to an arbitrary commit. This is known as a ‘detatched HEAD’. ↩︎

A Noisy Wind Tunnel

Sat, 29 Jan 2022 00:00:00 +0000

I raced bikes as a junior and came back to it after a twenty year hiatus. One of the biggest contrasts I’ve seen in the sport is the proliferation of bike sensors. All I used to have ‘back in the day’ was a simple computer with velocity and cadence. Now I’ve got that, plus position via GPS, power, heart rate, pedal smoothness and balance, all collected and displayed on my phone.

It’s all well and good to collect and visualise this data, but surely there was more I could do with it? After much thought, I realised I could use it determine the aerodynamic efficiency of different positions on the bike. So in this article I’m going to attempt to answer the following question:

How much more aerodynamically efficient is it to ride with your hands on the drops of the handlebars, rather than the tops?

There are two main sections of the article: in the first section we look at how the data was generated, loaded into R, and transformed into a state that’s ready for analysis. It’s in this section where we see R really shine, with a simple and element method of transforming XML into a rectangular, tidy data format.

In the second section we define an aerodynamic model (or more accurately reuse a common model), then perform a simple regression of this data to determine the aerodynamic properties. Diagnostics on the highlight a key missing element, forcing us to update the model to get better estimates of the aerodynamic properties.

Data Acquisition

We’ll first look at how the experiment was set up and how the data was captured. A track bike (with has a single, fixed gear) was ridden around the Coburg velodrome which is a 250m outdoor track. A sensor (Wahoo speed) on the hub of the wheel collected the velocity, and the pedals (PowerTap P1s) collected power and cadence.

Data was gathered while in two different positions on the bike¹. The first position which we will call being on the ‘tops’ looked similar to this (sans brake levers):

The second position which we will call being on the ‘drops’ looked like this:

For each position the pace was slowly increasing from 10km/h to to 45km/h in approximately 10km/h increments. For each increment level, the pace was held as close as possible to constant for two laps, increasing to three laps for higher velocities to try and get enough samples.

The experimental environemnt is far from clean, with two main external elements affecting our data generation process: wind, and the lumpyness of the velodrome. Because we are moving around and oval, both of these external elements will add noise to the data, but shouldn’t bias it in any one direction. If there was any biasing effect it would be from wind gusts.

What results are we expecting? We’re expecting better aerodynamics when in the drops position due to two factors: a reduction in the front on surface area, and a more streamlined shape.

Transforming the Data

The data is downloaded in TCX (Training Center XML) format. While good for us that it’s in a standard structured format, it’s not quite in the rectangular, tidy data that we need for our analysis. The first step is therefore to extract and transform it. The XML is is made up of a a single activity with multiple laps. Each lap has trackpoints which contain a timestamp and the data collected (velocity, power, heartrate, etc). A trackpoint is taken every one second.

You can look at the full file here, but below is a high level overview of the structure:

<TrainingCenterDatabase>
<Activities>
<Activity>
<Lap>
<Track>
<Trackpoint>
<Time>2022-01-16T00:00:41Z</Time>
<DistanceMeters>1.48</DistanceMeters>
<HeartRateBpm>
<Value>105</Value>
</HearthRateBpm>
<Cadence>32</Cadence>
<Extensions>
<TPX>
<Speed>3.19</Speed>
<Watts>56</Watts>
</TPX>
</Extensions>
</Trackpoint>
<!-- Multiple trackpoints (1 second per sample) -->
</Track>
</Lap>
<!-- Multiple laps (generated manually) -->
</Activity>
</Activities>
</TrainingCenterDatabase>

Thanks to the XML2 library, XPath queries, the vectorised nature of R, extracting and transforming this data is relatively easy:

cycle_data <-
read_xml('cycle_data.tcx') %>%
xml_ns_strip() %>%
xml_find_all('.//Trackpoint[Extensions]') %>%
{
tibble(
time = xml_find_first(., './Time') %>% xml_text() %>% ymd_hms(),
velocity = xml_find_first(., './Extensions/TPX/Speed') %>% xml_double(),
power = xml_find_first(., './Extensions/TPX/Watts') %>% xml_integer(),
bpm = xml_find_first(., './HeartRateBpm/Value') %>% xml_integer(),
cadence = xml_find_first(., './Cadence') %>% xml_integer(),
lap = xml_find_num(
.,
'count(./parent::Track/parent::Lap/preceding-sibling::Lap)'
),
)
}

time	velocity	power	bpm	cadence
2022-01-16 00:00:42	3.19	56	105	32
2022-01-16 00:00:43	3.28	100	104	34
2022-01-16 00:00:44	3.50	75	104	36
2022-01-16 00:00:45	3.58	84	105	38
2022-01-16 00:00:46	3.78	79	106	40
2022-01-16 00:00:47	4.08	83	107	43
2022-01-16 00:00:48	4.39	172	108	46
2022-01-16 00:00:49	4.58	197	109	47
2022-01-16 00:00:50	4.78	213	111	49
2022-01-16 00:00:51	5.00	288	113	51

While terseness is elegant it can also make the code difficult to interpret, so I think it’s valuable to go through each step of the pipeline:

The TCX file is read in as as an xml_document
The XML is namespaced, but as we’re only working with this file we strip the namespace to make our XPath easier to work with.
Using the .//Trackpoint[Extensions] XPath we find all ‘trackpoint’ nodes that have a child ‘extensions’ node.
- We do this because some of the trackpoints only have a timestamp with no data.
We then construct a data frame (a tibble) by finding and extracting the velocity, power, etc from each trachpoint, with the XPaths being relative to the trackpoint node.
- The braces to stop the normal behaviour of the left-hand side of the pipe being passed as the first argument to the tibble.
Determining which ‘lap’ a trackpoint belongs to takes a little more work. We do this by finding it’s grandparent lap node and counting how many preceding lap siblings it has. The first lap will have 0 siblings, the second lap 1, and so on.

That’s it! With less than 20 lines of R the XML has been transformed into a tidy, rectangular data format, ready for visualisation and analysis. Speaking of visualisation, let’s take a look at a few different aspects of the data to get a general feel for it. The following graph shows the power output over time, each lap being coloured separately. Laps one and three contain the data that will be used in the model.

The data was generated on a track bike which has only a single gear, so the velocity and cadence should have a near perfect linear relationship:

There’s a clear linear relationship, but there is also distribution of velocities across each cadence value. This is likely due to the difference in precision between the cadence and the velocity, as cadence is measured as a integer whereas velocity is a double with a single decimal point².

Before we look at the power and velocity, we need to do a little bit of housework. The second and fourth laps that contain our experimental data are extracted, and a new position factor variable is created with appropriately named levels.

In what could be considered controversial, we’re going to remove data points where the bike was accelerating - i.e. the rate of change of the power between trackpoint samples was between -10 and 10 watts. Acceleration was required to ‘move’ to different velocity increments, but our model only relates to points of (relatively) constant velocity. Given our knowledge of the data generation process, I think this data removal can be justified.

cycle_data_cleaned <-
cycle_data %>%
filter(
lap %in% c(1,3),
between(power - lag(power), -10, 10)
) %>%
mutate(position = fct_recode(as_factor(lap), "Tops" = "1", "Drops" = "3"))

We can now view the power output versus the velocity by position of the data we’ll be using in our model.

We see an exponential relationship, and can see the “blobs” of data where I have tried to keep a constant velocity. What is not instantly visible is the difference in power output versus velocity for each of the different hand positions.

Defining and Building a Model

We’ll be using the the classic drag equation as our model:

$$ F_d = \frac{1}{2}\rho C_D A v^2$$ This says that the force of drag $F_d$ on the bike/body system when moving through the air is proportional to half of the density of the fluid ($\rho$) times the drag coefficient the bike/body ($C_D$) times the front on cross-sectional area ($A$) times the square of the velocity ($v$). I’m going to bundle up all coefficients into a single coefficient $\beta$.

$$ \text{Let } \beta = \frac{1}{2} \rho C_D A $$ $$ F_d = \beta v^2 $$ We’ve got force on our left-hand side, but we need power. Energy is force times distance, and power is energy over time, so we have:

$$ F_d \Big( \frac{x}{t} \Big) = \beta v^2 \Big( \frac{x}{t} \Big)$$ Distance over time is velocity so we are left with:

$$ P_d = \beta v^3 $$ The coefficient is conditional on the position variable, so we’ll end up with two coefficients from this model:

$$ P_d = \Bigg\{\begin{array}{ll} \beta_{tops} v^3 & \text{if}\ position = tops \\
\beta_{drops} v^3 & \text{if}\ position = drops \end{array} $$

Is this a perfect model? Not at all, but for our purposes it should be reasonable. Don’t make me tap the “all models are wrong…” sign!

The model will give us an estimate (with some uncertainty) $\beta_{tops}$ value when I was on the tops of the handlebars, and a $\beta_{drops}$ value when I was in the drops.

We have some prior information that we can be included in the model: it takes zero watts to go zero metres per second. This implies that our model should go through the origin $(0,0)$ and we should not include an intercept. I believe that given our strong knowledge of the process that generated the data, removing the intercept is valid.

cycle_data_mdl <-
cycle_data_cleaned %>%
lm(power ~ 0 + position:I(velocity^3), data = .)

Here’s what model looks like overlayed on the data:

As expected the drops is more efficient that the tops. Before looking at the parameters of the model let’s first look at some diagnostics. The first one to look at is the fitted values of the over the residuals:

I’ve added a linear regression line to highlight the trend, and it shows shows something quite interesting: there appears to be a linear relationship that our model hasn’t accounted for.

If we think back to our model, we were only accounting for the power required to overcome drag, but there’s another force in play that we’ve completely ignored: friction. There’s the rolling friction of the wheels on the tack, and the sliding friction of the hubs, the chainset and pedals, and of the chain on the sprocket.

With this realisation, let’s try and build a better model to account for this force.

Building a Better Model

In the original model, $P_{Total} = P_{Drag}$, but in our updated model total power used is made up of power to overcome drag plus power to overcome friction:

$$ P_{t} = P_{d} + P_{f} $$ Once again knowing that forc times distance is energy, and energy over time is power, we end up with:

$$ P_{f} = \frac{ F_{f} \times x }{ t } = F_{f}v $$

If we let $\beta_1 = F_{f}$ then our updated model is:

$$ P_d = \beta_1 v + \Bigg\{\begin{array}{ll} \beta_{tops} v^3 & \text{if}\ position = tops \\
\beta_{drops} v^3 & \text{if}\ position = drops \end{array} $$

We now run our updated model over the data. The frictional component is not going to be affected by the position on the handlebars, so we ensure it’s not conditional on the position:

cycle_data_mdl <-
cycle_data_cleaned %>%
lm(power ~ 0 + velocity+ position:I(velocity^3), data = .)

Here’s the updated on model on top of the original data:

Hard to discern if much difference from this graph, so we return to the fitted versus residual diagnostic graph:

That’s looking much better! We’ve now captured the linear component, the residuals are random, and the variation is reasonably even across the entire spread of fitted values. There are a few outliers, and a more rigourous analysis would look to determine whether they had significant leverage on our regression line. Subjectively looking at this graph though my guess would be no.

The other type of diagnostic to look at is a histogram of the residuals. A linear regression has an assumption that the residuals are normal. The residual shape doesn’t affect the point estimates of the model, but does affect the confidence intervals of the parameters.

This looks great: the residuals are approximately normal, there’s not much mass at outside of 2 standard deviations, and the mean sits approximately at zero.

With confidence in the model we now take a look at the parameters:

Term	Estimate	Std Error	Statistic
velocity	4.1788613	0.3782129	11.04897
positionTops:I(velocity^3)	0.2131439	0.0045782	46.55634
positionDrops:I(velocity^3)	0.1889915	0.0044721	42.26044

The velocity term is the $\beta_1$ coefficient, which is the the frictional force of the bike. The model has determined that the frictional of the bike accounts for 4.18 Newtons of force.

The next two values the $\beta_{tops}$ and $\beta_{drops}$ coefficients. We’re not concerned with the specific values (being a combination of the fluid density, drag coefficient, and my cross-sectional area), but what we want to look at is percentage change between these values. The result is that we need to use 11.33% less power to acheive the same velocity in the two different positions. Put another way, we are 11.33% more efficient when positioned in the drops rather than on the tops.

The following table gives you an idea on the differences in power required for velocities of 20, 40, and 60 km/h.

Velocity	Tops	Drops	Power Difference
20	59.76	55.62	4.14
40	338.81	305.68	33.13
60	1056.43	944.61	111.82

Don’t Forget the Uncertainty

In calculating the average percent decrease, the uncertainty in the parameters has been thrown away. If we assume two things about the parameters:

The parameter estimates are normally distributed, and
There is no covariance between the parameters

then we can take a computational approach to determining the uncertainly of the percentage. Drawing samples from each of the parameter distributions (with a mean of the parameter estimate and a standard deviation of the standard error), we can calculate the percentage for each pair of samples³, giving us a distribution of percentages. The quantiles we want to determine can then be calculated from this data.

# Extract the parameter and standard error from the model.
beta_tops <- tidy(cycle_data_mdl)[[2]][2]
sigma_tops <- tidy(cycle_data_mdl)[[3]][2]
beta_drops <- tidy(cycle_data_mdl)[[2]][3]
sigma_drops <- tidy(cycle_data_mdl)[[3]][3]
# Generate our samples and calculate the percentages
percent_distribution <-
tibble(
beta_top_dist = rnorm(1000000, beta_tops, sigma_tops),
beta_drop_dist = rnorm(1000000, beta_drops, sigma_drops),
percent = ((beta_top_dist - beta_drop_dist) / beta_top_dist) * 100
)

Our 89%⁴ confidence interval is therefore [6.69%, 15.77%].

Summary

In this article we looked at the aerodynamics of different positions on a bike. We gathered data using different sensors, and showed the elegance of R by transforming XML data into a rectangular, tidy data frame.

We defined a simple model and used this to perform a regression of power required to maintain a specific velocity. By performing diagnostics on this model, we were able to identify that our model was incomplete, and that we were likely not including friction in the model. We defined and created a new model with friction included, which performed better than our original model.

The ultimate aim of the article was to determine how much more efficient it is to ride in the ‘drops’ of the handlebars rather than the ‘tops’. From our modelling we found the average estimate of our efficiency gain to be 11.33%, with an 89% confidence interval of [6.69%, 15.77%].

Images courtesy of bikegremlin.com ↩︎
A linear regression of cadence on velocity was performed and the residuals were in the range of (-.5, .5). This supports our precision difference hypothesis. ↩︎
Thanks to /u/eatthepieguy for responding to my query on this. ↩︎
Why 89%? Well, why 95%? ↩︎

A Tale Of Two Optimisations

Sun, 10 Oct 2021 00:00:00 +0000

A couple of months ago I wrote a toy program called whitespacer. Ever since, I’ve had this gnawing feeling that I could have done it better; that it could have been written in a more performant manner. In this article I’ll take you through a couple of different ideas I came up with. We’ll profile and visualise their different performances and stumble upon some surprising behaviour. We’ll use this as an excuse to take a deeper dive into their behaviour at the CPU level and gain a better understanding about the perf performance analysis tool and branch prediction.

A Quick Recap

In a previous article I took you through the whitespacer program. Here’s a quick recap of what it does:

Reads from standard in and writes to standard out.
Works in an ‘encoding’ and ‘decoding’ mode’.
In encoding mode it takes each of the four dibits (2 bits) of each byte and turns it into one of four whitespace characters (tab, new line, carriage return and space).
Decoding mode does the reverse, taking groups of four whitespace characters and reconstituting the original byte.

Here’s the encoding function:

//Dibit to whitesapce lookup table (global variable)
char encode_lookup_tbl[] = { '\t', '\n', '\r', ' ' };
//Given a dibit, returns the whitespace encoding
unsigned char lookup_encode(const unsigned char dibit) {
return encode_lookup_tbl[ dibit ];
}

I’ve omitted the decoding function for brevity, but it’s the same with a different lookup table.

Attempt 1: A Mathematical Function

What bothered me about the original implementation was the lookup table. Even though I knew they’d be cached, I still thought the memory accesses might have a detrimental affect on performance.

I had an idea about using mathematical functions (rather than the lookup table) to perform the encoding/decoding. This would remove the memory accesses and perhaps improve performance.

From somewhere I recalled that if we have a set of $k + 1$ data points $(x_0, y_0),…, (x_k, y_k)$ where no two $x_i$ are the same, we can fit a curve using a linear regression with a polynomial of degree $k$. Here’s our table of data points:

# A tibble: 4 × 2
dibit ascii_dec
<int> <int>
1 0 9
2 1 10
3 2 13
4 3 32

This means we can find $\beta$ coefficients for the function $$ f(x) = \beta_0 + \beta_1 x + \beta_2 x^2 + \beta_3 x^3 $$ such that when passed a dibit value it returns the appropriate whitespace character. We can also find the inverse polynomial $f^{-1}(x)$ which takes a whitespace character and returns a dibit to be our decoding function. Let’s create linear regression models in R where whitespace is the table holding our dibit and whitespace values:

encode_model <-
whitespace %>%
lm(ascii_dec ~ dibit + I(dibit^2) + I(dibit^3), data = .)
decode_model <-
whitespace %>%
lm(dibit ~ ascii_dec + I(ascii_dec^2) + I(ascii_dec^3), data = .)

Visualising these models will help us see what’s going on. On the left is our encoding model, which takes out dibit values and maps them to our ASCII whitespace characters. On the right our decoding model, which takes the ASCII whitespace characters’ decimal value and maps it back to a dibit. What becomes obvious by visualising these is how they make no sense for any values outside of our four points:

Let’s take a look at the $\beta$ coefficients:

# A tibble: 4 × 3
parameter encode decode
<chr> <dbl> <dbl>
1 beta_0 9.00 -31.8
2 beta_1 4.67 6.42
3 beta_2 -6.00 -0.381
4 beta_3 2.33 0.00669

Immediately we see a bit of a problem. I’ll be honest that I was hoping - somewhat optimistically - for some nice, clean integer coefficients. Instead we’ve got floating point values. My gut feel is that having to use floating point instructions is not going to improve upon our original lookup table. But we won’t know until we profile, so let’s persist. Here’s the new polynomial encoding function, with the decoding function omitted for brevity:

unsigned char poly_encode(const unsigned char dibit) {
return (unsigned char) (9.0 +
4.666667 * dibit -
6.0 * (dibit * dibit) +
2.333333333333 * (dibit * dibit * dibit));
}

We don’t need to (and are probably unlikely to) hit the mark exactly, we just need to get close enough so that the whole part of the floating point value is correct. The cast to usigned char will give us this whole part, throwing away any values after the decimal point.

Attempt 2: A Switch

While working on the polynomial function, it struck me that we could also use a conditional statement to make decisions on how to encode (and decode) individual dibits. Here’s an implementation which uses a switch statement:

unsigned char switch_encode(const unsigned char dibit) {
switch (dibit) {
case 0:
return '\t';
case 1:
return '\n';
case 2:
return '\r';
case 3:
return ' ';
}
}

We also need need a way to select the algorithm the program uses at runtime. A command line option -a has been added, where is either ‘lookup’, ‘poly’ or ‘switch’. If none is specified it defaults to the original lookup table. You can find the full code for the new, multi-algorithm whitespacer here.

Profiling

Rather than supposition, let’s test how the different algorithms perform. I’ve created an R function which takes a vector of shell commands and returns how long they took to run. There will be a small amount of overhead in spawning a shell, but as this is constant across all executions and as we’re looking at he differences between the runtimes, it gets cancelled out.

system_profile <- function(commands) {
map_dbl(commands, ~{
start <- proc.time()["elapsed"]
system(.x, ignore.stdout = TRUE)
finish <- proc.time()["elapsed"]
finish - start
})
}

We now run 100 iterations of an encode / decode pipeline for each algorithm and look at the time each takes to run, piping in a 32Mb file of random bytes generated from /dev/urandom. The output is dumped to /dev/null. The executables have been compiled with all optimisations disabled.

profiling_results <-
tibble(
n = 1:300,
algo = rep(c('lookup', 'poly', 'switch'), max(n) / 3)
) %>%
mutate(
command = glue(
'./ws_debug -a { algo } < urandom_32M | ./ws_debug -d -a { algo } > /dev/null'
),
time = system_profile(command)
) %>%
select(-command)

Rather than simply looking at the means or medians for each of the algorithms, we take a look at the distribution of runtimes for each with the mean highlighted.

As expected, the polynomial encoding/decoding is slower than the lookup table. But what is really surprising is the switch statement: its slower than both! On average it’s 2.45 seconds slower than the lookup table! I love a good surprise, so let’s dive in and try to work out what’s happening.

What’s With The Switch?

We’ll take a bottom up approach and look at the instructions that were being executed on the CPU as the process was running. Using perf record we take samples of the process’s state, most importantly the instruction pointer. By using the -b switch, perf also captures the Last Branch Record (LBR) stack. With the LBR processor feature, the CPU logs the from and to addresses of predicted and mispredicted branches taken to a set of special purpose registers. With this information, perf can reconstitute the a history of the instructions executed, rather than only having a single point in time to use from the sample.

Let’s run the encoding half of the pipeline and feed it 32Mb of random bytes:

perf record -b -o switch.data -e cycles:pp ./ws_debug -a switch < urandom_32M > /dev/null
[ perf record: Woken up 22 times to write data ]
[ perf record: Captured and wrote 5.345 MB switch.data (6833 samples) ]

Looking at the trace data (saved in switch.data), the brstackins field allows us to see the instructions executed and approximate CPU cycles for different branches. Perf has captured around 43,000 executions of our switch_encode() function, with just one of these displayed below:

perf script -F +brstackinsn -i switch.data

switch_encode:
0000560dd2bffddd insn: 55
0000560dd2bffdde insn: 48 89 e5
0000560dd2bffde1 insn: 89 f8
0000560dd2bffde3 insn: 88 45 fc
0000560dd2bffde6 insn: 0f b6 45 fc
0000560dd2bffdea insn: 83 f8 01
0000560dd2bffded insn: 74 1e # MISPRED 4 cycles 1.50 IPC
0000560dd2bffe0d insn: b8 0a 00 00 00
0000560dd2bffe12 insn: eb 0e # PRED 22 cycles 0.05 IPC
0000560dd2bffe22 insn: 5d
0000560dd2bffe23 insn: c3 # PRED 5 cycles 0.20 IPC

Even without decoding the machine code, what immediately stands stand out is the 22 cycles taken following the branch misprediction. Let’s now zoom out and run perf stat to pull out some summary statistics:

# Perf stat with 32Mb urandom bytes
perf stat ./ws_debug -a switch < urandom_32M > /dev/null


Performance counter stats for './ws_debug -a switch':
1743.865268 task-clock (msec) # 1.000 CPUs utilized
7 context-switches # 0.004 K/sec
0 cpu-migrations # 0.000 K/sec
12,852 page-faults # 0.007 M/sec
6,484,859,596 cycles # 3.719 GHz
5,773,682,725 instructions # 0.89 insn per cycle
967,903,800 branches # 555.034 M/sec
123,207,223 branch-misses # 12.73% of all branches
1.744494500 seconds time elapsed

The first statistic that stands out are the instructions per cycle, which is just under one. The likely cause of this is the number is the number of branch misses, which is up at ~12%. These branch prediction misses are destroying any benefit of pipelining in the CPU.

I’ve got an sneaking suspicion that the cause of these missed branch predictions is our input data, so let’s test the hypothesis. We create a 32Mb file of all zeros from /dev/zero instead of random bytes, then re-profile with this data as input instead of the random bytes. I’ll omit the code and go straight to the results:

The switch algorithm now outperforms the others! Here’s the perf stat:

# Perf stat with 32Mb of zero bytes
perf stat ./ws_debug -a switch < zero_32M > /dev/null


Performance counter stats for './ws_debug -a switch':
543.503058 task-clock (msec) # 0.999 CPUs utilized
8 context-switches # 0.015 K/sec
0 cpu-migrations # 0.000 K/sec
12,854 page-faults # 0.024 M/sec
1,953,309,524 cycles # 3.594 GHz
5,835,245,013 instructions # 2.99 insn per cycle
999,489,826 branches # 1838.977 M/sec
1,226,487 branch-misses # 0.12% of all branches
0.544021460 seconds time elapsed

In the grand scheme of things, almost no branch prediction misses, and a huge speed increase as compared to the random bytes.

Now this is where I start to butt up against the limits of my CPU architecture knowledge (feel free to contact me with any corrections), but what I assume is happening is that the branch predictor on my CPU is using historical branching information to try and make good guesses. But when the input is random bytes, history provides no additional information, and the branch predictor adds no benefit. In fact it may be a hindrance due to the penalty of a missed branches.

Lookup versus Polynomial

Now let’s take a look at the unsurprising result: our original lookup algorithm versus the polynomial. We’ll go straight to using perf stat to see high-level statistics. First up is the lookup algorithm:

# Lookup table
perf stat ./ws_debug -a lookup < urandom_32M > /dev/null


Performance counter stats for './ws_debug -a lookup':
511.025199 task-clock (msec) # 0.999 CPUs utilized
7 context-switches # 0.014 K/sec
1 cpu-migrations # 0.002 K/sec
12,852 page-faults # 0.025 M/sec
1,802,617,592 cycles # 3.527 GHz
5,195,307,808 instructions # 2.88 insn per cycle
487,513,834 branches # 953.992 M/sec
506,448 branch-misses # 0.10% of all branches
0.511367875 seconds time elapsed

Now the polynomial:

# Polynomial
perf stat ./ws_debug -a poly < urandom_32M > /dev/null


Performance counter stats for './ws_debug -a poly':
1063.839451 task-clock (msec) # 1.000 CPUs utilized
2 context-switches # 0.002 K/sec
0 cpu-migrations # 0.000 K/sec
12,850 page-faults # 0.012 M/sec
3,829,284,007 cycles # 3.599 GHz
7,755,413,038 instructions # 2.03 insn per cycle
487,472,058 branches # 458.220 M/sec
537,512 branch-misses # 0.11% of all branches
1.064266885 seconds time elapsed

We see two main reasons as to why the polynomial is slower. First off it simply takes more instructions to calculate the polynomial as opposed to looking up the value in a lookup table. Second, even with the (likely cached) memory accesses, we’re able to execute more instructions per cycle with the lookup table as opposed to the polynomial algorithm.

Summary

In this article we looked at two different alternatives to a lookup table for encoding and decoding bytes in the whitespacer program. The fist was to try and use a polynomial function, and the second was to use a conditional switch statement.

We found a surprising result with the switch statement, and were able to determine using the perf tool that we were paying a penalty for missed branch predictions due to the randomness of the input data.

When you run into a problem or a surprising result, you’re often gifted an opportunity to learn something new. I’ve certainly learned a lot about perf, LBR stacks and branch prediction in putting this article together.

Bandwidth Seasonal Decomposition

Wed, 11 Aug 2021 00:00:00 +0000

Over the past few months I’ve been studying time series data and modelling using Rob Hyndman’s fantastic Forecasting: Principles and Practice textbook. My area of expertise is in networking, and a significant amount of operational the data that we deal with fits into the category of time series data. It could be throughput through a router, sessions on a firewall, or the counts of HTTP response codes from a content delivery network.

In this article we’re going to look at applying time series concepts and models to the bandwidth utilisation - both ingress and egress - of a network router. Using historical data, we’ll see how we can decompose this data into separate components, and then use these components to forecast the bandwidth utilisation in the future.

Caveats

A couple of things to note before we start. In a real world situation we’d likely try a few different models, tune them with different parameters, and evaluate them using cross validation or bootstrapping. We’re going to keep things simple in this article by using a single, parsimonious model with one set of parameters to forecast our network throughput, and a simple training/test set split for validating our model’s performance.

We’re also going to skip over the underlying mathematics of our methods, focusing on their practical use. Leaving this out is a hard decision for me, as I dislike using statistical methods without a decent understanding of how things are working under the hood. However this is an article, not a dissertation, so the underlying mathematics will be left for another day.

A Quick Primer

Time series data focuses on a single variable that is observed multiple times over a period of time. Contrast this against cross-sectional data, which focuses on multiple variables observed at the same point in time.

Certail kinds of time series data exhibit patterns which make it possible to split or ‘decompose’ it into different components:

Trend: the long term increase or decrease in the data.
Cycle: these are rises and falls in the data that are not a fixed period.
Seasonal: a pattern that occurs due to seasonal factors such as the time of the day. It’s a fixed and known period.
Remainder: what’s left after the trend, cycle, and seasonal components are removed.

Often the trend and cycle components are combined into a single component called the trend-cycle.

The Data

Let’s get an understanding of the data and perform some diagnostics on it. The data we’re using is contained in a time series table or tsibble called throughput. It consists of 1440 observations of the ingress and egress throughput through a router over 30 days. Each observation is the average throughput through the router over a 30 minute interval.

As we’re going to be forecasting, we immediately split out data into a training set and a test set. The training set will contain the first 23 days of data, and the test set will contain the last 7. We’ll perform discovery and train our model on the training set, leaving the test set to ascertain the accuracy of our model.

# Training set
throughput_train <-
throughput %>%
filter_index(. ~ '2021-06-24')
# Test set
throughput_test <-
throughput %>%
filter_index('2021-06-25' ~ '2021-07-01')

Let’s take a look at the training data.

We see a very clear pattern with a daily “seasonal period” for both the ingress and egress directions. As expected, there is more ingress data than egress data. We can use a seasonal plot to get a better view of the seasonality. This chart plots each day over the top of each other, giving us a view of the traffic profile throughout each hour of the day.

For both ingress and egress directions we see throughput dropping overnight and reaching a minimum around 4 am in the morning. It rises slowly at first, increasing at 9am when everyone starts work. It continues to rise throughput the day, peaking at around 9pm at night.

Modelling & Decomposition

We’re going to use ‘Seasonal and Trend decomposition using LOESS’ (STL) to decompose our time series, where LOESS is ‘LOcally Estimated Scatter point Smoothing’ (acronym inception!). We’ll use this to additively decompose our time series at time t into trend, seasonal, and remainder components, written as:

$$ y_t = T_t + S_t + R_t $$ Given our domain expertise and our initial view of the data, we’re confident that the seasonal period is one day. But it would be nice to put a quantitative number around that. We can use the feat_stl() function to pull out some STL specific features. As our data is measured every 30 minutes, a period of 48 is one day.

throughput_train %>%
features(Mbps, list(~{ feat_stl(.x, .period = 48) })) %>%
select(
direction, trend_strength, starts_with('seasonal_strength')
)

# A tibble: 2 × 3
direction trend_strength seasonal_strength_48
<chr> <dbl> <dbl>
1 egress 0.659 0.934
2 ingress 0.583 0.980

Both the trend strength and seasonal strength are statistics between 0 and 1, giving a measure of the strength of the components that the STL decomposition has extracted. We see a reasonable trend, but a very large seasonal strength, adding to the evidence of a daily seasonal pattern. We can now define our STL model, run it over our data, and extract out the components.

# Define out STL model
STL_tp <- STL(
Mbps ~ trend() + season(period = '1 day'),
robust = TRUE
)
# Run an STL model across out data
tp_stl_mdl <-
throughput_train %>%
model(STL = STL_tp)
# Extract out the components
tp_stl_decomp <- tp_stl_mdl %>% components()

Let’s take a look at each of the components in both the ingress and egress directions.

At a first glance the STL decomposition has done well. The trend-cycle looks pretty flat, which is to be expected given the relatively short time frame of the data. The ebbs and flows of the trend-cycle could be cyclic, or could be some longer term seasonality such as a weekly seasonality that we haven’t captured.

You may have noticed that there are negative values for both the seasonal and remainder component. As we’re using an additive model, these values are relative to the trend component at each point in point in time.

The decomposition also gives us the seasonally adjusted series. This is the series with the seasonal component removed.

The seasonally adjusted series is important when we want to use this decomposition to forecast future values.

The remainder is relatively small, which is a good sign as it implies that we’ve pulled out most of the ‘signal’ in the trend-cycle and seasonal components. Let’s focus in on the remainder, also known as the residual.

Looking at the line graph of the residuals, there may be some seasonality we haven’t completely captured, but that’s not surprising given the simplicity of the model. The residuals have a reasonably Gaussian distribution, but have long tails. A Quantile-Quantile plot will helps us view this in more detail.

This plot compares the distribution of our residuals against a Gaussian distribution. If our residuals were Gaussian, all points would lie on the 45 degree line. We see that for one standard deviation around the mean fo egress direction, and two standard deviations for the ingress direction, our residuals are reasonably Gaussian. However outside of this we start to see the long tails of our data.

The distribution of the residuals doesn’t affect our forecasts, but it does affect our prediction intervals around the forecasts which assume a Gaussian distribution of the residuals. From what we’ve seen here we could be comfortable in around a 70% to 80% confidence interval around our forecasts, but anything higher breaks our assumptions and thus could not be relied upon.

Forecasting

Now that we’ve decomposed out series, we can use this as a way to forecast our series into the future. This is done by forecasting the seasonal component and and the seasonally adjusted components separately. These two separate forecasts can then be added together to form our single forecast. The prediction intervals are ‘reseasonalised’ in a similar way by adding the seasonal forecasts to the upper and lower limits of the prediction intervals.

We’re going to use two very simple models to forecast the components. To forecast the seasonally adjusted data we’ll use a naive method, which sets all forecasts to be the value of the last observation. To forecast the seasonal component, we’ll use a seasonal naive method, which sets the forecast to be equal to the last observed value from the same season, in our case a season being one day.

The decomposition_model() function from the fabletools package does a lot of the heavy lifting for us, and we then forecast our throughput for the next week:

# Decompose and model and forecast
throughput_dcmp_fc <-
throughput_train %>%
model(
SNAIVE = decomposition_model(
STL_tp,
NAIVE(season_adjust),
SNAIVE(`season_1 day` ~ lag('1 day'))
),
) %>%
forecast(h = '7 days')

Let’s take a look at the forecast with a 70% prediction interval, and compare it to our test data which holds the real values for the next week.

Using two of the most simple modelling methods, we’ve been able to forecast the throughput reasonably well. The forecasts for our egress direction are a little off due to the larger variance of the data, but the ingress direction forecasts are quite close to our test data. It’s also comforting that all of the test data sits comfortably within our 70% prediction interval.

We’ll use two metrics to gauge the accuracy of our forecasts. The first one is mean absoute error (MAE), which is the mean of the absolute value of the difference between our forecasts and the actual data. MAE is nice because it’s in the same units as our y-axis. The second is mean absolute percentage error (MAPE), which gives our error as a percentage of the actual test data. I should note that MAPE doesn’t work in all circumstances; for example it’s undefined if any of our test values are 0.

throughput_dcmp_fc %>%
accuracy(
throughput_test,
measures = list(
MAE = MAE,
MAPE = MAPE
)
)

# A tibble: 2 × 5
.model direction .type MAE MAPE
<chr> <chr> <chr> <dbl> <dbl>
1 SNAIVE egress Test 9.95 14.8
2 SNAIVE ingress Test 16.0 6.50

For our egress direction our forecasts are out on average by 9.95 megabits per second, or 14.83 percent. With the reduced variability of the data our ingress forecasts are better. We’re only out on average by 16.04 megabits per second, or 6.5 percent.

Summary

In this article we’ve looked at analysing and forecasting network throughput. We analysed the data to confirm our assumptions about its seasonality, then used STL to decompose it into its seasonal, trend-cycle, and remainder components. We applied very simple modelling methods on each of these components and used these to forecast the next week of values. Comparing these values to the actual test data we found we were reasonably accurate with our forecasts, even with the simple methods used.

In a real world situation we’re probably not concerned with what our throughput utilising is next week. We’d be more interested about what the throughput will be in one or two years so we can make better decisions on investment. This doesn’t mean the simple models we’ve shown here aren’t useful, just that our training data would likely need to be larger to detect long term trend and cycle components and changes in daily seasonality. We may also want to try out some more complex models, test out their accuracy using cross-validation on our training data, and use bootstrapping to better determine the prediction intervals of the forecasts. But I’d hasten to add that more complex models aren’t always the answer, and that as we’ve shown here you can get very usable forecasts and prediction intervals with parsimonious models.

Whitespacer

Wed, 30 Jun 2021 00:00:00 +0000

A few weeks ago I was analysing some packet captures and thanking the RFC gods that HTTP - and many other protocols - use ASCII/UTF-8 rather than packing everything into binary.

I then started thinking how confusing it would be to look at a packet capture and only see whitespace in the conversation. And thus whitespacer was born: a utility to encode messages into pure, soft, clean whitespace.

How It Works

Whitespacer has two modes: encoding and decoding. In encoding mode, it takes bytes from standard in, encodes them as whitespace characters, and writes them to standard out. Using the ‘-d’ switch on the command line moves it to encoding mode, taking the whitespace characters and decoding them back to the original bytes. You can find the full code (writen in C) on my github repo.

The encoding is a simple base-4 encoding. Each byte has its four groups of two bits encoded into one of four whitespace characters:

00 -> ‘\t’
01 -> ‘\n’
10 -> ‘\r’
11 -> ' ' (space)

In this article I’ll take you through the program itself, then some sections of code I found interesting to write.

The Program

The code has been compiled into an ELF file called ‘ws’. Let’s see what the encoding looks like piped into hexdump:

echo "Hello World!" | ./ws | hexdump

0000000 0d09 0a09 0a0a 0a0d 2009 0a0d 2009 0a0d
0000010 2020 0a0d 0909 090d 0a20 0a0a 2020 0a0d
0000020 090d 0a20 2009 0a0d 0a09 0a0d 090a 090d
0000030 0d0d 0909
0000034

You can see that the only bytes present are 0x9, 0xa, 0xd and 0x20: our whitespace characters. Encoding and then decoding (as it should) gives us our original string back.

echo "Hello World!" | ./ws | ./ws -d

Hello World!

Correctness

Let’s test it for correctness. We’ll generate a 128Kb file filled with random bytes and run these through the encoder/decoder.

# Create a 1Mb file full of random data
dd if=/dev/urandom of=urandom bs=1KB count=128
# Run the file through the encoder/decoder
./ws < urandom | ./ws -d > urandom.transfer
# Are the files the same?
md5sum urandom urandom.transfer

128+0 records in
128+0 records out
128000 bytes (128 kB, 125 KiB) copied, 0.00582111 s, 22.0 MB/s
0f92a99dd3e2556acf41097a9fc74037 urandom
0f92a99dd3e2556acf41097a9fc74037 urandom.transfer

The MD5 hashes are the same, implying it’s encoding and decoding each byte correctly. We can be doubly sure by looking at the distribution of byte values in the random file using a little bit of R.

tibble(
bytes = readBin(
file('urandom', 'rb'),
what = 'integer',
size = 1,
signed = TRUE,
n = file.size('urandom')
)
) %>%
ggplot() +
geom_histogram(aes(bytes), binwidth = 1) +
labs(
title = 'Random Bytes From /dev/urandom',
subtitle = 'Byte Distribution (total)',
x = 'Byte Value',
y = 'Frequency'
)

So we know that it’s encoded and decoded every byte value successfully. We now also know that /dev/urandom appears to be uniformly distributed.

Performance

We’ve tested it for correctness, but how fast does it run? We create a 3Gb file, ensure it’s cached in memory using fincore, available in the linux-ftools package. Unfortunately fincore doesn’t columnate very well, the last value is the percentage of the file in the cache.

# Create a 3Gb file full of random data
dd if=/dev/zero of=zero bs=100M count=30
# Read the file to add it to the cache
cat zero > /dev/null
# Confirm the file is in the cache
fincore --pages=false zero

30+0 records in
30+0 records out
3145728000 bytes (3.1 GB, 2.9 GiB) copied, 2.82209 s, 1.1 GB/s
filename size total pages cached pages cached size cached percentage
zero 3145728000 768000 768000 3145728000 100.000000

Next we perform a baseine without our encoder/decoder, measuring the throughput using the pipeviewer utility.

# Baseline without encode/decode
cat zero | pv -fa > /dev/null

[2.23GiB/s]
[2.33GiB/s]

Now we insert whitespacer into the pipeline:

# Check the throughput
cat zero | ./ws | ./ws -d | pv -fa > /dev/null

[ 237MiB/s]
[ 270MiB/s]
[ 254MiB/s]
[ 254MiB/s]
[ 262MiB/s]
[ 269MiB/s]
[ 271MiB/s]
[ 265MiB/s]
[ 271MiB/s]
[ 269MiB/s]
[ 272MiB/s]
[ 272MiB/s]

It’s a significant hit to throughput, but I don’t think it’s too bad.

Wireshark

Finally, at the start I talked about what it would look like in Wireshark, so let’s look at that. We set up a TCP listener on port 8080 piping to out decoder. We then enode a string and send it down this TCP session. We’ll take a packet capture at the same time.

# TCP listener and decoder
nc -l 8080 | ./ws -d &
# Encode, connect and send
echo "This is some text passed through TCP" | ./ws | nc -N localhost 8080

This is some text passed through TCP

Here’s what we see in Wireshark using the ‘Follow TCP Stream’ option:

Exactly what I was looking for.

The Code

In this section I want to highlight a couple of sections of the code that I enjoyed writing, or had some nuance to them. This includes the lookup tables, the encoding function, and the read loop.

Lookup Tables

The lookup table used to encode the whitespace went through a few iterations. In the first version there was no lookup table. Instead I used four whitespace characters with contiguous byte values: ‘\t’, ‘\n’, ‘\v’, ‘\f’. This allowed the encoding and decoding to be a simple addition (encoding) and subtraction (decoding) of the lowest whitespace character’s value ('\t’ = 9).

The downside was that some of these characters weren’t rendered in Wireshark as whitespace, but rather as dots. I then moved to using the whitespace used in the current version, but with static encoding and decoding lookup tables. The encoding lookup table was four bytes, and the decoding lookup table was 256 bytes, with a canary value for bytes that aren’t valid whitespace in my encoding scheme.

I then realised I could do this a better way, and ended up with the following code:

unsgined char encode_lookup_tbl[] = { '\t', '\n', '\r', ' ' };
unsigned char decode_lookup_tbl[256];
void alloc_decode_lookup_tbl(void) {
int x;
//Fill the entire array with our canary
 for (x = 0; x < 256; x++) {
decode_lookup_tbl[x] = LOOKUP_CANARY;
}
//Add the four encoding characters by using the inverse
 //of the encoding table
 for (x = 0; x < 4; x++) {
decode_lookup_tbl[ encode_lookup_tbl[x] ] = x;
}
}

The encode_lookup_tbl is a static array of the whitespace characters used in the encoding. But the the decoding lookup table is dynamically generated. It’s first filled with a canary value, then we use the inverse of the encoding table to generate the decoding table. I like the elegance of this: if we change the encoding, the decoding is automatically updated.

Encoding

The encoding also went through a couple of iterations. I first iterated only through the input bytes, and indexed the output bytes using x, x + 1, x + 2, etc.

The final encoding function ended up like this:

ssize_t ws_encode(
const unsigned char *bytes_in,
unsigned char *ws_out,
const ssize_t bytes
) {
int x, y;
for (x = 0; x < bytes; x++) {
for (y = 0; y < 4; y++) {
ws_out[(4 * x) + y] = encode_lookup_tbl[
(bytes_in[x] >> (2 * y)) & 0x03
];
}
}
return x * 4;
}

I moved to a double loop, with x indexing into the input array, (4 * x ) + y indexing into the output array. I will admit that while I reduced the lines of code, I’ve probably made it much harder to interpret.

Reading

The reading loop when encoding is really simple: read bytes from standard in into a buffer, encode these bytes, then write them to standard out.

However decoding is a little more nuanced. The challenge is that there’s no guarantee how many bytes a read() system call will return; it could be anything between 1 to the size_t count variable you pass to it. For decoding, our decoded bytes come in as four byte blocks of whitespace. We need to make sure that we’re not passing a split block into our decoder.

To ensure this doesn’t occur, I keep track of the bytes read on each read call, and our position in the read buffer. If the number of bytes read is a multiple of four, we’re fine. If not, we need to go back and read more bytes until it is

A multiple of four, or
We’ve filled our input buffer, which is also a multiple of four bytes

I won’t post the read loop code, but you can see it here.

Summary

Is this a useful program? Probably not. Was it very difficult to write? There was some nuance, but it wasn’t too hard. It was however a fun project with a small and clearly defined scope. This made it enjoyable to work on in the handful of spare hours available to me.

What the #!

Tue, 11 May 2021 00:00:00 +0000

Working with computers you take a lot for granted. You assume your press of the keyboard will bubble up through the kernel to your terminal, your HTTP request will remain intact after travelling halfway across the globe, and that your stream of a cat video will be decoded and rendered on your screen. Taking these things for granted isn’t a negative, in fact quite the opposite. The countless abstractions and indirections that hide the internal details of a computer are the reason that people - computer science degree or not - can use them in some shape or form.

But at times it’s an unsatisfying feeling not knowing how something is working under the hood, and there’s a want to “pay some attention to the person behind the curtain”. This happened recently to me when writing a script and adding the obligatory hashbang (#!) to the first line. I’ve done this hundreds of times before and know that this specifies the interpreter (and optional arguments) that run the rest of the file, but I wanted to understand how this worked: where is the line parsed, and how is the interpreter run?

So in this article, join me for a dive through user and kernel space in order to answer the question:

How is an interpreter called when specified using a hashbang in the first line of a script?

Two Notes

When discussing kernel components, we’ll be using the following version of Linux:

uname -sor

Linux 4.15.0-142-generic GNU/Linux

In places I’ll be pasting snippets of C from the kernel source code. The code snippets won’t include things such as error checking, locking, and other items I deem only tangentially related the core question of this article. I will include a link to the full source of each function, and elipses (…) will be added to show you that code has been removed.

Execution and Userspace

Let’s dive in - here’s an example Perl script that we’ll run, and the modification of its permission to allow it to be executed.

cat data/foo.pl
chmod u+x data/foo.pl

#!/usr/bin/perl
use strict;
use warnings;
use 5.010;
use Data::Dumper;
print Dumper [@ARGV];

The first investigative tool we’ll use is strace, which attaches itself to a process and intercepts system calls. In the below code snippet, we run strace with the -e argument to filter out all but the system calls we’re interested in. I’ve done this for brevity within the article, but you’d likely want to look through the whole trace to get a firm idea about what the process is doing.

A bash process is run, which then executes our script:

strace -e trace=vfork,fork,clone,execve bash -c './data/foo.pl argument_1'

execve("/bin/bash", ["bash", "-c", "./data/foo.pl argument_1"], 0x7ffffdf84020 /* 100 vars */) = 0
execve("./data/foo.pl", ["./data/foo.pl", "argument_1"], 0x563c6922a890 /* 100 vars */) = 0
$VAR1 = [
'argument_1'
];
+++ exited with 0 +++

The strace utility shows us two processes executions: the initial bash shell (which will have followed the clone() call from the original shell and not captured), then the path of our script being passed directly to the execve() system call. This is the system call that executes processes. It’s prototype is:

int execve(
const char *filename,
char *const argv[],
char *const envp[]
);

with *filename containing the path to the program to run, *argv[] containing the command line arguments, and *envp[] containing the environment variables.

What does this tell us? It tells us that the scripts are passed directly this system call, and it’s not the bash process that parses or acts on the hash-bang line.

A Quick Look in glibc

We’ll stay in userspace a little longer, as the bash process doesn’t call the system call directly. The execve() function is part of the standard C library (on my machine it’s glibc), to which bash is dynamically linked. While it’s unlikely that anything of significance is occurring in the library, let’s be rigorous and take a look.

We can use the ldd utility to print out the dynamic libraries linked at runtime by the dynamic linker:

ldd $(which bash)

 linux-vdso.so.1 (0x00007ffea7d8c000)
libtinfo.so.5 => /lib/x86_64-linux-gnu/libtinfo.so.5 (0x00007f289d576000)
libdl.so.2 => /lib/x86_64-linux-gnu/libdl.so.2 (0x00007f289d372000)
libc.so.6 => /lib/x86_64-linux-gnu/libc.so.6 (0x00007f289cf81000)
/lib64/ld-linux-x86-64.so.2 (0x00007f289daba000)

We can see that libc on my machine is located at /lib/x86_64-linux-gnu/libc.so.6. Using objdump we can disassemble the shared library, and we extract out the section that’s related to execve().

objdump -d /lib/x86_64-linux-gnu/libc.so.6 | sed -n '/^[[:xdigit:]]\+ <execve/,/^$/p'

00000000000e4c00 <execve@@GLIBC_2.2.5>:
e4c00: b8 3b 00 00 00 mov $0x3b,%eax
e4c05: 0f 05 syscall
e4c07: 48 3d 01 f0 ff ff cmp $0xfffffffffffff001,%rax
e4c0d: 73 01 jae e4c10 <execve@@GLIBC_2.2.5+0x10>
e4c0f: c3 retq
e4c10: 48 8b 0d 51 62 30 00 mov 0x306251(%rip),%rcx # 3eae68 <h_errlist@@GLIBC_2.2.5+0xdc8>
e4c17: f7 d8 neg %eax
e4c19: 64 89 01 mov %eax,%fs:(%rcx)
e4c1c: 48 83 c8 ff or $0xffffffffffffffff,%rax
e4c20: c3 retq
e4c21: 66 2e 0f 1f 84 00 00 nopw %cs:0x0(%rax,%rax,1)
e4c28: 00 00 00
e4c2b: 0f 1f 44 00 00 nopl 0x0(%rax,%rax,1)

As expected, the standard library doesn’t deal with the hashbang line either. It places 0x3b (decimal 59) - the execve system call number- into the eax reigster and calls the fast system call x86 instruction. The instructions following the syscall instruction deal with error handling on the return from the kernel.

It would take another whole article to dive into the process of jumping from user space into the kernel through a system call. I’ve provided a brief overview in an appendix at the bottom of this article. Instead, we’ll jump straight to the execve() system call definition in the kernel.

Delving Into the Kernel

We skip over the first few function calls which only tangentially relate to our question we’re trying to answer: SYSCALL_DEFINE3(execve) calls do_execve() which callsdo_execveat_common().

It’s at this point where we start to see some items of interest:

The allocation of the linux_binprm structure, which is the primary structure we’ll be concerned with in this article. The members we’re focused on are:
- char buf[BINPRM_BUF_SIZE] - holds first 128 bytes of the file being executed.
- int argc, envc - our command line argument and environment counts
- const char * filename - the name of the binary that’s seen by the ‘ps’ utility.
- const char * interp - name of the binary that was really executed.
The opening of file based on the path passed to the system call.
Initialisation of some temporary stack space to hold the command line arguments and environment variables.
Copying of the first 128 bytes of the executed file to a buffer.
Counting of the number of argument and environment variables.
Copying of the argument and environment variables on to the stack.

Here’s the code with my comments inline:

static int do_execveat_common(int fd, struct filename *filename,
struct user_arg_ptr argv,
struct user_arg_ptr envp,
int flags)
{
//The most pertinent structure
 struct linux_binprm *bprm;
...
//Allocate space for the structure
 bprm = kzalloc(sizeof(*bprm), GFP_KERNEL);
...
//Open our file that's being executed, and add it
 //to the bprm structure
 file = do_open_execat(fd, filename, flags);
bprm->file = file;
//Copy the name of the file to the structure
 //The 'else' deals with situations where a
 //file descriptor (/dev/fd/*) has been passed
 //to the execve call.
 if (fd == AT_FDCWD || filename->name[0] == '/') {
bprm->filename = filename->name;
} else {
...
}
//At this stage, our interpreter is the same
 //as the file being executed.
 bprm->interp = bprm->filename;
//Create some temporary stack space
 //to copy the command and environment
 //variables to
 retval = bprm_mm_init(bprm);
//Count the argument variables.
 bprm->argc = count(argv, MAX_ARG_STRINGS);
//Count the environment variables.
 bprm->envc = count(envp, MAX_ARG_STRINGS);
//In this function, the bprm->buf character
 //array is zeroed out, and the first 128 bytes
 //of the file are copied into it.
 retval = prepare_binprm(bprm);
//Copy the filename on to the stack, which becomes
 retval = copy_strings_kernel(1, &bprm->filename, bprm);
//Copy the environment variables on to the temporary
 //stack
 retval = copy_strings(bprm->envc, envp, bprm);
//Copy the command line arguments on to the
 //temporary stack
 retval = copy_strings(bprm->argc, argv, bprm);
...
retval = exec_binprm(bprm);
...
}

The next function called, exec_binprm(), has as its main responsibility the calling of search_binary_handler(). Let’s look at how that’s dealt with.

Binary Handler Search

The binary handler is responsible for iterating through the list of supported binary formats, and dispatching the load_binary() function of each one.

int search_binary_handler(struct linux_binprm *bprm)
{
struct linux_binfmt *fmt;
int retval;
...
/* This allows 4 levels of binfmt rewrites before failing hard. */
if (bprm->recursion_depth > 5)
return -ELOOP;
...
list_for_each_entry(fmt, &formats, lh) {
...
bprm->recursion_depth++;
retval = fmt->load_binary(bprm);
bprm->recursion_depth--;
...
}
...
return retval;
}

The formats global variable is a linked list of linux_binfmt structures. Some of these are defined in the kernel, but they can also be loaded via loadable kernel modules. These are registered using the register_binfmt() function. The built-in These include the common ELF format, the older a.out format, but the one we are most interested in is the ‘script’ format.

Here’s the structure and the code code that registers the script format:

static struct linux_binfmt script_format = {
.module = THIS_MODULE,
.load_binary = load_script,
};
static int __init init_script_binfmt(void)
{
register_binfmt(&script_format);
return 0;
}

We can see that for a script, the load_binary function pointer that the search_binary_handler() function will dispatch points to the load_script() function. Let’s now turn our attention to this.

Script Binary Format

The load_script() function must first determine whether it is the appropriate handler for the file that’s being executed. The binprm structure has the first 128 bytes of the file to be executed in the buf member. It looks at the first two bytes and checks whether they are the hash-bang. If not then it returns -ENOEXEC.

static int load_script(struct linux_binprm *bprm)
{
const char *i_arg, *i_name;
char *cp;
struct file *file;
int retval;
if ((bprm->buf[0] != '#') || (bprm->buf[1] != '!'))
return -ENOEXEC;

The rest of the function can be broken down into three parts:

Parsing the interpreter and arguments
Splitting the interpreter and arguments
Updating the command line arguments
Recalling binary handler

Parsing the Interpreter & Arguments

At this point the function knows it’s a script, so now it has to extract the interpreter and any arguments out of the 128 byte buffer. I’ve commented each line of this processes below:

//Add a NUL to the end so the string is NUL terminated.
bprm->buf[BINPRM_BUF_SIZE - 1] = '\0';
//The end of the string is either:
// a) A newline character, or
// b) The end of the buffer
 if ((cp = strchr(bprm->buf, '\n')) == NULL)
cp = bprm->buf+BINPRM_BUF_SIZE-1;
//For a) above, replaces the newline with a NUL.
 //If it was b) above, it redundantly replaces a NUL
 //with another NUL
 *cp = '\0';
//Work our way backwards through the buffer
 while (cp > bprm->buf) {
cp--;
//If the character is whitespace, replace it with
 //a NUL
 if ((*cp == ' ') || (*cp == '\t'))
*cp = '\0';
//Otherwise, we've found the end of the interpreter
 //string
 else
break;
}
//After the hashbang (the buf + 2), remove any whitespace
 for (cp = bprm->buf+2; (*cp == ' ') || (*cp == '\t'); cp++);
//If we hit a NUL, the line only contains a hashbang
 //with no interpreter
 if (*cp == '\0')
return -ENOEXEC; /* No interpreter name found */
//i_name (and cp) points to the start of the interpreter string
 i_name = cp;

At the end of this process, i_name points to the first character of a NUL terminated string containing the path to the interpreter and arguments, with whitespace before and after being removed.

+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+----+
| / | u | s | r | / | b | i | n | / | e | n | v | | p | e | r | l | \0 |
+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+----+
^
|
+------+
|i_name|
+------+

Splitting the Interpreter and Arguments

The string now needs to be split into its components: the path to the interpreter, and any arguments to that interpreter:

i_arg = NULL;
//cp still points to the start of the interpreter string,
//exlcluding any whitespace.
//
//Move along the string until we either hit
// a) A NUL character, or
// b) A space or a tab
for ( ; *cp && (*cp != ' ') && (*cp != '\t'); cp++)
/* nothing */ ;
//If there is whitespace, replace it with a NUL character
while ((*cp == ' ') || (*cp == '\t'))
*cp++ = '\0';
//If there are bytes after the whitespace, these become
//the arguments to the interpreter.
if (*cp)
i_arg = cp;

Again, taking our example script, the pointers now point to the following pieces of memory:

+---+---+---+---+---+---+---+---+---+---+---+---+----+---+---+---+---+----+
| / | u | s | r | / | b | i | n | / | e | n | v | \0 | p | e | r | l | \0 |
+---+---+---+---+---+---+---+---+---+---+---+---+----+---+---+---+---+----+
^ ^
| |
+------+ +-----+
|i_name| |i_arg|
+------+ +-----+

One of the main implications of this code is that you cannot have whitespace in the interpreter path, as anything after the whitespace is considered arguments to the interpreter.

Updating the Arguments

The arguments and argument counts now need to be updated. If we ran our script as ./foo.pl foo_arg, and the hashbang line was #!/usr/bin/perl perl_arg, the new command line arguments need to be ./usr/bin/perl perl_arg ./foo.pl foo_arg. Because of the way the stack is laid out, this is done in reverse order.

//The current argv[0] (the filename of our script) is removed
//from the temporary stack
retval = remove_arg_zero(bprm);
...
//Add in the filename of the script being executed.
retval = copy_strings_kernel(1, &bprm->interp, bprm);
...
bprm->argc++;
if (i_arg) {
//If the interpreter line has arguments, add these in to the stack.
 retval = copy_strings_kernel(1, &i_arg, bprm);
...
bprm->argc++;
}
//Finallly, add the interpreter, which becomes arg[0].
retval = copy_strings_kernel(1, &i_name, bprm);
...
bprm->argc++;
//Update the 'interp` bprm member, which will now
//be difference to the 'filename' member.
retval = bprm_change_interp(i_name, bprm);

Now that the the interpreter has been parsed and the bprm structure updated, the interpreter is opened as a file, and the search_binary_hander() is called again. Except this time it will be searching for a binary handler for our interpreter.

file = open_exec(i_name);
if (IS_ERR(file))
return PTR_ERR(file);
bprm->file = file;
retval = prepare_binprm(bprm);
if (retval < 0)
return retval;
return search_binary_handler(bprm);

The interpreter is of this type:

file /usr/bin/perl

/usr/bin/perl: ELF 64-bit LSB shared object, x86-64, version 1 (SYSV), dynamically linked, interpreter /lib64/ld-linux-x86-64.so.2, for GNU/Linux 3.2.0, BuildID[sha1]=e865d791bb4b89f4ab5e7ec1217e38ff6c31f3ed, stripped

Thus the ELF binary handler will be called, doing what it needs to do to load the binary and add it to the kernel scheduler, eventually running the process.

Summary

We started this article out with a question: how is an interpreter called when used in a hashbang line of script. We used some tools to determine whether it was performed in userspace, but found that it was the kernel that performed this task.

We went through the kernel, starting at the execve() system call, working our way down to the binary handlers. We then went through the ‘script’ binary handler, which matches files that have ‘#!’ as their first two bytes. We could see how this handler parsed the interpreter line, extracting the interpreter path and optional arguments, and updating the binary to be called by the kernel.

This is an example of an elegant and generalised solution by the Linux kernel.

Appendix - System Calls

When we started delving into the kernel, we skipped over the syscall instruction and the system call handler in the kernel; this appendix summarises what happens between. There’s a number of different variables that change the code path (page table isolation, slow and fast paths), so it’s a simplification.

As with the rest of this article, we only consider an x86_64 processor architecture, and I’m also going to ignore the page table isolation feature introduced to mitigate against the Meltdown vulnerability.

The syscall instruction:
- Saves the address of the following instruction to the rcx register
- Loads a new instruction pointer from the IA32_LSTAR model specific register.
- Jumps to the new instruction at a ring 0 privilege level.
The IA32_LSTAR register holds the address if entry_SYSCALL_64, which is our system call handler.
- This is set (per-CPU) at boot time in syscall_init().
The entry_SYSCALL_64 handler performs re-organisation required to transition from userspace to kernel space.
- Main task is to push all the current registers on to some new stack space.
- There’s loads of other things, but let’s consider them out of scope for this summarisation.
The system call is then called using its number (in the rax register) as an index into the sys_call_table array.
- This is an array of function pointers to each of the system calls.
- The file in the #include <asm/syscalls_64.h> line is generated dynamically.
It’s generated from the syscall table file.
This is converted into a header via a simple shell script.

A Bit on the Nose

Sun, 07 Mar 2021 00:00:00 +0000

I’ve never been particularly interested in horse racing, but I married into a family that loves it. Each in-law has their own ideas and combinations of factors that lead them to bet on a particular horse. It could be it form, barrier position, track condition, trainer, jockey, and many others.

After being drawn into conversations about their preferred selection methods, I wanted come at the problem backed with data. I must admit I had an initial feeling of arrogance, thinking “of course I can do this better”. In fact I’ve seen this in many places where ‘data scientists’ stroll into fields of enquiry armed with data and a swag of models, but lacking an understanding of the problem space. Poor assumptions abound, and incorrect conclusions are almost certainly reached.

I was determined not to fall into the same traps, and after quashing my misplaced sense of superiority, I started to think about how to approach the problem at hand. Rather than diving straight into prediction - models akimbo - I thought the best place to start would be to create naive baselines. This would give me something to compare the performance of any subsequent models against.

In this article I will look at two baselines. The first is to pick a random horse in each race, which will provide us with a lower bound for model predictive accuracy. The second is to pick the favourite in each race. The favourite has many of the factors that we would be using in the model already built in via the consensus of the bettors: form, barrier position, trainer, jockey, etc. Any model we create needs to approach the accuracy of this method.

Simply put, we want to answer the following questions:

How accurate are our ‘random’ and ‘favourite’ methods at picking the winning horse?

What are our long term returns using the ‘random’ and ‘favourite’ methods?

Data Information & Aquisition

The data was acquired by using rvest to scrape a website that contained historical information on horse races. I was able to iterate across each race, pulling out specific variables using CSS selectors and XPaths. The dataset is for my own personal use, and I have encrypted the data that us used in this article.

The dataset contains information on around 180,000 horse races over the period from 2011 to 2020. It’s in a tidy format, with each row containing information on each horse in each race. It includes, but isn’t limited to, the name and state that the track, the date of the race, the name of the horse, jockey and trainer, the weight the horse is carrying, race length, duration, barrier position. Here’s an random sample from the dataset with some of the key variables selected:

hr_results %>%
select(
race_id, state, track,
horse.name, jockey, odds.sp,
position, barrier, weight
) %>%
slice_sample(n = 10) %>%
gt()

race_id	state	track	horse.name	jockey	odds.sp	position	barrier	weight
51226	QLD	Doomben	Daisy Duke	Robbie Fradd	6.00	1	3	58.0
134689	VIC	Pakenham	Nautilus	James Winks	6.00	4	1	54.5
24981	WA	Bunbury	RABBIT NAGINA	Alan Kennedy	31.00	6	10	56.5
78601	NSW	Grenfell	Gaze Beyond	Ms Ashleigh Stanley	6.00	4	9	53.0
44267	NSW	Deniliquin	Sunpoint	Ms A Beer	8.00	6	4	57.0
129895	WA	Northam	Ram Jam	Ben Kennedy	2.25	1	4	58.5
101574	TAS	Launceston	Gee Gee Double Hot	Scarlet So	5.00	1	1	52.0
134173	VIC	Pakenham	Miss Mo	Ben E Thompson	8.50	7	3	58.0
69517	QLD	Gold Coast	Liberty Island	Jag Guthmann-Chester	8.00	5	12	57.0
140862	SA	Port Augusta	Gold Maestro	Jeffrey Maund	31.00	1	5	54.0

We won’t use most of the variables in the data set, only a select few:

race_id - a unique identifier for each race. There are multiple rows with the same race_id, each representing a horse that ran in that race.
odds.sp - the ‘starting price’, which is are the “odds prevailing on a particular horse in the on-course fixed-odds betting market at the time a race begins.".
position - the finishing position of the horse.

I’ve omitted the code to load the data, however the full source of this article (and the entire website) is available on github. The data is contained in the variable hr_results.

Exploration

Let’s take a look at the dataset from a few different perspectives to give us some context. First up we take a look at the number of races per month per state. We can clearly see the yearly cyclic nature, with the rise into the spring racing carnivals and a drop off over winter.

Next we take a look at the top 10 winning horses and trainers over this period:

Which tracks have run the most races over this period?

Finally, what is the distribution of the starting price odds? This distribution has a very long tail, so I’ve removed the long odds above 100 to provide a better view of the most common values. What’s interesting is the bias towards odds with round numbers after the 20 mark.

Data Sampling

With a high level handle on the data we’re working with, let’s move on to answering the questions. The process is:

Take a sample of races across the time period.
- We will use 0.5% or ~800 races.
Place a dollar ‘bet’ on a horse in each race, determined by one of our methods.
Calculate our return (payout - stake).
Calculate our cumulative return.
Calculate our accuracy across all the races.
Calculate our return per race.
Return to 1. and repeat.

After the process is complete, we can look at the mean and distributions for the return per race and accuracy metrics. This process is similar to a bootstrap except within the sample we’re performing it without replacement instead of with replacement.

We select only the variables that we need, so we’re not moving huge amounts of unused data between to our worker processes. (Before I realised I should be pruning the data, I was spinning up large AWS instances with 128Gb of memory to perform the sampling. After the pruning I could run it on my laptop with 16GB of memory!) The data is nested based on its race ID, allowing us to sample per race rather than per horse.

# Nest per race
hr_results <- hr_results %>%
select(race_id, position, odds.sp) %>%
group_by(race_id) %>%
nest()
head(hr_results)

## # A tibble: 6 x 2
## # Groups: race_id [6]
## race_id data
## <dbl> <list>
## 1 25488 <tibble [6 × 2]>
## 2 25489 <tibble [5 × 2]>
## 3 25490 <tibble [6 × 2]>
## 4 25491 <tibble [12 × 2]>
## 5 25492 <tibble [14 × 2]>
## 6 25493 <tibble [9 × 2]>

The the mc_cv() (Monte-Carlo cross validation) function from the rsample package is used to create our sampled data sets. We’re not actually performing the cross-validation part, only using the training set that comes back from the function and throwing away the test set.

The worker function mc_sample() is created to be passed to future_map() so we can spread the sampling work across multiple cores.

We generate 2000 samples of .5% of the total races in the dataset, or around 800 races per sample. The returned results are unnested, returning us back to our original tidy format, with each sample identified by the sample_id variable:

# Sampling function that creates a Monte-Carlo CV set
# and returns the analysis portion.
mc_sample <- function(data, times, prop) {
data %>%
mc_cv(times = times, prop = prop) %>%
mutate(analysis = map(splits, ~analysis(.x))) %>%
select(-c(id, splits))
}
# Set up out workers
plan(multisession, workers = availableCores() - 1)
# Parallel sampling
number_samples <- 2000
hr_mccv <- future_map(
1:number_samples,
~{ mc_sample(hr_results, times = 1, prop = .005) },
.options = furrr_options(seed = TRUE)
)
# Switch plans to close workers and release memory
plan(sequential)
# Bind samples together and unnest
hr_mccv <- hr_mccv %>%
bind_rows() %>%
mutate(sample_id = 1:n()) %>%
unnest(cols = analysis) %>%
unnest(cols = data)

A bet_returns() function is created which places a bet (default $1) for the win on each horse in the dataset it’s provided. It determines the return based on the starting price odds. The data set uses decimal (also known as continental) odds, so if we placed a $1 bet on a horse with odds of 3.0 and the horse wins, our payout is $3, but our return is $2 (payout - $1). If the horse doesn’t win, our payout is $0 and our return is -$1.

# Places a bet for the win on each horse and calculates the return,
# the cumulative return, and the cumulative return per race.
bet_returns <- function(data, bet = 1) {
data %>%
mutate(
bet_return = if_else(
position == 1,
(bet * odds.sp) - bet,
-bet
)
) %>%
group_by(sample_id) %>%
mutate(
sample_race_index = 1:n(),
cumulative_return = cumsum(bet_return),
cumulative_rpr = cumulative_return / sample_race_index
) %>%
ungroup()
}

Approach 1: Random Selection

The first approach to take is to bet on a random horse per race.

# Select a random horse from each race where there are odds available
hr_random <- hr_mccv %>%
drop_na(odds.sp) %>%
group_by(sample_id, race_id) %>%
slice_sample(n = 1) %>%
ungroup()
# Place our bets
hr_random <- bet_returns(hr_random)

Let’s first calculate the accuracy per sample, and view this as a histogram. The solid line is the mean, and the dashed lines are the 2.5% and 97.5% quantiles, showing the middle 95% range of the accuracy.

hr_random_accuracy <-
hr_random %>%
mutate(win = if_else(position == 1, 1, 0)) %>%
group_by(sample_id) %>%
summarise(accuracy = mean(win))

The random method gives us a mean accuracy of 11%, with 95% range between 9.1% and 13.5%. That’s about a 1 in 9 chance of picking the winning horse. At first I thought this was a little low, as the average number of horses in a race was about 6. I naively assumed that the random method would give us a 1 in 6 chance of picking the winnow, or 17% accuracy level. But this assumption assumes a uniform probability of winning for each horse, which of course is not correct.

Accuracy is one thing, but what about our returns? Let’s take a look at our cumulative returns over time. It’s difficult to graph the entire 2000 samples as it becomes one big blob on the graph, so we look at the first 40 samples which gives us a reasonable representation:

The result is a general trend downwards. We see some big jumps where our chosen horse is the long shot that came home, and some of our samples manage to pull themselves back into the black for periods of time. But they quickly regress trend back into the red.

The number of races may vary slightly per sample, so instead of looking at the cumulative return, let’s look at the returns per race, i.e. (cumulative return / number of races).

In the long run our average return per race is -$0.30, and 95% of our returns are within the range of -$0.49 to -$0.04. As we’ve used a dollar bet, this translates nicely to a percentage. What we can say is that in the long run we’re on average losing 30% of our stake each time we use this method of betting.

Approach 2 - Favourite

The second approach to take is to bet on the favourite in each race. We rank each horse in each race using the order() function, and extract the horse with a rank of 1. For races where there are two equal favourites, we pick one of those horses at random.

# Favourite horse from each race
hr_favourite <- hr_mccv %>%
drop_na(odds.sp) %>%
group_by(sample_id, race_id) %>%
mutate(odds.rank = order(odds.sp)) %>%
slice_min(odds.rank, with_ties = FALSE, n = 1) %>%
ungroup()
# Place out bets
hr_favourite <- bet_returns(hr_favourite)

Let’s again take a look at the accuracy of this approach, viewed as a histogram of accuracy per sample.

# Calculate the accuracy
hr_favourite_accuracy <-
hr_favourite %>%
mutate(win = if_else(position == 1, 1, 0)) %>%
group_by(sample_id) %>%
summarise(accuracy = mean(win))

This is looking much better - we’ve got a mean accuracy across all of the samples of 35%, with 95% of our accuracy in the range of 32.0% - 38.3%. These accuracy percentages look pretty good, and my gut feel is that they would be pretty difficult to approach with any sort of predictive model. Picking the favourite is around 3 times better than picking a random horse.

What do our returns over time look like? Again we take the first 40 samples and graph the cumulative return.

There is still a general trend downwards, however it’s certainly not as pronounced as the random method. There are longer periods of time where we’re trending sideways, and some of our samples even manage to eke out a profit.

Taking a look again at the distributions of our returns per race:

Picking the favourite is much better than picking a random horse but it’s certainly no slam dunk. The long run average return per race is still negative at -$0.05. The 95% of returns per race are in the range of -$0.15 to $0.04.

Conclusion

In this article we baselined two different approaches to betting on horse races: picking a random horse, and picking the favourite. Our aim was determine the mean accuracy and mean returns per race for each of the approaches.

We found the accuracy of picking a random horse is 11% and the mean returns per race for a dollar bet are -$0.30. You’re losing thirty cents on the dollar per bet.

Betting of the favourite is unsurprisingly much better, with a mean accuracy of 35% and mean returns per race for a dollar bet being -$0.05, or a loss a five cents on the dollar. I’m impressed with the bookies ability to get so close to parity.

What we don’t take into account here is the utility, or enjoyment, that is gained from the bet. If you think cost of the enjoyment you receive betting on a random horse is worth around 30% of your stake, or betting on the favourite is worth 5% of your stake, then go for it. As long as you’re not betting more than you can afford, then I say analyses be damned and simply enjoy the thrill of the punt.

AFL Bets - Analysing the Halftime Payout

Thu, 13 Aug 2020 00:00:00 +0000

If you’ve watched AFL over the past few years, you would have noticed betting companies spruiking a cornucopia of betting options. In fact it would be hard for you not to notice, given the way they yell at you down the television screen.

One of the value adds these companies advertise is the ‘goal up at halftime’ payout. The terms are that if you have a head-to-head bet on the game, and your team is up by 6 points or more at half time, you’ll be paid out as if you had won.

Betting companies aren’t in the business of giving away money, so they must be confident that, in the long run, the team that is up at half time almost always goes on to win the game. But how confident should they be? Is this something that we can calculate?

Good data analysis always starts off with a question. In this article I will try to answer the question:

If a betting company pays out an AFL head-to-head bet at halftime because a team is up by 6 points or more, in the long run what proportion of bets will the betting company payout that they wouldn’t have if they didn’t offer this option?

There are two scenarios to consider:

A team is up at half time and goes on to win.
A team is down at half time and goes on to win.

With 1, a betting company loses nothing paying out at half time, as they will have had to have paid out the bet anyway. However with 2, the betting company does lose, as they’re paying out both teams. We want to determine how often this scenario plays out.

Model Notes Assumptions

The terms of the payout are clear-cut: head-to-head bet, team is up by a goal, bet is paid out. We want to model the probability of a win (the result) versus the half time differential (the predictor):

$$ Pr(R = Win | S) $$

Where $R$ is the result (Win, Loss), and $S$ is the score differential at halftime.

The main assumption we need to make is around timing: we assume that this halftime payout is applied across all games. This allows us to discount all other variables such as the teams’ odds, weather conditions, team form, etc. What is likely is that the betting companies have far more complex statistical models that take into account a wide range of variables. They can then ‘turn on’ this offer on specific games when the probabilities are in their favour.

Another item to consider is how far to go back in time to train our model. It could be that the game has changed significantly in the past few years, making this kind of payout more feasible. We will attempt to model this by adding a categorical variable representing the league a game was played in: the Victorian Football League (VFL) or the Australian Football League (AFL). We can then determine whether this has statistical significance, and whether it increases the accuracy of our model.

What About a Draw?

Spoiler alert: we’re going to be using a logistic regression in our model. This allows us to model a binary outcome, but we actually have three outcomes: loss, win and draw.

In a draw, the head-to-head bet is paid out at half the face value. So if a team is up at halftime and paid out, and the game goes on to be a draw, the betting company will still have paid out more than they had to. As we’re looking at ‘the proportion of bets the betting company payout that they wouldn’t have if they didn’t offer this option’, we will consider a draw to be a loss.

Loading and Transforming the Data

Our data for this analysis will come from the AFL Tables site, via the fitzRoy R package. The data is received in a long format that includes statistics for each player. We’re only concerned with team statistics, not player statistics, so the first row is taken from each game and transmuted into the variables we require.

As discussed in the assumptions, we’d like to see if there’s a difference between the VFL and AFL leagues. A categorical variable is added denoting whether the game was played as part of the ‘Australian Football League’ or ‘Victorian Football League’, which changed in 1990.

library(tidyverse)
library(magrittr)
library(fitzRoy)
library(modelr)
library(lubridate)
# Download the AFL statistics
afl_match_data <- get_afltables_stats()
# Group by each unique game and take the first row from each. 
# Transmute into the required data.
afl_ht_results <-
afl_match_data %>%
mutate(
Game_ID = group_indices(., Season, Round, Home.team, Away.team)
) %>%
group_by(Game_ID) %>%
slice(1) %>%
transmute(
Home_HT.Diff = (6 * HQ2G + HQ2B) - (6 * AQ2G + AQ2B),
Away_HT.Diff = -Home_HT.Diff,
Home_Result = as_factor(ifelse(Home.score > Away.score, 'Win', 'Loss')),
Away_Result = as_factor(ifelse(Away.score > Home.score, 'Win', 'Loss')),
League = ifelse(year(Date) >= 1990, 'AFL', 'VFL')
) %>%
ungroup()
print(afl_ht_results)

# A tibble: 15,705 x 6
Game_ID Home_HT.Diff Away_HT.Diff Home_Result Away_Result League
<int> <dbl> <dbl> <fct> <fct> <chr>
1 1 13 -13 Win Loss VFL
2 2 2 -2 Win Loss VFL
3 3 -18 18 Loss Win VFL
4 4 -17 17 Loss Win VFL
5 5 -14 14 Loss Win VFL
6 6 20 -20 Win Loss VFL
7 7 23 -23 Win Loss VFL
8 8 -41 41 Loss Win VFL
9 9 -24 24 Loss Win VFL
10 10 -15 15 Loss Win VFL
# … with 15,695 more rows

We have one row per game, but our observations are focused on each team rather than each individual game. We pivot the data to give us the half time differential and result per team, which results in two rows per game. Note the ability of pivot_longer() to extract out more than two columns at once using the names_sep argument.

afl_ht_results <-
afl_ht_results %>%
pivot_longer(
-c(Game_ID, League),
names_to = c('Team', '.value'),
names_sep = '_',
values_drop_na = TRUE
) %>%
select(-Team)
print(afl_ht_results)

# A tibble: 31,410 x 4
Game_ID League HT.Diff Result
<int> <chr> <dbl> <fct>
1 1 VFL 13 Win
2 1 VFL -13 Loss
3 2 VFL 2 Win
4 2 VFL -2 Loss
5 3 VFL -18 Loss
6 3 VFL 18 Win
7 4 VFL -17 Loss
8 4 VFL 17 Win
9 5 VFL -14 Loss
10 5 VFL 14 Win
# … with 31,400 more rows

In this format there is a lot of redundancy: each game has two rows in our data frame, with each row simply being the negation of the other row. We remove this redundancy by taking, at random, either one team’s variable from each game.

At this point, we have tidied and transformed our data into the variables we require and into the shape we need. We can now start to analyse and use it for modeling.

afl_ht_sample <-
afl_ht_results %>%
group_by(Game_ID) %>%
sample_frac(.5) %>%
ungroup()
print(afl_ht_sample)

# A tibble: 15,705 x 4
Game_ID League HT.Diff Result
<int> <chr> <dbl> <fct>
1 1 VFL 13 Win
2 2 VFL 2 Win
3 3 VFL -18 Loss
4 4 VFL -17 Loss
5 5 VFL 14 Win
6 6 VFL 20 Win
7 7 VFL 23 Win
8 8 VFL -41 Loss
9 9 VFL 24 Win
10 10 VFL 15 Win
# … with 15,695 more rows

Let’s take a look at the win/loss ratios for each halftime differential, splitting on whether which league the game was played.

# Graph the win/loss ratios by the halftime differential
afl_ht_sample %>%
group_by(HT.Diff, League) %>%
summarise(Ratio = mean(Result == 'Win'), .groups = 'keep') %>%
ggplot() +
geom_point(aes(HT.Diff, Ratio, colour = League)) +
labs(
x = 'Half Time Difference',
y = 'Win/Loss Ratio',
title = 'AFL Games - All Games',
subtitle = 'Half Time Difference vs. Win/Loss Ratio'
)

As mentioned earlier, we knew that the logistic regression would be the likley method used to model this data. This graph, with it’s clear sigmoid-shaped curve, confirms that a logistic regression is an appropriate choice.

Modeling

Our data is in the right shape, so we now use it to create a model. The data is split into training and test sets, with 80% of the observations in the training set and 20% left over for final testing.

A logistic regression is then used to model the result of the game against the halftime differential, the league, and also take into account any interaction between the league and the halftime differential. As a learning exercise I’ve decided to use the tidymodels approach to run the regression.

library(tidymodels)
# Split the data into training and test sets.
set.seed(1)
afl_ht_sets <-
afl_ht_sample %>%
initial_split(prop = .8)
# Define our model and engine.
afl_ht_model <-
logistic_reg() %>%
set_engine('glm')
# Fit our model on the training set
afl_ht_fit <-
afl_ht_model %>%
fit(Result ~ HT.Diff * League, data = training(afl_ht_sets))

Let’s see how this model looks against the the training data:

# View the logistic regression against the win/loss ratios
training(afl_ht_sets) %>%
group_by(HT.Diff, League) %>%
summarise(Ratio = mean(Result == 'Win'), .groups = 'keep') %>%
bind_cols(predict(afl_ht_fit, new_data = ., type = 'prob')) %>%
ggplot() +
geom_point(aes(HT.Diff, Ratio, colour = League), alpha = .3) +
geom_line(aes(HT.Diff, .pred_Win, colour = League))

We see it fits the data well, and that there doesn’t appear visually to be much of a difference between the VFL era and the AFL era.

Probabilities

We’re concerned with half time differentials above 6, so let’s look at some of the probabilities our model spits out for one, two and three goal leads at half time.

# 1, 2 and 3 goal leads in the two leagues
prob_data <-
crossing(
HT.Diff = c(1, 2, 3) * 6,
League = c('AFL', 'VFL')
)
# Prediction across this data
afl_ht_fit %>%
predict(new_data = prob_data, type = 'prob') %>%
bind_cols(prob_data) %>%
mutate(Percent_Win = round(.pred_Win * 100, 2)) %>%
select_at(vars(-starts_with('.pred')))

# A tibble: 6 x 3
HT.Diff League Percent_Win
<dbl> <chr> <dbl>
1 6 AFL 62.1
2 6 VFL 63.0
3 12 AFL 73.1
4 12 VFL 74.9
5 18 AFL 81.9
6 18 VFL 83.9

Our model gives mid-60%, mid-70% and mid-80% probabilities in both leagues for teams leading by one, two and three goals respectively. For the purposes of this article we’re going to use a decision threshold of 50% as between the ‘Win’ and ‘Loss’ categories.

What this means is that our model will always predict a win if a team is leading by a goal or more, and thus for the us there will only be two error types:

True Positives - predicting a win when the result is a win.
False Positives - predicting a win when the result is a loss.

At this point we could move to estimate the expected proportion of payouts simply looking at the win/loss ratios for halftime differentials of 6 point or more. But before we do that, let’s perform some further diagnostics on our model to ensure that we’re not making invalid assumptions.

Training Accuracy

The next step is to look at the accuracy of our model against the training set - that is - the same set of data that model was built upon.

# Calculate training accuracy
afl_ht_fit %>%
predict(training(afl_ht_sets)) %>%
bind_cols(training(afl_ht_sets)) %>%
accuracy(Result, .pred_class)

# A tibble: 1 x 3
.metric .estimator .estimate
<chr> <chr> <dbl>
1 accuracy binary 0.784

So 78.4% of the time the model predicts the correct result. That’s good, but we need to remember that the model was generated from the same data so it’s going to be optimistic. THe test accuracy is likely to be lower.

Model Coefficients

We’ve looked at the outputs of the model: probabilities and accuracy. But what is the model actually telling us about the relationship between halftime differential and league to the probability of a win? This is where the actual values of the model coefficients come in. Our logistic function will look as such:

$$ p(X) = \frac{ e^{\beta_0 + \beta_1 X_1 + \beta_2 X_2 + \beta_3 X_1 X_2} }{ 1 - e^{\beta_0 + \beta_1 X_1 + \beta_2 X_2 + \beta_3 X_1 X_2} }$$`

where $X_1$ is the halftime differential in points, and $X_2$ is a categorical variable denoting the league the game was played in: ‘AFL’ or ‘VFL’.

We also need to remember that the result of our model is not a probability, but the log-odds or logit of the result:

$$ logit(p) = log(\frac{p}{1 - p}) $$ where $p$ is the probability of the result being a win.

# Model coefficients
afl_ht_fit %>%
tidy()

# A tibble: 4 x 5
term estimate std.error statistic p.value
<chr> <dbl> <dbl> <dbl> <dbl>
1 (Intercept) 0.0139 0.0392 0.355 7.23e- 1
2 HT.Diff -0.0846 0.00252 -33.6 8.02e-248
3 LeagueVFL 0.0126 0.0487 0.259 7.96e- 1
4 HT.Diff:LeagueVFL -0.00869 0.00332 -2.62 8.76e- 3

The model coefficients are as such:

The intercept ($\beta_0$) tells us the log-odds of winning in the AFL with a halftime differential of zero.
HT.Diff ($\beta_0$) is the change in log-odds of a win in the AFL for every one point of halftime differential.
LeagueVFL ($\beta_1$) tells us the difference in log-odds of winning with a differential of zero in the VFL as compared to the AFL.
- This needs to be added to the intercept to when considering VFL games.
HT.Diff:LeagueVFL ($\beta_3$) is the difference in the change in log-odds of a win for every one point of halftime differential in the VFL.
- Again, this needs to be added to the HT.Diff variable when considering VFL games.

So for an AFL game, for each point a team is leading by at half time, their odds of winning increase by $e^{-0.0846468}$ or 0.9188368. For a VFL game, it’s $e^{-0.0846468 + (-0.0086936)}$ or 0.9108834.

Looking at the p-values, if we assume a standard significance value of $\alpha = 0.05$, then the halftime difference is highly significant, and that there is a slight significance between the change in log-odds per halftime differential between the VFL and the AFL. So we can say that the odds of winning given a lead at halftime were slightly less in the VFL era as compared to the AFL era.

We’re building this model in order to predict the results, not in order to explain how each variable affects the outcome. As such, the statistical significance of each predictor isn’t that relevant to us. But it does raise a question: should we include the statistically insignificant predictors in our model or not?

To answer this question, we’ll use bootstrapping.

Bootstrapping

With the bootstrap, we take a sample from the training set a number of times with replacement, run our model across this data, and and record the accuracy. The mean accuracy is then calculated across all of these runs.

We’ll create two models: one with the league included, and a model without. The model with the best accuracy from this bootstrap is the model that will be used.

# Recipe A: Result vs Halftime Difference
afl_recipe_ht <-
training(afl_ht_sets) %>%
recipe(Result ~ HT.Diff) %>%
step_dummy(all_nominal(), -all_outcomes())
# Bootstrap Recipe A
workflow() %>%
add_model(afl_ht_model) %>%
add_recipe(afl_recipe_ht) %>%
fit_resamples(bootstraps(training(afl_ht_sets), times = 50)) %>%
collect_metrics()

# A tibble: 2 x 5
.metric .estimator mean n std_err
<chr> <chr> <dbl> <int> <dbl>
1 accuracy binary 0.784 50 0.000765
2 roc_auc binary 0.869 50 0.000646

# Recipe B: Result vs Halftime Difference, League, and interaction term 
afl_recipe_ht_league <-
training(afl_ht_sets) %>%
recipe(Result ~ HT.Diff + League) %>%
step_dummy(all_nominal(), -all_outcomes()) %>%
step_interact(~League_VFL:HT.Diff)
# Bootstrap recipe B
workflow() %>%
add_model(afl_ht_model) %>%
add_recipe(afl_recipe_ht_league) %>%
fit_resamples(bootstraps(training(afl_ht_sets), times = 50)) %>%
collect_metrics()

# A tibble: 2 x 5
.metric .estimator mean n std_err
<chr> <chr> <dbl> <int> <dbl>
1 accuracy binary 0.784 50 0.000618
2 roc_auc binary 0.869 50 0.000525

The result: there is hardly any difference between a model with only halftime difference, and a model that takes into account the league the game was played in.

Final Testing

A model needs to be chosen, and so the model with the league predictor is the one that will be used. How does the model stack up against the test set:

afl_ht_fit %>%
predict(testing(afl_ht_sets)) %>%
bind_cols(testing(afl_ht_sets)) %>%
accuracy(Result, .pred_class)

# A tibble: 1 x 3
.metric .estimator .estimate
<chr> <chr> <dbl>
1 accuracy binary 0.787

Our test accuracy is in fact slightly better than our training accuracy!

This accuracy is across the whole gamut of halftime differentials, but we’re only concerned with halftime differentials of 6 points or more:

# Filter out differentials of 6 points or more
afl_ht_testing_subset <-
testing(afl_ht_sets) %>%
filter(HT.Diff >= 6)
# Apply the model to this subset of data 
afl_ht_testing_subset_fit <-
afl_ht_fit %>%
predict(afl_ht_testing_subset) %>%
bind_cols(afl_ht_testing_subset)
# Test set, goal or more accuracy
afl_ht_testing_subset_fit %>%
accuracy(Result, .pred_class)

# A tibble: 1 x 3
.metric .estimator .estimate
<chr> <chr> <dbl>
1 accuracy binary 0.835

Our model, applied to the subset of the test data we’re concerned with, is 84% accurate.

Conclusion

How do these values we’ve calculated relate to the payouts a betting company has to deliver? If a head-to-bet has been placed on a team and that team is up by 6 points or more at half time, we estimate that 84% of the time they will go on to win. The betting company would have had to pay this out anyway, so scenario does not have an affect on the payout.

However with the ‘payout at halftime’ deal in place, there are times when a team is down by 6 points or more and at half-time and goes on to win. From our model and data, we see this occurring 16% of the time.

Therefore, with this deal in place, on head-to-head bets, we would expect the betting companies to pay-out 16/84 or 19.05% more times than they would if the deal was not in place. We note that this includes where a the result is a draw, and the company would only pay out half of the head-to-head bet.

Simulating Snakes and Ladders

Wed, 03 Jun 2020 00:00:00 +0000

For the past couple of months my family and I - like the rest of the world - have been in isolation due to the coronavirus. My eldest son Ned is 5 years old and is interested in games and puzzles at moment, so these have been a key tool in reducing the boredom of lockdown.

Snakes and ladders is one of the games that’s caught his attenton. While sitting on the floor and playing a game for the umpteenth time, I started to wonder about some of the game’s statistical properties. That’s normal, right?

In this article I want to try and answer two questions about snakes and ladders. The first is:

For my son’s board, what is the average amount of dice rolls it takes to finish a game?

And the second is:

What is the average amount of dice rolls it takes to finish a game for a generalised board?

Defining the Board

This is the board we play on - it’s large sheet of plastic, hence the crinkles:

A snakes and ladders board can be represented as a vector, with each element of the vector representing a square or ‘spot’ on the board. Each element holds the value of the shift that occurs when you land on it: negative for snakes, positive for ladders, or zero for neither.

The vector below is a representation of my son’s board. We’re letting R do the calculations for us here, entering values as destination - source for ladders and source - destinaton for snakes.

neds_board = c(
38-1, 0, 0, 14-4, 0, 0, 0, 0, 31-9, 0,
0, 0, 0, 0, 0, 6-16, 0, 0, 0, 0,
42-21, 0, 0, 0, 0, 0, 0, 84-28, 0, 0,
0, 0, 0, 0, 0, 44-36, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 26-47, 0, 11-49, 0,
67-51, 0, 0, 0, 0, 53-56, 0, 0, 0, 0,
0, 19-62, 0, 60-64, 0, 0, 0, 0, 0, 0,
91-71, 0, 0, 0, 0, 0, 0, 0, 0, 100-80,
0, 0, 0, 0, 0, 0, 24-87, 0, 0, 0,
0, 0, 73-93, 0, 75-95, 0, 0, 78-98, 0, 0
)

Playing the Game

With a data structure that represents the board, we now we need an algorithm that represents the game.

The snl_game() function takes a vector defining a board, and a finish type, and runs through a single player game until the game is complete, returning the number of rolls it took to finish the game.

The finish type specfies one of the two different ways a game can be finished. My son and I play an ‘over’ finish type, where any dice roll that takes you over the last spot on the board length results in a win.

The other finish is the ‘exact’ type, where you need to land exactly one spot past the last spot on the board to win. If you roll a value that takes you over, you remain in your current place.

library(tidyverse)
library(magrittr)
library(glue)
library(knitr)
library(kableExtra)

snl_game <- function(board, finish = 'exact') {
if (!finish %in% c('exact', 'over')) {
stop("Argument 'finish' must be either 'exact' or 'over")
}
# We sart on 0, which is off the board. First space is 1
pos <- 0
# We finish one past the end of the board
fin_pos <- length(board) + 1
# roll counter
rolls <- 0
while (rolls <- rolls + 1) {
# Roll the dice
roll <- sample(1:6, 1)
# Update the position
next_pos <- pos + roll
# Two types of finish:
# a) We need an exact roll to win
# b) We need any roll to win
if (next_pos > fin_pos) {
if (finish == 'exact') { next }
else { return(rolls) }
}
# Did we win?
if (next_pos == fin_pos) { return(rolls) }
# Take into account any snakes/ladders 
pos <- next_pos + board[next_pos]
# Did we somehow move off the board in the negative direction?
if (next_pos < 1) {
warning(glue("Went into negative board position: {next_pos}"))
return(NA_integer_)
}
}
}

Answering the Specific Question

Now that we’ve defined a data structure and an algorithm, let’s try and determine the average number of rolls to win on my son’s board. Using my new favourite function crossing(), 200,000 games are simulated for each of the finish types and summary statistics calculated. We visualise the distribution of the numbner of rolls as a histogram:

# Simulate 200,000 games of each finish type 
neds_board_sim <-
crossing(
finish_type = c('exact', 'over'),
n = 1:200000
) %>%
mutate(rolls = map_dbl(finish_type, ~snl_game(neds_board, finish = .x)))
# Summarise the results
neds_board_summary <-
neds_board_sim %>%
group_by(finish_type) %>%
summarise(
min = min(rolls),
max = max(rolls),
mean = mean(rolls),
quantile_95 = quantile(rolls, .95),
quantile_5 = quantile(rolls, .05)
)
# Plot the histograms
neds_board_sim %>%
ggplot() +
geom_histogram(aes(rolls), binwidth = 1) +
geom_vline(
aes(xintercept = mean),
linetype = 'dashed',
colour = 'red',
neds_board_summary
) +
geom_label(aes(label = round(mean, 1), x = mean, y = 0), neds_board_summary) +
facet_wrap(~finish_type, scales = 'free') +
labs(
x = 'Number of Dice Rolls',
y = 'Number of Games',
title = 'Snakes and Ladders - Dice Roll Histogram'
)

print(neds_board_summary)

# A tibble: 2 x 6
finish_type min max mean quantile_95 quantile_5
<chr> <dbl> <dbl> <dbl> <dbl> <dbl>
1 exact 7 288 41.7 90 15
2 over 7 293 36.5 83 12

From this simulated data we’ve determined that it takes on average 41.72 rolls to finish an ‘exact’ game type, and 36.51 rolls to finish an ‘over’ game type.

For the ‘over’ finish type that my son and I play, I estimate a dice roll and move to take around 10 seconds. Our games should on average take around 13 minutes, with 95% of games finishing in less than 28 minutes.

Answering the General Question

We’ve answered the specific question, but can we generalise this to any board? To do this, we’ll have to provide a way of generating a board.

There are two random elements that we need to generate: which spots on the board will have a snake or a ladder, and the shift value for each of these spots.

The first step is to define the the shift - either forwards or backwards - of a single spot. This is done with the spot_alloc() function below. The shift is taken from a normal distribution (floored to an integer) and min()/max() clamped so that we don’t shift ourselves off the bottom or the top of the board.

spot_alloc <- function(spot, board_size, mean, sd) {
# Integer portion of a random normal variable
r <- floor(rnorm(1, mean, sd))
# Clamp the shift value to within the board limits
max(-(spot -1), min(board_size - spot, r))
}

The second step is to generate the board. The snl_board() function does this, taking a board size, a proportion of the board that will be snakes and ladders, and a desired mean and standard deviation for the snake and ladder shifts.

snl_board <- function(board_size, proportion, mean, sd) {
# Allocate the board
board <- rep(0, board_size)
# Which spots will on the board will be snakes or ladders?
spots <- trunc(runif(proportion * board_size, 1, board_size))
# Assign to these spots either a snake or a ladder
board[spots] <- map_dbl(spots, ~spot_alloc(.x, board_size, mean, sd))
return(board)
}

Due to the clamping, the mean we speciify in our argument to snl_board() doesn’t have a purely linear relationship to the evential mean of the entire board. We can see below that it actually resembles a logistic function.

# Our board generation with only one variable.
board_generator <- function(mean) {
# Constant arguments across off of the simulations
board_length <- 100
snl_prop <- .19
snl_sd <- board_length / 3
snl_board(board_length, snl_prop, mean, snl_sd)
}
# Running the simulations
crossing(n = 1:10, mean = seq(-200, 200, 3)) %>%
mutate( board_mean = map_dbl(mean, ~mean(board_generator(.x))) ) %>%
ggplot() +
geom_point(aes(mean, board_mean), alpha = .2) +
labs(
x = 'Specified Mean',
y = 'Actual Mean',
title = 'Specified Mean versus Actual Board Mean'
)

With a board and a game we can now run our simulations for the general case. For each game type and mean we’ll run 200 simulations.

set.seed(1)
# Simulate our snakes and ladders games for different means and finish types.
general_snl_sim <-
crossing(
n = 1:200,
mean = -2:100,
finish_type = c('exact', 'over')
) %>%
mutate(
board = map(mean, ~board_generator(.x)),
board_mean = map_dbl(board, ~mean(.x)),
rolls = map2_dbl(board, finish_type, ~snl_game(.x, .y))
)
general_snl_sim %>%
ggplot() +
geom_point(aes(board_mean, rolls, colour = finish_type), alpha = .5) +
facet_wrap(~finish_type) +
theme(legend.position = 'none') +
labs(
x = 'Board Mean',
y = 'Number of Dice Rolls',
title = 'Simulated Snakes and Ladders',
subtitle = 'Mean of the Board vs. Number of Dice Rolls'
)

With the data in hand, we can now attempt to model the number of dice rolls versus the board mean to answer our question.

Modeling

We’ll keep it simple and apply an ordinary least squares to each of the finish types separately.

library(broom)
# Perform a regression against each group separately
ols_models <-
general_snl_sim %>%
group_by(finish_type) %>%
do(model = lm(rolls ~ board_mean, data = .) )
# Graph the linear regression 
general_snl_sim %>%
ggplot() +
geom_point(aes(board_mean, rolls, colour = finish_type), alpha = .3) +
geom_smooth(aes(board_mean, rolls), method = 'lm', formula = 'y ~ x', ) +
facet_wrap(~finish_type) +
labs(
x = 'Board Mean',
y = 'Dice Rolls',
colour = 'Finish Type',
title = 'Number of Dice Rolls vs Board Mean',
subtitle = 'Split by Finish Type with OLS Best Fit'
)

The intercepts, which represent a board mean of 0, are 31.9 rolls for the exact finish type, and 27.5 rolls for the over finish type.

The coefficient of the board mean variable is very similar for both finish types, -2.6 and -2.7 for the exact and over types respectively. This tells us that for every one unit increase in the board mean, the number of rolls to finish a game on average decreases by -2.6 and -2.7 rolls.

Whenever we discuss a linear model it’s not enough to simply discuss coefficients; we also need to discuss what our uncertaintly is. However let me put a pin in this and discuss this shortly when looking at the diagnostics of the fit.

ols_models %>% tidy(model)

# A tibble: 4 x 6
# Groups: finish_type [2]
finish_type term estimate std.error statistic p.value
<chr> <chr> <dbl> <dbl> <dbl> <dbl>
1 exact (Intercept) 31.9 0.181 176. 0
2 exact board_mean -2.64 0.0318 -82.9 0
3 over (Intercept) 27.5 0.172 160. 0
4 over board_mean -2.72 0.0302 -90.1 0

How well does the least squares model the number of roles in terms of the mean of the board? The R-squared value tells us that the linear regression explains around 25% for the exact finish type, and 28% for the over finish type. On first glance that seems low, however it’s probably reasonable given the randomness of the dice rolls and the snakes and ladders.

ols_models %>%
glance(model) %>%
select(finish_type, r.squared)

# A tibble: 2 x 2
# Groups: finish_type [2]
finish_type r.squared
<chr> <dbl>
1 exact 0.250
2 over 0.283

The next step is to perform some diagnostics on these models. The first thing to look at is a graph of the residuals versus the response variable.

ols_models %>%
augment(model) %>%
ggplot() +
geom_point(aes(.fitted, .resid, colour = finish_type), alpha = .1) +
geom_smooth(aes(.fitted, .resid), method = 'loess', formula = 'y ~ x') +
facet_wrap(~finish_type) +
labs(
x = 'Fitted Value',
y = 'Residuals',
colour = 'Finish Type',
title = 'Residual Diagnostic Plot'
)

There are two things that immediately stand out in this plot - potential non-linearity of the data, the heteroscedacticity of the residuals.

Non-Linearity

Thie first property of the residual graph to notice is the uptick in the shape of the residuals between a fitted value of 30 and 40. This tells us that for fitted values less than 30 (or high board means), the linear regression is a resonably fit to the data. However as the fitted values grow, there doesn’t appear to be a linear relationship between the response and predictor.

The next steps from here would be to either transform the predictor before applying the linear regression, or finding a more flexible model to fit the data on.

Heterocedasticity

The second property to notice is the variance of the residuals increasing as the fitted values increase. This manifests itself as a funnel shape in the residual plot. Our residuals are heteroscedastic, rather than homoscedastic. An important assumption of a linear regression model is that the residuals have a constant variance. The standard errors and confidence intervals rely on this assumption.

This variability is the reason that we didn’t take a look at the standard error after performing our regression: given the variability of the residuals, the standard error is not liklely to be providing us with accurate information.

A possible solution to this is to transform the response using a consave function (square root or log). This results in a greater shrinkage for larger responses, leading to a redicution in heteroscedacticity.

Conclusion

At the ouset of this article I wanted to answer two questions: what is the mean number of rolls it takes to finish a snakes and ladders game on a specific board, and what is the mean number of rolls to finish a game on a general board.

In the specific instance we simulated a large number of games on the specific board. Using this data we were able to determine the mean rolls, as well and lower 5% and upper 95% bounds.

In the general instance we again simulated a large number of games on boards with different means. We it an ordinary least squares model to the data, but saw two issues: some non-linearity of the data in certain ranges of the independent variable, and heteroscedacticity of the residuals. Further work would be needed - either by transforming the data or by using a more flexible model - to get more accurate estimates and confidence intervals of the mean number of rolls across all board means.

Packet Analysis with R (Part 1)

Sat, 22 Feb 2020 00:00:00 +0000

As a network security consultant I’ve spent a my fair share of time trawling through packet captures, looking for that clue or piece of evidence I hope will lead me to the root cause of a problem. Wireshark is the the tool par excellence for interpreting and investigating packet captures, however I’ve always found that it’s best suited to bottom-up rather than top-down analysis. Opening a packet capture you’re bombarded with information, the minutiae from each packet instantly available. This is perfect if you know what you’re looking for and can filter out the noise to concentrate on your problem. But if you don’t have a clear view of what’s in the capture, or where the problem may lie, taking a step back and removing yourself from the details in Wireshark can be difficult.

Recently, while reading Hadley Wickham’s R for Data Science book, the chapter on tidy data resonated with me. For the uninitiated, ‘tidy data’ is a method of organising columnar data to facilitate easier analysis. It can be summarised by three main properties:

Each variable must have its own column.
Each observation must have its own row.
Each value must have its own cell.

What struck me was that this perfectly described packet captures: each captured packet being and observation, and the values of the dissectors the variables. I wondered whether analysis of packet captures could be done with R and be the top-down compliment to Wireshark’s bottom-up approach.

In this article I want to show how valuable it can be to perform packet analysis using the R language. It’s broken into three sections:

Conversion of packet captures to columnar data.
Creation of Wireshark analogies in R.
Deeper dive into the packet captures.

There’s nothing too complicated in here: no regressions, no categorisation, no machine learning. It’s predominantly about filtering, counting, summarising and visualising aspects of packet captures. What I hope you will see is the power and usefulness in these simple actions.

PCAP to CSV Transformation

The first step is to convert the packet capture file into a format that R can ingest. I chose the comma separate values format (CSV) for its simplicity and human readability, however SQLLite and Parquet are other viable options.

We download a sample packet capture file and run a PCAP to CSV conversion script I’ve written over the top of it:

packet_capture <- './sample.pcap'
pcap_to_csv <- './pcap_to_csv'

# Download the sample packet capture
if (!file.exists(packet_capture)) {
download.file(
url = 'https://tinyurl.com/h545tup',
destfile = packet_capture
)
}
# Download the PCAP to CSV script to the CWD.
download.file(
url = 'https://tinyurl.com/utdbj44',
destfile = pcap_to_csv
)

At a high level the script performs the following actions:

Spawns a tshark process which runs over the packet capture, outputting the specified fields in JSON format to STDOUT.
Reads the JSON from STDOUT and flattens the data structure.
Outputs all of the fields as CSV.

Spawning the tshark process and reading from STDOUT is not the cleanest of implementations, but it does the job we need it to do.

time perl pcap_to_csv sample.pcap

## Gathering dissectors...
## Extracting packets...
## Decoding JSON...
## Flattening packets...
## Creating sample.pcap.csv
## perl pcap_to_csv sample.pcap 17.33s user 0.79s system 101% cpu 17.774 total

What’s the size differential?

ls -lh sample.* | awk '{ print $5, $9 }'

## 9.1M sample.pcap
## 101M sample.pcap.csv

We see there’s about a 10:1 size ratio between the CSV and the original packet capture.

This CSV file is then ingested into R and some mutations are performed:

We remove the ‘.0’ from the end of variable names. This allows us to refer directly to variables that are only in a frame once, e.g. pcap['tcp.dstport'] instead of pcap['tcp.dstport.0'].
The frame.time field is changed to a POSIXct date-time class rather than a simple character string.

library(glue)
library(tidyverse)
library(kableExtra)
# Ingest the packet capture
pcap <-
glue(packet_capture, ".csv") %>%
read_csv(guess_max = 100000)
# Remove the ':0' from the column names
names(pcap) <- names(pcap) %>% str_remove('\\.0$')
# Update the frame.time column
pcap <-
pcap %>%
mutate(frame.time = as.POSIXct(
frame.time_epoch,
tz = 'UTC',
origin = '1970-01-01 00:00.00 UTC'
))

Taking a look at some of the key variables in the first 10 rows:

# First peek
pcap %>%
select(
frame.time,
ip.src, ip.dst,
tcp.dstport, tcp.stream
) %>%
slice(1:5)

## # A tibble: 5 x 5
## frame.time ip.src ip.dst tcp.dstport tcp.stream
## <dttm> <chr> <chr> <dbl> <dbl>
## 1 2011-01-25 18:52:22 192.168.3.131 72.14.213.138 80 0
## 2 2011-01-25 18:52:22 72.14.213.138 192.168.3.131 57011 0
## 3 2011-01-25 18:52:22 192.168.3.131 72.14.213.102 80 1
## 4 2011-01-25 18:52:22 192.168.3.131 72.14.213.138 80 0
## 5 2011-01-25 18:52:22 72.14.213.102 192.168.3.131 55950 1

Wireshark Analogies

Now that we’ve got our data in to R, let’s explore it. To start with we’ll emulate some of the native outputs of Wireshark.

I/O Graph

This is the default graph you would find by going to [Statistics -> I/O Graph] in Wireshark. We round the each frame’s time to the nearest second and tally up the number of frames occurring within each of these seconds.

pcap %>%
group_by(t = round(frame.time_relative)) %>%
tally() %>%
ggplot() +
geom_line(aes(t, n)) +
labs(
title = 'Total Input/Output',
x = 'Seconds Since Start of Capture',
y = 'Frame Count'
)

IP Conversations

This is similar to the output you would get by going to [Statistics -> Conversations -> IP]. We group by source and destination IP address and count the number of packets and the number of kilobytes in each of these unidirectional IP conversations.

pcap %>%
group_by(ip.src, ip.dst) %>%
summarise(
packets = n(),
kbytes = sum(frame.len)/1000
) %>%
arrange(desc(packets)) %>%
head()

## # A tibble: 6 x 4
## # Groups: ip.src [5]
## ip.src ip.dst packets kbytes
## <chr> <chr> <int> <dbl>
## 1 65.54.95.68 192.168.3.131 1275 1719.
## 2 204.14.234.85 192.168.3.131 1036 957.
## 3 65.54.95.75 192.168.3.131 766 879.
## 4 192.168.3.131 204.14.234.85 740 478.
## 5 192.168.3.131 65.54.95.68 664 66.9
## 6 65.54.95.140 192.168.3.131 658 763.

Protocols

In this graph we’re trying to emulate [Statistics -> Protocol Hierarchy]. The frame.protocols field lists the dissectors used in the frame separated by a colon. A regex is used to extract out the first four dissectors and create a new variable. This variable is grouped variable and count the number of frames for each one.

We graph the output slightly differently, first flipping the coordinates to that the x-axis runs top to bottom and y-axis runs left to right, then scaling the x-axis logarithmically.

No surprises that TCP traffic accounts for the most packets, followed by SSL (TLS) and HTTP.

pcap %>%
mutate(
first_4_proto = str_extract(frame.protocols, '(\\w+)(:\\w+){0,4}')
) %>%
count(first_4_proto) %>%
ggplot() +
geom_col(aes(fct_reorder(first_4_proto, n), n)) +
coord_flip() +
scale_y_log10() +
labs(
title = 'Packet Capture Protocols',
x = 'First Four Dissectors',
y = 'Total Frames (Log Scale)'
)

Packet Lengths

This graph is a visual representation of [Statistics -> Packet Lengths]. The axis is broken up into bins of 50 bytes, and the height of each bar represents the log of the number of packets seen with a size within that range. The bars are also colourised based on whether the packet is a TCP acknowledgement or not.

pcap %>%
mutate(is_ack = !is.na(tcp.analysis.acks_frame)) %>%
ggplot() +
geom_histogram(aes(frame.len, fill = is_ack), binwidth = 50) +
labs(
x = 'Number of Frames',
y = 'Frame Size - Log(Bytes)',
fill = 'Is ACK Segment?'
) +
scale_y_log10()

Exploratory

We’ve emulated (to an extent) some of the Wireshark statistical information, let’s dig a little deeper and see what else we can discover about this particular packet capture.

HTTP Hosts

Let’s explore what HTTP hosts requests are being made to. We filter out all packets without the http.host field, which contains the value of the Host header, and count the number of occurrences of each distinct value.

We see an MSN address topping the list, however interestingly a broadcast address is second.

 pcap %>%
dplyr::filter(!is.na(http.host)) %>%
count(http.host) %>%
top_n(20, n) %>%
ggplot() +
geom_col(aes(fct_reorder(http.host, n), n)) +
coord_flip() +
labs(
title = 'Requests per HTTP Host Header',
x = 'Host',
y = 'Number of HTTP requests'
)

Let’s dive a little deeper on this - what are the protocols of these multicast HTTP packets?

pcap %>%
dplyr::filter(http.host == '239.255.255.250:1900') %>%
select(frame.protocols) %>%
distinct()

## # A tibble: 2 x 1
## frame.protocols
## <chr>
## 1 eth:ethertype:ip:udp:ssdp
## 2 eth:ethertype:ip:icmp:ip:udp:ssdp

We see that it’s SSDP broadcasting out, as well as other hosts responding with ICMP messages. What are the ICMP messages?

pcap %>%
dplyr::filter(
frame.protocols == 'eth:ethertype:ip:icmp:ip:udp:ssdp'
) %>%
select(icmp.type, icmp.code)

## # A tibble: 20 x 2
## icmp.type icmp.code
## <dbl> <dbl>
## 1 11 0
## 2 11 0
## 3 11 0
## 4 11 0
## 5 11 0
## 6 11 0
## 7 11 0
## 8 11 0
## 9 11 0
## 10 11 0
## 11 11 0
## 12 11 0
## 13 11 0
## 14 11 0
## 15 11 0
## 16 11 0
## 17 11 0
## 18 11 0
## 19 11 0
## 20 11 0

Type 11 (time exceeded) code 0 (time to live exceeded in transit) messages.

TLS Versions and Ciphers

Taking more of a security perspective, let’s take a look at the SSL/TLS versions and ciphers being used.

During the TLS handshake, the ClientHello message has two versions: the record version which indicates which version of the ClientHello is being sent, and the handshake version which indicates the version of the protocol the client/server wishes to communicate on during the session. We’re concerned with the handshake version:

pcap %>%
dplyr::filter(!is.na(ssl.handshake.version)) %>%
count(ssl.handshake.version)

## # A tibble: 2 x 2
## ssl.handshake.version n
## <chr> <int>
## 1 0x00000300 10
## 2 0x00000301 126

The predominant version is TLS 1.1 (0x0301), with some TLS 1.0 (0x0300).

What about the ciphers being used? By filtering out packets that aren’t part of the handshake and selecting the ciphersuite variable we can get an idea.

pcap %>%
dplyr::filter(!is.na(ssl.handshake.ciphersuite)) %>%
select(ssl.handshake.ciphersuite)

## # A tibble: 122 x 1
## ssl.handshake.ciphersuite
## <dbl>
## 1 49162
## 2 5
## 3 49162
## 4 49162
## 5 49162
## 6 49162
## 7 49162
## 8 49162
## 9 5
## 10 5
## # … with 112 more rows

Unfortunately we don’t get the ciphersuite in a human readable format. Instead we get the the decimal version of the two-byte identification number. This makes it’s difficult to make a security judgement on these ciphers.

Let’s translate these into a human readable format. This website that has a translation table and also - thankfully - has a CSS element that we can use to pull out the values.

The rvest library is used to download the page, pull out the table entries, and convert them to text. Each entry is a string with the ciphersuite name and hex separated by spaces, so those are split, and finally the columns are given sensible names.

library(rvest)
s <- 'https://tinyurl.com/t74r83x'
s %>%
xml2::read_html() %>%
html_nodes('.memItemRight') %>%
html_text() %>%
str_split_fixed("\\s+", n = 2) %>%
as_tibble(.name_repair = ~{ c('ciphersuite', 'hex_value') }) %>%
mutate(hex_value = as.hexmode(hex_value)) ->
cipher_mappings
head(cipher_mappings)

## # A tibble: 6 x 2
## ciphersuite hex_value
## <chr> <hexmode>
## 1 TLS_NULL_WITH_NULL_NULL 0
## 2 TLS_RSA_WITH_NULL_MD5 1
## 3 TLS_RSA_WITH_NULL_SHA 2
## 4 TLS_RSA_WITH_RC4_128_MD5 4
## 5 TLS_RSA_WITH_RC4_128_SHA 5
## 6 TLS_RSA_WITH_DES_CBC_SHA 9

We’re only concerned with the ciphersuite the ServerHello responds with, because this is the one that is ultimately used. Thus other records are filtered out, the number of discrete ciphersuites is counted, and the values converted to hex.

A left join by the hex values is performed which adds the ciphersuite column to the data. The data is presented as a bar graph, the height of the bar representing the number of times each ciphersuite was used in an TLS connection.

pcap %>%
dplyr::filter(ssl.handshake.type == 2) %>%
count(ssl.handshake.ciphersuite) %>%
mutate(
cs = as.hexmode(ssl.handshake.ciphersuite)
) %>%
left_join(
cipher_mappings,
by = c('cs' = 'hex_value')
) %>%
ggplot() +
geom_col(aes(ciphersuite, n)) +
coord_flip() +
labs(x = 'TLS Ciphersuite', y = 'Total TLS Sessions')

DNS Response Times

Finally, let’s take a look at DNS response times. We filter for DNS responses, group by the query and the response type, calculate the mean response time for each of these groups an plot it.

pcap %>%
dplyr::filter(dns.flags.response == 1) %>%
group_by(dns.qry.name, dns.resp.type) %>%
summarise(mean_resp = mean(dns.time)) %>%
ggplot() +
geom_col(aes(
fct_reorder(dns.qry.name, mean_resp),
mean_resp,
fill = as.factor(dns.resp.type)
)) +
coord_flip() +
labs(
x = 'DNS Query Name',
y = 'Mean Response Time (seconds)',
fill = 'DNS Response Type'
)

What we see that response time for some domains differs. The shorter response times have a low variance, indicating they likely came from the resolver’s cache. Other responses have a higher variance, either because of network latency to authoritative DNS servers, or because other DNS resolvers in the chain (opaque to us) have the entry cached as well.

Summary

In this article I’ve discussed the conversion of packet capture files to CSV, and exploratory data analysis of these packet captures. I hope I’ve shown a how standard packet capture analysis with Wireshark can be complimented by analysis with the R language.