Secret Santa Picker 2 using R

December 7, 2016
By

(This article was first published on The Practical R, and kindly contributed to R-bloggers)

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.

names

To leave a comment for the author, please follow the link and comment on their blog: The Practical R.

R-bloggers.com offers daily e-mail updates about R news and tutorials on topics such as: Data science, Big Data, R jobs, visualization (ggplot2, Boxplots, maps, animation), programming (RStudio, Sweave, LaTeX, SQL, Eclipse, git, hadoop, Web Scraping) statistics (regression, PCA, time series, trading) and more...



If you got this far, why not subscribe for updates from the site? Choose your flavor: e-mail, twitter, RSS, or facebook...

Comments are closed.

Search R-bloggers


Sponsors

Never miss an update!
Subscribe to R-bloggers to receive
e-mails with the latest R posts.
(You will not see this message again.)

Click here to close (This popup will not appear again)