R on Publishable Stuff

A template for creating card sorting games in R

Mon, 04 Nov 2024 00:00:00 +0100

Last week I made the small card sorting game called The Climate Impact Sorting Challenge where the challenge is to sort cards with different foods in the order of their climate impact. But then the thought hit me: Any time you find yourself with a dataset with labels (say, types of foods) mapped to numbers (say, climate impact in CO2e) you could turn that into a card sorting game! So, I created a template to facilitate this, and in this post, I’ll show you how to make card sorting games like these using R (or really any data-savvy language):

But first, here are the games I’ve made so far:

It’s the Calories Sorting Challenge! Place the cards in order of increasing calorie content. How many can you get right before you make a mistake? ( source code )
It’s the Countries Population Sorting Challenge! Place the cards in order of increasing population. How many can you get right before you make a mistake? ( source code )
It’s the U.S. Presidents Sorting Challenge! Place the cards in order of when each U.S. president first took office. How many can you get right before you make a mistake? ( source code )
It’s the Climate Impact Sorting Challenge! Place the cards in order of increasing climate impact. How many can you get right before you make a mistake? ( source code )

How to make a card sorting game using the template?

In the sorting-challenges-template GitHub repo you’ll find a file called template-sorting-challenge.html which is the whole game packaged into one stand-alone HTML file, except that it contains a number of placeholder variables that need to be filled in. Let’s define those in R:

library(jsonlite)
library(tidyverse)
library(glue)

# Define the placeholder variables to be inserted into the template
# You can see a variable is a placeholder, as it uses a weird UpperCamelCase name.
GameTitle <- "Calorie Content Sorting Challenge"
GameDescription <- "Place the foods in order of increasing calorie content per 100g."
AuthorName <- "Rasmus Bååth"
Instructions <- "
  Drag and drop the food items to arrange them in order of increasing
  calorie content per 100g. See how many you can get right before making a mistake!
"
LeftGuidanceText <- "← Less calories"
RightGuidanceText <- "More calories →"
InfoText <- "<p>
  <b>About this game</b><br>
  This game helps you learn about the calorie content of different foods.
</p>"

Here we’re creating a small example game that’s about sorting foods according to their calorie content. There’s one placeholder variable left, and that’s the data for the cards. Here we’ll fill that in with some made-up example calorie values:

# Create the candidates cards, here with made up with food items, 
# but generally here's where you would read in some data and munge it into 
# the target formar with the following columns:
# description: The name of the card
# value: The numeric value of the card
# display: The string that will be revealed on the card
candidate_cards <- tribble(
  ~description,       ~value, ~display,
  "Apple",            52,     "52 kcal per 100g",
  "Banana",           96,     "96 kcal per 100g",
  "Broccoli",         34,     "34 kcal per 100g",
  "Cheddar Cheese",   403,    "403 kcal per 100g",
  "Chicken Breast",   165,    "165 kcal per 100g",
  "White Rice",       130,    "130 kcal per 100g",
  "Avocado",          160,    "160 kcal per 100g",
  "Salmon",           208,    "208 kcal per 100g",
  "Almonds",          579,    "579 kcal per 100g",
  "Dark Chocolate",   546,    "546 kcal per 100g"
)
# Convert the candidate_cards dataframe to JSON format for the template
CandidateCardsArray <- toJSON(candidate_cards, auto_unbox = TRUE)

Finally we replace the placeholders in the template, write it to a file…

sorting_challenge_template <- read_file("template-sorting-challenge.html" ) 
example_sorting_game <- glue(sorting_challenge_template, .open = "{{", .close = "}}")
write_file(example_sorting_game, "example-sorting-game.html")

and presto, a game!

Here’s the full R script for creating this example game. Do let me know if you make something fun with it!

The Climate Impact Sorting Challenge

Sat, 19 Oct 2024 00:00:00 +0200

Try out The Climate Impact Sorting Challenge! A quick game I just made that teaches you about the climate impact of different kinds of food.

This game can be played in two different ways. You can play it by yourself and try to beat your own high score (mine is 9). If you’re in a group, you can play “last man standing” style, where you take turns placing the cards. When someone misplaces a card, that person is out! (Strategy tip: If it’s beef, it’s bad).

Q&A

Where is this data from? The emission factors data is from The Big Climate Database v1.2, specifically the Danish emission factors. I chose the Danish emission factors as they were the most complete, as this database is of Danish origin, but these emission factors will be roughly applicable to other European countries as well.

How was this made? This was put together mostly in a single day, mostly by me shouting at the computer until it did what I wanted (a.k.a. AI-driven development). I started out knowing I wanted to make a single HTML page app built on the SortableJS JavaScript library, which makes it easy to add drag-and-droppable lists to a webpage. Then, with some judicious prompting of the ChatGPT o1-preview model, I got a working game in ~1 hour. Here’s the full transcript of this initial prompting history. I then whipped up a small R script to parse and insert the emission factors from The Big Climate Database into the game, and with some final tweaks and fixes, that was basically it. The full code is available here on GitHub.

Any caveats? Yes, lots. Notably, these emission factors are averages, and the specific climate impact of any type of food can vary significantly depending on how the food is produced. Another thing to consider is that the emission factors are per kg of food. This does not take into account that different foods have different nutritional values. For example, a kg of butter has a much higher climate impact than a kg of lettuce, but a kg of butter also has a much higher energy content than a kg of lettuce.

A Bayesian Plackett-Luce model in Stan applied to pinball championship data

Sun, 22 Sep 2024 00:00:00 +0200

Sometimes it feels a bit silly when a simple statistical model has a fancy-sounding name. But it also feels good to drop the following in casual conversation: “Ah, then I recommend a Plackett-Luce model, a straightforward generalization of the Bradley–Terry model, you know”, when a friend wonders how they could model their, say, pinball championship dataset. Incidentally, in this post we’re going to model the result of the IFPA 18 World Pinball Championship using a Plackett-Luce model, implemented in Stan as a generalization of the Bradley–Terry model, you know.

I know neither who Bradley, Terry, Plackett, nor Luce were, but I know when their models could be useful:

A Bradley-Terry model can be used to model data where you have pairwise comparisons between different items, and you are interested in the underlying “fitness” of the items. A concrete example is sports where each match is a “pairwise comparison” between two players or teams, and you assume each player or team has an underlying skill or ability.
A Plackett-Luce model can be useful when you have several rankings between items and you’re, again, interested in the “fitness” of each item. This model could be used to assess the quality of different products when each participant has ranked the items from best to worst. Or, in a sports setting, it can be used to model the underlying skills of each player when the outcome isn’t wins or losses, but rankings. Just like you have in pinball championships.

So, both models can model the skills of a number of players/teams, the only difference being that a Bradley-Terry works with wins/losses and a Plackett-Luce model works with rankings (1st/2nd/3rd/etc).

Now we’re going to grab some data with rankings from the IFPA 18 World Pinball Championship, implement a Bayesian Plackett-Luce model in Stan, and then take it for a spin.

IFPA 18 World Pinball Championship dataset

Despite the name, the IFPA 18 World Pinball Championship took place in 2023. The IFPA Championship is generally considered the most prestigious pinball competition, but the main reason why we’re going to analyze it here is because the results of all the 480 pinball matches that went down between the 80 competing players are available in a single spreadsheet! It’s not a very tidy dataset, however, and it will need some tidying up. I won’t bore you with the details, unless you really want to know:

How the sausage gets tidied up

library(readxl)
library(tidyverse)

# This data is NOT in a tidy format, and so the code to tidy it up
# will also be fairly messy...
# The result of IFPA 18 World Pinball Championship was downloaded 
# from here: https://www.ifpapinball.com/ifpa18/
ifpa_xlsx_path <- "IFPA 18 World Pinball Championship live results.xlsx"

# Reading and tidying the sheet with the pinball machine names used in the tournament
machines_wide <- read_xlsx(ifpa_xlsx_path, sheet = "Machines", range = "B2:F22")
machines_long <- machines_wide |> 
  select(old = OLD, mid = MID, new = NEW) |> 
  pivot_longer(
    cols = everything(), names_to = "game_category", values_to = "game_name"
  ) |> 
  # The two machines were missing from the original data
  add_row(game_category = "old", game_name = "Dodge City") |>
  add_row(game_category = "old", game_name = "8 Ball") |>
  arrange(game_name)

# Reading in the match data which is spread over multiple Session sheets, 
# each containing several sub-tables with the results of the games.
ifpa_xlsx_info <- 
  expand_grid(
    session = paste("Session", 1:8),
    tibble(
      group = 1:20,
      group_pos = seq(1, 96, 5)
    )
  ) |> 
  rowwise() |> 
  mutate(session_df = list(
    read_xlsx(
      ifpa_xlsx_path, sheet = session, 
      range = paste0("A", group_pos, ":K", group_pos + 4),
      col_names = FALSE
    )
  )) |> 
  ungroup()

