White Elephant

white_elephant.R

# White elephant gift exchange                                                                                                                                                 
#                                                                                                                                                                              
# Rules:                                                                                                                                                                       
# 1) N players each bring one gift                                                                                                                                             
# 2) Each round, a player                                                                                                                                                      
# 3) Gifts can not be stolen more than three times each                                                                                                                        
# 4) Gifts cannot be stolen more than once per round                                                                                                                           
#                                                                                                                                                                              
# Assumptions:                                                                                                                                                                 
# 1) Each player has a                                                                                                                                                         
# 2) Players steal with probability p = (number of gifts taken) / N                                                                                                            
# 3) Players steal the gift of maximal utility to them                                                                                                                         
                                                                                                                                                                               
# Maximum number of steals per gift                                                                                                                                            
kMaxSteals <- 3                                                                                                                                                                
                                                                                                                                                                               
# Weight given to each gift's utility relative to person/gift level noise                                                                                                      
gift.utility.weight <- 0.5                                                                                                                                                     
                                                                                                                                                                               
N <- 2                                                                                                                                                                         
                                                                                                                                                                               
# Matrix of utilities: rows are players, columns are gifts                                                                                                                     
gift.utility <- runif(N)                                                                                                                                                       
utility.matrix <- matrix((gift.utility * gift.utility.weight) +                                                                                                                
                         (runif(N ^ 2) * (1 - gift.utility.weight)),                                                                                                           
                         N, N, byrow=T)                                                                                                                                        
colnames(utility.matrix) <- paste("Gift", 1:N)                                                                                                                                 
rownames(utility.matrix) <- paste("Player", 1:N)                                                                                                                               
                                                                                                                                                                               
ChooseGift <- function(player, utility.matrix, gifts) {                                                                                                                        
  # Function for a single player to choose a White Elephant gift (one round)                                                                                                   
  #                                                                                                                                                                            
  # Logic for a single turn is as follows:                                                                                                                                     
  #   1) Player will choose an unopened gift with probability                                                                                                                  
  #      p = (number of gifts taken) / N                                                                                                                                       
  #   2) If player chooses an unopened gift, they will choose one at random                                                                                                    
  #   3) If player chooses to steal, they will steal their favorite gift                                                                                                       
  #      of those that have not been stolen this round                                                                                                                         
  #                                                                                                                                                                            
  # Args:                                                                                                                                                                      
  #   person: Person # taking the turn                                                                                                                                         
  #   utility.matrix: utility matrix with persons in rows and gifts as columns                                                                                                 
  #   gifts: data.table for each gift's state. Includes columns for                                                                                                            
  #          1) gift.id                                                                                                                                                        
  #          2) is.visible                                                                                                                                                     
  #          3) steals (number of steals)                                                                                                                                      
  #          4) stolen.this.round                                                                                                                                              
  #          5) is.choosable                                                                                                                                                   
  #          6) owner.id                                                                                                                                                       
  #          7) is.stealable                                                                                                                                                   
  #                                                                                                                                                                            
  # Return:                                                                                                                                                                    
  #   List with two elements:        
  #   1) gifts, an updated data.table of all gifts                                                                                                                             
  #   2) stealee, the ID of the player from whom the gift was stolen.                                                                                                          
  #      NA if player didn't steal.                                                                                                                                            
                                                                                                                                                                               
  # Calculate stealing probability                                                                                                                                             
  prob.steal <- gifts[, sum(is.stealable) / sum(is.choosable)]                                                                                                                 
  # Generate a random number to determine whether the player will steal                                                                                                        
  will.steal <- (runif(1) < prob.steal)                                                                                                                                        
                                                                                                                                                                               
  if(will.steal) {                                                                                                                                                             
    # If they steal, choose their favorite                                                                                                                                     
    # Vector of gift utilities for current player                                                                                                                              
    player.gift.utilities <- utility.matrix[player, ]                                                                                                                          
    # Maximum utility for player                                                                                                                                               
    max.stealable.utility <-                                                                                                                                                   
      max(player.gift.utilities[gifts[is.stealable == T]$gift.id])                                                                                                             
    # Corresponding gift                                                                                                                                                       
    chosen.gift <- which(player.gift.utilities == max.stealable.utility)                                                                                                       
    # Find stealee                                                                                                                                                             
    stealee <- gifts[chosen.gift]$owner.id                                                                                                                                     
    # Alter gift record                                                                                                                                                        
    gifts[chosen.gift, stolen.this.round := T]                                                                                                                                 
    gifts[chosen.gift, steals := steals + 1]                                                                                                                                   
  } else {                                                                                                                                                                     
    # Otherwise choose a random invisible gift                                                                                                                                 
    invisible.gifts <- gifts[is.na(owner.id)]$gift.id                                                                                                                          
    chosen.gift <- sample(invisible.gifts, 1)                                                                                                                                  
    stealee <- NA                                                                                                                                                              
  }                                                                                                                                                                            
                                                                                                                                                                               
  gifts[chosen.gift, owner.id := player]                                                                                                                                       
                                                                                                                                                                               
  return(list(gifts=gifts, stealee=stealee))                                                                                                                                   
}                                                                                                                                                                              
                                                                                                                                                                               
