Variance Explained

Machine learning in a hurry: what I've learned from the SLICED ML competition

2021-07-21T20:00:00+00:00

This summer I’ve been competing in the SLICED machine learning competition, where contestants have two hours to open a new dataset, build a predictive model, and be scored as a Kaggle submission. Contestants are graded primarily on model performance, but also get points for visualization and storytelling, and from audience votes. Before SLICED I had almost no experience with competitive ML, so I learned a lot!

For four of the SLICED episodes (including the two weeks I was competing) I shared a screencast of my process. Episodes 4 and 7 were the ones I was competing live (you can also find the code here):

If you watch just one, I recommend AirBnb, which was a blast! (It was easily my favorite dataset of the competition, with a mix of text, geographic, and categorical data- though episode 1 and episode 8 were also delightful).

In this post, I’ll share some of what I’ve learned about using R, and the tidymodels collection of packages, for competitive Kaggle modeling.

The tidymodels packages

For years Python has had a solid advantage in tooling for machine learning (scikit-learn is just dynamite), but R has been catching up fast. The tidyverse team at RStudio has been developing the tidymodels suite of packages to play well with the tidyverse tools. This was the first time I’d really gotten in-depth experience with them, and I’ll share what I liked (and didn’t).

Pit of success

The “pit of success”, in contrast to a “summit of success” or a “pit of doom”, is the philosophy that users shouldn’t have to strive and struggle to do the right thing. They should be able to fall into good habits almost by accident, because it’s easier than using them incorrectly.

There’s a lot of traps you can fall into when doing machine learning, and the tidymodels packages are designed to avoid those “without thinking”. I think the single most impressive one is avoiding data leakage during your data cleaning.

Recipes and data leakage

Think of a few of the many feature engineering steps we might apply to a dataset before fitting a model:

Imputing missing values (e.g. with mean)
Dimensionality reduction (e.g. with PCA)
Bucketing rare categories (e.g. replacing rare levels of a categorical variable with “Other”)

The recipes package offers functions for performing these operations (like step_impute_mean, step_pca, and step_other), but that’s only part of its value. The brilliant insight of the recipes packages is that each of those feature engineering steps is itself a model that needs to be trained! If you include the test set when you’re imputing values with their mean, or when you’re applying PCA, you’re accidentally letting in information from the test set (which makes you more likely to overfit and not realize it).

The recipes package makes this explicit: a recipe has to be trained on data (with prep()) before it is applied to a dataset (with bake()). By combining this recipe with a model specification into a workflow object, you encapsulate the entire start-to-end process of feature engineering and modeling. Other tidymodels tools then take advantage of this encapsulated workflow.

Other packages

I’ve found each of the other packages also plays a role in the tidymodels “pit of success”. For instance:

Cross validation (rsamples): Cross validation is one of the key ways to avoid overfitting, especially when selecting models and choosing hyperparameters. vfold_cv and fit_resamples make it easy.
Tuning hyperparameters (tune): tune_grid makes it trivial to specify a combination of hyperparameters see how the performance varies. autoplot() in particular has a real “does exactly what I want out of the box” feel.
Trying different models (parsnip): I really like not having to deal with each modeling package’s idiosyncrasies of inputs and outputs; less time reading docs means more time focusing on my model and data.
Text classification (textrecipes): This has a special place in my heart. I helped develop the tidytext package, but I’ve never been completely thrilled with how it fit into a machine learning workflow. By providing tools for tokenization and filtering, the textrecipes package turns text into just another type of predictor.

These conveniences aren’t just a matter of saving effort or time; together they add up to a more robust and effective process. Prior to tidymodels, I might have just skipped tuning a parameter, or stopped with the first model type I tried, because iterating would be too difficult (a phenomenon known as shlep blindness).

Some of the resistance I’ve seen to tidymodels comes from a place of “This makes it too easy- you’re not thinking carefully about what the code is doing!” But I think this is getting it backwards. By removing the burden of writing procedural logic, I get to focus on scientific and statistical questions about my data and model.

Silly complaint: "this tool keeps you from thinking." No one stops thinking when they use good tools. They think about more important things
— David Robinson (@drob) August 26, 2016

Where tidymodels can improve

I wasn’t happy with everything about the tidymodels packages, especially when I first started the competition. In some cases I felt the API forced excessive piping when they could have used function arguments, making the model specifications much more verbose than they had to be. And as I’ll discuss later, the stacks package still feels like a terrific idea with a rough draft implementation.

But the great news is that the team is continuing to improve it! I opened two GitHub issues (parsnip and workflows) in the course of my SLICED competition, and by the time I reached my second lap they were already fixed!¹

In tonight's #SLICED, gonna be rocking the development versions of parsnip & workflows

A. parsnip models now have a default instead of needing set_engine()
B. workflow() now takes a preprocessor / spec argument

💕 the recent work from the tidymodels team https://t.co/2O4Xfen2kU pic.twitter.com/9yI4FYTilu
— David Robinson (@drob) July 14, 2021

Gradient boosted trees are incredible, and easy to tune

Now that I’ve talked about the tools, I’ll get to the machine learning itself.

I know I’m just about the last person to appreciate this, but it was remarkable how powerful xgboost was at creating high performance models quickly. When I was practicing for the competition, I honed in on a process early on. Something like:

Pick out the numeric variables, or the low-cardinality categorical ones
Mean-impute missing values, if any
Fit an xgboost boosted trees model, with learn_rate = .02, mtry varying from 2-4, and trees varying from 300 to 800
Plot a learning curve (showing the performance as the number of trees varies), and use it to adjust mtry and trees if needed.

In most of the episodes, this rote process usually me most of the way to my final model! It almost always outperformed anything I could get from linear or random forest models even with heavy feature engineering and tuning. The process is especially convenient because you can get an entire learning curve (varying the number of trees) from a single model fit, so it’s a very fast use of the tune package.

This is very different from my experience with keras (a deep learning framework), which I found I’d usually have to spend a solid amount of time fiddling with hyperparameters before I could even beat a random forest. It’s certainly possible that keras could have been beaten some of my boosted trees, but I doubt I would have gotten to it nearly as quickly.

In my own professional work I usually like to build interpretable models, make visualizations, and understand the role of each feature. But boosted trees are farther in the direction of “black boxes”. But competitive ML has an amusing way of “focusing the mind” on a performance metric.

Besides which, I was impressed how much I could learn from an importance measure like Gini coefficient. Unlike the features in a linear model, these could represent interesting nonlinear terms, and it helped highlight unimportant terms I could drop from the model. Speaking of which…

Even with xgboost, feature engineering can still help!

Something I quickly discovered with xgboost is that providing too many features could easily hurt it. Low-value features in an xgboost dilute the importance of the remaining ones, since they show up in fewer randomly selected trees. This is in contrast to regularized linear regression (e.g. LASSO), where it’s usually pretty easy for the penalty term to set extra coefficients to zero.

This pops up when we have categorical predictors. If a category has 20 levels, then when turned into one-hot encoding that’s 20 additional binary variables. Those end up in a lot more trees than (say) one or two highly predictive models. I tended to find that my models performed better when I just removed high-cardinality variables up front (my understanding is that catboost might handle these more gracefully!)

Stacking models is even better!

Once you’ve hit a point of diminishing returns when tuning a model, it’s often better to start fresh with another model that makes a different kind of error, and average their predictions together. This is the principle behind model stacking, a type of ensemble learning.

I’ve been using the stacks package for creating these blended models:

A perfect example was in the AirBnb pricing video. I was able to get to a strong model with xgboost based on numeric variables like latitude/longitude (very effective with trees!) and a few categorical variables.

But the data also included sparse categorical variables like neighborhood, and a text field (the apartment name) where tokens like “townhouse” or “studio” had a lot of predictive power

The stacks package puts this process within the tidymodels framework. Of all the tidymodels packages I’ve used, the stacks package is the one that’s most clearly in an early state. For starters, it’s overly opinionated about the way it combines models, always using a regularized linear model with bootstrapped cross validation. Partly because of that, it’s slow even when combining just two or three models. And I’ve found that it sometimes gives unhelpful errors when the inputs aren’t set up correctly, which suggests it needs some heavier “playtesting”.

Conclusion: I need to learn to meme

I learned a lot about tidymodels and machine learning in the process of competing. But my favorite part of the experience was that because it was hosted publicly on Kaggle, people watching the competition live could compete themselves (often outperforming the contestants!)

This meant we got to learn as a community, and joke around too.

This thread is for @kierisi and @kierisi only. If you're not @kierisi you can scroll past.

ARTISINAL SLICED MEMES FOR JESSE, a 🧵: pic.twitter.com/mYHR3bobGE
— Chelsea Parlett-Pelleriti (@ChelseaParlett) June 23, 2021

My competitor Jesse Mostipak came up with a brilliant schtick of showing memes on screen while her models were training:

This was at least one of the reasons she crushed me in the chat voting portion of our competition (and one of the reasons I’m trying out some memes in this post. Better late than never!)

No matter how far I make it in the playoffs, I’ll be joining in with some submissions every chance I get, and I’m honored to have had the chance to learn with everyone.

Thanks especially to my friend and colleague Julia Silge, who works on the tidymodels packages full time and helped talk through some of my thoughts and feedback on the packages. ↩

The 'circular random walk' puzzle: tidy simulation of stochastic processes in R

2020-11-23T23:40:00+00:00

Previously in this series

I love 538’s Riddler column, and I’ve enjoyed solving the November 20th puzzle. I’ll quote:

To celebrate Thanksgiving, you and 19 of your family members are seated at a circular table (socially distanced, of course). Everyone at the table would like a helping of cranberry sauce, which happens to be in front of you at the moment.

Instead of passing the sauce around in a circle, you pass it randomly to the person seated directly to your left or to your right. They then do the same, passing it randomly either to the person to their left or right. This continues until everyone has, at some point, received the cranberry sauce.

Of the 20 people in the circle, who has the greatest chance of being the last to receive the cranberry sauce?

I’ll solve this with tidy simulation in R, as usual using one of my favorite functions, tidyr’s crossing(), and getting another chance to explore a variation of a “random walk”.

Simulating a table of 20

What’s fun about this problem is that it’s an example of a random walk: a stochastic process made up of a sequence of random steps (in this case, left or right). What makes this a fun variation is that it’s a random walk in a circle- passing 5 to the left is the same as passing 15 to the right. I wasn’t previously familiar with a random walk in a circle, so I approached it through simulation to learn about its properties.

Simulating a random walk in a circle

The classic way to simulate a random walk in R is with cumsum() and sample(). sample(c(1, -1)) picks a random direction for each step, and cumsum() takes the cumulative sum of those steps:

cumsum(sample(c(1, -1), 30, replace = TRUE))

##  [1] 1 2 3 4 5 6 7 6 5 6 5 6 5 6 7 6 5 6 7 6 5 6 5 4 5 4 3 4 5 4

Right now this is a random walk on integers (…, -2, -1, 0, 1, 2, …). To make this a random walk at a circular table of 20, you can use the modulo operator, %% 20.

cumsum(sample(c(1, -1), 30, replace = TRUE)) %% 20

##  [1]  1  0 19 18 17 16 17 18 19 18 19 18 19 18 17 18 19  0 19  0 19  0  1  2  1  2  3
## [28]  4  5  4

Notice that the cranberry sauce can now be passed from 0 to 19 and then back.

Simulating many walks with crossing()

We’ll simulate 50,000 trials (feel free to increase or decrease that number, depending on how accurate you need your simulation to be). For each, we’ll try 1000 steps.

library(tidyverse)

# For the sake of efficiency, perform only the cumulative sum
# as a grouped operation
sim_steps <- crossing(trial = 1:50000,
                      step = 1:1000) %>%
  mutate(direction = sample(c(1, -1), n(), replace = TRUE)) %>%
  group_by(trial) %>%
  mutate(position = cumsum(direction)) %>%
  ungroup() %>%
  mutate(seat = position %% 20)

sim_steps

## # A tibble: 50,000,000 x 5
##    trial  step direction position  seat
##    <int> <int>     <dbl>    <dbl> <dbl>
##  1     1     1         1        1     1
##  2     1     2        -1        0     0
##  3     1     3        -1       -1    19
##  4     1     4         1        0     0
##  5     1     5        -1       -1    19
##  6     1     6         1        0     0
##  7     1     7        -1       -1    19
##  8     1     8         1        0     0
##  9     1     9         1        1     1
## 10     1    10         1        2     2
## # … with 49,999,990 more rows

We end up with 10 million steps, each representing the position of the cranberry sauce at one point in time.

How long does it take for the cranberry sauce to reach each seat for the first time? We can use distinct() with .keep_all = TRUE to answer that: we keep the first time each seat appears in each trial. (We also filter out seat 0, which is you, because you start with the cranberry sauce on step 0).

sim <- sim_steps %>%
  distinct(trial, seat, .keep_all = TRUE) %>%
  filter(seat != 0)

sim

## # A tibble: 949,995 x 5
##    trial  step direction position  seat
##    <int> <int>     <dbl>    <dbl> <dbl>
##  1     1     1         1        1     1
##  2     1     3        -1       -1    19
##  3     1    10         1        2     2
##  4     1    14        -1       -2    18
##  5     1    43        -1       -3    17
##  6     1    50        -1       -4    16
##  7     1    63        -1       -5    15
##  8     1    64        -1       -6    14
##  9     1    65        -1       -7    13
## 10     1    66        -1       -8    12
## # … with 949,985 more rows

Summarizing and visualizing

Now that we have our simulation with one row for each seat in each trial, we can learn stats about each seat. Which is the best seat to be in? Which is most likely to be last?

by_seat <- sim %>%
  group_by(trial) %>%
  mutate(is_last = row_number() == 19) %>%
  group_by(seat) %>%
  summarize(avg_step = mean(step),
            pct_last = mean(is_last),
            avg_length_last = mean(step[is_last]))

This isn’t the Riddler’s question, but it’s the first one I was interested in: how long does it take for each seat, on average, to get the cranberry sauce?

by_seat %>%
  ggplot(aes(seat, avg_step)) +
  geom_line() +
  expand_limits(y = 0) +
  labs(x = "Seat",
       y = "Average # of steps to reach this seat")

It looks like a parabola. The best seat to be in is either #1 or #19, immediately to the right or left of the starting position: on average they’re waiting about 19 steps to get it. The worst seat to be in is #10, directly across the table. On average they’re waiting about 100 steps to get it. Overall, this makes intuitive sense: the closer you are to the original sauce, the more likely you can get it right away.

What I love about tidy simulation is that I can visualize some more details about the distribution, such as with a histogram on a log scale.

sim %>%
  ggplot(aes(step)) +
  geom_histogram() +
  scale_x_log10() +
  facet_wrap(~ seat, scales = "free_y") +
  labs(x = "Step on which this seat gets the cranberry sauce",
       y = "")

The seats immediately to your left and right, 1 and 19, have a mode of 1 step (which makes sense: they have a 50% chance of getting it on the first step). For seats that are roughly across the table (like 7-13), the number of steps looks roughly log-normally distributed.

Now let’s answer the Ridder’s question: how likely is each seat to be the last person to get the cranberry sauce?

by_seat %>%
  ggplot(aes(seat, pct_last)) +
  geom_line() +
  scale_y_continuous(labels = scales::percent) +
  geom_hline(yintercept = 1 / 19, lty = 2, color = "red") +
  expand_limits(y = 0) +
  labs(x = "Seat",
       y = "% this is the last seat to get cranberry sauce")

That’s a very different story! Other than a little random noise, the 19 people at the table all have the same probability of being the last to receive the cranberry sauce. (The probability is therefore 1/19, shown by the dashed red line).

This wasn’t what I originally expected, but upon consideration it makes sense. Consider the person at seat 10 (directly across the table from you). We know it will take longer for them to get the sauce, but consider what it would take to be last. Imagine the moment that the sauce first reaches either person 9 or person 11 (one of which has to happen first). At that moment, the situation is analogous. to the person seated immediately to the original left or right: the sauce would have to make a full circle of the table before going just one step. The same would apply to any seat $s$, by breaking it down into the situation where the sauce reaches either $s-1$ or $s+1$.

Larger table sizes

Something I love about crossing() for simulation is that you can keep adding complexity to the question you’re asking. What if there weren’t 20 people at the table, but some arbitrary $n$? We’ll try 20, 30, and 40, doing 20K simulations each.

# Repeat all of the above, but with an extra crossing() step
sim_size <- crossing(trial = 1:20000,
                           step = 1:2000) %>%
  mutate(direction = sample(c(1, -1), n(), replace = TRUE)) %>%
  group_by(trial) %>%
  mutate(position = cumsum(direction)) %>%
  ungroup() %>%
  crossing(table_size = c(20, 30, 40)) %>%
  mutate(seat = position %% table_size) %>%
  distinct(table_size, trial, seat, .keep_all = TRUE) %>%
  filter(seat != 0)

# Group by table_size as well
by_seat_size <- sim_size %>%
  group_by(table_size, trial) %>%
  mutate(is_last = row_number() == table_size - 1) %>%
  group_by(table_size, seat) %>%
  summarize(avg_step = mean(step),
            pct_last = mean(is_last),
            avg_length_last = mean(step[is_last]))

We can confirm that the “all seats are equally likely to get the sauce last” holds true for every table size.

But we can also take a closer look at that parabola for the average # of steps to reach each position. Can we figure out a closed form solution for it?

A few patterns we notice, where $n$ is the table size.

The peak for each is at seat $n / 2$, which takes on average $(n / 2) ^ 2 steps$.
The average for seats 1 and $n-1$ (the people seated immediately to your left/right) is $n-1$.

We can get a bit more precise by fitting a parabola to each of the seat size results, using the broom package to combine the linear models.

by_seat_size %>%
  mutate(linear = seat,
         quadratic = seat ^ 2) %>%
  group_by(table_size) %>%
  summarize(mod = list(lm(avg_step ~ quadratic + linear)),
            td = map(mod, broom::tidy, conf.int = TRUE)) %>%
  unnest(td) %>%
  ggplot(aes(table_size, estimate)) +
  geom_line() +
  geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .1) +
  facet_wrap(~ term)

The intercept is indistinguishable from 0, the linear term is equal to the table size, and the quadratic term stays at -1. This suggests that the average number of steps to reach a seat $s$ is $-s^2+n*s$. (This matches our results for the maximum and the $s=1$ point above).

As I often note in these posts, I love how doing some simulation can lead us to an exact solution (even if we can’t yet prove it).

The 'prisoner coin flipping' puzzle: tidy simulation in R

2020-05-04T19:10:00+00:00

Previously in this series

I love 538’s Riddler column, and I’ve enjoyed solving the May 1st puzzle. I’ll quote:

You are locked in the dungeon of a faraway castle with three fellow prisoners (i.e., there are four prisoners in total), each in a separate cell with no means of communication. But it just so happens that all of you are logicians (of course)….

Each prisoner will be given a fair coin, which can either be fairly flipped one time or returned to the guards without being flipped. If all flipped coins come up heads, you will all be set free! But if any of the flipped coins comes up tails, or if no one chooses to flip a coin, you will all be doomed to spend the rest of your lives in the castle’s dungeon.

The only tools you and your fellow prisoners have to aid you are random number generators, which will give each prisoner a random number, uniformly and independently chosen between zero and one.

What are your chances of being released?

I’ll solve this with tidy simulation in R, in particular using one of my favorite functions, tidyr’s crossing(). In an appendix, I’ll show how to get a closed form solution for $N=4$.

I’ve also posted a 30-minute screencast of how I first approached the simulation and visualization.

Simulating four prisoners

Before we jump into our simulation, we can start with a bit of logic. The four prisoners can’t communicate and they’re in symmetrical situations. This means we’ll all have to take the same strategy, trusting in the fact that all the other logicians will choose the same one.

If we all decided not to flip a coin, we’d never get free. If we all decided to flip the coin, our chance of freedom would be $\frac{1}{2^4}=\frac{1}{16}$, the chance of four heads. Thus, we have one knob with which to control our strategy: the probability that we decide to flip our coin instead of returning it to the guards.

Since this probability will the be the same across all four prisoners, we can simulate this for many possible strategies between 1% and 100% using rbinom().

library(tidyverse)
library(scales)
theme_set(theme_light())
set.seed(2020-05-04)

sim <- crossing(trial = 1:100000,
                probability = seq(.01, 1, .01)) %>%
  mutate(num_flips = rbinom(n(), 4, probability),
         num_tails = rbinom(n(), num_flips, .5),
         set_free = num_flips != 0 & num_tails == 0)

sim

## # A tibble: 10,000,000 x 5
##    trial probability num_flips num_tails set_free
##    <int>       <dbl>     <int>     <int> <lgl>   
##  1     1      0.01           0         0 FALSE   
##  2     1      0.02           0         0 FALSE   
##  3     1      0.03           0         0 FALSE   
##  4     1      0.04           0         0 FALSE   
##  5     1      0.05           0         0 FALSE   
##  6     1      0.06           1         0 TRUE    
##  7     1      0.0700         0         0 FALSE   
##  8     1      0.08           0         0 FALSE   
##  9     1      0.09           1         0 TRUE    
## 10     1      0.10           0         0 FALSE   
## # … with 9,999,990 more rows

The above performs 10 million simulations (100,000 trials for each probability) but because it’s vectorized it’s pretty fast: about 1.5 seconds on my machine. Notice that the prisoners are set free only if they flip at least one coin and get no tails (num_flips != 0 & num_tails == 0). In the first ten simulations above, the strategy appeared to work twice (the 6th and 9th observations).

Each value of probability is one strategy: the probability each prisoner decides to use to see if they’ll flip their coin. We can thus summarize and visualize the chance of freedom within each probability.

summarized <- sim %>%
  group_by(probability) %>%
  summarize(pct_free = mean(set_free)) 

summarized %>%
  ggplot(aes(probability, pct_free)) +
  geom_line() +
  expand_limits(y = 0)

This curve makes some intuitive sense. If the probability of flipping is too low, there’s a high risk that nobody flips a coin, but if the probability is too high it approaches $\frac{1}{16}$. We also knew the peak couldn’t be above 50%, since at least one coin will have to get flipped.

summarized %>%
  arrange(desc(pct_free))

## # A tibble: 100 x 2
##    probability pct_free
##          <dbl>    <dbl>
##  1        0.35    0.286
##  2        0.37    0.286
##  3        0.36    0.285
##  4        0.3     0.284
##  5        0.34    0.284
##  6        0.32    0.283
##  7        0.33    0.283
##  8        0.31    0.282
##  9        0.38    0.282
## 10        0.39    0.282
## # … with 90 more rows

It looks like the optimum is around 35% (though there’s some uncertainty), and that when they use that strategy the prisoners will have a 28% chance of release.

Exact solution with optimize

To move from a simulation to an exact solution, let’s start by getting the exact formula for that curve. What’s the probability the prisoners go free if the chance of each flipping their coin is p?

There are four ways that we wind up winning: 1 prisoner can flip 1 heads, 2 prisoners can flip 2 heads, 3 prisoners can flip 3 heads, and 4 prisoners could flip 4 heads. These are disjoint events (it’s impossible two of them happen together), so we can sum up the probabilities. Let F be the number of coins that are flipped, and T be the number of tails flipped. The probability of getting freedom is

\[\sum_{k=1}^4{P(F=k|p)P(T=0|F=k)}\]

Both of these probabilities follow a binomial distribution: the probability of some number of successes in a set of idential trials. And the probability there are no tails is $\frac{1}{2^k}$ This can be written in R as follows, using the dbinom() function:

probability_exact <- function(p, n = 4) {
  sum(dbinom(1:n, n, p) / 2 ^ (1:n))
}

# Probability all heads if each player has 20% chance
probability_exact(.2)

## [1] 0.2465

We could add these exact values onto our earlier simulation to check our math.

# map_dbl lets us calculate probability of freedom for each strategy 
summarized %>%
  mutate(exact = map_dbl(probability, probability_exact)) %>%
  ggplot(aes(probability, pct_free)) +
  geom_line() +
  geom_line(aes(y = exact), color = "red", lty = 2) +
  expand_limits(y = 0)

This matches the simulation, so it looks like we got it right!

We’re especially interested in the peak: what’s the optimal strategy, and the corresponding probability of going free? We can use the built-in optimize function, which is built for one-dimensional optimization within an interval.

opt <- optimize(probability_exact, c(0, 1), maximum = TRUE)
opt

## $maximum
## [1] 0.3420391
## 
## $objective
## [1] 0.2848424

The highest chance of escape is 28.5%, when the prisoners use the random number generator to have a 34.2% chance of flipping the coin.

