Creating a Coin Flipping Game

I am working with the R programming language.

I am working with the R programming language. Recently, I thought of the following "game" to illustrate "mixed strategies and comparative advantages":

  • There are two Players: Player 1 and Player 2
  • There are two Coins: Coin 1 and Coin 2
  • Coin 1 lands on "Heads" with a probability of 0.5 and "Tails" with a probability of 0.5
  • Coin 2 lands on "Heads" with a probability of 0.7 and "Tails" with a probability of 0.3
  • If Coin 1 is "Heads", a score of -1 is obtained; if Coin 1 is "Tails", a score of +1 is obtained
  • If Coin 2 is "Heads", a score of -3 is obtained; if Coin 1 is "Tails", a score of +4 is obtained

In this game, Player 1 always starts first - Player 1 chooses either Coin 1 or Coin 2, flips the coin that they select and gets a "score". Then, Player 2 chooses either Coin 1 or Coin 2, flips the coin that they select and get a "score". The Player with the higher score wins, the Player with the lower score loses (a "tie" is also possible).

I wrote the R code to simulate this game being played 100 times:

score_coin_1 = c(-1,1)

score_coin_2 = c(-3, 4)


results <- list()

for (i in 1:100)

{

iteration = i


player_1_coin_choice_i = sample(2, 1, replace = TRUE)
player_2_coin_choice_i = sample(2, 1, replace = TRUE)

player_1_result_i = ifelse(player_1_coin_choice_i == 1, sample(score_coin_1, size=1, prob=c(.5,.5)),  sample(score_coin_2, size=1, prob=c(.7,.3)) )
player_2_result_i = ifelse(player_2_coin_choice_i == 1, sample(score_coin_1, size=1, prob=c(.5,.5)), sample(score_coin_2, size=1, prob=c(.7,.3)))

winner_i = ifelse(player_1_result_i > player_2_result_i, "PLAYER_1", ifelse(player_1_result_i == player_2_result_i, "TIE", "PLAYER_2"))

my_data_i = data.frame(iteration, player_1_coin_choice_i, player_2_coin_choice_i, player_1_result_i, player_2_result_i , winner_i )

 results[[i]] <- my_data_i

}



results_df <- data.frame(do.call(rbind.data.frame, results))

head(results_df)
  iteration player_1_coin_choice_i player_2_coin_choice_i player_1_result_i player_2_result_i winner_i
1         1                      1                      1                -1                 1 PLAYER_2
2         2                      1                      2                -1                -3 PLAYER_1
3         3                      2                      2                 4                -3 PLAYER_1
4         4                      1                      2                 1                -3 PLAYER_1
5         5                      2                      1                 4                 1 PLAYER_1
6         6                      2                      2                 4                -3 PLAYER_1

My Question: I now want to make a more "complicated version" of this game in which:

  • Player 1 flips 2 coins (e.g. random choice between : coin 1 coin 1 OR coin 1 coin 2 OR coin 1 coin 2 OR coin 2 coin 2) and records his score
  • Next, Player 2 flips 2 coins and records his score
  • Then, Player 1 flips 2 coins - records his score and adds it to his previous score
  • Finally, Player 2 flips 2 coins - records his score and adds it to his previous score
  • The player with the total highest score wins.

I was able to "extend" the above code for this modified version of the game above, but the code becomes very long and very complicated (the code also becomes "in stone" (fixed) for this specific set up) :

results <- list()

for (i in 1:100)

