Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
White Elephant
# 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)
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment