R help - Dec 2015 - Coding your Secret Santa in R!

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!