{

iteration = i

player_1_coin_choice_firstflip_turn_1_i = sample(2, 1, replace = TRUE)
player_1_coin_choice_secondflip_turn_1_i = sample(2, 1, replace = TRUE)

player_1_firstflip_result_turn_1_i = ifelse(player_1_coin_choice_firstflip_turn_1_i == 1, sample( LETTERS[1:2], 1, replace=TRUE, prob=c(0.5,0.5) ), sample( LETTERS[3:4], 1, replace=TRUE, prob=c(0.5,0.5) ))
player_1_secondflip_result_turn_1_i = ifelse(player_1_coin_choice_secondflip_turn_1_i == 1, sample( LETTERS[1:2], 1, replace=TRUE, prob=c(0.5,0.5) ), sample( LETTERS[3:4], 1, replace=TRUE, prob=c(0.5,0.5) ))

player_1_firstflip_result_turn_1_score_1_i = ifelse(player_1_firstflip_result_turn_1_i == "A", 0.5, ifelse(player_1_firstflip_result_turn_1_i == "B", 0.3, ifelse(player_1_firstflip_result_turn_1_i == "C", 0.3, 0.9)))
player_1_secondflip_result_turn_1_score_1_i = ifelse(player_1_secondflip_result_turn_1_i == "A", 0.5, ifelse(player_1_secondflip_result_turn_1_i == "B", 0.3, ifelse(player_1_secondflip_result_turn_1_i == "C", 0.3, 0.9)))

player_1_totalscore_turn_1_i = player_1_secondflip_result_turn_1_score_1_i + player_1_firstflip_result_turn_1_score_1_i

player_2_coin_choice_firstflip_turn_1_i = sample(2, 1, replace = TRUE)
player_2_coin_choice_secondflip_turn_1_i = sample(2, 1, replace = TRUE)

player_2_firstflip_result_turn_1_i = ifelse(player_2_coin_choice_firstflip_turn_1_i == 1, sample( LETTERS[1:2], 1, replace=TRUE, prob=c(0.5,0.5) ), sample( LETTERS[3:4], 1, replace=TRUE, prob=c(0.5,0.5) ))
player_2_secondflip_result_turn_1_i = ifelse(player_2_coin_choice_secondflip_turn_1_i == 1, sample( LETTERS[1:2], 1, replace=TRUE, prob=c(0.5,0.5) ), sample( LETTERS[3:4], 1, replace=TRUE, prob=c(0.5,0.5) ))

player_2_firstflip_result_turn_1_score_1_i = ifelse(player_2_firstflip_result_turn_1_i == "A", 0.5, ifelse(player_2_firstflip_result_turn_1_i == "B", 0.3, ifelse(player_2_firstflip_result_turn_1_i == "C", 0.3, 0.9)))
player_2_secondflip_result_turn_1_score_1_i = ifelse(player_2_secondflip_result_turn_1_i == "A", 0.5, ifelse(player_2_secondflip_result_turn_1_i == "B", 0.3, ifelse(player_2_secondflip_result_turn_1_i == "C", 0.3, 0.9)))

player_2_totalscore_turn_1_i = player_2_secondflip_result_turn_1_score_1_i + player_2_firstflip_result_turn_1_score_1_i

player_2_coin_choice_firstflip_turn_2_i = sample(2, 1, replace = TRUE)
player_2_coin_choice_secondflip_turn_2_i = sample(2, 1, replace = TRUE)

player_2_firstflip_result_turn_2_i = ifelse(player_2_coin_choice_firstflip_turn_2_i == 1, sample( LETTERS[1:2], 1, replace=TRUE, prob=c(0.5,0.5) ), sample( LETTERS[3:4], 1, replace=TRUE, prob=c(0.5,0.5) ))
player_2_secondflip_result_turn_2_i = ifelse(player_2_coin_choice_secondflip_turn_2_i == 1, sample( LETTERS[1:2], 1, replace=TRUE, prob=c(0.5,0.5) ), sample( LETTERS[3:4], 1, replace=TRUE, prob=c(0.5,0.5) ))

player_2_firstflip_result_turn_2_score_2_i = ifelse(player_2_firstflip_result_turn_2_i == "A", 0.5, ifelse(player_2_firstflip_result_turn_2_i == "B", 0.3, ifelse(player_2_firstflip_result_turn_2_i == "C", 0.3, 0.9)))
player_2_secondflip_result_turn_2_score_2_i = ifelse(player_2_secondflip_result_turn_2_i == "A", 0.5, ifelse(player_2_secondflip_result_turn_2_i == "B", 0.3, ifelse(player_2_secondflip_result_turn_2_i == "C", 0.3, 0.9)))

player_2_totalscore_turn_2_i = player_2_secondflip_result_turn_2_score_2_i + player_2_firstflip_result_turn_2_score_2_i

player_1_coin_choice_firstflip_turn_2_i = sample(2, 1, replace = TRUE)
player_1_coin_choice_secondflip_turn_2_i = sample(2, 1, replace = TRUE)

player_1_firstflip_result_turn_2_i = ifelse(player_1_coin_choice_firstflip_turn_2_i == 1, sample( LETTERS[1:2], 1, replace=TRUE, prob=c(0.5,0.5) ), sample( LETTERS[3:4], 1, replace=TRUE, prob=c(0.5,0.5) ))
player_1_secondflip_result_turn_2_i = ifelse(player_1_coin_choice_secondflip_turn_2_i == 1, sample( LETTERS[1:2], 1, replace=TRUE, prob=c(0.5,0.5) ), sample( LETTERS[3:4], 1, replace=TRUE, prob=c(0.5,0.5) ))


player_1_firstflip_result_turn_2_score_2_i = ifelse(player_1_firstflip_result_turn_2_i == "A", 0.5, ifelse(player_1_firstflip_result_turn_2_i == "B", 0.3, ifelse(player_1_firstflip_result_turn_2_i == "C", 0.3, 0.9)))
player_1_secondflip_result_turn_2_score_2_i = ifelse(player_1_secondflip_result_turn_2_i == "A", 0.5, ifelse(player_1_secondflip_result_turn_2_i == "B", 0.3, ifelse(player_1_secondflip_result_turn_2_i == "C", 0.3, 0.9)))

player_1_totalscore_turn_2_i = player_1_secondflip_result_turn_2_score_2_i + player_1_firstflip_result_turn_2_score_2_i

player_1_final_score_i = player_1_totalscore_turn_2_i + player_1_totalscore_turn_1_i

player_2_final_score_i = player_2_totalscore_turn_2_i + player_2_totalscore_turn_1_i

winner_i = ifelse(player_1_final_score_i > player_2_final_score_i, "PLAYER 1", ifelse( player_1_final_score_i == player_2_final_score_i, "TIE",  "PLAYER 2"))

my_data_i = data.frame(iteration, player_1_coin_choice_firstflip_turn_1_i , player_1_coin_choice_secondflip_turn_1_i , player_1_firstflip_result_turn_1_i ,
player_1_secondflip_result_turn_1_i , player_1_firstflip_result_turn_1_score_1_i , player_1_secondflip_result_turn_1_score_1_i , player_1_totalscore_turn_1_i ,
player_2_coin_choice_firstflip_turn_1_i , player_2_coin_choice_secondflip_turn_1_i , player_2_firstflip_result_turn_1_i , player_2_secondflip_result_turn_1_i ,
player_2_firstflip_result_turn_1_score_1_i , player_2_secondflip_result_turn_1_score_1_i , player_2_totalscore_turn_1_i , player_2_coin_choice_firstflip_turn_2_i ,
player_2_coin_choice_secondflip_turn_2_i , player_2_firstflip_result_turn_2_i , player_2_secondflip_result_turn_2_i ,
player_2_firstflip_result_turn_2_score_2_i , player_2_secondflip_result_turn_2_score_2_i , player_2_totalscore_turn_2_i ,
player_1_coin_choice_firstflip_turn_2_i ,player_1_coin_choice_secondflip_turn_2_i , player_1_firstflip_result_turn_2_i ,player_1_secondflip_result_turn_2_i ,
player_1_firstflip_result_turn_2_score_2_i ,player_1_secondflip_result_turn_2_score_2_i ,player_1_totalscore_turn_2_i ,player_1_final_score_i , player_2_final_score_i ,winner_i )

 results[[i]] <- my_data_i

}