If you want to see some equations rather than simulations, the Appendix below shows how to calculate the (slightly messy) exact form, and gets some hints about what it looks like for an arbitrary N.

Extra credit: arbitrary N

Extra credit: Instead of four prisoners, suppose there are N prisoners. Now what are your chances of being released?

What’s wonderful about the crossing() function is that we can always add another variable to our calculation. Let’s add n, ranging from 2 prisoners to 8 prisoners.

sim_n <- crossing(trial = 1:100000,
                  probability = seq(.02, 1, .02),
                  n = 2:8) %>%
  mutate(num_flips = rbinom(n(), n, probability),
         num_tails = rbinom(n(), num_flips, .5),
         set_free = num_flips != 0 & num_tails == 0)

Since our probability_exact() function takes two arguments (p and n), we can also calculate all the exact probabilities with map2_dbl.

probabilities_n <- sim_n %>%
  group_by(probability, n) %>%
  summarize(simulated = mean(set_free)) %>%
  ungroup() %>%
  mutate(exact = map2_dbl(probability, n, probability_exact))

probabilities_n %>%
  ggplot(aes(probability, exact, color = factor(n))) +
  geom_line() +
  geom_point(aes(y = simulated), size = .4) +
  scale_x_continuous(labels = percent) +
  scale_y_continuous(labels = percent) +
  labs(x = "p: Probability of flipping the coin",
       y = "Probability of freedom",
       color = "N: # of prisoners",
       title = "What's the chance of escaping with n prisoners?",
       subtitle = "Points show simulations of 100,000 prisoners each; lines are exact solution")

This let us check our results for an arbitrary $N$. It looks like our simulation and exact calculations line up, which is a good way to check our work!

The probability of freedom has one peak for any value of $N$. It looks like the best value of $p$ when there are two prisoners is about a 2/3 chance of flipping, and that decreases as $N$ increases. The chance of success also decreases as $N$ increases, but not by too much, and it looks like it might asymptote.

Let’s use optimize to find the best strategy for every value of $N$, up to (say) 60 prisoners.

# Function that takes n and runs the optimise step
optimize_for_n <- function(n) {
  optimize(function(p) probability_exact(p, n), c(0, 1), maximum = TRUE)
}

optimal_n <- tibble(n = 2:60) %>%
  mutate(optimal = map(n, optimize_for_n)) %>%
  unnest_wider(optimal)

optimal_n %>%
  gather(metric, value, -n) %>%
  mutate(metric = ifelse(metric == "maximum", "Optimal probability to flip", "Probability of escape")) %>%
  ggplot(aes(n, value, color = metric)) +
  geom_line() +
  geom_hline(lty = 2, yintercept = .25) +
  scale_y_continuous(labels = percent) +
  expand_limits(y = 0) +
  labs(x = "N: # of prisoners",
       y = "Probability",
       color = "",
       title = "How does the optimal strategy and outcome change with N?")

The optimal $p$ does indeed decrease as $N$ increases, and appears to be approaching zero. The probability of escape (you’d rather play this game with just one other prisoner than with many), but notice that it is approaching an asymptote, which appears to be 25% (shown as a dashed line).

Instead of thinking about the optimal value of $p$, it might make sense to think about $Np$, the expected number of flips. That is, how many flips are you aiming for across all $N$ prisoners?

optimal_n %>%
  arrange(desc(n)) %>%
  mutate(expected_coins_flipped = n * maximum) %>%
  ggplot(aes(n, expected_coins_flipped)) +
  geom_line() +
  labs(y = "Expected # of coins getting flipped")

With a small $N$ you’re looking to flip about 1.34 coins, and as $N$ gets large that target seems to approach 1.386.

It makes intuitive sense that you’re aiming at a number of flips a little over 1. You really don’t want to end up flipping zero (in which case you’ll lose right away), but you’re balancing that against not wanting to flip too many, in which case you’ll have a high risk of flipping at least one tails.

As $N$ gets large, since $p$ stays small, the number of coins flipped will approach a Poisson distribution, a useful distribution of counts where the variance is equal to the mean. At that point, it doesn’t end up mattering what $N$ is, so it makes sense that the probability of escape asymptotes rather than continuing to decline.

# Summing the Poisson probabilities up to 1000
optimize(function(p) sum(dpois(1:1000, p) / 2 ^ (1:1000)),
         c(0, 10),
         maximum = TRUE)

## $maximum
## [1] 1.386312
## 
## $objective
## [1] 0.25

Put another way: even if you were playing this game with a billion prisoners, you’d still have a 25% chance of escaping: each prisoner would just take a $\frac{1.386}{1,000,000,000}$ chance of flipping the coin. Pretty cool!

(I don’t have an intuition for why the optimal expected number of flips is 1.386, or why the probability of escape approaches $\frac{1}{4}$, but I bet someone who’s good with infinite series could work it out based on the density of the Poisson distribution).

Appendix: Closed form solution for N=4

I focus more on code than on equations in this blog, but I thought I’d try getting an exact form for the optimal strategy. After all, I’d have to if I were one of the prisoners and didn’t have access to R.

\[\sum_{k=1}^4{P(F=k|p)P(T=0|F=k)}\] \[=\sum_{k=1}^4\frac{ {4 \choose k} p^k(1-p)^{4-k}}{2^k}\] \[=\frac{4p(1-p)^3}{2}+\frac{6p^2(1-p)^2}{4}+\frac{4p^3(1-p)}{8}+\frac{p^4}{16}\] \[=2p(1-p)^3+\frac{3}{2}p^2(1-p)^2+\frac{1}{2}p^3(1-p)+\frac{1}{16}p^4\] \[=2p(1-p)^3+\frac{3}{2}p^2(1-p)^2+\frac{1}{2}p^3(1-p)+\frac{1}{16}p^4\] \[=-\frac{15}{16}p^4+\frac{7}{2}p^3-\frac{9}{2}p^2+2p\]

We can see from the graph above that there is one maximum between 0 and 1. To find that maximum, we’ll take the derivative and set it to zero:

\[0=-\frac{60}{16}p^3+\frac{21}{2}p^2-9p+2\]

Life is too short for me to remember how to find the roots of cubic equations (though I hope for their sake that the prisoners can work it out), but Wolfram Alpha tells me the only solution is:

\[-\frac{2}{15}(-7+2^{1/3}+2 \times 2^{2/3})\]

So… if you had that closed form solution on your bingo card, congrats. But it is indeed about equal to .342, so it checks out with our simulation! I never get tired of how simulation can help check our math.

I ran through the solution (not shown) for $n=3$ and $n=2$, and found that they are, respectively, $\frac{1}{7}(6-2\sqrt{2})$ and $\frac{2}{3}$. So there are some hints at structures in common ($2^N-1$ in the denominator, a sequence of $N-1$th roots of 2), but it’s not something I’m planning to solve!

The 'spam comments' puzzle: tidy simulation of stochastic processes in R

2020-04-13T17:45:00+00:00

Previously in this series:

I love 538’s Riddler column, and the April 10 puzzle is another interesting one. I’ll quote:

Over the course of three days, suppose the probability of any spammer making a new comment on this week’s Riddler column over a very short time interval is proportional to the length of that time interval. (For those in the know, I’m saying that spammers follow a Poisson process.) On average, the column gets one brand-new comment of spam per day that is not a reply to any previous comments. Each spam comment or reply also gets its own spam reply at an average rate of one per day.

For example, after three days, I might have four comments that were not replies to any previous comments, and each of them might have a few replies (and their replies might have replies, which might have further replies, etc.).

After the three days are up, how many total spam posts (comments plus replies) can I expect to have?

This is a great opportunity for tidy simulation in R, and also for reviewing some of the concepts of stochastic processes (this is known as a Yule process). As we’ll see, it’s even thematically relevant to current headlines, since it involves exponential growth.

Solving a puzzle generally involves a few false starts. So I recorded this screencast showing how I originally approached the problem. It shows not only how to approach the simulation, but how to use those results to come up with an exact answer.

Simulating a Poisson process

The Riddler puzzle describes a Poisson process, which is one of the most important stochastic processes. A Poisson process models the intuitive concept of “an event is equally likely to happen at any moment.” It’s named because the number of events occurring in a time interval of length $x$ is distributed according to $\mbox{Pois}(\lambda x)$, for some rate parameter $\lambda$ (for this puzzle, the rate is described as one per day, $\lambda=1$).

How can we simulate a Poisson process? This is an important connection between distributions. The waiting time for the next event in a Poisson process has an exponential distribution, which can be simulated with rexp().

# The rate parameter, 1, is the expected events per day
waiting <- rexp(10, 1)
waiting

##  [1] 0.1417638 2.7956808 1.2725448 0.3452203 0.5303130 0.2647746 2.6195738
##  [8] 1.2933250 0.5539181 0.9835380

For example, in this case we waited 0.14 days for the first comment, then 2.8 after that for the second one, and so on. On average, we’ll be waiting one day for each new comment, but it could be a lot longer or shorter.

You can take the cumulative sum of these waiting periods to come up with the event times (new comments) in the Poisson process.

qplot(cumsum(waiting), 0)

Simulating a Yule process

Before the first comment happened, the rate of new comments/replies was 1 per day. But as soon as the first comment happened, the rate increased: the comment could spawn its own replies, so the rate went up to 2 per day. Once there were two comments, the rate goes up to 3 per day, and so on.

