生成所有可能的独特选择组合

Posted 2023-03-31

【中文标题】生成所有可能的独特选择组合

【英文标题】：Generate all possible unique combinations of picks

【发布时间】：2018-01-06 01:20:39

【问题描述】：

一个人可以从 1, 2, 3 中选择三个值之一

一个人会选择上述三个值之一 10 次以生成类似的列表

列表 1：1, 2, 3, 2, 1 , 2, 3, 1, 1, 2

列表 2：1, 1, 3, 2, 1, 3, 3, 1, 1, 2

列表 3：3, 3, 3, 2, 3, 1, 3, 1, 1, 2

列表 4：1, 2, 3, 2, 3, 2, 3, 1, 1, 2

.

.

.

.

？可能有多少个这样的唯一列表？

我知道 vba 中的基本循环，例如 for、do while、while 等。但我想不出其中的逻辑以及如何在代码中实现。请指教。

这是我正在尝试的，但我很确定它有缺陷。

Sub genComb()

Application.ScreenUpdating = False

fO = 2

For i = 1 To 3

    For j = 1 To 3
         
        For m = 1 To 3
                               
            For n = 1 To 10
                Cells(fo,n) = m
               
            
            Next n
            fo = fo +1 
        Next m
    
    Next i
    
Next j

Application.ScreenUpdating = True

End Sub

【问题讨论】：

您能否举一个您尝试过的代码示例，即使它的算法不完整？

我不认为你的意思是“套”。我认为您的意思是“列表”。作为 sets，您列出的 4 件事都是相同的 - 编写一组 1,2,3 的不同方式。您似乎想在1,2,3 的 10 倍笛卡尔幂中枚举 3^10 个元素。

@JohnColeman 是的，你是对的。我不知道集合不能有重复。

“设置”不明确。在自然语言的使用中，您所说的完全可以接受，但在数学和计算机科学中有技术意义。在 CS 中，它往往意味着元素没有固定顺序并且只出现一次的数据结构。顺便说一句——你的预期输出是什么？ A 列中的字符串还是前 10 列中的数字？

@JohnColeman 感谢您的解释。我的预期输出是前 10 列中的数字。

【参考方案1】：

递归方法很自然：

Function Product(A As Variant, B As Variant, Optional delim As String = "/") As Variant
    'Returns the Cartesian product of two 1-based 1-dimensional arrays
    'The output is a 1-dimensional array of delimited strings
    Dim Prod As Variant
    Dim i As Long, j As Long, k As Long, m As Long, n As Long

    m = UBound(A)
    n = UBound(B)
    ReDim Prod(1 To m * n)

    For i = 1 To m
        For j = 1 To n
            k = k + 1
            Prod(k) = A(i) & delim & B(j)
        Next j
    Next i

    Product = Prod
End Function

Function Power(A As Variant, n As Long, Optional delim As String = "/") As Variant
    'Returns the n-fold Cartesian power of the 1-based, 1-d array A
    'Returns the resul as an array of delimited strings
    Dim Pow As Variant
    Dim i As Long, m As Long

    If n = 1 Then
        'return a copy of A
        m = UBound(A)
        ReDim Pow(1 To m)
        For i = 1 To m
            Pow(i) = A(i)
        Next i
    Else
        Pow = Product(A, Power(A, n - 1, delim))
    End If

    Power = Pow
End Function

Function SplitArray(A As Variant, Optional delim As String = "/") As Variant
    'A is a 1-based array of delimited strings, all of which
    'are assumed to have the same number of fields
    'each entry is split into a row of the returned 2-d matrix

    Dim i As Long, j As Long, k As Long, m As Long, n As Long
    Dim B As Variant, R As Variant

    m = UBound(A)
    R = Split(A(1), delim)
    n = UBound(R) - LBound(R) + 1

    ReDim B(1 To m, 1 To n)
    For i = 1 To m
        k = 0
        R = Split(A(i), delim)
        For j = LBound(R) To UBound(R)
            k = k + 1
            B(i, k) = R(j)
        Next j
    Next i
    SplitArray = B
End Function

Sub test()
    Dim A(1 To 3) As Long
    Dim i As Long
    Dim B As Variant
    A(1) = 1: A(2) = 2: A(3) = 3
    B = SplitArray(Power(A, 10))
    Range("A1:J59049").Value = B '3^10 = 59049
End Sub

当test 运行时，它会在前 10 列中填充所需的数字。可以对代码进行调整，使其仅适用于基于 1 的数组并不是最大的灵活性，并且一些错误检查可能不会造成伤害。

【讨论】：

非常感谢先生。效果很好，我会花一些时间来学习。

【参考方案2】：

看起来您正在尝试为一组 3 个元素和 10 个元素的子集生成一组重复的排列：

PR(n, k) = n ^ k 
         = 3 ^ 10
         = 59049

一个简单的算法是重复第一列中的集合，然后重复上一列中的值n 次：

1  1  1  1  1  1  1  1  1  1
2  1  1  1  1  1  1  1  1  1
3  1  1  1  1  1  1  1  1  1
1  2  1  1  1  1  1  1  1  1
2  2  1  1  1  1  1  1  1  1
3  2  1  1  1  1  1  1  1  1
1  3  1  1  1  1  1  1  1  1
2  3  1  1  1  1  1  1  1  1
3  3  1  1  1  1  1  1  1  1
...

Sub Example()
  GetPermutationWithRepetition n:=3, k:=10, output:=[Sheet1!A1]
End Sub

Sub GetPermutationWithRepetition(n As Long, k As Long, output As Range)
  Dim r&, c&, repeat&, value&

  ReDim data(1 To n ^ k, 1 To k)

  For c = 1 To k
    r = 1
    repeat = (n ^ (c - 1)) - 1

    Do While r <= UBound(data)
      For value = 1 To n
        For r = r To r + repeat
          data(r, c) = value
        Next
      Next
    Loop
  Next

  output.Resize(UBound(data, 1), UBound(data, 2)).Value2 = data
End Sub