Textgrids are a way to annotate audio data

Praat is a program for speech and acoustic analysis that has been around for over 30 years. It includes a scripting language for manipulating and analyzing data and for creating annotation workflows. Users can annotate intervals or points of time in a sound file using a textgrid object. Here is a screenshot of a textgrid in Praat:

There are three rows in the image, all three of them sharing the same x axis (time).

1. Amplitude waveform, showing intensity over time
2. Spectrogram, showing how the intensity (color) at frequencies (y) changes over time. Red dots mark estimated formants (resonances) in the speech signal.
3. Textgrid of text annotations for the recording

A user can edit the textgrid by adding or adjusting boundaries and adding annotations, and Praat will save this data to a .TextGrid file.

Other programs can produce .TextGrid files: the textgrid pictured here is the result of forced alignment, specifically by the Montreal Forced Aligner. I told the program I said “library tidy verse library b r m s”, and it looked up the pronunciations of those words and used an acoustic model to estimate the time intervals of each word and each speech sound. The aligner produced a .TextGrid file for this alignment.

These textgrids are the bread and butter of some of the research that we do. For example, our article on speaking/articulation rate in children involved over 30,000 single-sentence .wav files and .TextGrid files. We used the alignments to determine the duration of time spent speaking, the number of vowels in each utterance and hence the speaking rate in syllables per second.

Reading these .TextGrid files into R was cumbersome, so I wrote and released readtextgrid, an R package built around one simple function:

library(tidyverse)
library(readtextgrid)

path_tg <- "_R/data/mfa-out/library-tidyverse-library-brms.TextGrid" 
data_tg <- read_textgrid(path_tg)

data_tg
#> # A tibble: 43 × 10
#>    file       tier_num tier_name tier_type tier_xmin tier_xmax  xmin  xmax text 
#>    <chr>         <int> <chr>     <chr>         <dbl>     <dbl> <dbl> <dbl> <chr>
#>  1 library-t…        1 words     Interval…         0      3.60  0     0.08 ""   
#>  2 library-t…        1 words     Interval…         0      3.60  0.08  0.74 "lib…
#>  3 library-t…        1 words     Interval…         0      3.60  0.74  1.12 "tid…
#>  4 library-t…        1 words     Interval…         0      3.60  1.12  1.58 "ver…
#>  5 library-t…        1 words     Interval…         0      3.60  1.58  1.74 ""   
#>  6 library-t…        1 words     Interval…         0      3.60  1.74  2.46 "lib…
#>  7 library-t…        1 words     Interval…         0      3.60  2.46  2.72 "b"  
#>  8 library-t…        1 words     Interval…         0      3.60  2.72  2.9  "r"  
#>  9 library-t…        1 words     Interval…         0      3.60  2.9   3.04 "m"  
#> 10 library-t…        1 words     Interval…         0      3.60  3.04  3.46 "s"  
#> # ℹ 33 more rows
#> # ℹ 1 more variable: annotation_num <int>

The function returns a tidy tibble with one row per annotation. The filename is stored as a column too so that we can lapply() over a directory of files. Annotations are numbered so that we can group_by(text, annotation_num) and have repeated words handled separately.

With this textgrid in R, I can measure speaking rate, for example:

data_tg |> 
  filter(tier_name == "phones", text != "") |> 
  summarise(
    speaking_time = sum(xmax - xmin),
    # vowels have numbers to indicate degree of stress
    num_vowels = sum(str_detect(text, "\\d"))
  ) |> 
  mutate(
    syllables_per_sec = num_vowels / speaking_time 
  )
#> # A tibble: 1 × 3
#>   speaking_time num_vowels syllables_per_sec
#>           <dbl>      <int>             <dbl>
#> 1          3.22         13              4.04

Or annotate a spectrogram:

library(tidyverse)
library(ggplot2)
path_spectrogram <- "_R/data/mfa/library-tidyverse-library-brms.csv"
data_spectrogram <- readr::read_csv(path_spectrogram)
#> Rows: 249366 Columns: 6
#> ── Column specification ────────────────────────────────────────────────────────
#> Delimiter: ","
#> dbl (6): y, x, power, time, frequency, db
#> 
#> ℹ Use `spec()` to retrieve the full column specification for this data.
#> ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

data_spectrogram |> 
  mutate(
    # reserve more of the color variation for intensities above 15 dB
    db = ifelse(db < 15, 15, db)
  ) |> 
  ggplot() + 
  aes(x = time, y = frequency) +
  geom_raster(aes(fill = db)) +
  geom_text(
    aes(label = text, x = (xmin + xmax) / 2),
    data = data_tg |> filter(tier_name == "words"),
    y = 6500,
    vjust = 0
  )  +
  geom_text(
    aes(label = text, x = (xmin + xmax) / 2),
    data = data_tg |> filter(tier_name == "phones"),
    y = 6100,
    vjust = 0,
    size = 2
  )  +
  ylim(c(NA, 6600)) +
  theme_minimal() +
  scale_fill_gradient(low = "white", high = "black") +
  guides(fill = "none") +
  labs(x = "time [s]", y = "frequency [Hz]")

Spectrogram of me saying 'library tidyverse library brms'

I released the first version of the package in 2020. This package, notably for me, contains the first hex badge I ever made.

My original .TextGrid parser and its problem

Here is what the contents of the .TextGrid file look like. It’s not the whole file but enough to give a sense of the structure:

path_tg |> 
  readLines() |> 
  head(26) |> 
  c("[... TRUNCATED ... ]") |> 
  writeLines()
#> File type = "ooTextFile"
#> Object class = "TextGrid"
#> 
#> xmin = 0 
#> xmax = 3.596009 
#> tiers? <exists> 
#> size = 2 
#> item []: 
#>     item [1]:
#>         class = "IntervalTier" 
#>         name = "words" 
#>         xmin = 0 
#>         xmax = 3.596009 
#>         intervals: size = 11 
#>         intervals [1]:
#>             xmin = 0.0 
#>             xmax = 0.08 
#>             text = "" 
#>         intervals [2]:
#>             xmin = 0.08 
#>             xmax = 0.74 
#>             text = "library" 
#>         intervals [3]:
#>             xmin = 0.74 
#>             xmax = 1.12 
#>             text = "tidy" 
#> [... TRUNCATED ... ]

The first 7 lines provide some metadata about the time range of the audio and the number of tiers (size = 2). The file then writes out each tier (item [n] lines) by first giving the class, name, time duration and number of marks or intervals. Each mark or interval is enumerated with time values xmin, xmax and text values.

Because nearly everything here follows a key = value syntax and because sections are split from each other very neatly with item [n]: or interval [n]: lines, I was able to write a simple parser using regular expressions: Split the file into item [n] sections, split those into interval [n] sections, and extract key-value pairs.

This easy approach came with limitations. First, the TextGrid specification was much more flexible. For example, Praat also provides much less verbose “short” format textgrids which are like a stream of time and text annotations:

path_tg_short <- "_R/data/mfa-out/library-tidyverse-library-brms-short.TextGrid"
path_tg_short |> 
  readLines() |> 
  head(26) |> 
  c("[... TRUNCATED ... ]") |> 
  writeLines()
#> File type = "ooTextFile"
#> Object class = "TextGrid"
#> 
#> 0
#> 3.596009
#> <exists>
#> 2
#> "IntervalTier"
#> "words"
#> 0
#> 3.596009
#> 11
#> 0
#> 0.08
#> ""
#> 0.08
#> 0.74
#> "library"
#> 0.74
#> 1.12
#> "tidy"
#> 1.12
#> 1.58
#> "verse"
#> 1.58
#> 1.74
#> [... TRUNCATED ... ]

Everything is in the same order, but the annotations are gone. It turns out that all of the helpful labels from before were actually comments that get ignored. Everything that isn’t a number or a string in double-quotes (or a <flag>) is a comment.

