The so-called Monty Hall or Let’s Make a Deal problem has caused much consternation over the years. It is named for an old television program. A contestant is presented with three doors. Behind one door is a fabulous prize; behind the other two doors are virtually worthless prizes. The contestant chooses a door. The host of the show, Monty Hall, then opens one of the remaining two doors, revealing one of the worthless prizes. Because Monty is the host, he knows which doors conceal the worthless prizes and always chooses one of them to reveal, but never the door chosen by the contestant. Then the contestant is offered the choice of keeping what is behind her original door or trading for what is behind the remaining unopened door. What should she do?

There are two popular answers. • There are two unopened doors, they are equally likely to conceal the fabulous prize, so it doesn’t matter which one she chooses. • She had a 1/3 probability of choosing the right door initially, a 2/3 chance of getting the prize if she trades, so she should trade.

Solving the problem by simulation: Let’s calculate the probability of winning if you don’t change your inital choice after Monte reveals one door without a prize.

nSims<-10000
prizeMat<-rmultinom(n=nSims, size=1, prob=c(rep(1,3))) # 1 indicates prize, 0 no prize.
doorChoseMat<-rmultinom(n=nSims, size=1, prob=c(rep(1,3)))
winnerMat<-prizeMat*doorChoseMat
sum(apply(winnerMat,2,sum))/nSims 
[1] 0.3394

~1/3 as expected

Next, Let’s next calculate the probability of winning if you do change your inital choice after Monte reveals one door without prize. Note that we know this has to equal 2/3 so that the total probability sums to 1.

nSims<- 10000
prizeMat<-rmultinom(n=nSims, size=1, prob=c(rep(1,3))) # 1 indicates prize, 0 no prize.
doorChoseMat<-rmultinom(n=nSims, size=1, prob=c(rep(1,3)))
winCount<-0
for(i in 1:nSims){ 
  indexChoosen<-which(doorChoseMat[,i]==1, arr.ind = TRUE) # index of the door choosen by contestant
  index0s<-which(prizeMat[,i]==0, arr.ind = TRUE) # positions that contain 0's
  setMonteCanReveal<-setdiff(index0s,indexChoosen)
  doorMonteReveals<-ifelse(length(setMonteCanReveal)>1,sample(x=setMonteCanReveal,size=1),setMonteCanReveal)
  doorChoosen<-setdiff(c(1,2,3),c(doorMonteReveals,indexChoosen))
  if(prizeMat[doorChoosen,i]==1){winCount<-winCount+1}
  # browser()
}
winCount/nSims
[1] 0.6734

Probability is ~2/3 if you change your door

