R.5 — What's the Best Strategy in Rock-Paper-Scissors?

Jun. 23, 2018

R-Posts R Riddles Probability

This week’s Riddler from FiveThirtyEight is a probabilistic challenge from a simple childhood game: rock-paper-scissors, the classic game of schoolchildren getting to pick who goes first in the lunch line. Oliver Roeder writes the challenge:

You know how the game works: Rock beats scissors, scissors beats paper, paper beats rock.

To enter this battle royale, submit the following two things via the button below: 1) The probabilities that you will play rock, paper and scissors on the initial throw of a match, and 2) the conditional probabilities that you will play rock, paper and scissors after you observe your opponent play either rock, paper or scissors.2

I’ll match each of your submissions against every other submission in a series of best-two-out-of-three rock-paper-scissors matches. Whoever wins the most matches will be crowned Rochambeau Raja of Riddler Nation

So, how are you going to decide which probabilities to assign to which hands? If your goal is to not waste three hours coding a solution in R, you’ve come to the wrong place. All others, step onto the tournament floor with me.


Using R to Win a Rock-Paper-Scissors Tournament

There are a few ingredients to our solution to Oliver’s puzzle for The Riddler this week. Here’s what we need:

  1. Five functions:
    1. One function to simulate the first “hand” (either rock, paper, or scissors)
    2. One function to simulate the followup hands
    3. One function to simulate one “game” of rock-paper-scissors: that’s one hand for we and one for the opponent
    4. One function to simulate a followup game for either players
    5. One function to simulate a “match,” or a best two-out-of-three exchange of R-P-S games
  2. Four (sets of) Probabilities:
    1. The probability that we pick either R, P, or S on the first hand
    2. The opponent’s probability of picking R, P, or S.
    3. Probabilities that we pick either R, P, or S on the followup hands, given that we’re exposed to the opponent’s first/second hand
    4. Probabilities that the opponent picks either R, P, or S on the followup hands, given that they’re exposed to our first/second hand
  3. To repeat hundreds of matches with hundreds of players to assess the accuracy of the inputted probabilities

These ingredients, broken down, are not so tough to grasp. However, before I tell you the optimal strategy (probabilities) for a game of rock-paper-scissors, allow me to ruin your day: the game is mostly about chance, and evaluating your opponent’s playing style. The solution here only lets you win 55% of the time on average — nobody is going to become the world champion R-P-S player by memorizing this program and entering the nearest tournament. Problems of intuition, chancy anticipation, and human touch are the hardest for computers to emulate.

So, how would you start out, if you wanted to beat Oliver’s puzzle? Let’s first fill out the first ingredients to the puzzle: functions for playing the game.


30,000 Games of Rock-Paper-Scissors

