On Mon, May 9, 2011 at 11:26 PM, Ken Wesson <kwess...@gmail.com> wrote:
> The code is idiomatic Clojure, using sequence functions in preference
> to loop/recur and itself using higher order functions in what might be
> described as a continuation-passing style. There is also no mutation
> or impure function use except for the calls to rand-int and that rng's
> hidden internal state; it could be made fully pure by passing around
> an extra parameter in the form of a seq of random bits supplied
> externally and, from functions that consume from the seq, returning
> the reduced seq.

Here's the pure version. I've made it COMPLETELY purely functional --
even to the point of making a functional reimplementation of
java.util.Random.nextInt().

The first few functions build up to random-bit-seq, which takes a seed
and returns an infinite lazy sequence of random bits, which is used to
implement rand-num (replaces rand-int in original). The rand-num
function, and things like rand-elt and make-monty, now return a vector
of [random-influenced-return-value
unconsumed-portion-of-random-bit-seq]; rand-num uses a rejection
algorithm (stack-safe thanks to recur) to produce uniform results when
the range is not a power of two (notably, the Monty Hall problem
results in it often being called with 3) and handles the corner case 1
correctly (returning 0 and the whole random-bit-seq, having consumed
none of it).

After that, the original Monty Hall problem functions follow, mostly
altered by a) taking an added parameter of a random bit sequence and
b) returning a vector whose final component is the partially-consumed
random bit sequence. So the sequence threads through all the function
calls being consumed to produce random numbers via rand-num, all
without any actual mutation.

The monty-avg function takes a random seed as an added parameter,
rather than a bit sequence. As one would hope, it produces a fixed
result for a fixed choice of contestant, number-of-trials, and seed --
it is, after all, a pure function. :) Notice also that the sum of the
return value for switching-contestant and staying-contestant will
always be exactly 1, seed and number-of-trials remaining equal,
because every time the switching-contestant would have gotten a goat
the staying-contestant gets a car, and vice versa -- they are
encountering the exact same sequence of games. Nothing is changing,
including any of the random choices, except which final door is
chosen, which has no effect on subsequent games.

I've also included a third contestant, the
sometimes-switching-contestant, who has a fifty percent chance of
switching (and thus consumes one bit of the random bit sequence when
Monty offers the option of switching). As you might expect, this one
wins fifty percent of the time. The number isn't exactly half, though,
despite the above, since he isn't switching on a set of games and
staying on an identical set of games, but rather switching on a set of
games and staying on a different set of games.

All of this passing and returning of side-band parameters cries out
for some sort of simplification -- enter monads. But I leave writing a
version of the below that employs monads as an exercise for the
reader. ;)

Implementing a superior, simulation-grade PRNG such as Mersenne
Twister in a pure-functional manner to implement random-bit-seq is
also left as an exercise for the reader.

One limitation of the pure-functional approach is notable: unlike in
the original, it is possible in this version for the contestant to
cheat by basically stacking the deck -- it could return not the
unconsumed portion of the random-bit-seq but instead a tailored seq
that will control Monty for the next game in the sequence in puppet
fashion to produce a desired result (e.g. a car every time). At the
end is a cheating-contestant function that actually does this.

This may not be a true weakness of pure functionality, though. One can
imagine blocking this form of cheating by providing two random bit
sequences, one that Monty uses and one that the contestant uses --
though the contestant now has to trust Monty not to mess with the
sequence to puppet the contestant. More sophisticatedly, each could
encrypt and decrypt their sequence by xoring it with a fixed,
unknown-to-the-other bit-sequence of fixed length that is cycled, at
least in principle, and thereby pass "private" information through the
other back to themselves in a manner that would resist both
eavesdropping and any attempt to exert control via tampering; the most
tampering could do is randomize things, and if the private information
was already random this would have no meaningful consequence. One can
also imagine including check digits in "private" information in
addition to encrypting it, so that any substitution with random data
will (with high likelihood) be detected, making the "private" data
tamper-evident in a cryptographically-strong manner as well as
resistant to eavesdropping and (directed) tampering.