#final results of 100 random iterations
results_df <- data.frame(do.call(rbind.data.frame, results))

I am wondering if there is a more "efficient" way to write the code for this simulation that "adapts" to different requirements. For instance, suppose I specify in advance (there will be no more than 2 coins):

  • The probability of Heads/Tails for Coin 1 and Coin 2
  • The score associated with Coin 1 and Coin 2
  • The number of "turns" the game lasts (e.g. in the first example the game lasts for "1 turn", in the second example the game lasts for "2 turns") - e.g. suppose I want the game to last for 3 turns

Is there a way to "adapt" my code I have written so that it can easily accommodate different numbers of turns, probabilities and scores?

Thanks!

Hi there,

This was a fun challenge.

I did take the liberty to completely rewrite the code but made comments at every step. I did check if the correct probabilities were used, but please verify because it's easy to make a mistake and mess up the game :slight_smile:

#Set.seed for reproducibility
set.seed(1)

#Set the coins
coins = data.frame(
  coin = 1:2,
  hProb = c(0.5, 0.7), #Chance of heads
  hScore = c(-1, -3), #Score when heads
  tScore = c(1,4) #Score when tails
)
nCoins = nrow(coins)

#Set the players
players = list(
  player = 1:2,
  cProb = list(c(0.5,0.5), c(0.5,0.5)) #Chance of picking a specific coin
)
nPlayers= length(players$player)