This is a particular case of a stochastic process known as a Yule process (which is a special case of a birth process. We could prove a lot of mathematical properties of that process, but let’s focus on simulating it.

The waiting time for the first commentwould be $\mbox{Exponential}(1)$, but the waiting time for the second is $\mbox{Exponential}(2)$, then $\mbox{Exponential}(3)$, and so on. We can use the vectorized rexp() function to simulate those. The waiting times will, on average, get shorter and shorter as there are more comments that can spawn replies.

set.seed(2020)

waiting_times <- rexp(20, 1:20)

# Cumulative time
cumsum(waiting_times)

##  [1] 0.2938057 0.9288308 1.0078320 1.1927956 1.4766987 1.6876352 2.5258522
##  [8] 2.5559037 2.6146623 2.6634295 2.7227323 2.8380710 2.9404016 2.9460719
## [15] 2.9713356 3.0186731 3.1340060 3.2631936 3.2967087 3.3024576

# Number before the third day
sum(cumsum(waiting_times) < 3)

## [1] 15

In this case, the first 15 events happened before the third day. Notice that in this simulation, we’re not keeping track of which comment received a reply: we’re treating all the comments as interchangeable. This lets our simulation run a lot faster since we just have to generate the waiting times.

All combined, we could perform this simulation in one line:

sum(cumsum(rexp(20, 1:20)) < 3)

## [1] 6

So in one line with replicate(), here’s one million simulations. We simulate 300 waiting periods from each, and see how many happen before the first day.

sim <- replicate(1e6, sum(cumsum(rexp(300, 1:300)) < 3))

mean(sim)

## [1] 19.10532

It looks like it’s about 19.1.

Turning this into an exact solution

Why 19.1? Could we get an exact answer that is intuitively satisfying?

One trick to get a foothold is to vary one of our inputs: rather than looking at 3 days, let’s look at the expected comments after time $t$. That’s easier if we expand this into a tidy simulation, using one of my favorite functions crossing().

library(tidyverse)
set.seed(2020)

sim_waiting <- crossing(trial = 1:25000,
         observation = 1:300) %>%
  mutate(waiting = rexp(n(), observation)) %>%
  group_by(trial) %>%
  mutate(cumulative = cumsum(waiting)) %>%
  ungroup()

sim_waiting

## # A tibble: 7,500,000 x 4
##    trial observation waiting cumulative
##    <int>       <int>   <dbl>      <dbl>
##  1     1           1  0.294       0.294
##  2     1           2  0.635       0.929
##  3     1           3  0.0790      1.01 
##  4     1           4  0.185       1.19 
##  5     1           5  0.284       1.48 
##  6     1           6  0.211       1.69 
##  7     1           7  0.838       2.53 
##  8     1           8  0.0301      2.56 
##  9     1           9  0.0588      2.61 
## 10     1          10  0.0488      2.66 
## # … with 7,499,990 more rows

We can confirm that the average number of comments in the first three days is about 19.

sim_waiting %>%
  group_by(trial) %>%
  summarize(num_comments = sum(cumulative <= 3)) %>%
  summarize(average = mean(num_comments))

## # A tibble: 1 x 1
##   average
##     <dbl>
## 1    18.9

But we can also use crossing() (again) to look at the expected number of cumulative comments as we vary $t$.

average_over_time <- sim_waiting %>%
  crossing(time = seq(0, 3, .25)) %>%
  group_by(time, trial) %>%
  summarize(num_comments = sum(cumulative < time)) %>%
  summarize(average = mean(num_comments))

(Notice how often “solve the problem for one value” can be turned into “solve the problem for many values” with one use of crossing(): one of my favorite tricks).

How does the average number of comments increase over time?

ggplot(average_over_time, aes(time, average)) +
  geom_line()

At a glance, this looks like an exponential curve. With a little experimentation, and noticing that the curve starts at $(0, 0)$, we can find that the expected number of comments at time $t$ follows $e^t-1$. This fits with our simulation: $e^3 - 1$ is 19.0855.

ggplot(average_over_time, aes(time, average)) +
  geom_line(aes(y = exp(time) - 1), color = "red") +
  geom_point() +
  labs(y = "Average # of comments",
       title = "How many comments over time?",
       subtitle = "Points show simulation, red line shows exp(time) - 1.")

Intuitively, it makes sense that on average the growth is exponential. If we’d described the process as “bacteria in a dish, each of which could divide at any moment”, we’d expect exponential growth. The “minus one” is because the original post is generating comments just like all the others do, but doesn’t itself count as a comment.¹

Distribution of comments at a given time

It’s worth noting we’re still only describing an average path. There could easily be more, or fewer, spam comments by the third day. Our tidy simulation gives us a way to plot many such paths.

sim_waiting %>%
  filter(trial <= 50, cumulative <= 3) %>%
  ggplot(aes(cumulative, observation)) +
  geom_line(aes(group = trial), alpha = .25) +
  geom_line(aes(y = exp(cumulative) - 1), color = "red", size = 1) +
  labs(x = "Time",
       y = "# of comments",
       title = "50 possible paths of comments over time",
       subtitle = "Red line shows e^t - 1")

The red line shows the overall average, reaching about 19.1 at 3 days. However, we can see that it can sometimes be much smaller or much larger (even even more than 100).

What is the probability distribution of comments after three days- the probability there is one comment, or two, or three? Let’s take a look at the distribution.

# We'll use the million simulated values from earlier
num_comments <- tibble(num_comments = sim)

num_comments %>%
  ggplot(aes(num_comments)) +
  geom_histogram(binwidth = 1)

Interestingly, at a glance this looks a lot like an exponential curve. Since it’s a discrete distribution (with values 0, 1, 2…), this suggests it’s a geometric distribution: the expected number of “tails” flipped before we see the first “heads”.

We can confirm that by comparing it to the probability mass function, $(1-p)^np$. If it is a geometric distribution, then because we know the expected value is $e^3-1$ we know the rate parameter $p$ (the probability of a success on each heads) is $\frac{1}{e^3}=e^{-3}$.

p <- exp(-3)

num_comments %>%
  filter(num_comments <= 150) %>%
  ggplot(aes(num_comments)) +
  geom_histogram(aes(y = ..density..), binwidth = 1) +
  geom_line(aes(y = (1 - p) ^ num_comments * p), color = "red")

This isn’t a mathematical proof, but it’s very compelling. So what we’ve learned overall is:

$X(t)\sim \mbox{Geometric}(e^{-t})$ $E[X(t)]= e^{-t}-1$

These are true because the rate of comments is one per day. If the rate of new comments were $\lambda$, you’d replace $t$ above with $\lambda t$.

I don’t have an immediate intuition for why the distribution is geometric. Though it’s interesting that the parameter $p=e^{-t}$ for the geometric distribution (the probability of a “success” on the coin flip that would stop the process) is equal to the probability that there are no events in time $t$ for a Poisson process.

Conclusion: Yule process

I wasn’t familiar with it when I first tried out the riddle, but this is known as a Yule process. For confirmation of some of the results above you can check out this paper or the Wikipedia entry, among others.

What I love about simulation is how it builds an intuition for these processes from the ground up. These simulated datasets and visualizations are a better “handle” for me for grasp the concepts than mathematical equations would be. After I’ve gotten a feel for the distributions, I can check my answer by looking through the mathematical literature.

If you don’t like the $-1$, you could have counted the post as a comment, started everything out at $X(0)=1$, and then you would find that $E[X(t)]=e^t$. This is the more traditional definition of a Yule process. ↩

Feller's coin-tossing puzzle: tidy simulation in R

2020-01-17T14:00:00+00:00

Previously in this series:

I have an interest in probability puzzles and riddles, and especially in simulating them in R. I recently learned about Feller’s coin-tossing puzzle, from the book Mathematical Constants by Steven Finch. (I recommend the book if you like the topic too!)

Mathematician William Feller posed the following problem:

If you flip a coin $n$ times, what is the probability there are no streaks of $k$ heads in a row?

Note that while the number of heads in a sequence is governed by the binomial distribution, the presence of consecutive heads is a bit more complicated, because the presence of a streak at various points in the sequence isn’t independent. This reminds me a bit of one of my earlier tidyverse simulations:

A #tidyverse simulation to demonstrate that if you wait for two heads in a row, it takes 6 flips on average, while you wait for a heads then a tails, it takes 4 flips on average

h/t @CutTheKnotMath #rstats pic.twitter.com/V0zgOmCy7t
— David Robinson (@drob) June 17, 2018

To continue my series of simulating probability puzzles in the tidyverse, I’d like to show how we’d approach simulating Feller’s coin-tossing problem, and comparing it to the exact values. (In the process, we also see how we’d calculate a Fibonacci sequence in one line!)

Simulating a single sequence

Let’s start with values $n=20;k=3$: what’s the probability that a sequence of 20 flips contains no streaks of length 3? You can flip a sequence of coins with rbinom().

# We'll say 1 is heads, 0 is tails
flips <- rbinom(20, 1, .5)
flips

##  [1] 1 0 0 0 1 0 1 1 1 0 1 1 1 1 1 0 0 1 1 1

In this case, there were indeed a few streaks of 3 heads in a row. How could determine that in R?

Well, we could use dplyr’s window function lead() (which moves each flip forward one in the sequence), to ask if there are any flips sets in which a coin, the next coin, and the one after that are all 1 (heads).

library(dplyr)

flips & lead(flips) & lead(flips, 2)

##  [1] FALSE FALSE FALSE FALSE FALSE FALSE  TRUE FALSE FALSE FALSE  TRUE
## [12]  TRUE  TRUE FALSE FALSE FALSE FALSE  TRUE    NA    NA

Indeed, there are (though notice the last two are NA, since there is no lead() coin).

Remember that Feller was looking for the probability there are no streaks in the sequence. We use !any() to check this:

!any(flips & lead(flips) & lead(flips, 2), na.rm = TRUE)

## [1] FALSE

This gives us an approach that, similar to our previous tidyverse approaches to simulation, we can repeat and summarize across parameter values using tidyr’s crossing() and purrr’s map_lgl().

library(tidyverse)

# Set up a function for there being no streak of 3
no_three_heads <- function(x) {
  !any(x & lead(x) & lead(x, 2), na.rm = TRUE)
}

# Note that if there are 1 or 2 flips, the probability is 100%
sim <- crossing(trial = seq_len(10000),
                sequence_length = seq(3, 51, 2)) %>%
  mutate(flips = map(sequence_length, rbinom, 1, .5)) %>%
  mutate(no_three = map_lgl(flips, no_three_heads)) %>%
  group_by(sequence_length) %>%
  summarize(chance_no_three = mean(no_three))

sim

## # A tibble: 25 x 2
##    sequence_length chance_no_three
##              <dbl>           <dbl>
##  1               3           0.874
##  2               5           0.744
##  3               7           0.635
##  4               9           0.528
##  5              11           0.452
##  6              13           0.387
##  7              15           0.323
##  8              17           0.280
##  9              19           0.230
## 10              21           0.193
## # … with 15 more rows

This takes about 5 seconds on my machine. We can then visualize the probability that there are no streaks as a function of the number of flips in the sequence.

ggplot(sim, aes(sequence_length, chance_no_three)) +
  geom_line() +
  scale_y_continuous(labels = scales::percent_format()) +
  labs(x = "# of flips",
       y = "Probability there are no sequences of 3 heads")

It looks like for $k=3$, the probability there are no sequences of three is 7/8 for a sequence of 3 flips, crosses 50% roughly when there are 10 flips, and then is rather close to zero by the time there are 50 flips.

Extending for multiple values of k

Once we’re not fixed to $k=3$, we can’t use x & lead(x) & lead(x, 2) to check for the presence of a streak anymore.¹ As a replacement, I’d like to introduce a useful base R function called rle, for “run-length encoding”.

rle(flips)

## Run Length Encoding
##   lengths: int [1:9] 1 3 1 1 3 1 5 2 3
##   values : int [1:9] 1 0 1 0 1 0 1 0 1

A run-length encoding divides a vector down into streaks of consecutive values. It turns the vector into two components: the lengths of each streak, and the value in each. We can use these in combination- !any(r$values & r$lengths >= len)- to check if there are any streaks of heads greater than a certain length. (This is a good example of how knowing slightly obscure base R functions, like rle, gives you a toolbox for elegant and efficient solutions).

By adding a value k to our crossing(), we can then visualize the probability for each value of k.

no_streak <- function(x, len) {
  r <- rle(x)
  !any(r$values & r$lengths >= len)
}

# Note that when k is 1, the probability is 2^(-n), not too exciting
feller_seq <- crossing(trial = seq_len(10000),
                       n = seq(2, 40, 2),
                       k = 2:4) %>%
  mutate(flips = map(n, rbinom, 1, .5)) %>%
  mutate(no_seq = map2_lgl(flips, k, no_streak)) %>%
  group_by(n, k) %>%
  summarize(p = mean(no_seq))

feller_seq

## # A tibble: 60 x 3
## # Groups:   n [20]
##        n     k     p
##    <dbl> <int> <dbl>
##  1     2     2 0.751
##  2     2     3 1    
##  3     2     4 1    
##  4     4     2 0.497
##  5     4     3 0.811
##  6     4     4 0.934
##  7     6     2 0.337
##  8     6     3 0.692
##  9     6     4 0.869
## 10     8     2 0.214
## # … with 50 more rows

feller_seq %>%
  ggplot(aes(n, p, color = factor(k))) +
  geom_line() +
  scale_y_continuous(labels = scales::percent) +
  labs(y = "Probability there is no streak",
       color = "Length of streak")

The longer the streak, the less likely the sequence won’t contain it, which makes sense. By the time the sequence is length 40, it’s almost certain to contain a stretch of 2 heads, very likely to contain a stretch of 3 heads, and has a 75% chance to contain a stretch of 4 heads.

Feller’s coin-tossing constants

Something I like about simulations is that they can double-check mathematical results.

When Feller looked at this problem, he proved a result about $p(n,k)$, namely:

\[\lim_{n\rightarrow \infty}\alpha_k p(n, k)=\beta_k\]

Where $\alpha_k$ and $\beta_k$ are Feller’s constants. (You can find a few such values, and some more details, on Wikipedia). We could compare those exact values to the simulation, by creating a table of the constants and joining them.

feller_constants <- tibble(k = c(2, 3, 4),
                           alpha = c(1.236, 1.087, 1.0376),
                           beta = c(1.447, 1.237, 1.137))

feller_seq %>%
  inner_join(feller_constants, by = "k") %>%
  ggplot(aes(n)) +
  geom_line(aes(y = p, color = factor(k))) +
  geom_line(aes(y = beta / alpha ^ (n + 1), group = k), lty = 2) +
  scale_y_continuous(labels = scales::percent) +
  labs(x = "Length of sequence",
       y = "Probability there is no streak of heads",
       color = "Length of streak")

Calculating the probability of Fibonacci numbers

But an approach I like even more than Feller’s constants is to calculate the exact probability based on higher-order Fibonacci sequences.

\[p(n,k)=\frac{F^{(k)}_{n + 2}}{2^n}\]

where $F^{(k)}_{n + 2}$ is the $n+2$ term of the $k$th order Fibonacci sequence. The first few paragraphs of this paper points out why. (In short for $k=2$: the number of sequences of length $n$ that have no streaks of 2 is all the sequences of length $n-1$ that are followed by a $T$, plus all the sequences of length $n-2$ that are followed by a $TH$. This is divided by the $2^n$ possible sequences.)

Let’s talk about Fibonacci sequences! Each step in a Fibonacci sequence is the sum of the previous 2, after starting with (1, 1). To get that in R, you’d keep applying the step c(., sum(tail(., 2))) again and again (tail() gets the last items of a vector).

This can be done in one line (trick of the day!) with the reduce function from purrr, which calls a function for each element in a vector while passing along the result. When passed a dummy vector, like 1:50, and an initial value, like c(1, 1) (the first two), it’s a quick way to say “call this function 50 times”.

# Gets the first 52 fibonacci numbers, starting with 1, 1
reduce(seq_len(50), ~ c(., sum(tail(., 2))), .init = c(1, 1))

##  [1]           1           1           2           3           5
##  [6]           8          13          21          34          55
## [11]          89         144         233         377         610
## [16]         987        1597        2584        4181        6765
## [21]       10946       17711       28657       46368       75025
## [26]      121393      196418      317811      514229      832040
## [31]     1346269     2178309     3524578     5702887     9227465
## [36]    14930352    24157817    39088169    63245986   102334155
## [41]   165580141   267914296   433494437   701408733  1134903170
## [46]  1836311903  2971215073  4807526976  7778742049 12586269025
## [51] 20365011074 32951280099

In higher order Fibonacci sequences, the terms are the sum of 3 (“tribonacci”), 4 (“tetranacci”), or more previous terms, meaning they grow even faster. We could create a function that calculates those series.

fibonacci <- function(order) {
  reduce(seq_len(50), ~ c(., sum(tail(., order))), .init = c(1, 1))
}

# Fibonacci
head(fibonacci(2))

## [1] 1 1 2 3 5 8

# Tribonacci
head(fibonacci(3))

## [1]  1  1  2  4  7 13

So returning to our simulation, we can confirm our math.

feller_seq %>%
  group_by(k) %>%
  mutate(exact = fibonacci(k[1])[n + 2] / 2 ^ n) %>%
  ggplot(aes(n)) +
  geom_line(aes(y = p, color = factor(k))) +
  geom_line(aes(y = exact, group = k), lty = 2) +
  scale_y_continuous(labels = scales::percent) +
  labs(y = "Probability there is no streak",
       color = "Length of streak")

Notice what a wide range of tools can be used in simulations. Besides our usual collection of tidyverse tricks like crossing(), we used rle() (a handy trick any time you need to examine consecutive streaks), and reduce() (useful for setting up recursive relationships like in the Fibonacci sequence).

I’m really enjoying these probability puzzle simulations. If you have a favorite probability puzzle you’d like me to simulate, please put in the comments!

With reduce, there actually is a way we could take the lead() approach with an arbitrary streak length (left as an exercise to the reader!). But I found it’s about 10X slower than the rle() approach above, so I’m focusing on this one. ↩

The 'Spelling Bee Honeycomb' puzzle: efficient computation in R

2020-01-06T14:00:00+00:00

Previously in this series:

I love 538’s Riddler column, and the January 3 puzzle is a fun one. I’ll quote:

The New York Times recently launched some new word puzzles, one of which is Spelling Bee. In this game, seven letters are arranged in a honeycomb lattice, with one letter in the center. Here’s the lattice from December 24, 2019:

The goal is to identify as many words that meet the following criteria:

The word must be at least four letters long.

The word must include the central letter.

The word cannot include any letter beyond the seven given letters.

Note that letters can be repeated. For example, the words GAME and AMALGAM are both acceptable words. Four-letter words are worth 1 point each, while five-letter words are worth 5 points, six-letter words are worth 6 points, seven-letter words are worth 7 points, etc. Words that use all of the seven letters in the honeycomb are known as “pangrams” and earn 7 bonus points (in addition to the points for the length of the word). So in the above example, MEGAPLEX is worth 15 points.

Which seven-letter honeycomb results in the highest possible game score? To be a valid choice of seven letters, no letter can be repeated, it must not contain the letter S (that would be too easy) and there must be at least one pangram.

Solving this puzzle in R is interesting enough, but it’s particularly challenging to do so in a computationally efficient way. As much as I love the tidyverse, this, like the “lost boarding pass” puzzle and Emily Robinson’s evaluation of the best Pokémon team, serves as a great example of using R’s matrix operations to work efficiently with data.

I’ve done a lot of puzzles recently, and I realized that showing the end result isn’t a representation of my thought process. I don’t show all the dead ends and bugs, or explain why I ended up choosing a particular path. So in the same spirit as my Tidy Tuesday screencasts, I recorded myself solving this puzzle (though not the process of turning it into a blog post).

Setup: Processing the word list

Our first step is to process the word list for words that could appear in a honeycomb puzzle. Based on the above rules, these will have at least four letters, have no more than 7 unique letters, and never contain the letter S. We’ll do this processing with tidyverse functions.

library(tidyverse)

words <- tibble(word = read_lines("https://norvig.com/ngrams/enable1.txt")) %>%
  mutate(word_length = str_length(word)) %>%
  filter(word_length >= 4,
         !str_detect(word, "s")) %>%
  mutate(letters = str_split(word, ""),
         letters = map(letters, unique),
         unique_letters = lengths(letters)) %>%
  mutate(points = ifelse(word_length == 4, 1, word_length) +
           7 * (unique_letters == 7)) %>%
  filter(unique_letters <= 7) %>%
  arrange(desc(points))

words

## # A tibble: 44,585 x 5
##    word             word_length letters   unique_letters points
##    <chr>                  <int> <list>             <int>  <dbl>
##  1 antitotalitarian          16 <chr [7]>              7     23
##  2 anticlimactical           15 <chr [7]>              7     22
##  3 inconveniencing           15 <chr [7]>              7     22
##  4 interconnection           15 <chr [7]>              7     22
##  5 micrometeoritic           15 <chr [7]>              7     22
##  6 nationalization           15 <chr [7]>              7     22
##  7 nonindependence           15 <chr [7]>              7     22
##  8 nonintervention           15 <chr [7]>              7     22
##  9 nontotalitarian           15 <chr [7]>              7     22
## 10 overengineering           15 <chr [7]>              7     22
## # … with 44,575 more rows

There are 44585 that are eligible to appear in a puzzle. This data gives us a way to solve the December 24th Honeycomb puzzle that comes with the Riddler column.

get_words <- function(center_letter, other_letters) {
  all_letters <- c(center_letter, other_letters)
  
  words %>%
    filter(str_detect(word, center_letter)) %>%
    mutate(invalid_letters = map(letters, setdiff, all_letters)) %>%
    filter(lengths(invalid_letters) == 0) %>%
    select(word, points)
}

honeycomb_words <- get_words("g", c("a", "p", "x", "m", "e", "l"))
honeycomb_words

## # A tibble: 43 x 2
##    word    points
##    <chr>    <dbl>
##  1 amalgam      7
##  2 agapae       6
##  3 agleam       6
##  4 allege       6
##  5 gaggle       6
##  6 galeae       6
##  7 gemmae       6
##  8 pelage       6
##  9 plagal       6
## 10 agama        5
## # … with 33 more rows

sum(honeycomb_words$points)

## [1] 153

Looks like the score is 153.

Could we use this get_words() function to brute force every possible honeycomb? Only if we had a lot of time on our hands. Since S is eliminated, there are 25 possible choices for the center letter, and $24\choose 6$ (“24 choose 6”) possible combinations of outer letters, making 25 * choose(24, 6) = 3.36 million possible honeycombs. It would take about 8 days to test every one this way. We can do a lot better.

Heuristics: What letters appear in the highest-scoring words?

Would you expect the winning honeycomb to have letters like X, Z, or Q? Neither would I. The winning honeycomb is likely filled with common letters like E that appear in lots of words.

Let’s quantify this, by looking at how many words each letter appears in, and how many total points they’d earn.

library(tidytext)

# unnest_tokens is a fast approach to splitting one-character-per-row
letters_unnested <- words %>%
  select(word, points) %>%
  unnest_tokens(letter, word, token = "characters", drop = FALSE) %>%
  distinct(word, letter, .keep_all = TRUE)

letters_summarized <- letters_unnested %>%
  group_by(letter) %>%
  summarize(n_words = n(),
            n_points = sum(points)) %>%
  arrange(desc(n_points))

letters_summarized

## # A tibble: 25 x 3
##    letter n_words n_points
##    <chr>    <int>    <dbl>
##  1 e        28203   275039
##  2 i        21128   220473
##  3 a        21719   214490
##  4 r        20977   209803
##  5 n        18735   197485
##  6 t        16232   170953
##  7 l        16503   164552
##  8 o        16038   160863
##  9 d        13894   137491
## 10 c        11644   123224
## # … with 15 more rows

What letters have the most and least points?

Of course, any given honeycomb with one of these letters will get only a tiny fraction of the points available to the letter. There could be interactions between those terms (maybe two relatively rare letters go well together). But it gives us a sense of which letters are likely to be included (almost certainly not ones like X, Z, Q, and J), which may help us narrow down our search space in the next step.

Using matrices to score honeycombs

When you need R to be very efficient, you might want to turn to matrix operations, which when used properly are some of the fastest operations in R. Luckily, it turns out that a lot of this puzzle can be done through linear algebra. I’m presenting this as the finished product, but if you’re interested in my thought process as I came up with it I do recommend running through the screencast recording to show how I got here.

We start by creating a word-by-letter matrix. There are 44K words and (without S) 25 letters. To operate efficiently on these, we’ll want these in a 44K x 25 binary matrix rather than strings. The underrated reshape2::acast can set this up for us.

word_matrix <- letters_unnested %>%
  reshape2::acast(word ~ letter, fun.aggregate = length)

dim(word_matrix)

## [1] 44585    25

head(word_matrix)

##          a b c d e f g h i j k l m n o p q r t u v w x y z
## aahed    1 0 0 1 1 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## aahing   1 0 0 0 0 0 1 1 1 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0
## aalii    1 0 0 0 0 0 0 0 1 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0
## aardvark 1 0 0 1 0 0 0 0 0 0 1 0 0 0 0 0 0 1 0 0 1 0 0 0 0
## aardwolf 1 0 0 1 0 1 0 0 0 0 0 1 0 0 1 0 0 1 0 0 0 1 0 0 0
## aargh    1 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0

A points-per-word vector. Once we have the set of words that are possible with each honeycomb, we’ll need to score them to find the maximum.

points_per_word <- setNames(words$points, words$word)
head(points_per_word)

## antitotalitarian  anticlimactical  inconveniencing  interconnection 
##               23               22               22               22 
##  micrometeoritic  nationalization 
##               22               22

At this point, we take a matrix multiplication approach to score all the honeycomb combinations. Since I went through it in the screencast, I won’t walk through each of the steps except in the comments.

find_best_score <- function(center_letter, possible_letters) {
  # Find all 6-letter combinations for the outside letters
  outside <- setdiff(possible_letters, center_letter)
  combos <- combn(outside, 6)

  # Binary matrix with one row per combination, 1 means letter is forbidden
  forbidden_matrix <- 1 - apply(combos, 2, function(.) {
    colnames(word_matrix) %in% c(center_letter, .)
  })
  
  # Must contain the center letter, can't contain any forbidden
  filtered_word_matrix <- word_matrix[word_matrix[, center_letter] == 1, ]
  allowed_matrix <- (filtered_word_matrix %*% forbidden_matrix) == 0
  
  # Score all the words, and add them up within each combination
  scores <- t(allowed_matrix) %*% points_per_word[rownames(allowed_matrix)]
  
  # Find the highest score, and return a tibble with all useful info
  tibble(center_letter = center_letter,
         other_letters = paste(combos[, which.max(scores)], collapse = ","),
         score = max(scores))
}

In this approach, I hold the center letter constant, and try every combination of 6 within a pool of letters (the possible_letters argument) for the outer letters.

If we use all 25 available letters, this ends up impractically slow and memory-intensive (we end up with something like a 40,000 by 135,000 matrix). But if we bring it down to 15 letters, it can run in a few seconds per central letter. Here I’ll use the heuristic we came up with above: it’s likely that the winning solution is made up of mostly the ones that appear in lots of high-scoring words, like E, I, and A.

pool <- head(letters_summarized$letter, 15)

# Try each as a center letter, along with the pool
best_scores <- purrr::map_df(pool, find_best_score, pool)

best_scores

## # A tibble: 15 x 3
##    center_letter other_letters score
##    <chr>         <chr>         <dbl>
##  1 e             i,a,r,n,t,g    3769
##  2 i             e,a,r,n,t,g    3406
##  3 a             e,i,r,n,t,g    3372
##  4 r             e,i,a,n,t,g    3898
##  5 n             e,i,a,r,t,g    3782
##  6 t             e,i,a,r,n,g    3421
##  7 l             e,i,a,n,t,g    2061
##  8 o             e,i,r,n,t,c    1839
##  9 d             e,i,a,r,n,g    2626
## 10 c             e,i,a,r,n,t    1982
## 11 g             e,i,a,r,n,t    3095
## 12 u             e,a,r,n,t,d    1206
## 13 m             e,i,a,r,n,t    1754
## 14 p             e,a,r,t,l,d    1793
## 15 b             e,i,a,r,l,d    1673

It takes about a minute to try all combinations of the top 15 letters. This makes it clear: the best combination is R in the center, and E, I, A, N, T, G surrounding it, for a total score of 3898.

How good was our heuristic at judging letters?

We took a shortcut, and therefore a bit of risk, in winnowing down the alphabet to just 15 letters. How could we get a sense of whether we still got the right answer?

We could start by looking at how good a predictor our heuristic was of how good a letter is in the center.

best_scores %>%
  mutate(center_letter = fct_inorder(center_letter)) %>%
  ggplot(aes(center_letter, score)) +
  geom_line(group = 1) +
  expand_limits(y = 0) +
  labs(x = "Center letter (ordered by individual letter score)",
       y = "Best score possible with this center letter")

We can see that the heuristic isn’t perfect. For instance, G is a surprisingly good center letter (and makes it into the outer letters of our winning honeycomb) considering that overall it doesn’t quite make the top 10 for our heuristic. However, it’s unlikely we’re missing anything with the rarer letters.

Offline, I tried running this code with the top 21 letters (that is, all but Z, X, J, and Q) and while it takes a long time to run it confirms that you can’t beat R/EIRNTG, and that none of the letters after G are particularly strong.

Shortcut: Pangrams

It wasn’t until later in the day (2020-01-06) that I posted this that Hector Pefo pointed out an excellent shortcut.

You can find all possible 7-letter sets that yield pangrams (only about 8K), generate word-lists for these sets, and then score all 56K possible bees. 23sec. Same answer, but nowhere near as interesting a process! https://t.co/ue6AXqqk9s
— Hector Pefo (@HectorPefo) January 6, 2020

I’d ignored the “each puzzle must have a pangram” rule (since I confirmed that whatever won haed at least one), but I hadn’t thought of using it as a shortcut. Thanks to this approach, we can do this a good deal faster, and without relying on heuristics!

We’d start by making a binary matrix of the legal pangrams.

possible_pangrams <- words %>%
  filter(unique_letters == 7) %>%
  mutate(letters = map_chr(letters, ~ paste(sort(.), collapse = ","))) %>%
  distinct(letters) %>%
  mutate(combination = letters) %>%
  separate_rows(letters) %>%
  reshape2::acast(combination ~ letters, fun.aggregate = length)

head(possible_pangrams)

##               a b c d e f g h i j k l m n o p q r t u v w x y z
## a,b,c,d,e,f,k 1 1 1 1 1 1 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## a,b,c,d,e,f,r 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0
## a,b,c,d,e,h,l 1 1 1 1 1 0 0 1 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0
## a,b,c,d,e,h,n 1 1 1 1 1 0 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0
## a,b,c,d,e,h,o 1 1 1 1 1 0 0 1 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0
## a,b,c,d,e,h,r 1 1 1 1 1 0 0 1 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0

There are only 7986 combinations of seven letters that offer a pangram, meaning there are 7 x 7986 = 5.5902 × 10⁴ possible.

We can modify the matrix multiplication to score each of these combinations. As part of this process, I’ve also figured out how to test all the central letters in one additional matrix multiplication (which I could have done in the original solution if we’d used the word_by_center matrix).

library(Matrix)

# This is efficient only with sparse matrices
word_matrix_sparse <- as(word_matrix, "sparseMatrix")

# Find the words that are possible with each pangram
pangram_words <- word_matrix_sparse %*% t(1 - possible_pangrams) == 0

# Find the matrix of word scores based on what the center letter is
# A word is included only if it has that central letter
word_by_center <- points_per_word[rownames(word_matrix)] * word_matrix_sparse

# Create a 8K by 25 matrix: best combination + best center letter
scores <- t(pangram_words) %*% word_by_center

# Tidy the matrix
puzzle_solutions <- reshape2::melt(as.matrix(scores),
                          varnames = c("combination", "center"),
                          value.name = "score") %>%
  as_tibble() %>%
  filter(score > 0) %>%
  arrange(desc(score))

puzzle_solutions

## # A tibble: 55,902 x 3
##    combination   center score
##    <fct>         <fct>  <dbl>
##  1 a,e,g,i,n,r,t r       3898
##  2 a,e,g,i,n,r,t n       3782
##  3 a,e,g,i,n,r,t e       3769
##  4 a,d,e,i,n,r,t e       3672
##  5 a,e,g,i,n,r,t t       3421
##  6 a,e,g,i,n,r,t i       3406
##  7 a,e,g,i,n,r,t a       3372
##  8 a,d,e,g,i,n,r e       3271
##  9 a,d,e,g,i,n,r r       3236
## 10 a,d,e,i,l,r,t e       3194
## # … with 55,892 more rows

With this scores matrix, we can confirm our finding of the highest combination, center and score. It also shows that the top three puzzles all have the same combination (but different center letters).

This is pretty fast (about 25 seconds for me), and runs without any heuristics. It also lets us discover the worst score!

puzzle_solutions %>%
  arrange(score)

## # A tibble: 55,902 x 3
##    combination   center score
##    <fct>         <fct>  <dbl>
##  1 c,i,n,o,p,r,x x         14
##  2 b,i,m,n,r,u,v v         15
##  3 b,e,j,k,o,u,x x         15
##  4 c,f,l,n,o,u,x x         15
##  5 a,c,e,i,q,u,z z         15
##  6 d,f,h,n,o,u,x x         16
##  7 e,i,o,q,t,u,x x         16
##  8 a,b,d,i,j,r,y j         17
##  9 a,c,d,j,q,r,u q         17
## 10 b,h,i,l,p,u,w w         17
## # … with 55,892 more rows

This reveals that there’s only one combination, c,i,n,o,p,r,x with center letter x, that has the minimum possible Spelling Bee score of 14: a single 7-letter pangram where the combination offers no other words. (If you’re interested, the word is “princox”).

Conclusion

After a decade programming in R, I still love the process of journeying through multiple approaches to a problem, and iterating before I find an efficient and elegant solution. An important part of the process was also sharing the work publicly and getting feedback, so that Hector could contribute a deeper optimization. Just because we end up with a handful of matrix multiplications doesn’t mean it’s easy to get there, especially when you’re out of practice with linear algebra like I am.

Every time I practice linear algebra pic.twitter.com/xDgXkFB8xD
— David Robinson (@drob) March 28, 2016

That’s why I’m glad that I recorded and shared my first attempt at this puzzle, including my dead ends and misunderstandings. (I even originally misunderstood the end goal of the puzzle, far from the first time that’s happened!) I hope it’s useful to you too!

The birthday paradox puzzle: tidy simulation in R

2020-01-03T14:00:00+00:00

Previously in this series:

The birthday problem is a classic probability puzzle, stated something like this.

A room has n people, and each has an equal chance of being born on any of the 365 days of the year. (For simplicity, we’ll ignore leap years). What is the probability that two people in the room have the same birthday?

If you’re not familiar with the puzzle, you might expect that in a moderately sized room (like 20-30 people) that the chance will be pretty small that two people have the same birthday. But in fact, if the room has more than 23 people, the chance is greater than 50%! This makes the puzzle a classic for intro statistics classes.

I’ve been interested for a while in the tidyverse approach to simulation. In this post, I’ll use the birthday problem as an example of this kind of tidy simulation, most notably the use of the underrated crossing() function.

Simulating the birthday paradox

First, I’ll show the combined approach, before breaking it down.

library(tidyverse)
theme_set(theme_light())

summarized <- crossing(people = seq(2, 50, 2),
                       trial = 1:10000) %>%
  mutate(birthday = map(people, ~ sample(365, ., replace = TRUE)),
         multiple = map_lgl(birthday, ~ any(duplicated(.)))) %>%
  group_by(people) %>%
  summarize(chance = mean(multiple))

# Visualizing the probability
ggplot(summarized, aes(people, chance)) +
  geom_line() +
  scale_y_continuous(labels = scales::percent_format()) +
  labs(y = "Probability two have the same birthday")

This visualization shows that the probability two people have the same birthday is low if there are 10 people in the room, moderate if there are 10-40 people in the room, and very high if there are more than 40. It crosses over to become more likely than not when there are ~23 people in the room.

I’ll break down the simulation a bit below.

Simulating one case

When you’re approaching a simulation problem, it can be worth simulating a single case first.

Suppose we have 20 people in a room. Ignoring leap years (and treating each calendar day as a number from 1 to 365), we can simulate their birthdays with sample(365, 20, replace = TRUE).

# 10 random numbers from 1 to 365
sample(365, 10, replace = TRUE)

##  [1]  53 216 220 309  13  37  35 299 263 333

We then use two handy base R functions, duplicated and any, to discover if there are any duplicated days.

# When the values 2 and 1 appear for the second time, they're TRUE
duplicated(c(1, 2, 3, 4, 2, 5, 1))

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

# This asks "are any values here duplicated?"
any(duplicated(c(1, 2, 3, 4, 2, 5, 1)))

## [1] TRUE

This gives us a one-liner for simulating a single case of the birthday problem, with (say) 20 people:

any(duplicated(sample(365, 20, replace = TRUE)))

## [1] TRUE

If you run this line a few times, you’ll see it’s sometimes true and sometime false, which already gives us the sense that pairs of people sharing a birthday in a moderately-sized room aren’t as rare as you might expect.

The tidy approach to many simulations across multiple parameters

I find the crossing() function in tidyr incredibly valuable for simulation. crossing() creates a tibble of all combinations of its arguments.

crossing(first = c("a", "b", "c"),
         second = c(1, 2, 3))

## # A tibble: 9 x 2
##   first second
##   <chr>  <dbl>
## 1 a          1
## 2 a          2
## 3 a          3
## 4 b          1
## 5 b          2
## 6 b          3
## 7 c          1
## 8 c          2
## 9 c          3

Our simulation starts by generating 10000 * 25 combinations of people and trial, with values of people ranging from 2 to 50. trial exists only so that we have many observations of each, in order to minimize statistical noise.

# Generate combinations of 10,000 replications and number of people (2-50)
crossed <- summarized <- crossing(trial = seq_len(10000),
                                  people = seq(2, 50, 2))

crossed

## # A tibble: 250,000 x 2
##    trial people
##    <int>  <dbl>
##  1     1      2
##  2     1      4
##  3     1      6
##  4     1      8
##  5     1     10
##  6     1     12
##  7     1     14
##  8     1     16
##  9     1     18
## 10     1     20
## # … with 249,990 more rows

We then use functions from purrr, useful for operating across a list, to generate a list column of integer vectors. With a second step, we determine which of them have multiples of any birthday.

# Generate a list column of samples
sim <- crossed %>%
  mutate(birthday = map(people, ~ sample(365, ., replace = TRUE)),
         multiple = map_lgl(birthday, ~ any(duplicated(.))))

sim

## # A tibble: 250,000 x 4
##    trial people birthday   multiple
##    <int>  <dbl> <list>     <lgl>   
##  1     1      2 <int [2]>  FALSE   
##  2     1      4 <int [4]>  FALSE   
##  3     1      6 <int [6]>  TRUE    
##  4     1      8 <int [8]>  FALSE   
##  5     1     10 <int [10]> FALSE   
##  6     1     12 <int [12]> FALSE   
##  7     1     14 <int [14]> FALSE   
##  8     1     16 <int [16]> FALSE   
##  9     1     18 <int [18]> FALSE   
## 10     1     20 <int [20]> FALSE   
## # … with 249,990 more rows

Finally, we use one of my favorite tricks in R: using mean() to find the fraction of a logical vector that’s TRUE.

# Find the percentage of cases where multiple is TRUE
summarized <- sim %>%
  group_by(people) %>%
  summarize(chance = mean(multiple))

summarized

## # A tibble: 25 x 2
##    people chance
##     <dbl>  <dbl>
##  1      2 0.0019
##  2      4 0.0157
##  3      6 0.0434
##  4      8 0.0706
##  5     10 0.113 
##  6     12 0.162 
##  7     14 0.223 
##  8     16 0.279 
##  9     18 0.344 
## 10     20 0.414 
## # … with 15 more rows

Together these three steps (crossed+sim+summarized) make up the solution in the first code chunk above. Notice this simulation combines the base R approach (sample, duplicated, and any) with tidyverse functions from dplyr (like mutate, group_by, and summarize), tidyr (crossing) and purrr (map and map_lgl). I’ve found this crossing/map/summarize approach useful in many simulations.

How can we check our math? R has a built-in pbirthday function that gives an exact solution: for instance, pbirthday(20) gives the probability two people in a room of 20 will have the same birthday. We can compare our su

# pbirthday is not vectorized, so we have to use map_dbl
summarized %>%
  mutate(exact = map_dbl(people, pbirthday)) %>%
  ggplot(aes(people, chance)) +
  geom_line() +
  geom_line(aes(y = exact), lty = 2, color = "red") +
  labs(x = "# of people",
       y = "Probability two have the same birthday")

Looks like we got very close!

Generalizing the birthday problem

We’ve seen how likely it is that there’s a pair of people with the same birthday. What about a group of 3, 4, or 5 who all have the same birthday? How likely is that?

First, instead of working with ~ any(duplicated(.)) as our vectorized operation, we could find how many people are in the most common group of birthdays, with another combination of base R functions: max and table.

# table() returns a vector of frequencies
table(c("a", "b", "b", "c", "c", "d", "d", "d"))

## 
## a b c d 
## 1 2 2 3

# So max(table()) tells us that in this group, one letter occurs 3 times
max(table(c("a", "b", "b", "c", "c", "d", "d", "d")))

## [1] 3

# Use this max(table()) approach in the map_int
sim_most_common <- crossing(people = seq(5, 100, 5),
                            trial = 1:5000) %>%
  mutate(birthday = map(people, ~ sample(365, ., replace = TRUE))) %>%
  mutate(most_common = map_int(birthday, ~ max(table(.))))

sim_most_common

## # A tibble: 100,000 x 4
##    people trial birthday  most_common
##     <dbl> <int> <list>          <int>
##  1      5     1 <int [5]>           1
##  2      5     2 <int [5]>           1
##  3      5     3 <int [5]>           1
##  4      5     4 <int [5]>           1
##  5      5     5 <int [5]>           1
##  6      5     6 <int [5]>           1
##  7      5     7 <int [5]>           1
##  8      5     8 <int [5]>           1
##  9      5     9 <int [5]>           2
## 10      5    10 <int [5]>           1
## # … with 99,990 more rows

Now that we know within each trial what the largest group with the same birthday is. We now need to know the fraction within each number where the most_common is at least 2, 3, 4, or 5. We use another application of the ever-useful crossing function, to apply multiple thresholds to each number of people.

summarized_most_common <- sim_most_common %>%
  crossing(threshold = 2:5) %>%
  group_by(people, threshold) %>%
  summarize(chance = mean(most_common >= threshold))

summarized_most_common

## # A tibble: 80 x 3
## # Groups:   people [20]
##    people threshold chance
##     <dbl>     <int>  <dbl>
##  1      5         2 0.0302
##  2      5         3 0     
##  3      5         4 0     
##  4      5         5 0     
##  5     10         2 0.115 
##  6     10         3 0.001 
##  7     10         4 0     
##  8     10         5 0     
##  9     15         2 0.250 
## 10     15         3 0.0036
## # … with 70 more rows

We can visualize these and compare them to the exact values from pbirthday() (pbirthday() takes a coincident argument to extend the problem to more than two participants).

summarized_most_common %>%
  mutate(exact = map2_dbl(people, threshold,
                          ~ pbirthday(.x, coincident = .y))) %>%
  ggplot(aes(people, chance, color = factor(threshold))) +
  geom_line() +
  geom_line(aes(y = exact), lty = 2) +
  scale_y_continuous(labels = scales::percent_format()) +
  labs(x = "# of people in room",
       y = "Probability a group with the same birthday exists",
       color = "Group size")

From this we learn that in a room of 100 people, it is almost certain that a pair exists with the same birthday, more likely than not that that a group of 3 does, unlikely that a group of 4 does, and almost impossible that a group of 5 does.

What I like about the tidy approach to simulation is that we can keep adding parameters that we’d like to vary through an extra crossing() and an extra term in the group_by. For instance, if we’d wanted to see how the probability varied as the number of days in a year changed (not relevant for birthdays, but might be relevant in other applications like the cryptographic birthday attack), we could have added that to the crossing() and worked with the first argument to sample.

The 'largest stock profit or loss' puzzle: efficient computation in R

2019-12-24T14:00:00+00:00

Previously in this series:

I recently came across an interview problem from A Cool SQL Problem: Avoiding For-Loops . Avoiding loops is a topic I always enjoy reading about, and the blog post didn’t disappoint. I’ll quote that post’s description of the problem:

You have a table of trading days (with no gaps) and close prices for a stock.

Find the highest and lowest profits (or losses) you could have made if you bought the stock at one close price and sold it at another close price, i.e. a total of exactly two transactions.

You cannot sell a stock before it has been purchased. Your solution can allow buying and selling on the same trading_date (i.e. profit or loss of $0 is always, by definition, an available option); however, for some bonus points, you may write a more general solution for this problem that requires you to hold the stock for at least N days.

The blog post provided a SQL solution, and noted the importance of thinking with tables rather than loops. But the post made me think about how I’d solve the problem in R, and make the solution as computationally efficient as possible. As in many of my posts, we’ll take a “tidy approach” that focuses on the dplyr, tidyr, and ggplot2 packages.

Setup: Getting stock data with the tidyquant package

The original blog post worked on just one stock symbol, but let’s make the problem slightly harder by examining data for several stocks at the same time. To gather some real data, I’ll use the excellent tidyquant package from Business Science. I’ll pick four stocks: Apple, Microsoft, Netflix, and Tesla.

library(tidyverse)
library(tidyquant)

stock_symbols <- c("AAPL", "MSFT", "NFLX", "TSLA")

# Keep just the closing price
stock_prices <- tq_get(stock_symbols, from = "2010-01-01") %>%
  select(symbol, date, close)

stock_prices

## # A tibble: 9,922 x 3
##    symbol date       close
##    <chr>  <date>     <dbl>
##  1 AAPL   2010-01-04  30.6
##  2 AAPL   2010-01-05  30.6
##  3 AAPL   2010-01-06  30.1
##  4 AAPL   2010-01-07  30.1
##  5 AAPL   2010-01-08  30.3
##  6 AAPL   2010-01-11  30.0
##  7 AAPL   2010-01-12  29.7
##  8 AAPL   2010-01-13  30.1
##  9 AAPL   2010-01-14  29.9
## 10 AAPL   2010-01-15  29.4
## # … with 9,932 more rows

Notice that the result from tq_get is tidy: one row per symbol per day. This isn’t part of the interview question, but we can visualize the stocks over time using ggplot2.

# In honor of the tidyquant package, we'll use theme_tq
theme_set(theme_tq())

ggplot(stock_prices, aes(date, close, color = symbol)) +
  geom_line() +
  theme_tq()

Solving the problem with a self-join

One way to approach this problem (one taken in SQL by the original blog post) is to cross join the data with itself, and examine all combinations of dates with a future date.

In this case, since we have the symbol column and we only want to compare symbols to themselves, we’ll want to join based on the "symbol" column.¹

library(tidyr)

stock_prices %>%
  inner_join(stock_prices,
             by = "symbol",
             suffix = c("", "_future"))

## # A tibble: 24,622,684 x 5
##    symbol date       close date_future close_future
##    <chr>  <date>     <dbl> <date>             <dbl>
##  1 AAPL   2010-01-04  30.6 2010-01-04          30.6
##  2 AAPL   2010-01-04  30.6 2010-01-05          30.6
##  3 AAPL   2010-01-04  30.6 2010-01-06          30.1
##  4 AAPL   2010-01-04  30.6 2010-01-07          30.1
##  5 AAPL   2010-01-04  30.6 2010-01-08          30.3
##  6 AAPL   2010-01-04  30.6 2010-01-11          30.0
##  7 AAPL   2010-01-04  30.6 2010-01-12          29.7
##  8 AAPL   2010-01-04  30.6 2010-01-13          30.1
##  9 AAPL   2010-01-04  30.6 2010-01-14          29.9
## 10 AAPL   2010-01-04  30.6 2010-01-15          29.4
## # … with 24,721,994 more rows

This creates all combinations of present and future dates, ending up in columns close and close_future. Now we’ll need a few dplyr steps:

Filter for cases where date_future is greater than date (filter)
Look at the change if you bought on date and sold on date_future (mutate)
Aggregate to find the maximum and minimum change within each symbol (group_by/summarize)

So our solution looks like this:

stock_prices %>%
  inner_join(stock_prices,
             by = "symbol",
             suffix = c("", "_future")) %>%
  filter(date_future >= date) %>%
  mutate(change = close_future - close) %>%
  group_by(symbol) %>%
  summarize(largest_gain = max(change),
            largest_loss = min(change))

## # A tibble: 4 x 3
##   symbol largest_gain largest_loss
##   <chr>         <dbl>        <dbl>
## 1 AAPL           266.        -89.9
## 2 MSFT           136.        -21.5
## 3 NFLX           412.       -185. 
## 4 TSLA           415.       -206.

I don’t know if this metric is at all meaningful from a finance perspective (of course nobody would know in advance when you’re supposed to buy and sell a stock to maximize a stock), but it’s interesting to see how much Netflix has grown since 2010, and how Tesla has seen a large drop (though based on the graph above it has since recovered).

The above lines up with the original blog post: join the data to itself while constraining on comparing dates to future dates. However, in R, on a dataset this size, it’s not a very fast approach. It had to create a 25-million row table (~6.3 million for each symbol; the number of days squared), and it had to make millions of comparisons. On my machine it takes about 3 seconds to run, and if we’d had a dataset of thousands of symbols it would have been impossible.

Solving with vectorized functions: cummean and cummax

A much faster approach in R is to use vectorized functions. In particular, we can use cummax() (cumulative max) and cummin() (cumulative min), to quickly discover the highest and lowest future prices from each date.

We first sort by the stock symbol² and by the descending date. We also group by the symbol, which means we’ll be looking at changes within each stock.

stock_prices %>%
  arrange(symbol, desc(date)) %>%
  group_by(symbol) %>%
  mutate(highest_future = cummax(close),
         lowest_future = cummin(close))

## # A tibble: 9,922 x 5
## # Groups:   symbol [4]
##    symbol date       close highest_future lowest_future
##    <chr>  <date>     <dbl>          <dbl>         <dbl>
##  1 AAPL   2019-12-23  284             284          284 
##  2 AAPL   2019-12-20  279.            284          279.
##  3 AAPL   2019-12-19  280.            284          279.
##  4 AAPL   2019-12-18  280.            284          279.
##  5 AAPL   2019-12-17  280.            284          279.
##  6 AAPL   2019-12-16  280.            284          279.
##  7 AAPL   2019-12-13  275.            284          275.
##  8 AAPL   2019-12-12  271.            284          271.
##  9 AAPL   2019-12-11  271.            284          271.
## 10 AAPL   2019-12-10  268.            284          268.
## # … with 9,912 more rows

Look, for instance, at the 10th row of the table. The closing price of AAPL on 2019-12-10 was 268, and the highest it will ever be in the future is 284, while the lowest it will ever be is 268. This means that someone buying on 2019-12-10 could gain up to $16, and couldn’t lose money.

By finding the largest/smallest difference between each day’s price and the highest/lowest future price, we can get the highest possible gain or the biggest possible loss. This gives us a new approach to the interview problem.

stock_prices %>%
  arrange(symbol, desc(date)) %>%
  group_by(symbol) %>%
  summarize(highest_gain = max(cummax(close) - close),
            biggest_loss = min(cummin(close) - close))

## # A tibble: 4 x 3
##   symbol highest_gain biggest_loss
##   <chr>         <dbl>        <dbl>
## 1 AAPL           266.        -89.9
## 2 MSFT           136.        -21.5
## 3 NFLX           412.       -185. 
## 4 TSLA           415.       -206.

In R, this is about 1000X faster than the self-join approach (for me it takes about 5 milliseconds, compared to about 3 seconds for self-join). cummin and cummax are fast (they’re base R functions implemented in C), and the effect on memory is linear in terms of the number of observations.

It’s worth mentioning that the vectorized approach isn’t specific to dplyr (though dplyr makes it especially convenient for performing within each stock symbol). If x is an ordered vector, you can use rev(cummax(rev(x))) to get the highest future gain, which gives us a one liner for performing this on a vector of prices.

# Using the vector of prices from the ryx,r blog post
x <- c(41, 43, 47, 42, 45, 39,  38, 41)

max(rev(cummax(rev(x))) - x)

## [1] 6

min(rev(cummin(rev(x))) - x)

## [1] -9

Variation: waiting at least N days?

There’s one more variation from the original blog post that’s worth thinking through. What if you set the rule that you have to hold the stock for some number N (say, 100) of trading days N before selling it?

You can solve this in R with the dplyr’s lag() window function, which shifts each value in a vector several positions later.

# Separated into a mutate and a summarize just for the sake of clarity
stock_prices %>%
  arrange(symbol, desc(date)) %>%
  group_by(symbol) %>%
  mutate(highest_future = lag(cummax(close), 100),
         lowest_future = lag(cummin(close), 100)) %>%
  summarize(highest_gain = max(highest_future - close, na.rm = TRUE),
            biggest_loss = min(lowest_future - close, na.rm = TRUE))

## # A tibble: 4 x 3
##   symbol highest_gain biggest_loss
##   <chr>         <dbl>        <dbl>
## 1 AAPL           257.        -73.7
## 2 MSFT           134.        -16.7
## 3 NFLX           412.       -185. 
## 4 TSLA           403.       -206.

From this we can see that if we had to wait 100 days, our “highest possible gain” doesn’t change, but our “biggest possible loss” shrinks for some of them. This makes sense because these stocks have generally been growing over time.

What if we wanted to see how the N (the gap we have to wait) changes the biggest gain and biggest loss? Well, one of my favorite tidyr tricks is crossing(), which duplicates a dataset multiple times. By duplicating the data for many values of N, then doing lag(cummax(close), N[1]), we can calculate a solution for many values of N, and visualize them.

biggest_changes <- stock_prices %>%
  crossing(N = seq(0, 1000, 10)) %>%
  arrange(N, symbol, desc(date)) %>%
  group_by(N, symbol) %>%
  mutate(highest_future = lag(cummax(close), N[1]),
         lowest_future = lag(cummin(close), N[1])) %>%
  summarize(highest_gain = max(highest_future - close, na.rm = TRUE),
            biggest_loss = min(lowest_future - close, na.rm = TRUE))

biggest_changes %>%
  ggplot(aes(N, biggest_loss, color = symbol)) +
  geom_line() +
  labs(x = "Gap that you have to wait before selling a stock",
       y = "Biggest loss possible in 2010-2019")

This extension was made possible by two features of our approach:

Advantage of the tidyverse: Since we solved the problem with dplyr, it was fairly straightforward to examine the effect of another parameter (N, the number of days we had to wait) by adding an extra group_by variable.
Advantage of computational speed: Since we managed to solve the problem in milliseconds rather than seconds, it wasn’t much of a hassle to solve it for a hundred different input parameters.

Fun fact: if there were only one stock and it didn’t have a symbol column, we could have used crossing() to find all combinations. ↩
Technically, we don’t have to sort by symbol; as long as you’re sorted by descending date, the grouped operation will work within each symbol. However, this makes the data to understand when viewing the first few rows. ↩

The 'knight on an infinite chessboard' puzzle: efficient simulation in R

2018-12-10T16:00:00+00:00

Previously in this series:

I’ve recently been enjoying The Riddler: Fantastic Puzzles from FiveThirtyEight, a wonderful book from 538’s Oliver Roeder. Many of the probability puzzles can be productively solved through Monte Carlo simulations in R.

Here’s one that caught my attention:

Suppose that a knight makes a “random walk” on an infinite chessboard. Specifically, every turn the knight follows standard chess rules and moves to one of its eight accessible squares, each with probability 1/8.

What is the probability that after the twentieth move the knight is back on its starting square?

In this post I’ll show how I’d answer this question through simulation in R, with an eye on keeping the simulation fast and interpretable. As in many of my posts, we’ll take a “tidy approach” that focuses on the dplyr, tidyr, and ggplot2 packages.

Simulating a knight’s moves

The first question is how we can simulate a knight’s move randomly. There are eight positions that a knight can move to, following the rule of “two spaces in one direction, one in the other”.

It helps to break each possible move into its X and Y components:

X = 2, Y = 1
X = 2, Y = -1
X = 1, Y = 2
X = 1, Y = -2
X = -1, Y = 2
X = -1, Y = -2
X = -2, Y = 1
X = -2, Y = -1

Notice that the moves are always made up of one 2 and one 1, and that either, both, or neither can be negative.

The first step of the simulation (getting a 1 and a 2) can be done as follows for a single simulation:

# Random number between 1 and 2
move_x <- sample(2, 1)

# If x is 2, y is 1, and vice versa
move_y <- 3 - move_x

c(move_x, move_y)

## [1] 1 2

How about letting either number be negative? Well, sample(c(1, -1)) can get us a value that’s either 1 or -1, so we can multiply that by each.

move_x <- sample(2, 1) * sample(c(1, -1), 1)
move_y <- (3 - abs(move_x)) * sample(c(1, -1), 1)

c(move_x, move_y)

## [1]  2 -1

Now that we can sample a single move, we can try sampling many moves (say, 20) by adding 20, replace = TRUE to each.

move_x <- sample(2, 20, replace = TRUE) * sample(c(1, -1), 20, replace = TRUE)
move_y <- (3 - abs(move_x)) * sample(c(1, -1), 20, replace = TRUE)

move_x

##  [1]  2  1  1  1 -2  2 -2  1  2 -2 -1  1 -2 -2  2 -2  1 -2 -2 -2

move_y

##  [1]  1 -2 -2 -2  1  1  1 -2 -1 -1  2 -2 -1 -1 -1 -1 -2 -1  1 -1

Now that we’ve figured out how to simulate chess moves, we can go ahead with our simulation of positions.

Tidy simulation

The crossing() function from tidyr is wonderful for setting up Monte Carlo simulations. It creates a tbl_df with every combination of the inputs (it’s similar to the built-in expand.grid).

In this simulation we’ll want some number of trials and some number of turns. If we wanted to generate 3 trials that each included 3 chess turns, we could do:

crossing(trial = 1:3,
         turn = 1:3)

## # A tibble: 9 x 2
##   trial  turn
##   <int> <int>
## 1     1     1
## 2     1     2
## 3     1     3
## 4     2     1
## 5     2     2
## 6     2     3
## 7     3     1
## 8     3     2
## 9     3     3

In this experiment, we’ll simulate 100,000 trials (and, as the riddle specifies, 20 moves), and then bring in our vectorized approach to simulating chess moves. Notice we use n() (a special dplyr function) for the number of items.

# Use n() and replace = TRUE to vectorize the sampling above
crossing(trial = 1:100000,
         turn = 1:20) %>%
  mutate(move_x = sample(2, n(), replace = TRUE) *
           sample(c(1, -1), n(), replace = TRUE),
         move_y = (3 - abs(move_x)) *
           sample(c(1, -1), n(), replace = TRUE))

## # A tibble: 2,000,000 x 4
##    trial  turn move_x move_y
##    <int> <int>  <dbl>  <dbl>
##  1     1     1      1     -2
##  2     1     2      2     -1
##  3     1     3      1     -2
##  4     1     4     -1     -2
##  5     1     5     -2     -1
##  6     1     6     -1     -2
##  7     1     7      1     -2
##  8     1     8     -2      1
##  9     1     9      1     -2
## 10     1    10      2     -1
## # ... with 1,999,990 more rows

Now, because the knights both start at (0, 0), we can calculate the position based on the cumulative sum of moves the X direction and in the Y direction. We do this by adding a group_by() (since movement happens separately within each trial) and mutate() to the sequence.

turns <- crossing(trial = 1:100000,
                  turn = 1:20) %>%
  mutate(move_x = sample(2, n(), replace = TRUE) *
           sample(c(1, -1), n(), replace = TRUE),
         move_y = (3 - abs(move_x)) *
           sample(c(1, -1), n(), replace = TRUE)) %>%
  group_by(trial) %>%
  mutate(position_x = cumsum(move_x),
         position_y = cumsum(move_y)) %>%
  ungroup()

turns

## # A tibble: 2,000,000 x 6
##    trial  turn move_x move_y position_x position_y
##    <int> <int>  <dbl>  <dbl>      <dbl>      <dbl>
##  1     1     1      1      2          1          2
##  2     1     2      2      1          3          3
##  3     1     3      1      2          4          5
##  4     1     4     -2     -1          2          4
##  5     1     5     -1      2          1          6
##  6     1     6      2     -1          3          5
##  7     1     7      1     -2          4          3
##  8     1     8      2      1          6          4
##  9     1     9      2     -1          8          3
## 10     1    10      1     -2          9          1
## # ... with 1,999,990 more rows

Just like that, we’ve performed 100,000 trials of 20 sequential chess moves. Not bad!

Answering the questions

First, let’s answer the riddle’s question. How often is the knight back at its home space (0, 0) by the twentieth move?

turns %>%
  filter(turn == 20) %>%
  summarize(mean(position_x == 0 & position_y == 0))

## # A tibble: 1 x 1
##   `mean(position_x == 0 & position_y == 0)`
##                                       <dbl>
## 1                                   0.00627

The probability of being back on the home space is about .6%.

How does this compare to other turns?

library(ggplot2)
theme_set(theme_light())

by_turn <- turns %>%
  group_by(turn) %>%
  summarize(home = mean(position_x == 0 & position_y == 0))

by_turn %>%
  ggplot(aes(turn, home)) +
  geom_line() +
  scale_y_continuous(labels = scales::percent_format()) +
  labs(y = "% home")

It looks like it’s impossible for the knight to be back home on an odd numbered turn (if you have a chessboard you can try it!). At an even numbered turn, the probability is 1/8 for the second turn (the probability the first move was immediately followed by the opposite move). It then goes down from there to the .006 we see above.

Where might the chess piece be by turn 20? A geom_tile is a nice visualization for this.

turns %>%
  filter(turn == 20) %>%
  count(position_x, position_y, sort = TRUE) %>%
  ggplot(aes(position_x, position_y, fill = n)) +
  geom_tile()

Finally, any time we look at change over time (especially in several dimensions like a chess board), we can use Thomas Pedersen’s gganimate package to give a more dynamic view.

library(gganimate)

turns %>%
  count(turn, position_x, position_y) %>%
  ggplot(aes(position_x, position_y, fill = n)) +
  geom_tile() +
  transition_manual(turn)

Besides showing how the knight “spreads” across the board, the animation communicates an insight that might not be noticeable otherwise (but which is relevant in chess): any given space on the chessboard is either an “odd # of moves” space or an “even # of moves” one. As we saw earlier, the home is an even space, so it can be reached on turn 20 but not on turns 19 or 21.

Conclusions

What have we learned about efficient simulation in R?

Think vectorizably: Notice that we generated all of our 2 million moves in a couple of calls to sample(). This helps keeps our simulation fast because functions like sample() have some computational overhead. If we’d simulated each individual move in a loop, this simulation would have taken a lot longer.
Some functions show up a lot in simulations. The crossing() and cumsum() functions are very different, but they’re both wildly useful for simulations. Make sure you learn and understand them!
Tidy simulation is useful for visualization This puzzle could have been solved a bit more computationally efficiently by creating matrices for move_x, move_y, position_x, and position_y, and operating on them instead. In my opinion it would have made the code a bit less readable. But more importantly, by working in a tidy format we were able to immediately pipe the results into ggplot2 and gganimate and create visualizations. These helped check our results and improve our intuition around the answer.

Until next time, happy simulating!

Exploring college major and income: a live data analysis in R

2018-10-16T15:20:00+00:00

I recently came up with the idea for a series of screencasts:

I've thought about recording a screencast of an example data analysis in #rstats. I'd do it on a dataset I'm unfamiliar with so that I can show and narrate my live thought process.

Any suggestions for interesting datasets to use?
— David Robinson (@drob) October 6, 2018

Hadley Wickham had the great suggestion of analyzing a Tidy Tuesday dataset. Tidy Tuesday is a fantastic project run by the R for Data Science online learning community (especially Thomas Mock) that releases an interesting dataset each week.

I’ve now released my first such screencast, exploring this week’s Tidy Tuesday dataset on (the data behind The Economic Guide to Picking a College Major). You can also find the R Markdown I produced here.

I produced a handful of figures that I found pretty interesting. I took a look at the distribution of income from graduates within each category of major.

I spent some time on looking at the differences in gender distribution across majors, which was also included in the data.

And I ended by setting up an interactive scatterplot with the plotly package that compared the share of women in a field to the median salary.

Some notes and observations:

This isn’t an R tutorial: If I were teaching R, I’d have prepared in advance and moved more slowly through the material. This is a case study in how I’d dive into a dataset and learn from it, including steps where I think aloud and decide what route to take. If anything, it’s closer to a “speedrun”.
I enjoyed showing the order I work in: I write blog posts somewhat “inside-out”: I start with a few figures, then figure out what preprocessing I should have started with, and I’m always moving uninteresting figures out of the post or to appendices. It was nice to show how an analysis took shape and ended up looking like a organized final product.
I ran into fewer bugs than I expected to Part of the excitement of a live screencast is that “anything can go wrong” (part of the reason I recorded this first one in advance rather than live is to practice with less pressure!) I was pretty well versed in the tools I used in this session (dplyr and ggplot2), so I got stuck on only a handful of bugs (though I did go down a few unproductive routes).

I had enough fun that I think I’ll do it again (though probably not every week). With that in mind, I’ve learned some lessons that might improve my future screencasts:

I speak too fast: this is a recurring issue for me. When I’m speaking in front of an audience I can watch people’s faces and pace myself a bit better, but when I’m “by myself” while recording it’s difficult. I’ve learned this is especially difficult for non-native listeners, and I’ll try to be more conscious and speak slower!
I need to keep a better eye on time: The screencast is about 80 minutes long (I’d originally planned on an hour, and I’ll probably aim for that in the future). I’d be interested in feedback about the length, and whether people find the whole session interesting.

I look forward to hearing your feedback, and to recording to the next one!

Who wrote the anti-Trump New York Times op-ed? Using tidytext to find document similarity

2018-09-06T12:00:00+00:00

Like a lot of people, I was intrigued by “I Am Part of the Resistance Inside the Trump Administration”, an anonymous New York Times op-ed written by a “senior official in the Trump administration”. And like many data scientists, I was curious about what role text mining could play.

Ok NLP people, now’s your chance to shine. Just spitballing here but TF-IDF on “the op-ed” compared to the published writing of every senior Trump admin official? I want likelihood estimates with standard errors. GO!
— Drew Conway (@drewconway) September 5, 2018

This is a useful opportunity to demonstrate how to use the tidytext package that Julia Silge and I developed, and in particular to apply three methods:

Using TF-IDF to find words specific to each document (examined in more detail in Chapter 3 of our book)
Using widyr to compute pairwise cosine similarity
How to make similarity interpretable by breaking it down by word

Since my goal is R education more than it is political analysis, I show all the code in the post.

Even in the less than 24 hours since the article was posted, I’m far from the first to run text analysis on it. In particular Mike Kearney has shared a great R analysis on GitHub (which in particular pointed me towards CSPAN’s cabinet Twitter list), and Kanishka Misra has done some exciting work here.

Downloading data

Getting the text of the op-ed is doable with the rvest package.

# setup
library(tidyverse)
library(tidytext)
library(rvest)
theme_set(theme_light())

url <- "https://www.nytimes.com/2018/09/05/opinion/trump-white-house-anonymous-resistance.html"

# tail(-1) removes the first paragraph, which is an editorial header
op_ed <- read_html(url) %>%
  html_nodes(".e2kc3sl0") %>%
  html_text() %>%
  tail(-1) %>%
  data_frame(text = .)

The harder step is getting a set of documents representing “senior officials”. An imperfect but fast approach is to collect text from their Twitter accounts. (If you find an interesting dataset of, say, government FOIA documents, I recommend you try extending this analysis!)

We can look at a combination of two (overlapping) Twitter lists containing administration staff members:

library(rtweet)

cabinet_accounts <- lists_members(owner_user = "CSPAN", slug = "the-cabinet")
staff <- lists_members(slug = "white-house-staff", owner = "digiphile")

# Find unique screen names from either account
accounts <- unique(c(cabinet_accounts$screen_name, staff$screen_name))

# Download ~3200 from each account
tweets <- map_df(accounts, get_timeline, n = 3200)

This results in a set of 136,501 from 69 Twitter handles. There’s certainly no guarantee that the op-ed writer is among these Twitter accounts (or, if they are, that they even write their tweets themselves). But it still serves as an interesting case study of text analysis. How do we find the tweets with the closest use of language?

Tokenizing tweets

First, we need to tokenize the tweets: to turn them from full messages into individual words. We probably want to avoid retweets, and we need to use a custom regular expression for splitting it and remove links (just as I’d done when analyzing Trump’s Twitter account).

# When multiple tweets across accounts are identical (common in government
# accounts), use distinct() to keep only the earliest
reg <- "([^A-Za-z\\d#@']|'(?![A-Za-z\\d#@]))"

tweet_words <- tweets %>%
  filter(!is_retweet) %>%
  arrange(created_at) %>%
  distinct(text, .keep_all = TRUE) %>%
  select(screen_name, status_id, text) %>%
  mutate(text = str_replace_all(text, "https?://t.co/[A-Za-z\\d]+|&amp;", "")) %>%
  unnest_tokens(word, text, token = "regex", pattern = reg) %>%
  filter(str_detect(word, "[a-z]"))

This parses the corpus of tweets into almost 1.5 million words.

Among this population of accounts, and ignoring “stop words” like “the” and “of”, what are the most common words? We can use ggplot2 to visualize this.

tweet_words %>%
  filter(!word %in% stop_words$word) %>%
  count(word, sort = TRUE) %>%
  head(16) %>%
  mutate(word = reorder(word, n)) %>%
  ggplot(aes(word, n)) +
  geom_col() +
  coord_flip() +
  labs(y = "# of uses among staff Twitter accounts")

No real surprises here. Many accounts mention @POTUS often, as well as words like “people”, “American”, and “Trump” that you’d expect from administration accounts.

Finding a text signature: TF-IDF vectors

What words make up someone’s “signature”? What make up mine, or Trump’s, or Mike Pence’s, or the op-ed’s?

We could start with the most common words someone uses. But there are some words, like “the” and “of” that just about everyone uses, as well as words like “President” that everyone in our dataset will use. So we also want to downweight words that appear across many documents. A common tool for balancing these two considerations and turning them into a “signature” vector is tf-idf: term-frequency inverse-document-frequency. This takes how frequently someone uses a term, but divides it by (the log of) how many documents mention it. For more details, see Chapter 3 of Text Mining with R.

The bind_tf_idf function from tidytext lets us compute tf-idf on a dataset of word counts like this. Before we do, we bring in the op-ed as an additional document (since we’re interesting in considering it as one “special” document in our corpus).

# Combine in the op_ed wordswith the name "OP-ED" 
op_ed_words <- op_ed %>%
  unnest_tokens(word, text) %>%
  count(word)

word_counts <- tweet_words %>%
  count(screen_name, word, sort = TRUE) %>%
  bind_rows(op_ed_words %>% mutate(screen_name = "OP-ED"))

# Compute TF-IDF using "word" as term and "screen_name" as document
word_tf_idf <- word_counts %>%
  bind_tf_idf(word, screen_name, n) %>%
  arrange(desc(tf_idf))

word_tf_idf

## # A tibble: 226,410 x 6
##    screen_name    word                 n      tf   idf tf_idf
##    <chr>          <chr>            <int>   <dbl> <dbl>  <dbl>
##  1 JoshPaciorek   #gogreen           170 0.0204   4.25 0.0868
##  2 USTradeRep     ustr               147 0.0213   3.56 0.0757
##  3 DeptVetAffairs #vantagepoint      762 0.0173   3.56 0.0614
##  4 DeptofDefense  #knowyourmil       800 0.0185   3.15 0.0584
##  5 DanScavino     #trumptrain        655 0.0201   2.86 0.0575
##  6 USUN           @ambassadorpower   580 0.0154   3.56 0.0548
##  7 USTreasury     lew                690 0.0183   2.86 0.0523
##  8 HUDgov         hud                566 0.0196   2.30 0.0451
##  9 OMBPress       omb                 38 0.0228   1.95 0.0444
## 10 SecElaineChao  'can                 1 0.00990  4.25 0.0421
## # ... with 226,400 more rows

We can now see the words with the strongest associations to a user. For example, Josh Paciorek (the VP’s Deputy Press Secretary) uses the hashtag #gogreen (supporting Michigan State Football) quite often; it makes up 2% of the words (tf, term frequency). Since no one else uses it (leading to an inverse document frequency, idf, of 4.5), this makes it a critical part of his TF-IDF vector (his “signature”).

We could take a look at the “signatures” of a few selected Twitter accounts.

library(drlib)

selected <- c("realDonaldTrump", "mike_pence", "DeptVetAffairs", "KellyannePolls")

word_tf_idf %>%
  filter(screen_name %in% selected) %>%
  group_by(screen_name) %>%
  top_n(12, tf_idf) %>%
  ungroup() %>%
  mutate(word = reorder_within(word, tf_idf, screen_name)) %>%
  ggplot(aes(word, tf_idf, fill = screen_name)) +
  geom_col(show.legend = FALSE) +
  scale_x_reordered() +
  coord_flip() +
  facet_wrap(~ screen_name, scales = "free_y") +
  labs(x = "",
       y = "TF-IDF vectors of this word for this user",
       title = "TF-IDF: top words for selected staff members")

This gives us a set of words that are quite specific to each account. For instance, @DeptVetAffairs uses hashtags like “#vantagepoint” and “#veteranoftheday” that almost no other account in this set would use. Words that are specific to Trump include “witch” (as in “witch hunt”), “fake” (as in “fake news”) and other phrases that he tends to fixate on while other government officials don’t. (See here for my text analysis of Trump’s tweets as of August 2017).

This shows how TF-IDF offers us a vector (an association of each word with a number) that describes the unique signature of that document. To compare our documents (the op-ed with each Twitter account), we’ll be comparing those vectors.

The widyr package: cosine similarity

How can we compare two vectors to get a measure of document similarity? There are many approaches, but perhaps the most common for comparing TF-IDF vectors is cosine similarity. This is a combination of a dot product (multiplying the same term in document X and document Y together) and a normalization (dividing by the magnitudes of the vectors).

My widyr package offers a convenient way to compute pairwise similarities on a tidy dataset:

library(widyr)

# Find similarities between screen names
# upper = FALSE specifies that we don't want both A-B and B-A matches
word_tf_idf %>%
  pairwise_similarity(screen_name, word, tf_idf, upper = FALSE, sort = TRUE)

## # A tibble: 2,415 x 3
##    item1          item2           similarity
##    <chr>          <chr>                <dbl>
##  1 VPComDir       VPPressSec           0.582
##  2 DeptVetAffairs SecShulkin           0.548
##  3 ENERGY         SecretaryPerry       0.472
##  4 HUDgov         SecretaryCarson      0.440
##  5 usedgov        BetsyDeVosED         0.417
##  6 Interior       SecretaryZinke       0.386
##  7 SecPriceMD     SecAzar              0.381
##  8 SecPompeo      StateDept            0.347
##  9 VPPressSec     VP                   0.343
## 10 USDA           SecretarySonny       0.337
## # ... with 2,405 more rows

The top results show that this elementary method is able to match people to their positions. The VP Press Secretary and VP Communications Director unsurprisingly work closely together and tweet on similar topics. Similarly, it matches Shulkin, Perry, Carson, DeVos, and Zinke to their (current or former) cabinet positions, and links the two consecutive Health and Human Services directors (Price and Azar) to each other.

It’s worth seeing this document similarity metric in action, but it’s not what you’re here for. We’re really excited about seeing comparisons between the op-ed and Twitter articles. We can

# Look only at the similarity of the op-ed to other documents
op_ed_similarity <- word_tf_idf %>%
  pairwise_similarity(screen_name, word, tf_idf, sort = TRUE) %>%
  filter(item1 == "OP-ED")

library(drlib)

op_ed_similarity %>%
  head(12) %>%
  mutate(item2 = reorder(item2, similarity)) %>%
  ggplot(aes(item2, similarity)) +
  geom_col() +
  scale_x_reordered() +
  coord_flip() +
  facet_wrap(~ item1, scales = "free_y") +
  labs(x = "",
       y = "Cosine similarity between TF-IDF vectors",
       subtitle = "Based on 69 selected staff accounts",
       title = "Twitter accounts using words similar to NYTimes op-ed")

This unveils the most similar writer as… Trump himself.

Hmmm. While that would certainly be a scoop, it doesn’t sound very likely to me. And the other top picks (the official White House account, the Press Secretary, and the Vice President) also seem like suspicious guesses.

Interpreting machine learning: what words contributed to scores?

The method of tf-idf is a fairly basic one for text mining, but as a result it has a useful trait: it’s based on a linear combination of one-score-per-word. This means we can say exactly how much each word contributed to a TF-IDF similarity between the article and a Twitter account. (Other machine learning methods allow interactions between words, which makes them harder to interpret).

We’ll try an approach of decomposing our TF-IDF similarity to see how much each . You could think of this as asking “if the op-ed hadn’t used this word, how much lower would the similarity score be?”

# This takes a little R judo, but it's worth the effort

# First we normalize the TF-IDF vector for each screen name,
# necessary for cosine similarity
tf_idf <- word_tf_idf %>%
  group_by(screen_name) %>%
  mutate(normalized = tf_idf / sqrt(sum(tf_idf ^ 2))) %>%
  ungroup()

# Then we join the op-ed words with the full corpus, and find
# the product of their TF-IDF with it in other documents
word_combinations <- tf_idf %>%
  filter(screen_name == "OP-ED") %>%
  select(-screen_name) %>%
  inner_join(tf_idf, by = "word", suffix = c("_oped", "_twitter")) %>%
  filter(screen_name != "OP-ED") %>%
  mutate(contribution = normalized_oped * normalized_twitter) %>%
  arrange(desc(contribution)) %>%
  select(screen_name, word, tf_idf_oped, tf_idf_twitter, contribution)

# Get the scores from the six most similar
word_combinations %>%
  filter(screen_name %in% head(op_ed_similarity$item2)) %>%
  mutate(screen_name = reorder(screen_name, -contribution, sum),
         word = reorder_within(word, contribution, screen_name)) %>%
  group_by(screen_name) %>%
  top_n(12, contribution) %>%
  ungroup() %>%
  mutate(word = reorder_within(word, contribution, screen_name)) %>%
  ggplot(aes(word, contribution, fill = screen_name)) +
  geom_col(show.legend = FALSE) +
  scale_x_reordered() +
  facet_wrap(~ screen_name, scales = "free_y") +
  coord_flip() +
  labs(x = "",
       y = "Contribution to similarity score",
       title = "What caused each Twitter account to be similar to the article",
       subtitle = "For the 6 accounts with the highest similarity score")

Now the reasons for the TF-IDF similarities become clearer.

The op-ed uses the words “Russia” five times. The Press Secretary and especially Trump mention Russia multiple times on their Twitter accounts, always within the context of defending Trump (as expected). Several accounts also get a high score because they mention the word “Trump” so frequently.

Unfortunately, with a document this short and topical, that’s all it takes to get a high similarity score (a bag of words method can’t understand the context, such as mentioning Russia in a negative or a defensive context). This is one reason it’s worth taking a closer look at what goes into an algorithm,

Having said that, there’s one signature I think is notable.

“Malign behavior”

Many others have noted “lodestar” as a telltale word in the piece. None of the relevant documents included that. I’d like to focus on another word that did: malign. Emphasis mine:

He complained for weeks about senior staff members letting him get boxed into further confrontation with Russia, and he expressed frustration that the United States continued to impose sanctions on the country for its malign behavior.

“Malign” isn’t as rare a word as “lodestar”, but it’s notable for being used in the exact same context (discussing Russia or other countries’ behavior) in a number of tweets from both Secretary of State Pompeo and the @StateDepartment account. (Pompeo has actually used the term “malign” an impressive seven times since May, though all but one were about Iran rather than Russia).

In #Finland tonight. Monday, @POTUS & I will meet with our Russian counterparts in #Helsinki A better relationship with the Russian government would benefit all, but the ball is in Russia’s court. We will continue to hold Russia responsible for its malign activities @StateDept pic.twitter.com/K4C1PSrRMb
— Secretary Pompeo (@SecPompeo) July 15, 2018

“Malign behavior” has been common language for Pompeo this whole year, as it has for other State Department officials like Jon Huntsman. What’s more, you don’t need data science to notice the letter spends three paragraphs on foreign policy (and praises “the rest of the administration” on that front). I’m not a pundit or a political journalist, but I can’t resist speculating a bit. Pompeo is named by the Weekly Standard as one of four likely authors of the op-ed, but even if he’s not the author my guess would be someone in the State Department.

Conclusion: Opening the black box

It’s worth emphasizing again that this article is just my guess based on a single piece of language (it’s nowhere close to the certainty of my analysis of Trump’s Twitter account during the campaign, which was statistically significant enough that I’d be willing to consider it “proof”).

I was fairly skeptical from the start that we could get strong results with document-comparison methods like this, especially on such a small article. That opinion mirrored people with much more expertise than I have:

That means you need a pretty large sample to not have large error bars. Don’t expect conclusive or even suggestive evidence here.
— David Mimno (@dmimno) September 6, 2018

But I’m satisfied with this analysis both as a demonstration of tidytext methods and one on the importance of model interpretability. When we ran a TF-IDF comparison, we knew it was wrong because @realDonaldTrump appeared at the top. But what if Trump hadn’t been the one to mention Russia the most, or if another false positive had caused an account to rise to the top? Breaking similarity scores down by word is a useful way to interrogate our model and understand its output. (See here for a similar article about understanding the components of a model).

Scientific debt

2018-05-10T14:00:00+00:00

A very useful concept in software engineering is technical debt.

Technical debt occurs when engineers choose a quick but suboptimal solution to a problem, or don’t spend time to build sustainable infrastructure. Maybe they’re using an approach that doesn’t scale well as the team and codebase expand (such as hardcoding “magic numbers”), or using a tool for reasons of convenience rather than appropriateness (“we’ll write the DevOps infrastructure in PHP since that’s what our team already knows”). Either way, it’s something that seems like it’s working at first but causes real challenges in the long-term, in the form of delayed feature launches and hard-to-fix bugs.

In my new job, I’ve been thinking about the role of data science within a business, and discussing this with other professionals in the field. On a panel earlier this year, I realized that data scientists have a rough equivalent to this concept: “scientific debt.”

Scientific debt is when a team takes shortcuts in data analysis, experimental practices, and monitoring that could have long-term negative consequences. When you hear a statement like:

“We don’t have enough time to run a randomized test, let’s launch it”
“To a first approximation this effect is probably linear”
“This could be a confounding factor, but we’ll look into that later”
“It’s directionally accurate at least”

you’re hearing a little scientific debt being “borrowed”.

Example: WidgetCorp

Most engineers have a sense of what it’s like for a company to struggle with technical debt. What would a company struggling with scientific debt look like?

Imagine a small startup WidgetCorp is developing a B2B product, and deciding on their sales strategy. One year they decide to start focusing their sales efforts on larger corporate clients. They notice that as they take on this new strategy, their monthly revenue increases. They’re encouraged by this, and in the following years hire half a dozen salespeople with experience working with large clients, and spend marketing and design effort building that as part of their brand.

Years later, the strategy doesn’t seem to be paying off: their revenue is struggling and the early successes aren’t repeating themselves. They hire an analyst who looks at their sales data, and finds that in fact, it had never been the case that they’d had a higher return-on-investment selling to large companies. In that early year, their revenue had been rising because of a seasonal effect (the demand for widgets goes up in the fall and winter), which was compounded with some random noise and anecdotes (e.g. “SmallCompany.com was a waste of our time, but we just closed a huge deal with Megabiz!”)

WidgetCorp took on too much scientific debt.

Some ways this might have happened:

They made irreversible decisions based on flawed analyses. It’s reasonable to take a quick look at metrics and be happy that they’re going in the right direction. But once the company made product, sales and marketing changes, it became difficult to reverse them. Before making a major shift in business, it’s worth making sure that the data supports it: that they’ve accounted for seasonal effects and applied proper statistical tests.

Lack of monitoring. Early on, there may not have been enough data to tell whether larger clients were a better investment. But as more data was collected, it would be worth continually testing this assumption, in the form of a dashboard or a quarterly report. If this isn’t tracked, no one will notice that the hypothesis was falsified even once they have the data.

Lack of data infrastructure: Maybe early in the company the leads were locked in a sales CRM, while accounting data was stored in Excel spreadsheets that were emailed around. Even if there were a dedicated analyst within the company, they may not have easy access to the relevant data (linking together sales sucess and company size). Even if it were theoretically possible to combine the datasets with some effort, schlep blindness might have made everyone avoid the analysis entirely. This is an area where technical debt and scientific debt often appear together, since it takes engineering effort to make scientific problems easy to solve.

Spreading inaccurate lore. Suppose that the WidgetCorp CEO had given a series of company-wide talks and public blog posts with the message “The future of WidgetCorp is serving big companies!” Product teams got into the habit of prioritizing features in this direction, and every failure got blamed on “I guess we weren’t focused enough on big clients”. This kind of “cultural inertia” can be very difficult to reverse, even if the executive team is willing to publicly admit their mistake (which isn’t guaranteed!)

Just about every experienced data scientist has at least a few of these stories, even from otherwise successful companies. They are to scientific debt what the Daily WTF is to technical debt.

Is scientific debt always bad?

Not at all!

I often take shortcuts in my own analyses. Running a randomized experiment for a feature launch is sometimes too expensive, especially if the number of users is fairly small or the change pretty uncontroversial (you wouldn’t A/B test a typo fix). And while correlation doesn’t imply causation, it’s usually better than nothing when making business decisions.

The comparison to technical debt is useful here: a small engineering team’s first goal is typically to build an minimum viable product quickly, rather than overengineer a system that they think will be robust in the distant future. (The equivalent in scientific debt is typically called overthinking, e.g. “Yes I suppose we could control for weather when we examine what sales deals succeed, but I’m pretty sure you’re overthinking this”). And the comparison to financial debt is meaningful too: companies typically take on debt (or, similarly, give up equity) while they’re growing. Just like you can’t build a company without borrowing money, you can’t build a company while being certain every decision is thoroughly supported by data.

What’s important in both technical and scientific debt is to keep the long-term cost in mind.

It isn't technical debt if you aren't...

1) Leveraging it to get something valuable up front
2) Paying interest on it regularly
3) Treating it as a liability that you may eventually need to pay in full