# A function to pivot the sub-tables into a tidy data frame
pivot_session_df <- function(s) {
  player_names <- s$...1[2:5]
  game1 <- s$...3[2:5]
  score1 <- s$...5[2:5]
  game2 <- s$...6[2:5]
  score2 <- s$...8[2:5]
  game3 <- s$...9[2:5]
  score3 <- s$...11[2:5]
  
  tibble(
    player_name = rep(player_names, 3),
    round = rep(1:3, each = 4),
    game_name = c(game1, game2, game3),
    score = c(score1, score2, score3)
  )  
}

# Stitching the data together, and turning it into long format.
# Also, adding unique numerical identifiers for everything 
# as it's going to make things easier when writing the Stan model.
match_results <- 
  ifpa_xlsx_info |> 
  mutate(session_df = map(session_df, pivot_session_df)) |>
  unnest(session_df) |> 
  left_join( machines_long, by = "game_name") |>
  mutate(
    session = str_remove(session, "Session "),
    player_id = as.integer(factor(player_name)),
    game_id = as.integer(factor(game_name)),
    game_category_id = recode(game_category, `old` = 1, `mid` = 2, `new` = 3),
    rank = recode(score, `7` = 1, `5` = 2, `3` = 3, `1` = 4),
  ) |> 
  group_by(session, group, round) |> 
  mutate(round_id = cur_group_id()) |>
  select(
    session, group, round, round_id, player_name, player_id, score, rank,
    game_name, game_id, game_category, game_category_id
  )

write_csv(match_results, "ifpa-18-world-pinball-championship-match-results.csv")

The final tidy IFPA 18 Pinball Championship dataset includes the results from each of the eight qualifying sessions before the final tournament:

library(tidyverse)
match_results <- read_csv("ifpa-18-world-pinball-championship-match-results.csv")
match_results

# A tibble: 1,920 × 12
   session group round round_id player_name    player_id score  rank game_name  
     <dbl> <dbl> <dbl>    <dbl> <chr>              <dbl> <dbl> <dbl> <chr>      
 1       1     1     1        1 Michael Trepp         57     1     4 Little Joe 
 2       1     1     1        1 Bob Matthews          12     7     1 Little Joe 
 3       1     1     1        1 Mark Pearson          54     3     3 Little Joe 
 4       1     1     1        1 Escher Lefkoff        28     5     2 Little Joe 
 5       1     1     2        2 Michael Trepp         57     5     2 Jokerz     
 6       1     1     2        2 Bob Matthews          12     1     4 Jokerz     
 7       1     1     2        2 Mark Pearson          54     7     1 Jokerz     
 8       1     1     2        2 Escher Lefkoff        28     3     3 Jokerz     
 9       1     1     3        3 Michael Trepp         57     3     3 Indianapol…
10       1     1     3        3 Bob Matthews          12     1     4 Indianapol…
# ℹ 1,910 more rows
# ℹ 3 more variables: game_id <dbl>, game_category <chr>,
#   game_category_id <dbl>

In each round during these sessions, four players compete on the same pinball machine. The player that comes 1st gets 7 points, the second one gets 5 points, and so on. For example, looking at the first couple of rows above, we can see that when competing on the Little Joe (1972) machine, Bob Matthews won and Michael Trepp ended up last. During the pre-tournament sessions, players rotate to face off against most other players and compete on many different pinball machines. At the end of the sessions, each player’s score is tallied up, and the top 32 players proceed to the final tournament (not included in this dataset).

We’re now ready to model this data using a Plackett-Luce model!

The Plackett-Luce model

Despite the somewhat involved names, both the Bradley–Terry model and the Plackett-Luce model are fairly straightforward. In the simplest case, without covariates, both models assume that each player (or team/item/product) has an underlying skill. In themselves, these skill parameters don’t have any meaning. They only become meaningful when used to come up with the probability of each player winning. Let’s say n players compete, each with their own skill parameter skill_{1, 2, …, n}. Then the probability of each player winning is calculated as

$$p_1 = \frac{\exp({skill}_1)}{\sum(\exp({skill}_{1, 2, …, n}))}, \\[0.7em] p_2 = \frac{\exp({skill}_2)}{\sum(\exp({skill}_{1, 2, …, n}))}, \\[0.7em] … \\[0.5em] p_n = \frac{\exp({skill}_n)}{\sum(\exp({skill}_{1, 2, …, n}))}$$

The exp () makes sure that the result is always positive, even for negative skills, and by dividing by ∑(exp(skill_{1, 2, …, n})) we make the transformed skills sum to one like good probabilities should (this transformation is known as the softmax function). For example, if we have four players with skills c(0.8, 1.0, -1.0, 0.0) the probability distribution p over each player winning would be:

skills <- c(0.8, 1.0, -1.0, 0.0)
p <- exp(skills) / sum(exp(skills))

barplot(p, col = "salmon", ylab = "Probability of winning", names.arg = 
  paste(
    "Player", 1:4, "\nskill:", skills, "\nexp(skill):", round(exp(skills), 2),
    "\np: ", round(p, 2)
  )
)

The sole difference between the Bradley–Terry model and the Plackett-Luce model is in what data they model: Bradley-Terry models the winner of a competition between two players, while Plackett-Luce models the rankings in a competition with several players. It does this by assuming that the performance of each player isn’t influenced by the other players, which allows for modeling rankings as a series of competitions. Perhaps it’s easiest to explain by showing the “generative model” in R, for a competition with our four players from above:

players <- 1:4 # Our four competing players

# Sampling the winner of the bunch
p <- exp(skills[players]) / sum(exp(skills[players]))
first <- sample(players, prob = p, size = 1)

# Excluding the player who came first, who will win second place?
players <- players[players != first] 
p <- exp(skills[players]) / sum(exp(skills[players]))
second <- sample(players, prob = p, size = 1)

# Excluding the players who came first and second, who will win third place?
players <- players[players != second]
p <- exp(skills[players]) / sum(exp(skills[players]))
third <- sample(players, prob = p, size = 1)

# The player who's left gets fourth place
fourth <- players[players != third]

ranking <- c(first, second, third, fourth)
ranking

[1] 4 1 2 3

That’s basically the simple version of the Plackett-Luce model. In our case we, of course, know the rankings of all the competitions in the IFPA 18 Pinball Championship so we don’t want to simulate the data using fixed skill parameters. Instead, we’re now ready to do the Bayesian trick where we assume the player skills are unknown parameters and use the data to figure them out.

A Plackett-Luce model in Stan

While we could work with the tidied match_results in Stan, the model becomes easier to implement if we extract only the parts of the data that we need. Here, that’s the number of players (n_players), the number of rounds (n_round), and a matrix with the 1st, 2nd, 3rd, and 4th player_id for each round (player_ranks).

stan_data <- list(
  n_players = max(match_results$player_id),
  n_rounds = max(match_results$round_id),
  player_ranks = match_results |> 
    select(round_id, rank, player_id) |> 
    pivot_wider(names_from = rank, values_from = player_id) |> 
    arrange(round_id) |>
    select(`1`, `2`, `3`, `4`) |> 
    as.matrix()
)
head(stan_data$player_ranks)

      1  2  3  4
[1,] 12 28 54 57
[2,] 54 57 28 12
[3,] 28 54 57 12
[4,] 64 37  2 62
[5,] 64 62 37  2
[6,] 62  2 37 64

For example, looking at the first couple of rows in stan_data$player_ranks above, we can (again) see that in round one, on the first row, player_id: 12 (that is, Bob Matthews) won and player_id: 57 (Michael Trepp) came last.

Also, while we could implement the likelihood part of this model directly using sum()s and exp()s, a shortcut is to use the categorical_logit() distribution. The parameter to this distribution is a vector which will be softmax transformed (just what we want in the Plackett-Luce model) into the probability that each of the categories represented by this vector will be selected. For example, this sampling statement defines the likelihood that the first player, with skill 0.8 would win: 1 ~ categorical_logit([0.8, 1.0, -1.0, 0.0]).

Given that we’ve got our data nicely packaged up in stan_data and that we can use the categorical_logit() distribution, the Stan model definition becomes fairly straightforward:

plackett_luce_model_code <- "
data {
  int n_players; 
  int n_rounds;
  int player_ranks[n_rounds, 4];
}

parameters {
  vector[n_players] skills;
  real<lower=0> skills_sigma;
}

model {
  // A vector to hold the skills for each round
  // Just to limit the amunt of indexing we'll need to do
  vector[4] round_skills; 
  
  // It's important that the distribution over skills is anchored at a 
  // fixed value, here 0.0. Otherwise, as skills are relative to each other,
  // they wouldn't be identifiable.
  skills ~ normal(0, skills_sigma);
  skills_sigma ~ cauchy(0, 1);
  
  for (round_i in 1:n_rounds) {
    round_skills = skills[player_ranks[round_i]];
    
    // The likelihood of the winner winning out of the 4 players
    1 ~ categorical_logit(round_skills[1:4]);
    // The likelihood of the 2nd place winning out of the 3 remaining players
    1 ~ categorical_logit(round_skills[2:4]);
    // The likelihood of the 3rd place winning out of the 2 remaining players
    1 ~ categorical_logit(round_skills[3:4]);
    // And the remaining 4th place is guaranteed to 'win' against themselves...
  }
}
"

