vba - セットを2つの互いに素なサブセット（すべての組み合わせ）に分割します

Question

セットを定義しますA={1,2}。A2つの互いに素なサブセットに分離できるBすべての可能な組み合わせを生成するにはどうすればよいCですか？n=2可能な組み合わせについては

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

これを一般化するにはどうすればよい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