Below, I import the tidyverse suite of packages (it will come in handy later and write the first two functions: one for the first hand, which only takes probs, a list of probabilities for rock (1), paper (2), and scissors, (3), and one for the followup hand, which plays one hand of the game using conditional probabilities dependent on seeing a given hand (R, P, or S).

# https://fivethirtyeight.com/features/the-riddlers-inaugural-rock-paper-scissors-tournament/

library(tidyverse)

# function to choose either rock, paper, or scissors, given probability  ---
hand <- function(probs){
  sample(1,x = 1:3,replace=T,prob=probs)
}

# a function to choose R, P, S given your opponent does R, P, S ---
follow_hand <- function(opp_pick, probs){
  follow_probs <- probs[opp_pick,]
  return(hand(follow_probs))
}

Let’s play a few hands.

# play one hand where there's an equal chance of picking rock, paper, or scissors
hand(c(1/3,1/3,1/3))
## [1] 1
# play a bunch of initial hands
replicate(10,
          hand(c(1/3,1/3,1/3))
          )
##  [1] 1 3 3 1 1 1 1 3 3 3
# play a followup hand
follow_hand(1,data.frame("Rock" = c(7/10,2/10,1/10),
                         "Paper" = c(1/10,7/10,2/10),
                         "Scissors" = c(1/10,2/10,7/10)))
## [1] 1
#play a bunch of followup hands
replicate(10,
  follow_hand(1,data.frame("Rock" = c(7/10,2/10,1/10),
                         "Paper" = c(1/10,7/10,2/10),
                         "Scissors" = c(1/10,2/10,7/10)))
)
##  [1] 1 1 1 1 1 1 1 1 1 1

These functions are cool, but they’re only getting us so far. Below I specify two functions: one to play the first game of a three-game match and return the results, and play the followup game in a match and return the results.

# play the first game ---
play_game <- function(first_probs,opp_first_probs){
  my_hand <- hand(first_probs) # draw a hand with my probabilities
  opp_hand <- hand(opp_first_probs) # opponent's hand
  
  my_win_tri = case_when(my_hand == 1 & opp_hand==1 ~ 0,
                         my_hand == 1 & opp_hand == 2 ~ -1,
                         my_hand == 1 & opp_hand == 3 ~ 1,
                         my_hand == 2 & opp_hand == 1 ~ 1,
                         my_hand == 2 & opp_hand == 2 ~ 0,
                         my_hand == 2 & opp_hand == 3 ~ -1,
                         my_hand == 3 & opp_hand == 1 ~ -1,
                         my_hand == 3 & opp_hand == 2 ~ 1,
                         my_hand == 3 & opp_hand == 3 ~ 0)
  
  return(list("my_hand" = my_hand,"opp_hand" = opp_hand,"my_win" = my_win_tri))
}


# play a followup hand --------
play_followup <- function(my_hand_one,opp_hand_one,my_follow_probs,opp_follow_probs){
  my_hand <- follow_hand(opp_hand_one,my_follow_probs) # followup hand for me, given the opponent's hand and my followup probabilities
  opp_hand <- follow_hand(my_hand_one,opp_follow_probs) # followup hand for me, given my hand and the opponent's followup probabilities
  
  
  my_win_tri = case_when(my_hand == 1 & opp_hand==1 ~ 0,
                         my_hand == 1 & opp_hand == 2 ~ -1,
                         my_hand == 1 & opp_hand == 3 ~ 1,
                         my_hand == 2 & opp_hand == 1 ~ 1,
                         my_hand == 2 & opp_hand == 2 ~ 0,
                         my_hand == 2 & opp_hand == 3 ~ -1,
                         my_hand == 3 & opp_hand == 1 ~ -1,
                         my_hand == 3 & opp_hand == 2 ~ 1,
                         my_hand == 3 & opp_hand == 3 ~ 0)
  
  return(list("my_hand" = my_hand,"opp_hand" = opp_hand,"my_win" = my_win_tri))
}

Now that we have the function definitions out of the way, we can actually play a hand of R-P-S! Here’s what happens if I put my hand up against the opponent’s hand, given the following probabilities for each of us:

  • 20% chance that I choose rock
  • 50% chance that I choose paper
  • 30% chance that I choose scissors
  • 50% chance the opponent chooses choose rock
  • 30% chance the opponent chooses choose paper
  • 20% chance the opponent chooses choose scissors

I chose these probabilities based on a post to Reddit’s r/dataisbeautiful subreddit that analyzed the frequencies of certain hands from 100 different players.

# play one game
play_game(c(2/10,5/10,3/10),
          c(5/10,3/10,2/10))
## $my_hand
## [1] 2
## 
## $opp_hand
## [1] 1
## 
## $my_win
## [1] 1

Of course, because any one simulated game can produce one of three outcomes for the player (win, loss, or tie) and we would have a skewed expectation of the chance to win by focusing on one case, it takes a few thousand games to reach the true chance than we will win, lose or tie. Here, I repeat the simulated initial game 1,000 times and output the chance we win, lose, or tie.

# how often do I win when I play 5000 games?
games <- replicate(5000,
          play_game(c(2/10,5/10,3/10),
                    c(5/10,3/10,2/10))) 

games %>%
  as.data.frame() %>% t() %>% as.data.frame() %>% # transpose data
  pull(my_win) %>% as.numeric() %>% # pull win column
  table() %>% prop.table() %>% round(3)# find the proportion of wins/total
## .
##    -1     0     1 
## 0.315 0.309 0.375

As you can see, is a roughly 38% chance that you will win any given match if you and your opponents play with these probabilities. That’s better odds than not, given the circumstances, but still reflects that there’s no perfect winning strategy to this game of human chance.

Of course there is no guarantee that this win probability my actual one in reality; for one thing, the Reddit post could mislead us about the true nature of first picks for R-P-S. Second, it is feasible that the types of players who submit solutions to the Riddler are thinking one step ahead and choosing paper as their most likely first throw, which means I should be programming a higher probability for scissors and lowest probability for rock. Nevertheless, the Reddit post is the only real data we have (and this is already likely too much effort for a silly little puzzle).

Oliver’s rock-paper-scissors tournament stipulates that the player who wins the most best-two-out-of-three matches will be declared the winner of the tournament. The function below does just that, first playing the initial game until someone wins, then playing the subsequent games until someone wins. The function plays the second and third games by exposing both players to the opponents’ picks in previous game and chooses the appropriate new hand based on inputted conditional probabilities. The function returns the number of matches by which you win or lose (-2, -1, 1, or 2).

# this code chunck just makes a function to play one match of r-p-s (best two out of three hands, 1 initial and 2 followup) ----
play_match <- function(my_first_probs,opp_first_probs,my_follow_probs,opp_follow_probs){
  # play one game
  first <- play_game(my_first_probs,opp_first_probs)
  
  while(first$my_win==0){
    first <- play_game(my_first_probs,opp_first_probs)
  }
  
  # play follow game, hand for me & opp dependent on the first
  second <- play_followup(first$my_hand,first$opp_hand,my_follow_probs,opp_follow_probs)
  
  while(second$my_win==0){
    second <-  play_followup(first$my_hand,first$opp_hand,my_follow_probs,opp_follow_probs)
  }
  
  if(first$my_win == 1 & second$my_win == 1){
    return(2)
  }else if(first$my_win == -1 & second$my_win == -1){
    return(-2)
  }
  
  # play thrid game, hand for me & opp dependent on the follow
  third <- play_followup(second$my_hand,second$opp_hand,my_follow_probs,opp_follow_probs)
  
  while(third$my_win==0){
    third <- play_followup(second$my_hand,second$opp_hand,my_follow_probs,opp_follow_probs)
  }
  
  score <- first$my_win + second$my_win + third$my_win
  
  return(score)
  
}

We’re going to play a round with the following conditional probabilities for us and the opponent:

  • When I see rock:
    • 70% chance of playing rock next, 20% paper, 10% scissors
  • When I see paper:
    • 10% chance of playing rock next, 70% paper, 20% scissors
  • When I see scissors:
    • 10% chance of playing rock next, 20% paper, 70% scissors

The logic behind this seems okay; when I see an opponent play rock, they think that I will next play paper, so they will play scissors, so I should throw rock. If I assume that the other Riddler R-P-S tournament players also are thinking along these lines (indeed, they’re likely thinking far ahead), then this strategy should win more often than it loses… even if barely. Of course, if you’re playing a particular pattern the opponent will likely figure it out, so we need to preserve some probability for the chance that the opponent picks something else.

Want to try out your own strategy? The New York Times has a robot that will play you in R-P-S, learning how to beat you along the way.

# play a match!
# ok, actually play!! 

my_init_probs <- c(2/10,5/10,3/10)

opp_init_probs <- c(5/10,3/10,2/10)

my_pick_probs_condit <- data.frame("Rock" = c(7/10,2/10,1/10),
                                   "Paper" = c(1/10,7/10,2/10),
                                   "Scissors" = c(1/10,2/10,7/10))

opp_pick_probs_condit <-  data.frame("Rock" = c(7/10,2/10,1/10),
                                     "Paper" = c(1/10,7/10,2/10),
                                     "Scissors" = c(1/10,2/10,7/10))

# a function to play the match with inputted variables
play_match_custom <- function(x){
  match <- play_match(my_first_probs = my_init_probs,
          opp_first_probs = opp_init_probs,
          my_follow_probs = my_pick_probs_condit,
          opp_follow_probs = opp_pick_probs_condit)
  return(match)}


# here's the call: 
play_match_custom()
## [1] -1

Again, anything is possible on the first match, so what we really want to do is play the game thousands of times and assess the results probabilistically. Here, I’ve written code to parallelize the simulation process and run 10,000 matches of rock-paper-scissors.

# use parallelization to speed up simulation of 10k rounds
library(doParallel)
# setup parallel backend to use many processors
## Calculate the number of cores
num_cores <- ifelse(detectCores()>1,detectCores() -1,detectCores()) # get available cores
registerDoParallel(cores=num_cores)  
cl <- parallel::makeCluster(num_cores)

# export functions and variables to the clusters
clusterExport(cl=cl,varlist = c("play_match_custom","play_match",
                                "play_game","hand","case_when",
                                "play_followup","follow_hand",
                                "my_init_probs",
                                "opp_init_probs",
                                "my_pick_probs_condit",
                                "opp_pick_probs_condit"
                                ))
# collect the output
tourney <- parLapply(cl=cl,1:10000,fun = "play_match_custom")

stopCluster(cl)

# turn the output into a data frame
tourneys <- tourney %>% as.numeric() %>%
  table() %>% 
  prop.table() %>% round(3) %>%
  as.data.frame() 

head(tourneys)
##    .  Freq
## 1 -2 0.134
## 2 -1 0.336
## 3  1 0.356
## 4  2 0.173

Here you can see that there is an outside chance that the program can win a given match, but it still loses a good deal of the time.

data.frame("outcome" = tourney %>% as.numeric()) %>%
  ggplot(.,aes(x=outcome)) + 
  geom_histogram(binwidth=0.5) + theme_light()

# probability of winning or losing?
tourneys %>%
  setNames(c("win","freq")) %>%
  mutate(win = as.numeric(as.character(win))) %>%
  group_by(win>0) %>%
  summarise(few=sum(freq))
## # A tibble: 2 x 2
##   `win > 0`   few
##   <lgl>     <dbl>
## 1 FALSE     0.47 
## 2 TRUE      0.529

Using this approach, we win the game 53% of the time, which is probably the best we can hope for after thinking about the problem for an hour and then writing this code.

Good luck, fellow Riddlers! If you think you have better assumptions about the probabilities players pick, feel free to modify the code above and show me how good you can be at rock-paper-scissors.


comments powered by Disqus