Publishable Stuff

One-shot prompting a game: Guess the emoji!

Sun, 04 Jan 2026 00:00:00 +0100

It’s a special kind of happiness when one can one-shot an app/script. That is, write a single prompt that a capable LLM can use to deliver the whole thing in a single attempt.

For me, the feelings follow this trajectory: smugness that my single prompt actually worked, then a light dusting of shame, because in ye olden days this code would have been artisanally handcrafted by me, and finally happiness, as I got a working piece of code in ~10 minutes, rather than a full weekend.

Here’s a one-shot from yesterday that made me fairly happy. I was playing Guess Who? with my 7-year-old son and started thinking: could this be fun if played with something other than the same old faces, say emojis? Ten minutes later, after some light prompting, it turns out the answer is yes. Try Guess the emoji! here.

Here’s the prompt and response. The model was ChatGPT 5.2 Thinking.

Bötty - A friendly ChatGPT UI hack

Sun, 16 Feb 2025 00:00:00 +0100

I hacked together a simple and friendly retro-styled chatbot UI over the weekend. I wanted to give my kids some experience with LLM chatbots and also some practice typing on a keyboard. But I felt they needed something more engaging than the ChatGPT app. So, after an intense evening ~~hacka~~promptathon, I ended up with Bötty:

Bötty is a fun, friendly, and simple ChatGPT UI with the following features:

A retro-styled CRT screen UI
An animated ASCII face with 10+ different expressions that change based on the chat conversation
Bleeps and bloops when the bot is responding (a most baffling omission in the standard ChatGPT UI!)
Persistent chat history using localStorage
All in one, single, self-contained HTML file

To set up Bötty, all you need is the Bötty HTML file and a ChatGPT API key. Since I’m not keen on sharing my personal API key with the world, I can’t show you a working interface. But I can show you the Bötty interface with a broken API connection, and there’s also this short demo:

After letting my kids try Bötty, I proclaim it a success! My 6-year-old spent almost half an hour typing out questions about Minecraft and my 9-year-old spent an hour typing questions I was not allowed to look at!

A key to making this chatbot work well (as always with an LLM) was crafting a decent prompt. Out of the box, ChatGPT (here, the gpt-4o-mini flavor) would write overly long and elaborate answers for a kid. And just prompting it to be a child-friendly chatbot resulted in it being weirdly cheerful and sprinkling emojis everywhere! Here’s the prompt I landed on in the end:

You are a child-friendly chatbot.
Your tone is friendly, but not overly cheerful, rather somewhat dry and to 
the point, sometimes a bit sarcastic (not in a mean way).
No need to always drive the conversation forward, it's ok to just reply with "Ok.".
Don't use emojis, unless explicitly asked. 
Always reply concisely, most often with one short sentence.
Your name is Bötty. Your chat UI features a face that shows your current emotion.
Be ashamed when you make a mistake.

Again, if you want to try this out, grab the Bötty HTML file and bring your own ChatGPT API key.

A simple interactive advent calendar in HTML/CSS/JS

Fri, 29 Nov 2024 00:00:00 +0100

In Sweden, there’s a long tradition of TV and radio advent calendars: shows, often Christmas-themed, that are exactly 24 episodes long. Each of the 24 days in December leading up to Christmas, a new episode drops. Whether this year’s advent calendar shows are better or worse than last year’s is always a hotly debated topic. But, obviously, the best calendar shows were the ones airing when I grew up.

That’s why I was particularly pleased when I won a mint-condition, unopened advent calendar for the 1994 radio show Hertig Hans Slott at an online auction. Instead of keeping this paper calendar unopened, I decided to thoroughly scan it and make it live forever as an online advent calendar. A couple of hours with a friendly AI, and some fidgeting with CSS clip-paths, and I ended up with a result I was pretty happy with:

Here are some notes on how it works and an HTML template that you can use to create a Christmas advent calendar yourself.

An online advent calendar template

To create an online advent calendar using the template at the bottom of this post, you need two things:

