Monty Hall problem using Monte Carlo simulations

n0ne showed how to translate Monte Carlo simulations of the Monty Hall Problem from Ruby and Python to Haskell. Since I have been trying to understand Patrick Perry’s monte-carlo monad, I thought that this is a good problem to start with. Monty Hall problems is one of those probability problems where the result is opposite to what intuition suggests.

Lets start by importing some Haskell packages that I will use later on. The most important for our purpose is Control.Monad.MC, which provides a nice wrapper to do Monte Carlo simulations.

 import Data.List (delete, (\\) )
 import Text.Printf (printf)
 import Control.Monad
 import Control.Monad.MC

So, the Monty Hall problem goes as follows. A contestant in game show faces three doors. There is a car behind one of them and goats behind the other two. He picks a door, and then the game show host, who knows what is behind the doors, opens one of the other doors to reveal a goat. The contestant then has the option to stick to his original choice, or switch to the unopened door. What is better?

One thing that I like about Haskell is its expressiveness. In particular, one can translate each line above from English to Haskell and get a working example. Let see.

• A contestant in a game show faces three doors.

  data Door = Door1 | Door1 ">Door2 | Door3 deriving (Show, Eq, Enum)
  doors = [Door1 .. Door3]
  

• There is a car behind one of them and goats behind the other two.

  data Object = Car | Goat deriving (Show, Eq)
  type Universe = [Object]
  
  nature :: MC Universe
  nature = shuffle 3 [Car, Goat, Goat]
  

Here shuffle is a function from monte-carlo package, which as the name suggests shuffles the first three objects from [Car, Goat, Goat]. This represents our state of the world.

• He picks a door

  contestant :: MC Door
  contestant = sample 3 doors

The function sample is also from monte-carlo package. It picks one out of the list of options.

• and then the game show host, who knows what is behind the doors, opens one of the other doors to reveal a goat.

Lets break down each English phrase. First, we need to figure out what options the game show host has. He can open any door which has a goat behind it. So, first we figure out which of the remaining doors have a goat behind them.

 options :: Universe -> Door -> [Door]
 options universe door = filter (\d -> Goat == open universe d) remainder
   where remainder = delete door doors

 open :: Universe -> Door -> Object
 open [a,_,_] Door1 = a
 open [_,a,_] Door2 = a
 open [_,_,a] Door3 = a
 open _        _    = error "Wrong number of elements in the universe"

Now the host can pick any one of the them.

 host :: [Door]-> MC Door
 host o = sample (length o) o where

• The contestant then has the option to stick to his original choice, or switch to the unopened door.

I will write a function for each strategy of the contestant, even though one function is redundant.

 strategyStick :: Door -> Door -> Door
 strategyStick d1 ">d2 ">d1 d2 = d1
strategyFlip :: Door -> Door -> Door
 strategyFlip d1 d2 = head (doors \\ [d1,d2])

• What is better?

Ah, the finale. Assuming that the contestant wants a car over a goat, we need to associate a reward with the outcome. If the outcome is a Car, the contest gets a reward of 1 Car, otherwise he gets 0 Cars.

 reward :: Universe -> Door -> Double
 reward u d = if Car == open u d then 1.0 else 0.0

Now, which strategy gives the contestant a better reward on average. We can, of course evaluate the average reward of each strategy analytically. We can also use the probability monad by Martin Erwig, which does exact probability calculations in Haskell. It even has Monty Hall problem as one of the examples. In this post, however, I am interested in a Monte Carlo approach. Monte Carlo approach works on the law of large numbers: one can approximate the expected value of a random variable by taking independent samples from its distribution and computing the sample average. To do so in Haskell, I first need to define the random variable, which in this case is the reward that we get. We need to specify the strategy in order to determine the outcome.

 randomVariable :: (Door -> Door -> Door) -> MC Double
randomVariable strategy = do
   u <- nature
   c <- contestant
   h <- host (options u c)
   let r = reward u (strategy c h)
   return r

This function says that the outcome is produced as follows. First nature chooses the ordering of the objects behind the door, then the contestant chooses a door, then the host opens a door, and then, depending on the contestant’s strategy, he gets a reward.

This is another good thing about Haskell. I can switch to an imperative style whenever it is convenient. In this case I can sequence a bunch of random events, and I have not even talked about generating random number!. Haskell provides a complete separation of generating random variable from the Monte Carlo simulation. Thanks to the new repeatMC function in the monte-carlo package, running a simulation is straight-forward.

 main = let
   n     = 100000
   seed  = 42
   stats = repeatMC n (randomVariable strategyStick) `evalMC` mt19937 seed
   in do
putStrLn $ printf "Mean                    : %f" (sampleMean stats)
      putStrLn $ printf "99%% Confidence interval : (%f, %f)"
                `uncurry` (sampleCI 0.99 stats)

The results of the simulation are stored in the Summary data type, which I talked about in the last post.

I only output the result of the stick strategy. The result of the switch strategy is going to be (1 - result of stick), since if the contestant did not get the car by sticking to his choice, he would have gotten it by switching. And the result (surprise, surprise, if you did not know about Monty Hall problem)

Mean                    : 0.3355999999999993
99% Confidence interval : (0.33175368331333815, 0.3394463166866604)

So, sticking to one’s choice only wins 1/3rd of the time. Which means that switching wins 2/3rd of the time. So, if you happen to be in a Monty Hall game show—switch.

---

Possibly related posts: (automatically generated)

• Bear Thief Gets Behind the Wheel