[汇编]组合数的序列号

[汇编]组合数的序列号 组合数的序列号 以下程序为 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