The Santa Claus Problem

Simon Peyton Jones, in "Beautiful Concurrency", [1] a chapter of Beautiful Code, presents the Santa Claus problem and a solution:

A well-known example is the so-called Santa Claus problem, originally attributed to Trono: [2]

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 gorup of elves and a group of reindeer waiting.

His solution is presented in Haskell, using Software Transactional Memory:

module Main where

import Control.Concurrent
import Control.Concurrent.STM
import System.Random

-- Gates

data Gate = MkGate Int (TVar Int)

newGate :: Int -> STM Gate
newGate n = do { tv <- newTVar 0; return (MkGate n tv) }

useGate :: Gate -> IO ()
useGate (MkGate n tv) = atomically (do { n_left <- readTVar tv; check (n_left > 0); writeTVar tv (n_left - 1) })

operateGate :: Gate -> IO ()
operateGate (MkGate n tv) = do atomically (writeTVar tv n)
                               atomically (do { n_left <- readTVar tv; check (n_left == 0) })

-- Groups

data Group = MkGroup Int (TVar (Int, Gate, Gate))

newGroup :: Int -> IO Group
newGroup n = atomically (do { g1 <- newGate n;
                              g2 <- newGate n;
                              tv <- newTVar (n, g1, g2);
                              return (MkGroup n tv) })

joinGroup :: Group -> IO (Gate, Gate)
joinGroup (MkGroup n tv) = atomically (do { (n_left, g1, g2) <- readTVar tv;
                                            check (n_left > 0);
                                            writeTVar tv (n_left - 1, g1, g2);
                                            return (g1, g2) })

awaitGroup :: Group -> STM (Gate,Gate)
awaitGroup (MkGroup n tv) = do (n_left, g1, g2) <- readTVar tv
                               check (n_left == 0)
                               new_g1 <- newGate n
                               new_g2 <- newGate n
                               writeTVar tv (n,new_g1,new_g2)
                               return (g1,g2)

-- Elves & reindeer

meetInStudy :: String -> IO ()
meetInStudy s = putStr (s ++ " meeting in the study\n")

deliverToys :: String -> IO ()
deliverToys s = putStr (s ++ " delivering toys\n")

helper1 :: Group -> IO () -> IO()
helper1 group task = do (in_gate, out_gate) <- joinGroup group
                        useGate in_gate
                        task
                        useGate out_gate

elf1      gp id = helper1 gp (meetInStudy ("Elf " ++ show id))
reindeer1 gp id = helper1 gp (deliverToys ("Reindeer " ++ show id))

forever :: IO () -> IO ()
forever act = do act
                 waitTime <- getStdRandom (randomR (1,1000000))
                 threadDelay waitTime
                 forever act

elf :: Group -> Int -> IO ThreadId
elf gp id = forkIO (forever (elf1 gp id))


reindeer :: Group -> Int -> IO ThreadId
reindeer gp id = forkIO (forever (reindeer1 gp id))

-- Santa

choose :: [(STM a, a -> IO ())] -> IO ()
choose choices = do act <- atomically (foldr1 orElse actions)
                    act
    where
      actions :: [STM (IO ())]
      actions = [ do { val <- guard; return (rhs val) } | (guard, rhs) <- choices ]

santa :: Group -> Group -> IO ()
santa elf_gp rein_gp = do putStr "----------\n"
                          choose [(awaitGroup rein_gp, run "deliver toys"),
                                  (awaitGroup elf_gp, run "meet in my study")]
    where
      run :: String -> (Gate,Gate) -> IO ()
      run what (in_gate, out_gate) = do putStr ("Ho! Ho! Ho! Let's " ++ what ++ "\n")
                                        operateGate in_gate; operateGate out_gate

-- Main

main = do elf_gp <- newGroup 3
          sequence [ elf elf_gp n | n <- [1..10]]
          rein_gp <- newGroup 9
          sequence [ reindeer rein_gp n | n <- [1..9]]
          forever (santa elf_gp rein_gp)

[2008-02-06: As liyang pointed out, I had a bug in my original re-typing of the Haskell solution, as presented on this page. Oddly, the second version that I was using when I was testing the two solutions and writing this page did not have that typo. I do not know how the bug got into this version, but I have fixed it now.]

Erlang

For comparison, I would like to present the first piece of Erlang code I have written:

-module(santa).
-export([main/0, elf/2, reindeer/2]).

-import(io, [fwrite/1, fwrite/2]).
-import(random, [uniform/1]).
-import(timer, [sleep/1]).
-import(lists, [map/2]).

%% Elves and Reindeer

useGate(Santa, Message) ->
    Santa ! Message,                            % Send announcement
    receive go -> true end.                     % Await acknowledgement

helper(Santa, Message, String, Id) ->
    useGate(Santa, { Message, self() }),        % Announce readiness
    fwrite(String, [Id]),
    useGate(Santa, done),                       % Announce completion
    sleep( uniform(1000) ),                     % Snooze
    helper(Santa, Message, String, Id).         % Lather, rinse, repeat

