Last week at Thanksgiving, my family drew names from a hat for our annual game
of Secret Santa. Actually, it wasn’t a hat but you know what I mean. (Now that I
think about it, I don’t think I’ve ever seen names drawn from a literal hat
before!) In our family, the rules of Secret Santa are pretty simple:
The players’ names are put in “a hat”.
Players randomly draw a name from a hat, become that person’s Secret Santa,
and get them a gift.
If a player draws their own name, they draw again.
Once again this year, somebody asked if we could just use an app or a website to
handle the drawing for Secret Santa. Or I could write a script to do it I
thought to myself. The problem nagged at the back of my mind for the past few
days. You could just shuffle the names… no, no, no. It’s trickier than that.
In this post, I describe a couple of algorithms for Secret Santa sampling using
R and directed graphs. I use the
DiagrammeR package which creates graphs from dataframes of nodes and edges, and I liberally use dplyr verbs to manipulate tables of edges.
If you would like a more practical way to use R for Secret Santa, including
automating the process of drawing names and emailing players, see this blog post.
Making a graph, connecting nodes twice
Let’s start with a subset of my family’s game of just five players. I assign
each name a unique ID number.
library(DiagrammeR)
library(magrittr)
library(dplyr, warn.conflicts = FALSE)
players 2-__5
1
Jeremy2
TJ3
Jonathan4
Alex5
MarissaBefore the game starts, anyone could draw anyone else’s name, so let’s visualize
all possible gives-to relations. We can do this by using combn(n, 2) to
generate all n-choose-2 pairs and creating two edges for each pair.
combn(players$Name, 2)
#__ [,1] [,2] [,3] [,4] [,5] [,6] [,7] #__ [1,] &quot;Jeremy&quot; &quot;Jeremy&quot; &quot;Jeremy&quot; &quot;Jeremy&quot; &quot;TJ&quot; &quot;TJ&quot; &quot;TJ&quot; #__ [2,] &quot;TJ&quot; &quot;Jonathan&quot; &quot;Alex&quot; &quot;Marissa&quot; &quot;Jonathan&quot; &quot;Alex&quot; &quot;Marissa&quot;
#__ [,8] [,9] [,10] #__ [1,] &quot;Jonathan&quot; &quot;Jonathan&quot; &quot;Alex&quot; #__ [2,] &quot;Alex&quot; &quot;Marissa&quot; &quot;Marissa&quot;
# All the edge-manipulating functions in this post take an optional take `...`
# argument for setting the style of edges.
create_all_giving_edges 1-__2
1-__3
1-__4
1-__5
2-__1
2-__3
2-__4
2-__5
3-__1
3-__2
3-__4
3-__5
4-__1
4-__2
4-__3
4-__5
5-__1
5-__2
5-__3
5-__4
1
Jeremy2
TJ3
Jonathan4
Alex5
MarissaA fast, simple solution is a Hamiltonian path
Do you need to organize a gift-giving drawing for a group of people? The easiest
solution is to shuffle the names and have the first name give to the second name,
the second to the third, and so on with last name giving looping back around to
the first name. This solution is equivalent to walking through the graph and
visiting every node just once. Such a path is called a Hamiltonian path.
Here we find a Hamiltonian path and create a helper function overwrite_edges()
to update the edges that fall on the path.
overwrite_edges %
anti_join(new_df, by = c(&quot;from&quot;, &quot;to&quot;)) %__%
bind_rows(new_df)
}
create_hamiltonian_gift_edges %0
1-__2
1-__3
1-__4
1-__5
2-__1
2-__3
2-__4
2-__5
3-__1
3-__2
3-__4
3-__5
4-__1
4-__2
4-__3
4-__5
5-__1
5-__2
5-__3
5-__4
1
Jeremy2
TJ3
Jonathan4
Alex5
MarissaAs promised, the red paths loop through all nodes exactly once. No one is their
own gift giver :white_check_mark:, and everyone has an incoming red path
:white_check_mark: and an outgoing red path :white_check_mark:. Very nice. Actually… let’s put that checklist into a validation function.
# Check for valid gift-giving edges
has_valid_gift_edges % render_graph(title = &quot;Selected vs. illegal&quot;)
%0
Selected vs. illegal1-__2
1-__3
1-__4
1-__5
2-__1
2-__3
2-__4
2-__5
3-__1
3-__2
3-__4
3-__5
4-__1
4-__2
4-__3
4-__5
5-__1
5-__2
5-__3
5-__4
1
Jeremy2
TJ3
Jonathan4
Alex5
MarissaWe delete those illegal edges and leaving us with the following graph.
edges_after_pick1 %
overwrite_edges(current_pick %__% mutate(arrowsize = NULL)) %__% anti_join(current_illegal_edges, by = &quot;id&quot;) create_graph(nodes, edges_after_pick1) %__% render_graph(title = &quot;After one draw&quot;)
%0
After one draw1-__2
1-__3
1-__4
1-__5
2-__1
3-__2
3-__4
3-__5
4-__2
4-__3
4-__5
5-__2
5-__3
5-__4
1
Jeremy2
TJ3
Jonathan4
Alex5
MarissaThe name has been removed from the hat, and the graph is simpler now!
Let’s do it again. Draw a random legal edge (fat arrow) and identify all the illegal paths (navy).
current_pick % draw_secret_santa_edge(
rel = &quot;gives-to&quot;, color = &quot;#FF4136&quot;, penwidth = 1,
arrowsize = 1)
current_illegal_edges %
find_illegal_edges(edge = current_pick, color = &quot;#001f3f&quot;, penwidth = .5)
edges_after_pick1 %__%
overwrite_edges(current_pick) %__% overwrite_edges(current_illegal_edges) %__% create_graph(nodes, .) %__% render_graph(title = &quot;Selected vs. illegal&quot;)
%0
Selected vs. illegal1-__2
1-__3
1-__4
1-__5
2-__1
3-__2
3-__4
3-__5
4-__2
4-__3
4-__5
5-__2
5-__3
5-__4
1
Jeremy2
TJ3
Jonathan4
Alex5
MarissaAfter deleting illegal edges, the problem simplifies further.
edges_after_pick2 %
overwrite_edges(current_pick %__% mutate(arrowsize = NULL)) %__% anti_join(current_illegal_edges, by = &quot;id&quot;) create_graph(nodes, edges_after_pick2) %__% render_graph(title = &quot;After two draws&quot;)
%0
After two draws1-__2
1-__4
1-__5
2-__1
3-__2
3-__4
3-__5
4-__3
5-__2
5-__4
1
Jeremy2
TJ3
Jonathan4
Alex5
MarissaYou can tell where this is going… Loop Town!
To finish up, we are going to repeat this process until there are only
gift-giving edges left. We will control the loop with this helper function which tells us if there are any free edges remaining.
has_free_edge % nrow()
edges_left != 0
}
In the function below, the while-loop does the same steps as above: Randomly
selecting a free edge and removing illegal edges.
draw_edges_from_hat % rename(to_fam = Family) %__% select(-Name) %__% select(id, from, to, rel, from_fam, to_fam, everything())
nibling_edges
#__ # A tibble: 132 x 8
#__ id from to rel from_fam to_fam penwidth color
#__ #__ 1 1 1 2 potential-gift Water Water 0.5 #CCCCCC90
#__ 2 2 1 3 potential-gift Water Electric 0.5 #CCCCCC90
#__ 3 3 1 4 potential-gift Water Plant 0.5 #CCCCCC90
#__ 4 4 1 5 potential-gift Water Plant 0.5 #CCCCCC90
#__ 5 5 1 6 potential-gift Water Plant 0.5 #CCCCCC90
#__ 6 6 1 7 potential-gift Water Fighting 0.5 #CCCCCC90
#__ 7 7 1 8 potential-gift Water Fighting 0.5 #CCCCCC90
#__ 8 8 1 9 potential-gift Water Normal 0.5 #CCCCCC90
#__ 9 9 1 10 potential-gift Water Normal 0.5 #CCCCCC90
#__ 10 10 1 11 potential-gift Water Psychic 0.5 #CCCCCC90
#__ # ... with 122 more rows
In the graph below, we draw an olive edge to connect edge pair of siblings.
These edges are illegal before we even start drawing names.
sibling_edges % filter(from_fam == to_fam) %__% mutate(
rel = &quot;sibling&quot;,
color = &quot;#3D9970&quot;, penwidth = 1)
# Update edges that represent siblings
nibling_edges % overwrite_edges(sibling_edges)
nibling_nodes % overwrite_edges(sibling_edges) %__% create_graph(nibling_nodes, .) %__% render_graph(height = 400)
%0
1-__2
1-__3
1-__4
1-__5
1-__6
1-__7
1-__8
1-__9
1-__10
1-__11
1-__12
2-__1
2-__3
2-__4
2-__5
2-__6
2-__7
2-__8
2-__9
2-__10
2-__11
2-__12
3-__1
3-__2
3-__4
3-__5
3-__6
3-__7
3-__8
3-__9
3-__10
3-__11
3-__12
4-__1
4-__2
4-__3
4-__5
4-__6
4-__7
4-__8
4-__9
4-__10
4-__11
4-__12
5-__1
5-__2
5-__3
5-__4
5-__6
5-__7
5-__8
5-__9
5-__10
5-__11
5-__12
6-__1
6-__2
6-__3
6-__4
6-__5
6-__7
6-__8
6-__9
6-__10
6-__11
6-__12
7-__1
7-__2
7-__3
7-__4
7-__5
7-__6
7-__8
7-__9
7-__10
7-__11
7-__12
8-__1
8-__2
8-__3
8-__4
8-__5
8-__6
8-__7
8-__9
8-__10
8-__11
8-__12
9-__1
9-__2
9-__3
9-__4
9-__5
9-__6
9-__7
9-__8
9-__10
9-__11
9-__12
10-__1
10-__2
10-__3
10-__4
10-__5
10-__6
10-__7
10-__8
10-__9
10-__11
10-__12
11-__1
11-__2
11-__3
11-__4
11-__5
11-__6
11-__7
11-__8
11-__9
11-__10
11-__12
12-__1
12-__2
12-__3
12-__4
12-__5
12-__6
12-__7
12-__8
12-__9
12-__10
12-__11
1
Squirtle2
Wartortle3
Pikachu4
Bulbasaur5
Ivysaur6
Venusaur7
Machamp8
Machoke9
Ratata10
Raticate11
Mew12
MewtwoThe solution for this trickier, more constrained version of the problem is to
delete the illegal edges beforehand so that they can never be drawn from the
hat. After that, the same algorithm works as before.
nibling_edges %__% filter(rel != &quot;sibling&quot;) %__% draw_edges_from_hat(color = &quot;#FF4136&quot;) %__% create_graph(nibling_nodes, .) %__% render_graph(height = 500)
#__ Warning: Invalid drawing. Trying again.
#__ Warning: Invalid drawing. Trying again.
%0
1-__4
2-__6
3-__9
4-__3
5-__11
6-__8
7-__1
8-__12
9-__7
10-__2
11-__10
12-__5
1
Squirtle2
Wartortle3
Pikachu4
Bulbasaur5
Ivysaur6
Venusaur7
Machamp8
Machoke9
Ratata10
Raticate11
Mew12
Mewtwo
Like usual, I’m not sure how to close one of these blog posts. I guess: When a
problem involves relations among individuals, always consider whether there is a
graph hiding in the background. Even the simple process of drawing names from a
hat for Secret Santa describes a graph: a graph of gift-giving relations among
individuals. This graph wasn’t obvious to me until I thought about Hamilitonian path solution. Hey, wait a minute, that’s a big gift-giving circle! It’s like some kind of network… ooooooh.