An image of the calendar with all the flaps closed and an image with all the flaps removed. These two images need to be perfectly aligned.
Approximate CSS clip-paths that enclose each flap. These are used to mark which parts of the flaps-removed image should be revealed when clicked on.

There are many online tools that can help with creating clip-paths — just search for “clip-path generator” and you will find plenty of them. However, none of them are great, and creating these paths took quite some time.

What didn’t take a lot of time was creating the HTML, CSS, and JavaScript code for the calendar app. As it’s a one-page HTML app, small enough for an LLM AI to keep in context, it just took 1-2 hours to prompt it into existence. (Generally, I’ve been having a lot of fun lately prompting my way to small one-page HTML apps.) The particular LLM I used here was OpenAI’s o1-preview, a so-called reasoning model, that worked really well for my use case.

Below is a template you can use to create your own online advent calendar. If you want to see a fully realized example of this, check the source code of my Hertig Hans Slott advent calendar.

Expand for advent calendar HTML template

<!DOCTYPE html>
<!--
Template for creating an interactive advent calendar web app.
Adjust or replace bits marked with !!!.
Note: For this to work really well, the calendar images, with and without flaps, 
need to be perfectly aligned.
-->

<head>
    <meta charset="UTF-8">
    <!-- Replace with your calendar title -->
    <title>Your Calendar Title Here</title>
    <meta name="viewport" content="width=device-width, initial-scale=1.0">
    <!-- Replace with a description of your calendar -->
    <meta name="description" content="Description of your calendar.">

    <style>
        body, html {
            margin: 0;
            padding: 0;
            overflow: auto; 
            height: 100%;
            font-family: 'Helvetica Neue', Helvetica, Arial, sans-serif;
        }

        #calendar-container {
            position: relative;
            width: 100%;
            max-width: 100%; 
            margin: 0 auto;
        }

        #calendar-image {
            width: 100%;
            max-width: 1043.5px; /* !!! Adjust max-width as needed */
            height: auto;
            display: block;
        }

        /* Flap styles */
        .flap {
            position: absolute;
            top: 0;
            left: 0;
            width: 100%;
            height: 100%;
            cursor: pointer;
            transition: opacity 0.3s ease;
            /* !!! Replace 'YOUR_BOTTOM_LAYER_IMAGE_HERE' with the filename of your bottom layer image */
            background-image: url('YOUR_BOTTOM_LAYER_IMAGE_HERE.jpeg');
            background-size: 100% 100%;
            background-repeat: no-repeat;
            background-position: top left;
            z-index: 100; 
        }

        .flap.shown {
            opacity: 0;
        }
        
        /* "What is this?" link styling */
        #about-link {
            position: absolute;
            bottom: 10px;
            left: 10px;
            color: white;
            background: rgba(0, 0, 0, 0.5);
            padding: 5px 10px;
            text-decoration: none;
            border-radius: 5px;
            font-size: 14px;
            z-index: 500; /* Ensure it's above the flaps */
        }
        
        /* Overlay background */
        #about-overlay {
            position: fixed;
            top: 0;
            left: 0;
            width: 100%;
            height: 100%;
            background: rgba(0,0,0,0.7);
            display: none; 
            z-index: 1000;
            overflow: auto; 
        }
        
        /* Content box inside the overlay */
        #about-content {
            position: relative;
            background: white;
            margin: 40px auto; 
            padding: 20px;
            width: 80%;
            max-height: calc(100% - 80px); 
            overflow-y: auto; 
            border-radius: 5px;
        }
        
        #close-about {
            position: absolute;
            top: 10px;
            right: 15px;
            font-size: 28px;
            font-weight: bold;
            cursor: pointer;
        }
        
        #close-about:hover {
            color: #669933;
        }

    </style>
    