There are also other quirks (" escapement, ! comments, deviations between the Praat description of the format and the behavior of praat.exe). I have them documented as a kind of unofficial specification in an article on the package website.

But my original regular-expression based parser could only handle the verbose long-format textgrids. I knew this. I put this in a GitHub issue in 2020. And this compatibility oversight was never a problem for me until I tried a new phonetics tool that defaulted to saving the textgrids in the short format. Now, readtextgrid could not in fact “read textgrid”.

The new R-based tokenizer

Josef Fruehwald, a linguist with lots of acoustics/phonetics software, submitted a pull request to implement a proper parser that I eventually rewrote to handle various edge cases and undocumented behavior in the .TextGrid specification. I made an adversarial .TextGrid file 😈 that could still be opened by praat.exe but was meant to be difficult to parse. This was a fun development loop: Make the file harder, update the parser to handle the new feature, repeat.

Because the essential data in the file are just string tokens and number tokens, I needed to make a tokenizer: a piece of software that reads in characters, groups them into tokens, and figures out what kind of data the token represents. The initial R-based version of the tokenizer did the following:

• Read the file character by character
• Gather the characters for the current token and keep them when they form a valid string or number
• Shift between three states (in_string, in_strong_comment for ! comments, in_escaped_quote)

These three states determine how we interpret spaces, newlines, and " characters. For example, a newline ends a ! comment but a newline can appear in a string so it doesn’t end a string. Moreover, in a comment, " is ignored, but in a string, it might be the end of the string or an escaped quote (doubled double-quotes are used for " characters: the string """a""" has the text "a").

But at a high level, the code was simple:

for (i in seq_along(all_char)) {

  # { ... examine current character ... }
  
  # { ... handle comment state ... }
  
  # { ... collect token if we see whitespace and are not in a string  ... }
  
  # { ... handle string and escaped quote state ... }

}

The new character-by-character parser worked 🎉. It had conquered the adversarial example file, but there was still one more problem. It was slower than the original regular-expression parser!

tg_lines <- readLines(path_tg)

bench::mark(
  legacy = readtextgrid:::legacy_read_textgrid_lines(tg_lines),
  new_r = readtextgrid:::r_read_textgrid_lines(tg_lines)
)
#> # A tibble: 2 × 6
#>   expression      min   median `itr/sec` mem_alloc `gc/sec`
#>   <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl>
#> 1 legacy       75.1ms   76.1ms      13.1    6.81MB     19.7
#> 2 new_r        70.7ms   72.3ms      13.7  590.88KB     10.3

At this point, I asked ChatGPT for tips on speeding up the tokenizer.

Some thoughts about LLMs

the thing about (the current) chatgpt is that it writes like a fucking idiot with excellent grammar

— sarah jeong (@sarahjeong.bsky.social) July 6, 2025 at 7:20 PM

Now, let’s talk about large language models (LLMs). There’s a lot I could say about them.¹ As a language scientist, I’ll start here: They know syntax. They know which words go together and can generate very plausible sequences of words. They do not know semantics however. They don’t have any firsthand knowledge or experience about what those sequences express. They can’t introspect about that knowledge or experience to see whether things “make sense”.² They don’t care about the truth or falsity of statements. They just make plausible sequences of words.

Now, it turns out that if you learn how to make sequences of words from an Internet-sized corpus of text, then a lot of the plausible sequences you make will turn out to be true. If you read 10,000 cookbooks, you could probably provide a very classic recipe for scrambled eggs. But because you don’t know about sarcasm or can’t draw on your own experience of trying to not ingest non-food chemicals, you might suggest putting glue on a pizza.

So, as we use an LLM, we need to ask ourselves how much we care about the truth or care about knowing or understanding things. That may sound like a glib or weird statement: Shouldn’t we always care about the truth? Well, sometimes we don’t. We just want some syntax; we want boilerplate or templates to fill out.³ For example, I can ask an LLM to “write some unit tests for a function round_to(xs, unit) that rounds a vector of values to an arbitrary unit” and receive:

test_that("round_to() rounds to nearest multiple of unit", {
  expect_equal(round_to(5, 2), 6)
  expect_equal(round_to(4.9, 2), 4)
  expect_equal(round_to(5.1, 2), 6)
  expect_equal(round_to(c(1, 2, 3, 4), 2), c(2, 2, 4, 4))
})

These tests are not useful until I plug in the correct values for the expected output.

In other cases, we don’t quite care about truth or comprehension because we can get external corroboration.⁴ When I ask ChatGPT for an obfuscated R script to make Pac-Man in ggplot2, I can run the code to see if it works without trying to decipher its syntax:

library(ggplot2)
ggplot()+
geom_polygon(aes(x,y),
data=within(data.frame(t(sapply(seq(a<-pi/9,2*pi-a,l<-4e2),
function(t)c(cos(t),sin(t))))),
{rbind(.,0,0,cos(a),sin(a))->df;x=df[,1];y=df[,2]}),
fill="#FF0",col=1)+
annotate("point",x=.35,y=.5,size=3)+
annotate("point",x=c(1.4,2,2.6),y=0,size=3)+
coord_equal(xlim=c(-1.2,3),ylim=c(-1.2,1.2))+
theme_void()
#> Error in eval(substitute(expr), e): object '.' not found

(Strangely, this is the case where a dot kills Pac-Man.)

Vibes are semantic vapor

When we abandon caring about truth or understanding things and just rely on external corroboration, we are in the realm of vibe coding. I like this term because of its insouciant honesty: Truth? Comprehension? We’re just going off the vibes. It would be a great help if we used the word more liberally. A YouTube video called “A vibe history of NES videogames”? No thanks.⁵

If we lean into vibes, we need to get better at external corroboration and know our programming languages even better. R is a flexible programming language and it does some things that “help” the user that can lead to silent bugs. Famously, function arguments and $ will match partial names.

# Look at the "Call:" in the output
lm(f = hp ~ cyl, d = mtcars)
#> 
#> Call:
#> lm(formula = hp ~ cyl, data = mtcars)
#> 
#> Coefficients:
#> (Intercept)          cyl  
#>      -51.05        31.96

# There is no `m` column
all(mtcars$m == mtcars$mpg)
#> [1] TRUE

A student I work with was trying to compute sensitivity and specificity on weighted data. The LLM suggested the following:

# Make some weighted data using frequencies
data <- pROC::aSAH |> 
  count(outcome, age, name = "weight")

# What the LLM did:
pROC::roc(data, "outcome", "age", weights = data$weight)
#> Setting levels: control = Good, case = Poor
#> Setting direction: controls < cases
#> 
#> Call:
#> roc.data.frame(data = data, response = "outcome", predictor = "age",     weights = data$weight)
#> 
#> Data: age in 44 controls (outcome Good) < 30 cases (outcome Poor).
#> Area under the curve: 0.5947

This code runs without any problems. It’s wrong, but it runs. The problem is that pROC::roc(...) supports variadic arguments (...):

# Note the dots
pROC:::roc |> formals() |> str()
#> Dotted pair list of 1
#>  $ ...: symbol
pROC:::roc.data.frame |> formals() |> str()
#> Dotted pair list of 5
#>  $ data     : symbol 
#>  $ response : symbol 
#>  $ predictor: symbol 
#>  $ ret      : language c("roc", "coords", "all_coords")
#>  $ ...      : symbol

Those ... are for forwarding arguments to other functions that roc() might call internally. Unfortunately, functions by default don’t check the contents of the ... to see if they have unsupported arguments. Thus, bad arguments are ignored silently:

# method and weights are not real arguments
pROC::roc(data, "outcome", "age", method = fake, weights = fake)
#> Setting levels: control = Good, case = Poor
#> Setting direction: controls < cases
#> 
#> Call:
#> roc.data.frame(data = data, response = "outcome", predictor = "age",     method = fake, weights = fake)
#> 
#> Data: age in 44 controls (outcome Good) < 30 cases (outcome Poor).
#> Area under the curve: 0.5947

The LLM hallucinated a weights argument, which is a plausible argument,⁶ and the ... syntax behavior swallowed it up like Pac-Man. It always comes back to Pac-Man. I ended up writing a function that could compute sens and spec on weighted data.

Unfortunately the space of LLM code errors and the space of human errors are not the same, making hard-won code review instincts misfire

— Eugene Vinitsky 🍒 (@eugenevinitsky.bsky.social) November 13, 2025 at 6:21 PM

As users, we can guard against the first two silent problems with options(warnPartialMatchArgs, warnPartialMatchDollar), and as developers, we can prevent the second problem with rlang::check_dots_used() and friends. But like I said at the outset, external corroboration requires us to know even more about the language in order to vibe safely.

Syntax and semantics, again

In this mini-position statement on LLM assistance, the two principles I am trying to develop are:

• LLMs know text distributions very well. Use them to generate starter syntax.
• LLMs don’t understand anything. It’s all bullshit and vibes.

If we think of LLMs as syntax generators, we can imagine some pretty good use cases:

• Write unit tests for a function that does…
• Set up Roxygen docs for this function
• Create a function to simulate data for a model of rt ~ group + (1 | id)
• Write a Stan program to fit this model. (Mind your priors.)
• Spoiler alert: Convert this R loop into C++ code

Still, we need to be mindful of the semantic limitations and skeptical of the output. We should audit the results and make sure we comprehend them, or admit upfront that this code is running on vibes. In either case, we also need to be vigilant about bugs that could happen silently or bugs that a machine might make but a human wouldn’t (hallucinations).

One thing I worry about with LLM reliance is skill atrophy. If I keep using this bot as a crutch, then some of my skills will get weaker. Sam Mehr has a take I quite like that puts this concern upfront. LLMs are fine for code we don’t feel bothered to learn:

re AI, a PhD student mentioned sheepishly that they used chatgpt for advice on coding up an unusual element in javascript. Almost apologized

I'm like no no no you're a psych PhD, not CS, this is exactly what LLMs are for! Doing a so-so job at things you just need done & don't care about learning!

— samuel mehr (@mehr.nz) May 13, 2025 at 10:32 PM

I quite like programming and want to learn. I like to read the release notes, dig into the documentation and experiment with new modeling features. At the same time, sometimes I just want a bash script to unzip all .zip files in a directory. Time was, we would find something from Stack Overflow to adapt for that problem. Now, we ask ChatGPT for the code, look it over quick, test it and move on. That seems fine. A metacognitive awareness about what is worth learning and what problems are worth solving in a slower methodical way is very useful for an LLM user.

Finally, to be clear—I can’t believe I need to make this disclaimer—we should always care about truth and accuracy when we write prose and publish it and put our name on it. Vibes are not scientific or scholarly. When I see emails or code documentation with immaculate formatting and perfect language, my bullshit sensor goes off and I worry that I need to read extra carefully because a smooth-talking robot is trying to pull a fast one on me. I don’t use LLMs for writing except for proofreading or requests for nitpicking. I have an instruction in ChatGPT that says not to revise anything I write unless it sneaks Magic: The Gathering card names into the output. (Alas, it generally ignores that diabolic edict of mine.)

AI assistance in readtextgrid

Because the old parser was outperforming the newer, more robust parser, I asked ChatGPT for ways to make my textgrid parsing faster. For example, one version of the loop collected characters in a vector and then paste0()-ed them together. ChatGPT suggested that because we are iterating over character indices we instead use substring() to extract tokens from the text. That worked, and it ran faster, until it failed a unit test on a character wearing a diacritic. After a few rounds of trying to improve the loop, I asked quite bluntly: “How can we move the tokenize loop into Rcpp or cpp11 with the viewest [sic] headaches possible”.

And it provided some very legible cpp11 code. I had never used C++ with R before. To get started, I had to call on usethis::use_cpp11() to make the necessary boilerplate—you just need syntax sometimes—and I had to troubleshoot the first couple versions of the function because of errors. The cpp11 documentation is small in a good way. It has examples of converting R code into C++ equivalents, which is precisely the activity that I was up to.

What I liked about the ChatGPT output is how clear the translation was. In the R version, part of the character processing loop is to peek ahead to the next character to see whether " is an escaped quote "" or the end of a string:

# ... in the character processing loop

    # Start or close string mode if we see "
    if (c_starts_string) {
      # Check for "" escapes
      peek_c <- all_char[i + 1]
      if (peek_c == "\"" & in_string) {
        in_escaped_quote <- TRUE
      } else {
        in_string <- !in_string
      }
    }

# ...

And here is the C++ version of the peek ahead code:

// ... helper functions ...

  // Is this a UTF-8 continuation byte? (10xxxxxx)
  auto is_cont = [](unsigned char b)->bool {
    // Are the first two bits 10?
    return (b & 0xC0) == 0x80;
  };

// ... in the character processing loop ...

    if (b == 0x22) { // '"'
      // peek ahead to see if we have a double "" escapement
      size_t j = i + 1;
      // We need the next character, not just the next byte, so we skip
      // continuation characters.
      while (j < nbytes && is_cont(static_cast<unsigned char>(src[j]))) ++j;
      // Use `0x00` dummy character if we are at the end of the string
      unsigned char nextb = (j < nbytes) ? static_cast<unsigned char>(src[j]) : 0x00;

      if (in_string && nextb == 0x22) {
        esc_next = true;    // consume next '"' once
      } else {
        in_string = !in_string;
      }
    }

// ...

There is a logical correspondence between the lines that I wrote myself in R and the lines that the LLM provided for C++. The C++ version works at the level of bytes instead of characters, and that matters:

"é" |> nchar(type = "chars")
#> [1] 1
"é" |> nchar(type = "bytes")
#> [1] 2

But the C++ code makes sense to me. It looks plausible, right? Still, plausible isn’t enough. I asked the LLM a lot of follow-up questions: what does auto do, what is size_t doing, and so on. And I annotated the C++ code with comments for my own understanding.

During my auditing, I went down a particular rabbithole to make sure I understood how Unicode bytes get packed into UTF-8 sequences. I learned how the character é for example has the codepoint (character number) U+00E9 in Unicode, so it falls in the range of codepoints that need to be split into two bytes. The scheme for two-byte encoding is

character number               ->               character encoding
codepoint -> 00000yyy yyxxxxxx -> 110yyyyy 10xxxxxx -> UTF-8 bytes
00E9      -> 00000000 11101001 -> 11000011 10101001 -> c3 a9

Which we can check by hand:

bitchar_to_raw <- function(xs) {
  xs |> 
    strsplit("") |> 
    lapply(function(x) as.integer(x) |> rev() |> packBits()) |> 
    unlist()
}

bitchar_to_raw(c("11000011", "10101001"))
#> [1] c3 a9
charToRaw("é")
#> [1] c3 a9

In the UTF-8 scheme, bytes that start with 10 are only the second, third and fourth bytes in a character’s encoding—that is, only the continuation bytes. Now, at this point, we can comprehend why the C++ is checking for continuation characters and why the check for continuation characters involves checking the first two bits.

Another rabbithole involved how to parse numbers. At first, the LLM suggested I use one of R’s own C functions to handle it. That idea seems really powerful to me—wait, now I can tap into what R’s own routines?!—but R’s parser was a bit stricter than what I needed to match praat.exe.

This new C++ based tokenizer yielded a huge performance gain:

bench::mark(
  legacy = readtextgrid:::legacy_read_textgrid_lines(tg_lines),
  new_r = readtextgrid:::r_read_textgrid_lines(tg_lines),
  new_cpp = readtextgrid::read_textgrid_lines(tg_lines)
)
#> # A tibble: 3 × 6
#>   expression      min   median `itr/sec` mem_alloc `gc/sec`
#>   <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl>
#> 1 legacy      65.22ms  68.77ms      13.8    6.49MB     4.59
#> 2 new_r       72.67ms   88.5ms      11.5  363.33KB     5.74
#> 3 new_cpp      3.12ms   3.64ms     272.    96.77KB     4.11

That’s an improvement of 10–15x! Now, I find myself wondering: What else could use a cpp11 speed boost?

One downside of adopting cpp11 is that the package needs to compile code. As a result, I can’t just tell people to try the developer version of the package with remotes::install_github(). CRAN compiles packages so end users don’t face this issue when installing the official released version of packages.

One workaround I adopted was relying on R Universe which will provide compiled versions of packages hosted on GitHub. Then we change the installation instructions to:

install.packages(
  "readtextgrid", 
  repos = c("https://tjmahr.r-universe.dev", "https://cloud.r-project.org")
)

You might have seen this pattern elsewhere. cmdstanr skips CRAN entirely and only uses R Universe.

Parting thoughts

An LLM helped me translate pokey R code into fast C++ code. The code is live now on CRAN, released in readtextgrid 0.2.0. I’m maybe kind of a C++ developer now? (Nah.)

This kind of code translation strikes me as an easy win for R developers: “I have my version that works right now, but I think it can go faster. Help me convert this to C++.” I took care to make sure I understood the output. The syntax came easy, but the semantics (comprehension and validation) took more time.

If I ask myself, could I have done this translation to C++ without an LLM? The answer is no, not in a reasonable timeframe, certainly not as fast as the two days it took me in this case. That’s a pretty undeniable boost.

Which software to cite

Let’s make a distinction here between reporting (or summarizing) an analysis and reproducing (or carrying out) an analysis.

Our main manuscript document is for reporting. We want to report which tools and which versions of those tools we used to get our statistical results. We don’t need to include every computational detail. We will save that level of detail for a supplemental document that shows the exact modeling code and sessioninfo::session_info() for reproducing our results. Moreover, journals will sometimes limit the number of references in a manuscript and a full R analysis might draw on 15 packages, so we in general cannot cite everything that helped us get our results. So, we can think more generally about citation priorities.

For an analysis carried out in R, these items have the highest priority for citations:

• R (the programming language / analysis environment).
• Third party packages that carried out the analyses.
  • For example, nlme, lme4, ordinal, rms, brms.
• If a package calls on another language or analysis tool, cite that tool as well.
  • For example, brms and rstanarm fit models using the Stan programming language, so we need to cite and version Stan as well.
• Packages that performed additional computation on analysis results.
  • For example, emmeans to get marginal means from a fitted model.
• Packages that visualized analysis results automatically. For example, see or interactions.

The following items would have the lowest priority for citations:

• RStudio: It’s just an interface to the language. (Ideally, an analysis could be run without touching RStudio.)
• The built-in stats package.
• knitr/quarto/rmarkdown: These performed R computations for us and stored the results in a document.
• Siloed off parts of a main package.
  • For example, the gamlss package fits GAMLSS models but the distributions for model families are stored in the package gamlss.dist. gamlss needs gamlss.dist to work, but gamlss is the main important thing to cite.
• Data storage formats.

If space and the publication venue permit, we can also cite and version the key R packages that manipulated or visualized the data such as tidyverse, ggplot2, broom, tidybayes/ggdist, etc. Be generous. We do want to credit the tools we used to get our results after all!

Where to get citation information

Creators of scientific software will often tell users how to cite their software. Scientific software tools often have an associated article that announces the software and describes how to use it, and authors will ask users to cite that publication so they can obtain academic credit for their software work.

For R and R packages, the citation() function will tell users how to cite their software. lme4 is one of those packages that directs users to a publication.

citation("lme4")
#> To cite lme4 in publications use:
#> 
#>   Douglas Bates, Martin Maechler, Ben Bolker, Steve Walker (2015).
#>   Fitting Linear Mixed-Effects Models Using lme4. Journal of
#>   Statistical Software, 67(1), 1-48. doi:10.18637/jss.v067.i01.
#> 
#> A BibTeX entry for LaTeX users is
#> 
#>   @Article{,
#>     title = {Fitting Linear Mixed-Effects Models Using {lme4}},
#>     author = {Douglas Bates and Martin M{\"a}chler and Ben Bolker and Steve Walker},
#>     journal = {Journal of Statistical Software},
#>     year = {2015},
#>     volume = {67},
#>     number = {1},
#>     pages = {1--48},
#>     doi = {10.18637/jss.v067.i01},
#>   }

Notice in the BibTeX entry at the bottom how {lme4} is put in braces. These braces tell LaTeX not to change the capitalization of that word when printing the title. Some journals or formats have different preferences for how to capitalize titles, but as a general rule of thumb, software titles need to be printed verbatim, or as they would be used by the user. (That is, library(Lme4) will not load the lme4 package). When creating bibliography entries, take care to preserve the capitalization so that the software name is accurate. Take care also to differentiate between statistical methods and software names: “We fit GAMLSS models with the gamlss package”.

For CRAN packages, the output of citation() is also provided online in HTML. The CRAN package description page (e.g., lme4) includes a Citation entry which generates a formatted version of the citation information (e.g., lme4 citation info).

When the software doesn’t have a publication, R will generate a citation for you. The ordinal package is one such example.

citation("ordinal")
#> To cite 'ordinal' in publications use:
#> 
#>   Christensen R (2023). _ordinal-Regression Models for Ordinal Data_. R
#>   package version 2023.12-4,
#>   <https://CRAN.R-project.org/package=ordinal>.
#> 
#> A BibTeX entry for LaTeX users is
#> 
#>   @Manual{,
#>     title = {ordinal---Regression Models for Ordinal Data},
#>     author = {Rune H. B. Christensen},
#>     year = {2023},
#>     note = {R package version 2023.12-4},
#>     url = {https://CRAN.R-project.org/package=ordinal},
#>   }

The underscores _ in the title indicate that the title would be italicized when the citation is viewed on CRAN.

How to cite and version R and R packages

As a rule of thumb, any citation of a resource should answer these questions:

• Who (authors)
• What (title and sometimes format)
• When (year)
• Where (journal, URL, book, DOI)

Then for software, we can add the following:

• Which (version)

The citation() will answer these questions for you.

There are a couple of other functions to know when it comes to package versions. utils::packageVersion() provides the package version as a string:

utils::packageVersion("lme4")
#> [1] '1.1.35.3'
utils::packageVersion("ordinal")
#> [1] '2023.12.4'

For the current R version, a bunch of built-in functions can tell you everything you need to know. I can never remember which of these functions I want (it’s getRversion()), so I will sometimes use utils::packageVersion("base") to get a simple version number.

R.version.string
#> [1] "R version 4.4.0 (2024-04-24 ucrt)"
R.version
#>                _                                
#> platform       x86_64-w64-mingw32               
#> arch           x86_64                           
#> os             mingw32                          
#> crt            ucrt                             
#> system         x86_64, mingw32                  
#> status                                          
#> major          4                                
#> minor          4.0                              
#> year           2024                             
#> month          04                               
#> day            24                               
#> svn rev        86474                            
#> language       R                                
#> version.string R version 4.4.0 (2024-04-24 ucrt)
#> nickname       Puppy Cup
getRversion()
#> [1] '4.4.0'

utils::packageVersion("base")
#> [1] '4.4.0'

For Stan, depending on the backend used, the software version is available via:

# rstanarm and default brms
rstan::stan_version()
#> [1] "2.32.2"

# non-default for brms
cmdstanr::cmdstan_version()
#> [1] "2.34.1"

Examples

A simple example of R, a modeling R package and a helper R package:

Analyses were carried out the R programming language (vers. 4.2.0, R Core Team, 2021). Mixed models were estimated using the lme4 package (vers. 1.1.28, Bates et al., 2015). We estimated marginal means and contrasts using the emmeans package (vers. 1.7.2, Lenth, 2021).

Below is the actual RMarkdown content, so that version numbers and citations are inlined automatically. (We’re omitting details on creating .bib files or using pandoc’s @ citations.)

```{r}
v_lme4 <- packageVersion("lme4")
v_r <- packageVersion("base")
v_emmeans <- packageVersion("emmeans")
```

Analyses were carried out the R programming language [vers. `r v_r`,
@rstats]. Mixed models were estimated using the lme4 package
[vers. `r v_lme4`, @lme4]. We estimated marginal means and contrasts
using the emmeans package [vers. `r v_emmeans`, @emmeans].

This aspect of the code is invisible, but I use nonbreaking spaces   (HTML  ) after vers. so that the vers. and the version number stay on the same line.

Here is a more involved example involving an additional language and an R package that interfaces to that language:

We estimated the models using Stan (vers. 2.27.0, Carpenter et al., 2017) via the brms package (vers. 2.16.1, Bürkner, 2017) and tidybayes package (vers. 3.0.4, Kay, 2021) in R (vers. 4.3.0, R Core Team, 2021).

Behind the scenes, I had written the following RMarkdown:

```{r}
model <- targets::tar_read(model_random_slope)
v_stan <- model$version$cmdstan
v_brms <- model$version$brms
v_tidybayes <- packageVersion("tidybayes")
v_r <- getRversion()
```

We estimated the models using Stan [vers. `r v_stan`, @stan] via the
brms package [vers. `r v_brms`, @brms-jss] and tidybayes package
[vers. `r v_tidybayes`, @R-tidybayes] in R [vers. `r v_r`, @r-base].

Notice that I am reading in a cached model object (targets::tar_read()) and reading the software versions from that object. This arrangement avoids problems where models are fitted with one version of a package but utils::packageVersion() returns a different, more recent package version. brms stored these versions automatically for me. In general, when I cache a model like this, I store the package version in the model object.

A note on automatic citation helpers

A tool like the grateful package will generate a list of references and citations for us. Suppose we had the following where we fit a model and look at a summary of it.

library(tidyverse)
library(mgcv)
#> Loading required package: nlme
#> 
#> Attaching package: 'nlme'
#> The following object is masked from 'package:dplyr':
#> 
#>     collapse
#> This is mgcv 1.9-1. For overview type 'help("mgcv-package")'.

data <- MASS::mcycle
model <- gam(accel ~ s(times, bs = "cr"), data = data)
broom::tidy(model)
#> # A tibble: 1 × 5
#>   term       edf ref.df statistic p.value
#>   <chr>    <dbl>  <dbl>     <dbl>   <dbl>
#> 1 s(times)  8.39   8.87      53.8       0

grateful detects the following packages in use:

grateful::scan_packages(pkgs = "Session")
#>         pkg version
#> 1      base   4.4.0
#> 2     knitr    1.46
#> 3      mgcv   1.9.1
#> 4      nlme 3.1.164
#> 5 tidyverse   2.0.0

Note that broom is excluded despite being used and that nlme is included despite not being loaded directly. That’s because broom is loaded by tidyverse and gets absorbed by the tidyverse citation and because mgcv loads nlme (as its start-up message says). (And knitr is loaded when I render my blog posts but not when I work within this R session interactively.)

Okay, so we should just list the packages manually and disable tidyverse from absorbing broom. grateful can create a bibliography for us:

grateful::get_pkgs_info(
  pkgs = c("mgcv", "broom"), 
  out.dir = getwd(), 
  cite.tidyverse = FALSE
)
#>     pkg version                                         citekeys
#> 1 broom   1.0.5                                            broom
#> 2  mgcv   1.9.1 mgcv2011, mgcv2016, mgcv2004, mgcv2017, mgcv2003

a <- grateful::cite_packages(
  pkgs = c("mgcv", "broom"), 
  out.dir = getwd(), 
  cite.tidyverse = FALSE, 
  output = "paragraph"
)
a |> stringr::str_wrap(width = 72) |> writeLines()
#> We used the following R packages: broom v. 1.0.5 [@broom], mgcv v. 1.9.1
#> [@mgcv2003; @mgcv2004; @mgcv2011; @mgcv2016; @mgcv2017].

Now, we have the issue where citation(mgcv) has multiple publications associated with it, not all of which are relevant for our usage.

The point of this example is that a tool like grateful—and more generally tools that produce code for us—can be useful to compile information and get the ball rolling for us. But, we still have to edit and refine the outputs to work correctly.

Last knitted on 2024-05-07. Source code on GitHub.¹

library(tidyverse)

table1 <- tribble(
  ~Layer,  ~C14, ~error,
     "B", -5773,     30,
     "B", -5654,     30,
     "B", -5585,     30,
     "C", -5861,     30,
     "C", -5755,     30,
     "E", -5850,     50,
     "E", -5928,     50,
     "E", -5905,     50,
     "G", -6034,     30,
     "G", -6184,     30,
     "I", -6248,     50,
     "I", -6350,     50
  )
table1$Layer <- factor(table1$Layer)

Because of how the layers are ordered—new stuff piled on top of older stuff—we a priori expect deeper layers to have older dates, so these are the ordering constraints:

where μ is the average C14 age of a layer.

Ben-Shachar’s post works through some ways in brms to achieve this constraint:

1. Fit the usual model but filter out posterior draws where the ordering constraint is violated.

2. Have the Stan sampler reject draws where the constraint is violated. But note that the documentation for reject has a section titled “Rejection is not for constraints”.

3. Use brms’s monotonic effect mo() syntax.

In this post, I am going to add another option to this list:

4. Use contrast coding so the model parameters represent the differences between successive levels, and use priors to enforce the ordering constraint.

Big idea of contrast coding

When our model includes categorical variables, we need some way to code those variables in our model (that is, use numbers to represent the category levels). Our choice of coding scheme will change the meaning of the model parameters, allowing us to perform different comparisons (test different statistical hypotheses) about the means of the category levels. Let’s spell that out again, because it is the big idea of the contrast coding:

different contrast coding schemes <-> 
  different parameter meanings <-> 
    different comparisons / hypotheses

(Isn’t that an eye-popping graphic?)

The toolbox of contrast coding schemes is deep but also confusing. Whenever I step away from R’s default contrast coding, I usually have these pages open to help me: some tutorial on a UCLA page, Lisa DeBruine’s comparison article, and the menu of contrast schemes in emmeans. So, let’s review the basics by looking at R’s default contrast coding scheme.

The default: dummy coding

By default, R will code categorical variables in a regression model using “treatment” or “dummy” coding. In this scheme,

• The intercept is the mean of one of the category levels (the reference level)
• Parameters estimate the difference between each other level and the reference level

Let’s fit a simple linear model and work through the parameter meanings:

m1 <- lm(C14 ~ 1 + Layer, table1)
coef(m1)
#> (Intercept)      LayerC      LayerE      LayerG      LayerI 
#>  -5670.6667   -137.3333   -223.6667   -438.3333   -628.3333

Here, the (Intercept) is the mean of the reference level, and the reference level is the level of the categorical variable not listed in the other parameter names (LayerB). Each of the other parameters is a difference from that reference level. Layer C’s mean is (Intercept) + LayerC. The model.matrix() shows how these categorical variables are coded in the model’s design/contrast matrix:

# Matrix has 1 row per observation but we just want 1 per category level
mat_m1 <- m1 |> 
  model.matrix() |>
  unique()
mat_m1
#>    (Intercept) LayerC LayerE LayerG LayerI
#> 1            1      0      0      0      0
#> 4            1      1      0      0      0
#> 6            1      0      1      0      0
#> 9            1      0      0      1      0
#> 11           1      0      0      0      1

The (Intercept) is the model constant, so naturally, it’s switched on (equals 1) for every row. Each of the other columns are indicator variables. layerC turns on for the layer C rows, layerE turns on for layer E rows, and so on.

Matrix multiplying the contrast matrix by the model coefficients will compute the mean values of each layer.

Think of this equation as a contract for a contrast coding scheme: Multiplying the contrast matrix by the model coefficients should give us the means of the category levels.

mat_m1 %*% coef(m1)
#>         [,1]
#> 1  -5670.667
#> 4  -5808.000
#> 6  -5894.333
#> 9  -6109.000
#> 11 -6299.000

# Means by hand
aggregate(C14 ~ Layer, table1, mean)
#>   Layer       C14
#> 1     B -5670.667
#> 2     C -5808.000
#> 3     E -5894.333
#> 4     G -6109.000
#> 5     I -6299.000

If the matrix multiplication is too quick, here it is in slow motion where each row has been weighted (multiplied) by coefficients:

# Sums of the rows are the means
mat_m1 %*% diag(coef(m1))
#>         [,1]      [,2]      [,3]      [,4]      [,5]
#> 1  -5670.667    0.0000    0.0000    0.0000    0.0000
#> 4  -5670.667 -137.3333    0.0000    0.0000    0.0000
#> 6  -5670.667    0.0000 -223.6667    0.0000    0.0000
#> 9  -5670.667    0.0000    0.0000 -438.3333    0.0000
#> 11 -5670.667    0.0000    0.0000    0.0000 -628.3333

Successive differences coding

Now, let’s look at a different kind of coding: (reverse) successive differences coding. In this scheme:

• The intercept is the mean of the levels means
• Parameters estimate the difference between adjacent levels
• but I have to reverse how the levels are ordered in the underlying factor() so that the differences are positive, comparing each layer with the one below it. (LayerB - LayerC should be positive).

We apply this coding by creating a new factor and setting the contrast(). R lets us set the contrast to the name of a function that computes contrasts, so we use "contr.sdif".

contr.sdif <- MASS::contr.sdif

# Reverse the factor levels
table1$LayerAlt <- factor(table1$Layer, rev(levels(table1$Layer)))

contrasts(table1$LayerAlt) <- "contr.sdif"

Then we just fit the model as usual. As intended, the model’s coefficients are different.

m2 <- lm(C14 ~ 1 + LayerAlt, table1)
coef(m2)
#> (Intercept) LayerAltG-I LayerAltE-G LayerAltC-E LayerAltB-C 
#> -5956.20000   190.00000   214.66667    86.33333   137.33333

We can compute the mean of layer means and the layer differences by hand to confirm that the model parameters are computing what we expect.

# Make a list so we can write out the diffs easily
layer_means <- table1 |> 
  split(~ Layer) |> 
  lapply(function(x) mean(x$C14))
str(layer_means)
#> List of 5
#>  $ B: num -5671
#>  $ C: num -5808
#>  $ E: num -5894
#>  $ G: num -6109
#>  $ I: num -6299

data.frame(
  model_coef = coef(m2),
  by_hand = c(
    mean(unlist(layer_means)),
    layer_means$G - layer_means$I,
    layer_means$E - layer_means$G,
    layer_means$C - layer_means$E,
    layer_means$B - layer_means$C
  )
)
#>              model_coef     by_hand
#> (Intercept) -5956.20000 -5956.20000
#> LayerAltG-I   190.00000   190.00000
#> LayerAltE-G   214.66667   214.66667
#> LayerAltC-E    86.33333    86.33333
#> LayerAltB-C   137.33333   137.33333

Back to our contrast coding contract, we see that the contrast matrix matrix-multiplied by the model coefficients gives us the level means.

mat_m2 <- unique(model.matrix(m2))

mat_m2 %*% coef(m2)
#>         [,1]
#> 1  -5670.667
#> 4  -5808.000
#> 6  -5894.333
#> 9  -6109.000
#> 11 -6299.000

# By hand
aggregate(C14 ~ Layer, table1, mean)
#>   Layer       C14
#> 1     B -5670.667
#> 2     C -5808.000
#> 3     E -5894.333
#> 4     G -6109.000
#> 5     I -6299.000

It’s so clean and simple. We still get the level means and the parameters estimate specific comparisons of interest to us. So, how are the categorical variables and their differences coded in the model’s contrast matrix?

mat_m2
#>    (Intercept) LayerAltG-I LayerAltE-G LayerAltC-E LayerAltB-C
#> 1            1         0.2         0.4         0.6         0.8
#> 4            1         0.2         0.4         0.6        -0.2
#> 6            1         0.2         0.4        -0.4        -0.2
#> 9            1         0.2        -0.6        -0.4        -0.2
#> 11           1        -0.8        -0.6        -0.4        -0.2

Wait… what? 😕

The Comparison Matrix

When I first started drafting this post, I made it to this point and noped out for a few days. My curiosity did win out eventually, and I hit the books (remembered this tweet and this handout, watched this video, read this paper, and read section 9.1.2 in Applied Regression Analysis & Generalized Linear Models). Now, for the rest of the post.

The best formal, citable source for what I describe here is Schad and colleagues (2020), but what they call a “hypothesis matrix”, I’m calling a comparison matrix. I do this for two reasons: 1) to get away from hypothesis testing mindset (see Figure 1) and 2) because we are using the hypothesis matrix to apply a constraint among parameter values (remember that?).

In this approach, we define the model parameters β by matrix-multiplying the the comparison matrix C (which activates or weights different level means) and the levels means μ.

So, in the dummy-coded version of the model, we had the following comparison matrix:

The first row in C sets the Layer B as the reference value for the dummy coding. The second row turns on both Layer B and Layer C, but Layer B is negatively weighted. Thus, the corresponding model coefficient is the difference between Layers C and B.

The comparison matrix for the reverse successive difference contrast coding is similar. The first row activates all of the layers buts equally weights them, so we get a mean of means for the model intercept. Each row after the first is the difference between two layer means.

Now, here is the magic part 🔮. Multiplying both sides by the inverse of the comparison matrix will set up a design matrix for the linear model which follows the contract for the contrast matrices I described above:

So, we can invert¹ our comparison matrix to get the model’s contrast matrix:

comparisons <- c(
  .2, .2, .2, .2, .2,
   0,  0,  0,  1, -1,
   0,  0,  1, -1,  0,
   0,  1, -1,  0,  0,
   1, -1,  0,  0,  0
)

mat_comparisons <- matrix(comparisons, nrow = 5, byrow = TRUE)
solve(mat_comparisons)
#>      [,1] [,2] [,3] [,4] [,5]
#> [1,]    1  0.2  0.4  0.6  0.8
#> [2,]    1  0.2  0.4  0.6 -0.2
#> [3,]    1  0.2  0.4 -0.4 -0.2
#> [4,]    1  0.2 -0.6 -0.4 -0.2
#> [5,]    1 -0.8 -0.6 -0.4 -0.2

mat_m2
#>    (Intercept) LayerAltG-I LayerAltE-G LayerAltC-E LayerAltB-C
#> 1            1         0.2         0.4         0.6         0.8
#> 4            1         0.2         0.4         0.6        -0.2
#> 6            1         0.2         0.4        -0.4        -0.2
#> 9            1         0.2        -0.6        -0.4        -0.2
#> 11           1        -0.8        -0.6        -0.4        -0.2

Or, perhaps more commonly, we can take the contrast matrix used by a model and recover the comparison matrix, which is a nice trick when we have R automatically set the contrast values for us:

# Dummy coding example
mat_m1
#>    (Intercept) LayerC LayerE LayerG LayerI
#> 1            1      0      0      0      0
#> 4            1      1      0      0      0
#> 6            1      0      1      0      0
#> 9            1      0      0      1      0
#> 11           1      0      0      0      1
solve(mat_m1)
#>              1 4 6 9 11
#> (Intercept)  1 0 0 0  0
#> LayerC      -1 1 0 0  0
#> LayerE      -1 0 1 0  0
#> LayerG      -1 0 0 1  0
#> LayerI      -1 0 0 0  1

# Successive differences coding example
mat_m2
#>    (Intercept) LayerAltG-I LayerAltE-G LayerAltC-E LayerAltB-C
#> 1            1         0.2         0.4         0.6         0.8
#> 4            1         0.2         0.4         0.6        -0.2
#> 6            1         0.2         0.4        -0.4        -0.2
#> 9            1         0.2        -0.6        -0.4        -0.2
#> 11           1        -0.8        -0.6        -0.4        -0.2
solve(mat_m2)
#>               1    4    6    9   11
#> (Intercept) 0.2  0.2  0.2  0.2  0.2
#> LayerAltG-I 0.0  0.0  0.0  1.0 -1.0
#> LayerAltE-G 0.0  0.0  1.0 -1.0  0.0
#> LayerAltC-E 0.0  1.0 -1.0  0.0  0.0
#> LayerAltB-C 1.0 -1.0  0.0  0.0  0.0

As I said earlier, there are all kinds of contrast coding schemes which allow us to define the model parameters in terms of specific comparisons, and this post only mentions two such schemes (dummy coding and a reversed version of successive differences coding).

Finally, in Layer I of this post, the brms model

Now that we know about contrasts, and how they let us define model parameters in terms of the comparisons we want to make, we can use this technique to enforce an ordering constraint.

We set up our model as in Ben-Shachar’s post, but here we set a prior for normal(500, 250) on the non-intercept coefficients with a lower-bound of 0 lb = 0 to enforce the ordering constraint.

library(brms)
priors <- 
  set_prior("normal(-5975, 1000)", class = "Intercept") + 
  set_prior("normal(500, 250)", class = "b", lb = 0) +
  set_prior("exponential(0.01)", class = "sigma")

validate_prior(
  priors,
  bf(C14 | se(error, sigma = TRUE) ~ 1 + LayerAlt),
  data = table1
)
#>                prior     class        coef group resp dpar nlpar lb ub
#>     normal(500, 250)         b                                    0   
#>     normal(500, 250)         b LayerAltBMC                        0   
#>     normal(500, 250)         b LayerAltCME                        0   
#>     normal(500, 250)         b LayerAltEMG                        0   
#>     normal(500, 250)         b LayerAltGMI                        0   
#>  normal(-5975, 1000) Intercept                                        
#>    exponential(0.01)     sigma                                    0   
#>        source
#>          user
#>  (vectorized)
#>  (vectorized)
#>  (vectorized)
#>  (vectorized)
#>          user
#>          user

We fit the model:

m3 <- brm(
  bf(C14 | se(error, sigma = TRUE) ~ 1 + LayerAlt),
  family = gaussian("identity"),
  prior = priors,
  data = table1,
  seed = 4321,
  backend = "cmdstanr",
  cores = 4, 
  # caching
  file = "_caches/2023-07-03", 
  file_refit = "on_change"
)

We can see that the level differences are indeed positive with 95% intervals of positive values.

summary(m3)
#>  Family: gaussian 
#>   Links: mu = identity; sigma = identity 
#> Formula: C14 | se(error, sigma = TRUE) ~ 1 + LayerAlt 
#>    Data: table1 (Number of observations: 12) 
#>   Draws: 4 chains, each with iter = 2000; warmup = 1000; thin = 1;
#>          total post-warmup draws = 4000
#> 
#> Population-Level Effects: 
#>             Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> Intercept   -5957.60     27.91 -6011.89 -5900.71 1.00     1964     1715
#> LayerAltGMI   211.00     82.29    51.67   378.86 1.00     1693      939
#> LayerAltEMG   206.15     71.30    68.47   349.07 1.00     1937     1185
#> LayerAltCME   105.55     62.84     7.90   243.81 1.00     1377     1023
#> LayerAltBMC   145.95     65.13    23.63   279.12 1.00     1684      857
#> 
#> Family Specific Parameters: 
#>       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sigma    79.03     26.95    41.05   142.49 1.00     1651     2149
#> 
#> Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).
bayesplot::mcmc_intervals(m3, regex_pars = "Layer")

Estimates of the level differences.

conditional_effects(m3)

Conditional means for each layer.

Normally, I don’t think you need contrast codes

My general advice for contrast coding is to just fit the model and then have the software compute the appropriate estimates and comparisons afterwards on the outcome scale. For example, emmeans can take a fitted model, run requested comparisons, and handle multiple comparisons and p-value adjustments for us. marginaleffects probably does this too. (I really need to play with it.) And in a Bayesian model, we can compute comparisons of interest by doing math on the posterior samples (estimating things and computing differences and summarizing the distribution of the differences), but this particular model, where the coding was needed to impose the prior ordering constraint, ruled out the posterior post-processing approach.

Last knitted on 2023-07-05. Source code on GitHub.²

AOC is a yearly collection of programming puzzles throughout the first 25 days of December. I like it… so much so that I wrote an R package for completing my puzzles using the structure of an R package. The puzzles start out easy and get progressively more elaborate or devious in their requirements. But I am going to talk about an easy puzzle in this post, and specifically, one little trick I used in my solution.

Day 2 of 2022 requires us to score games of Rock Paper Scissors. The moves are encoded using letters, where our opponent’s moves are coded as A, B, C and ours are coded as X, Y, Z. So, an input describing three moves will look like the following:

example_input <- c(
  "A Y",
  "B X",
  "C Z"
)

Where the letters mean the following:

move_codes <- c(
  "A" = "rock",
  "B" = "paper",
  "C" = "scissors",
  "X" = "rock",
  "Y" = "paper",
  "Z" = "scissors"
)

This encoding seems like a weird bit of indirection thrown on, and it is, because the puzzle changes the meanings of the letters in Part 2. Still, it is straightforward to parse the input into a list of roshambo moves.

input <- example_input |> 
  strsplit(" ") |> 
  # Use character subsetting to convert letters to moves
  lapply(function(x) unname(move_codes[x])) 

# Our character's move is the second element in each vector
str(input)
#> List of 3
#>  $ : chr [1:2] "rock" "paper"
#>  $ : chr [1:2] "paper" "rock"
#>  $ : chr [1:2] "scissors" "scissors"

Now, for the point of this post, how do we score each game?

The naive approach is to start typing away furiously

before eventually noping the hell out of there.

What we have is a decision tree: we need to follow a branch for player one and another branch for player two. And here’s the main point of this post: nested lists are trees. (Yes, I love lists—see this post where I use them in my knitr reporting.) The top (outer) level of the list will be all of the player one options, and then the bottom (inner) level will be all the player two options. The nodes of the tree (bottom level values) are the outcomes of the games.

run_game <- function(pair) {
  # nested lists are trees
  rules <- list(
    rock = list(
      rock = "draw",
      scissors = "lose",
      paper = "win"
    ),
    scissors = list(
      scissors = "draw",
      rock = "win",
      paper = "lose"
    ),
    paper = list(
      paper = "draw",
      scissors = "win",
      rock = "lose"
    )
  )

  # Because `rules[[pair[1]]][[pair[2]]]` is unsightly:
  rules |>
    getElement(pair[1]) |>
    getElement(pair[2])
}

At this point, we could take a second to ponder how the structure of several nested if-elses—the actual shape of the code, indenting in and out in and in again—resembles the structure and the shape of the nested list, and ponder further about how the regular, orderly shape of code could be the whispers of hidden data, saying “list() me, list() me”. Or, we could run the code and see it in action.

input |> 
  lapply(run_game)
#> [[1]]
#> [1] "win"
#> 
#> [[2]]
#> [1] "lose"
#> 
#> [[3]]
#> [1] "draw"

# Or to repeat the input
input |> 
  stats::setNames(input) |> 
  lapply(run_game)
#> $`c("rock", "paper")`
#> [1] "win"
#> 
#> $`c("paper", "rock")`
#> [1] "lose"
#> 
#> $`c("scissors", "scissors")`
#> [1] "draw"

Earlier in the post, I used character subsetting to convert letters into moves. This process turned a matching/replacement problem into a data lookup problem. The Rock Paper Scissors are the same trick again: converting a decision tree into a data lookup problem.

Last knitted on 2022-12-06. Source code on GitHub.¹

Summoning Salt is a Youtube creator who creates documentaries that trace out the world record progression in a speedrun. The videos are immensely enjoyable, as Salt dishes out the history bit by bit, record by record, sometimes in a suspenseful fashion.

As a data visualization person, I’ve noticed that Summoning Salt recently started to use a new prop in the videos: A step graph of the world record times. The graph is developed throughout a video as players (represented by individual colors) lower the times with new records (points) until you get a full reveal of a timeline like the following:

Let’s recreate this figure in R with ggplot2.

Warp pipe: Obtaining the data

The game in question is New Super Mario Bros Wii, and the record keeper is the site speedrun.com. There is not just one speedrun category for this game, so in particular, we want the “Any%” record history (i.e., “any percent”: you don’t have play every level, and you can skip parts of the game.)

We need to get the leaderboard history data from speedrun.com. There is an official REST API for the site’s data, but it’s not straightforward how to query it to obtain the data needed for a world record progression. (Apparently, one could request the leaderboard on different dates and work backwards through time.) But that’s okay, we are not going to use the API. Instead, the statistics page for the game has a plot that is tantalizingly close to the one we want to create.

This plot is interactive, and our browser is downloading the data and plotting it for us. If we snoop around the page, we can find the JSON data behind the plot. In Firefox, when I right-click on the plot and hit “Inspect”, I see the HTML code that contains the plot. Just below the plot’s div is a chunk of Javascript.

The first line of it is all the speedrun data that is being plotted. We save that JSON into its own file.

Ground pound: Filtering and cleaning the data

Let’s read the data into R. JSON is short for “Javascript Object Notation”, and it’s basically the equivalent of a list() in R. Hence, jsonlite provides a large, deeply nested list for us.

library(tidyverse)

# a helper function to download the data from github
# in case you want to play along
path_blog_data <- function(x) {
  file.path(
    "https://raw.githubusercontent.com",
    "tjmahr/tjmahr.github.io/master/_R/data",
    x
  )
}

json_runs <- path_blog_data("2022-05-23-nsmbw-runs.json") |> 
  jsonlite::read_json()

The plot on the statistics page has a dropdown menu for different kinds of records to display, so this JSON object has a sublist for each dropdown menu choice. What we want is the first sublist (full game runs) then its first sublist (with a label of "Any% - Physical") then its "data".

# Dropdown menu choices
str(json_runs, max.level = 1)
#> List of 10
#>  $ 0   :List of 7
#>  $ 6789:List of 18
#>  $ 6805:List of 18
#>  $ 6815:List of 18
#>  $ 6826:List of 19
#>  $ 6841:List of 18
#>  $ 6846:List of 20
#>  $ 6859:List of 19
#>  $ 6868:List of 22
#>  $ 6882:List of 18

# Full game run histories
str(json_runs[[1]], max.level = 2)
#> List of 7
#>  $ :List of 7
#>   ..$ label                    : chr "Any% - Physical"
#>   ..$ data                     :List of 30
#>   ..$ borderColor              : chr "#EE4444"
#>   ..$ pointBorderColor         : chr "#EE4444"
#>   ..$ pointHoverBackgroundColor: chr "#EE4444"
#>   ..$ hidden                   : logi FALSE
#>   ..$ steppedLine              : logi TRUE
#>  $ :List of 7
#>   ..$ label                    : chr "Cannonless - Physical"
#>   ..$ data                     :List of 25
#>   ..$ borderColor              : chr "#EF8241"
#>   ..$ pointBorderColor         : chr "#EF8241"
#>   ..$ pointHoverBackgroundColor: chr "#EF8241"
#>   ..$ hidden                   : logi FALSE
#>   ..$ steppedLine              : logi TRUE
#>  $ :List of 7
#>   ..$ label                    : chr "100% - Physical"
#>   ..$ data                     :List of 17
#>   ..$ borderColor              : chr "#F0C03E"
#>   ..$ pointBorderColor         : chr "#F0C03E"
#>   ..$ pointHoverBackgroundColor: chr "#F0C03E"
#>   ..$ hidden                   : logi FALSE
#>   ..$ steppedLine              : logi TRUE
#>  $ :List of 7
#>   ..$ label                    : chr "Any% No W5 - Physical"
#>   ..$ data                     :List of 22
#>   ..$ borderColor              : chr "#8AC951"
#>   ..$ pointBorderColor         : chr "#8AC951"
#>   ..$ pointHoverBackgroundColor: chr "#8AC951"
#>   ..$ hidden                   : logi TRUE
#>   ..$ steppedLine              : logi TRUE
#>  $ :List of 7
#>   ..$ label                    : chr "Low% - Physical"
#>   ..$ data                     :List of 18
#>   ..$ borderColor              : chr "#09B876"
#>   ..$ pointBorderColor         : chr "#09B876"
#>   ..$ pointHoverBackgroundColor: chr "#09B876"
#>   ..$ hidden                   : logi TRUE
#>   ..$ steppedLine              : logi TRUE
#>  $ :List of 7
#>   ..$ label                    : chr "Any% Multiplayer - Physical"
#>   ..$ data                     :List of 11
#>   ..$ borderColor              : chr "#44BBEE"
#>   ..$ pointBorderColor         : chr "#44BBEE"
#>   ..$ pointHoverBackgroundColor: chr "#44BBEE"
#>   ..$ hidden                   : logi TRUE
#>   ..$ steppedLine              : logi TRUE
#>  $ :List of 7
#>   ..$ label                    : chr "All Regular Exits - Physical"
#>   ..$ data                     :List of 7
#>   ..$ borderColor              : chr "#6666EE"
#>   ..$ pointBorderColor         : chr "#6666EE"
#>   ..$ pointHoverBackgroundColor: chr "#6666EE"
#>   ..$ hidden                   : logi TRUE
#>   ..$ steppedLine              : logi TRUE

# Just want the data field from the first one
json_any_percent <- json_runs[[1]][[1]][["data"]]

Here are the first two points’ worth of date. We have a not-so-obviously encoded date (x), the run length in seconds (y) and the player. We are going to convert each of these lists into a dataframe and bind them together.

json_any_percent |> head(2) |> str()
#> List of 2
#>  $ :List of 4
#>   ..$ x      : int 1306670400
#>   ..$ y      : int 1616
#>   ..$ players:List of 1
#>   .. ..$ : chr "RaikerZ"
#>   ..$ link   : chr "/nsmbw/run/2216987"
#>  $ :List of 4
#>   ..$ x      : int 1325246400
#>   ..$ y      : int 1549
#>   ..$ players:List of 1
#>   .. ..$ : chr "RaikerZ"
#>   ..$ link   : chr "/nsmbw/run/2216995"

data <- json_any_percent |> 
  lapply(
    # turn one list into a dataframe
    function(x) { 
      tibble(
        date = x$x, 
        run_time_s = x$y, 
        player = x$players[[1]]
      )
    }
  ) |> 
  bind_rows()

data
#> # A tibble: 30 × 3
#>          date run_time_s player       
#>         <int>      <dbl> <chr>        
#>  1 1306670400       1616 RaikerZ      
#>  2 1325246400       1549 RaikerZ      
#>  3 1332763200       1531 RaikerZ      
#>  4 1349870400       1527 RaikerZ      
#>  5 1457179200       1526 GreenUprooter
#>  6 1461585600       1523 Auchgard     
#>  7 1461672000       1522 Auchgard     
#>  8 1461758400       1519 Auchgard     
#>  9 1470744000       1514 Auchgard     
#> 10 1471521600       1512 Auchgard     
#> # … with 20 more rows

Lastly, we need to do something about those dates. When you see a date-time represented by a single large number, it’s probably a POSIX date representing the date-time as the number of seconds since some origin date-time (see also Unix Time). Using the default Unix origin time seems to give the correct date conversion:

data <- data |> 
  mutate(
    date_posix = as.POSIXct(date, tz = "UTC", origin = "1970-01-01")
  ) 

data
#> # A tibble: 30 × 4
#>          date run_time_s player        date_posix         
#>         <int>      <dbl> <chr>         <dttm>             
#>  1 1306670400       1616 RaikerZ       2011-05-29 12:00:00
#>  2 1325246400       1549 RaikerZ       2011-12-30 12:00:00
#>  3 1332763200       1531 RaikerZ       2012-03-26 12:00:00
#>  4 1349870400       1527 RaikerZ       2012-10-10 12:00:00
#>  5 1457179200       1526 GreenUprooter 2016-03-05 12:00:00
#>  6 1461585600       1523 Auchgard      2016-04-25 12:00:00
#>  7 1461672000       1522 Auchgard      2016-04-26 12:00:00
#>  8 1461758400       1519 Auchgard      2016-04-27 12:00:00
#>  9 1470744000       1514 Auchgard      2016-08-09 12:00:00
#> 10 1471521600       1512 Auchgard      2016-08-18 12:00:00
#> # … with 20 more rows

Triple jump: Plotting

First, let’s get the data on the panel. I could spend an endless amount of time tweaking or customizing a plot’s theme, so I do the styling last. Otherwise, styling would fill up all of the time I’ve set aside to work on the plot.

We want to draw a point for each particular record-setting event, and we want to draw a line that connects all of the points. geom_step() draws a line plot but it can move straight up/down or straight left/right—no diagonal lines—so it’s what we want. We also want to the color of these geometries to change with the record holder (player).

ggplot(data) + 
  aes(x = date_posix, y = run_time_s, color = player) + 
  geom_step() +
  geom_point()

Oops! It assumed that we wanted to connected the dots separately for each color. We have to set the group aesthetic to a constant value so there is only one line drawn.

ggplot(data) + 
  aes(x = date_posix, y = run_time_s, color = player) + 
  geom_step(aes(group = 1)) +
  geom_point()

Making the Summoning Salt version is just a matter of theming at this point. We use theme_void() to completely wipe out the current theme, and we hide the color legend.

ggplot(data) + 
  aes(x = date_posix, y = run_time_s, color = player) + 
  geom_step(aes(group = 1)) +
  geom_point() + 
  theme_void() +
  guides(color = "none")

Next, we are going to use the showtext package to obtain an 8-bit font:

library(showtext)
#> Loading required package: sysfonts
#> Loading required package: showtextdb
font_add_google("Press Start 2P")
showtext_auto(TRUE)

The void theme provides nothing, so we have to specify the main colors, the axis lines, and the plotting margin. We also crank up the chroma values to have more intense colors for the black background.

ggplot(data) + 
  aes(x = date_posix, y = run_time_s, color = player) + 
  geom_step(aes(group = 1)) +
  geom_point() +
  guides(color = "none") + 
  scale_color_discrete(c = 255) +
  labs(title = "World Record Timeline") +
  theme_void(base_size = 20, base_family = "Press Start 2P") +
  theme(
    plot.title = element_text(color = "white", hjust = .5), 
    plot.background = element_rect(fill = "black"),
    axis.line = element_line(
      color = "white", 
      size = 1, 
      # more 8-bit looking lines
      lineend = "square"
    ), 
    plot.margin = margin(12, 12, 12, 12, "pt")
  ) 

To keep overlapping points from looking like blobs, we can use a filled point. For these, color is used on the border and fill is used on the inside. We will set the outline of the points to black and the fill to the player color. (If you look at more professional data visualizations, you see this trick frequently with white bordering around points.) With a new fill aesthetic in place, e have to make sure that guide for the fill doesn’t appear and that fill and color have the same color scale.

ggplot(data) + 
  aes(x = date_posix, y = run_time_s, color = player) + 
  geom_step(aes(group = 1)) +
  geom_point() +
  geom_point(
    aes(fill = player),
    shape = 21,
    color = "black", 
    size = 2
  ) +
  # no legend for fill
  guides(color = "none", fill = "none") + 
  # fill and color get same scale
  scale_color_discrete(c = 255, aesthetics = c("color", "fill")) +
  labs(title = "World Record Timeline") +
  theme_void(base_size = 20, base_family = "Press Start 2P") +
  theme(
    plot.title = element_text(color = "white", hjust = .5), 
    plot.background = element_rect(fill = "black"),
    axis.line = element_line(
      color = "white", 
      size = 1, 
      lineend = "square"
    ), 
    plot.margin = margin(12, 12, 12, 12, "pt")
  ) 

Finally, let’s make another version of this figure. How might we make a more accessible presentation of this information (of who held a record and when), assuming that we only have a static image? A legend with players/colors is a nonstarter. We could give each player their own distinct point shape so that color/shape encode the same information, but shapes get rough once you have to use more than four of them. We could use a player’s first letter instead of a point (show an F for FadeVanity) but the letters quickly overlap.

One idea would be to label the point with an annotation whenever there is a new record holder.

showtext_auto(FALSE)
data <- data |>
  mutate(
    # Remove the country flag annotation from this player
    player2 = ifelse(
      player == "[gb/eng]FadeVanity", 
      "FadeVanity", 
      player
    ),
    # Record whenever the title holder changes as an "era"
    change = player != lag(player) | is.na(lag(player)),
    era = cumsum(change)
  ) 

# I am going to hardcode some vertical position adjustments for the labels.
offsets <- c(1, 2, 1, 5, -1, 5, 4, 3, 2, 1, -4, -3, -2, -1)

data_lab <- data |> 
  group_by(era) |> 
  # Label the last point in an era
  filter(run_time_s == max(run_time_s)) |> 
  ungroup() |> 
  mutate(offset = offsets)

nudge_factor <- 30
ggplot(data) + 
  aes(x = date_posix, y = run_time_s, color = player) + 
  geom_text(
    aes(
      label = player2,
      y = run_time_s + nudge_factor * offset 
    ),
    hjust = 0,
    size = 4,
    data = data_lab
  ) +
  geom_segment(
    aes(
      # i.e., run the line up to .95 of the label's nudging
      yend = run_time_s + nudge_factor * offset * .95, 
      xend = date_posix
    ),     
    data = data_lab, 
    linetype = "dashed"
  ) + 
  geom_step(aes(group = 1), size = 1) +
  geom_point(size = 3) +
  # yes, I'm adding forty million seconds to the last datetime
  expand_limits(x = max(data$date_posix) + 4e7) +
  guides(color = "none") +
  scale_x_datetime(
    name = NULL,
    date_breaks = "2 years", 
    date_labels = "%Y"
  ) +
  scale_y_continuous(
    name = "World record",
    breaks = 21:27 * 60,
    # Show the minutes value with zero-padded seconds
    labels = function(x) sprintf("%d:%02.f", x %/% 60, x %% 60)
  ) + 
  theme_minimal(base_size = 14) +
  theme(plot.margin = margin(12, 12, 12, 12, "pt"))

Last knitted on 2022-05-27. Source code on GitHub.¹

I’d like to submit this one from Morgan Stanley 🤦🏻‍♂️ pic.twitter.com/D5CYi6zSrT

— Travis Whitfill MPH (@twhitfill) March 21, 2022

The main statistical problem here is the completely inappropriate “smoothing” line. The panel on the left is really two linear trends: a steady trend around 8,500 patients until May 6th and a decreasing trend from 11,000 patients starting on May 7th. Upon seeing data like these points, I would be inclined to ask, “What changed in the data? Was a new state added to the dataset? Did the definition of what counts as an ICU bed change?” The analysts here instead imposed a linear trend on the points.

Another problem with this plot is rhetorical: it’s tryhard counterintuitive bullshit. I think analysts will fetishize surprising or counterintuitive findings, with an attitude of “oh, you would think that such-and-such is true but the data show us that actually the opposite is true”. At the time of this plot, our belief was something like “Covid-19 protections like stay-at-home orders can help flatten the curve and reduce the spread of the disease and the number of hospitalizations.” This plot sashays into the room and tells us “well, according to the data, it’s the states without Covid-19 protections that have decreasing numbers of ICU patients, and get this: Covid lockdowns make things worse!”. Granted, I could not find the original report for this image, so I don’t know how the authors interpreted it in the report’s narrative. Yet, I can only assume the authors added these linear trend lines–overriding the default GAM or LOESS smooth used by stat_smooth()–to make this particular point.

When I first saw it, this plot made me quip: “I hate statistics now. it’s been a good run. gonna live my days out as a druid”. But it’s been a few days, and I’m still haunted by this plot. What did go wrong? Why do the ICU counts shoot upwards like that? So, I investigated it.

Attempt 1: There is no jump

I tried to find the original report, searching Google and Twitter for a report with this image from around May 12, 2020 (when @twhitfill first shared it), but nothing came up. After dredging through a bunch of Morgan Stanley report PDFs, I noticed that the reports usually had a small number of authors, so I am wondering whether (and hoping that) the original report was something more akin to a dashed-off newsletter than a research report.

Failing to find the original image, I tried to recreate it in R. The original image credits The COVID Tracking Project, and their downloads page provides a .csv file with state-level data. Here we read in just the relevant columns, filter down to the time range of the cursed image, and plot the total number of current ICU patients.

library(tidyverse)

# a helper function to download the data from github
# in case you want to play along
path_blog_data <- function(x) {
  file.path(
    "https://raw.githubusercontent.com",
    "tjmahr/tjmahr.github.io/master/_R/data",
    x
  )
}

data <- readr::read_csv(
  path_blog_data("all-states-history.csv"), 
  col_types = cols(
    date = col_date(), 
    state = col_character(), 
    inIcuCurrently = col_number(), 
    .default = col_skip()
  ), 
  progress = FALSE
)

data <- data %>% 
  filter(
    as.Date("2020-04-28") <= date,
    date <= as.Date("2020-05-11")
  )

ggplot(data) + 
  aes(x = date, y = inIcuCurrently) + 
  stat_summary(fun = "sum", geom = "point", size = 3) +
  labs(
    x = "Date", 
    y = "Current patients in ICU",
    caption = "Data from The COVID Project (March 23, 2022)"
  ) +
  theme_grey(base_size = 16)
#> Warning: Removed 454 rows containing non-finite values (stat_summary).

There is no jump in ICU patients ❌, and because the jump disappeared when we used a more recent (and presumably better) version of the dataset, the jump was probably some kind of artifact.

Out of curiosity, let’s look at the state-by-state data. Because (spoiler alert) about half the states only have NA values for this time period, we will filter out the NA points and look at the remaining points.

ggplot(data %>% filter(!is.na(inIcuCurrently))) + 
  aes(x = date, y = inIcuCurrently) + 
  geom_point() +
  facet_wrap("state") +
  labs(
    x = "Date", 
    y = "Current patients in ICU",
    caption = "Data from The COVID Project (March 23, 2022)"
  ) +   
  theme_grey(base_size = 12)

So, some states have ICU patient data added midway through this window and many states are completely missing data from this window. The whole open-versus-closed-states question was doomed from the get-go because we don’t know what happened in every state.

Attempt 2: Let’s go back in time

If we poke around the COVID Tracking Project’s GitHub repository, we find a folder of data backups with a file called states_daily_4pm_et.csv. This file provides the same result as the previously loaded data.

data <- readr::read_csv(
  path_blog_data("states_daily_4pm_et.csv"), 
  col_types = cols(
    date = col_date("%Y%m%d"),
    state = col_character(),
    inIcuCurrently = col_number(),
    .default = col_skip()
  ),
  progress = FALSE
)

data <- data %>% 
  filter(
    as.Date("2020-04-28") <= date,
    date <= as.Date("2020-05-11")
  )

ggplot(data) + 
  aes(x = date, y = inIcuCurrently) + 
  stat_summary(fun = "sum", geom = "point", size = 3) +
  labs(
    x = "Date", 
    y = "Current patients in ICU",
    caption = "Data from The COVID Project (March 23, 2022)"
  ) +
  theme_grey(base_size = 16)
#> Warning: Removed 454 rows containing non-finite values (stat_summary).

But because this file is hosted on GitHub, we can go back in time and find the version of the data from May 12, 2020 and use that file instead.

data <- readr::read_csv(
  path_blog_data("2020-05-12-states_daily_4pm_et.csv"), 
  col_types = cols(
    date = col_date("%Y%m%d"),
    state = col_character(),
    inIcuCurrently = col_number(),
    .default = col_skip()
  ),
  progress = FALSE
)

data <- data %>% 
  filter(
    as.Date("2020-04-28") <= date,
    date <= as.Date("2020-05-11")
  )

ggplot(data) + 
  aes(x = date, y = inIcuCurrently) + 
  stat_summary(fun = "sum", geom = "point", size = 3) +
  labs(
    x = "Date", 
    y = "Current patients in ICU",
    caption = "Data from The COVID19 Project (May 12, 2020)"
  ) +
  theme_grey(base_size = 16)
#> Warning: Removed 477 rows containing non-finite values (stat_summary).

There it is: the jump ICU patients on May 7th ✔️. Let’s look at the state-by-state data:

ggplot(data %>% filter(!is.na(inIcuCurrently))) + 
  aes(x = date, y = inIcuCurrently) + 
  geom_point() +
  facet_wrap("state") +
  labs(
    x = "Date", 
    y = "Current patients in ICU",
    caption = "Data from The COVID Project (May 12, 2020)"
  ) +
  theme_grey(base_size = 12)

Look at New York (NY)! That’s the jump in original plot. New York had a large number of ICU patients but their data only became available on May 7th, giving the spurious increase in ICU patients.

By adding incomplete data from NY to the rest of the states, the analyst effectively treated all of the missing points in the NY panel as zeros.

What could they have done differently?

It’s fun to complain about haunted plots, but I will try to be constructive for a moment. How would a fixed version of this plot look?

Option 1: Don’t do it. Given all the missing and incomplete data, it’s just not worth it to make this plot.

Option 2: Don’t aggregate. Or we might embrace the missingness, and show all and only the data we have. Here is a sketch of this kind of approach. We will show individual state data and provide labels for the states that stand out from the pack. We will also note the number of missing lines in the caption.

data_for_plot <- data %>% 
  filter(!is.na(inIcuCurrently)) %>% 
  group_by(state) %>%
  mutate(state_icu_max = max(inIcuCurrently)) %>% 
  ungroup() 

total_regions <- data$state %>% unique() %>% length()
plotted_regions <- data_for_plot$state %>% unique() %>% length()

ggplot(data_for_plot) + 
  aes(x = date, y = inIcuCurrently) + 
  geomtextpath::geom_textline(
    aes(label = state, group = state, hjust = state),
    data = . %>% filter(state_icu_max > 250)
  ) +
  geomtextpath::scale_hjust_discrete() +
  geom_line(
    aes(group = state),
    data = . %>% filter(state_icu_max <= 250)) +
  labs(
    x = "Date", 
    y = "Current patients in ICU",
    caption = glue::glue(
      "
      Data from The COVID Project (May 12, 2020).
      No data available for {total_regions - plotted_regions} states/territories.
      "
    )
  ) + 
  theme_grey(base_size = 14)

And then we can put the linear regression “smooth” on it. 🙃

Update: Notes from the Tracking Project trenches [Mar. 24, 2022]

After releasing this post, COVID Tracking Project alum Quang Nguyen shared some behind the scenes details of what happened around May 7th, 2020. I will repost the Twitter thread here:

OMG @COVID19Tracking history lesson (short 🧵)!! First, shoutout to our data infrastructure folks @zachlipton @JuliaKodysh for the GitHub archive! Second, I actually dug through the slack to figure out what happened (jokes on me, I was shift lead that day). https://t.co/7U6LOm8HKE pic.twitter.com/iXdPO9EV6A

— Quang Nguyen (@quangpmnguyen) March 24, 2022

The problem was, back in May 2020, the only way you can get hospitalization data for the state of NY was to take low-res screenshots of the governor's presentation and then try to piece the information together (also shoutout to @justinhendrix for watching these press conf.). pic.twitter.com/5UnGP1RUox

— Quang Nguyen (@quangpmnguyen) March 24, 2022

Using this weird graph, we actually tried to back-calculate total hospitalization numbers, but unfortunately, it was super messy and nothing came out of it. This source also doesn't have current ICU numbers.

— Quang Nguyen (@quangpmnguyen) March 24, 2022

We actually found a new source from Twitter (!!) who apparently got these numbers from a press email list from the governor (??). May 7th was the first day where we got data directly from the email list, which was the BLIP in total ICU data that made it onto the disastrous graph.

— Quang Nguyen (@quangpmnguyen) March 24, 2022

The bottom line is: data from 2020 was a mess, and don't trust anything that came out of it. A group of volunteers taped it together using nothing but hot glue and scotch tape.

— Quang Nguyen (@quangpmnguyen) March 24, 2022

The fact they had to pull numbers from the graphs in the Governor’s Covid briefings is an important reminder that high-quality Covid-19 was hard to come by at the start of the pandemic (especially from the Cuomo administration). We needed something like the COVID Tracking Project where volunteers would go to heroic lengths to curate data.

Last knitted on 2022-05-27. Source code on GitHub.¹