Code that doesn't meet this criteria isn't debt, it's just low quality work.
— Practicing Developer (@practicingdev) February 26, 2018

Wrong decisions are expensive, and not paying attention to data is a risk. We can do a cost-benefit analysis of whether the risk is worth it, but we shouldn’t write it off as “data scientists always find something to complain about”.

Why even call it “debt”?

To a data scientist or analyst, this post might sound pretty obvious. Of course there are downsides to ignoring statistical rigor, so why bother giving it a “buzzword-y” name? Because it puts the concept in terms executives and managers can easily understand.

Again, let’s go back to technical debt. There are lots of reasons individual engineers may want to write “clean code”: they appreciate its elegance, they want to impress their peers, or they’re perfectionists procrastinating on other work. These reasons don’t generally matter to non-technical employees, who care about product features and reliability. The framing of technical debt helps emphasize what the company loses by not investing in architecture: the idea that even if a product looks like it’s working, the flaws have a long-term cost in actual dollars and time.

Engineer: It bothers me that different internal projects use different naming conventions.

CTO: Sorry it annoys you, but code is code, I don’t see why you should waste time on this.

Engineer: Our inconsistent naming conventions are technical debt: they make it harder for new developers to learn the system.

CTO: I’ve been looking for ways to reduce our onboarding time! Great idea, let me know what you need to fix it.