#Choose number of rounds and tosses per round
nRounds = 3
nTosses = 2

#Play the game
game = lapply(1:nRounds, function(round){
  
  #Let each player play
  newRound = lapply(1:nPlayers, function(player){
    
    #Randomly pick nCoins with cProb
    toss = coins[sample(1:nCoins, nTosses, replace = T,
                        prob = players$cProb[[player]]),]
    #Get the toss score based on hProb 
    toss$score = ifelse(toss$hProb >= runif(nTosses), toss$hScore, toss$tScore)
    #Add player and round info
    toss$player = players$player[player]
    toss$round = round
    
    #Return the data from this round
    return(toss[,c("round","player", "coin", "score")])
    
  })
  
  #Bind the data from all players this round together
  return(do.call(rbind, newRound))
  
})

#Bind the data from all rounds this game together
game = do.call(rbind, game)

game
#>     round player coin score
#> 2       1      1    2    -3
#> 2.1     1      1    2     4
#> 21      1      2    2     4
#> 1       1      2    1     1
#> 12      2      1    1    -1
#> 22      2      1    2    -3
#> 3       2      2    1     1
#> 4       2      2    2    -3
#> 13      3      1    1    -1
#> 1.1     3      1    1     1
#> 11      3      2    1     1
#> 23      3      2    2    -3

Created on 2022-03-03 by the reprex package (v2.0.1)

Hope this helps,
PJ

1 Like

Thank you SO much! This does exactly what I want! Is it possible to loop this code so that 100 games are played and who wins in each game? Thank you!

1 Like

I am trying to adapt your code so that it plays 100 games and records the winner after each game in a new column:

for i in (1:100) {

#Play the game
game_i = lapply(1:nRounds, function(round){
  
  #Let each player play
  newRound = lapply(1:nPlayers, function(player){
    
    #Randomly pick nCoins with cProb
    toss = coins[sample(1:nCoins, nTosses, replace = T,
                        prob = players$cProb[[player]]),]
    #Get the toss score based on hProb 
    toss$score = ifelse(toss$hProb >= runif(nTosses), toss$hScore, toss$tScore)
    #Add player and round info
    toss$player = players$player[player]
    toss$round = round
    
    #Return the data from this round
    return(toss[,c("round","player", "coin", "score")])
    
  })
  
  #Bind the data from all players this round together
  return(do.call(rbind, newRound))
  
})

#Bind the data from all rounds this game together
game_i = do.call(rbind, game_i)

player_score_i =   data.frame(game_i %>% 
  group_by(player) %>% 
  summarise(sum= sum(score)))

game_i$winner_i = ifelse(player_score_i[1.1] > player_score_i[1.2], "PLAYER 1", ifelse(player_score_i[1.1] 
 == player_score_i[1.2], "TIE", "PLAYER 2"))

game_i$game_number_i = i

}

