Separate a set into two disjoint subsets (all combinations)

Question

Define the set A={1,2}. How do I generate all possible combinations that A can be separated into two disjoint subsets B and C? For n=2 the possible combinations are

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

How do I generalize this to any n? Preferably in VBA (or any other language will do).

Thank you.

Answer 1

Here's what I did. Sorry I can't remember the exact source of GenerateCombinationsso I cannot give credit. GenerateCombinations returns a jagged array (Variant) of combinations.

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