View Single Post
  #15   Report Post  
Posted to microsoft.public.excel.worksheet.functions
joeu2004 joeu2004 is offline
external usenet poster
 
Posts: 2,059
Default calculating probabilty of x number of successes with multiple

On Jan 9, 5:49*pm, joeu2004 wrote:
Function xprob10(rng As Range) As Double
[....]
fail1 = 1
For t1 = 1 To n - 9
succ1 = p(t1): fail2 = fail1
For t2 = t1 + 1 To n - 8
[....]


Not to beat a dead horse and certainly not to promote this approach
more than it deserves (which is simply in the genre of quick-and-dirty
solutions), but it occurred to me that in the OP's original posting,
10 successes in 21 trials was merely an example, and iandjmsmith's
excellent "xtestc3" function provides the generality to solve any K-in-
N problem. So I wondered how much more effort it would take to hack a
general solution along the same (inelegant) lines of generating all
combinations.

The structure of the "xprob10" function lends itself very nicely to a
recursive implementation, "probN" below, which finds the probability
of exactly K successes in any N trials. Initially, I was worried
about the execution time of a recursive solution; I was tempted to
avoid real recursion. But for the 10-in-21 case, although it does
take about twice as long, on my system, that is only about 460
milliseconds -- still not prohibitive. (Again, YMMV.)

The point again is not that this is an example of a good solution, but
that it should not dismisssed out-of-hand as an impracticable
solution, as long as the number of iterations is reasonable.


' hack implementation to compute probability of exactly K successes
' in K or more trials with varying independent probabilities of
success
' in "rng".
' For 10 in 21, takes about 0.460 seconds on my system (YMMV).

Private p() As Double, q() As Double
Private cnt As Long, n As Long
Private prob As Double


Function probN(rng As Range, nsucc As Long) As Double
Dim i As Long
Dim startTime As Double, endTime As Double
startTime = Timer
cnt = 0
prob = 0
n = rng.Count
If n < nsucc Then GoTo endit
ReDim p(1 To n), q(1 To n)
For i = 1 To n: p(i) = rng(i): q(i) = 1 - p(i): Next
If nsucc 0 Then
Call probNloop(1, n - (nsucc - 1), 1, 1)
ElseIf nsucc = 0 Then
prob = 1
For i = 1 To n: prob = prob * q(i): Next
End If
endit:
probN = prob
endTime = Timer
Debug.Print nsucc & " in " & n & ": " & cnt & Format(endTime -
startTime, " 0.000000 ") & prob
End Function


Private Sub probNloop(ByVal tmin As Long, ByVal tmax As Long, ByVal
succ As Double, ByVal fail As Double)
Dim t As Long
Dim xfail As Double
For t = tmin To tmax
If tmax < n Then
Call probNloop(t + 1, tmax + 1, succ * p(t), fail)
Else
xfail = fail
For i = t + 1 To n: xfail = xfail * q(i): Next
prob = prob + succ * p(t) * xfail
cnt = cnt + 1
End If
fail = fail * q(t)
Next t
End Sub