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

korhan

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
 
Sort by date Sort by votes
Here is the improved version of the program.

Code: 
Option Explicit


Sub Main()
    
    ' Declare constants
    Const int_HIGH_VALUE As Integer = 3
    Const int_LOW_VALUE As Integer = 1
    Const int_REPEAT As Long = 10000
    
    ' Declare variables
    Static blnRandomized As Boolean
    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


    ' Seed the randomizer one time for each Excel session
    If Not blnRandomized Then Randomize: blnRandomized = True
    
    ' int_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
    ' Scenario two
    Else
        boolSwitch = True
    End If
        
        ' Declare a counter variable
        ' Loop begins here
        Dim i As Long
        For i = 1 To int_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((int_HIGH_VALUE - int_LOW_VALUE + 1) * Rnd + 1)
            pickedDoor = Int((int_HIGH_VALUE - int_LOW_VALUE + 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 / int_REPEAT
        ElseIf boolSwitch Then
            Debug.Print "Switch " & switchCase / int_REPEAT
        End If
    Next scenarios
End Sub
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]
[/QUOTE]
 
Upvote 0

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
AlphaFrog said:
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]
Click to expand...

Here is the improved version of the program.

Code: 
Option Explicit


Sub Main()
    
    ' Declare constants
    Const int_HIGH_VALUE As Integer = 3
    Const int_LOW_VALUE As Integer = 1
    Const int_REPEAT As Long = 10000
    
    ' Declare variables
    Static blnRandomized As Boolean
    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


    ' Seed the randomizer one time for each Excel session
    If Not blnRandomized Then Randomize: blnRandomized = True
    
    ' int_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
    ' Scenario two
    Else
        boolSwitch = True
    End If
        
        ' Declare a counter variable
        ' Loop begins here
        Dim i As Long
        For i = 1 To int_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((int_HIGH_VALUE - int_LOW_VALUE + 1) * Rnd + 1)
            pickedDoor = Int((int_HIGH_VALUE - int_LOW_VALUE + 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 / int_REPEAT
        ElseIf boolSwitch Then
            Debug.Print "Switch " & switchCase / int_REPEAT
        End If
    Next scenarios
End Sub
 
Upvote 0
You must log in or register to reply here.

Forum statistics

Threads
1,214,945
Messages
6,122,395
Members
449,081
Latest member
JAMES KECULAH

Share this page

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