R code your Secret Santa exchange

WordPress has issues with the code sometimes. Full working code here.

Remember when everyone in the office/family would gather around and pull little pieces of paper out of a hat with names on them to decide who buys a secret Christmas gift for whom? Remember when people used to write on paper? And wear fancy hats? Ah, the good ol’ days.

These days, we use sophisticated algorithms for just about everything, so why not for making our Secret Santa lists? 

This started with me making the random draws on behalf of my family (which isn’t secret, but same difference). Every year, everyone in the family buys a gift for one other person in the family. This could just be a totally random draw, but there are a few important considerations:

  1. Nobody should buy a gift for themselves (someone ALWAYS draws their own name, it seems). Let’s face it, you’re all going to buy yourself enough crap this year. You don’t need to do it at the family gift exchange too.
  2. Nobody should draw the name of their spouse or kids. Again, you’re going to buy crap for your own immediate family anyway, so let’s make sure that doesn’t happen in the exchange. Besides, imagine your wife opening her new Victoria’s Secret item at the Christmas dinner table. Awkward.
  3. We need the flexibility to FIX a draw if necessary. There’s always someone who already bought something perfect for someone in particular and needs to draw their name. Okay fine, but quit being so impulsive about your Christmas shopping.
  4. We need the flexibility to AVOID a draw if necessary. Yep, there’s always that one or two awkward relationships in every family or office. Christmas is about mending bridges and coming together in love and peace despite our differences. But remember that self-help book or Weight Watchers membership gift that so-and-so gave to so-and-so? That brought a chill to the Holiday cheer. Let’s avoid that again.

Okay, those guidelines in mind, let’s get started. If there’s any redeeming value to this post, maybe it’s as a demonstration of how to use a while statement in R: something I didn’t use for a long time because I didn’t know it existed.

Let’s start by building some fake data. This is in the form of a data table containing all the names of the people in your office/family. We also need a column to identify families (or other groups) within which we don’t want any gift exchanging.

## Make list of 20 names from 4 families.
dat <- data.frame(Name=paste0("Name",1:20),
                  Family=paste0("Family",rep(1:4,each=5)))

Now, we’ll add our FIX and AVOID exceptions. Remember that you can’t fix a ‘BuyFor’ within the same family/group or the loop will never solve.

## Add the fixes and avoids
# Name3 has already bought 'the perfect gift' for Name17
# Name5 has already bought 'the perfect gift' for Name12
dat[dat$Name=="Name3","FIX"] <- "Name17"
dat[dat$Name=="Name5","FIX"] <- "Name12"
# Name9 and Name2 are not on speaking terms
dat[dat$Name=="Name9","AVOID"] <- "Name2"
# Name14 has bought for Name20 for 3 years in a row and needs a change 
dat[dat$Name=="Name14","AVOID"] <- "Name20"

Okay, time to make the random draw. This is pretty much a brute force approach to this problem, where the loop just continually runs over and over again until it hits a solution that meets all criteria. The exception here are the fixes, which we do manually at the start. Obviously, the more conditions you add (particularly with smaller lists), the longer this may take to solve. Notice that, to start, we have to add the ‘BuysFor’ (the name of the person to buy for) and ‘BuyFamily’ (the family/group of the BuysFor person) at the start, otherwise the while statement will skip the loop. To start, we’ll set everyone to buy their own gift to ensure that the loop is repeated.

# Set the random seed if you want your list to be reproducible
set.seed(2187)

# Assign everyone to but their own gift & assign the group/family of the gift receiver
dat[c("BuysFor","BuyFamily")] <- dat[c("Name","Family")]

# Set the fixed rows (BuyFor and BuyFamily column)
dat[!is.na(dat$FIX),"BuysFor"] <- dat[!is.na(dat$FIX),"FIX"]
dat[!is.na(dat$FIX),"BuyFamily"] <- dat$Family[match(dat[!is.na(dat$FIX),"FIX"],dat$Name)]

# Make logical (T/F) column of whether a person is buying for their own family
dat$FamilyMatch <- apply(dat[c("BuyFamily","Family")], 1, function(x) x[1]==x[2])

# Run the random assignment until the conditions are met
while(sum(dat$FamilyMatch, na.rm=T)>0 | sum(dat$AvoidFail, na.rm=T)>0){
  # Make random picks
  ranpicks <- sample(1:sum(is.na(dat$FIX)), replace=F)
  # Assign names and families for non-fix rows based on random picks
  dat[is.na(dat$FIX),"BuysFor"] <- dat$Name[!dat$Name %in% dat$FIX][ranpicks]
  dat[is.na(dat$FIX),c("BuysFor","BuyFamily")] <- dat[c("Name","Family")][!dat$Name %in% dat$FIX,][ranpicks,]
  # Logical test: buying for same family
  dat$FamilyMatch <- apply(dat[c("BuyFamily","Family")], 1, function(x) x[1]==x[2])
  # Logical test: buying for AVOID person
  dat$AvoidFail <- apply(dat[c("BuysFor","AVOID")], 1, function(x) x[1]==x[2])
}

And there we have it.

dat

   Name   Family  FIX    AVOID  BuysFor BuyFamily FamilyMatch AvoidFail
