R: Secret Snowflake Matcher

Here is the very short script I used to generate matches for the 2017 Secret Snowflake game being played between the first and second year PhD students.

It is modified from a framework written by David Roberts.

PhD Students: I’ve replaced all the parts that could be used to reverse-engineer the actual list of matches with toy data, but you can still prove to yourself that the process is random. Or you could work on your finals.

##### Pull in List of Names #####
nam <- cbind.data.frame(name = c("SnowWhite", "Doc", "Dopey", "Bashful",
"Grumpy", "Sneezy", "Sleepy", "Happy"),
allergies = c(rep("NA", times = 8)))

##### Add Exceptions #####

nam[nam$name=="Doc", "except"] <- "Dopey"
nam[nam$name=="SnowWhite", "except"] <- "Sneezy"
nam[nam$name=="Dopey", "except"] <- "Sneezy"
nam[nam$name=="Sleepy", "except"] <- "Bashful"

nam$except[is.na(nam$except)] <- 0

##### Run the Draw #####

# set.seed(54321)

# Assign everyone to their own gift to initialize
nam[c("BuysFor")] <- nam[c("name")]

# Run Random Assignment until Exception Conditions are Met

repeat{
# make random picks
picks           <- sample(1:nrow(nam), replace = F)
# Assign names based on random picks
nam[,"BuysFor"] <- nam$name[picks]
# Test the except condition
nam$ExceptFail   <- apply(nam[c("BuysFor", "except")],
1, function(x){
                                        ifelse(x[1]==x[2], 1, 0)
})
# Test the self-assignment condition
nam$SelfFail <- apply(nam[c("BuysFor", "name")],
1, function(x){
                                     ifelse(x[1]==x[2], 1, 0)
})
# break iff exceptions and self-assignment are successfully avoided
if(sum(nam$ExceptFail)==0 && sum(nam$SelfFail)==0){
break
}
}
### Generate master List of Matches ###
master <- cbind.data.frame(nam$name,
                           nam$BuysFor,
                           allergies = nam$allergies[match(nam$BuysFor, nam$name)])
# I add allergies because I wanted to create the full dataset I'd need
# to send match emails in one step

Warnings

The Exception system as two important caveats:

  1. Avoidance is not reciprocal. In the toy example above, the sampler will redraw if “Doc” is assigned to buy a gift for “Dopey,” but will accept “Dopey” buying a gift for “Doc.”
  2. Each name can only avoid one other name. If Doc’s except value is “Dopey,” the code as written above can’t also make Doc avoid Snow White. This can be fixed by adding more avoid columns (“Except2”, “Except3”, etc.) and placing one name in each. You would also have to add corresponding logical statements to the “break” condition in the sampler to make this work.

Extensions

The sampler can be modified quite easily to deal with group-based selection criteria. The David Roberts code (linked above) has one way to do this; what follows should be equally simple. Take for example an extended-family gift exchange, where you want to assign gift giving based on three conditions.

  1. No one should buy a gift for themselves
  2. Auntie June and Grandpa aren’t talking to each other; they shouldn’t be matched for the gift exchange.
  3. No one should buy a gift for another member of their nuclear family.

These first two conditions can be satisfied with the code above, so long as Auntie June isn’t fighting with so many people that more “Except” columns need to be created. The third condition can be solved by adding a column to the input data that indicates “Family,” and then adding a logical statement (basically, is the family value for observation “name” equal to the family value for observation “BuyFor”) to list of break conditions for the sampler.

I didn’t write up this last part (my extended family is using a no-gifts policy this year and that requires no randomizing), but the syntax used for this new condition should be similar to the syntax for the first two.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Google+ photo

You are commenting using your Google+ account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

w

Connecting to %s