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="<bastien111...@yandex.com>",
Isa="<isabelle111...@gmail.com>",
John="<john111...@gmail.com>",
Sylvie="<sylvie111...@hotmail.com>",
Cath="<lomb111...@gmail.com>", Rob="<rp111...@gmail.com>",
Matt="<matt111...@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("<bastien111...@yandex.com>", list.email[[tirage[i,"giver"]]],
"Secret Santa des Lombardo!", body,
control=list(smtpServer="relais.videotron.ca"))
}
### It's all done!
______________________________________________
R-help@r-project.org mailing list -- To UNSUBSCRIBE and more, see
https://stat.ethz.ch/mailman/listinfo/r-help
PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
and provide commented, minimal, self-contained, reproducible code.