Similarly, scientists, especially from an academic background, often have a particular interest in discovering truths about reality. So the idea of “I’d like to analyze whether X is a confounding factor here” can sound like an indulgence rather than an immediate business need. Statisticians in particular are often excited by finding flaws in mathematical methods. So when a data scientist says something like “We can’t use that method, Jones et al 2012 proved that it is asymptotically inconsistent,” non-technical colleagues might assume they’re overthinking it or even showing off. Framing it in terms of what we’re actually risking helps communicate why it’s worth spending time on.

How can we manage scientific debt well?

Let data scientists “pay interest” on it. Just as not every engineering project will lead to a new feature, not every analysis will lead to an exciting discovery or novel algorithm. Some time needs to be spent confirming or invalidating existing assumptions. Jacqueline Nolis has a great article about prioritizing data science work, where she describes this quadrant as “providing proof”.
Build data engineering processes: As described earlier, one reason a company might fall into scientific debt is that analysts may not have easy access to the data they need. It could be locked away in a platform that hasn’t been ingested, or in Google sheets that are edited by hand. Ingesting relevant data into a data warehouse or a data lake makes it more likely data scientists can make relevant discoveries.
Revisit old analyses: One common reason early-stage companies go into scientific debt is that they don’t yet have enough data to draw robust conclusions. Even if you don’t have enough data yet, that doesn’t mean you should forget about the problem. Sometimes I put time on my calendar to run an analysis once I expect enough data to be available, even if it’s a few months away. This can also help confirm an important analysis is still relevant: just like you’d keep track of a KPI over time, you want to keep track of whether a conclusion remains true.
Have data expertise spread throughout the company. Just as someone who can’t program may not recognize technical debt, someone who doesn’t have experience analyzing and understanding data may not recognize scientific debt. This is yet another reason to democratize data science within your company, as we do at DataCamp.

