VBA Help Identifying Logic Error

mudz78

New Member
Joined
Jun 4, 2004
Messages
38
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



Code:
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
 

Some videos you may like

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.

Tazguy37

MrExcel MVP
Joined
May 28, 2004
Messages
4,237
Shouldn't this:
Rich (BB code):
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:
Rich (BB code):
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

New Member
Joined
Jun 4, 2004
Messages
38
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:

Code:
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

MrExcel MVP
Joined
May 28, 2004
Messages
4,237
Post a sheet sample, and we'll have a look. Post expected results as well as actual.
 

Watch MrExcel Video

Forum statistics

Threads
1,119,128
Messages
5,576,253
Members
412,709
Latest member
Rishu
Top