vba - 生成所有 2^n 个子集的列表

Question

我正在寻找 VBA 中的代码来生成传递数组中项目的所有子集。

下面是选择所有 N 的简单代码，选择数组大小为 N 的 2 个子集。

希望为 N 选择(N-1)... 一直到 N 选择 1。

Option Base 1
Sub nchoose2()

iarray = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12)
n = UBound(iarray)

x = 1
t = 0
r = 0
Do While (n - x) >= 1

    For i = 1 To (n - x)
    Cells((i + t), 1) = iarray(x)
    Cells((i + t), 2) = iarray(i + x)

    Next i



x = x + 1
t = t + (n - (1 + r))
r = r + 1
Loop

End Sub

Answer 1

除了格雷码算法之外，您还可以利用 n 元素集的子集与长度为 n 的二进制向量之间的对应关系。以下代码说明了这种方法:

Sub AddOne(binaryVector As Variant)
'adds one to an array consisting of 0s and 1s
'thought of as a binary number in little-endian
'the vector is modified in place
'all 1's wraps around to all 0's
    Dim bit As Long, carry As Long, i As Long, n As Long
    carry = 1
    n = UBound(binaryVector)
    i = LBound(binaryVector)
    Do While carry = 1 And i <= n
        bit = (binaryVector(i) + carry) Mod 2
        binaryVector(i) = bit
        i = i + 1
        carry = IIf(bit = 0, 1, 0)
    Loop
End Sub


Function listSubsets(items As Variant) As Variant
'returns a variant array of collections
    Dim lb As Long, ub As Long, i As Long, j As Long, numSets As Long
    Dim vect As Variant 'binary vector
    Dim subsets As Variant
    lb = LBound(items)
    ub = UBound(items)
    ReDim vect(lb To ub)
    numSets = 2 ^ (1 + ub - lb)
    ReDim subsets(1 To numSets)
    For i = 1 To numSets
        Set subsets(i) = New Collection
        For j = lb To ub
            If vect(j) = 1 Then subsets(i).Add items(j)
        Next j
        AddOne vect
    Next i
    listSubsets = subsets
End Function

Function showCollection(c As Variant) As String
    Dim v As Variant
    Dim i As Long, n As Long
    n = c.Count
    If n = 0 Then
        showCollection = "{}"
        Exit Function
    End If
    ReDim v(1 To n)
    For i = 1 To n
        v(i) = c(i)
    Next i
    showCollection = "{" & Join(v, ", ") & "}"
End Function

Sub test()
    Dim stooges As Variant
    Dim stoogeSets As Variant
    Dim i As Long
    stooges = Array("Larry", "Curly", "Moe")
    stoogeSets = listSubsets(stooges)
    For i = LBound(stoogeSets) To UBound(stoogeSets)
        Debug.Print showCollection(stoogeSets(i))
    Next i
End Sub

运行代码会产生以下输出:

{}
{Larry}
{Curly}
{Larry, Curly}
{Moe}
{Larry, Moe}
{Curly, Moe}
{Larry, Curly, Moe}