[R] Coding your Secret Santa in R!

[Bastien.Ferland-Raymond at mffp.gouv.qc.ca]

Hello Everyone!

Christmas is coming and with it, gift exchange!  Every year, with my family, we draw names from a hat to decide who gives a gift to who.  Very basic and annoying method, as it doesn't prevent somebody to draw himself, to draw his/her partner, to draw years after years the same person and it forces to either have everybody at the same place at the same time to do the draw or have somebody to manage everything which with break the fun for him/her. 

This year, I decided it was time to upgrade and enter the 2.0 era for secret santa, I've coded it in R!

The principle is simple.  You enter the people names, the draw restrictions and the program randomly picks everyone secret santa and send them a email to tell them.  R is so great...

If you're interested, here is my code.  It's probably not optimal but it still works.  Part of the comments are in french, sorry about that.

Merry Christmas!
Bastien

####


####  code du tirage au sort pour les cadeaux de noel

###  set working directory
setwd("U:\\Dropbox\\Gestion familiale\\tirage Noël Lombardo")

### load required package (only if you want to send emails)
library(sendmailR)

### set the year (use later a little bit, could be more useful)
an <- 2015

### write a vector of all participants
#participants.2014 <- c("Bastien","Isa","Cath","Rob","Matt","Sylvie","John","Myriam","Yolande","Mike", "Audrey")    # if you want history
participants.2015 <- c("Bastien","Isa","Cath","Rob","Matt","Sylvie","John")

participants <- participants.2015       ## The one to use this year

###  If you want the code to send email, make a named list of the email address of participants
list.email <- c(Bastien="<bastien111111 at yandex.com>", Isa="<isabelle111111 at gmail.com>",
                John="<john111111 at gmail.com>", Sylvie="<sylvie111111 at hotmail.com>",
                Cath="<lomb111111 at gmail.com>", Rob="<rp111111 at gmail.com>",
                Matt="<matt111111 at gmail.com>")


###  You can add restrictions, i.e. people who can't give to other people.  Create as many as you want,
###  They are on the form of 2 columns matrix with the first column being the giver and the second column the receiver
###  In this case, there is 3 kinds of restrictions: 
###    1) you don't want to draw yourself
###    2) you don't want to draw your partner, girlfriend or boyfriend
###    3) you don't want to draw the same person as last year 

#1)
restiction.soismeme <- cbind(giver=participants,receiver=participants)                         

#2)
restriction.couple <- matrix(c("Bastien","Isa","Cath","Rob","Sylvie", "John","Mike","Audrey"),4,2,byrow=T)

#3) (restriction 2014 read on my hard drive last years restrictions, will not work on your computer)
#restriction.2013 <- matrix(c("Bastien","Sylvie", "Isa", "Bastien", "Matt", "Yolande","Rob","John","Cath","Rob"),5,2,byrow=T)
restriction.2014 <- cbind(unlist(strsplit(list.files("2014"),".txt")),as.character(unlist(sapply(list.files("2014", full.names=T),read.table))))

##  then you append (rbind) all the restrictions, the order matters!
restrictions <- rbind(restriction.couple,restriction.couple[,2:1],restiction.soismeme,restriction.2014)


###  I created a simple function validating the draw (making sure the draw isn't in the restrictions
###  this function is use latter in a "while" loop
valide.res <- function(paires, restric){
	any(apply(restric, 1, function(xx) all(paires==xx)))
}


###  Draw people as long as you have a restriction in the results
res=T
while(res==T){
tirage <- cbind(giver=sample(participants,length(participants)),receiver=sample(participants,length(participants)))
res <- any(apply(tirage,1,valide.res,restrictions))
}



###  This loop is run to output the draw results
###  It does 2 things:
###   1) save a text file named with the giver's name which contains the receiver's name 
###   2) send an email to the giver with the body of the message being the receiver's name
for(i in 1:nrow(tirage)){ 
  # 1) write text file
    write.table(tirage[i,"receiver"],file=paste0(an,"\\",tirage[i,"giver"],".txt"), quote=F,row.names=F, col.names=F)     
  # 2) send an email
    body <- list(paste0("Voici le résultat du tirage pour l'échange de cadeaux ", an, "!","  Vous avez pigé : "),
                 paste0("*** ",tirage[i,"receiver"]," ***"),
                 paste0("Bravo! et Joyeux Noël!"))
    sendmail("<bastien111111 at yandex.com>", list.email[[tirage[i,"giver"]]], "Secret Santa des Lombardo!", body, control=list(smtpServer="relais.videotron.ca"))
}


###  It's all done!