Data science at DataCamp

2018-04-10T15:00:00+00:00

In January, I was excited to make an announcement about a shift in my career:

I have some exciting news: today I'm joining @DataCamp as their Chief Data Scientist 🎉📊📈 pic.twitter.com/wiN9J4qSjx
— David Robinson (@drob) January 29, 2018

When I first discussed the role with the DataCamp CEO, I described my goal as to “Make DataCamp as good at doing data science as we are at teaching it.” Now that I’ve settled in, I’d like to talk about my plans in that direction (and to make a pitch for coming to work with us as a data engineer!)

Why I joined DataCamp

I loved working at Stack Overflow for two and a half years. I got to work with great web developers and data engineers to develop product features and to spread the tools and philosophy of data science throughout the company. I’ve been especially delighted to write about my data analyses in posts on the company blog.

But I’m very excited about this next step in my career. Part of the reason I’m excited to join DataCamp can be summarized by a graph I made last year for the Stack Overflow blog. Visits to Stack Overflow questions give us terrific insight into what programming technologies are growing and shrinking, based on how many visits go to particular tags. In a series of posts I took a look at the fastest growing tags on the site:

The two technologies that singularly stand out are R and Python. While Python can be used for many types of applications, in another post I showed that most of the growth in Python can be credited to data science. In short, data science is the fastest-growing part of the programming ecosystem. And as it grows, someone has to take responsibility for teaching the newcomers, whether they’re a beginner starting a data science career or an engineer or analyst interested in keeping up with data science skills.

This tells me that DataCamp is the right place to be, because nobody is better at teaching R and Python for data science. We have 77 live courses in R and 33 in Python (along with courses in complementary skills like SQL, shell, and git), and that content library is growing every week. And the focus on interactive exercises in the browser makes us uniquely suited to helping students learn.

Educating the next generation of data scientists is deeply important to me. I’ve worked with DataCamp as an external instructor before, teaching courses like my introduction to the tidyverse, foundations of probability, and a case study in exploratory data analysis. I’ve also written before about why I recommend teaching ggplot2 and the rest of the tidyverse as an introduction to R. I think that doing data science DataCamp is where I can contribute the most towards this goal.

How do we do data science at DataCamp?

To understand the Chief Data Scientist role, it’s worth sharing a bit about how data science is organized at DataCamp. The structure of data science within an organization has been the topic of a lot of discussion recently (Jacqueline Nolis has some of my favorite writing on the topic, including this presentation from Data Day Texas, and I’ve found the O’Reilly book Creating a Data-Driven Organization has helpful stories on how different companies structure it).

We have an extraordinary team of data scientists here, and one important decision we made when I joined is that in most cases they don’t report to me. Michael Chow is a learning engineer on my team that develops models and product features for measuring student learning, but other data scientists are spread through the company, each on a cross-functional team. For instance, we have a data scientist on the finance team (Dennis Vandevenne) who develops dashboards and analyses for sales and customer success. Ramnath Vaidyanathan leads research on the product team. And just this week my sister Emily Robinson joined the growth team to work on A/B tests and perform deep analyses of user acquisition. Each data scientist reports to the head of that department and focuses on that team’s problems, but also has a regular meeting with me and with the group to discuss the work they’re doing and the data-related challenges we’re having. In turn I report to the CEO and keep a birds-eye view of how data science works at the company.

As an individual contributor: “I have to go to a meeting this afternoon so today’s shot to hell”

As a team lead: “Oooh what a treat I’ve got 1-1:30 PM all to myself”
— David Robinson (@drob) March 22, 2018

This is generally referred to as matrix management, and it keeps data scientists close to the problems they’re working on and the priorities of their team. Perhaps my favorite advantage is that other managers can decide what data scientists should work on, which lets me focus on the how. This means the business stakeholders themselves get to spend time prioritizing projects, and I get to do my favorite task of helping data scientists do awesome things.

As you can probably imagine, there are challenges in this model (for instance, data scientists have to go to more meetings, and it’s hard to reallocate data effort across teams when necessary), but as of now I’m very optimistic about its future. I’ll likely write more about my thoughts on matrix management and data science in a future post.

What does a Chief Data Scientist do?

I previously wrote about what a data scientist does, but my responsibilities have changed with the new role. What do I now spend my time on?

Developing data science tools and processes. Since I have a global perspective on what data scientists at the company need, I work on building internal tools that help all our data scientists analyze our data. Perhaps the most important task is maintaining an internal R package, called datacampr, that manages connecting to our internal data sources. This was one of my favorite parts of working as an individual data scientist at Stack Overflow, so I’m excited that it’s become central to my work.

Similarly, another challenge is to surface work that data scientists have done so that the whole company can benefit from it. Towards that goal I’ve launched an internal knowledge repository, using AirBnb’s open source Knowledge Repo project. This lets data scientists contribute articles that everyone at the company can browse and understand, which helps reduce duplication of effort.

I’ve open sourced some of my work in the knowledgerepo R package, an R client for submitting articles to a knowledge repo. I’m hoping to share more of what I’ve learned in the future.

Meetings and advising: As a team that shares functional expertise, it’s useful for us to meet and compare notes on the challenges we’re having (“I’ve noticed these tables are slow to query: how could we index them to be faster?”). This lets data scientists share solutions (“oh, I have a query for that”) and lets me keep an eye on what tools and processes need to be built. It’s also fun to talk shop to other data scientists in the company- this week Ramnath shared an awesome open source project he’s working on (once it’s public you’ll probably be excited too!)

I also have weekly meetings individually with each data team member to help with whatever they’re analyzing or building. Sometimes that means pair programming, sometimes it means looking into eccentricities of our data, and sometimes it means following up with other teams to fix blocking issues. Since I share a background in data science, I’m often in a better position to handle data-related problems than their manager is. I also set up meetings to help people outside the team for whom understanding data is a part of their work, and I have some plans for making that a more formal part of my responsibilities.

While I often joke (like in the tweet above) about going to more meetings than I used to, the truth is that I really enjoy working with other people to help them understand data. Collaboration was one of my favorite parts of graduate school, and it’s been one of my favorite parts of being part of the larger data science community. There are other benefits as well:

The best part about being an Architecture Lead is helping other people code. That way it's their name in git blame.
— Nick Craver (@Nick_Craver) August 31, 2017

Manage data engineering: Data engineering has a close relationship with data science, since it’s responsible for making our data fast and easy to access. DataCamp uses a microservice architecture running on AWS (here’s an article from our CTO describing the vision), and our data sources are now large enough to require careful consideration in terms of how we store and query them.

Our engineering team believes strongly in ownership (the idea that each part of our infrastructure should have someone clearly responsible for it), and this extends to data science. In particular, we’ve taken a lot of inspiration from Jeff Magnusson’s Engineers Shouldn’t Write ETL that data scientists should be in charge of their own business logic in data pipelines, while data engineering is responsible for the platform. For example, data scientists often want to define their own views, stored queries that can be queried like a SQL table. We’ve recently implemented a system where data scientists can create their own views, each materialized once a day, just by pushing a file to a GitHub repository.

This kind of process is useful to data scientists, because it makes the infrastructure side (maintaining databases, scheduling tasks) invisible and let them focus on the SQL and business logic. In turn, if a view breaks or needs to be changed, the data scientist can take full responsibility for fixing it: they don’t need to go through anyone else. As I describe below, there’s a lot more work to be done on systems like this.

What’s next

Now that I’m a bit settled in, I’ve started planning what the rest of the year of data science at DataCamp will look like.

Hiring a data engineer. I’ve worked with consultants and our engineering team to develop infrastructure like I described above, but we don’t have a data engineer and I’m not qualified to take the next steps in building our data pipeline. That’s why we’re currently hiring for our first data engineer (working in Python), who’ll report to me and take over these responsibilities. It’s a chance to work closely with data scientists and lead the development of a powerful data platform. Please apply or get in touch if you’re interested!
Supporting Python within the company. Most of my tool development has been focused on R, since that’s what most of the data science team prefers for our analyses. But we have a ton of Python data science talent in the company as well (for instance, several people on the content team), and as we hire in the future we’d like to make it a truly “bilingual” data science department. In the next few months I’ll be bringing some of our Python data science infrastructure up to speed so that analysts have their choice of how to work.
Sharing what we’ve learned. DataCamp has access to extraordinary data about how people learn data science. Hundreds of thousands of people have learned R through our interactive introductory course, and for every exercise we have hundreds of thousands of attempted submissions. This means we have a particularly rich dataset around what people try, including what kinds of mistakes learners make.

One of my favorite parts of being a data scientist is sharing my results publicly. In the coming months my team and I will be sharing some blog posts about what we’ve learned from our learners, and how we’ve used these analyses to improve our platform and remain the best way to learn data science.

What digits should you bet on in Super Bowl squares?

2018-02-04T10:00:00+00:00

My new office introduced me to a betting game I wasn’t previously familiar with: Super Bowl squares. It’s played with a ten-by-ten grid, like this one from printyourbrackets.com:

Each row and column gets an assortment of digits from 0-9 representing each team’s score, and each person playing the game (after putting in some money) adds their initials to one of the boxes. Then the winner is picked based on the least significant digit of the score. If (for example) the game ended up being Eagles 20-Patriots 24, the player who had picked the row with 0 and the column with 4 would win.

If your team sets the digits in advance, you can get a statistical edge. Since not every score is equally likely, the least-significant digits aren’t equally likely either. Here I’ll take a data-driven approach to find the most common digits, and pairs of digits, in NFL scores. Like in most of my posts, I’ll be using the R language and the tidyverse collection of packages. By the end of tonight you can see how my predictions did!

Most common digits

We could use just the Super Bowl scores, perhaps scraped from Wikipedia. In a perfect world we could use that data, since Super Bowl scores are likely to be subtly different than the regular season. But there’ve been only 51, so the data is rather noisy. Instead, we’ll look at all NFL games since 1978, thanks to this helpful GitHub dataset from James Every.

library(tidyverse)
theme_set(theme_light())

# Git clone first from git@github.com:devstopfix/nfl_results.git
games <- dir("nfl_results/", pattern = ".csv", full.names = TRUE) %>%
  map_df(read_csv)

# Gather into one tall data frame of scores, and calculate the digit
# The dataset has a couple games from before 1978, but only a few per year
scores <- games %>%
  filter(season >= 1978) %>%
  gather(type, score, home_score, visitors_score) %>%
  mutate(digit = score %% 10)

scores

## # A tibble: 18,148 x 8
##    season  week kickoff             home_team  visitin… type   score digit
##     <int> <int> <dttm>              <chr>      <chr>    <chr>  <int> <dbl>
##  1   1978     1 1978-09-02 00:00:00 Buccaneers Giants   home_…    13  3.00
##  2   1978     1 1978-09-03 00:00:00 Bears      Cardina… home_…    17  7.00
##  3   1978     1 1978-09-03 00:00:00 Bengals    Chiefs   home_…    23  3.00
##  4   1978     1 1978-09-03 00:00:00 Bills      Steelers home_…    17  7.00
##  5   1978     1 1978-09-03 00:00:00 Broncos    Raiders  home_…    14  4.00
##  6   1978     1 1978-09-03 00:00:00 Browns     49ers    home_…    24  4.00
##  7   1978     1 1978-09-03 00:00:00 Eagles     Rams     home_…    14  4.00
##  8   1978     1 1978-09-03 00:00:00 Falcons    Oilers   home_…    20  0   
##  9   1978     1 1978-09-03 00:00:00 Jets       Dolphins home_…    33  3.00
## 10   1978     1 1978-09-03 00:00:00 Lions      Packers  home_…     7  7.00
## # ... with 18,138 more rows

This gives us a set of over 18,000 football scores (from over 9,000 games) we can analyze.

First we could ask what the most common scores are. (If you’re a football fan, you may want to try guessing before you look at them!)

scores %>%
  count(score, sort = TRUE)

## # A tibble: 60 x 2
##    score     n
##    <int> <int>
##  1    17  1412
##  2    20  1197
##  3    24  1189
##  4    10  1089
##  5    13   952
##  6    14   946
##  7    27   931
##  8    21   810
##  9    31   781
## 10    23   754
## # ... with 50 more rows

The most commmon (by a wide margin) is 17. This could come from two touchdowns (each with an extra point, or one with two extra points) and a field goal. 27 is also common, so 7 as the least significant digit is already looking like a solid bet.

So let’s create a histogram of the most common final digits. (I’ll do this one in silver for the Eagles).

ggplot(scores, aes(digit)) +
  geom_histogram(fill = "#8D9093", binwidth = .5) +
  scale_x_continuous(breaks = 0:9) +
  labs(title = "Frequency of final digits in NFL games since 1966")

As we suspected, the most common digit is 7. It’s closely followed by 0, and 4 and 5 are pretty common as well. But you really don’t want to bet on 2 or 5.

Are they independent?

It’s likely that each team’s strategy influences the other (and both may be influenced by common factors such as the weather or referee), meaning that the two digits in a score aren’t statistically independent. So let’s consider the most common pairs of scores. For this graph we’ll use red and white for the Patriots.

games %>%
  count(home_digit = home_score %% 10,
        visitors_digit = visitors_score %% 10) %>%
  mutate(percent = n / sum(n)) %>%
  ggplot(aes(home_digit, visitors_digit, fill = percent)) +
  geom_tile() +
  scale_x_continuous(breaks = 0:9) +
  scale_y_continuous(breaks = 0:9) +
  scale_fill_gradient2(high = "#C8102E", low = "white",
                       labels = scales::percent_format()) +
  theme_minimal() +
  labs(x = "Last digit of home team score",
       y = "Last digit of visitor team score",
       title = "Common pairs of NFL scores",
       fill = "% of games since 1978")

(Super Bowl games don’t actually have a home and away team, but it’s a reasonable way to visualize this data).

Interestingly, even though 7 and 0 are themselves the most common digits, the most common pairs of digits are not pairs of 7s or pairs of zeroes, but rather 7-0 and 0-7. This makes sense because except in rare circumstances, games are almost never tied, since they would go into overtime. This means that while 17 and 20 are both common scores, 17-17 and 20-20 are very rare (in fact, in this dataset there are only two of each).

Change over time

Rules and strategies change over time, and it’s plausible that the ending digits have changed with it. We can examine this hypothesis with a line graph.

scores %>%
  count(decade = 10 * season %/% 10,
        digit) %>%
  mutate(digit = reorder(digit, -n)) %>%
  group_by(decade) %>%
  mutate(percent = n / sum(n)) %>%
  ggplot(aes(decade, percent, color = digit)) +
  geom_line() +
  scale_y_continuous(labels = scales::percent_format()) +
  expand_limits(y = 0) +
  labs(title = "Most common ending digits of NFL games by decade",
       y = "% of scores ending in this digit")

Not too much: the relative ordering of the 10 digits has stayed the exact same across each decade. It looks like 7 has become a little less common, and that 0 and 4 have mostly converged in frequency.

We could consider filtering for only a subset of the data, such as games since 1990. If we consider too many years, it won’t be a precisely accurate picture of modern football, but if we consider too few we won’t have enough data and the estimate will be noisy (This is a classic example of a bias-variance tradeoff). Some sophisticated models can balance the two concerns, but this graph shows it probably isn’t worth the effort.

Conclusion

The pairs I’d bet on are 7-0/0-7 or 4-7/7-4, the most common pairings of digits. (Though the chance of winning with each is still around 3%, not much higher than winning a roulette spin). If those are taken I’d generally avoid pairs of the same digit, since the lack of ties make them unusually uncommon (last year’s Super Bowl game was the first to ever go into overtime, and there has never been a tied score).

In a more sophisticated model we’d consider rates within each team, and possibly incorporate the Vegas odds (a winning team’s score distribution is different than a losing team). I might try that for Super Bowl LIII next year.

Good luck and enjoy the game!

Exploring handwritten digit classification: a tidy analysis of the MNIST dataset

2018-01-22T18:00:00+00:00

In a recent post, I offered a definition of the distinction between data science and machine learning: that data science is focused on extracting insights, while machine learning is interested in making predictions. I also noted that the two fields greatly overlap:

I use both machine learning and data science in my work: I might fit a model on Stack Overflow traffic data to determine which users are likely to be looking for a job (machine learning), but then construct summaries and visualizations that examine why the model works (data science). This is an important way to discover flaws in your model, and to combat algorithmic bias. This is one reason that data scientists are often responsible for developing machine learning components of a product.

I’d like to further explore how data science and machine learning complement each other, by demonstrating how I would use data science to approach a problem of image classification. We’ll work with a classic machine learning challenge: the MNIST digit database.

The challenge is to classify a handwritten digit based on a 28-by-28 black and white image. MNIST is often credited as one of the first datasets to prove the effectiveness of neural networks.

In a series of posts, I’ll be training classifiers to recognize digits from images, while using data exploration and visualization to build our intuitions about why each method works or doesn’t. Like most of my posts I’ll be analyzing the data through tidy principles, particularly using the dplyr, tidyr and ggplot2 packages. In this first post we’ll focus on exploratory data analysis, to show how you can better understand your data before you start training classification algorithms or measuring accuracy. This will help when we’re choosing a model or transforming our features.

Preprocessing

The default MNIST dataset is somewhat inconveniently formatted, but Joseph Redmon has helpfully created a CSV-formatted version. We can download it with the readr package.

library(readr)
library(dplyr)

mnist_raw <- read_csv("https://pjreddie.com/media/files/mnist_train.csv", col_names = FALSE)

mnist_raw[1:10, 1:10]

## # A tibble: 10 x 10
##       X1    X2    X3    X4    X5    X6    X7    X8    X9   X10
##    <int> <int> <int> <int> <int> <int> <int> <int> <int> <int>
##  1     5     0     0     0     0     0     0     0     0     0
##  2     0     0     0     0     0     0     0     0     0     0
##  3     4     0     0     0     0     0     0     0     0     0
##  4     1     0     0     0     0     0     0     0     0     0
##  5     9     0     0     0     0     0     0     0     0     0
##  6     2     0     0     0     0     0     0     0     0     0
##  7     1     0     0     0     0     0     0     0     0     0
##  8     3     0     0     0     0     0     0     0     0     0
##  9     1     0     0     0     0     0     0     0     0     0
## 10     4     0     0     0     0     0     0     0     0     0

This dataset contains one row for each of the 60000 training instances, and one column for each of the 784 pixels in a 28 x 28 image. The data as downloaded doesn’t have column labels, but are arranged as “row 1 column 1, row 1 column 2, row 1 column 3…” and so on). This is a useful enough representation for machine learning. But as Jenny Bryan often discusses, we shouldn’t feel constricted by our current representation of the data, and for exploratory analysis we may want to make a few changes.

We’d like to represent it as one-row-per-pixel-per-instance. It would be challenging to visualize this default data as images, but it becomes easier once we consider each pixel an “observation”.
We’d like custom features that have meaning within the problem For instance, we don’t just have 784 arbitrary features; we have 28 rows and 28 columns. So rather than having labels like “X2” and “X3”, we’d like to keep track of variables for x and y (as coordinate positions of the images).
We’d like to explore a subset first. While you’re first exploring data, you don’t need your full complement of training examples, since working with a subset lets you iterate quickly and create proof of concepts while saving computational time.

If your data's huge, analyze a small subset first to check approach. Like navigating the route on a bike before trying your 18-wheeler truck
— David Robinson (@drob) September 4, 2015

With that in mind, we’ll gather the data, do some arithmetic to keep track of x and y within an image, and keep only the first 10,000 training instances.

library(tidyr)

pixels_gathered <- mnist_raw %>%
  head(10000) %>%
  rename(label = X1) %>%
  mutate(instance = row_number()) %>%
  gather(pixel, value, -label, -instance) %>%
  tidyr::extract(pixel, "pixel", "(\\d+)", convert = TRUE) %>%
  mutate(pixel = pixel - 2,
         x = pixel %% 28,
         y = 28 - pixel %/% 28)

pixels_gathered

## # A tibble: 7,840,000 x 6
##    label instance value pixel     x     y
##    <int>    <int> <int> <dbl> <dbl> <dbl>
##  1     5        1     0     0     0  28.0
##  2     0        2     0     0     0  28.0
##  3     4        3     0     0     0  28.0
##  4     1        4     0     0     0  28.0
##  5     9        5     0     0     0  28.0
##  6     2        6     0     0     0  28.0
##  7     1        7     0     0     0  28.0
##  8     3        8     0     0     0  28.0
##  9     1        9     0     0     0  28.0
## 10     4       10     0     0     0  28.0
## # ... with 7,839,990 more rows

We now have one row for each pixel in each image. This is a useful format because it lets us visualize the data along the way. For example, we can visualize the first 12 instances with a couple lines of ggplot2.

library(ggplot2)
theme_set(theme_light())

pixels_gathered %>%
  filter(instance <= 12) %>%
  ggplot(aes(x, y, fill = value)) +
  geom_tile() +
  facet_wrap(~ instance + label)

We’ll still often return to the one-row-per-instance format (especially once we start training classifiers in future posts), but this is a fast way to understand and appreciate how the data and the problem is structured. In the rest of this post we’ll also polish this kind of graph (like making it black and white rather than a scale of blues).

Exploring pixel data

Let’s get more comfortable with the data. From the legend above, it looks like 0 represents blank space (like the edges of the image), and a maximum around 255 represents the darkest points of the image. Values in between may represent different shades of “gray”.

How much gray is there in the set of images?

ggplot(pixels_gathered, aes(value)) +
  geom_histogram()

Most pixels in the dataset are completely white, along with another set of pixels that are completely dark, with relatively few in between. If we were working with black-and-white photographs (like of faces or landscapes), we might have seen a lot more variety. This gives us a hint for later feature engineering steps: if we wanted to, we could probably replace each pixel with a binary 0 or 1 with very little loss of information.

I’m interested in how much variability there is within each digit label. Do all 3s look like each other, and what is the “most typical” example of a 6? To answer this, we can find the mean value for each position within each label, using dplyr’s group_by and summarize.

pixel_summary <- pixels_gathered %>%
  group_by(x, y, label) %>%
  summarize(mean_value = mean(value)) %>%
  ungroup()

pixel_summary

## # A tibble: 7,840 x 4
##        x     y label mean_value
##    <dbl> <dbl> <int>      <dbl>
##  1     0  1.00     0          0
##  2     0  1.00     1          0
##  3     0  1.00     2          0
##  4     0  1.00     3          0
##  5     0  1.00     4          0
##  6     0  1.00     5          0
##  7     0  1.00     6          0
##  8     0  1.00     7          0
##  9     0  1.00     8          0
## 10     0  1.00     9          0
## # ... with 7,830 more rows

We visualize these average digits as ten separate facets.

library(ggplot2)

pixel_summary %>%
  ggplot(aes(x, y, fill = mean_value)) +
  geom_tile() +
  scale_fill_gradient2(low = "white", high = "black", mid = "gray", midpoint = 127.5) +
  facet_wrap(~ label, nrow = 2) +
  labs(title = "Average value of each pixel in 10 MNIST digits",
       fill = "Average value") +
  theme_void()

