Solving the Santa Claus Problem with Conjunction

The Santa Claus problem is a concurrency problem that, like the Dining Philosophers problem, can be used to demonstrate your particular concurrency framework of choice. December seems like the right time of year to post a CHP solution that I hacked up at the CPA 2008 conference last year. It’s short but rather primitive. Here’s the statement of the problem, via Simon Peyton Jones (who made an STM solution in a chapter of Beautiful Code):

Santa repeatedly sleeps until wakened by either all of his nine reindeer, back from their holidays, or by a group of three of his ten elves. If awakened by the reindeer, he harnesses each of them to his sleigh, delivers toys with them and finally unharnesses them (allowing them to go off on holiday). If awakened by a group of elves, he shows each of the group into his study, consults with them on toy R&D and finally shows them each out (allowing them to go back to work). Santa should give priority to the reindeer in the case that there is both a group of elves and a group of reindeer waiting.

The particularly tricky aspects of this problem are:

1. Santa must make a choice between the reindeer and elves.
2. Santa must give priority to the reindeer.
3. The elves must come in groups of exactly three, even though there are ten of them.

Choice is easy in CHP, so the first item is not a problem. We saw in the last post how to emulate priority, so we can use that to solve the second point. The third item is difficult. Our barriers require all enrolled participants to synchronise, so we cannot use one barrier for all ten elves. We could introduce some intermediary agents to coordinate the elves, but that is a bit long-winded. Instead we can take a slightly brute-force approach combined with a CHP feature called conjunction.

Conjunction

The principle behind conjunction is straightforward. Usually you offer a choice such as read from channel c or read from channel d: readChannel c <-> readChannel d. This waits for the first of the two events, and executes it (it can never execute both options). A conjunction is when you want to read from channel c and read from channel d: readChannel c <&> readChannel d. Crucially, this will only read from both when both are available. If c is not ready, it will not read from d, and vice versa. It is both or none: an atomic item, if you like. Conjunction also has a list form, every.

One example of where this is useful is the aforementioned Dining Philosophers problem: a philosopher wishing to pick up his forks should execute syncBarrier leftFork <&> syncBarrier rightFork. That way he will either pick up both his forks or neither, thus eliminating the deadlock wherein each philosopher ends up holding one fork.

Conjunction Specifics

It is valid to offer conjunction as part of a choice; for example, (readChannel c <&> readChannel d) <-> readChannel e will wait to read from channels (c AND d) OR e. These choices can be overlapping, e.g. (readChannel c <&> readChannel d) <-> (readChannel d <&>readChannel e) waits for (c AND d) OR (d AND e).

The choices should be in disjunctive normal form (DNF): OR on the outside, AND in the bracket, so c AND (d OR e) is not valid. But AND does distribute over OR here, so this is equivalent to the DNF: (c AND d) or (c AND e). (The operators do not distribute in the opposite direction, so c OR (d AND e) is not equivalent to (c OR d) AND (c OR e), because the latter allows c and e to both happen, whereas the former does not.)

Conjunction and Barriers

Importantly for today’s post, there is a correspondence between barriers (N participants, all N must synchronise together) and a conjunction of two-party barriers. Let’s imagine for a moment that Santa wanted to meet with all ten of his elves. We could create a single barrier, enroll Santa and the ten elves, and get them all to synchronise on the barrier. The barrier would only complete when all eleven participants synchronised. But alternatively, we could create ten two-party barriers. We would enroll each elf on a different barrier, and enroll Santa on all of them. When they want to meet, the elves would all synchronise on their barrier (meaning their code is unchanged), while Santa would wait for the conjunction of all ten barriers. Each barrier would only complete when all of them complete, because of Santa waiting for the conjunfction of all of them, so we have the same semantics as we had when we had one barrier. These ten barriers would be dynamically fused into one barrier.

The Solution

Santa does not want to wait for all ten elves; he only wants to wait for three. We can implement this with a little brute-force. Labelling the elves A through J, we can make Santa wait for (A AND B AND C) OR (A AND B AND D) OR… (H AND I AND J). That’s 120 possibilities. Not scalable, but the problem said ten elves so that’s all we have to manage.

Let’s finally get to some code. A reindeer waits for a random time, then synchronises on its barrier (i.e. tries to meet with Santa). An elf waits for a random time, then synchronises on its barrier (i.e. tries to meet with Santa). So, perhaps unexpectedly, a reindeer has exactly the same code as an elf. (This is also the case in Peyton Jones’ solution). Here it is:

syncDelay :: EnrolledBarrier -> CHP ()
syncDelay b = forever (randomDelay >> syncBarrier b)
  where
    randomDelay = (liftIO $ randomRIO (500000, 1000000)) >>= waitFor

reindeer :: EnrolledBarrier -> CHP ()
reindeer = syncDelay

elf :: EnrolledBarrier -> CHP ()
elf = syncDelay

Our next job is to write the Santa process. Santa will take one barrier for the reindeer, and multiple barriers for the elves (one each). He will loop forever, first polling the reindeer (to give them priority) and otherwise choosing between the reindeer and the elves:

santa :: [EnrolledBarrier] -> EnrolledBarrier -> CHP ()
santa elfBars reindeerBar
  = forever (deliverToys </> (skip >> (deliverToys <-> meetThreeElves)))
  where

Now we need to define the helper processes. Delivering toys is straightforward; we just synchronise with the reindeer. The rest of the code deals with picking all groups of three elves, and making a choice between synchronising with each group:

    deliverToys = syncBarrier reindeerBar

    meetThreeElves = alt [meetGroup g | g <- allGroupsThreeElves]
    meetGroup bars = every_ [syncBarrier bar | bar <- bars]

    allGroupsThreeElves = allNFrom 3 elfBars
    allNFrom n = filter ((== n) . length) . filterM (const [True, False])

The allNFrom is not important here, so I’ve used a concise (but probably inefficient) definition. Now that we have santa, our elves and our reindeer, all that remains is to put them together. To do this we use two wiring helper functions, enrollAll (that enrolls all of the processes on the given barrier) and enrollOneMany (that enrolls one process on all the barriers, and each of the other processes on one):

main :: IO ()
main = runCHP_VCRTraceAndPrint $
  enrollOneMany
    (\elfBars ->
        enrollAll (newBarrierWithLabel "reindeer")
                  (santa elfBars : replicate 9 reindeer)
    )
    [(newBarrierWithLabel ("elf" ++ show n), elf) | n <- [0..9]]

That’s it. Part of the reason that this code is quite short is that I’ve omitted all the print statements detailing what is going on (for example in Peyton Jones’ version). These print statements were only there to observe the behaviour of the computation, and we can do that with CHP’s built-in traces mechanism, just by using the runCHP_VCRTraceAndPrint function.

View-Centric Reasoning (VCR) traces, developed by Marc L. Smith and subsequently tweaked a little bit by me, display an ordered list of multisets, where each multiset holds independent events (events that did not have a sequential dependency on each other). This style makes it very easy to see from the output that our Santa Claus solution has the right sort of behaviour, viz:

< {elf3, elf4, elf5}, {elf0, elf6, elf7}, {reindeer}, {elf1, elf8, elf9}, {elf2, elf4, elf7}, {elf0, elf1, elf3}, {elf5, elf8, elf9}, {reindeer}, {elf3, elf6, elf7}, {elf0, elf1, elf9}, {elf2, elf4, elf8}, {reindeer}, {elf3, elf5, elf6}, {elf0, elf4, elf9}, {elf1, elf2, elf7}, {elf5, elf6, elf8}, {reindeer}, {elf0, elf1, elf3}, {elf4, elf7, elf9}, {elf2, elf5, elf8}, {elf0, elf1, elf6}, {reindeer}, {elf3, elf7, elf9}, {elf0, elf1, elf4}, {elf2, elf6, elf8}, {elf5, elf7, elf9}, {elf0, elf3, elf4}, {reindeer}, {elf1, elf2, elf6}, {elf5, elf7, elf8}, ...

---

Concise Solution

For those who like a bit of code golf (finding the shortest version of a program), I came up with this concise version of the whole solution:

import Control.Concurrent.CHP
import Control.Concurrent.CHP.Traces
import Control.Monad
import Control.Monad.Trans
import System.Random

santa elves reindeer = forever $
  syncBarrier reindeer </> (alt $ map (every_ . map syncBarrier) groups)
  where groups = filter ((== 3) . length) $ filterM (const [True, False]) elves

main = runCHP_VCRTraceAndPrint $ enrollOneMany (enrollAll
  (newBarrierWithLabel "reindeer") . (: replicate 9 syncDelay) . santa)
  [(newBarrierWithLabel ("elf" ++ show n), syncDelay) | n <- [0..9]]
  where syncDelay = forever . (randomDelay >>) . syncBarrier
        randomDelay = (liftIO $ randomRIO (500000, 1000000)) >>= waitFor

Excluding the import statements, that’s a solution to the Santa Claus problem in eight lines of Haskell. Rather difficult-to-follow Haskell, but that’s usually the result of code golf.