In the above model, I’ve placed a hierarchical distribution on the skills parameters. This works well for this dataset, where there are a lot of players and plenty of data. With less data, one might want to just put a fixed prior here (say, skills ~ normal(0, 1.0)). The model above is somewhat inflexible in that it only works for the case where there are exactly four players in each round, but I hope you can see that it’s straightforward to tweak it to allow for other number of players, as well.

Now we can finally go ahead and fit this model!

library(rstan)

model_fit <- stan(
  model_code = plackett_luce_model_code, data = stan_data, 
  chains = 4, iter = 20000, cores = 4
)

Skimping a bit on checking model convergence, we can, at least, see that both the trace plots and the number of effective samples look reasonable.

traceplot(model_fit, pars = c("skills_sigma", "skills[1]", "skills[2]", "skills[3]"))

model_fit |> 
  extract(pars = c("skills_sigma", "skills[1]", "skills[2]", "skills[3]"), permuted = FALSE) |> 
  monitor()

Inference for the input samples (4 chains: each with iter = 10000; warmup = 5000):

               Q5  Q50 Q95 Mean  SD  Rhat Bulk_ESS Tail_ESS
skills_sigma  0.2  0.3 0.4  0.3 0.1     1     2252     2456
skills[1]    -0.4  0.0 0.3  0.0 0.2     1    37109    14113
skills[2]    -0.5 -0.1 0.2 -0.1 0.2     1    29867    13139
skills[3]    -0.8 -0.4 0.0 -0.4 0.2     1     8267    13065

For each parameter, Bulk_ESS and Tail_ESS are crude measures of 
effective sample size for bulk and tail quantities respectively (an ESS > 100 
per chain is considered good), and Rhat is the potential scale reduction 
factor on rank normalized split chains (at convergence, Rhat <= 1.05).

That was a simple Plackett-Luce model in Stan. But finally, let’s have a look at the fitted Plackett-Luce model of the IFPA 18 World Pinball Championship.

The fitted IFPA 18 World Pinball Championship model

First, let’s extract the player skill parameters. For simplicity I’ll use the median point estimates and 95% probability intervals here, rather than working with the full distributions.

skills_summary <- summary(model_fit, pars = "skills")$summary

player_skill <- match_results |> 
  summarise(score = sum(score), .by = c(player_id, player_name)) |>
  arrange(player_id) |>
  mutate(
    median_skill = skills_summary[, "50%"],
    lower_skill = skills_summary[, "2.5%"],
    upper_skill = skills_summary[, "97.5%"]
  ) |> 
  arrange(desc(median_skill))
player_skill

# A tibble: 80 × 6
   player_id player_name              score median_skill lower_skill upper_skill
       <dbl> <chr>                    <dbl>        <dbl>       <dbl>       <dbl>
 1        39 Johannes Ostermeier        138        0.669      0.134        1.28 
 2        28 Escher Lefkoff             130        0.570      0.0811       1.15 
 3        54 Mark Pearson               114        0.362     -0.0724       0.864
 4        47 Keith Elwin                116        0.338     -0.0973       0.851
 5        21 Daniele Celestino Accia…   114        0.327     -0.111        0.835
 6        78 Viggo Löwgren              118        0.307     -0.119        0.804
 7        80 Zach Sharpe                116        0.294     -0.137        0.786
 8        36 Jason Zahler               106        0.240     -0.183        0.722
 9        48 Keri Wing                  108        0.230     -0.184        0.692
10        45 Josh Sharpe                110        0.226     -0.191        0.701
# ℹ 70 more rows

Not surprisingly, we find that Johannes Ostermeier, who ended up winning the whole tournament, also got the highest skill estimate. We can now also plot all the skill estimates:

Plot code

player_skill |> 
  mutate(player_name = fct_reorder(player_name, median_skill)) |>
  ggplot(aes(x = median_skill, y = player_name)) +
  geom_point() +
  geom_errorbarh(aes(xmin = lower_skill, xmax = upper_skill), height = 0) +
  labs(
    title = "Player skill estimates for IFPA 18 World Pinball Championship",
    subtitle = "Posterior medians with 95% probablilty intervals",
    x = "Skill", y = ""
  ) +
  theme_minimal() +
  theme(axis.text.y = element_text(size = 6))

It’s somewhat hard to interpret these skill estimates on their own, but two things to note here:

Despite the large number of rounds played (480), the uncertainty in the skill parameters is large.
Overall, players have very similar skill. This is not so surprising, as these are all top pinball players. If I had competed here, my skill estimate would be far far to the left.

To verify that these skill parameters make some sense, we could also plot them against each player’s final score from the qualifying sessions:

Plot code

player_skill |> 
  ggplot(aes(x = median_skill, y = score)) +
  geom_point() +
  labs(
    title = "Player skill vs final score for IFPA 18 World Pinball Championship",
    x = "Median player skill", y = "Final Score"
  ) +
  theme_minimal()

The final score and the estimated skill are so strongly correlated that one might wonder if there was any point at all in going through the trouble of fitting a Plackett-Luce model. However, we can do much more interesting stuff with the skill estimates than we can with just the scores. For example, we can calculate the probability of players winning in different matchups. Say the top player played against the three players with the lowest skill:

highest_and_lowest_players <- union(
 slice_max(player_skill, median_skill, n = 1),
 slice_min(player_skill, median_skill, n = 3)
)
highest_and_lowest_players

# A tibble: 4 × 6
  player_id player_name         score median_skill lower_skill upper_skill
      <dbl> <chr>               <dbl>        <dbl>       <dbl>       <dbl>
1        39 Johannes Ostermeier   138        0.669       0.134      1.28  
2        77 Vid Kuklec             58       -0.574      -1.12      -0.107 
3        24 Didier Dujardin        56       -0.565      -1.11      -0.109 
4         7 Artur Natorski         62       -0.466      -0.979     -0.0334

skills <- highest_and_lowest_players$median_skill
p <- exp(skills) / sum(exp(skills))

barplot(p, col = "aquamarine", ylab = "Probability of winning", names.arg = 
  paste(highest_and_lowest_players$player_name, "\np: ", round(p, 2))
)

Here, according to this model, Johannes would have a 53% probability of winning when facing Vid, Didier, and Artur. Again, this shows that in a single game of pinball, even when the top player meets the lowest scoring players in the World Pinball Championship, it’s still far from guaranteed that the top player would win. But at the IFPA 18 World Pinball Championship Johannes did go all the way and won the final game as shown in this live stream.

All code for this post can be found in this Quarto markdown file.

Update: Bob Carpenter has published a case study analyzing sushi rating data with an alternative (and faster) Plackett-Luce model in Stan.

CopenhagenR, the 2024 spring season

Sun, 04 Aug 2024 00:00:00 +0200

This is just a post to brag about that the CopenhagenR useR group is alive and kicking, again.

After COVID-19, the group (like so many other meetups) was on hiatus for a couple of years and without an organizer. In 2023, I thought I would try starting it again and, while it took a little while, I’m happy that I got together five great meetups for the spring 2024 season! Here’s a little bit about what went down.

CopenhagenR gratefully acknowledges the R Consortium as a sponsor. Also, a great thanks to Prosa, who generously provide a location for most meetups this spring 2024 season.

• State of the R, the New Stuff - Niels Ole Dam

First out was Niels Ole Dam who, very appropriately, set out to cover what has happened in the R world the last couple of years. His highlights included Quarto, webR, the GT package, and many other things. Check out his very sleek slides here.

• Reproducible Workflows with R and sequencing data - Adrian Geissler

Next out was Adrian Geissler, postdoctoral researcher at the University of Copenhagen. His presentation focused on how to handle data management, reproducible workflows, and large scale computing in the life sciences using R for computation and snakemake for orchestration. Here are the presentation slides and a screencast of the presentation.

• Simplify making shiny apps with teal - Dawid Kałędkowski //
R and Software Freedom - Ramarro Marrone

In this double-header evening, Dawid Kałędkowski kicked things off with showcasing his package Teal — a shiny-based interactive exploration framework for quickly creating reproducible dashboards. Next up, Ramarro Marrone tackled the hot topic of software freedom, and went through which parts of the R world were freer and which could be considered non-free. This talk resulted in a heated debate that continued over the following coffee/cake/beer.

• Visualizing 440 bicycle rides using R - Gregers Kjerulf Dubrow

Gregers Kjerulf Dubrow presented a very personal analysis of all bike trips he made in Copenhagen in 2023, as tracked by the Strava fitness app. The first part of the talk detailed how to import and clean Strava data in R, the second part took a deep dive into the time-location bike data of the more than 440 bicycle rides (including a data anomaly that, in the end, turned out to have had a very real and dangerous cause). The full bike analysis is available on Gregers’ blog.

• Animating a melody as a mathematical object - Charles T. Gray

Rounding off the season, Charles T. Gray, former professional musician turned data scientist, gave us a peek into the musical world through the lens of graphs, nodes, and edges. Her presentation explored animating a midi file as graph using R packages like pyramidi, ggraph, and gganimate. Check out a post-version of her talk on her blog.

Public Pinball Machines per Capita: A new global indicator

Fri, 07 Jun 2024 00:00:00 +0200