LS0tCnRpdGxlOiAiUiBOb3RlYm9vayIKb3V0cHV0OiBodG1sX25vdGVib29rCi0tLQoKVGhlIHNvLWNhbGxlZCBNb250eSBIYWxsIG9yIExldOKAmXMgTWFrZSBhIERlYWwgcHJvYmxlbSBoYXMgY2F1c2VkIG11Y2ggY29uc3Rlcm5hdGlvbiBvdmVyIHRoZSB5ZWFycy4gSXQgaXMgbmFtZWQgZm9yIGFuIG9sZCB0ZWxldmlzaW9uIHByb2dyYW0uIEEgY29udGVzdGFudCBpcyBwcmVzZW50ZWQgd2l0aCB0aHJlZSBkb29ycy4gQmVoaW5kIG9uZSBkb29yIGlzIGEgZmFidWxvdXMgcHJpemU7IGJlaGluZCB0aGUgb3RoZXIgdHdvIGRvb3JzIGFyZSB2aXJ0dWFsbHkgd29ydGhsZXNzIHByaXplcy4gVGhlIGNvbnRlc3RhbnQgY2hvb3NlcyBhIGRvb3IuIFRoZSBob3N0IG9mIHRoZSBzaG93LCBNb250eSBIYWxsLCB0aGVuIG9wZW5zIG9uZSBvZiB0aGUgcmVtYWluaW5nIHR3byBkb29ycywgcmV2ZWFsaW5nIG9uZSBvZiB0aGUgd29ydGhsZXNzIHByaXplcy4gQmVjYXVzZSBNb250eSBpcyB0aGUgaG9zdCwgaGUga25vd3Mgd2hpY2ggZG9vcnMgY29uY2VhbCB0aGUgd29ydGhsZXNzIHByaXplcyBhbmQgYWx3YXlzIGNob29zZXMgb25lIG9mIHRoZW0gdG8gcmV2ZWFsLCBidXQgbmV2ZXIgdGhlIGRvb3IgY2hvc2VuIGJ5IHRoZSBjb250ZXN0YW50LiBUaGVuIHRoZSBjb250ZXN0YW50IGlzIG9mZmVyZWQgdGhlIGNob2ljZSBvZiBrZWVwaW5nIHdoYXQgaXMgYmVoaW5kIGhlciBvcmlnaW5hbCBkb29yIG9yIHRyYWRpbmcgZm9yIHdoYXQgaXMgYmVoaW5kIHRoZSByZW1haW5pbmcgdW5vcGVuZWQgZG9vci4gV2hhdCBzaG91bGQgc2hlIGRvPwoKVGhlcmUgYXJlIHR3byBwb3B1bGFyIGFuc3dlcnMuCiDigKIgVGhlcmUgYXJlIHR3byB1bm9wZW5lZCBkb29ycywgdGhleSBhcmUgZXF1YWxseSBsaWtlbHkgdG8gY29uY2VhbCB0aGUgZmFidWxvdXMgcHJpemUsIHNvIGl0IGRvZXNu4oCZdCBtYXR0ZXIgd2hpY2ggb25lIHNoZSBjaG9vc2VzLgrigKIgU2hlIGhhZCBhIDEvMyBwcm9iYWJpbGl0eSBvZiBjaG9vc2luZyB0aGUgcmlnaHQgZG9vciBpbml0aWFsbHksIGEgMi8zIGNoYW5jZSBvZiBnZXR0aW5nIHRoZSBwcml6ZSBpZiBzaGUgdHJhZGVzLCBzbyBzaGUgc2hvdWxkIHRyYWRlLgoKU29sdmluZyB0aGUgcHJvYmxlbSBieSBzaW11bGF0aW9uOgpMZXQncyBjYWxjdWxhdGUgdGhlIHByb2JhYmlsaXR5IG9mIHdpbm5pbmcgaWYgeW91IGRvbid0IGNoYW5nZSB5b3VyIGluaXRhbCBjaG9pY2UgYWZ0ZXIgTW9udGUgcmV2ZWFscyBvbmUgZG9vciB3aXRob3V0IGEgcHJpemUuCgpgYGB7cn0KblNpbXM8LTEwMDAwCnByaXplTWF0PC1ybXVsdGlub20obj1uU2ltcywgc2l6ZT0xLCBwcm9iPWMocmVwKDEsMykpKSAjIDEgaW5kaWNhdGVzIHByaXplLCAwIG5vIHByaXplLgpkb29yQ2hvc2VNYXQ8LXJtdWx0aW5vbShuPW5TaW1zLCBzaXplPTEsIHByb2I9YyhyZXAoMSwzKSkpCndpbm5lck1hdDwtcHJpemVNYXQqZG9vckNob3NlTWF0CnN1bShhcHBseSh3aW5uZXJNYXQsMixzdW0pKS9uU2ltcyAKYGBgCgp+MS8zIGFzIGV4cGVjdGVkCgpOZXh0LCBMZXQncyBuZXh0IGNhbGN1bGF0ZSB0aGUgcHJvYmFiaWxpdHkgb2Ygd2lubmluZyBpZiB5b3UgZG8gY2hhbmdlIHlvdXIgaW5pdGFsIGNob2ljZSBhZnRlciBNb250ZSByZXZlYWxzIG9uZSBkb29yIHdpdGhvdXQgcHJpemUuIE5vdGUgdGhhdCB3ZSBrbm93IHRoaXMgaGFzIHRvIGVxdWFsIDIvMyBzbyB0aGF0IHRoZSB0b3RhbCBwcm9iYWJpbGl0eSBzdW1zIHRvIDEuIAoKYGBge3J9CgpuU2ltczwtIDEwMDAwCnByaXplTWF0PC1ybXVsdGlub20obj1uU2ltcywgc2l6ZT0xLCBwcm9iPWMocmVwKDEsMykpKSAjIDEgaW5kaWNhdGVzIHByaXplLCAwIG5vIHByaXplLgpkb29yQ2hvc2VNYXQ8LXJtdWx0aW5vbShuPW5TaW1zLCBzaXplPTEsIHByb2I9YyhyZXAoMSwzKSkpCndpbkNvdW50PC0wCmZvcihpIGluIDE6blNpbXMpeyAKICBpbmRleENob29zZW48LXdoaWNoKGRvb3JDaG9zZU1hdFssaV09PTEsIGFyci5pbmQgPSBUUlVFKSAjIGluZGV4IG9mIHRoZSBkb29yIGNob29zZW4gYnkgY29udGVzdGFudAogIGluZGV4MHM8LXdoaWNoKHByaXplTWF0WyxpXT09MCwgYXJyLmluZCA9IFRSVUUpICMgcG9zaXRpb25zIHRoYXQgY29udGFpbiAwJ3MKICBzZXRNb250ZUNhblJldmVhbDwtc2V0ZGlmZihpbmRleDBzLGluZGV4Q2hvb3NlbikKICBkb29yTW9udGVSZXZlYWxzPC1pZmVsc2UobGVuZ3RoKHNldE1vbnRlQ2FuUmV2ZWFsKT4xLHNhbXBsZSh4PXNldE1vbnRlQ2FuUmV2ZWFsLHNpemU9MSksc2V0TW9udGVDYW5SZXZlYWwpCiAgZG9vckNob29zZW48LXNldGRpZmYoYygxLDIsMyksYyhkb29yTW9udGVSZXZlYWxzLGluZGV4Q2hvb3NlbikpCiAgaWYocHJpemVNYXRbZG9vckNob29zZW4saV09PTEpe3dpbkNvdW50PC13aW5Db3VudCsxfQogICMgYnJvd3NlcigpCn0Kd2luQ291bnQvblNpbXMKCmBgYAoKIFByb2JhYmlsaXR5IGlzIH4yLzMgaWYgeW91IGNoYW5nZSB5b3VyIGRvb3IKCgo=