I will keep working on this to see if it is possible!

Thank you for all your help!

1 Like

Hi there,

This can simply be done my adding yet another loop (sapply) to the game, now playing multiple games

#Set.seed for reproducibility
set.seed(1)

#Set the coins
coins = data.frame(
  coin = 1:2,
  hProb = c(0.5, 0.7), #Chance of heads
  hScore = c(-1, -3), #Score when heads
  tScore = c(1,4) #Score when tails
)
nCoins = nrow(coins)

#Set the players
players = list(
  player = c("player1", "player2"),
  cProb = list(c(0.5,0.5), c(0.5,0.5)) #Chance of picking a specific coin
)
nPlayers= length(players$player)

#Choose number of games, rounds and tosses per round
nRounds = 2
nTosses = 2
nGames = 3

#Play the game multiple times
allGames = lapply(1:nGames, function(game){
  
  #Play a single game
  newGame = lapply(1:nRounds, function(round){
    
    #Let each player play
    newRound = lapply(1:nPlayers, function(player){
      
      #Randomly pick nCoins with cProb
      toss = coins[sample(1:nCoins, nTosses, replace = T,
                          prob = players$cProb[[player]]),]
      #Get the toss score based on hProb 
      toss$score = ifelse(toss$hProb >= runif(nTosses), toss$hScore, toss$tScore)
      #Add player and round info
      toss$player = players$player[player]
      toss$round = round
      
      #Return the data from this round
      return(toss[,c("round","player", "coin", "score")])
      
    })
    
    #Bind the data from all players this round together
    return(do.call(rbind, c(newRound, make.row.names = F)))
    
  })
  
  #Bind the data from all rounds this game together
  newGame = do.call(rbind, c(newGame, make.row.names = F))
  newGame$game = game
  return(newGame)
  
})

#Bind data from all games
allGames = do.call(rbind, c(allGames, make.row.names = F))
#Make game column first
allGames = allGames[,c(ncol(allGames), 1:(ncol(allGames)-1))]

allGames
#>    game round  player coin score
#> 1     1     1 player1    2    -3
#> 2     1     1 player1    2     4
#> 3     1     1 player2    2     4
#> 4     1     1 player2    1     1
#> 5     1     2 player1    1    -1
#> 6     1     2 player1    2    -3
#> 7     1     2 player2    1     1
#> 8     1     2 player2    2    -3
#> 9     2     1 player1    1    -1
#> 10    2     1 player1    1     1
#> 11    2     1 player2    1     1
#> 12    2     1 player2    2    -3
#> 13    2     2 player1    2    -3
#> 14    2     2 player1    2    -3
#> 15    2     2 player2    1    -1
#> 16    2     2 player2    2    -3
#> 17    3     1 player1    2     4
#> 18    3     1 player1    2    -3
#> 19    3     1 player2    1     1
#> 20    3     1 player2    2    -3
#> 21    3     2 player1    1     1
#> 22    3     2 player1    1     1
#> 23    3     2 player2    1    -1
#> 24    3     2 player2    1    -1

Created on 2022-03-03 by the reprex package (v2.0.1)

I also added the make.row.names = F argument to the do.call function to get rid of the rownames and avoid conflict when binding games together

If you like to get the winner per game from this table, you can use the following code

library(tidyverse)

results = allGames %>% group_by(game, player) %>% 
  summarise(score = sum(score), .groups = "drop") %>% 
  group_by(game) %>% 
  summarise(
    winner = paste(player[score == max(score)], collapse = ","),
    score = max(score),
    .groups = "drop"
  )

results
#> # A tibble: 3 x 3
#>    game winner          score
#>   <int> <chr>           <dbl>
#> 1     1 player2             3
#> 2     2 player1,player2    -6
#> 3     3 player1             3

Note that this time I did use the Tidyverse (dplyr functions) to get the summary stats. I avoided them in the original game because it seemed you were not familiar with them, but I highly recommend you check them out if you want to do easy data manipulation.

PJ

2 Likes

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.