There are tons of well-known global indicators. We’ve all heard of gross domestic product, life expectancy, rate of literacy, etc. But, ever since I discovered pinballmap.com, possibly the world’s most comprehensive database of public pinball locations, I’ve been thinking about a potential new global indicator: Public Pinball Machines per Capita. Thanks to Pinball Map’s well-documented public API, this indicator is now a reality!

Here’s how this was put together (and just scroll to the bottom for a CSV file with this indicator for all countries).

Pulling public pinball locations from Pinball Map

Pinball Map is, from what I can discern, the most popular app for finding out where there are arcades and bars with pinball machines. It’s open for anyone to register new pinball locations, but not only that, the app itself is open source, and the data it collects is available through a public API under a permissive licence! Using this API, we will pull essential data for our Public Pinball Machines per Capita indicator: all registered pinball locations and their respective machine counts.

Loading packages

library(httr2) # To interact with the Pinball Map API
library(jsonlite) # To parse the JSON responses
library(tidyverse) # To munch, crunch, and plot the data
library(ggrepel) # For less crowed labels on plots
library(WDI) # To pull in other country-level data
library(maps) # For plotting maps

Code for pulling pinball stats from the Pinball Map API

# We're going to pull a lot of data here, possibly abusing the Pinball Map API,
# a bit. But I'm an active patreon sponsor, so hopefully that's OK...
# Did I mention that they are on patreon? https://www.patreon.com/pinballmap

# Pulls and parses JSON from the given URL
get_req_json <- \(url) {
  request(url)  |> 
    req_perform() |> 
    resp_body_json(simplifyVector = TRUE)
}

# Pulling all regions defined by the Pinball Map API
regions <- get_req_json("https://pinballmap.com/api/v1/regions.json")$regions

# Now looping over the region names and for each name pull down all locations
region_locations <- lapply(regions$name, \(name) {
  url <- paste0("https://pinballmap.com/api/v1/region/", name, "/locations.json")
  get_req_json(url)$locations
})

# Pull down all "regionless" locations. Actually, most locations are regionless.
regionless_locations <- get_req_json(
  "https://pinballmap.com/api/v1/locations.json?regionless_only=true"
)$locations

# Finally, combine it all...
locations <- bind_rows(region_locations, regionless_locations) |> 
  select(name, country, city, lat, lon, num_machines) |> 
  mutate(lat = as.numeric(lat), lon = as.numeric(lon)) |> 
  # ... and order locations from north to south
  arrange(desc(lat))

sample_n(locations, size = 5)

                        name country          city  lat    lon num_machines
1 Arena Lanes Bowling Center      US      Oak Lawn 41.7  -87.7            3
2              Pete's Treats      US Union Springs 42.9  -76.7            1
3         The Summit Windsor      US      Loveland 40.4 -105.0            6
4             Skylark Lounge      US        Denver 39.7 -105.0            2
5         The Escape Gamebar      US       Atlanta 33.9  -84.3            5

The above shows a sample of five out of the 10,330 locations where you can play pinball, as of June 2024. As we have the longitude and latitude we can also figure out that the northernmost place to play pinball is in Rovaniemi, Finland, and the southernmost place is in Woolston, New Zealand.

Code

locations[c(1, nrow(locations)),]

                       name country      city   lat   lon num_machines
1               Kauppayhtiö      FI Rovaniemi  66.5  25.7            2
10330 Fish & Chips On Ferry      NZ  Woolston -43.5 172.7            1

Or, why not just plot all pinball locations on a world map?

Plot code

extreme_locations <- locations |> 
  filter(lat %in% range(lat)) |>
  mutate(display_label = paste(city, country, sep = ", "))

ggplot() +
  geom_polygon(data = map_data("world"), aes(x = long, y = lat, group = group), fill = "lightblue", color = "lightblue3") +
  geom_point(data = locations, aes(x = lon, y = lat), color = "magenta4", size = 1, alpha = 0.50) +
  geom_point(data = extreme_locations, aes(x = lon, y = lat), color = "red2", size = 2) +
  geom_text(data = extreme_locations, aes(x = lon, y = lat, label = display_label), nudge_x = -25) +
  theme_void() +
  ggtitle("Pinball Locations Worldwide (according to pinballmap.com)")

Finally, we can now sum up how many public pinball machines there are in each country, where the USA, unsurprisingly, takes the lead.

Code

pinball_stats <- locations |> 
  group_by(country) |> 
  summarise(
    n_locations = n(),
    n_machines = sum(num_machines)) |> 
  arrange(desc(n_machines))
pinball_stats

# A tibble: 65 × 3
   country n_locations n_machines
   <chr>         <int>      <int>
 1 US             7831      32287
 2 CA              511       1765
 3 AU              427       1247
 4 DE              129       1099
 5 FR              247        707
 6 SE               79        692
 7 GB              160        500
 8 FI               98        496
 9 NL               69        461
10 JP               86        351
# ℹ 55 more rows

Calculating Public Pinball Machines per Capita

Knowing how many public pinball machines there are in each country isn’t enough, we also need to consider the size of the population. Thanks to the WDI package it’s easy to pull this, and any other indicators you fancy, from the World Bank Open Data and to calculate the number of Public Pinball Machines per Capita (here per million people).

Code for pulling World Development Indicators

country_stats_by_year = WDI(
  indicator = c(
    "NY.GDP.PCAP.CD", "SP.POP.TOTL", "SP.DYN.LE00.IN", 
    "SP.DYN.TFRT.IN", "IT.NET.USER.ZS", "AG.LND.FRST.ZS"
  ), 
  extra = TRUE, 
  latest = 1
)

country_stats <- country_stats_by_year |> 
  arrange(country, year) |> 
  group_by(country) |>
  # Keep the latest indicator for each country
  summarize(across(everything(), \(x) last(na.omit(x)))) |>
  select(
    country_name = country, 
    country_code = iso2c,
    gdp_per_capita = NY.GDP.PCAP.CD,
    population = SP.POP.TOTL,
    life_expectancy = SP.DYN.LE00.IN, 
    births_per_woman = SP.DYN.TFRT.IN,
    internet_usage_perc = IT.NET.USER.ZS,
    forest_coverage_perc = AG.LND.FRST.ZS
  )

Code for calculating Public Pinball Machines per Capita

pinball_country_stats <- country_stats |> 
  # Let's keep only larger countries
  filter(population > 500000) |> 
  inner_join(pinball_stats, by = join_by(country_code == country)) |>
  mutate(
    n_locations_per_million_capita = round(n_locations / population * 1000000, 3),
    n_machines_per_million_capita = round(n_machines / population * 1000000, 3)) |>
  arrange(desc(n_machines_per_million_capita))

select(pinball_country_stats, 
  country_name, population, n_machines, n_machines_per_million_capita
)

# A tibble: 58 × 4
   country_name  population n_machines n_machines_per_million_capita
   <chr>              <dbl>      <int>                         <dbl>
 1 United States  333287557      32287                          96.9
 2 Finland          5556106        496                          89.3
 3 Sweden          10486941        692                          66.0
 4 Denmark          5903037        323                          54.7
 5 Norway           5457127        266                          48.7
 6 Australia       26005540       1247                          48.0
 7 Canada          38929902       1765                          45.3
 8 New Zealand      5124100        171                          33.4
 9 Switzerland      8775760        267                          30.4
10 Netherlands     17700982        461                          26.0
# ℹ 48 more rows

Now, there’s out new global indicator! Looks like the USA is still in the lead, but now the Nordic countries have bubbled up as some of the countries with the highest pinball density.

Plot code

pinball_country_stats |> 
  head(10) |> 
  mutate(
    country_name = forcats::fct_reorder(country_name, n_machines_per_million_capita),
    n_machines_per_million_capita = round(n_machines_per_million_capita, 1)
  ) |>
  ggplot(aes(x = n_machines_per_million_capita, y = country_name)) +
    geom_col(fill = "lightgreen") +
    geom_text(aes(label = n_machines_per_million_capita), hjust = 1.2) +
    labs(
      x = "Number of machines per million capita",
      y = "Country",
      title = "Top 10 countries by number of public pinball machines per million capita"
    )

Public Pinball Machines per Capita VS other indicators

Let’s have a look at how Public Pinball Machines per Capita compares to some other indicators. How about Life Expectancy?

Plot code

ggplot(pinball_country_stats, aes(x = life_expectancy, y = n_machines_per_million_capita)) +
  geom_label_repel(aes(label = country_name), fill = "lightblue",  max.overlaps = Inf, box.padding  = -0.2) +
  scale_x_log10(labels = scales::label_comma(), limits = c(67, NA)) +
  scale_y_log10(labels = scales::label_comma()) +
  labs(
    x = "Life expectancy at birth (years)",
    y = "Number of machines per million capita",
    title = "Number of Public Pinball Machines per Capita vs life expectancy"
  )

So maybe playing pinball actually makes you live longer! What’s that thing they say about correlation, now again… Or what about the fertility rate (the average number of births per woman)?

Plot code

