Every year my extended family does a "secret santa" gift exchange. Each person draws another person at random and then gets a gift for them. At first, none of my siblings were married, and so the draw was completely random. Then, as people got married, we added the restriction that spouses should not draw each others names. This restriction meant that we moved from using slips of paper on a hat to using a simple computer program to choose names. Then people began to complain when they would get the same person two years in a row, so the program was modified to keep some history and avoid giving anyone a name in their recent history. This year, not everyone was participating, and so after removing names, and limiting the number of exclusions to four per person, I had data something like this:

Name: **Spouse**, *Recent Picks*

Noah:** Ava**. *Ella, Evan, Ryan, John*

Ava: **Noah**, *Evan, Mia, John, Ryan*

Ryan: **Mia**, *Ella, Ava, Lily, Evan*

Mia: **Ryan**, *Ava, Ella, Lily, Evan*

Ella: **John**,* Lily, Evan, Mia, Ava*

John:** Ella**, *Noah, Lily, Ryan, Ava*

Lily: **Evan**, *John, Mia, Ava, Ella*

Evan: **Lily**,* Mia, John, Ryan, Noah*

This data can be stored as a nested list of strings for Maple:

(**) restrictions := [["Noah", ["Ava", "Ella", "Evan", "Ryan", "John"]],
["Ava", ["Noah", "Evan", "Mia", "John", "Ryan"]],
["Ryan", ["Mia", "Ella", "Ava", "Lily", "Evan"]],
["Mia", ["Ryan", "Ava", "Ella", "Lily", "Evan"]],
["Ella", ["John", "Ava", "Lily", "Evan", "Mia"]],
["John", ["Ella", "Lily", "Ryan", "Ava", "Noah"]],
["Lily", ["Evan", "John", "Mia", "Ava", "Ella"]],
["Evan", ["Lily", "Mia", "John", "Ryan", "Noah"]]];
(**) people := [seq(p[1], `in`(p, restrictions))];
(**) n := nops(people);

The quick and dirty code I used is something like this that below. It just simulates drawing names out of a hat and throwing away the whole draw and starting again if the restrictions are not met. When I ran it this year, I had to stop it after 10 minutes with no output (the code below stops after unsuccessfully trying n * n! random draws).

# Randomly Search For Match
foundmatch := false:
to n*(n!) while not foundmatch do
choice := Statistics:-Shuffle(people);
foundmatch := true;
for i to n do
if choice[i] = restrictions[i][1] then
foundmatch := false;
break; # my own name
end if;
if choice[i] in restrictions[i][2] then
foundmatch := false;
break; # a name in my history
end if;
end do; #check match
end do:
if foundmatch then
zip(`=`,people,choice);
else
"No Match Found";
end if;

Since it is completely random, I did not know for sure that there was no acceptable match, and that the program was just very unlucky. Maybe it would have been smarter to simulate drawing names one at a time and redrawing each until an acceptable name was found and only starting over if no acceptable matches remained. This program does not find a match either but it is still random, so it could also be getting very unlucky and missing a possible match.

# Randomly Match Each Name
foundmatch := false:
to (n!) while not foundmatch do
picked := {};
choice := NULL;
for i to n do
possibles := ([op({op(people)} minus picked minus {restrictions[i][1]
minus {op(restrictions[i][2])})]);
if nops(possibles) = 0 then
foundmatch := false;
break; # no match possible from here
end if;
p := RandomTools:-Generate(choose(possibles));
picked := picked union {p};
choice := choice, p;
foundmatch := true;
end do;
end do:
if foundmatch then
zip(`=`,people,[choice]);
else
"No Match Found";
end if;

Now, it would be possible to write a program to enumerate all possible matches, and if that collection were not empty, randomly choose a match. But, instead, I applied the GraphTheory package to the problem. A standard approach for this sort of thing is to create a bipartite graph with each person listed twice (once as a gifter once as giftee) with an edge representing each possible match. The following one line call builds such a graph using the first three letters of each name to label its gifter node and the same appended with a "2" for its gifter node.

(**) G := GraphTheory:-Graph({seq(seq({restrictions[i][1][1 .. 2], cat(p[1 .. 2], "2")},
`in`(p, `minus`({op(people)}, {restrictions[i][1], op(restrictions[i][2])}))),
i = 1 .. nops(restrictions))});
G := Graph 1: an undirected unweighted graph with 16 vertices and 16 edge(s)

Just looking at the graph, it is not obvious that there are no matches:

(**) GraphTheory:-DrawGraph(G, style = bipartite);

Fortunately, there is a command to search for the largest possible matching in a bipartite graph.

(**) B := GraphTheory:-BipartiteMatching(G);
B := 7, {{"Av", "El2"}, {"Av2", "Ev"}, {"El", "No2"}, {"Ev2", "Jo"},
{"Jo2", "Mi"}, {"Li", "Ry2"}, {"Li2", "No"}}

The 7 in the output means that the largest matching in the graph is 7 edges. Since we have 8 people, that means it is not possible to match the people given the restrictions! You can draw the matching, and see that it is, indeed, not full. Mia is not a giftee and Ryan is not a gifter.

(**) GraphTheory:-HighlightEdges(G, B[2]);
(**) GraphTheory:-DrawGraph(G, style = bipartite);

In this case, you can better see why it is not possible to generate a match by breaking the graph into its connected components.

(**) GraphTheory:-ConnectedComponents(G);
[["Av", "Av2", "El2", "Ev", "Ev2", "Jo", "Li2", "Mi2", "No"],
["El", "Jo2", "Li", "Mi", "No2", "Ry", "Ry2"]]
(**) GraphTheory:-InducedSubgraph(G, %[1]);
Graph 2: an undirected unweighted graph with 9 vertices and 8 edge(s)
(**) GraphTheory:-InducedSubgraph(G, %%[2]);
Graph 3: an undirected unweighted graph with 7 vertices and 8 edge(s)
(**) GraphTheory:-DrawGraph([%,%%],style=bipartite);

Here is a nicer version of this graph created using GraphTheory:-Export together with the GraphViz graph renderer.

The graph can split into two pieces: one with 4 gifters and 5 giftees and the other with 4 gifters and 3 giftees. When arranged this way, it is absolutely clear that there can be no match. Fortunately, Mia was very bad this year, and Ryan is short on cash, so this matching worked out just fine.

View 5480_SecretSanta.mw on MapleNet or Download 5480_SecretSanta.mw

View file details