非递归解决组合问题
从m 个互不相同元素中取 n 个元素,一般选用递归或回溯算法解决，本文旨在利用进制转换的方法达到这一目的。代码如下
Sub GETALL(ByVal num As Integer, ByRef x As Variant, ByRef RESULT() As String, Optional ByRef all As Long)
Dim A() As String, b() As Integer '临时数组
Dim n As Integer ' 数组元素个数
Dim i As Long '循环变量
Dim TEMP As Long '二进制转换中间变量
Dim num2 As Integer '中间计数变量
n = UBound(x) - LBound(x) + 1 '数组元素个数
If num > n Then MsgBox "ERR!", vbInformation, "WARNING": Exit Sub
ReDim b(0 To n - 1)
all = 0
For i = 0 To 2 ^ n - 1 '循环
TEMP = i
num2 = 0
For j = 0 To n - 1 '转换为二进制
b(j) = TEMP And 1 '0 or 1
TEMP = TEMP \ 2
If b(j) = 1 Then
num2 = num2 + 1
ReDim Preserve A(1 To num2)
A(num2) = x(LBound(x) + j)
End If
Next
If num2 = num Then
all = all + 1
ReDim Preserve RESULT(1 To all)
RESULT(all) = Join(A, ",") '结果保存
Debug.Print RESULT(all) '输出
End If
Next
Debug.Print "从 " & n & " 个元素的数组中选 " & num; " 个元素， 共 " & all & "种组合！"
End Sub
Private Sub Command1_Click()
Dim x, i As Integer
Dim out() As String
x = Array(1, 2, 3, 4, 5, 6, 7, 8)
GETALL 4, x, out
End Sub
输出：
1,2,3,4
1,2,3,5
1,2,4,5
1,3,4,5
2,3,4,5
1,2,3,6
1,2,4,6
1,3,4,6
2,3,4,6
1,2,5,6
1,3,5,6
2,3,5,6
1,4,5,6
2,4,5,6
3,4,5,6
1,2,3,7
1,2,4,7
1,3,4,7
2,3,4,7
1,2,5,7
1,3,5,7
2,3,5,7
1,4,5,7
2,4,5,7
3,4,5,7
1,2,6,7
1,3,6,7
2,3,6,7
1,4,6,7
2,4,6,7
3,4,6,7
1,5,6,7
2,5,6,7
3,5,6,7
4,5,6,7
1,2,3,8
1,2,4,8
1,3,4,8
2,3,4,8
1,2,5,8
1,3,5,8
2,3,5,8
1,4,5,8
2,4,5,8
3,4,5,8
1,2,6,8
1,3,6,8
2,3,6,8
1,4,6,8
2,4,6,8
3,4,6,8
1,5,6,8
2,5,6,8
3,5,6,8
4,5,6,8
1,2,7,8
1,3,7,8
2,3,7,8
1,4,7,8
2,4,7,8
3,4,7,8
1,5,7,8
2,5,7,8
3,5,7,8
4,5,7,8
1,6,7,8
2,6,7,8
3,6,7,8
4,6,7,8
5,6,7,8
从 8 个元素的数组中选 4 个元素， 共 70种组合！
但从运算速度上来说，本方法可能要比递归，回溯慢些。