ggplot(pinball_country_stats, aes(x = births_per_woman, y = n_machines_per_million_capita)) +
  geom_label_repel(aes(label = country_name), fill = "lightcoral",  max.overlaps = Inf, box.padding = -0.2) +
  scale_x_log10(labels = scales::label_comma()) +
  scale_y_log10(labels = scales::label_comma()) +
  labs(
    x = "Fertility rate (no. births per woman)",
    y = "Number of machines per million capita",
    title = "Number of Public Pinball Machines per Capita vs fertility rate"
  )

Nope, no clear relationship there. Actually, out of all the indicators I looked through, the one with the highest correlation to Public Pinball Machines per Capita was…

Plot code

ggplot(pinball_country_stats, aes(x = gdp_per_capita, y = n_machines_per_million_capita)) +
  geom_label_repel(aes(label = country_name), fill = "lightgreen", max.overlaps = Inf, box.padding  = -0.2) +
  geom_smooth(method = "lm", se = FALSE, color = "#d03030aa") +
  scale_x_log10(labels = scales::label_comma()) +
  scale_y_log10(labels = scales::label_comma()) +
  labs(
    x = "GDP per capita (in USD)",
    y = "Number of machines per million capita",
    title = "Number of Public Pinball Machines per Capita vs GDP per Capita"
  )

… GDP per Capita. This shouldn’t surprise anyone who’s ever looked into buying a pinball machine and walked away in shock having learned that a new machine would set you back $8000, at least. Still, the correlation between these two indicators is strikingly high:

Code

cor(
  log(pinball_country_stats$n_machines_per_million_capita),
  log(pinball_country_stats$gdp_per_capita)
)

[1] 0.815

With such a strong correlation with GDP per Capita, it can be interesting to look at the residuals of the linear regression line above. That is, what’s left after the influence of GDP per Capita has been “accounted” for (and I can’t stress the quotes enough here, as we’re not really accounting for anything).

Plot code

lm_model <- lm(log(n_machines_per_million_capita) ~ log(gdp_per_capita), data = pinball_country_stats)
pinball_country_stats$residual <- residuals(lm_model)

ggplot(pinball_country_stats, aes(x = gdp_per_capita, y = residual)) +
  geom_label_repel(aes(label = country_name), fill = "lightgreen",  max.overlaps = Inf, box.padding = -0.2) +
  geom_smooth(method = "lm", se = FALSE, color = "#d03030aa") +
  scale_x_log10(labels = scales::label_comma()) +
  labs(
    x = "GDP per capita (in USD)",
    y = "Residual",
    title = "Residual after accounting for GDP per capita"
  )

Here Hungary and Croatia show up as being relative pinball fanatics, considering their GDP per Capita. While Singapore and Luxembourg couldn’t care less for the silver ball. If you want to take a look yourself, here’s a CSV file with the full Public Pinball Machines per Capita dataset:

Code

pinball_country_stats |> 
  select(country_name, country_code, population, n_locations, n_machines,  n_machines_per_million_capita, gdp_per_capita) |>
  write_csv("public_pinball_machines_per_capita_2024.csv")

public_pinball_machines_per_capita_2024.csv

Caveats: This indicator is mostly a joke, 100% depends on the completeness of Pinball Map, and countries without a single registered pinball machine are excluded.

Modeling my pinball scores

Sun, 24 Mar 2024 00:00:00 +0100

Upon discovering that the tiny town I live in has a pinball arcade with over 40 tables (!), I got a bout of pinball fever. I fancy myself a fairly accomplished video game player, but was disappointed to discover that my ability to keep Mario alive didn’t translate to preventing the pinball from draining. Assuming I just needed a bit of practice, I downloaded a virtual version of Fish Tales — a fun, fishing-based table from 1992 — and began practicing. Here’s the data and quick analysis of how I improved over 100 games of Fish Tales.

(By the way, if you didn’t know, the hobbyist pinball emulation scene is amazing. Almost every real pinball table from the last 70 years has been painstakingly 3D-model by someone and is available completely for free, but completely not legally…)

In total, I played 100 games over the course of 10 sessions. The game ran perfectly on my 2022 MacBook Pro at 120 FPS, with non-noticeable input latency. I made sure to learn all the rules of Fish Tales (even though Fish Tales is considered a simple game, the ruleset is non-obvious and opaque), and I played in a distraction-free environment (that is, when the kids weren’t around). And yet, my scores improved like this:

Plot code

library(tidyverse)
library(ggside)
library(atsar)
library(rstan)
library(ggpubr)

scores <- read_csv("fish_tale_scores.csv")
scores |> 
  ggplot(aes(x = game, y = score)) +
  geom_point() +
  scale_y_log10(labels = scales::comma) +
  theme_minimal() +
  labs(title = "Pinball scores by game", x = "Game", y = "Score")

Here the scores (raw data available here) are shown on a log scale, as the score in Fish Tale, like in many other pinball games, sometimes snowball and sometimes never go anywhere.

Looking at my score trajectory, it might be easy to dismiss as not much of a trajectory at all. However, maybe we’re just lacking the right model here. But how to model data like this? Maybe a simple linear trend, while hard to justify from a theoretical perspective, could work here?

Plot code

scores |> 
  ggplot(aes(x = game, y = score)) +
  geom_point() +
  geom_smooth(method = 'lm', formula = 'y ~ x', se=FALSE) +
  scale_y_log10(labels = scales::comma) +
  theme_minimal() +
  labs(title = "Pinball scores by game + Linear model", x = "Game", y = "Score")

On the other hand, as we’re looking to model an improvement in proficiency, a sigmoid ( ∫ ) model might be more appropriate. That is, I’m starting from a baseline, then I’m seeing an accelerated rate of improvement, which eventually tapers off as I reach my “performance plateau”.

Plot code

scores |> 
  ggplot(aes(x = game, y = score)) +
  geom_point() +
  geom_smooth(
    method = 'nls', formula = 'y ~ SSlogis(x, Asym, xmid, scal)', se = FALSE
  ) +
  scale_y_log10(labels = scales::comma) +
  theme_minimal() +
  labs(title = "Pinball scores by game + Sigmoid model", x = "Game", y = "Score")

Hmm, that plateau came quickly… Nevertheless, both these models are missing what every good statistical model needs: a good measure of uncertainty and a computationally expensive model fitting procedure. Maybe a Bayesian state-space time series model is what we need here!

Model code

library(atsar)
ss_model <- fit_stan(
  scores$log2_score, 
  model_name = "ss_rw", 
  est_drift=FALSE, 
  mcmc_list=list(n_mcmc=10000, n_burn=2000, n_thin=1, n_chain=3)
)

Plot code

bayes_pred <- 2^rstan::summary(ss_model)$summary |> 
  as_tibble(rownames = "param") |> 
  filter(str_starts(param, "pred")) |> 
  mutate(game = as.numeric(str_extract(param, "\\d+"))) |>
  select(game, lower = `2.5%`,  pred = `50%`, upper = `97.5%`)

scores |> 
  ggplot(aes(x = game, y = score)) +
  geom_point() +
  geom_smooth(se=FALSE, method = 'loess', formula = 'y ~ x') +
  geom_ribbon(
    data = bayes_pred,
    aes(x = game, y = pred, ymin = lower, ymax = upper), 
    alpha = 0.3
  ) +
  scale_y_log10(labels = scales::comma) +
  theme_minimal() +
  labs(
    title = "Pinball scores by game + Bayesian state space model", 
    x = "Game", y = "Score"
  )

Or we could just go full 101 psychology statistics and force this data to submit to a t-test, using violence if necessary.

Plot code

scores |> 
  mutate(Group = ifelse(game <= 50, "Games 1 to 50", "Games 51 to 100") ) |> 
  ggboxplot(
    x = "Group", y = "score",
    color = "Group", palette = "jco",
    add = "jitter",
    title="Pinball scores by game, psychology stats-style"
  ) +
  scale_y_log10(labels = scales::comma) +
  stat_compare_means(method = "t.test")

Despite there being at least seven things abhorrently wrong with this approach, we still get a p-value that no amount of p-hackery can fix.

I asked on Mastodon what a good model could be for this type of data and Michael Szell promptly responded:

Lognormal, absolutely, that makes a lot of sense. But the stationary assumption, that hurts… and, yet, it’s hard to argue against:

Plot code

breaks = c(3000000, 10000000, 30000000, 100000000)

scores |> 
  ggplot(aes(x = game, y = log(score))) +
  geom_point() +
  scale_y_continuous(breaks = log(breaks), labels=scales::label_comma()(breaks)) +
  theme_minimal() +
  labs(title = "Pinball scores by game + Indepented (😭) Normal distribution (log scale)", x = "Game", y = "Score") +
  geom_ysidehistogram(bins = 12) +
  geom_ysidefunction(fun = \(x) 45 * dnorm(x, mean(log(scores$score)), sd(log(scores$score))), colour = "red") +
  theme(ggside.panel.scale.y = 0.3)

Given that we’ve now nailed the statistical model, I don’t need anymore feedback here. But if you know how I could improve my pinball game, please don’t hesitate to pester me over at @rabaath@fosstodon.org.

Why pandas feels clunky when coming from R

Tue, 20 Feb 2024 00:00:00 +0100

