vba - 将一个集合分成两个不相交的子集（所有组合）

Question

定义集合A={1,2}。如何生成所有可能的组合，这些组合A可以分成两个不相交的子集B和C？对于n=2可能的组合是

B     C
1     2
2     1
1,2   Ø
Ø     1,2

我如何将其推广到 any n？最好使用 VBA（或任何其他语言都可以）。

谢谢你。

Answer 1

这就是我所做的。对不起，我不记得确切的来源，GenerateCombinations所以我不能给予信任。GenerateCombinations返回一个锯齿状数组 ( Variant) 的组合。

Sub GenerateBCCombinations(Aset() As Variant, ByRef Bset() As Variant, ByRef Cset() As Variant)
    ' Separates A into two disjoint subsets B and C and generates all possible
    ' combinations hereof

    Dim i As Integer
    Dim b() As Variant

    ' Generate B subset
    Call GenerateCombinations(Aset, Bset)

    ' Generate C subset (complement of B)
    ReDim Cset(UBound(Bset))
    For i = LBound(Cset) To UBound(Cset)
        ReDim b(UBound(Bset(i)))
        b = Bset(i)
        Cset(i) = Complement(b, Aset)
    Next i

    ' Add the trivial case where B = Ø
    ReDim Preserve Bset(UBound(Bset) + 1)
    Bset(UBound(Bset)) = Array(0)
    ReDim Preserve Cset(UBound(Cset) + 1)
    Cset(UBound(Cset)) = Aset

End Sub

Sub GenerateCombinations(ByRef AllFields() As Variant, ByRef result() As Variant)

  Dim InxResultCrnt As Integer
  Dim InxField As Integer
  Dim InxResult As Integer
  Dim i As Integer
  Dim NumFields As Integer
  Dim Powers() As Integer
  Dim ResultCrnt() As Variant

  NumFields = UBound(AllFields) - LBound(AllFields) + 1

  ReDim result(0 To 2 ^ NumFields - 2)  ' one entry per combination
  ReDim Powers(0 To NumFields - 1)          ' one entry per field name

  ' Generate powers used for extracting bits from InxResult
  For InxField = 0 To NumFields - 1
    Powers(InxField) = 2 ^ InxField
  Next

 For InxResult = 0 To 2 ^ NumFields - 2
    ' Size ResultCrnt to the max number of fields per combination
    ' Build this loop's combination in ResultCrnt
    ReDim ResultCrnt(0 To NumFields - 1)
    InxResultCrnt = -1
    For InxField = 0 To NumFields - 1
      If ((InxResult + 1) And Powers(InxField)) <> 0 Then
        ' This field required in this combination
        InxResultCrnt = InxResultCrnt + 1
        ResultCrnt(InxResultCrnt) = AllFields(InxField)
      End If
    Next
    ' Discard unused trailing entries
    ReDim Preserve ResultCrnt(0 To InxResultCrnt)
    ' Store this loop's combination in return array
    result(InxResult) = ResultCrnt
  Next

End Sub

Function Complement(tbl1() As Variant, tbl2() As Variant) As Variant
' Returns the difference between tbl1 and tbl2 where tbl1 is the full set
    Dim tbl(), i&, x&

    For i = LBound(tbl2) To UBound(tbl2)
      If IsError(Application.match(tbl2(i), tbl1, 0)) Then
        x = x + 1
        ReDim Preserve tbl(1 To x)
        tbl(x) = tbl2(i)
      End If
    Next i

    If x = 0 Then tbl = Array(0)

    Complement = tbl
End Function