Ok, this should be that last update for this file.
Below the links, we are also posting the Excel - Visual Basic Code and the Visual Studio - Visual Basic Code.
Each has been formatted for their respective platforms.
You can download the Excel file at the following:
File - ftp://www.jadexcode.com/excel/combinatorialindex.xls
or
Folder - ftp://www.jadexcode.com/excel
Excel - Visual Basic Code
Function RandomLowerUpper(ByVal L As Double, ByVal U As Double) As Double
Randomize Timer
RandomLowerUpper = Int(Rnd() * (U - L + 1)) + L
End Function
Function Fact(ByVal N As Integer) As Double
If (N <= 1) Then
Fact = 1
Else
Fact = N * Fact(N - 1)
End If
End Function
Function Perm(ByVal N As Integer, ByVal R As Integer) As Double
Dim a As Integer
Dim b As Double
b = 1
If (N < R) Then
Perm = 0
Else
For a = N - R + 1 To N
b = b * a
Next a
Perm = b
End If
End Function
Function Comb(ByVal N As Integer, ByVal R As Integer) As Double
If (N < R) Then
Comb = 0
Else
Comb = Perm(N, R) / Fact(R)
End If
End Function
Function Cdist(ByVal N As Integer, ByVal R As Integer, ByVal C As Integer, ByVal Z As Integer) As Double
If (Z < C) Or (Z > (N - R + C)) Or (Z > N) Or (C > R) Or (N < 1) Or (R < 1) Or (C < 1) Or (Z < 1) Then
Cdist = 0
Else
Cdist = Comb(Z - 1, C - 1) * Comb(N - Z, R - C)
End If
End Function
Function fColumnSum(ByVal N As Integer, ByVal R As Integer, ByVal Z As Integer) As Double
Dim a As Integer
Dim ColumnSum As Double
If Z < 1 Then
fColumnSum = 0
ElseIf (Z >= 1) And (Z < N - R + 1) Then
ColumnSum = 0
For a = 1 To Z
ColumnSum = ColumnSum + Cdist(N, R, 1, a)
Next a
fColumnSum = ColumnSum
ElseIf Z >= N - R + 1 Then
fColumnSum = Comb(N, R)
End If
End Function
Function Index2Combin(ByVal N As Integer, ByVal R As Integer, ByVal I As Double) As String
Dim a, b, Combination(), Z As Integer
Dim J As Double
ReDim Combination(R)
Dim tmpString, CombinFormat As String
Dim NumberFound As Boolean
tmpString = ""
CombinFormat = ""
J = I
J = J - 1
Z = 0
b = Len(Format(N, "0"))
For a = 1 To b
CombinFormat = CombinFormat & "0"
Next a
For a = 1 To R
If (I >= 1) And (I <= Comb(N, R)) Then
If a = 1 Then
Combination(a) = 1
Else
Combination(a) = Combination(a - 1) + 1
End If
NumberFound = False
Do
Select Case (J - fColumnSum(N - Z, R - (a - 1), Combination(a) - Z - 1))
Case Is < 0
Combination(a) = Combination(a) - 1
NumberFound = True
Case Is = 0
NumberFound = True
Case Is > 0
Combination(a) = Combination(a) + 1
End Select
Loop Until NumberFound
J = J - fColumnSum(N - Z, R - (a - 1), Combination(a) - Z - 1)
Z = Combination(a)
Else
Combination(a) = 0
End If
tmpString = tmpString & Format(Combination(a), CombinFormat)
If a < R Then tmpString = tmpString & " "
Next a
Index2Combin = tmpString
End Function
Function Combin2Index(ByVal N As Integer, ByVal R As Integer, ByVal theRange As Range) As Double
Dim a As Integer
Dim fSum As Double
Dim NotInAscendingOrder, NotInPool As Boolean
NotInAscendingOrder = False
NotInPool = False
If (theRange.Rows.Count <> 1) Or (theRange.Columns.Count <> R) Then
Combin2Index = -1
Exit Function
End If
For a = 1 To R
If a < R Then
If theRange.Cells(1, a) >= theRange.Cells(1, a + 1) Then
NotInAscendingOrder = True
End If
End If
If (theRange.Cells(1, a) < 1) Or (theRange.Cells(1, a) > N) Then
NotInPool = True
End If
Next a
If NotInAscendingOrder Or NotInPool Then
Combin2Index = -1
Exit Function
End If
fSum = 1
For a = 1 To R
If a = 1 Then
fSum = fSum + fColumnSum(N, R, theRange.Cells(1, 1) - 1)
Else
fSum = fSum + fColumnSum(N - theRange.Cells(1, a - 1), R - a + 1, theRange.Cells(1, a) - theRange.Cells(1, a - 1) - 1)
End If
Next a
Combin2Index = fSum
End Function
Visual Studio - Visual Basic Code
Function RandomLowerUpper(ByVal L As Double, ByVal U As Double) As Double
Randomize()
RandomLowerUpper = Int(Rnd() * (U - L + 1)) + L
End Function
Function Fact(ByVal N As Integer) As Double
If (N <= 1) Then
Fact = 1
Else
Fact = N * Fact(N - 1)
End If
End Function
Function Perm(ByVal N As Integer, ByVal R As Integer) As Double
Dim a As Integer
Dim b As Double
b = 1
If (N < R) Then
Perm = 0
Else
For a = N - R + 1 To N
b = b * a
Next a
Perm = b
End If
End Function
Function Comb(ByVal N As Integer, ByVal R As Integer) As Double
If (N < R) Then
Comb = 0
Else
Comb = Perm(N, R) / Fact(R)
End If
End Function
Function Cdist(ByVal N As Integer, ByVal R As Integer, ByVal C As Integer, ByVal Z As Integer) As Double
If (Z < C) Or (Z > (N - R + C)) Or (Z > N) Or (C > R) Or (N < 1) Or (R < 1) Or (C < 1) Or (Z < 1) Then
Cdist = 0
Else
Cdist = Comb(Z - 1, C - 1) * Comb(N - Z, R - C)
End If
End Function
Function fColumnSum(ByVal N As Integer, ByVal R As Integer, ByVal Z As Integer) As Double
Dim a As Integer
Dim ColumnSum As Double
If Z < 1 Then
fColumnSum = 0
ElseIf (Z >= 1) And (Z < N - R + 1) Then
ColumnSum = 0
For a = 1 To Z
ColumnSum = ColumnSum + Cdist(N, R, 1, a)
Next a
fColumnSum = ColumnSum
ElseIf Z >= N - R + 1 Then
fColumnSum = Comb(N, R)
End If
End Function
Function Index2Combin(ByVal N As Integer, ByVal R As Integer, ByVal I As Double) As String
Dim a, b, Combination(), Z As Integer
Dim J As Double
ReDim Combination(R)
Dim tmpString, CombinFormat As String
Dim NumberFound As Boolean
tmpString = ""
CombinFormat = ""
J = I
J = J - 1
Z = 0
b = Len(Format(N, "0"))
For a = 1 To b
CombinFormat = CombinFormat & "0"
Next a
For a = 1 To R
If (I >= 1) And (I <= Comb(N, R)) Then
If a = 1 Then
Combination(a) = 1
Else
Combination(a) = Combination(a - 1) + 1
End If
NumberFound = False
Do
Select Case (J - fColumnSum(N - Z, R - (a - 1), Combination(a) - Z - 1))
Case Is < 0
Combination(a) = Combination(a) - 1
NumberFound = True
Case Is = 0
NumberFound = True
Case Is > 0
Combination(a) = Combination(a) + 1
End Select
Loop Until NumberFound
J = J - fColumnSum(N - Z, R - (a - 1), Combination(a) - Z - 1)
Z = Combination(a)
Else
Combination(a) = 0
End If
tmpString = tmpString & Format(Combination(a), CombinFormat)
If a < R Then tmpString = tmpString & " "
Next a
Index2Combin = tmpString
End Function
Function Combin2Index(ByVal N As Integer, ByVal R As Integer, ByVal theRange() As Integer) As Double
Dim a As Integer
Dim fSum As Double
Dim NotInAscendingOrder, NotInPool As Boolean
NotInAscendingOrder = False
NotInPool = False
If (UBound(theRange) <> R) Then
Combin2Index = -1
Exit Function
End If
For a = 1 To R
If a < R Then
If theRange(a) >= theRange(a + 1) Then
NotInAscendingOrder = True
End If
End If
If (theRange(a) < 1) Or (theRange(a) > N) Then
NotInPool = True
End If
Next a
If NotInAscendingOrder Or NotInPool Then
Combin2Index = -1
Exit Function
End If
fSum = 1
For a = 1 To R
If a = 1 Then
fSum = fSum + fColumnSum(N, R, theRange(1) - 1)
Else
fSum = fSum + fColumnSum(N - theRange(a - 1), R - a + 1, theRange(a) - theRange(a - 1) - 1)
End If
Next a
Combin2Index = fSum
End Function