VBA Help Identifying Logic Error

[mudz78]

Hi,

I am trying to write a little application that calculates the odds of getting a user defined result (or greater) on a user defined number of dice with user defined number of sides.

Example:

"What is the chance of rolling a five or a six three times or more, when rolling 5d6?"

The code below is what I have come up with, but I seem to get an unexpected result when I use values as in the example.

The correct result would be 0.002743484

What I get is 0.041152263.

A more complete overview of the results scenario can be found:
http://www.staff.ncl.ac.uk/nikolas.lloyd/wargames/crossfire/cfdiceeg.html. Many thanks to the site authour for the mathematical explanation.


I realise that my code is more than likely not optimised and that I have probably overstated the data types (hey, it stopped the ByRef Type mismatch errors), but I am a bit of a novice user.

Any advice would be greatly appreciated.

Thanks,
-John

Option Explicit
Dim n, x, p, r As Double

Private Sub cmdCalculate_Click()
'Reset Variables

'hold the factorial result
    f = 0
'number of dice being rolled
    n = 0
'probability of success on a single die
    p = 0
'minimum value required on a dice
    r = 0
'numbr of sides on a die
    s = 0
'number of successes required to meet (r) where x<=n
    x = 0
'Start Calculations
    All
End Sub

Private Sub All()
'store cumualtive calculation of odds
Dim result As Double

'Fetch User inputs
    n = CDbl((frmDice.txtTotalDice.Value))
    r = CDbl(frmDice.txtRequiredRoll.Value)
    s = CDbl(frmDice.txtDiceSize.Value)
    x = CDbl((frmDice.txtHits.Value))
    
'calculate odds of success on a single die
    p = CDbl((((d - r) + 1) / d))
    
'Loop, summing odds of desired results. Rolling 5 dice with
'_at least_ three favourable results required means summing
' odds of 3 results, 4 results and 5 results.
'Remember, n is the number of dice (ie 5) and x is the number of successes

    Do While x <= n
        result = result + Individual(n, x, p)
        x = x + 1
    Loop
'Display Result on Form
frmDice.txtResult.Text = 100 * r & " %"
End Sub

Public Function Individual(n, x, p)
'Calculate the odds of acheiving (x) successes rolling (n) dice given single
'die probabiltiy of (p).
'THanks to 
    f = (Factorial(n) / (Factorial(x) * Factorial((n - x)))) _
    * (p ^ x) * ((1 - p) ^ (n - x))
End Function

Function Factorial(ByVal x As Double) As Double
  'perform required factorial calculation
    Dim i As Integer
    Factorial = 1
    
    For i = 1 To x
        Factorial = Factorial * i
    Next i
End Function

 

[Tazguy37]

Shouldn't this:

Public Function Individual(n, x, p) 
'Calculate the odds of acheiving (x) successes rolling (n) dice given single 
'die probabiltiy of (p). 
'THanks to 
    f = (Factorial(n) / (Factorial(x) * Factorial((n - x)))) _ 
    * (p ^ x) * ((1 - p) ^ (n - x)) 
End Function

be:

Public Function Individual(n, x, p) 
'Calculate the odds of acheiving (x) successes rolling (n) dice given single 
'die probabiltiy of (p). 
'THanks to 
    Individual = (Factorial(n) / (Factorial(x) * Factorial((n - x)))) _ 
    * (p ^ x) * ((1 - p) ^ (n - x)) 
End Function

 

[mudz78]

Yep, it should. Thanks.

I have never really used functions before, didn't realise quite how they worked. I also noticed, that making changes to your code in the post and then not testing those changes is a baaad idea.

Fixed all the stupid errors and have ended up with:

Option Explicit
Dim n, x, p, r, s As Double

Private Sub cmdCalculate_Click()
'Reset Variables

'number of dice being rolled
    n = 0
'probability of success on a single die
    p = 0
'minimum value required on a dice
    r = 0
'number of sides on a die
    s = 0
'number of successes required to meet (r) where x<=n
    x = 0
'Start Calculations
    All
End Sub

Private Sub All()
'store cumualtive calculation of odds
Dim result As Double

'Fetch User inputs
    n = CDbl((frmDice.txtTotalDice.Value))
    r = CDbl(frmDice.txtRequiredRoll.Value)
    s = CDbl(frmDice.txtDiceSize.Value)
    x = CDbl((frmDice.txtHits.Value))
    
'calculate odds of success on a single die
    p = CDbl((((s - r) + 1) / s))

'Loop, summing odds of desired results. Rolling 5 dice with
'_at least_ three favourable results required means summing
' odds of 3 results, 4 results and 5 results.
'Remember, n is the number of dice (ie 5) and x is the number of successes

    Do While x <= n
        result = result + Individual(n, x, p)
        x = x + 1
    Loop
    
'Display Result on Form
frmDice.txtResult.Text = Round(100 * result, 2) & " %"
End Sub

Public Function Individual(n, x, p)
'Calculate the odds of acheiving (x) successes rolling (n) dice given single
'die probabiltiy of (p)
    Individual = (Factorial(n) / (Factorial(x) * Factorial((n - x)))) _
    * (p ^ x) * ((1 - p) ^ (n - x))
End Function

Function Factorial(ByVal x As Double) As Double
  'perform required factorial calculation
    Dim i As Integer
    Factorial = 1
    
    For i = 1 To x
        Factorial = Factorial * i
    Next i
End Function

Still not perfect. My end result is out by a fraction of a percent using the example.

Any suggestions?

Cheers,
-John

 

[Tazguy37]

Post a sheet sample, and we'll have a look. Post expected results as well as actual.