elf(Santa, Id) -> helper(Santa, elf, "Elf ~w meeting in the study~n", Id).
reindeer(Santa, Id) -> helper(Santa, deer, "Deer ~w delivering toys~n", Id).

%% Santa

operateGate(Helpers) ->                         % send 'go' acknowledgement
    map( (fun (Helper) -> Helper ! go end), Helpers ).

waitDone(N) -> if                               % wait for N 'done' messages
                   N > 0 -> receive done -> true end,
                            waitDone(N-1);
                   true -> true
               end.

doit(String, Helpers) ->                        % A meeting or toy delivery
    fwrite("Ho! Ho! Ho! Let's ~s!~n", [String]),
    operateGate(Helpers),
    waitDone(length(Helpers)),
    operateGate(Helpers).

handleHelper(N, Helpers, Message) ->            % Incoming!
    if
        length(Helpers) == N ->
            doit(Message, Helpers),
            [];
        true ->
            Helpers
    end.

santa(NElves,NDeer, E, D) ->
    %% The following receive expression implements the requirement
    %% that the deer be able to starve the elves.  Fairness can be
    %% achieved by removing it.
    receive
        {deer, EarlyDeer} ->
            NED = handleHelper(NDeer, [EarlyDeer|D], "deliver toys"),
            santa(NElves,NDeer,E,NED)
    after 0 -> true
    end,
    receive
        {elf, Elf} ->
            NE = handleHelper(NElves, [Elf|E], "meet in my study"),
            santa(NElves,NDeer,NE,D);
        {deer, Deer} ->
            ND = handleHelper(NDeer, [Deer|D], "deliver toys"),
            santa(NElves,NDeer,E,ND)
    end.

santa(NElves,NDeer) -> santa(NElves,NDeer, [], []).

%% main

main() ->
    [ spawn(santa, elf, [self(), X]) || X <- [1,2,3,4,5,6,7,8,9,10] ],
    [ spawn(santa, reindeer, [self(), X]) || X <- [1,2,3,4,5,6,7,8,9] ],
    santa(3,9).

I am sure a more experienced Erlang-ite would do better.

Erlang uses message passing for communication between threads, and to my eye leads to a more understandable solution. At least, it may not have the beauty of the Haskell code, but at least it has a certain native charm.

One significant difference is in the bias towards reindeer. Peyton Jones says,

The choice is made by the orElse, which first attempts to choose the reindeer (thereby giving them priority), and otherwise chooses the elves.

In the Erlang code, I had to specifically add a receive expression to allow the reindeer to starve the elves of Santa's attention; otherwise the priority would be decided by the message queue, fairly. My question is how to achieve fairness in the STM version?

Other Solutions

Googling shows that Nick Benton has a solution in Polyphonic C#: Jingle Bells: Solving the Santa Claus Problem in Polyphonic C#. This paper has an explicit discussion of the elf/reindeer priorities, along with some simple experimental analysis of the effect of the priorities. (I ought to do that.)

Also according to Google, Richard O'Keefe has another solution to the Santa Claus problem in Erlang, Erlang Eases Expediting Elves, Reduces Reindeer Rage. His solution is somewhat shorter than mine, and uses two "secretary" processes to manage the groups of reindeer and elves. On the other hand, it seems as simple and easy to read; we seem to have both come to the same conclusion.

Finally, Luke Gorrie (on Lambda the Ultimate!) presents a third Erlang solution along with a sketch of a Lisp simulation. I have not really analyzed this solution and I do not know if it handles the priorities complication, but it is relatively easy on the eyes.


[1]Simon Peyton Jones, "Beautiful Concurrency," in Beautiful Code: Leading Programmers Explain How They Think, edited by Andy Oram and Greg Wilson, O'Reilly Media, 2007.
[2]

J.A. Trono, "A new exercise in concurrency," SIGCSE Bulletin, Vol. 26, pp. 8-10, 1994. The full problem definition is:

Santa Claus sleeps in his shop up at the North Pole, and can only be wakened by either all nine reindeer being back from their year long vacation on the beaches of some tropical island in the South Pacific, or by some elves who are having some difficulties making the toys. One elf's problem is never serious enough to wake up Santa (otherwise, he may never get any sleep), so, the elves visit Santa in a group of three. When three elves are having their problems solved, any other elves wishing to visit Santa must wait for those elves to return. If Santa wakes up to find three elves waiting at his shop's door, along with the last reindeer having come back from the tropics, Santa has decided that the elves can wait until after Christmas, because it is more important to get his sleigh ready as soon as possible. (It is assumed that the reindeer don't want to leave the tropics, and therefore they stay there until the last possible moment. They might not even come back, but since Santa is footing the bill for their year in paradise ... This could also explain the quickness in their delivering of presents, since the reindeer can't wait to get back to where it is warm.) The penalty for the last reindeer to arrive is that it must get Santa while the others wait in a warming hut before being harnessed to the sleigh.

gloria i ad inferni
faciamus opus

Return to Top | About this site...
Last edited Wed Dec 9 19:36:46 2009.
Copyright © 2005-2012 Tommy M. McGuire