从多个集合中创建所有可能的组合

Posted 2023-03-31

【中文标题】从多个集合中创建所有可能的组合

【英文标题】：Creating all possible combinations from multiple sets

【发布时间】：2018-06-08 16:33:53

【问题描述】：

我的数学知识有限，如果我弄错了，请原谅这些术语。 我需要，其中至少包含一个项目。

 - SetA: [1, 2, 3, 4, 5, 6, 7] 
 - SetB: [a, b, c, d] 
 - SetC: [!, @, #, $, %]

示例输出：

 - [1,a,!]
 - [1,2,a,c,@]
 - [1,2,3,4,5,6,7,a,b,c,d,!,@,#,$,%]

是否有一个特定的组合公式，因为我只能想出嵌套循环，我不确定它是否正确。

【问题讨论】：

你使用什么语言？

嗨@Stedy我目前在excel中使用VBA

您可以计算三个集合的并集的幂集，然后使用拒绝采样来拒绝幂集中不包含每个集合中至少一个成员的元素。

【参考方案1】：

@barrycarter 有一个很好的主意来获得power set。然而，我们不需要拒绝任何东西，因为我们没有得到集合并集的幂集（这最终会变得低效，因为随着集合数量的增加会有很多拒绝）。我们只需获取每个集合的幂集，然后获取这些幂集的所有组合。下面的子程序适用于任意长度的任意数量的集合。

Sub CreateAllCombs()

Dim ArrayOfPowSets() As Variant, mySet() As Variant, ArrCounter() As Long, myPS As Variant
Dim myCombs() As Variant, nextComb() As Variant, ParentComb() As Variant, ArrMax() As Long
Dim i As Long, j As Long, k As Long, count1 As Long, count2 As Long, CombExist As Boolean
Dim tempCol As Long, myMax As Long, maxRow As Long, totalCombs As Long

   With ActiveSheet
        maxRow = .Cells(.Rows.count, "A").End(xlUp).Row
    End With

   ReDim ArrayOfSets(1 To maxRow, 1 To 1)
   ReDim ArrCounter(1 To maxRow)
   ReDim ArrMax(1 To maxRow)
   myMax = 0

    For i = 1 To maxRow
        With ActiveSheet
            tempCol = .Cells(i, .Columns.count).End(xlToLeft).Column
        End With
        ReDim mySet(1 To tempCol)
        For j = 1 To tempCol: mySet(j) = Cells(i, j): Next j
        myPS = PowerSet(mySet)
        ArrMax(i) = UBound(myPS)
        If ArrMax(i) > myMax Then
            myMax = ArrMax(i)
            ReDim Preserve ArrayOfPowSets(1 To maxRow, 1 To ArrMax(i))
        End If
        For j = 1 To ArrMax(i)
            ArrayOfPowSets(i, j) = myPS(j)
        Next j
        ArrCounter(i) = 1
    Next i

    CombExist = True
    totalCombs = 0

    Do While CombExist
        count1 = 1
        ReDim ParentComb(1 To 1)

        For i = 1 To maxRow - 1
            For j = 1 To UBound(ArrayOfPowSets(i, ArrCounter(i)))
                ReDim Preserve ParentComb(1 To count1)
                ParentComb(count1) = ArrayOfPowSets(i, ArrCounter(i))(j)
                count1 = count1 + 1
            Next j
        Next i

        For i = 1 To ArrMax(maxRow)
            count2 = count1
            nextComb = ParentComb
            For j = 1 To UBound(ArrayOfPowSets(maxRow, i))
                ReDim Preserve nextComb(1 To count2)
                nextComb(count2) = ArrayOfPowSets(maxRow, i)(j)
                count2 = count2 + 1
            Next j
            totalCombs = totalCombs + 1
            ReDim Preserve myCombs(1 To totalCombs)
            myCombs(totalCombs) = nextComb
        Next i

        k = maxRow - 1

        Do While (ArrCounter(k) >= ArrMax(k))
            ArrCounter(k) = 1
            k = k - 1
            If k = 0 Then Exit Do
        Loop

        If k > 0 Then ArrCounter(k) = ArrCounter(k) + 1 Else CombExist = False

    Loop

    Sheets("Sheet2").Select

    For i = 1 To totalCombs
        For j = 1 To UBound(myCombs(i))
            Cells(i, j) = myCombs(i)(j)
        Next j
    Next i

End Sub

我使用了 John Coleman 编写的幂集函数的略微修改版本，发现 here

Function PowerSet(Items As Variant) As Variant

    Dim PS As Variant
    Dim i As Long, j As Long, k As Long, n As Long
    Dim subset() As Variant

    n = UBound(Items)
    ReDim PS(1 To 1 + 2 ^ n - 2)
    For i = 1 To 2 ^ n - 1
        ReDim subset(1 To n)
        k = 0
        For j = 0 To n - 1
            If i And 2 ^ j Then
                k = k + 1
                subset(k) = Items(j + 1)
            End If
        Next j
        ReDim Preserve subset(1 To k)
        PS(i) = subset
    Next i

    PowerSet = PS

End Function

这假设 SetA 在第 1 行，SetB 在第 2 行，等等。观察：

此外，应该警告读者，这可能需要一段时间，因为有超过 1400 万种可能的组合。

(2^3 - 1) * (2^5 - 1) * (2^16 - 1) = 7 * 31 * 65535 = 14221095

此外，所有组合通常都写到Sheet2。

【讨论】：

感谢您的回答，我找到了另一种解决方案，因为我正在尝试处理长度为 7、8、12 的集合，并且超过 1 亿个组合。

【参考方案2】：

我想我找到了解决方案，请验证。

首先，对于每个集合，我创建了所有可能的组合，并使用不带空值的帕斯卡三角形之和或以下公式检查长度：

n!/(r!(n-r)!) - 1

例如

SetB: [a, b, c, d] -> [a,b,c,d,ab,ac,ad,bc,bd,cd,abc,abd,acd,bcd,abcd]

在为每个集合创建所有可能的组合之后，我只是使用了乘积规则

[SetA] X [SetB] X [SetC]

所有可能组合的结果：

多个项目 多套 没有重复 没有订单

参考：https://www.mathsisfun.com/combinatorics/combinations-permutations-calculator.html

EDIT1：检查每组的组合数量也可以是 (2^n)-1，其中 n= 组的长度

【讨论】：

您是如何在 Excel 中做到这一点的？

有一个更简单的公式可以找到所有子集....只需取元素的数量，比如 n，然后计算 2^n - 1。

@Enigmativity 检查约瑟夫伍德的上述答案

【参考方案3】：

您是否尝试过使用嵌套的 for 循环。

Sub Hello()
    MsgBox ("Hello, world!")

    Dim arr1
    arr1 = Array("1", "2", "3")

    Dim arr2
    arr2 = Array("a", "b", "c")

    Dim arr3
    arr3 = Array("!", "@", "$")

    For i = 0 To UBound(arr1)
        For j = 0 To UBound(arr2)
            For k = 0 To UBound(arr3)
                MsgBox (arr1(i) & arr2(j) & arr3(k))
            Next
        Next
    Next
End Sub

【讨论】：

这段代码使用每个集合中的恰好一个元素，但提问者想要至少一个元素，意思是一个或多个 元素。