(def two-48-1 (dec (bit-shift-left 1 48)))

(defn lc48 [n]
  (bit-and (+ (* n 0x5deece66d) 0xb) two-48-1))

(defn bit-seq-48 [n]
  (take 48
    (map second
      (rest
        (iterate
          (fn [[n _]]
            [(quot n 2) (rem n 2)])
          [n nil])))))

(defn random-bit-seq [seed]
  (mapcat bit-seq-48 (iterate lc48 seed)))

(defn bits-for-range [range]
  (count (take-while (complement zero?) (iterate #(quot % 2) (dec range)))))

(defn int-from-bits [bits]
  (first
    (reduce
      (fn [[n power2] bit]
        [(+ n (* power2 bit)) (* 2 power2)])
      [0 1]
      bits)))

(defn rand-num [range random-bits]
  (let [n-bits (bits-for-range range)
        bits (take n-bits random-bits)
        remain (drop n-bits random-bits)
        n (int-from-bits bits)]
    (if (< n range)
      [n remain]
      (recur range remain))))

(defn rand-elt [seq random-bits]
  (let [[n remain] (rand-num (count seq) random-bits)]
    [(nth seq n) remain]))

(defn make-monty [random-bits]
  (rand-elt
    [[:car :goat :goat]
     [:goat :car :goat]
     [:goat :goat :car]]
    random-bits))

(defn monty-hall [contestant random-bits]
 (let [[m random-bits] (make-monty random-bits)
       [door response-fn random-bits] (contestant random-bits)
       other-bad-doors (remove #(= (m %) :car)
                          (remove #(= % door)
                            [0 1 2]))
       [wrong-door random-bits] (rand-elt other-bad-doors random-bits)
       [final-door random-bits] (response-fn wrong-door random-bits)]
   [(m final-door) random-bits]))

(defn staying-contestant [random-bits]
 (let [[initial-door remain] (rand-num 3 random-bits)]
   [initial-door
    (fn [_ random-bits]
      [initial-door random-bits])
    remain]))

(defn switching-contestant [random-bits]
  (let [[initial-door remain] (rand-num 3 random-bits)]
    [initial-door
     (fn [wrong-door random-bits]
       [(first
          (remove #(= % initial-door)
            (remove #(= % wrong-door)
              [0 1 2])))
        random-bits])
     remain]))

(defn sometimes-switching-contestant [random-bits]
  (let [[initial-door remain] (rand-num 3 random-bits)]
    [initial-door
     (fn [wrong-door random-bits]
       (let [switch? (zero? (first random-bits))
             remain (rest random-bits)]
         [(if switch?
            (first
              (remove #(= % initial-door)
                (remove #(= % wrong-door)
                  [0 1 2])))
            initial-door)
          remain]))
     remain]))

(defn monty-avg [contestant n-trials seed]
  (double
    (/
      (count
        (filter #(= :car %)
          (map first
            (take n-trials
              (rest
                (iterate
                  (fn [[_ random-bits]]
                    (monty-hall contestant random-bits))
                  [nil (random-bit-seq seed)]))))))
        n-trials)))


user=> (monty-avg staying-contestant 10000 345683864)
0.3332
user=> (monty-avg switching-contestant 10000 345683864)
0.6668
user=> (monty-avg sometimes-switching-contestant 10000 345683864)
0.5012

(defn cheating-contestant [random-bit-seq]
  [0
   (constantly [0 (repeat 0)])
   random-bit-seq])

user=> (monty-avg cheating-contestant 10000 345683864)
1.0

-- 
You received this message because you are subscribed to the Google
Groups "Clojure" group.
To post to this group, send email to clojure@googlegroups.com
Note that posts from new members are moderated - please be patient with your 
first post.
To unsubscribe from this group, send email to
clojure+unsubscr...@googlegroups.com
For more options, visit this group at
http://groups.google.com/group/clojure?hl=en

Reply via email to