OK, VB code works. It is even faster than R. (100,50,5) in 1 second. Yours could easily be 10 times faster compiled.
I had to use variant types for the arrays, otherwise it wouldn't work with Excel. You may be able to make them Long types, and that may be faster, I don't know. Also, I included the 4th parameter so that you could optionally provide your own table and only make it 1 time for the same r and large n and k using make_table_once. I couldn't make it a default parameter in Excel, but you probably can in VB6. Right now you have to make it 0, like nconsec(100,50,5,0) and it will make the table for you. Later in your program, you could call make_table_once, and that will return a table that you can put in for the 4th parameter.
Code:
Function pconsec(n As Long, k As Long, r As Long, t As Variant)
pconsec = nconsec(n, k, r, t) / Application.Combin(n, k)
End Function
Function nconsec(n As Long, k As Long, r As Long, t As Variant)
Dim ctable() As Variant
Dim table() As Variant
With WorksheetFunction
If (n = k) Then
nconsec = 1
ElseIf (k < 2 * r) Then
nconsec = .Combin(n - r, k - r) + (n - r) * .Combin(n - r - 1, k - r)
Else
ctable = make_ctable(n, k, r)
If (t = 0) Then table = make_table(n, k, r, ctable) Else table = t
nconsec = recurse(n, k, r, ctable, table)
End If
End With
End Function
Function make_ctable(n As Long, k As Long, r As Long)
ReDim ctable(0 To n - r, 0 To k - r)
Dim i As Long
Dim j As Long
With WorksheetFunction
For i = 0 To n - r
For j = 0 To k - r
ctable(i, j) = Application.Combin(i, j)
Next j
Next i
make_ctable = ctable
End With
End Function
Function make_table(n As Long, k As Long, r As Long, ctable() As Variant)
ReDim table(1 To n - r - 1, 1 To k - r)
Dim x As Long
Dim y As Long
With WorksheetFunction
For x = r To n - r - 1
For y = r To .Min(x, k - r)
If x = y Then
table(x, y) = 1
Else
table(x, y) = recurse(x, y, r, ctable, table)
End If
Next y
Next x
End With
make_table = table
End Function
Function make_table_once(n As Long, k As Long, r As Long)
Dim ctable() As Variant
Dim table() As Variant
ctable = make_ctable(n, k, r)
make_table_once = make_table(n, k, r, ctable)
End Function
Function recurse(n As Long, k As Long, r As Long, ctable() As Variant, table() As Variant)
Dim i As Long
Dim m As Long
recurse = ctable(n - r, k - r) + (n - r) * ctable(n - r - 1, k - r)
For i = 0 To k - 2 * r
For m = r + i To n - k + r + i - 1
recurse = recurse - table(m, r + i) * ctable(n - r - m - 1, k - 2 * r - i)
Next m
Next i
End Function
Last edited by BruceZ; 12-30-2012 at 12:55 PM.
