The strategy of the Plinketto board

Exploring how best to use the Redlettermedia movie selection tool to your advantage.

Jonatan Pallesen
05-22-2019

Introduction

In RedLetterMedia, they make a type of video called Best of the Worst, where they choose 3 bad movies and watch them, and decide which one of them is the best of the worst. The selection procedure uses a device called a Plinketto board.

It is a form of Galton board that is slightly longer. (It has 10 starting slots and length 19). In the Galton board, the results are normally distributed around the where it is dropped. I explore the results for the Plinketto board using simulations.

Simulations

code


library(pacman)

p_load(tidyverse, magrittr, broom, rsample, janitor, scales)

source('../../src/extra.R', echo = F, encoding="utf-8")

plinketto <- function(s, width, height, row){
  if (row %% 2 == 0){
      s = s + sample(0:1, 1)
    } else {
      if (s > 1 && s < width) {
        s = s - sample(0:1, 1)
        }
      if (s == width) {
        s = s - 1
        }
    }
  row = row + 1
    
  if (row == height) {
    return(s)
  } else {
    return(plinketto(s, width, height, row))
  }
}

plotit <- function(df){
  df %>% ggplot(aes(x = factor(movie_choice, levels = 1:11))) +
    jpal_bar(aes(y = (..count..)/sum(..count..))) +
    scale_x_discrete(drop=F) +
    scale_y_continuous(labels=percent) +
    labs(y = "", x = "movie choice")
}

set.seed(1)

nsims <- 100000

Dropping in the center

The resulting movie picks normally distributed around the drop point.


tibble(movie_choice = replicate(nsims, plinketto(6, 11, 19, 0))) %>% 
  plotit()

Dropping at the edge

It is less likely for the ball to end up in the corner spot. Intuitively this is caused by there being two immediate paths to all the other slots, but only one immediate paths to the corner slot.


tibble(movie_choice = replicate(nsims, plinketto(1, 11, 19, 0))) %>% 
  plotit()

Note that this is only the case because the final row in the Plinketto board is narrow. If the final row had been wide, the results from dropping at the edge would look like this:


tibble(movie_choice = replicate(nsims, plinketto(1, 11, 20, 0))) %>% 
  plotit()

Dropping at the second slot

The chance of hitting the second slot is higher if you drop at the edge, than if you drop directly above it.


tibble(movie_choice = replicate(nsims, plinketto(2, 11, 19, 0))) %>% 
  plotit()

Maximum chance achievable

The below plot shows the maximum chance you can get to hit a specific movie, with optimal placement.


c(1:10) %>% map_df(~ tibble(movie_choice = replicate(nsims, plinketto(.x, 11, 19, 0))) %>% 
  tabyl(movie_choice) %>% mutate(drop = .x)) %>% 
  group_by(movie_choice) %>% 
  summarise(max_chance = max(percent)) %>% 
  ggplot(aes(x = movie_choice)) +
    jpal_bar(aes(y = max_chance), stat="identity") +
    scale_x_continuous(breaks = 1:11, labels = 1:11) +
    scale_y_continuous(labels=percent) +
    labs(y = "")

Strategy