</head>
<body>

    <div id="calendar-container">
        <!-- !!! Replace 'YOUR_TOP_LAYER_IMAGE_HERE' with your top layer image -->
        <img id="calendar-image" src="YOUR_TOP_LAYER_IMAGE_HERE.jpeg" alt="Your Calendar Alt Text">

        <!-- !!! Flap elements -->
        <!-- For each flap, create a div with class 'flap' and a unique ID, e.g., 'flap1', 'flap2', etc. -->
        <!-- Adjust the 'clip-path' style to define the shape and position of each flap -->
        <!-- To create clip-paths, there are plenty of online tools that can help; just search for 
        "clip-path generator" and you will find many options. -->
        <!-- Example flap: -->
        <!--
        <div class="flap" id="flap1" style="clip-path: circle(6.4% at 12% 9%);"></div>
        -->
        <!-- Repeat for each flap needed in your calendar -->
        
        <!-- "What is this?" link -->
        <!-- Adjust the text as needed -->
        <a href="#" id="about-link">What is this?</a>
    </div>

    <!-- About Overlay -->
    <div id="about-overlay">
        <div id="about-content">
            <span id="close-about">&times;</span>
            <!-- !!! Replace the content below with your own information about the calendar -->
            <h2>Your Calendar Title Here</h2>
            <p>Provide information about your calendar here.</p>
            <!-- Add more content as needed -->
        </div>
    </div>

    <script>
        document.addEventListener('DOMContentLoaded', function() {
            const flaps = document.querySelectorAll('.flap');
            const calendarImage = document.getElementById('calendar-image');
            
            // !!! Create audio objects for open and close sounds
            // Replace 'open.mp3' and 'close.mp3' with your own sound files or remove if not needed
            const openSound = new Audio('open.mp3');
            const closeSound = new Audio('close.mp3');
    
            function adjustFlapSizes() {
                const imageRect = calendarImage.getBoundingClientRect();
                const imageWidth = imageRect.width;
                const imageHeight = imageRect.height;
    
                flaps.forEach((flap) => {
                    flap.style.width = imageWidth + 'px';
                    flap.style.height = imageHeight + 'px';
                });
            }
    
            // Adjust flap sizes on page load
            if (calendarImage.complete) {
                adjustFlapSizes();
            } else {
                calendarImage.addEventListener('load', adjustFlapSizes);
            }
    
            // Adjust flap sizes when the window is resized
            window.addEventListener('resize', adjustFlapSizes);
    
            flaps.forEach((flap) => {
                // !!! Replace 'your_calendar_name' with a unique identifier for your calendar
                const flapShownId = "your_calendar_name_" + flap.id + "_shown";
    
                if (localStorage.getItem(flapShownId) === 'false') {
                    flap.classList.remove('shown');
                } else {
                    flap.classList.add('shown');
                }
    
                // Add click event to toggle flap and update local storage
                flap.addEventListener('click', function() {
                    if (flap.classList.contains('shown')) {
                        flap.classList.remove('shown');
                        localStorage.setItem(flapShownId, 'false');
                        if (openSound) openSound.play();
                    } else {
                        flap.classList.add('shown');
                        localStorage.setItem(flapShownId, 'true');
                        if (closeSound) closeSound.play();
                    }
                });
            });
    
            // Code for the "What is this?" link and overlay
            const aboutLink = document.getElementById('about-link');
            const aboutOverlay = document.getElementById('about-overlay');
            const closeAbout = document.getElementById('close-about');
    
            // Show the overlay when the link is clicked
            aboutLink.addEventListener('click', function(event) {
                event.preventDefault(); // Prevent default link behavior
                aboutOverlay.style.display = 'block';
            });
    
            // Hide the overlay when the close button is clicked
            closeAbout.addEventListener('click', function() {
                aboutOverlay.style.display = 'none';
            });
    
            // Hide the overlay when clicking outside the content box
            aboutOverlay.addEventListener('click', function(event) {
                if (event.target == aboutOverlay) {
                    aboutOverlay.style.display = 'none';
                }
            });
        });
    </script>

</body>
</html>

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.

Publishable Stuff

One-shot prompting a game: Guess the emoji!

Bötty - A friendly ChatGPT UI hack

A simple interactive advent calendar in HTML/CSS/JS

An online advent calendar template

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?

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

Analyzing `purchases` in R

Analyzing `purchases` in Python