We may all be familiar with the famous monty hall problem. This game was originally introduced from the TV show “Let’s make a Deal” and became a sensation once Maylin Vos Savant wrote a controversial column about how “Switching doors” was more advantageous than not.
The game is very simple..
You’re on a game show and you see 3 doors. Behind one door is something fantastic like a million dollars. Behind the other two doors are some ugly old goats. Your goal is to grab the prize (can be subjective).
To begin, you get to pick one door that you feel conceals the prize. The host then opens a different door that does not contain the prize (revealing an old goat). Now, given a choice that you see an old goat, you have the option to stay with your door of initial choice, or “switch” to the other door.
Wait, but once one door is eliminated, isn’t it just a 50-50 chance? Does it matter whether or not I switch?
Before we code it up, let’s look at the math in a ‘fixed’ state.
Below we see a very nice diagram created by Roopam Upadhyay breaking down the mathematics. This diagram assumes that the contestant has chosen door A and the Host (Monty) opening door B as the dummy. If the prize (car) happens to be inside B, we notice there is a 0% probability that he will open door if we were to choose door B as our guess or if the car was actually inside. If the prize car happens to be in door C, we see that with certainty he will open B and so on. Using bayes rule that given door B was opened as the dummy, what is the probability that the car was actually in door X? We cleary see how this is dealing with the possible combinations of the sample space.
If you are looking for another example, watch this video of a more intuitive explanation.
Now we will go on to code up our example by simulating this game. Let’s walk through our example.
We begin with a possible sample set of door A, B, or C. We make a random choice between the three and the car is possibly within those three.
doors <- c("A","B","C")
(sam_door <- sample(doors,1))
[1] "C"
(prize_door <- sample(doors,1))
[1] "B"
## [1] "C"
## [1] "A"
It looks like our samples did not match. Now let’s proceed to the next step. If we switch, we would surely lose. However, if we stay we will win. Let’s switch and win.
switch <- TRUE
if(switch) {
print(paste("You chose Door:",sam_door,"but switched.","The Prize was in:",prize_door))
sam_door != prize_door
} else {
print(paste("You chose Door:",sam_door,"but didn't switch.","The Prize was in:",prize_door))
sam_door == prize_door
}
[1] "You chose Door: C but switched. The Prize was in: B"
[1] TRUE
## [1] "You chose Door: C but switched. The Prize was in: A"
## [1] TRUE
Above, we decided to fulfill two conditions. If we switched, the sample door and prize door would ‘not-not’ be equal and we will win (We have eliminated the host’s door in this case because it doesn’t matter) giving us a TRUE. If we did not switch, the boolean comparison will give us a FALSE, indicating that we had lost.
This logic will hold for any sample of data. Now let’s validate Maylin’s statement. Is it really advantageous for us to switch doors every time?
We will now take the code we created above to count up how many times we win when switched, as compared to when we do NOT switch by comparing a function and running it over and over again (1000 times).
monty <- function(switch = TRUE) {
sam_door <- sample(c("A","B","C"),1) ; prize_door <- sample(c("A","B","C"),1)
ifelse(switch,sam_door != prize_door,sam_door == prize_door)
}
monty(FALSE)
[1] TRUE
require(dplyr) # '%>%' from'dplyr'
((if_switch <- replicate(1000,monty(switch = TRUE))) %>% mean) # produces a vector and finds the mean
[1] 0.681
((if_stay <- replicate(1000,monty(switch = FALSE))) %>% mean)
[1] 0.345
## [1] 0.686
## [1] 0.329
We are very close to Roopam’s diagram showing 2/3 chance of winning when we switch, whereas 33% chance of winning when we stay. It is powerful what we can decipher from conditional probabilities and from what simulation studies can show us! Hopefully this will give us some more insights on choices that may not be as obvious to us as they may seem.
Hope you had some fun!
LS0tCnRpdGxlOiAiTW9udHkgSGFsbCBTaW11bGF0aW9uIgpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sKLS0tCiAKV2UgbWF5IGFsbCBiZSBmYW1pbGlhciB3aXRoIHRoZSBmYW1vdXMgbW9udHkgaGFsbCBwcm9ibGVtLiBUaGlzIGdhbWUgd2FzIG9yaWdpbmFsbHkgaW50cm9kdWNlZCBmcm9tIHRoZSBUViBzaG93IFsiTGV0J3MgbWFrZSBhIERlYWwiXShodHRwczovL2VuLndpa2lwZWRpYS5vcmcvd2lraS9MZXQlMjdzX01ha2VfYV9EZWFsKSBhbmQgYmVjYW1lIGEgc2Vuc2F0aW9uIG9uY2UgTWF5bGluIFZvcyBTYXZhbnQgd3JvdGUgYSBjb250cm92ZXJzaWFsIGNvbHVtbiBhYm91dCBob3cgIlN3aXRjaGluZyBkb29ycyIgd2FzIG1vcmUgYWR2YW50YWdlb3VzIHRoYW4gbm90LgoKIVtdKGh0dHBzOi8vaW1ncy54a2NkLmNvbS9jb21pY3MvbW9udHlfaGFsbF8yeC5wbmcpCgpUaGUgZ2FtZSBpcyB2ZXJ5IHNpbXBsZS4uCgpZb3XigJlyZSBvbiBhIGdhbWUgc2hvdyBhbmQgeW91IHNlZSAzIGRvb3JzLiBCZWhpbmQgb25lIGRvb3IgaXMgc29tZXRoaW5nIGZhbnRhc3RpYyBsaWtlIGEgbWlsbGlvbiBkb2xsYXJzLiBCZWhpbmQgdGhlIG90aGVyIHR3byBkb29ycyBhcmUgc29tZSB1Z2x5IG9sZCBnb2F0cy4gWW91ciBnb2FsIGlzIHRvIGdyYWIgdGhlIHByaXplIChjYW4gYmUgc3ViamVjdGl2ZSkuCgpUbyBiZWdpbiwgeW91IGdldCB0byBwaWNrIG9uZSBkb29yIHRoYXQgeW91IGZlZWwgY29uY2VhbHMgdGhlIHByaXplLiBUaGUgaG9zdCB0aGVuIG9wZW5zIGEgZGlmZmVyZW50IGRvb3IgdGhhdCBkb2VzIG5vdCBjb250YWluIHRoZSBwcml6ZSAocmV2ZWFsaW5nIGFuIG9sZCBnb2F0KS4gTm93LCBnaXZlbiBhIGNob2ljZSB0aGF0IHlvdSBzZWUgYW4gb2xkIGdvYXQsIHlvdSBoYXZlIHRoZSBvcHRpb24gdG8gc3RheSB3aXRoIHlvdXIgZG9vciBvZiBpbml0aWFsIGNob2ljZSwgb3IgInN3aXRjaCIgdG8gdGhlIG90aGVyIGRvb3IuCgpXYWl0LCBidXQgb25jZSBvbmUgZG9vciBpcyBlbGltaW5hdGVkLCBpc24ndCBpdCBqdXN0IGEgNTAtNTAgY2hhbmNlPyBEb2VzIGl0IG1hdHRlciB3aGV0aGVyIG9yIG5vdCBJIHN3aXRjaD8KCkJlZm9yZSB3ZSBjb2RlIGl0IHVwLCBsZXQncyBsb29rIGF0IHRoZSBtYXRoIGluIGEgJ2ZpeGVkJyBzdGF0ZS4KCjxocj4KCkJlbG93IHdlIHNlZSBhIHZlcnkgbmljZSBkaWFncmFtIGNyZWF0ZWQgYnkgW1Jvb3BhbSBVcGFkaHlheV0odWNhbmFseXRpY3MuY29tKSBicmVha2luZyBkb3duIHRoZSBtYXRoZW1hdGljcy4gVGhpcyBkaWFncmFtIGFzc3VtZXMgdGhhdCB0aGUgY29udGVzdGFudCBoYXMgY2hvc2VuIGRvb3IgQSBhbmQgdGhlIEhvc3QgKE1vbnR5KSBvcGVuaW5nIGRvb3IgQiBhcyB0aGUgZHVtbXkuIElmIHRoZSBwcml6ZSAoY2FyKSBoYXBwZW5zIHRvIGJlIGluc2lkZSBCLCB3ZSBub3RpY2UgdGhlcmUgaXMgYSAwJSBwcm9iYWJpbGl0eSB0aGF0IGhlIHdpbGwgb3BlbiBkb29yIGlmIHdlIHdlcmUgdG8gY2hvb3NlIGRvb3IgQiBhcyBvdXIgZ3Vlc3Mgb3IgaWYgdGhlIGNhciB3YXMgYWN0dWFsbHkgaW5zaWRlLiBJZiB0aGUgcHJpemUgY2FyIGhhcHBlbnMgdG8gYmUgaW4gZG9vciBDLCB3ZSBzZWUgdGhhdCB3aXRoIGNlcnRhaW50eSBoZSB3aWxsIG9wZW4gQiBhbmQgc28gb24uIFVzaW5nIGJheWVzIHJ1bGUgdGhhdCBnaXZlbiBkb29yIEIgd2FzIG9wZW5lZCBhcyB0aGUgZHVtbXksIHdoYXQgaXMgdGhlIHByb2JhYmlsaXR5IHRoYXQgdGhlIGNhciB3YXMgYWN0dWFsbHkgaW4gZG9vciBYPyBXZSBjbGVhcnkgc2VlIGhvdyB0aGlzIGlzIGRlYWxpbmcgd2l0aCB0aGUgcG9zc2libGUgY29tYmluYXRpb25zIG9mIHRoZSBzYW1wbGUgc3BhY2UuCgohW10oaHR0cHM6Ly9jZG4taW1hZ2VzLTEubWVkaXVtLmNvbS9tYXgvMTYwMC8xKkJNeTh6X2pwUUpqbjFpRU1yRHBKakEuanBlZykKCklmIHlvdSBhcmUgbG9va2luZyBmb3IgYW5vdGhlciBleGFtcGxlLCB3YXRjaCB0aGlzIFt2aWRlb10oKSBvZiBhIG1vcmUgaW50dWl0aXZlIGV4cGxhbmF0aW9uLgoKTm93IHdlIHdpbGwgZ28gb24gdG8gY29kZSB1cCBvdXIgZXhhbXBsZSBieSBzaW11bGF0aW5nIHRoaXMgZ2FtZS4gTGV0J3Mgd2FsayB0aHJvdWdoIG91ciBleGFtcGxlLgoKV2UgYmVnaW4gd2l0aCBhIHBvc3NpYmxlIHNhbXBsZSBzZXQgb2YgZG9vciBBLCBCLCBvciBDLiBXZSBtYWtlIGEgcmFuZG9tIGNob2ljZSBiZXR3ZWVuIHRoZSB0aHJlZSBhbmQgdGhlIGNhciBpcyBwb3NzaWJseSB3aXRoaW4gdGhvc2UgdGhyZWUuCgpgYGB7cn0KZG9vcnMgPC0gYygiQSIsIkIiLCJDIikKKHNhbV9kb29yIDwtIHNhbXBsZShkb29ycywxKSkKKHByaXplX2Rvb3IgPC0gc2FtcGxlKGRvb3JzLDEpKQpgYGAKCiAgICAjIyBbMV0gIkMiCiAgICAjIyBbMV0gIkEiCgpJdCBsb29rcyBsaWtlIG91ciBzYW1wbGVzIGRpZCBub3QgbWF0Y2guIE5vdyBsZXQncyBwcm9jZWVkIHRvIHRoZSBuZXh0IHN0ZXAuIElmIHdlIHN3aXRjaCwgd2Ugd291bGQgc3VyZWx5IGxvc2UuIEhvd2V2ZXIsIGlmIHdlIHN0YXkgd2Ugd2lsbCB3aW4uIExldCdzIHN3aXRjaCBhbmQgd2luLgoKYGBge3J9CnN3aXRjaCA8LSBUUlVFCgogIGlmKHN3aXRjaCkgewogICAgcHJpbnQocGFzdGUoIllvdSBjaG9zZSBEb29yOiIsc2FtX2Rvb3IsImJ1dCBzd2l0Y2hlZC4iLCJUaGUgUHJpemUgd2FzIGluOiIscHJpemVfZG9vcikpCiAgICBzYW1fZG9vciAhPSBwcml6ZV9kb29yCiAgfSBlbHNlIHsKICAgIHByaW50KHBhc3RlKCJZb3UgY2hvc2UgRG9vcjoiLHNhbV9kb29yLCJidXQgZGlkbid0IHN3aXRjaC4iLCJUaGUgUHJpemUgd2FzIGluOiIscHJpemVfZG9vcikpCiAgICBzYW1fZG9vciA9PSBwcml6ZV9kb29yCiAgfQpgYGAKCiAgICAjIyBbMV0gIllvdSBjaG9zZSBEb29yOiBDIGJ1dCBzd2l0Y2hlZC4gVGhlIFByaXplIHdhcyBpbjogQSIKICAgICMjIFsxXSBUUlVFCgpBYm92ZSwgd2UgZGVjaWRlZCB0byBmdWxmaWxsIHR3byBjb25kaXRpb25zLiBJZiB3ZSBzd2l0Y2hlZCwgdGhlIHNhbXBsZSBkb29yIGFuZCBwcml6ZSBkb29yIHdvdWxkICdub3Qtbm90JyBiZSBlcXVhbCBhbmQgd2Ugd2lsbCB3aW4gKFdlIGhhdmUgZWxpbWluYXRlZCB0aGUgaG9zdCdzIGRvb3IgaW4gdGhpcyBjYXNlIGJlY2F1c2UgaXQgZG9lc24ndCBtYXR0ZXIpIGdpdmluZyB1cyBhIFRSVUUuIElmIHdlIGRpZCBub3Qgc3dpdGNoLCB0aGUgYm9vbGVhbiBjb21wYXJpc29uIHdpbGwgZ2l2ZSB1cyBhIEZBTFNFLCBpbmRpY2F0aW5nIHRoYXQgd2UgaGFkIGxvc3QuCgpUaGlzIGxvZ2ljIHdpbGwgaG9sZCBmb3IgYW55IHNhbXBsZSBvZiBkYXRhLiBOb3cgbGV0J3MgdmFsaWRhdGUgTWF5bGluJ3Mgc3RhdGVtZW50LiBJcyBpdCByZWFsbHkgYWR2YW50YWdlb3VzIGZvciB1cyB0byBzd2l0Y2ggZG9vcnMgZXZlcnkgdGltZT8gCgpXZSB3aWxsIG5vdyB0YWtlIHRoZSBjb2RlIHdlIGNyZWF0ZWQgYWJvdmUgdG8gY291bnQgdXAgaG93IG1hbnkgdGltZXMgd2Ugd2luIHdoZW4gc3dpdGNoZWQsIGFzIGNvbXBhcmVkIHRvIHdoZW4gd2UgZG8gTk9UIHN3aXRjaCBieSBjb21wYXJpbmcgYSBmdW5jdGlvbiBhbmQgcnVubmluZyBpdCBvdmVyIGFuZCBvdmVyIGFnYWluICgxMDAwIHRpbWVzKS4KCmBgYHtyfQptb250eSA8LSBmdW5jdGlvbihzd2l0Y2ggPSBUUlVFKSB7CiAgc2FtX2Rvb3IgPC0gc2FtcGxlKGMoIkEiLCJCIiwiQyIpLDEpIDsgcHJpemVfZG9vciA8LSBzYW1wbGUoYygiQSIsIkIiLCJDIiksMSkKICBpZmVsc2Uoc3dpdGNoLHNhbV9kb29yICE9IHByaXplX2Rvb3Isc2FtX2Rvb3IgPT0gcHJpemVfZG9vcikKfQptb250eShGQUxTRSkKcmVxdWlyZShkcGx5cikgIyAnJT4lJyBmcm9tJ2RwbHlyJwoKKChpZl9zd2l0Y2ggPC0gcmVwbGljYXRlKDEwMDAsbW9udHkoc3dpdGNoID0gVFJVRSkpKSAlPiUgbWVhbikgICAjIHByb2R1Y2VzIGEgdmVjdG9yIGFuZCBmaW5kcyB0aGUgbWVhbiAKKChpZl9zdGF5IDwtIHJlcGxpY2F0ZSgxMDAwLG1vbnR5KHN3aXRjaCA9IEZBTFNFKSkpICU+JSBtZWFuKQpgYGAKCiAgICAjIyBbMV0gMC42ODYKICAgICMjIFsxXSAwLjMyOQoKV2UgYXJlIHZlcnkgY2xvc2UgdG8gUm9vcGFtJ3MgZGlhZ3JhbSBzaG93aW5nIDIvMyBjaGFuY2Ugb2Ygd2lubmluZyB3aGVuIHdlIHN3aXRjaCwgd2hlcmVhcyAzMyUgY2hhbmNlIG9mIHdpbm5pbmcgd2hlbiB3ZSBzdGF5LiBJdCBpcyBwb3dlcmZ1bCB3aGF0IHdlIGNhbiBkZWNpcGhlciBmcm9tIGNvbmRpdGlvbmFsIHByb2JhYmlsaXRpZXMgYW5kIGZyb20gd2hhdCBzaW11bGF0aW9uIHN0dWRpZXMgY2FuIHNob3cgdXMhIEhvcGVmdWxseSB0aGlzIHdpbGwgZ2l2ZSB1cyBzb21lIG1vcmUgaW5zaWdodHMgb24gY2hvaWNlcyB0aGF0IG1heSBub3QgYmUgYXMgb2J2aW91cyB0byB1cyBhcyB0aGV5IG1heSBzZWVtLiAKCkhvcGUgeW91IGhhZCBzb21lIGZ1biEKCg==