1  Name1  Family1 <NA>   <NA>   Name7   Family2   FALSE       NA
2  Name2  Family1 <NA>   <NA>   Name8   Family2   FALSE       NA
3  Name3  Family1 Name17 <NA>   Name17  Family4   FALSE       NA
4  Name4  Family1 <NA>   <NA>   Name10  Family2   FALSE       NA
5  Name5  Family1 Name12 <NA>   Name12  Family3   FALSE       NA
6  Name6  Family2 <NA>   <NA>   Name14  Family3   FALSE       NA
7  Name7  Family2 <NA>   <NA>   Name19  Family4   FALSE       NA
8  Name8  Family2 <NA>   <NA>   Name13  Family3   FALSE       NA
9  Name9  Family2 <NA>   Name2  Name18  Family4   FALSE       FALSE
10 Name10 Family2 <NA>   <NA>   Name3   Family1   FALSE       NA
11 Name11 Family3 <NA>   <NA>   Name16  Family4   FALSE       NA
12 Name12 Family3 <NA>   <NA>   Name5   Family1   FALSE       NA
13 Name13 Family3 <NA>   <NA>   Name9   Family2   FALSE       NA
14 Name14 Family3 <NA>   Name20 Name2   Family1   FALSE       FALSE
15 Name15 Family3 <NA>   <NA>   Name20  Family4   FALSE       NA
16 Name16 Family4 <NA>   <NA>   Name4   Family1   FALSE       NA
17 Name17 Family4 <NA>   <NA>   Name6   Family2   FALSE       NA
18 Name18 Family4 <NA>   <NA>   Name11  Family3   FALSE       NA
19 Name19 Family4 <NA>   <NA>   Name15  Family3   FALSE       NA
20 Name20 Family4 <NA>   <NA>   Name1   Family1   FALSE       NA

With a huge list, you could add an extra step where the random sample draws only from rows outside the native family/group. That would probably speed things up, but I didn’t try it.

I also thought it might be cool to set up a script that would automatically email out to all the people on the list with their BuyFor name. This way, even the person running the script would have the option not to look at the results (i.e. would still not know who’s buying for them). This can in theory be done easily with the mailR or sendmailR packages. That would look something like this…if you can get it to work (I couldn’t. Help me out!)

# Install the sendmailR package
install.packages('sendmailR')
library(sendmailR)
# Add some hypothetical email addresses to our data
dat$Email <- paste0("Name",1:20,"@MyMailServer.com")
# LOOP to send all the emails
for(i in 1:nrow(dat)){
  sendmail(from="SENDER@gmail.com",
           to=paste(dat$Email[i]),
           subject="Secret Santa!",
           body=paste0("Hi ",dat$Name[i],". ","Please buy a gift for ",dat$BuysFor[i],". Thanks!"),
           smtp=list(host.name="smtp.gmail.com",
                     user.name="SENDER",
                     passwd="PASSWORD",
                     port=465, ssl=T),
           authenticate=T,
           send=T)
}

Happy Holidays!

Advertisements
This entry was posted in R, Uncategorized and tagged , , , . Bookmark the permalink.

8 Responses to R code your Secret Santa exchange

  1. David says:

    Obviously the code as provided has never worked so no-one on your list received an Xmas present. Shame!

    Like

    • roder1 says:

      I’ll assume you’re referring to the last piece of code (email automation), which I stated straight up didn’t work, as everything else seems to work fine. If you can troubleshoot the email code, that would be helpful. Otherwise, you’re off my Christmas list!

      Like

  2. Mike says:

    There is a problem here
    # Set the fixed rows (BuyFor and BuyFamily column)
    dat[!is.na(dat$FIX),”BuysFor dat[!is.na(dat$FIX),”FIX
    dat[!is.na(dat$FIX),”BuyFamily dat$Family[match(dat[!is.na(dat$FIX),”FIXt$Name)]

    Like

    • roder1 says:

      Yeah, looks like another encoding or copy/paste issue here. Here’s the difference between what I get when I copy/paste and the lines you pasted into the comment.

      MY COPY/PASTE VERSION:
      # Set the fixed rows (BuyFor and BuyFamily column)
      dat[!is.na(dat$FIX),”BuysFor”] <- dat[!is.na(dat$FIX),"FIX"]
      dat[!is.na(dat$FIX),"BuyFamily"] <- dat$Family[match(dat[!is.na(dat$FIX),"FIX"],dat$Name)]

      YOUR VERSION:
      # Set the fixed rows (BuyFor and BuyFamily column)
      dat[!is.na(dat$FIX),”BuysFor dat[!is.na(dat$FIX),”FIX
      dat[!is.na(dat$FIX),”BuyFamily dat$Family[match(dat[!is.na(dat$FIX),”FIXt$Name)]

      So something odd is happening here (quotes are messed up and some characters are dropped. As a solution, I'll post a .R file of the source code at the top of the page (and will do this from now on, because these issues are super annoying). Thanks again for pointing it out.

      Like

  3. Mike says:

    and here while(sum(dat$FamilyMatch, na.rm=T)>0sum(dat$AvoidFail, na.rm=T)>0

    Like

    • roder1 says:

      There should be an OR operator in that line: while(sum(dat$FamilyMatch, na.rm=T)>0 | sum(dat$AvoidFail, na.rm=T)>0).
      It appears on my version of the post. Maybe not coming in when you copy/paste?

      Like

  4. Mike says:

    Yeah all kinds of problems. Think you need to repaste things in.

    Like

    • roder1 says:

      Thanks Mike. I’ve copy/pasted the entire code again and run it and it works fine (for me, running Chrome on Win8 and Firefox on OSX). I do see that there are some discrepancies between what I see/copy and the issues you’ve identified. Any reason the encoding would appear different on different OS or browsers? E.g. the OR operator in the WHILE statement.

      Like

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 )

Twitter picture

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

Facebook photo

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

Google+ photo

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

Connecting to %s