將一個集合分爲兩個不相交的子集（所有組合）

Question

定義集合A={1,2}。如何生成A可分爲兩個不相交的子集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