IsChoosable <- function(steals, stolen.this.round)                                                                                                                             
  return(steals < kMaxSteals & !stolen.this.round)                                                                                                                             
                                                                                                                                                                               
IsStealable <- function(is.choosable, owner.id)                                                                                                                                
  return(is.choosable & !is.na(owner.id))                                                                                                                                      
                                                                                                                                                                               
Play <- function(utility.matrix) {                                                                                                                                             
  # Play full game of White Elephant                                                                                                                                           
  #                                                                                                                                                                            
  # Turns are taken until the gift unwrapped last is chosen                                                                                                                    
  #                                                                                                                                                                            
  # Args:                                                                                                                                                                      
  #   utility.matrix: utility matrix with persons in rows and gifts as columns                                                                                                 
  #                                                                                                                                                                            
  # Return:                                                                                                                                                                    
  #   data.table representing the N gifts and their owners   
                                                                                                                                                                              
  N <- nrow(utility.matrix)                                                                                                                                                    
                                                                                                                                                                               
  # Initialize gifts data.table                                                                                                                                                
  gifts <- data.table(gift.id=1:N,                                                                                                                                             
                      steals=0,                                                                                                                                                
                      stolen.this.round=F,                                                                                                                                     
                      owner.id=as.integer(NA))                                                                                                                                 
  gifts[, is.choosable := IsChoosable(steals, stolen.this.round)]                                                                                                              
  gifts[, is.stealable := IsStealable(is.choosable, owner.id)]                                                                                                                 
  # Initialize stealee                                                                                                                                                         
  stealee <- NA                                                                                                                                                                
  # Initialize number of unopened gifts                                                                                                                                        
  unopened.gift.count <- N                                                                                                                                                     
                                                                                                                                                                               
  # Continue while at least one gift remains unopened                                                                                                                          
  while(unopened.gift.count > 0) {                                                                                                                                             
    # Assign current.player and reset stolen.this.round for new rounds                                                                                                         
    is.first.round <- (unopened.gift.count == N)                                                                                                                               
    if(is.first.round) {                                                                                                                                                       
      # Player 1 plays first round                                                                                                                                             
      current.player <- as.integer(1)                                                                                                                                          
    } else if(is.na(stealee)) {                                                                                                                                                
      # If not a steal, move to next player in queue                                                                                                                           
      gift.owners <- gifts[!is.na(owner.id)]$owner.id                                                                                                                          
      current.player <- max(gift.owners) + as.integer(1)                                                                                                                       
      # Also reset all stolen.this.round field for all gifts, as this                                                                                                          
      # constitutes a new round                                                                                                                                                
      gifts[, stolen.this.round := F]                                                                                                                                          
    } else {                                                                                                                                                                   
      # If gift was stolen, assign current.player to stealee                                                                                                                   
      current.player <- stealee                                                                                                                                                
    }                                                                                                                                                                          
                                                                                                                                                                               
    turn.outcome <- ChooseGift(current.player, utility.matrix, gifts)                                                                                                          
    gifts <- turn.outcome$gift                                                                                                                                                 
    stealee <- turn.outcome$stealee                                                                                                                                            
                                                                                                                                                                               
    gifts[, is.choosable := IsChoosable(steals, stolen.this.round)]                                                                                                            
    gifts[, is.stealable := IsStealable(is.choosable, owner.id)]                                                                                                               
    unopened.gift.count <- sum(is.na(gifts$owner.id))                                                                                                                          
  }                                                                                                                                                                            
  return(gifts)                                                                                                                                                                
}