如何创建包含所有可能组合的列表

如何创建包含所有可能组合的列表

我有下表:

a b c d ...
q w e r ...
z x   v ...
  p

我在寻找一种算法(最好是 VBA,但其他语言的思维几乎相同)时遇到了很多麻烦,该算法将生成一个包含所有组合的列表 - 除了我只有几行之外,还有很多列,如果手动完成,这不会准确,我相信 VBA 可以使它 100% 完整。

因此,输出应该是这样的列表:

a
a,q
a,z
q,z
z
a/b
a/b,w
a/b,x
a/b,p
a/b,w,x
a/b,w,p
a/b,x,p
a/w
a/w,x
a/w,p
a/x
a/x,p
a/p
a,q/b
a,q/b,w
a,q/b,x
a,q/b,p
a,q/b,w,x
a,q/b,w,p
a,q/b,x,p
a,q/w
a,q/w,x
a,q/w,p
a,q/x
a,q/x,p
a,q/p
....etc.
  • 我并不真正关心“/”和“,”符号,我会找到一种方法来正确放置它们(“/”位于不同列的元素之间,而“,”位于同一列的元素之间)

  • 组合有两种方式 - 水平和垂直,但有以下限制:只能组合“n-1”个元素(水平和/或垂直)

答案1

你的例子表明12项目。此代码(由 John Coleman 于 2005 年提供)将在列中列出列表的 4095 个排列. 有 2N - 1 个项目:

Sub MAIN()
    B = Array("a", "b", "c", "d", "q", "w", "e", "r", "z", "x", "v", "p")
    Call GrayCode(B)
End Sub

Function GrayCode(Items As Variant) As String
    Dim CodeVector() As Integer
    Dim i, kk As Integer
    Dim lower As Integer, upper As Integer
    Dim SubList As String
    Dim NewSub As String
    Dim done As Boolean
    Dim OddStep As Boolean

    kk = 1
    OddStep = True
    lower = LBound(Items)
    upper = UBound(Items)

    ReDim CodeVector(lower To upper) 'it starts all 0
    Do Until done
        'Add a new subset according to current contents
        'of CodeVector

        NewSub = ""
        For i = lower To upper
            If CodeVector(i) = 1 Then
                If NewSub = "" Then
                    NewSub = "," & Items(i)
                Else
                    NewSub = NewSub & "," & Items(i)
                End If
            End If
        Next i
        If NewSub = "" Then NewSub = "{}" 'empty set
        SubList = SubList & vbCrLf & NewSub
        Cells(kk, 2) = Mid(NewSub, 2)
        kk = kk + 1
        'now update code vector
        If OddStep Then
            'just flip first bit
            CodeVector(lower) = 1 - CodeVector(lower)
        Else
            'first locate first 1
            i = lower
            Do While CodeVector(i) <> 1
                i = i + 1
            Loop
            'done if i = upper:
            If i = upper Then
                done = True
            Else
                'if not done then flip the *next* bit:
                i = i + 1
                CodeVector(i) = 1 - CodeVector(i)
            End If
        End If
        OddStep = Not OddStep 'toggles between even and odd steps
    Loop
    GrayCode = SubList
End Function

在此处输入图片描述

参考:

约翰·科尔曼密码

您可以通过更改来更改/添加/删除项目Array()。太多将超出列中项目数的限制。

相关内容