A simulation of the Monty Hall Problem
Ken Wesson
description of the Monty Hall Problem:
> Suppose you're on a game show and you're given the choice of three
> doors [and will win what is behind the chosen door]. Behind one
> door is a car; behind the others, goats [unwanted booby prizes].
> The car and the goats were placed randomly behind the doors before
> the show. The rules of the game show are as follows: After you have
> chosen a door, the door remains closed for the time being. The game
> show host, Monty Hall, who knows what is behind the doors, now has
> to open one of the two remaining doors, and the door he opens must
> have a goat behind it. If both remaining doors have goats behind
> them, he chooses one [uniformly] at random. After Monty Hall opens
> a door with a goat, he will ask you to decide whether you want to
> stay with your first choice or to switch to the last remaining
> door. Imagine that you chose Door 1 and the host opens Door 3,
> which has a goat. He then asks you "Do you want to switch to Door
> Number 2?" Is it to your advantage to change your choice?
This Clojure code simulates the Monty Hall problem in an interesting
way: the monty-hall function is passed a contestant function that,
when invoked, a) picks a door at random and b) also returns a function
that re-decides which door to open after Monty opens one of the other
two and gives them the chance to switch (monty-hall does this by
calling that function with the number of the door Monty opened).
Two contestant functions are provided. Both make a uniformly random
initial choice of door. The staying-contestant returns a function that
will make the same choice of door after Monty opens one of the other
two. The switching-contestant will switch to the other unopened door.
The monty-avg function takes a contestant and a number of trials, has
that contestant play that many games, and returns the proportion of
times that contestant won. Example output for 10,000 trials is
included; some people may find the results counterintuitive, but the
math says that the results I got are exactly what they should be (and
that 1000 PhDs were wrong about that).
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.
(defn rand-elt [seq]
(nth seq (rand-int (count seq))))
(defn make-monty []
(rand-elt
[[:car :goat :goat]
[:goat :car :goat]
[:goat :goat :car]]))
(defn monty-hall [contestant]
(let [m (make-monty)
[door response-fn] (contestant)
other-bad-doors (remove #(= (m %) :car)
(remove #(= % door)
[0 1 2]))
wrong-door (rand-elt other-bad-doors)
final-door (response-fn wrong-door)]
(m final-door)))
(defn staying-contestant []
(let [initial-door (rand-int 3)]
[initial-door
(constantly initial-door)]))
(defn switching-contestant []
(let [initial-door (rand-int 3)]
[initial-door
(fn [wrong-door]
(first
(remove #(= % initial-door)
(remove #(= % wrong-door)
[0 1 2]))))]))
(defn monty-avg [contestant n-trials]
(double
(/
(count
(filter #(= :car %)
(repeatedly n-trials #(monty-hall contestant))))
n-trials)))
user=> (monty-avg staying-contestant 10000)
0.3362
user=> (monty-avg switching-contestant 10000)
0.6616
Ken Wesson
> 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
Adam Burry
FYI, the best treatment of this problem I have seen is this one:
http://www.cs.utoronto.ca/~hehner/PPP.pdf
Adam
Konrad Hinsen
> FYI, the best treatment of this problem I have seen is this one:
> http://www.cs.utoronto.ca/~hehner/PPP.pdf
There's also a compact Clojure solution based on the probability monad:
Konrad.
Ken Wesson
Interesting. It is, as I thought, very short with monads -- though
that version doesn't really use randomness, but instead enumerates all
the possibilities. You'd need slightly different monads to thread a
random bit-stream through instead of enumerating all the alternatives.
The difference is like that between classical randomness and quantum
many worlds, with the probability distribution monads doing the many
worlds version. :)
Konrad Hinsen
> Interesting. It is, as I thought, very short with monads -- though
> that version doesn't really use randomness, but instead enumerates all
> the possibilities. You'd need slightly different monads to thread a
> random bit-stream through instead of enumerating all the alternatives.
Indeed. What's nice about monads is that you can use the same problem
specification for both approaches. Just change the monad name to
switch between enumeration and Monte-Carlo simulation.
Konrad.
siyu798
Ken Wesson
> Hi, I started learning clojure for a few months and this is what I have for
> the problem, and I find it running very slow if exceeding 100k trials, maybe
> it's because of using set? Any feedbacks will be appreciated. thx
> (require '[clojure.set :as set])
> (def doors #{:a :b :c})
> (defn rand-nth-set [s]
> (conj #{} (rand-nth (seq s))))
#{(rand-nth (seq s))} should work as well.
> (defn play
> ([] (play nil))
> ([switch?]
> (let [prize-door (rand-nth-set doors)
> picked-door (rand-nth-set doors)
> empty-doors (set/difference doors prize-door)
> opened-door (rand-nth-set (set/difference empty-doors picked-door))
> picked-door (if switch?
> (set/difference doors opened-door picked-door)
Shouldn't that be wrapped in (first ...) or something?
> picked-door)]
> (= picked-door prize-door))))
> (count (remove #(false? %) (repeatedly 10000 #(play true))))
> (count (remove #(false? %) (repeatedly 10000 #(play false))))
As for the speed, I'm not sure what the problem is.
--
Protege: What is this seething mass of parentheses?!
Master: Your father's Lisp REPL. This is the language of a true
hacker. Not as clumsy or random as C++; a language for a more
civilized age.
siyu798
On Thursday, May 19, 2011 4:38:17 PM UTC-4, Ken Wesson wrote:
On Thu, May 19, 2011 at 12:52 PM, siyu798 <siy...@gmail.com> wrote:
> Hi, I started learning clojure for a few months and this is what I have for
> the problem, and I find it running very slow if exceeding 100k trials, maybe
> it's because of using set? Any feedbacks will be appreciated. thx
> (require '[clojure.set :as set])
> (def doors #{:a :b :c})
> (defn rand-nth-set [s]
> (conj #{} (rand-nth (seq s))))#{(rand-nth (seq s))} should work as well.
> (defn play
> ([] (play nil))
> ([switch?]
> (let [prize-door (rand-nth-set doors)
> picked-door (rand-nth-set doors)
> empty-doors (set/difference doors prize-door)
> opened-door (rand-nth-set (set/difference empty-doors picked-door))
> picked-door (if switch?
> (set/difference doors opened-door picked-door)Shouldn't that be wrapped in (first ...) or something?
Ken Wesson
> On Thursday, May 19, 2011 4:38:17 PM UTC-4, Ken Wesson wrote:
>> On Thu, May 19, 2011 at 12:52 PM, siyu798 <siy...@gmail.com> wrote:
>> > (set/difference doors opened-door picked-door)
>>
>> Shouldn't that be wrapped in (first ...) or something?
>
> do you mean wrap the returned picked-door set in (first ...)? Since this
> is a three doors scenario so there should always be one door left to switch
> to, thus no need to use first.
There's a difference between :a and #{:a}, though, and it will cause
the switch case to never win since if prize-door is :a and picked-door
ends up #{:a} they won't compare equal.
> For some reasons I always have the impression that it's not idiomatic to use
> chained let form like the play fn here, is there a more idiomatic way to
> write this code?
AFAIK there is nothing whatsoever wrong with using chained let. It's
"procedural-ish" but it is still functional (immutable locals and all
that), often clearer than a densely-nested expression (not to mention
when some of the bound values get used more than once), and perhaps
most importantly, it works just fine in practice.
siyu798
On Thursday, May 19, 2011 6:36:34 PM UTC-4, Ken Wesson wrote:
On Thu, May 19, 2011 at 6:16 PM, siyu798 <siy...@gmail.com> wrote:
> On Thursday, May 19, 2011 4:38:17 PM UTC-4, Ken Wesson wrote:
>> On Thu, May 19, 2011 at 12:52 PM, siyu798 <siy...@gmail.com> wrote:
>> > (set/difference doors opened-door picked-door)
>>
>> Shouldn't that be wrapped in (first ...) or something?
>
> do you mean wrap the returned picked-door set in (first ...)? Since this
> is a three doors scenario so there should always be one door left to switch
> to, thus no need to use first.There's a difference between :a and #{:a}, though, and it will cause
the switch case to never win since if prize-door is :a and picked-door
ends up #{:a} they won't compare equal.
> For some reasons I always have the impression that it's not idiomatic to use
> chained let form like the play fn here, is there a more idiomatic way to
> write this code?AFAIK there is nothing whatsoever wrong with using chained let. It's
"procedural-ish" but it is still functional (immutable locals and all
that), often clearer than a densely-nested expression (not to mention
when some of the bound values get used more than once), and perhaps
most importantly, it works just fine in practice.
Ken Wesson
>> There's a difference between :a and #{:a}, though, and it will cause
>> the switch case to never win since if prize-door is :a and picked-door
>> ends up #{:a} they won't compare equal.
>
> prize-door is a set
Eh. Your implementation is a bit ... unusual. Though it lets you use
set/difference to simplify the exclusionary bits instead of remove
#{foo}. On the other hand, part of your performance problem may come
from using such a high level of abstraction.