Programming Praxis

Our simulation is a little bit complex because it has to account for the people who don’t participate on a given Friday. We write a function that takes a list of players, a strategy, and the number n of weeks, determines the absentees each week, and returns the net counts of the number of croissants each person buys and consumes over the course of n weeks:

(define (croissants n-players strategy n)
  (let ((players (range n-players)) (tot (make-vector n-players 0)))
    (do ((n n (- n 1))) ((zero? n) tot)
      (let* ((n-absent (randint (quotient n-players 3)))
             (present (drop n-absent (shuffle players)))
             (winner (strategy present tot)))
        (vector-set! tot winner
          (+ (vector-ref tot winner) n-players (- n-absent)))
        (do ((present present (cdr present))) ((null? present))
          (vector-set! tot (car present)
            (- (vector-ref tot (car present)) 1)))))))

The simplest solution is for those present each Friday to draw straws; the short straw buys croissants — perhaps you could cut one of those little coffee-stirrer straws in two to mark the short straw:

(define (draw-straws players tot) (fortune players))

If you’re willing to keep a database somewhere of the number of croissants each person has purchased and consumed (the original poster on Stack Overflow was willing to do so), a fairer strategy is to select the person who has the smallest number of croissants purchased less consumed; ties are resolved with a very serious game of rock-paper-scissors. In practice this can be done by keeping a list on the refrigerator door; each player adds to his running total the number of croissants he purchases when it is his week to do so, subtracts one for each croissant he consumes, and leaves his running total unchanged on the weeks he is out of the office. With this approach a player can be deleted whenever he leaves the game without messing up the game for the other players, and a new player can enter the game by adding his name with a running total of zero:

(define (fair-game players tot)
  (let loop ((players (cdr players)) (min-p (car players))
             (min-v (vector-ref tot (car players))))
    (if (null? players) min-p
      (if (< (vector-ref tot (car players)) min-v)
        (loop (cdr players) (car players) (vector-ref tot (car players)))
        (loop (cdr players) min-p min-v)))))

Run over ten thousand weeks, our simulations look like this:

> (croissants 10 draw-straws 10000)
#(85 -60 -344 -211 -27 -71 351 151 -51 177)
> (croissants 10 fair-game 10000)
#(4 3 -2 0 -5 2 -4 1 0 1)

The output from draw-straws is about what you expect from a small simulation; the differences are also on the order of a few hundred if you run for a million steps instead of ten thousand, showing that the differences are just due to fluctuations in the random number generator. The output from fair-game is, of course, fair, because we designed the strategy to be fair, with the difference between low and high never greater than the number of people in the game. Note that both sets of counts sum to zero, showing that the simulation works properly.

We used drop, range, the random number generator, fortune and shuffle from the Standard Prelude. You can run the program at http://programmingpraxis.codepad.org/OHI2QNyk.

Pages: 1 2