«

»

Dec 13

Use R to choose your secret santa partner

Ok, so you want to choose your secret santa partners, but you can’t find a hat? Well, here is an R Script that can swoop in to your rescue.

This isn’t the most elegant or efficient code, but unless you have a really huge family it won’t take long to run.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
ChooseSS = function(people, avoidmatch){
	permuteMyPeople = function(peeps){
		PeepsPermuted = sample(peeps)
		if(any(peeps==PeepsPermuted)){
			PeepsPermuted = permuteMyPeople(peeps)
		}
		return(PeepsPermuted)
	}
	cbindMyPermutedPeople = function(peeps){
		cbind(p1=people, p2=permuteMyPeople(people))
	}
	ret = cbindMyPermutedPeople(people)
	m1 = sapply(avoidmatch, match, ret[,1])
	m2 = sapply(avoidmatch, match, ret[,2])
	while(any(m1[1,]==m2[2,])|any(m1[2,]==m2[1,])){
		ret = cbindMyPermutedPeople(people)
		m1 = sapply(avoidmatch, match, ret[,1])
		m2 = sapply(avoidmatch, match, ret[,2])
	}
	ret
}

And, you can run it with this “example” family:

1
2
3
4
5
6
set.seed(2011)
family = c('Dick', 'Bonnie', 'Suzy', 'Jeff', 'Amy', 'Mike',
	'Kindy','Gene','Emily','Joe', 'Courtney', 'Meghann')
avoidmatch = list(c('Mike', 'Amy'), c('Suzy', 'Jeff'), c('Courtney', 'Meghann'),
	c('Dick', 'Bonnie'))
ChooseSS(family, avoidmatch)

Permanent link to this article: http://geneorama.com/use-r-to-choose-your-secret-santa-partner/

Leave a Reply

Your email address will not be published. Required fields are marked *

You may use these HTML tags and attributes: <a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <s> <strike> <strong>