Day 4 – Quantum Secret Santa

Much has already been written about the relationship between Santa Claus and quantum mechanics.  This makes sense intuitively — Unobservable?  In multiple places at once? We only see the effects? It almost goes without saying that Santa is a macroscopic quantum phenomenon.

Similarly,  the game of secret santa has been analyzed by combinatorists and cryptographers for quite some time.  How many ways can people give gifts to each other? How can Alice and Bob and their friends have a decent protocol for their secret santa party?

But the application of quantum states as a practical solution to secret santa didn’t become evident to me until this holiday season. The situation was this: my family and I are hosting guests from out of town. We need to organize a secret santa gift exchange, but don’t want to impose gift giving or secrecy constraints on people who are coming from the same household. More explicitly:

1. Several households of people are coming to visit us.
2. Everyone needs to be assigned to give a gift to someone else.
3. Everyone needs to be given their assignments ahead of time.
4. Nobody should be assigned to someone within their household.

Sounds like a job for Perl 6!

Before getting to the solution, let’s go through some background and prerequisites for solving this.

First, quantum superpositions.

Way back in 2000, Damian Conway wrote Quantum::Superpositions for Perl 5. The cool idea here was that instead of dealing with qubits, we could deal with a macroscopic version — variables that have several values at the same time. This idea was then brought into Perl 6 in the form of junctions — logical superpositions of values  — a variable representing several values at once.  Such variables can be treated like a single value, but operators and methods apply to all the values (and can be autothreaded). The routines any, all, one and none turn a list of values into a junction.  Without even reading the documentation or thinking about quantum theory, though, these examples make sense if you just say them out loud:

say so (1, 2, 3).all < 4;  # True
say so (1, 2, 3).any < 3;  # True
say so (1, 2, 3).one < 2;  # True
say so (1, 2, 3).none > 10; # True

As in, “So,  1, 2 and 3 — all of them are less than 4?”

Multiple junctions can be part of an expression, for instance:

say so (1, 2, 3).all < (7, 8, 9).all;    # True
say so (1, 2, 3).all == (4, 5, 6).none;  # True

Think: all of 1, 2, and 3 are less than all of 7, 8, and 9?

By the way, so casts an expression to boolean.

The second prerequisite to solving our secret santa problem is set operations. Unicode characters that serve as set operators are really convenient here.

Basically, the Unicode set operators all work just as you would expect.  Quick — what do think is the output of these statements?

say so (2, 4) ⊂ (2, 4, 6);
say so 2 ∈ (1, 2);
say so 10..20 ⊆ 10..20;

Really, the only tricky thing here is how do you type ⊆, ∈, ⊂ and others on your keyboard?  (Answer: command-control-space on a mac,  control-K + “(” + “_” in vim. Actually, there’s a section of the perl6 documentation about this very topic.). These operators are defined on sets.  But also, using one of these operators on a List will automatically create a set.

The third thing to know about is the Z meta operator — this zips two things together.  The way in which the corresponding elements are combined is determined by a parameter — another operator (which is why it’s a meta operator).

say (1, 2, 3) Z+ (4, 5, 6)  # (5, 7, 9)
say (1, 2, 3) Z=> (4, 5, 6) # (1 => 4 2 => 5 3 => 6)

If Z is given =>, the pair constructor, it’ll make a list of pairs (which can be cast into a hash).

Okay — enough prerequisites.  Let’s write the program already!

my $groups = ( <comet cupid rudolph>, <dancer prancer>, <donner blitzen> );
my @santas = $groups.flat;
my %pairs;

repeat {
 %pairs = @santas Z=> @santas.permutations.pick;
} until %pairs.none.kv ⊆ $groups.any;

Oh, I almost forgot: permutations gives you a list of all permutations of a list.  Also pick returns a random element of a list.

Anyway, the hard part is done!  That clause in the until section works like this: %pairs.none returns a junction of pairs.  Calling kv on that junction makes a junction composed of two-element lists (keys and values of the pairs).  Meanwhile, $groups.any makes a junction of the list of lists. The subset operator, ⊆, then asserts that none of the elements of the left hand side are subsets of any of the elements of the right hand side.  i.e. none of the key-value pairs are subsets of any of the groups. Once again, writing it out in English is pretty similar to how it looks in Perl 6.

To notify everyone, we are going to send an email.  We put everyone’s email addresses into a hash:

my %emails =
   comet   => 'comet213@our.home',
   cupid   => 'cupid99@our.home',
   rudolph => 'rudolph101@our.home',
   dancer  => 'dancer99@reindeer.game',
   prancer => 'prancer1@reindeer.game',
   donner  => 'donner99@reindeer.party',
   blitzen => 'blitzen2@reindeer.party';

Then we can use run to use an external program — sendmail (or postfix, msmtp, or any similar mailer) — to send out the message.

for @santas.sort -> $santa {
    my $p = run '/usr/sbin/sendmail', %emails{$santa}, :in;
    $p.in.say: qq:to/END/;
       From: santa@north.pole
       To: { $santa.tc } <{ %emails{$santa} }>
       Subject: 🎅

       Dear { $santa.tc },

       Please get a gift for { %pairs{$santa}.tc }!
       END
 $p.in.close;
}

Notice that we use .tc to capitalize the name.  This stands for “title case” — a Unicode generalization of upper casing the first letter. For instance, a name like ʣenana (in which the first character is a single Unicode character — a digraph) would be properly title cased as Dzenana, not DZenana.

That’s it for the program — after showing everyone the complete program on github, even the least technical guest was quickly able to understand how it worked.  It ran smoothly and now everyone’s ready for the holidays!