[重点]组合数的序列号
组合数的序列号
以下程序为 Excel VBA 代码
'号码(已经按升序排列,否则,必需先排序)转成序号
'本函数不对数据的有效性进行检测,输入的数据必须有意义
'当计算量较大时,将 N,M作为模块或者类的私有变量,这样,使
用时就不必重复的进行初始化。
Public Function NumberToSerial(ByVal N As Long, ByVal M As Long,
ByRef Numbers() As Long) As Long
'当计算量较大时,将CalTable() 作为模块或者类的私有变量,
这样,使用时就不必重复的进行初始化。
Dim CalTable() As Long
'初始化序号计算
:CalTable
If Not InitializeCalTable(N, M, CalTable) Then
NumberToSerial = 1
Exit Function
End If
Dim i As Long, j As Long, TempSerial As Long
TempSerial = 0
'计算第一个号码的序号的权重
For i = 1 To Numbers(1) - 1
TempSerial = TempSerial + CalTable(i, 1)
Next
Dim ptrRowStart As Long '指向序号计算表开始累加的行
Dim AccumulateRows As Long '计算表开始累加的行数
ptrRowStart = Numbers(1)
'计算二至 M-1 个号码的序号的权重
For j = 2 To M - 1
AccumulateRows = Numbers(j) - (Numbers(j - 1) + 1)
If AccumulateRows > 0 Then
For i = ptrRowStart To ptrRowStart + AccumulateRows - 1
TempSerial = TempSerial + CalTable(i, j)
Next
ptrRowStart = ptrRowStart + AccumulateRows
End If
Next
TempSerial = TempSerial + (Numbers(M) - Numbers(M - 1))
NumberToSerial = TempSerial '返回结果
End Function
'序号转成号码(按升序排列)
'本函数不对数据的有效性进行检测,输入的数据必须有意义
'当计算量较大时,将 N,M作为模块或者类的私有变量,这样,使
用时就不必重复的进行初始化。
Public Function SerialToNumber(ByVal N As Long, ByVal M As Long,
ByVal Serial As Long) As Long()
'当计算量较大时,将CalTable() 作为模块或者类的私有变量,
这样,使用时就不必重复的进行初始化。
Dim CalTable() As Long
'初始化序号计算表:CalTable
If Not InitializeCalTable(N, M, CalTable) Then
Exit Function
End If
Dim i As Long, j As Long, Numbers() As Long, CurNumber As
Long
ReDim Numbers(1 To M)
'计算第一个号码
Dim ptrRowStart As Long '指向序号计算表开始行
Dim N_M As Long
N_M = N - M
ptrRowStart = 1
CurNumber = 1
Do While Serial > CalTable(ptrRowStart, 1)
Serial = Serial - CalTable(ptrRowStart, 1)
ptrRowStart = ptrRowStart + 1 '行指针加 1
CurNumber = CurNumber + 1 '当前号码加 1
'已经查到计算表的最后一列,后面的数必定是连续的
'没有这行代码,此种情况可能导致 CalTable(ptrRowStart, 1) 下标越界的错误
If ptrRowStart > N_M Then Exit Do
Loop
Numbers(1) = CurNumber
'计算二至 M-1 个号码
For j = 2 To M - 1
If ptrRowStart <= N_M Then '必须判断一下,否则可能导
致 CalTable(ptrRowStart, j) 下标越界的错误
Do While Serial > CalTable(ptrRowStart, j)
Serial = Serial - CalTable(ptrRowStart, j)
ptrRowStart = ptrRowStart + 1 '行指针加 1
CurNumber = CurNumber + 1 '当前号码加 1
'已经查到计算表的最后一列,后面的数必定是连
续的
'没有这行代码,此种情况可能导致
CalTable(ptrRowStart, j) 下标越界的错误
If ptrRowStart > N_M Then Exit Do
Loop
End If
CurNumber = CurNumber + 1 '当前号码加 1
Numbers(j) = CurNumber
Next
'计算最后一位号码
Numbers(M) = CurNumber + Serial
'返回结果
SerialToNumber = Numbers
End Function
'初始化序号计算表:CalTable
'当计算量较大时,将 N,M,CalTable() 作为模块或者类的私有变量,这样,使用时就不必重复的进行初始化。 Private Function InitializeCalTable(ByVal N As Long, ByVal M
As Long, ByRef CalTable() As Long) As Boolean
If N < 2 Or M < 1 Or N <= M Then
'这类情况没有什么意义
InitializeCalTable = False
Exit Function
End If
'表的行数为:N - M,列数为: M - 1
Dim i As Long, j As Long, k As Long
Dim N2 As Long, M2 As Long
N2 = N - M
M2 = M - 1
ReDim CalTable(1 To N2, 1 To M2) As Long
'给 CalTable 最后一列赋值
k = 1
For i = N2 To 1 Step -1
k = k + 1
CalTable(i, M2) = k
Next
'给 CalTable 最后一行赋值
k = 1
For j = M2 To 1 Step -1
k = k + 1
CalTable(N2, j) = k
Next
'给 CalTable 其他单元赋值
For j = M2 - 1 To 1 Step -1 '一般来说,CalTable 的行数教列数多,这样计算效率可能会高些
For i = N2 - 1 To 1 Step -1
CalTable(i, j) = CalTable(i, j + 1) + CalTable(i
+ 1, j)
Next
Next
InitializeCalTable = True
End Function
'生成字典排序(升序)组合数,返回值为组合值 Public Function GenerateCombNumber(ByVal N As Long, ByVal M As
Long, ByRef ReturnValue() As Long) As Long
If N < 2 Or M < 1 Or N <= M Then
'这类情况没有什么意义
GenerateCombNumber = -1
Exit Function
End If
Dim Cnt As Long, ptrCurM As Long, CombCnt As Long
'计算组合值
CombCnt = 1
For Cnt = 1 To M
CombCnt = CombCnt * (N - Cnt + 1)
Next
For Cnt = 1 To M
CombCnt = CombCnt / Cnt
Next
GenerateCombNumber = CombCnt '返回组合值
ReDim ReturnValue(1 To CombCnt, 1 To M)
Dim i As Long, k As Long, CombNumber() As Long
ReDim CombNumber(1 To M)
'生成字典排序(升序)组合数
'第一组组合数
For i = 1 To M
ReturnValue(1, i) = i
CombNumber(i) = i
Next
Cnt = 1
ptrCurM = M '指向最后一个数
'后面的组合数
Do While Cnt < CombCnt
If ptrCurM = M Then
'将最后一位递增到 N
For i = CombNumber(M) + 1 To N
CombNumber(M) = i
'保存当前组合数结果
Cnt = Cnt + 1
For k = 1 To M
ReturnValue(Cnt, k) = CombNumber(k)
Next
Next
ptrCurM = M - 1 '将指针前移一位
Else
If CombNumber(ptrCurM) + 1 < CombNumber(ptrCurM +
1) Then
'和后面的数不相连,这个位置的数就加 1,并将其后的数依次排好
CombNumber(ptrCurM) = CombNumber(ptrCurM) + 1
For i = ptrCurM + 1 To M
CombNumber(i) = CombNumber(i - 1) + 1
Next
ptrCurM = M '将指针指向最后一位,继续
'保存当前组合数结果
Cnt = Cnt + 1
For k = 1 To M
ReturnValue(Cnt, k) = CombNumber(k)
Next
Else
'和后面的号码相连
ptrCurM = ptrCurM - 1 '将指针前移一位
End If
End If
Loop
End Function