Five years ago I started a new role and I suddenly found myself, a staunch R fan, having to code in Python on a daily basis. Working with data, most of my Python work involved using pandas, the Python data frame library, and initially I found it quite hard and clunky to use, being used to the silky smooth API of R’s tidyverse. And you know what? It still feels hard and clunky, even now, 5 years later!

But, what seems even harder, is explaining to “Python people” what they are missing out on. From their perspective, pandas is this fantastic tool that makes Data Science in Python possible. And it is a fantastic tool, don’t get me wrong, but if you, like me, end up in many “pandas is great, but…”-type discussions and are lacking clear examples to link to; here’s a somewhat typical example of a simple analysis, built from the ground up, that flows nicely in R and the tidyverse but that becomes clunky and complicated using Python and pandas.

Let’s first step through a short analysis of purchases using R and the tidyverse. After that we’ll see how the same solution using Python and pandas compares.

Analyzing `purchases` in R

We’ve been given a table of purchases with different amounts, where the customer could have received a discount and where each purchase happened in a country. Finance now wants to know: How much do we typically sell in each country? Let’s read in the data and take a look:

library(tidyverse)

purchases <- read_csv("purchases.csv")
purchases |> head()

# A tibble: 6 × 3
  country amount discount
  <chr>    <dbl>    <dbl>
1 USA       2000       10
2 USA       3500       15
3 USA       3000       20
4 Canada     120       12
5 Canada     180       18
6 Canada    3100       21

Now, without bothering with printing out the intermediate results, here’s how a quick pipeline could be built up, answering Finance’s question.

“How much do we sell..? Let’s take the total sum!”

purchases$amount |> sum()

“Ah, they wanted it by country…”

purchases |>
  group_by(country) |>
  summarize(total = sum(amount))

