jeudi 6 juillet 2017

VBA Random Number in Simulation

I'm trying to create a baseball post season simulator to see how much a bad pitcher impacts a team's championship odds. So I basically created a simulator for the playoffs (3 rounds, first is best of 5, next two are best of 7). And I can see how much a SP would hurt the team if he pitches every third game and he decreases the chance of winning by 10%.

To make sure I did this write, I first ran my simulation without any adjustment so every game both teams would have a 50% chance of winning... (a team would therefore have a 12.5% chance of winning the world series in a 3 round playoff) however, I was getting consistently higher than 12.5.

I have a feeling the problem was with the Rnd function, so I played with that a bit (added a function, tried to vary the time ect.), now my simulation comes out to be <12.5%. I then tried to trouble shoot and noticed that in each round was not being won 50% of the time... which was the case each time I re-ran the simulation (Like round 1 would have a 47% success then round two 51% then round three 58%... then the next run would return 46%, 52%, 59%.

Am I do something wrong, or is this just something the rnd function is not great at handling?

Public Function wRandomNumber(lowerbound, upperbound, Optional rndType = 1) As Double
Dim rndVariable As Double
'Const ms As Double = 0.000000011574

Randomize Timer
'Application.Wait Now + ms * 1
rndVariable = Rnd
If rndType = 1 Then
    wRandomNumber = Int((upperbound - lowerbound + 1) * rndVariable + lowerbound)
ElseIf rndType = 2 Then
    If (upperbound - lowerbound + 1) * rndVariable + lowerbound <= upperbound Then
        wRandomNumber = (upperbound - lowerbound + 1) * rndVariable + lowerbound
    Else
        Do While (upperbound - lowerbound + 1) * rndVariable + lowerbound > upperbound
            rndVariable = Rnd
            If (upperbound - lowerbound + 1) * rndVariable + lowerbound <= upperbound Then
                wRandomNumber = (upperbound - lowerbound + 1) * rndVariable + lowerbound
            End If
        Loop
    End If
End If

End Function

Public Sub Playoff_sim()

Dim game_num As Integer
Dim lds_wins_stros As Integer
Dim lds_loss_stros As Integer
Dim lcs_wins_stros As Integer
Dim lcs_loss_stros As Integer
Dim ws_wins_stros As Integer
Dim ws_loss_stros As Integer
Dim p As Double
Dim outcome1 As Single
Dim outcome2 As Single
Dim outcome3 As Single
Dim i As Double
Dim iter As Double
Dim CHAMPS As Double
Dim Loser As Double
Dim p_bad As Double
Dim p_norm As Double
Dim lds_champs As Double
Dim lcs_champs As Double
Dim r As Double
Const ms As Double = 0.000000011574

iter = 100000
CHAMPS = 0
Loser = 0
lds_champs = 0
lcs_champs = 0
p_bad = 0.5
p_norm = 0.5
r = 0
For i = 1 To iter

game_num = 1
lds_wins_stros = 0
lds_loss_stros = 0
lcs_wins_stros = 0
lcs_loss_stros = 0
ws_loss_stros = 0
ws_wins_stros = 0

Do Until lds_wins_stros = 3 Or lds_loss_stros = 3

outcome1 = wRandomNumber(0, 1, 2)
    If game_num = 3 Then
        p = p_bad
    Else
        p = p_norm
    End If

    If p > outcome1 Then
        lds_wins_stros = lds_wins_stros + 1
    Else
        lds_loss_stros = lds_loss_stros + 1
    End If
    r = r + 1
    'Worksheets("Playoff_Sim").Cells(r, 15).Value = outcome1

game_num = game_num + 1
Loop

If lds_wins_stros = 3 Then

    outcome2 = wRandomNumber(0, 1, 2)
    lds_champs = 1 + lds_champs
    Do Until lcs_wins_stros = 4 Or lcs_loss_stros = 4

    If game_num = 3 Or 6 Or 9 Or 12 Or 15 Or 18 Or 21 Then
        p = p_bad
    Else
        p = p_norm
    End If

    If p > outcome2 Then
        lcs_wins_stros = lcs_wins_stros + 1
    Else
        lcs_loss_stros = lcs_loss_stros + 1
    End If

    game_num = game_num + 1

    Loop

    If lcs_wins_stros = 4 Then
        lcs_champs = lcs_champs + 1

        outcome3 = wRandomNumber(0, 1, 2)
        Do Until ws_wins_stros = 4 Or ws_loss_stros = 4

            If game_num = 3 Or 6 Or 9 Or 12 Or 15 Or 18 Or 21 Then
                p = p_bad
            Else
                p = p_norm
            End If

            If p > outcome3 Then
                ws_wins_stros = ws_wins_stros + 1
            Else
                ws_loss_stros = ws_loss_stros + 1
            End If
        'r = r + 1
        game_num = game_num + 1
        'Worksheets("Playoff_Sim").Cells(r, 15).Value = outcome3
        Loop

        If ws_wins_stros = 4 Then
            CHAMPS = CHAMPS + 1
        Else
            Loser = Loser + 1
        End If

    Else
        Loser = Loser + 1
    End If

Else
    Loser = Loser + 1
End If

Next i

Worksheets("Playoff_Sim").Cells(2, 1).Value = CHAMPS
Worksheets("Playoff_Sim").Cells(2, 2).Value = Loser
Worksheets("Playoff_Sim").Cells(2, 3).Value = lds_champs
Worksheets("Playoff_Sim").Cells(2, 4).Value = lcs_champs

End Sub




Aucun commentaire:

Enregistrer un commentaire