Monty Hall simulation works but how can I make it more efficient and less redundant

korhan

Board Regular
Joined
Nov 6, 2009
Messages
215
Hi everyone,

I have written a code for Monty Hall problem from scratch. I really didn't read anybody else's because it was making everything more confusing. Results are correct. If you switch you win more; however, my code seems a little redundant. I am trying to shorten it and if you are familiar with this simulation please share thoughts and ideas. Anything is greatly appreciated.

Code:
Option Explicit


Sub Main()
    
    ' Declare constants
    Const highValue As Integer = 3
    Const lowValue As Integer = 1
    Const repeat As Long = 10000
    
    ' Declare variables
    Dim dicDoorsMain As Dictionary
    Dim dicDoorsLeft As Dictionary
    Dim pickedDoor As Integer
    Dim prizeDoor As Integer
    Dim noSwitchCase As Long
    Dim switchCase As Long
    Dim strWinner As String
    Dim scenarios As Integer
    Dim boolSwitch As Boolean
    
    ' Initialize objects
    Set dicDoorsMain = New Dictionary
    Set dicDoorsLeft = New Dictionary
    
    ' Assign values to the object dicDoors


    ' Repeat this game twice for scenarios
    ' 1) Switch
    ' 2) Stay
    
    For scenarios = 1 To 2
    
    switchCase = 0
    noSwitchCase = 0
    
    ' Scenario one
    If scenarios = 1 Then
        boolSwitch = False
    Else
        boolSwitch = True
    End If
        
        ' Declare a counter variable
        ' Loop begins here
        Dim i As Long
        For i = 1 To repeat
                
            ' Set strWinner to null string
            strWinner = Empty
            
            ' Create the dictionary object for main doors (participant's options)
            With dicDoorsMain
                .Add "Door 1", 1
                .Add "Door 2", 2
                .Add "Door 3", 3
            End With
            
            ' Create the dictionary object for doors left( Monty's options)
            With dicDoorsLeft
                .Add "Door 1", 1
                .Add "Door 2", 2
                .Add "Door 3", 3
            End With
                    
            ' Pick prize door and participant's door
            prizeDoor = Int((highValue - lowValue + 1) * Rnd + 1)
            pickedDoor = Int((highValue - lowValue + 1) * Rnd + 1)
            
            ' Remove the doors from the possible selections for switch scenarios
            With dicDoorsLeft
                If .Exists("Door " & prizeDoor) Then: .Remove ("Door " & prizeDoor)
                If .Exists("Door " & pickedDoor) Then: .Remove ("Door " & pickedDoor)
            End With
            
            ' Monty picks a door from possible doors
            Dim montyDoor As Integer
            ' If prizeDoor and pickedDoor are different then Monty has only one choice
            If prizeDoor <> pickedDoor Then
                montyDoor = dicDoorsLeft.Items(0)
            Else
                'If prizeDoor and pickedDoor are the same then Monty has two doors to choose from
                montyDoor = Int((dicDoorsLeft.Count - 1 + 1) * Rnd + 1)
            End If
            
            ' Remove Monty's door from possible options of selections
            With dicDoorsMain
                If .Exists("Door " & montyDoor) Then: .Remove ("Door " & montyDoor)
            End With


            ' Case with no switch
            If boolSwitch = False Then
                If pickedDoor = prizeDoor Then
                    noSwitchCase = noSwitchCase + 1
                    strWinner = "No Switch"
                End If
            ElseIf boolSwitch Then
                ' Case switch
                With dicDoorsMain
                    If .Exists("Door " & pickedDoor) Then: .Remove ("Door " & pickedDoor)
                        If .Keys(0) = "Door " & prizeDoor Then
                            switchCase = switchCase + 1
                            strWinner = "Switch"
                        End If
                End With
            End If
            
            ' Erase dictionary objects
            dicDoorsLeft.RemoveAll
            dicDoorsMain.RemoveAll
        Next i
        
        ' Print the results
        If boolSwitch = False Then
            Debug.Print "No switch " & noSwitchCase / repeat
        ElseIf boolSwitch Then
            Debug.Print "Switch " & switchCase / repeat
        End If
    Next scenarios
End Sub
 

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
If you run your code a couple of times and take note of the results, then close Excel and restart it, your code will generate the same results as before.

Seed the Randomizer one time for each session of Excel. Add these two lines at the top of your code below the declarations.

Code:
    [color=green]'Randomize[/color]
    [color=darkblue]Static[/color] bIsRandomized [color=darkblue]As[/color] [color=darkblue]Boolean[/color]
    [color=darkblue]If[/color] [color=darkblue]Not[/color] bIsRandomized [color=darkblue]Then[/color] Randomize: bIsRandomized = [color=darkblue]True[/color]
 
Upvote 0
If you run your code a couple of times and take note of the results, then close Excel and restart it, your code will generate the same results as before.

Seed the Randomizer one time for each session of Excel. Add these two lines at the top of your code below the declarations.

Code:
    [COLOR=green]'Randomize[/COLOR]
    [COLOR=darkblue]Static[/COLOR] bIsRandomized [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Boolean[/COLOR]
    [COLOR=darkblue]If[/COLOR] [COLOR=darkblue]Not[/COLOR] bIsRandomized [COLOR=darkblue]Then[/COLOR] Randomize: bIsRandomized = [COLOR=darkblue]True[/COLOR]


I did not know that. Thanks for letting me know.
 
Upvote 0
I have written a code for Monty Hall problem from scratch... If you switch you win more
Just wondering if you are aware that you can conclude logically that it is better to switch without doing any calculations.
 
Upvote 0
It's always better to switch; principle of restricted choice.

https://en.wikipedia.org/wiki/Monty_Hall_problem
Wow, I am amazed at the size of that write-up. I remember reading the original Parade/Vos Savant article when it first came out and being struck by how clear the solution was once Vos Savant suggested expanding the number of doors to one million. Once you exaggerate the problem that way, it becomes so clear that your original odds of selecting the correct door were one in a million and that no matter what the host did, that did not change and, in essence, he was ultimately offering you the choice of sticking with your one-in-a-million door or swapping it for all of the other doors en masse. Once you realize that is what is ultimately being offered, the choice of swapping becomes an easy one.
 
Upvote 0
It's common knowledge to decent bridge players; when the player on your left drops one of two touching honors under declarer's winner, the assumption is that it's the only one they hold, since they would be equally likely to drop either if they had both.
 
Last edited:
Upvote 0
It's common knowledge to decent bridge players; when the player on your left drops one of two touching honors under declarer's winner, the assumption is that it's the only one they hold, since they would be equally likely to drop either if they had both.

@shg

WOW i like it! :cool:
Didn't know you are a Bridge player.
The law of restricted choice is applied in many situations, but the best known is something like (9 cards in the suit)
AK10xx (HAND)
xxxx (DUMMY)

Declarer cashes the A (or K) and LHO (Left Hand Opponent) plays either Q or J

See
https://www.larryco.com/bridge-learning-center/detail/103
https://en.wikipedia.org/wiki/Principle_of_restricted_choice
many others in the internet

M.
 
Last edited:
Upvote 0
Just wondering if you are aware that you can conclude logically that it is better to switch without doing any calculations.

Hey Rick,

This was actually a mental challenge for me and it was really fun to simulate. I must admit that it took me a while to really understand the logic behind the whole thing. Had to watch couple of youtube videos.
 
Upvote 0

Forum statistics

Threads
1,223,713
Messages
6,174,043
Members
452,542
Latest member
Bricklin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top