These averaged images are called centroids. We’re treating each image as a 784-dimensional point (28 by 28), and then taking the average of all points in each dimension individually. One elementary machine learning method, nearest centroid classifier, would ask for each image which of these centroids it comes closest to.

Already we have some suspicions about which digits might be easier to separate. Distinguishing 0 and 1 looks pretty straightforward: you could pick a few pixels at the center (always dark in 1 but not 0), or at the left and right edges (often dark in 0 but not 1), and you’d have a pretty great classifier. Pairs like 4/9, or 3/8, have a lot more overlap and will be a more challenging problem.

Again, one of the aspects I like about the tidy approach is that at all stages of your analysis, your data is in a convenient form for visualization, especially a faceted graph like this one. In its original form (one-row-per-instance) we’d need to do a bit of transformation before we could plot it as images.

Atypical instances

So far, this machine learning problem might seem a bit easy: we have some very “typical” versions of each digit. But one of the reasons classification can be challenging is that some digits will fall widely outside the norm. It’s useful to explore atypical cases, since it could help us understand why the method fails and help us choose a method and engineer features.

In this case, we could consider the Euclidean distance (square root of the sum of squares) of each image to its label’s centroid.

pixels_joined <- pixels_gathered %>%
  inner_join(pixel_summary, by = c("label", "x", "y"))

image_distances <- pixels_joined %>%
  group_by(label, instance) %>%
  summarize(euclidean_distance = sqrt(mean((value - mean_value) ^ 2)))

image_distances

## # A tibble: 10,000 x 3
## # Groups: label [?]
##    label instance euclidean_distance
##    <int>    <int>              <dbl>
##  1     0        2               47.2
##  2     0       22               53.1
##  3     0       35               69.4
##  4     0       38               59.5
##  5     0       52               61.4
##  6     0       57               65.7
##  7     0       64               68.1
##  8     0       69               81.1
##  9     0       70               65.2
## 10     0       76               59.6
## # ... with 9,990 more rows

Measured this way, which digits have more variability on average?

ggplot(image_distances, aes(factor(label), euclidean_distance)) +
  geom_boxplot() +
  labs(x = "Digit",
       y = "Euclidean distance to the digit centroid")

It looks like 1s have especially low distances to their centroid: for the most part there’s not a ton of variability in how people draw that digit. It looks like the most variability by this measure are in 0s and 2s. But every digit has at least a few cases with an unusually large distance from their centroid. I wonder what those look like?

To discover this, we can visualize the six digit instances that had the least resemblance to their central digit.

worst_instances <- image_distances %>%
  top_n(6, euclidean_distance) %>%
  mutate(number = rank(-euclidean_distance))

pixels_gathered %>%
  inner_join(worst_instances, by = c("label", "instance")) %>%
  ggplot(aes(x, y, fill = value)) +
  geom_tile(show.legend = FALSE) +
  scale_fill_gradient2(low = "white", high = "black", mid = "gray", midpoint = 127.5) +
  facet_grid(label ~ number) +
  labs(title = "Least typical digits",
       subtitle = "The 6 digits within each label that had the greatest distance to the centroid") +
  theme_void() +
  theme(strip.text = element_blank())

This is a useful way to understand what kinds of problems the data could have. For instance, while most 1s looked the same, they could be drawn diagonally, or with a flat line and a flag on top. A 7 could be drawn with a bar in the middle. (And what is up with that 9 on the lower left?)

This also gives us a realistic sense of how accurate our classifier can get. Even humans would have a hard time classifying some of these sloppy digits, so we can’t expect a 100% success rate. (Conversely, if one of our classifiers does get a 100% success rate, we should examine whether we’re overfitting!).

Pairwise comparisons of digits

So far we’ve been examining one digit at a time, but our real goal is to distinguish them. For starters, we might like to know how easy it is to tell pairs of digits apart.

To examine this, we could try overlapping pairs of our centroid digits, and taking the difference between them. If two centroids have very little overlap, this means they’ll probably be easy to distinguish.

We can approach this with a bit of crossing() logic from tidyr:

digit_differences <- crossing(compare1 = 0:9, compare2 = 0:9) %>%
  filter(compare1 != compare2) %>%
  mutate(negative = compare1, positive = compare2) %>%
  gather(class, label, positive, negative) %>%
  inner_join(pixel_summary, by = "label") %>%
  select(-label) %>%
  spread(class, mean_value)

ggplot(digit_differences, aes(x, y, fill = positive - negative)) +
  geom_tile() +
  scale_fill_gradient2(low = "blue", high = "red", mid = "white", midpoint = .5) +
  facet_grid(compare2 ~ compare1) +
  theme_void() +
  labs(title = "Pixels that distinguish pairs of MNIST images",
       subtitle = "Red means the pixel is darker for that row's digit, and blue means the pixel is darker for that column's digit.")

Pairs with very red or very blue regions will be easy to classify, since they describe features that divide the datasets neatly. This confirms our suspicion about 0/1 being easy to classify: it has substantial regions than are deeply red or blue.

Comparisons that are largely white may be more difficult. We can see 4/9 looks pretty challenging, which makes sense (a handwritten 4 and 9 really differ only by a small region at the top). 7/9 shows a similar challenge.

What’s next

MNIST has been so heavily studied that we’re unlikely to discover anything novel about the dataset, or to compete with the best classifiers in the field. (One paper used deep neural networks to achieve about 99.8% accuracy, which is about as well as humans perform).

But a fresh look at a classic problem is a great way to develop a case study. I’ve been exploring this dataset recently, and I’m excited by how it can be used to illustrate a tidy approach to fundamental concepts of machine learning. In the rest of this series I’d like to show how we could demonstrate how we would train classifiers such as logistic regression, decision trees, nearest neighbor, and neural networks. In each case we’ll use tidy principles to demonstrate the intuition and insight behind the algorithm.

What's the difference between data science, machine learning, and artificial intelligence?

2018-01-09T17:00:00+00:00

When I introduce myself as a data scientist, I often get questions like “What’s the difference between that and machine learning?” or “Does that mean you work on artificial intelligence?” I’ve responded enough times that my answer easily qualifies for my “rule of three”:

When you’ve written the same code 3 times, write a function

When you’ve given the same in-person advice 3 times, write a blog post
— David Robinson (@drob) November 9, 2017

The fields do have a great deal of overlap, and there’s enough hype around each of them that the choice can feel like a matter of marketing. But they’re not interchangeable: most professionals in these fields have an intuitive understanding of how particular work could be classified as data science, machine learning, or artificial intelligence, even if it’s difficult to put into words.

So in this post, I’m proposing an oversimplified definition of the difference between the three fields:

Data science produces insights
Machine learning produces predictions
Artificial intelligence produces actions

To be clear, this isn’t a sufficient qualification: not everything that fits each definition is a part of that field. (A fortune teller makes predictions, but we’d never say that they’re doing machine learning!) These also aren’t a good way of determining someone’s role or job title (“Am I a data scientist?”), which is a matter of focus and experience. (This is true of any job description: I write as part of my job but I’m not a professional writer).

But I think this definition is a useful way to distinguish the three types of work, and to avoid sounding silly when you’re talking about it. It’s worth noting that I’m taking a descriptivist rather than a prescriptivist approach: I’m not interested in what these terms “should mean”, but rather how people in the field typically use them.

Data science produces insights

Data science is distinguished from the other two fields because its goal is an especially human one: to gain insight and understanding. Jeff Leek has an excellent definition of the types of insights that data science can achieve, including descriptive (“the average client has a 70% chance of renewing”) exploratory (“different salespeople have different rates of renewal”) and causal (“a randomized experiment shows that customers assigned to Alice are more likely to renew than those assigned to Bob”).

Again, not everything that produces insights qualifies as data science (the classic definition of data science is that it involves a combination of statistics, software engineering, and domain expertise). But we can use this definition to distinguish it from ML and AI. The main distinction is that in data science there’s always a human in the loop: someone is understanding the insight, seeing the figure, or benefitting from the conclusion. It would make no sense to say “Our chess-playing algorithm uses data science to choose its next move,” or “Google Maps uses data science to recommend driving directions”.

This definition of data science thus emphasizes:

Statistical inference
Data visualization
Experiment design
Domain knowledge
Communication

Data scientists might use simple tools: they could report percentages and make line graphs based on SQL queries. They could also use very complex methods: they might work with distributed data stores to analyze trillions of records, develop cutting-edge statistical techniques, and build interactive visualizations. Whatever they use, the goal is to gain a better understanding of their data.

Machine learning produces predictions

I think of machine learning as the field of prediction: of “Given instance X with particular features, predict Y about it”. These predictions could be about the future (“predict whether this patient will go into sepsis”), but they also could be about qualities that aren’t immediately obvious to a computer (“predict whether this image has a bird in it”). Almost all Kaggle competitions qualify as machine learning problems: they offer some training data, and then see if competitors can make accurate predictions about new examples.

There’s plenty of overlap between data science and machine learning. For example, logistic regression can be used to draw insights about relationships (“the richer a user is the more likely they’ll buy our product, so we should change our marketing strategy”) and to make predictions (“this user has a 53% chance of buying our product, so we should suggest it to them”).

Models like random forests have slightly less interpretability and are more likely to fit the “machine learning” description, and methods such as deep learning are notoriously challenging to explain. This could get in the way if your goal is to extract insights rather than make predictions. We could thus imagine a “spectrum” of data science and machine learning, with more interpretable models leaning towards the data science side and more “black box” models on the machine learning side.

Most practitioners will switch back and forth between the two tasks very comfortably. I use both machine learning and data science in my work: I might fit a model on Stack Overflow traffic data to determine which users are likely to be looking for a job (machine learning), but then construct summaries and visualizations that examine why the model works (data science). This is an important way to discover flaws in your model, and to combat algorithmic bias. This is one reason that data scientists are often responsible for developing machine learning components of a product.

Artificial intelligence produces actions

Artificial intelligence is by far the oldest and the most widely recognized of these three designations, and as a result it’s the most challenging to define. The term is surrounded by a great deal of hype, thanks to researchers, journalists, and startups who are looking for money or attention.

When you’re fundraising, it’s AI
When you’re hiring, it’s ML
When you’re implementing, it’s linear regression
When you’re debugging, it’s printf()
— Baron Schwartz (@xaprb) November 15, 2017

This has led to a backlash that strikes me as unfortunate, since it means some work that probably should be called AI isn’t described as such. Some researchers have even complained about the AI effect: “AI is whatever we can’t do yet”.¹ So what work can we fairly describe as AI?

One common thread in definitions of “artificial intelligence” is that an autonomous agent executes or recommends actions (e.g. Poole, Mackworth and Goebel 1998, Russell and Norvig 2003). Some systems I think should described as AI include:

Game-playing algorithms (Deep Blue, AlphaGo)
Robotics and control theory (motion planning, walking a bipedal robot)
Optimization (Google Maps choosing a route)
Natural language processing (bots²)
Reinforcement learning

Again, we can see a lot of overlap with the other fields. Deep learning is particuarly interesting for straddling the fields of ML and AI. The typical use case is training on data and then producing predictions, but it has shown enormous success in game-playing algorithms like AlphaGo. (This is in contrast to earlier game-playing systems, like Deep Blue, which focused more on exploring and optimizing the future solution space).

But there are also distinctions. If I analyze some sales data and discover that clients from particular industries renew more than others (extracting an insight), the output is some numbers and graphs, not a particular action. (Executives might use those conclusions to change our sales strategy, but that action isn’t autonomous) This means I’d describe my work as data science: it would be cringeworthy to say that I’m “using AI to improve our sales.”

please

please

please do not write that someone who trained an algorithm has "harnessed the power of AI"
— Dave Gershgorn (@davegershgorn) September 18, 2017

The difference between artificial intelligence and machine learning is a bit more subtle, and historically ML has often been considered a subfield of AI (computer vision in particular was a classic AI problem). But I think the ML field has largely “broken off” from AI, partly because of the backlash described above: most people who to work on problems of prediction don’t like to describe themselves as AI researchers. (It helped that many important ML breakthroughs came from statistics, which had less of a presence in the rest of the AI field). This means that if you can describe a problem as “predict X from Y,” I’d recommend avoiding the term AI completely.

by today's definition, y=mx+b is an artificial intelligence bot that can tell you where a line is going
— Amy Hoy ✨ (@amyhoy) March 29, 2017

Case study: how would the three be used together?

Suppose we were building a self-driving car, and were working on the specific problem of stopping at stop signs. We would need skills drawn from all three of these fields.

Machine learning: The car has to recognize a stop sign using its cameras. We construct a dataset of millions of photos of streetside objects, and train an algorithm to predict which have stop signs in them.
Artificial intelligence: Once our car can recognize stop signs, it needs to decide when to take the action of applying the brakes. It’s dangerous to apply them too early or too late, and we need it to handle varying road conditions (for example, to recognize on a slippery road that it’s not slowing down quickly enough), which is a problem of control theory.
Data science: In street tests we find that the car’s performance isn’t good enough, with some false negatives in which it drives right by a stop sign. After analyzing the street test data, we gain the insight that the rate of false negatives depends on the time of day: it’s more likely to miss a stop sign before sunrise or after sunset. We realize that most of our training data included only objects in full daylight, so we construct a better dataset including nighttime images and go back to the machine learning step.

It doesn’t help that AI is often conflated with general AI, capable of performing tasks across many different domains, or even superintelligent AI, which surpasses human intelligence. This sets unrealistic expectations for any system described as “AI”. ↩
By “bots” here I’m referring to systems meant to interpret natural language and then respond in kind. This can be distinguished from text mining, where the goal is to extract insights (data science) or text classification, where the goal is to categorize documents (machine learning) ↩

Advice to aspiring data scientists: start a blog

2017-11-14T16:45:00+00:00

Last week I shared a thought on Twitter:

When you’ve written the same code 3 times, write a function

When you’ve given the same in-person advice 3 times, write a blog post
— David Robinson (@drob) November 9, 2017

Ironically, this tweet hints at a piece of advice I’ve given at least 3 dozen times, but haven’t yet written a post about. I’ve given this advice to almost every aspiring data scientist who asked me what they should do to find a job: start a blog, and write about data science.¹

What could you write about if you’re not yet working as a data scientist? Here are some possible topics (each attached to examples from my own blog):

Analyses of datasets you find interesting (example, example)
Intuitive explanations of concepts you’ve recently mastered (example, example)
Explorations of how to make a specific piece of code faster (example)
Announcements about open source projects you’ve released (example)
Links to interactive applications you’ve built (example, example)
Sharing a writeup of conferences or meetups you’ve attended (example)
Expressing opinions about data science or educational practice (example)

In a future post I’d like to share advice about the how of data science blogging (such as how to choose a topic, how to structure a post, and how to publish with blogdown). But here I’ll focus on the why. If you’re in the middle of a job search, you’re probably very busy (especially if you’re currently employed), and blogging is a substantial commitment. So here I’ll lay out three reasons that a data science blog is well worth your time.

Practice analyzing data and communicating about it

If you’re hoping to be a data scientist, you’re (presumably) not one yet. A blog is your chance to practice the relevant skills.

Data cleaning: One of the benefits of working with a variety of datasets is that you learn to take data “as it comes”, whether it’s in the form of a supplementary file from a journal article or a movie script
Statistics: Working with unfamiliar data lets you put statistical methods into practice, and writing posts that communicate and teach concepts helps build your own understanding
Machine learning: There’s a big difference between having used a predictive algorithm once and having used it on a variety of problems, while understanding why you’d choose one over another
Visualization: Having an audience for your graphs encourages you to start polishing them and building your personal style
Communication: You gain experience writing and get practice structuring a data-driven argument. This is probably the most relevant skill that blogging develops since it’s hard to practice elsewhere, and it’s an essential part of any data science career

I can’t emphasize enough how important this kind of practice is. No matter how many Coursera, DataCamp or bootcamp courses you’ve taken, you still need experience applying those tools to real problems. This isn’t unique to data science: whatever you currently do professionally, I’m sure you’re better at it now than when you finished taking classes in it.

… and that concludes Machine Learning 101. Now, go forth and apply what you've learned to real data! pic.twitter.com/D6wSKgdjeM
— ML Hipster (@ML_Hipster) August 19, 2015

One of the great thrills of a data science blog is that, unlike a course, competition, or job, you can analyze any dataset you like! No one was going to pay me to analyze Love Actually’s plot or Hacker News titles. Whatever amuses or interests you, you can find relevant data and write some posts about it.

Create a portfolio of your work and skills

Graphic designers don’t typically get evaluated based on bullet points on their CV or statements in a job interview: they share a portfolio with examples of their work. I think the data science field is shifting in the same direction: the easiest way to evaluate a candidate is to see a few examples of data analyses they’ve performed.

Blogging is an especially good fit for showing off your skills because, unlike a technical interview, you get to put your “best foot forward.” Which of your skills are you proudest of?

If you’re skilled at visualizing data, write some analyses with some attractive and informative graphs (“Here’s an interactive visualization of mushroom populations in the United States”)
If you’re great at teaching and communicating, write some lessons about statistical concepts (“Here’s an intuitive explanation of PCA”)
If you have a knack for fitting machine learning models, blog about some predictive accomplishments (“I was able to determine the breed of a dog from a photo with 95% accuracy”)
If you’re an experienced programmer, announce open source projects you’ve developed and share examples of how they can be used (“With my sparkcsv package, you can load CSV datasets into Spark 10X faster than previous methods”)
If your real expertise is in a specific domain, try focusing on that (“Here’s how penguin populations have been declining in the last decade, and why”)

Just because you’re expecting employers to look at your work doesn’t mean it has to be perfect. Generally, when I’m evaluating a candidate, I’m excited to see what they’ve shared publicly, even if it’s not polished or finished. And sharing anything is almost always better than sharing nothing.

"Things that are still on your computer are approximately useless." -@drob #eUSR #eUSR2017 pic.twitter.com/nS3IBiRHBn
— Amelia McNamara (@AmeliaMN) November 3, 2017

In this post I shared how I got my current job, when a Stack Overflow engineer saw one of my posts and reached out to me. That certainly qualifies as a freak accident. But the more public work you do, the higher the chance of a freak accident like that: of someone noticing your work and pointing you towards a job opportunity, or of someone who’s interviewing you having heard of work you’ve done.

