Last year I made a blog post about a Secret Santa picker HERE, but to use it required quite a bit of messing around with the code. So this year I decided to improve the whole thing by making it a function rather than a script. The function take two inputs, a list of names and a number of names. The code for the function is listed first followed by the code for the script used to call the function.
Here’s the function. Nothing needs to be changed in this code for it to run properly.
# make a function
secret_santa <-function(npeople, names){
# this 'flag' is used to determine if the
# function stays in or out of the while function
flag = "bad"
# first list of names
namelist1 = matrix(names, ncol = 1, nrow = npeople)
fam = matrix(ncol = 1, nrow = npeople, NA)
while (flag == "bad"){
# names to choose from
namelist2 = matrix(ncol = 1, nrow = npeople, NA)
for (i in 1:npeople){
#pick the first name
if (i==1){
xx2 = sample(names, (npeople-i+1), replace=FALSE)
} else
xx2 = sample(xx2, (npeople-i+1), replace=FALSE)
if (i == npeople & xx2[1]==namelist1[i,1]){
flag = "bad"
}else if(xx2[1]!= namelist1[i,1]){
namelist2[i,1] = xx2[1]
flag = "good"
} else{
namelist2[i,1] = xx2[2]
flag = "good"
}
#set up the new matrix with one less name
used = which(xx2==namelist2[i])
xx2[used] = "zzzzz"
xx2 = sort(xx2)[1:(npeople-i)]
}
#flag
#add "has" to the matrix
has = matrix(ncol=1, nrow = npeople, "has")
#build the final matrices
final = cbind(namelist1, has, namelist2)
#the final results
#final
}
final
}
Save this function as “secret-santa-function.R” and we’ll call it from our script. Okay, now let’s make our script.
# call the function from the script
source("secret-santa-function.R")
### Function input
### make a list of names
names = c("James","Nick","Emily","Natasha","Bob", "Teddy")
n = length(names)
#call the function
output <-secret_santa(n, names)
output The list of names is the only input needed. In the case above it’s ‘names = c(“James”,”Nick”,”Emily”,”Natasha”,”Bob”, “Teddy”)’. The other variable the function needs is the number of names, which is read automatically from the length function. That’s it, you’re done. Call the function from the script and you’ve got your names.
The Practical R 
Hey, great article. Just one observation to improve:
There’s no code that prevents that the gift exchange cycle closes before it ends.
For example:
If A has B, B has X and X has A…. you have to get the C, D, E, F to play in another circle of gifts.
How would you fix that?
And is it possible to also add like a rule where A can’t have B and viceversa. C and D can’t be an exchange as well… and so on (so it can work with big families and couples can help pick gifts lol).
It would be GREAT!
LikeLike
Bernardo the gift exchange cycle should close after it has looped through all the names. If you enter a list of 10 names, you’ll get an output matching 10 names, just make sure ‘n’ gets updated after the names are updated.
As to your second point, I agree that would be great. I haven’t tried that yet, but it would be cool (and a bit more complicated).
LikeLike
Your function is far too complicated. All you have to do is sample from your names list while excluding the person you’re matching and existing matches.
secret_santa <- function(names){
n = length(names)
match = NULL
for(i in 1:n){
match=c(match,sample(names[!(names %in% c(names[i],match))],1))
}
cbind(names,match)
}
names = c('A','B','C','D','E','F')
output = secret_santa(names)
output
LikeLiked by 2 people
I’m sure it was fun to code the function. Another way to do it would be to randomize the order of the Santas, and then everyone gets the next person in the list.
set.seed(1)
santas <- c("James","Nick","Emily","Natasha","Bob", "Teddy")
random_santas <- sample(santas)
paste(random_santas, "has", "random_santas[c(2:length(random_santas), 1)])
You can put the output into sort if you want to make it in alphabetical order:
sort(paste(random_santas, "has", "random_santas[c(2:length(random_santas), 1)]))
LikeLike