在一组16个
大家好，我知道这个问题看起来与其他问题相似，但是我已经对它们进行了广泛的跟踪，无法让它们为我工作。
我有16个数据集，我们称它们为1到16。我想遍历所有可能的不同方式，将这16个数据集分为4个组。最基本的示例是：[1,2,3,4] [5,6,7,8] [9,10,11,12] [13,14,15,16]。
问题？如何才能最好地遍历这些组合（在vba中）？
下面，我提供了一个更详细的示例，以帮助说明我正在尝试实现的目标，迄今为止的思想过程，尝试过的代码以及为何无效的原因。
示例：另一个有效的组合可能是[2,4,6,8] [10,12,14,16] [1,3,5,7] [9,11,13， 15]等。但是，我想避免任何重复：一种类型的重复将包括在一组或同一组合的另一组中重复的元素：[1,2,2,4] ... OR [1,2,3,4] [4,5,6,7] ...类型2复制将涉及与先前迭代相同的组，例如[1,2,4， 3] [5,6,8,7] [9,10,12,11] [13,14,16,15]。
思考过程，我想避免重复，特别是因为这将大大减少我必须比较的组合数量。我试图通过使用比较组合中的所有元素以查看是否相同的函数来避免类型1。我试图通过确保每个组中的元素始终按升序来避免类型2，并确保每个组中的第一个元素也始终按升序进行。 （这应该可以吗？）
代码 以下是我尝试过的两个代码示例。第一个简单地使excel崩溃了（如果您正在考虑的话，我确实有一个值而不是大数）；我猜想有太多组合无法一一进行吗？ 第二个组没有给我唯一的组，它返回相同的组，但每个组中只有第一个值更改。
1。
Sub CombGen()
Dim Combs(1 To 1820)
Dim Comb(1 To 4)
Dim GroupsCombs(1 To *large number*)
Dim GroupsComb(1 To 1820)
x = 1
For a = 1 To 16 - 3
Comb(1) = a
For b = a + 1 To 16 - 2
Comb(2) = b
For c = b + 1 To 16 - 1
Comb(3) = c
For d = c + 1 To 16
Comb(4) = d
Combs(x) = Comb
x = x + 1
Next d
Next c
Next b
Next a
x = 1
For a = 1 To 1820 - 3
GroupsComb(1) = a
For b = a + 1 To 1820 - 2
GroupsComb(2) = b
For c = b + 1 To 1820 - 1
GroupsComb(3) = c
For d = c + 1 To 1820
GroupsComb(4) = d
If Repeat(a, b, c, d, Combs) = False Then
GroupsCombs(x) = Comb
x = x + 1
End If
Next d
Next c
Next b
Next a
End Sub
Function Repeat(a, b, c, d, Combs)
Repeat = False
Dim letters(1 To 4): letters(1) = a: letters(2) = b: letters(3) = c: letters(4) = d
Dim i: Dim j
Repeat = False
For x = 1 To 4
For y = 2 To 4
For i = 1 To 4
For j = 1 To 4
If Combs(letters(i))(x) = Combs(letters(j))(y) Then
Repeat = True
End If
Next j
Next i
Next y
Next x
End Function
2。
For a = 1 To 16 - 3
For b = a + 1 To 16 - 2
For c = b + 1 To 16 - 1
For d = c + 1 To 16
TempGroups(1, 1) = a: TempGroups(1, 2) = b: TempGroups(1, 3) = c: TempGroups(1, 4) = d
For e = 1 To 16 - 3
If InArray(TempGroups, e) = False Then
For f = e + 1 To 16 - 2
If InArray(TempGroups, f) = False Then
For g = f + 1 To 16 - 1
If InArray(TempGroups, g) = False Then
For h = g + 1 To 16
If InArray(TempGroups, h) = False Then
TempGroups(2, 1) = e: TempGroups(2, 2) = f: TempGroups(2, 3) = g: TempGroups(2, 4) = h
For i = 1 To 16 - 3
If InArray(TempGroups, i) = False Then
For j = i + 1 To 16 - 2
If InArray(TempGroups, j) = False Then
For k = j + 1 To 16 - 1
If InArray(TempGroups, k) = False Then
For l = k + 1 To 16
If InArray(TempGroups, l) = False Then
TempGroups(3, 1) = i: TempGroups(3, 2) = j: TempGroups(3, 3) = k: TempGroups(3, 4) = l
For m = 1 To 16 - 3
If InArray(TempGroups, m) = False Then
For n = m + 1 To 16 - 2
If InArray(TempGroups, n) = False Then
For o = n + 1 To 16 - 1
If InArray(TempGroups, o) = False Then
For p = o + 1 To 16
If InArray(TempGroups, p) = False Then
TempGroups(3, 1) = m: TempGroups(3, 2) = n: TempGroups(3, 3) = o: TempGroups(3, 4) = p
If *comparison criteria are met* Then
For x = 1 To 4
For y = 1 To 4
Groups(x, y) = TempGroups(x, y)
Next y
Next x
End If
End If
Next p
End If
Next o
End If
Next n
End If
Next m
End If
Next l
End If
Next k
End If
Next j
End If
Next i
End If
Next h
End If
Next g
End If
Next f
End If
Next e
Next d
Next c
Next b
Next a
End If
Groups和TempGroups是2D数组，第一个值是组号，第二个值是该组中的元素号。
InArray是我制作的一个函数（很容易解释）
在这种情况下，我使用比较标准将最新的“最佳”组组与“ tempgroups”的当前迭代进行比较，并保存最佳组，以便与下一次迭代进行比较
没有帮助的链接：
How can I iterate throught every possible combination of n playing cards
虽然这很有用，但它只查看集合中一组的组合，我想查看集合中多个组的组合
Listing all permutations of a given set of values 这更多地关注排列（重新排列组的顺序，而不是组合）
我看过的几乎所有其他解决方案都属于这些类别之一
1 个答案:
答案 0 :(得分：1)
从概念上讲，这个问题并不难。我们需要做的就是生成所有16!的排列，并删除所有4组的组内重复的4!。最后，我们需要为整个组删除4!个重复项。因此，我们应该获得将近300万个结果：
16! / (4!^5) = 2,627,625
例如，如果我们考虑lexicographical order中1到16的前10个排列，则有：
1 (1 2 3 4) (5 6 7 8) (9 10 11 12) (13 14 15 16)
2 (1 2 3 4) (5 6 7 8) (9 10 11 12) (13 14 16 15)
3 (1 2 3 4) (5 6 7 8) (9 10 11 12) (13 15 14 16)
4 (1 2 3 4) (5 6 7 8) (9 10 11 12) (13 15 16 14)
5 (1 2 3 4) (5 6 7 8) (9 10 11 12) (13 16 14 15)
6 (1 2 3 4) (5 6 7 8) (9 10 11 12) (13 16 15 14)
7 (1 2 3 4) (5 6 7 8) (9 10 11 12) (14 13 15 16)
8 (1 2 3 4) (5 6 7 8) (9 10 11 12) (14 13 16 15)
9 (1 2 3 4) (5 6 7 8) (9 10 11 12) (14 15 13 16)
10 (1 2 3 4) (5 6 7 8) (9 10 11 12) (14 15 16 13)
如您所见，所有这些都是相同的，因为最后一组是唯一要排列的东西（OP不需要）。如果我们继续生成并查看20到30的排列，我们将：
20 (1 2 3 4) (5 6 7 8) (9 10 11 12) (16 13 15 14)
21 (1 2 3 4) (5 6 7 8) (9 10 11 12) (16 14 13 15)
22 (1 2 3 4) (5 6 7 8) (9 10 11 12) (16 14 15 13)
23 (1 2 3 4) (5 6 7 8) (9 10 11 12) (16 15 13 14)
24 (1 2 3 4) (5 6 7 8) (9 10 11 12) (16 15 14 13)
25 (1 2 3 4) (5 6 7 8) (9 10 11 13) (12 14 15 16) <- a different combination
26 (1 2 3 4) (5 6 7 8) (9 10 11 13) (12 14 16 15)
27 (1 2 3 4) (5 6 7 8) (9 10 11 13) (12 15 14 16)
28 (1 2 3 4) (5 6 7 8) (9 10 11 13) (12 15 16 14)
29 (1 2 3 4) (5 6 7 8) (9 10 11 13) (12 16 14 15)
30 (1 2 3 4) (5 6 7 8) (9 10 11 13) (12 16 15 14)
最后在排列＃25，我们得到了OP遵循的新的自定义组合。
如果我们继续前进，最终排列＃5606234726401（是的，超过5万亿）是其中组与前几个排列完全相同的例子，只有这些组才被排列（同样，这些是排列我们要避免）：
5606234726401 (5 6 7 8) (1 2 3 4) (9 10 11 12) (13 14 15 16) <- same as the 1st permutation
5606234726402 (5 6 7 8) (1 2 3 4) (9 10 11 12) (13 14 16 15)
5606234726403 (5 6 7 8) (1 2 3 4) (9 10 11 12) (13 15 14 16)
5606234726404 (5 6 7 8) (1 2 3 4) (9 10 11 12) (13 15 16 14)
5606234726405 (5 6 7 8) (1 2 3 4) (9 10 11 12) (13 16 14 15)
5606234726406 (5 6 7 8) (1 2 3 4) (9 10 11 12) (13 16 15 14)
5606234726407 (5 6 7 8) (1 2 3 4) (9 10 11 12) (14 13 15 16)
5606234726408 (5 6 7 8) (1 2 3 4) (9 10 11 12) (14 13 16 15)
5606234726409 (5 6 7 8) (1 2 3 4) (9 10 11 12) (14 15 13 16)
5606234726410 (5 6 7 8) (1 2 3 4) (9 10 11 12) (14 15 16 13)
重点是，我们需要一种避免组内以及组内置换的方法，因为生成和筛选大量置换所需的纯粹计算能力（无论算法的效率如何）根本不可行
我们需要一种不同的方法。让我们看一下16选择4的组合，例如450到460：
450 (1 12 14 16)
451 (1 12 15 16)
452 (1 13 14 15)
453 (1 13 14 16)
454 (1 13 15 16)
455 (1 14 15 16)
456 (2 3 4 5)
457 (2 3 4 6)
458 (2 3 4 7)
459 (2 3 4 8)
460 (2 3 4 9)
我们在这里注意到，如果要用前455个组合中不存在的组合填充其他3个组，则最终将复制组合456至459。例如，组合291至294为：
291 (1 6 7 8)
292 (1 6 7 9)
293 (1 6 7 10)
294 (1 6 7 11)
如果我们要填写这些组合的补码的所有可能组合，请选择4（例如291的补码为(2 3 4 5 9 10 11 12 13 14 15 16)），前面显示的那些组合（456至459）将已经被考虑。
这是一个很好的结果。这意味着我们可以简单地在第一个“组”完成后停止生成结果（例如，当第一个组中的第一个数字保持为1时）。当我们移至其他小组时，也会有同样的想法。
下面，我们提供了一些辅助功能，用于计算组合，生成组合并获取向量的补码。组合生成器非常高效，可以在3秒钟内在旧的Windows计算机上生成全部5200,300个25选12的组合。
Option Explicit
Function nCr(n As Long, r As Long) As Long
Dim res As Long, i As Long, temp As Double
temp = 1
For i = 1 To r: temp = temp * (n - r + i) / i: Next i
nCr = Round(temp)
End Function
Sub GetCombosNoRep(ByRef combos() As Long, n As Long, r As Long, numRows As Long)
Dim index() As Long
Dim numIter As Long, i As Long, k As Long, count As Long
ReDim index(1 To r)
count = 1
For i = 1 To r: index(i) = i: Next
While count <= numRows
numIter = n - index(r) + 1
For i = 1 To numIter
For k = 1 To r
combos(count, k) = index(k)
Next k
count = count + 1
index(r) = index(r) + 1
Next i
For i = r - 1 To 1 Step -1
If index(i) <> (n - r + i) Then
index(i) = index(i) + 1
For k = i + 1 To r
index(k) = index(k - 1) + 1
Next k
Exit For
End If
Next i
Wend
End Sub
Sub GetComplement(n As Long, childVec() As Long, complementVec() As Long)
Dim i As Long, j As Long
ReDim logicalVec(1 To n)
For i = 1 To n: logicalVec(i) = True: Next i
For i = 1 To UBound(childVec): logicalVec(childVec(i)) = False: Next i
j = 1
For i = 1 To n
If logicalVec(i) Then
complementVec(j) = i
j = j + 1
End If
Next i
End Sub
这是主要的子例程：
Sub MasterGenerator()
Dim myRows As Long, i As Long, j As Long, r As Long, n As Long
Dim combos() As Long, k As Long, gSize As Long, total As Long
Dim sTime As Double, eTime As Double, verbose As Boolean
n = CLng(InputBox("How many datasets do you have?", "ENTER # OF DATASETS", "16"))
r = CLng(InputBox("How many groups do you have?", "ENTER # OF GROUPS", "4"))
verbose = CBool(InputBox("Should the results be printed?", "VERBOSE OPTION", "True"))
If Abs(Round(n / r) - (n / r)) > 0.00001 Or r < 2 Or r >= n Then
MsgBox "Incorrect input!!!"
'' You could have custom message like: MsgBox "# of Datasets is NOT divisible by # of Groups!!!"
Exit Sub
End If
sTime = Timer
gSize = n / r
total = 1
Dim AllCombs() As Variant, tN As Long
ReDim AllCombs(1 To r - 1)
tN = n
For i = 1 To r - 1
myRows = nCr(tN, gSize)
ReDim combos(1 To myRows, 1 To gSize)
Call GetCombosNoRep(combos, tN, gSize, myRows)
total = total * myRows / (r - (i - 1))
AllCombs(i) = combos
tN = tN - gSize
Next i
Dim MasterGroups() As Long
ReDim MasterGroups(1 To total, 1 To r, 1 To gSize)
Dim secLength As Long, s As Long, e As Long, m As Long
secLength = nCr(n, gSize) / r
Dim v() As Long, child() As Long, q As Long, temp As Long
ReDim v(1 To n)
For i = 1 To n: v(i) = i: Next i
ReDim child(1 To gSize)
Dim superSecLen As Long, numReps As Long
superSecLen = total
Dim endChild() As Long, endV() As Long
ReDim endChild(1 To n - gSize)
ReDim endV(1 To gSize)
'' Populate all but the last 2 columns
If r > 2 Then
For i = 1 To r - 2
numReps = nCr(n - (i - 1) * gSize, gSize) / (r - (i - 1))
secLength = superSecLen / numReps
s = 1: e = secLength
If i = 1 Then
For j = 1 To numReps
For k = s To e
For m = 1 To gSize
MasterGroups(k, i, m) = v(AllCombs(i)(j, m))
Next m
Next k
s = e + 1
e = e + secLength
Next j
Else
ReDim child(1 To (i - 1) * gSize)
ReDim v(1 To n - (i - 1) * gSize)
While e < total
'' populate child vector so we can get the complement
For j = 1 To i - 1
For m = 1 To gSize
child(m + (j - 1) * gSize) = MasterGroups(s, j, m)
Next m
Next j
Call GetComplement(n, child, v)
For q = 1 To numReps
For k = s To e
For m = 1 To gSize
MasterGroups(k, i, m) = v(AllCombs(i)(q, m))
Next m
Next k
s = e + 1
e = e + secLength
Next q
Wend
End If
superSecLen = secLength
Next i
numReps = nCr(n - (r - 2) * gSize, gSize) / (r - 2)
s = 1: e = secLength
ReDim child(1 To (r - 2) * gSize)
ReDim v(1 To n - (r - 2) * gSize)
While e <= total
'' populate child vector so we can get the complement
For j = 1 To r - 2
For m = 1 To gSize
child(m + (j - 1) * gSize) = MasterGroups(s, j, m)
endChild(m + (j - 1) * gSize) = MasterGroups(s, j, m)
Next m
Next j
Call GetComplement(n, child, v)
q = 1
For k = s To e
For m = 1 To gSize
MasterGroups(k, r - 1, m) = v(AllCombs(r - 1)(q, m))
endChild(m + (r - 2) * gSize) = MasterGroups(k, r - 1, m)
Next m
q = q + 1
Call GetComplement(n, endChild, endV)
For m = 1 To gSize
MasterGroups(k, r, m) = endV(m)
Next m
Next k
s = e + 1
e = e + secLength
Wend
Else
For k = 1 To total
For m = 1 To gSize
MasterGroups(k, 1, m) = v(AllCombs(1)(k, m))
endChild(m) = MasterGroups(k, 1, m)
Next m
Call GetComplement(n, endChild, endV)
For m = 1 To gSize
MasterGroups(k, 2, m) = endV(m)
Next m
Next k
End If
If verbose Then
Dim myString As String, totalString As String, printTotal As Long
printTotal = Application.WorksheetFunction.Min(100000, total)
For i = 1 To printTotal
totalString = vbNullString
For j = 1 To r
myString = vbNullString
For k = 1 To gSize
myString = myString & " " & MasterGroups(i, j, k)
Next k
myString = Right(myString, Len(myString) - 1)
myString = "(" & myString & ") "
totalString = totalString + myString
Next j
Cells(i, 1) = totalString
Next i
eTime = Timer - sTime
MsgBox "Generation of " & total & " as well as printing " & printTotal & " custom combinations completed in : " & eTime & " seconds"
Else
eTime = Timer - sTime
MsgBox "Generation of " & total & " custom combinations completed in : " & eTime & " seconds"
End If
End Sub
我知道这有点多，但是它非常通用并且相当快。如果您运行Sub MasterGenerator，然后为＃个数据集输入8，为这样的组数输入2：
您得到以下结果：
对于OP的特定情况，有超过200万个结果，因此我们不能一一打印出来。但是，使用Verbose = False运行时，自定义组合将在大约12秒内生成。
相关问题
最新问题
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？