And the purpose of blogging isn’t only to advertise yourself to employers. You also get to build a network of colleagues and fellow data scientists, which helps both in finding a job and in your future career. (I’ve found #rstats users on Twitter to be a particularly terrific community). A great example of someone who succeeded in this strategy is my colleague Julia Silge, who started her excellent blog while she was looking to shift her career into data science, and both got a job and built productive relationships through it.

Get feedback and evaluation

Suppose you’re currently looking for your first job as a data scientist. You’ve finished all the relevant DataCamp courses, worked your way through some books, and practiced some analyses. But you still don’t feel like you’re ready, or perhaps your applications and interviews haven’t been paying off, and you decide you need a bit more practice. What should you do next?

What skills could you improve on? It’s hard to tell when you’re developing a new set of skills how far along you are, and what you should be learning next. This is one of the challenges of self-driven learning as opposed to working with a teacher or mentor. A blog is one way to get this kind of feedback from others in the field.

This might sound scary, like you could get a flood of criticism that pushes you away from a topic. But in practice, you can usually sense that you’re not ready well before you finish a blog post.² For instance, even if you’re familiar with the basics of random forests, you might discover that you can’t achieve the accuracy you’d hoped for on a Kaggle dataset- and you have a chance to hold off on your blog post until you’ve learned more. What’s important is the committment: it’s easy to think “I probably could write this if I wanted”, but harder to try writing it.

Which of your skills are more developed, or more important, than you thought you were? This is the positive side of self-evaluation. Once you’ve shared some analyses and code, you’ll probably find that you were underrating yourself in some areas. This affects everyone but it’s especially important for graduating Ph.D. students, who spend several years becoming an expert in a specific topic while surrounded by people who are already experts- a recipe for impostor syndrome.

Imposter Syndrome: be honest with yourself about what you know and have accomplished & focus less on the difference. pic.twitter.com/VTjS5KdR6Y
— David Whittaker (@rundavidrun) April 13, 2015

For instance, I picked up the principles of empirical Bayes estimation while I was a graduate student, and since it was a simplification of “real” Bayesian analysis I assumed it wasn’t worth talking about. But once I blogged about empirical Bayes, I learned that those posts had a substantial audience, and that there’s a real lack of intuitive explanations for the topic. I ended up expanding the posts into an e-book: most of the material in the book would never qualify for an academic publication, but it was still worth sharing with the wider world.

One question I like to ask of PhD students, and anyone with hard-won but narrow expertise, is “What’s the simplest thing you understand that almost no one outside your field does?” That’s a recipe for a terrific and useful blog post.

Conclusion

One of the hardest mental barriers to starting a blog is the worry that you’re “shouting into the void”. If you haven’t developed an audience yet, it’s possible almost no one will read your blog posts- so why put work into them?

First, a lot of the benefits I describe above are just as helpful whether you have ten Twitter followers or ten thousand. You can still practice your analysis and writing skills, and point potential employers towards your work. And it helps you get into the habit of sharing work publicly, which will become increasingly relevant as your network grows.

Secondly, this is where people who are already members of the data science community can help. My promise is this: if you’re early in your career as a data scientist and you start a data-related blog, tweet me a link at @drob and I’ll tweet about your first post (in fact, the offer’s good for each of your first three posts). Don’t worry if it’s polished or “good enough to share”- just share the first work you find interesting!³ I have a decently-sized audience, and more importantly my followers include a lot of data scientists who are very supportive of beginners and are interested in promoting their work.

Good luck and I’m excited to see what you come up with!

It’s also a great idea to blog if you’re currently a data scientist! But the reasons are a bit different, and I won’t be exploring them in this post. ↩
Even if you do post an analysis with some mistakes or inefficiencies, if you’re part of a welcoming community the comments are likely to trend towards constructive (“Nice post! Have you considered vectorizing that operation?”) rather than toxic (“That’s super slow, dummy!”). In short, if as a beginner you post something that gets nasty comments, it’s not your fault, it’s the community’s. ↩
A few common-sense exceptions: I wouldn’t share work that’s ethically compromised, such as if it publicizes private data or promotes invidious stereotypes. Another exception is posts that are just blatant advertisements for a product or service. This probably doesn’t apply to you: just don’t actively try to abuse it! ↩

Announcing "Introduction to the Tidyverse", my new DataCamp course

2017-11-09T18:00:00+00:00

For the last few years I’ve been encouraging a particular approach to R education, teaching the dplyr and ggplot2 packages first and introducing real datasets early on. This week I’m excited to announce the next step: the release of Introduction to the Tidyverse, my new interactive course on the DataCamp platform.

The course is an introduction to the dplyr and ggplot2 packages through an analysis of the Gapminder dataset, enabling students to explore and visualize country statistics over time. It’s designed so that people can take it even if they have no previous experience in R, or if they’ve learned some (like in DataCamp’s free introduction) but aren’t familiar with dplyr, ggplot2, or how they fit together.

I’ve published two DataCamp courses before, Exploratory Data Analysis: Case Study (which makes a great followup to this new one) and Foundations of Probability. But I’m particularly excited about this one because the topic is so important to me. Here I’ll share a bit of my thinking behind the course and we made the decisions we did.

How “Intro to the Tidyverse” started

In early July I was at the useR 2017 conference in Brussels (where I gave a talk on R’s growth as seen in Stack Overflow data). A lot of the attendees were experienced teachers, and a common theme in my conversations was about whether it made sense to teach tidyverse packages like dplyr and ggplot2 before teaching base R syntax.

.@minebocek agrees: teach tidyverse to beginners first #UseR2017 pic.twitter.com/vxjCjNrDz0
— David Robinson (@drob) July 5, 2017

These conversations encouraged me to publish Teach the tidyverse to beginners that week. But the most notable conversations I had were with Chester Ismay, who had recently joined DataCamp as a Curriculum Lead, and with the rest of their content team (like Nick Carchedi and Richie Cotton). Chester and I have a lot of alignment in our teaching philosophies, and we realized the DataCamp platform offers a great opportunity to try a tidyverse-first course at a large scale.

The months since have been an exciting process of planning, writing, and executing the course. I enjoyed building my first two DataCamp courses, but this was a particularly thrilling experience, because I grew to realize I’d been planning this course for a while, almost subconsciously. In early October I filmed the video in NYC, and it was released almost four months to the day after Chester and I first had the idea.

The curriculum

I realized while I was writing the “teach tidyverse first” post that while I had taught R to beginners with dplyr/ggplot2 about a dozen times in my career (a mix of graduate courses, seminars, and workshops), I hadn’t shared my curriculum in any standardized way.¹ This means the conversation has always been a bit abstract. What exactly do I mean by teaching dplyr first, and when do other programming concepts get introduced along the way?

We put a lot of thought into the ordering of topics. DataCamp courses are divided into four chapters, each containing several videos and about 10-15 exercises.

Data Wrangling. Learn to do three things with a table: filter for particular observations, arrange the observations in a desired order, and mutate to add or change a column. You’ll see how each of these steps lets you answer questions about your data.
Data Visualization. Learn the essential skill of data visualization, using the ggplot2 package. Visualization and maniuplation are often intertwined, so you’ll see how the dplyr and ggplot2 packages work closely together to create informative graphs.
Grouping and summarizing. We may be interested in aggregations of the data, such as the average life expectancy of all countries within each year. Here you’ll learn to use the group by and summarize verbs, which collapse large datasets into manageable summaries.
Types of visualizations. Learn to create line plots, bar plots, histograms, and boxplots. You’ll see how each plot needs different kinds of data manipulation to prepare for it, and understand the different roles of each of these plot types in data analysis.

This ordering is certainly not the only way to teach R. But I like how it achieves a particular set of goals.

It not only introduces dplyr and ggplot2, but show how they work together. This is the reason we alternated chapters in a dplyr-ggplot2-dplyr-ggplot2 order, to appreciate how filtering, grouping, and summarizing data can feed directly into visualizations. This is one distinction between this course and the existing (excellent) dplyr and ggplot2 courses on DataCamp.
Get students doing powerful things quickly. This is a major theme of my tidyverse-first post and a sort of obsession of mine. The first exercise in the course introduces the gapminder dataset, discussing the data before writing a single line of code. And the last chapter in particular teaches students to create four different types of graphs, and shows how once you understand the grammar of graphics you can make a variety of visualizations.
Teach an approach that scales to real projects. There are hundreds of important topics students don’t learn in the course, ranging from matrices to lists to loops. But the particular skills they do learn aren’t toy examples or bad habits that need to be unlearned. I do use the functions and graphs taught in the course every day, and Julia Silge and I wrote a book using very similar principles.
Beginners don’t need any previous experience in R, or even in programming. We don’t assume someone’s familiar even with the basics in advance, even fundamentals such as variable assignment (assignment is introduced at the start of chapter 2; until then exploration is done interactively). It doesn’t hurt to have a course like Introduction to R under one’s belt first, but it’s not mandatory.

Incidentally, the course derives a lot of inspiration from the excellent book R for Data Science (R4DS), by Hadley Wickham and Garrett Grolemund. Most notably R4DS also uses the gapminder dataset to teach dplyr (thanks to Jenny Bryan’s R package it’s a bit of a modern classic).² I think the two resources complement each other: some people prefer learning from videos and interactive exercises than from books, and vice versa. Books have an advantage of having space to go deeper (for instance, we don’t teach select, grouped mutates, or statistical transformations), while courses are useful for having a built-in self-evaluation mechanism. Be sure to check out this page for more resources on learning tidyverse tools.

What’s next

I’m excited about developing my fourth DataCamp course with Chester (continuing my probability curriculum). And I’m particularly interested in seeing how the course is received, and whether people who complete this course continue to succeed in their data science journey.

I have a lot of opinions about R education, but not a lot of data about it, and I’m considering this an experiment to see how the tidyverse-first approach works in a large-scale interactive course. I’m looking forward both to the explicit data that DataCamp can collect, and to hear feedback from students and other instructors. So I hope to hear what you think!

The last online course I’ve recorded for beginners, which I recorded in 2014, takes a very different philosophy than I use now, especially in the first chapter. ↩
One of the differences is that we introduce the first dplyr operations before introducing ggplot2 (because it’s difficult to visualize gapminder data without filtering it first, while R4DS uses a different dataset to teach ggplot2). ↩

Don't teach students the hard way first

2017-09-21T14:00:00+00:00

Imagine you were going to a party in an unfamiliar area, and asked the host for directions to their house. It takes you thirty minutes to get there, on a path that takes you on a long winding road with slow traffic. As the party ends, the host tells you “You can take the highway on your way back, it’ll take you only ten minutes. I just wanted to show you how much easier the highway is.”

Wouldn’t you be annoyed? And yet this kind of attitude is strangely common in programming education.

I was recently talking to a friend who works with R and whose opinions I greatly respect. He was teaching some sessions to people in his company who hadn’t used R before, where he largely followed my philosophy on teaching the tidyverse to beginners. I agreed with his approach, until he said something far too familiar to me:

“I teach them dplyr’s group_by/summarize in the second lesson, but I teach them loops first just to show them how much easier dplyr is.”

I talk to people about teaching a lot, and that phrase keeps popping up: “I teach them X just to show them how much easier Y is”. It’s a trap- a trap I’ve fallen into before when teaching, and one that I’d like to warn others against.

First, why do some people make this choice? I think because when we teach a class, we accidentally bring in all of our own history and context.

For instance, I started programming with Basic and Perl in high school, then Java in college, then got really into Python, then got even more into R. Along the way I built up habits in each language that had to be painfully undone afterwards. I worked in an object-oriented style in Python, then switched to thinking in data frames and functional operations. I wrote too many loops when I started R, then I grew accustomed to the apply family of functions. Along the way there were thousands of little frustrations and little epiphanies, tragedies and triumphs in microcosm.

But when I’m teaching someone how to use R… they don’t care about any of that. They weren’t there! They didn’t make my mistakes, they don’t need to be talked out of them. Going back to the party host, perhaps the highway was built only last year, and maybe the host had to talk his friends, stuck in their habits, into taking the highway by explaining how much faster it is. But that doesn’t make any difference to the guest, who has never taken either route.

@ucfagls I think ppl teach base stuff preferentially because it’s what they still use or they’re reliving their own #rstats “journey” @drob
— Jenny Bryan (@JennyBryan) January 16, 2015

It’s true that I learned a lot about programming in the path I described above. I learned how to debug, how to compare programming paradigms, and when to switch from one approach to another. I think some teachers hope that by walking students through this “journey”, we can impart some of that experience. But it doesn’t work: feeding students two possible solutions in a row is nothing like the experience of them comparing solutions for themselves, and doesn’t grant them any of the same skills. Besides which, students will face plenty of choices and challenges as they continue their programming career, without us having to invent artificial ones.

Students should absolutely learn multiple approaches (there’s usually advantages to each one). But not in this order, from hardest to easiest, and not because it happened to be the order we learned it ourselves.

Bandwidth and trust

There are two reasons I recommend against teaching a harder approach first. One is educational bandwidth, and one is trust.

One of the most common mistakes teachers make (especially inexperienced ones) is to think they can teach more material than they can.

.@minebocek talks philosophy of Data Carpentry.

Highlight: don't take on too much material. Rushing discourages student questions #UseR2017 pic.twitter.com/txAcSd3ND3
— David Robinson (@drob) July 6, 2017

This comes down to what I sometimes call educational bandwidth: the total amount of information you can communicate to students is limited, especially since you need to spend time reinforcing and revisiting each concept. It’s not just about the amount of time you have in the lesson, either. Learning new ideas is hard work: think of the headache you can get at the end of a one-day workshop. This means you should make sure every idea you get across is valuable. If you teach them a method they’ll never have to use, you’re wasting time and energy.

The other reason is trust. Think of the imaginary host who gave poor directions before giving better ones. Wouldn’t it be unpleasant to be tricked like that? When a student goes through the hard work of learning a new method, telling them “just kidding, you didn’t need to learn that” is obnoxious, and hurts their trust in you as a teacher.

In some cases there’s a tradeoff between bandwidth and trust. For instance, as I’ve described before, I teach dplyr and the %>% operator before explaining what a function is, or even how to do a variable assignment. This conserves bandwidth (it gets students doing powerful things quickly) but it’s a minor violation of their trust (I’m hiding details of how R actually works). But there’s no tradeoff in teaching a hard method before an easier one.

Exceptions

Is there any situation where you might want to show students the hard way first? Yes: one exception is if the hard solution is something the student would have been tempted to do themselves.

One good example is in R for Data Science, by Hadley Wickham and Garrett Grolemund. Chapter 19.2 describes “When should you write a function”, and gives an example of rescaling several columns by copying and pasting code:

df$a <- (df$a - min(df$a, na.rm = TRUE)) / 
  (max(df$a, na.rm = TRUE) - min(df$a, na.rm = TRUE))
df$b <- (df$b - min(df$b, na.rm = TRUE)) / 
  (max(df$b, na.rm = TRUE) - min(df$a, na.rm = TRUE))
df$c <- (df$c - min(df$c, na.rm = TRUE)) / 
  (max(df$c, na.rm = TRUE) - min(df$c, na.rm = TRUE))
df$d <- (df$d - min(df$d, na.rm = TRUE)) / 
  (max(df$d, na.rm = TRUE) - min(df$d, na.rm = TRUE))

By showing them what this approach looks like (and even including an intentional typo in the second line, to show how copying and pasting code is prone to error), the book guides them towards the several steps involved in writing a function.

rescale01 <- function(x) {
  rng <- range(x, na.rm = TRUE)
  (x - rng[1]) / (rng[2] - rng[1])
}

This educational approach makes sense because copying and pasting code is a habit beginners would fall into naturally, especially if they’ve never programmed before. It doesn’t take up any educational bandwidth because students already know how to do it, and it’s upfront about it’s approach (when I teach this way, I usually use the words “you might be tempted to…”).

However, teaching a loop (or split()/lapply(), or aggregate, or tapply) isn’t something beginners would do accidentally, and it’s therefore not something you need to be talking.

In conclusion: teaching programming is hard, don’t make it harder. Next time you’re teaching a course, or workshop, or writing a tutorial, or just helping a colleague getting set up in R, try teaching them your preferred method first, instead of meandering through subpar solutions. I think you’ll find that it’s worth it.

Trump's Android and iPhone tweets, one year later

2017-08-09T16:00:00+00:00

A year ago today, I wrote up a blog post Text analysis of Trump’s tweets confirms he writes only the (angrier) Android half.

My analysis, shown below, concludes that the Android and iPhone tweets are clearly from different people, posting during different times of day and using hashtags, links, and retweets in distinct ways. What’s more, we can see that the Android tweets are angrier and more negative, while the iPhone tweets tend to be benign announcements and pictures.

Of course, a lot has changed in the last year. Trump was elected and inaugurated, and his Twitter account has become only more newsworthy. So it’s worth revisiting the analysis, for a few reasons:

There is a year of new data, with over 2700 more tweets. And quite notably, Trump stopped using the Android in March 2017. This is why machine learning approaches like didtrumptweetit.com are useful, since they can still distinguish Trump’s tweets from his campaign’s by training on the kinds of features I used in my original post.
I’ve found a better dataset: in my original analysis, I was working quickly and used the twitteR package to query Trump’s tweets. I since learned there’s a bug in the package that caused it to retrieve only about half the tweets that could have been retrieved, and in any case I was able to go back only to January 2016. I’ve since found the truly excellent Trump Twitter Archive, which contains all of Trump’s tweets going back to 2009. Below I show some R code for querying it.
I’ve heard some interesting questions that I wanted to follow up on: These come from the comments on the original post and other conversations I’ve had since. Two questions included what device Trump tended to use before the campaign, and what types of tweets tended to lead to high engagement.

So here I’m following up with a few more analyses of the \@realDonaldTrump account. As I did last year, I’ll show most of my code, especially those that involve text mining with the tidytext package (now a published O’Reilly book!). You can find the remainder of the code here.

Updating the dataset

The first step was to find a more up-to-date dataset of Trump’s tweets. The Trump Twitter Archive, by Brendan Brown, is a brilliant project for tracking them, and is easily retrievable from R.

library(tidyverse)
library(lubridate)

url <- 'http://www.trumptwitterarchive.com/data/realdonaldtrump/%s.json'
all_tweets <- map(2009:2017, ~sprintf(url, .x)) %>%
  map_df(jsonlite::fromJSON, simplifyDataFrame = TRUE) %>%
  mutate(created_at = parse_date_time(created_at, "a b! d! H!:M!:S! z!* Y!")) %>%
  tbl_df()

As of today this contains 31548, including the text, device, and the number of retweets and favorites. (Also impressively, it updates hourly, and since September 2016 it includes tweets that were afterwards deleted).

Devices over time

My analysis from last summer was useful for journalists interpreting Trump’s tweets, since it was able to distinguish Trump’s tweets from those sent by his staff. But it stopped being true in March 2017, when Trump switched to using an iPhone.

Let’s dive into at the history of all the devices used to tweet from the account, since the first tweets in 2009.

library(forcats)

all_tweets %>%
  mutate(source = fct_lump(source, 5)) %>%
  count(month = round_date(created_at, "month"), source) %>%
  complete(month, source, fill = list(n = 0)) %>%
  mutate(source = reorder(source, -n, sum)) %>%
  group_by(month) %>%
  mutate(percent = n / sum(n),
         maximum = cumsum(percent),
         minimum = lag(maximum, 1, 0)) %>%
  ggplot(aes(month, ymin = minimum, ymax = maximum, fill = source)) +
  geom_ribbon() +
  scale_y_continuous(labels = percent_format()) +
  labs(x = "Time",
       y = "% of Trump's tweets",
       fill = "Source",
       title = "Source of @realDonaldTrump tweets over time",
       subtitle = "Summarized by month")

A number of different people have clearly tweeted for the \@realDonaldTrump account over time, forming a sort of geological strata. I’d divide it into basically five acts:

Early days: All of Trump’s tweets until late 2011 came from the Web Client.
Other platforms: There was then a burst of tweets from TweetDeck and TwitLonger Beta, but these disappeared. Some exploration (shown later) indicate these may have been used by publicists promoting his book, though some (like this one from TweetDeck) clearly either came from him or were dictated.
Starting the Android: Trump’s first tweet from the Android was in February 2013, and it quickly became his main device.
Campaign: The iPhone was introduced only when Trump announced his campaign by 2015. It was clearly used by one or more of his staff, because by the end of the campaign it made up a majority of the tweets coming from the account. (There was also an iPad used occasionally, which was lumped with several other platforms into the “Other” category). The iPhone reduced its activity after the election and before the inauguration.
Trump’s switch to iPhone: Trump’s last Android tweet was on March 25th, 2017, and a few days later Trump’s staff confirmed he’d switched to using an iPhone.

Which devices did Trump use himself, and which did other people use to tweet for him? To answer this, we could consider that Trump almost never uses hashtags, pictures or links in his tweets. Thus, the percentage of tweets containing one of those features is a proxy for how much others are tweeting for him.

library(stringr)

all_tweets %>%
  mutate(source = fct_lump(source, 5)) %>%
  filter(!str_detect(text, "^(\"|RT)")) %>%
  group_by(source, year = year(created_at)) %>%
  summarize(tweets = n(),
            hashtag = sum(str_detect(str_to_lower(text), "#[a-z]|http"))) %>%
  ungroup() %>%
  mutate(source = reorder(source, -tweets, sum)) %>%
  filter(tweets >= 20) %>%
  ggplot(aes(year, hashtag / tweets, color = source)) +
  geom_line() +
  geom_point() +
  scale_x_continuous(breaks = seq(2009, 2017, 2)) +
  scale_y_continuous(labels = percent_format()) +
  facet_wrap(~ source) +
  labs(x = "Time",
       y = "% of Trump's tweets with a hashtag, picture or link",
       title = "Tweets with a hashtag, picture or link by device",
       subtitle = "Not including retweets; only years with at least 20 tweets from a device.")

This suggests that each of the devices may have a mix (TwitLonger Beta was certainly entirely staff, as was the mix of “Other” platforms during the campaign), but that only Trump ever tweeted from an Android.

When did Trump start talking about Barack Obama?

Now that we have data going back to 2009, we can take a look at how Trump used to tweet, and when his interest turned political.

In the early days of the account, it was pretty clear that a publicist was writing Trump’s tweets for him. In fact, his first-ever tweet refers to him in the third person:

Be sure to tune in and watch Donald Trump on Late Night with David Letterman as he presents the Top Ten List tonight!
— Donald J. Trump (@realDonaldTrump) May 4, 2009

The first hundred or so tweets follow a similar pattern (interspersed with a few cases where he tweets for himself and signs it). But this changed alongside his views of the Obama administration. Trump’s first-ever mention of Obama was entirely benign:

Staff Sgt. Salvatore A. Giunta received the Medal of Honor from Pres. Obama this month. It was a great honor to have him visit me today.
— Donald J. Trump (@realDonaldTrump) November 22, 2010

But his next were a different story. This article shows how Trump’s opinion of the administration turned from praise to criticism at the end of 2010 and in early 2011, when he started spreading a conspiracy theory about Obama’s country of origin. His second and third tweets about the president both came in July 2011, followed by many more.

What changed? Well, it was two months after the infamous 2011 White House Correspondents Dinner, where Obama mocked Trump for his conspiracy theories, causing Trump to leave in a rage. Trump has denied that the dinner pushed him towards politics… but there certainly was a reaction at the time.

all_tweets %>%
  filter(!str_detect(text, "^(\"|RT)")) %>%
  group_by(month = round_date(created_at, "month")) %>%
  summarize(tweets = n(),
            hashtag = sum(str_detect(str_to_lower(text), "obama")),
            percent = hashtag / tweets) %>%
  ungroup() %>%
  filter(tweets >= 10) %>%
  ggplot(aes(as.Date(month), percent)) +
  geom_line() +
  geom_point() +
  geom_vline(xintercept = as.integer(as.Date("2011-04-30")), color = "red", lty = 2) +
  geom_vline(xintercept = as.integer(as.Date("2012-11-06")), color = "blue", lty = 2) +
  scale_y_continuous(labels = percent_format()) +
  labs(x = "Time",
       y = "% of Trump's tweets that mention Obama",
       subtitle = paste0("Summarized by month; only months containing at least 10 tweets.\n",
                         "Red line is White House Correspondent's Dinner, blue is 2012 election."),
       title = "Trump's tweets mentioning Obama")

between <- all_tweets %>%
  filter(created_at >= "2011-04-30", created_at < "2012-11-07") %>%
  mutate(obama = str_detect(str_to_lower(text), "obama"))

percent_mentioned <- mean(between$obama)

Between July 2011 and November 2012 (Obama’s re-election), a full 32.3%% of Trump’s tweets mentioned Obama by name (and that’s not counting the ones that mentioned him or the election implicitly, like this). Of course, this is old news, but it’s an interesting insight into what Trump’s Twitter was up to when it didn’t draw as much attention as it does now.

Trump’s opinion of Obama is well known enough that this may be the most redundant sentiment analysis I’ve ever done, but it’s worth noting that this was the time period where Trump’s tweets first turned negative. This requires tokenizing the tweets into words. I do so with the tidytext package created by me and Julia Silge.

library(tidytext)

all_tweet_words <- all_tweets %>%
  mutate(text = str_replace_all(text, "https?://t.co/[A-Za-z\\d]+|&amp;", "")) %>%
  filter(!str_detect(text, "^(\"|RT)")) %>%
  unnest_tokens(word, text, token = "regex", pattern = reg) %>%
  filter(!word %in% stop_words$word, str_detect(word, "[a-z]"))

all_tweet_words %>%
  inner_join(get_sentiments("afinn")) %>%
  group_by(month = round_date(created_at, "month")) %>%
  summarize(average_sentiment = mean(score), words = n()) %>%
  filter(words >= 10) %>%
  ggplot(aes(month, average_sentiment)) +
  geom_line() +
  geom_hline(color = "red", lty = 2, yintercept = 0) +
  labs(x = "Time",
       y = "Average AFINN sentiment score",
       title = "@realDonaldTrump sentiment over time",
       subtitle = "Dashed line represents a 'neutral' sentiment average. Only months with at least 10 words present in the AFINN lexicon")

(Did I mention you can learn more about using R for sentiment analysis in our new book?)

Changes in words since the election

My original analysis was on tweets in early 2016, and I’ve often been asked how and if Trump’s tweeting habits have changed since the election. The remainder of the analyses will look only at tweets since Trump launched his campaign (June 16, 2015), and disregards retweets.

library(stringr)

campaign_tweets <- all_tweets %>%
  filter(created_at >= "2015-06-16") %>%
  mutate(source = str_replace(source, "Twitter for ", "")) %>%
  filter(!str_detect(text, "^(\"|RT)"))

tweet_words <- all_tweet_words %>%
  filter(created_at >= "2015-06-16")

We can compare words used before the election to ones used after.

ratios <- tweet_words %>%
  mutate(phase = ifelse(created_at >= "2016-11-09", "after", "before")) %>%
  count(word, phase) %>%
  spread(phase, n, fill = 0) %>%
  mutate(total = before + after) %>%
  mutate_at(vars(before, after), funs((. + 1) / sum(. + 1))) %>%
  mutate(ratio = after / before) %>%
  arrange(desc(ratio))

What words were used more before or after the election?

Some of the words used mostly before the election included “Hillary” and “Clinton” (along with “Crooked”), though he does still mention her. He no longer talks about his competitors in the primary, including (and the account no longer has need of the #trump2016 hashtag).

Of course, there’s one word with a far greater shift than others: “fake”, as in “fake news”. Trump started using the term only in January, claiming it after some articles had suggested fake news articles were partly to blame for Trump’s election.

As of early August Trump is using the phrase more than ever, with about 9% of his tweets mentioning it. As we’ll see in a moment, this was a savvy social media move.

What words lead to retweets?

One of the most common followup questions I’ve gotten is what terms tend to lead to Trump’s engagement.

word_summary <- tweet_words %>%
  group_by(word) %>%
  summarize(total = n(),
            median_retweets = median(retweet_count))

What words tended to lead to unusually many retweets, or unusually few?

word_summary %>%
  filter(total >= 25) %>%
  arrange(desc(median_retweets)) %>%
  slice(c(1:20, seq(n() - 19, n()))) %>%
  mutate(type = rep(c("Most retweets", "Fewest retweets"), each = 20)) %>%
  mutate(word = reorder(word, median_retweets)) %>%
  ggplot(aes(word, median_retweets)) +
  geom_col() +
  labs(x = "",
       y = "Median # of retweets for tweets containing this word",
       title = "Words that led to many or few retweets") +
  coord_flip() +
  facet_wrap(~ type, ncol = 1, scales = "free_y")

Some of Trump’s most retweeted topics include Russia, North Korea, the FBI (often about Clinton), and, most notably, “fake news”.

Of course, Trump’s tweets have gotten more engagement over time as well (which partially confounds this analysis: worth looking into more!) His typical number of retweets skyrocketed when he announced his campaign, grew throughout, and peaked around his inauguration (though it’s stayed pretty high since).

all_tweets %>%
  group_by(month = round_date(created_at, "month")) %>%
  summarize(median_retweets = median(retweet_count), number = n()) %>%
  filter(number >= 10) %>%
  ggplot(aes(month, median_retweets)) +
  geom_line() +
  scale_y_continuous(labels = comma_format()) +
  labs(x = "Time",
       y = "Median # of retweets")

Also worth noticing: before the campaign, the only patch where he had a notable increase in retweets was his year of tweeting about Obama. Trump’s foray into politics has had many consequences, but it was certainly an effective social media strategy.

Conclusion: I wish this hadn’t aged well

Until today, last year’s Trump post was the only blog post that analyzed politics, and (not unrelatedly!) the highest amount of attention any of my posts have received. I got to write up an article for the Washington Post, and was interviewed on Sky News, CTV, and NPR. People have built great tools and analyses on top of my work, with some of my favorites including didtrumptweetit.com and the Atlantic’s analysis. And I got the chance to engage with, well, different points of view.

Wait was that an optionhttps://t.co/HRr4yj30hx pic.twitter.com/ZIpaEgYnrw
— David Robinson (@drob) August 10, 2016

The post has certainly had some professional value. But it disappoints me that the analysis is as relevant as it is today. At the time I enjoyed my 15 minutes of fame, but I also hoped it would end. (“Hey, remember when that Twitter account seemed important?” “Can you imagine what Trump would tweet about this North Korea thing if we were president?”) But of course, Trump’s Twitter account is more relevant than ever.

I remember when my Android/iPhone analysis came out last year, people asked "Who cares what Trump tweets?"

😬https://t.co/fnDEiWMNYk
— David Robinson (@drob) July 26, 2017

I don’t love analyzing political data; I prefer writing about baseball, biology, R education, and programming languages. But as you might imagine, that’s the least of the reasons I wish this particular chapter of my work had faded into obscurity.