Creating a "Prisoner's Dilemma Table" in R-CodePudding

I am working with the R programming language. I created the following "game" in R which involves two players flipping coins (the result of each coin is associated with a "score") to see who gets the highest score:

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

I then extracted the scores of all possible outcomes:

one_one <- results_df[which(results_df$player_1_coin_choice_i == 1 & results_df$player_2_coin_choice_i == 1), ]
one_two <- results_df[which(results_df$player_1_coin_choice_i == 1 & results_df$player_2_coin_choice_i == 2), ]
two_one <- results_df[which(results_df$player_1_coin_choice_i == 2 & results_df$player_2_coin_choice_i == 1), ]
two_two <- results_df[which(results_df$player_1_coin_choice_i == 2 & results_df$player_2_coin_choice_i == 2), ]

 library(dplyr)
    
    one_one_sum = data.frame(one_one %>% 
      group_by(winner_i) %>% 
      summarise(n = n()))
    
    one_two_sum = data.frame(one_two %>% 
      group_by(winner_i) %>% 
      summarise(n = n()))
    
    two_one_sum = data.frame(two_one %>% 
      group_by(winner_i) %>% 
      summarise(n = n()))
    
    two_two_sum = data.frame(two_two %>% 
      group_by(winner_i) %>% 
      summarise(n = n()))

From here, I want to make this kind of table ("Prisoner's Dilemma":

Here, "Coin 1, Coin 1" means Player 1 chose Coin 1 and Player 2 also chose Coin 1 - "Coin 2, Coin 1" means Player 1 chose Coin 2 and Player 1 chose Coin 1, etc.

My Question: Is it possible to "directly" make this table in R? Currently, I am creating this table in Microsoft Excel and Powerpoint - but is possible to make this table directly in R?

Thanks!

CodePudding user response：

Not sure exactly how you want the payoffs you calculate to translate into the payoff matrix, but here's a way you could do it with ggplot2. Note that the input is a list that has elements ll, lr, ul, ur for the payoffs that apply to win, lose and tie in the lower-left, lower-right, upper-left and upper-right quadrants. If the vector of payoffs has only two values, the Tie label will not be printed. Here's an example:

library(ggplot2)

payoffs <- list(ul=c(1,2,3), ll = c(3,2,1), ur = c(4,5,6), lr = c(6,5,4))

pd_game <- function(payoffs, ...){
  ## payoffs should have elements ll, lr, ul, ur for lower-left
  ## lower-right, upper-left and upper-right quadrant payoffs
require(ggplot2)
g <- ggplot()   
  geom_segment(aes(y=0, yend=0, x=.15, xend=1))   
  geom_segment(aes(y=.4, yend=.4, x=.2, xend=1))   
  geom_segment(aes(y=.8, yend=.8, x=.15, xend=1))   
  geom_segment(aes(y=0, yend=1, x=.3, xend=.3))   
  geom_segment(aes(y=0, yend=.95, x=.65, xend=.65))   
  geom_segment(aes(y=0, yend=1, x=1, xend=1))   
  geom_text(aes(x=.15, y=.2, label="Coin 1, Coin 2"), hjust=0)   
  geom_text(aes(x=.15, y=.6, label="Coin 1, Coin 1"), hjust=0)   
  geom_text(aes(x=.475, y=.9, label="Coin 2, Coin 1"), hjust=0.5)   
  geom_text(aes(x=.825, y=.9, label="Coin 2, Coin 2"), hjust=0.5)   
  geom_text(aes(x=.4, y=.275, label=paste0("Win: ", payoffs$ll[1])), hjust=0)   
  geom_text(aes(x=.4, y=.2, label=paste0("Lose: ", payoffs$ll[2])), hjust=0)   
  geom_text(aes(x=.75, y=.275, label=paste0("Win: ", payoffs$lr[1])), hjust=0)   
  geom_text(aes(x=.75, y=.2, label=paste0("Lose: ", payoffs$lr[2])), hjust=0)   
  geom_text(aes(x=.4, y=.675, label=paste0("Win: ", payoffs$ul[1])), hjust=0)   
  geom_text(aes(x=.4, y=.6, label=paste0("Lose: ", payoffs$ul[2])), hjust=0)   
  geom_text(aes(x=.75, y=.675, label=paste0("Win: ", payoffs$ur[1])), hjust=0)   
  geom_text(aes(x=.75, y=.6, label=paste0("Lose: ", payoffs$ur[2])), hjust=0)   
  geom_text(aes(x=.1, y=.4, label="Player 1"), hjust=0)   
  geom_text(aes(x=.65, y=1, label="Player 2"), hjust=0.5)   
  theme_void()

if(length(payoffs$ul) == 3){
  g <- g   geom_text(aes(x=.4, y=.525, label=paste0("Tie: ", payoffs$ul[3])), hjust=0) 
    
}
if(length(payoffs$lr) == 3){
  g <- g   geom_text(aes(x=.75, y=.125, label=paste0("Tie: ", payoffs$lr[3])), hjust=0) 
}
if(length(payoffs$ll) == 3){
  g <- g   geom_text(aes(x=.4, y=.125, label=paste0("Tie: ", payoffs$ll[3])), hjust=0)    
}
if(length(payoffs$ur) == 3){
  g <- g geom_text(aes(x=.75, y=.525, label=paste0("Tie: ", payoffs$ur[3])), hjust=0)    
}
g
}

pd_game(payoffs)