“And I guess I should deduct the discount.” (#👈/👆/👇 marks lines that changed/moved)

purchases |> 
  group_by(country) |> 
  summarize(total = sum(amount - discount)) #👈

“Oh, and Maria asked me to remove any outliers. Let’s remove everything 10x larger than the median.”

purchases |>
  filter(amount <= median(amount) * 10) |> #👈
  group_by(country) |> 
  summarize(total = sum(amount - discount))

“I probably should use the median within each country. Prices are quite different across the globe…”

purchases |>
  group_by(country) |>                     #👆
  filter(amount <= median(amount) * 10) |> #👇
  summarize(total = sum(amount - discount))

# A tibble: 11 × 2
   country   total
   <chr>     <dbl>
 1 Australia   540
 2 Brazil      414
 3 Canada      270
 4 France      450
 5 Germany     513
 6 India       648
 7 Italy       567
 8 Japan       621
 9 Spain       594
10 UK          432
11 USA        8455

“And we’re done, let’s go for second breakfast!”

Analyzing `purchases` in Python

We’re now going to take a look at how this little analysis would look in Python and pandas. One complication here is that pandas can be written in many different styles; it’s not like in the tidyverse where there’s often one obvious way to do something. Here we’re opting for writing pandas using the fluent method chaining API, as opposed to using the more “imperative” approach that results in a lot of repeats of df and statements like df[df["this"] == "that"] = calc_some(df["other_thing"]). We’re also opting for always returning a table with all the data in the data frame proper. We don’t want data hidden away in the index (that is, pandas’ really advanced system for row and column names). Having data in the index is generally annoying when one wants to process the data further or when turning the data into plots.

Again, let’s step through the R version of the analysis, and below let’s write the corresponding pandas code. Again, #👈/👆/👇 marks lines that have changed/moved.

Reading in the data

# R
library(tidyverse)

purchases <- read_csv("purchases.csv")
purchases |> head()

# A tibble: 6 × 3
  country amount discount
  <chr>    <dbl>    <dbl>
1 USA       2000       10
2 USA       3500       15
3 USA       3000       20
4 Canada     120       12
5 Canada     180       18
6 Canada    3100       21

This is basically the same in pandas. So far so good!

# Python 
import pandas as pd

purchases = pd.read_csv("purchases.csv")
purchases.head()

  country  amount  discount
0     USA    2000        10
1     USA    3500        15
2     USA    3000        20
3  Canada     120        12
4  Canada     180        18

“How much do we sell..? Let’s take the total sum!”

# R
purchases$amount |> sum()

[1] 17210

This is also similar in pandas:

# Python 
purchases["amount"].sum()

(However, note that this method, pandas.Series.sum(), is not the same as pandas.DataFrame.sum(), or numpy.sum(), or the built-in sum function, each of which has different arguments and behaviors. In R, it’s always the same built-in sum() function.)

“Ah, they wanted it by country…”

purchases |>
  group_by(country) |>
  summarize(total = sum(amount))

# A tibble: 11 × 2
   country   total
   <chr>     <dbl>
 1 Australia   600
 2 Brazil      460
 3 Canada     3400
 4 France      500
 5 Germany     570
 6 India       720
 7 Italy       630
 8 Japan       690
 9 Spain       660
10 UK          480
11 USA        8500

This is also very similar in Python:

# Python 
(purchases
  .groupby("country")["amount"]
  .sum()
)

country
Australia     600
Brazil        460
Canada       3400
France        500
Germany       570
India         720
Italy         630
Japan         690
Spain         660
UK            480
USA          8500
Name: amount, dtype: int64

Ah, but here we actually need to do more work. The output has now turned into a pandas.Series, not a data frame, and country got moved to the index. We can solve this by using .reset_index(). Also, we’re not happy with the amount column name, but .sum() does not allow us to specify a different name. Instead of .sum() we can use the .agg() method to get around this:

# Python 
(purchases
  .groupby("country")
  .agg(total=("amount", "sum")) #👈
  .reset_index()                #👈
)

      country  total
0   Australia    600
1      Brazil    460
2      Canada   3400
3      France    500
4     Germany    570
5       India    720
6       Italy    630
7       Japan    690
8       Spain    660
9          UK    480
10        USA   8500

(Another thing that’s new here is that we now have to pass the sum method as a "sum" string.)

“And I guess I should deduct the discount.”

A tiny change in R…

# R
purchases |> 
  group_by(country) |> 
  summarize(total = sum(amount - discount)) #👈

# A tibble: 11 × 2
   country   total
   <chr>     <dbl>
 1 Australia   540
 2 Brazil      414
 3 Canada     3349
 4 France      450
 5 Germany     513
 6 India       648
 7 Italy       567
 8 Japan       621
 9 Spain       594
10 UK          432
11 USA        8455

… but a large change in Python. The .agg() method can only aggregate single columns. When this is not the case we have to fall back on .apply(), which can handle any type of aggregation. As we want to avoid a column with the enigmatic name 0, we also have to use .rename() to get back to total, again.

# Python 
(purchases
  .groupby("country")
  .apply(lambda df: (df["amount"] - df["discount"]).sum()) #👈
  .reset_index()
  .rename(columns={0: "total"})                            #👈
)

      country  total
0   Australia    540
1      Brazil    414
2      Canada   3349
3      France    450
4     Germany    513
5       India    648
6       Italy    567
7       Japan    621
8       Spain    594
9          UK    432
10        USA   8455

“Oh, and Maria asked me to remove any outliers.”

purchases |>
  filter(amount <= median(amount) * 10) |> #👈
  group_by(country) |> 
  summarize(total = sum(amount - discount))

# A tibble: 11 × 2
   country   total
   <chr>     <dbl>
 1 Australia   540
 2 Brazil      414
 3 Canada      270
 4 France      450
 5 Germany     513
 6 India       648
 7 Italy       567
 8 Japan       621
 9 Spain       594
10 UK          432
11 USA        1990

This is also a simple change in Python, using .query():

# Python 
(purchases
  .query("amount <= amount.median() * 10") #👈
  .groupby("country")
  .apply(lambda df: (df["amount"] - df["discount"]).sum())
  .reset_index()
  .rename(columns={0: "total"})
)

      country  total
0   Australia    540
1      Brazil    414
2      Canada    270
3      France    450
4     Germany    513
5       India    648
6       Italy    567
7       Japan    621
8       Spain    594
9          UK    432
10        USA   1990

(But why is it called .query() when it filters? And why can’t we use DataFrame.filter() instead? Ah, that only filters on the index names. And why do we suddenly have to pass in Python code as a string? Ah, it’s actually not Python, but a language that’s similar to Python. Of course, all these questions have explanations, yet I still can never really remember what I’m allowed to put in a .query() string. Instead of .query() we could use .loc[], but then we need to do a fair bit of typing: .loc[lambda df: df["amount"] <= df["amount"].median() * 10]. Compare that to the R version filter(amount <= median(amount) * 10))

“I probably should use the median within each country”

# R 
purchases |>
  group_by(country) |>                     #👆
  filter(amount <= median(amount) * 10) |> #👇
  summarize(total = sum(amount - discount))

# A tibble: 11 × 2
   country   total
   <chr>     <dbl>
 1 Australia   540
 2 Brazil      414
 3 Canada      270
 4 France      450
 5 Germany     513
 6 India       648
 7 Italy       567
 8 Japan       621
 9 Spain       594
10 UK          432
11 USA        8455

What’s just swapping two lines in R, becomes much more involved in Python. The reason for this is that .groupby() doesn’t return a pandas.DataFrame, it returns a pandas.api.typing.DataFrameGroupBy object, which doesn’t have the same set of methods as a regular data frame. Especially, it doesn’t have .query() nor .loc[]. There are two solutions here: A first solution is that we fall back on .apply(), this time returning a filtered version of each group, but then we also need to remove the country index completely with .reset_index(drop=True) as the filtered purchases already has a country column:

# Python 
(purchases
  .groupby("country")                                               #👈
  .apply(lambda df: df[df["amount"] <= df["amount"].median() * 10]) #👈
  .reset_index(drop=True)                                           #👈
  .groupby("country")
  .apply(lambda df: (df["amount"] - df["discount"]).sum())
  .reset_index()
  .rename(columns={0: "total"})
)

      country  total
0   Australia    540
1      Brazil    414
2      Canada    270
3      France    450
4     Germany    513
5       India    648
6       Italy    567
7       Japan    621
8       Spain    594
9          UK    432
10        USA   8455

(The fact that grouped and regular pandas data frames have different APIs is a constant source of confusion, to me. One example of this is .filter(), where DataFrameGroupBy.filter() does something completely different from DataFrame.filter(). And none of them actually filter away values!)

A second solution is that we first calculate the median amount per country and assign it to each row in purchases. The upside is now that we can continue to use .query(), but at the cost of introducing both .assign() and .transform() into the mix.

# Python 
(purchases
  .assign(country_median=lambda df:                         #👈
      df.groupby("country")["amount"].transform("median")   #👈
  )
  .query("amount <= country_median * 10")                   #👈                   
  .groupby("country")
  .apply(lambda df: (df["amount"] - df["discount"]).sum())
  .reset_index()
  .rename(columns={0: "total"})
)

      country  total
0   Australia    540
1      Brazil    414
2      Canada    270
3      France    450
4     Germany    513
5       India    648
6       Italy    567
7       Japan    621
8       Spain    594
9          UK    432
10        USA   8455

Compare this with, again, the final R solution:

purchases |>
  group_by(country) |>
  filter(amount <= median(amount) * 10) |>
  summarize(total = sum(amount - discount))

This solution is not only shorter but also contains less ‘boilerplate’ code, such as lambda, reset_index, etc. The journey to the R solution was more straight forward and we could build it up one step at a time. With pandas, we often had to backtrack and switch out parts of the intermediate solution.

So, what’s your point?

My point is that, if you’re a “Python person”, then pandas is a great tool and people with extensive R experience may find working with pandas frustrating for valid reasons. Show them some compassion!

You might think my purchases analysis was just a little toy example, selected to highlight the clunkiness of the pandas API. And yes, partially, but my experience is that with larger, real-world code the problems with the pandas API, outlined in this post, remains. That is, pandas feels clunky when coming from R because:

The naming of methods and arguments is often confusing (.filter() doesn’t filter values. Will .sum(axis=1) sum the rows or the columns?)
Different methods are available for grouped and non-grouped data frames and methods with the same name can do very different things (for example DataFrame.filter() and DataFrameGroupBy.filter()).
Many convenience function are missing from pandas, which means you’ll have to code them from scratch. For instance, moving the year to be the first column is df |> relocate(year) in the tidyverse. It’s df[["year"] + [col for col in df.columns if col != "year"]] in pandas.
Pandas will constantly move columns into the index, and you’ll have to work hard to get that data out again. You’ll be typing .reset_index() many many times.

Baking the cake dataset cake

Mon, 12 Feb 2024 00:00:00 +0100

Now that I’ve got my hands on the source of the cake dataset I knew I had to attempt to bake the cake too. Here, the emphasis is on attempt, as there’s no way I would be able to actually replicate the elaborate and cake-scientifically rigorous recipe that Cook followed in her thesis. Skipping things like beating the eggs exactly “125 strokes with a rotary beater” or wrapping the grated chocolate “in waxed paper, while white wrapping paper was used for the other ingredients”, here’s my version of Cook’s Recipe C, the highest rated cake recipe in the thesis:

~~ Frances E. Cook's best chocolate cake ~~

- 112 g butter (at room temperature, not straight from the fridge!)
- 225 g sugar
- ½ teaspoon vanilla, extract or sugar.
- ¼ teaspoon salt
- 96 g eggs, beaten (that would be two small eggs)
- 57 g dark chocolate (regular dark chocolate, not the 85% masochistic kind)
- 122 g milk (that is, ½ a cup)
- 150 g wheat flour
- 2½ teaspoon baking powder

1. In a bowl mix together the butter, sugar, vanilla, and salt 
   using a hand or stand mixer.
2. Add the eggs and continue mixing for another minute.
3. Melt the chocolate in a water bath or in a microwave oven. 
   Add it to the bowl and mix until it's uniformly incorporated.
4. Add the milk and mix some more.
5. In a separate bowl combine the flour and the baking powder.
   Add it to the batter, while mixing, until it's all combined evenly.
6. To a "standard-sized" cake pan (around 22 cm/9 inches in diameter)
   add a coating of butter and flour to avoid cake stickage.
7. Add the batter to the pan and bake in the middle of the oven
   at 225°C (437°F) for 24 minutes.

Here’s now some notes, photos, and data on how the actual cake bake went down.

Some notes from a cake bake

If you do attempt this recipe, I must warn you that this cake is baked at an unusually high temperature, as this resulted in the best rated cake in Cook’s thesis. However, at that temperature my cake came out just a tiny bit scorched. Otherwise, I do believe this is a fairly standard cake recipe.

But! I could not be satisfied with baking just the one cake recipe above. As the whole point of Cook’s thesis was to explore the effect of baking temperature I, of course, had to explore the same! Cook baked 150 different cakes over six different temperatures, but that was too ambitious for a Saturday afternoon, so I picked just three of those:

175°C (347°F) for 39 minutes
200°C (392°F) for 31½ minutes
225°C (437°F) for 24 minutes

And then I baked the same cake three times. I was planning to make a nicely staged photo of all the ingredients, but forgot about that completely, so here’s instead how my real-life messy cake bake looked:

Even though I did bake three cakes at different temperatures, I cannot stress enough that there’s no way I even came close to replicate a crumb of Cook’s original study. But, that didn’t stop me from making some pretend-comparisons with her work. One graph from the original study I particularly liked, was the photo of actual cakes baked at different temperatures:

And below are the results of my endeavors where, sadly, all my cakes looks like Cook’s no. 1 above.

In the cake dataset the main outcome variable is the angle at which the cake breaks. But lacking the advanced breaking angle apparatus Cook used, there was no way I could get a good cake break angle measure. Well, at least I broke my cakes:

What Cook did, and what I actually also could do, was to rate the three different cakes. As I celebrated my birthday, I had a small panel of cake eaters readily available. Six participants (average age 29.0, SD=28.7) were given a nibble of each of the three cakes (baked at 175°C, 200°C, and 225°C). The participants were asked to rate the overall eating quality of each cake on a scale from 1 (“completely awful”) to 10 (“cake perfection”). After the rating session concluded, the participants were awarded with more cake.

Unfortunately, the results were somewhat inconclusive, as the participants rate all cakes fairly highly, with no clear preference for cakes baked at higher temperatures:

Expand for the full cake rating dataset

subject,age,temperature,score
1,72,175,5
1,72,200,6
1,72,225,6
2,69,175,4
2,69,200,5
2,69,225,6
3,5,175,8
3,5,200,7
3,5,225,9
4,8,175,9
4,8,200,10
4,8,225,8
5,35,175,7
5,35,200,6
5,35,225,7
6,39,175,7
6,39,200,7
6,39,225,7

But, to give a positive spin to this result, it seems like Frances E. Cook’s best chocolate cake recipe results in highly rated cakes at any baking temperature!

The source of the cake dataset

Sun, 28 Jan 2024 00:00:00 +0100

In statistics, there are a number of classic datasets that pop up in examples, tutorials, etc. There’s the iris dataset (just type iris in your nearest R prompt), the Palmer penguins (the modern iris alternative), the titanic dataset(s) (I hope you’re not a guy in 2nd or 3rd class!), etc. While looking for a dataset to illustrate a simple hierarchical model I stumbled upon another one: The cake dataset in the lme4 package which is described as containing “data on the breakage angle of chocolate cakes made with three different recipes and baked at six different temperatures [as] presented in Cook (1938)¹”. For me, this raised a lot of questions: Why measure the breakage angle of chocolate cakes? Why was this data collected? And what were the recipes?

I assumed the answers to my questions would be found in Cook (1938)¹ but, after a fair bit of flustered searching, I realized that this scholarly work, despite its obvious relevance to society, was nowhere to be found online. However, I managed to track down that there existed a hard copy at Iowa State University, accessible only to faculty staff.

The tl;dr: After receiving help from several kind people at Iowa State University, I received a scanned version of Frances E. Cook’s Master’s thesis, the source of the cake dataset. Here it is:

Cook, Frances E. (1938). Chocolate cake: I. Optimum baking temperature. (Master’s thesis, Iowa State College).

It contains it all, the background, the details, and the cake recipes! Here’s some more details on the cake dataset, how I got help finding its source, and, finally, the cake recipes.

The `cake` dataset

The cake dataset can be found in the lme4 package with the following description:

Data on the breakage angle of chocolate cakes made with three different recipes and baked at six different temperatures. This is a split-plot design with the recipes being whole-units and the different temperatures being applied to sub-units (within replicates). The experimental notes suggest that the replicate numbering represents temporal ordering.

So for each of the $3 \times 6 = 18$ recipe and temperature combinations, Cook made 15 (!) replicates, resulting in a total of $3 \times 6 \times 15 = 270$ cakes/datapoints. Here’s the first couple of rows:

replicate	recipe	angle	temperature
1	A	42	175
1	A	46	185
1	A	47	195
1	A	39	205
1	A	53	215
1	A	42	225
1	B	39	175
…	…	…	…

If you want the full dataset without getting lme4 here’s the cake dataset as a CSV file. Plotting this dataset we can quickly conclude that the cake breakage angle increases as a function of baking temperature:

While the cake dataset is found in lme4, the original source is Cochran and Cox’s book Experimental designs². But what’s the original original source? Any why measure the cake breakage angle?

The hunt for the source of the cake dataset

From the lme4 documentation I knew that the cake dataset came from the study by Cook (1938)¹ but no amount of Googling, Binging, nor Google Scholaring resulted in any trace of a digital copy. I did find that physical copies existed at Iowa State University and at Cornell, which presented a problem for me, being physically in Sweden. There was an option to request that the copy would be digitized, an option available to Iowa State faculty only.

Twitter to the rescue, I thought, and fired away a tweet that got a tumbleweed response. But, final proof for me that Twitter is dying, the same request on Mastodon ( come join me!) was an astounding success!

I got many helpful responses, with several pointing me directly at Iowa State staff that might help me out. Like this one from Karl Broman:

A quick e-mail later and I got this very encouraging e-mail from Dan Nettleton at the Department of Statistics, Iowa State:

He recruited the help of Philip M. Dixon, Department of Statistics, and Megan O’Donnell, Research Data Services Lead, and after a couple of days more I got this from Megan:

She (the busy Research Data Services Lead with a looming deadline) is apologizing to me (the random Swede with an eccentric cake thesis digitization request) that it took a few days to get me everything I asked for!? Still, the feeling of shame for having wasted Megan’s time was overshadowed by joy. Attached to the e-mail was, of course, also the full Master’s thesis of Frances E. Cook from 1938: Chocolate cake: I. Optimum baking temperature..

Highlights from Chocolate cake: I. Optimum baking temperature

Reading the thesis, it’s immediately clear that the breakage angle of cakes wasn’t the main focus. Instead, Cook was after some “accurate scientific information” on the optimum baking temperature for chocolate cake.

To figure out what was the best chocolate cake, she needed a battery of measures of cake goodness, such as cake tenderness, as measured objectively by its breaking angle. There were also several subjective measures, as found in the “Score Card for Cake” on page 50.

But how was the breaking angle of the cakes measured? In the thesis, we learn that “The tenderness of the cake was tested with the breaking angle apparatus as described by Myers (1936)³”, but there are no images that show us how it functioned. While I can’t find an online trace of Myers (1936)³ I do believe I’ve found a description of this very apparatus in Lowe and Nelson (1939)⁴!

From an outsider perspective, not being active in the field of culinary research myself, the thesis of Cook comes off as being fantastically serious about cake. I especially adore that it includes photographs of all the cakes:

But, to be fair, in the photos above, you can clearly see how the baking temperature influences the volume of the cake.

The cake recipes

Like in a food blog that has been SEOed to death, here, finally, at the very end, are the cake recipes. I might not be the most experienced cake maker, but this is by far the most complicated chocolate cake recipe I’ve ever seen.

Now, for the baking time and temperature above you get a matrix of options. The answer for which option to pick can be found a bit further down in table XV, which displays the total scores for each option.

The winner, when considering the dimensions texture, tenderness, velvetiness and eating quality, was Recipe C with a baking temperature of 225 C° (437 F°) for 24 minutes. I’m no cake scientist, but if a linear model is to be believed when extrapolating outside of the range of the dataset (always a good idea) this cake would be delicious when baked in a pizza oven!

Cook, Frances E. (1938). Chocolate cake: I. Optimum baking temperature. (Master’s thesis, Iowa State College). ↩︎ ↩︎ ↩︎
Cochran, W. G., and Cox, G. M. (1957) Experimental designs, 2nd Ed. New York, John Wiley & Sons. ↩︎
Myers, Elizabeth. (1936). Plain Cake X. Effect of two temperatures of ingredients at time of combining on fat distribution as determined by microscopical examination. (Unpublished thesis, Iowa State College) ↩︎ ↩︎
Lowe, Belle and Nelson, P. Mabel (1939) The physical and chemical characteristics of lards and other fats in relation to their culinary value. II. Use in plain cake. Iowa Agrigultural Research Bulletin 255. ↩︎

Get a Git repo where your team can stow their throwaway data science code!

Sat, 02 Dec 2023 00:00:00 +0100

When I started working as a Data Scientist nearly ten years ago, the data science team I joined did something I found really strange at first: They had a single GitHub repo where they put all their “throwaway” code. An R script to produce some plots for a presentation, a Python notebook with a machine learning proof-of-concept, a bash script for cleaning some logs. It all went into the same repo. Initially, this felt sloppy to me, and sure, there are better ways to organize code, but I’ve come to learn that not having a single place for throwaway code in a team is far worse. Without a place for throwaway code, what’s going to happen is:

Some ambitious person on the team will create a new GitHub repo for every single analysis/POC/thing they do, “swamping” the GitHub namespace.
Some others will stow their code on the company wiki or drop it in the team Slack channel.
But most people aren’t going to put it anywhere, and we all know that code “available on request” often isn’t available at all.

So, in all teams I’ve worked in, I’ve set up a GitHub repo that looks something like this:

With the following blurb: A place for non-production scripts, notebooks, and other throwaway code. Don’t bother with branches and pull requests, unless you want a review, as this is more of a Dropbox folder masquerading as a GitHub repo. If you want to set up a similar repo, feel free to take a look at the ds-exploration-template repo over here.

And having such a repo has been very useful! It’s not the best place to put code, it does tend to become a bit disorganized after a while, but it is a place to put code, and where it’s easy to do so. And then, when you get a request that makes you think “Ah! I remember that Kristin (who’s on parental leave and shouldn’t be bothered) did something similar last year!” it’s really great to be able to go to that repo and find that code.

replicate	recipe	angle	temperature
1	A	42	175
1	A	46	185
1	A	47	195
1	A	39	205
1	A	53	215
1	A	42	225
1	B	39	175
…	…	…	…

replicate	recipe	angle	temperature
1	A	42	175
1	A	46	185
1	A	47	195
1	A	39	205
1	A	53	215
1	A	42	225
1	B	39	175
…	…	…	…

R on Publishable Stuff

A template for creating card sorting games in R

How to make a card sorting game using the template?

The Climate Impact Sorting Challenge

Q&A

A Bayesian Plackett-Luce model in Stan applied to pinball championship data

IFPA 18 World Pinball Championship dataset

The Plackett-Luce model

A Plackett-Luce model in Stan

The fitted IFPA 18 World Pinball Championship model

CopenhagenR, the 2024 spring season

• State of the R, the New Stuff - Niels Ole Dam

• Reproducible Workflows with R and sequencing data - Adrian Geissler

• Simplify making shiny apps with teal - Dawid Kałędkowski // R and Software Freedom - Ramarro Marrone

• Visualizing 440 bicycle rides using R - Gregers Kjerulf Dubrow

• Animating a melody as a mathematical object - Charles T. Gray

Public Pinball Machines per Capita: A new global indicator

Pulling public pinball locations from Pinball Map

Calculating Public Pinball Machines per Capita

Public Pinball Machines per Capita VS other indicators

Modeling my pinball scores

Why pandas feels clunky when coming from R

Analyzing purchases in R

Analyzing purchases in Python

Reading in the data

“How much do we sell..? Let’s take the total sum!”

“Ah, they wanted it by country…”

“And I guess I should deduct the discount.”

“Oh, and Maria asked me to remove any outliers.”

“I probably should use the median within each country”

So, what’s your point?

Baking the cake dataset cake

Some notes from a cake bake

The source of the cake dataset

The cake dataset

The hunt for the source of the cake dataset

Highlights from Chocolate cake: I. Optimum baking temperature

The cake recipes

Get a Git repo where your team can stow their throwaway data science code!

• Simplify making shiny apps with teal - Dawid Kałędkowski //
R and Software Freedom - Ramarro Marrone

Analyzing `purchases` in R

Analyzing `purchases` in Python

The `cake` dataset

replicate	recipe	angle	temperature
1	A	42	175
1	A	46	185
1	A	47	195
1	A	39	205
1	A	53	215
1	A	42	225
1	B	39	175
…	…	…	…