通过16个群组中的4个群组的组合进行迭代 [英] Iterating through combinations of groups of 4 within a group of 16
问题描述
大家好，我知道这个问题看起来与其他问题相似，但是我已经对它们进行了广泛的跟踪，无法让它们为我工作.
Hi all, I know this question looks similar to some others but I have trawled through them extensively and can't get them to work for me.
我有16个数据集，我们称它们为1到16.我想遍历所有可能的不同方式，将这16个数据集分为4个组.最基本的例子是:[1,2,3,4] [5,6,7,8] [9,10,11,12] [13,14,15,16].
I have 16 datasets, let's call them 1 to 16. I would like to iterate through every possible different way of collecting these 16 into 4 groups; the most basic example being : [1,2,3,4][5,6,7,8][9,10,11,12][13,14,15,16].
问题:如何才能最好地遍历这些组合(在vba中)?
The Question is how can I best iterate throught these combinations (in vba)?
下面，我提供了一个更详细的示例，以帮助说明我正在尝试实现的目标，迄今为止的思想过程，尝试过的代码以及为何无效的原因.
Below I have provided a more detailed example to help illustrate what I am trying to achieve, my thought proccesses to date, the code I have tried, and why it hasn't worked.
示例:另一个有效的组合可能是[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].
Example Another valid combination could be [2,4,6,8][10,12,14,16][1,3,5,7][9,11,13,15], etc etc. However, I would like to avoid any duplication: a type one duplication would include elements repeated within a group, or another group of the same combination: [1,2,2,4]... OR [1,2,3,4][4,5,6,7]... A type 2 duplication would involve the same groups as a previous iteration, for example [1,2,4,3][5,6,8,7][9,10,12,11][13,14,16,15].
思考过程，我想避免任何重复，特别是因为这将大大减少我必须比较的组合数量.我试图通过使用比较组合中的所有元素以查看是否相同的函数来避免类型1.我试图通过确保每个组中的元素始终按升序来避免类型2，并确保每个组中的第一个元素也始终按升序进行. (这应该可以吗?)
Thought Process I would like to avoid any duplication, especially as this will massively cut down the number of combinations I will have to compare. I have tried to avoid type 1 by using a function that compares all the elements in a combination to see if any are the same. I have tried to avoid type 2 by ensuring the elements in each group are always in ascending order, and ensuring the first element from each group is always in ascending order too. (This should work shouldn't it?)
代码 以下是我尝试过的两个代码示例.第一个简单地使excel崩溃了(如果您正在考虑的话，我确实有一个值而不是大数)；我猜想有太多组合无法一一进行吗? 第二个组没有给我唯一的组，它返回相同的组，但每个组中只有第一个值更改.
Code Below are two examples of code I have tried. The first one simply crashed excel (I did have a value instead of large number if that's what you're thinking); I'd imagine there are just too many combinations to go through one by one? The second doesn't give me unique groups, it returns the same groups with only the first value in each one changed.
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"的当前迭代进行比较，并保存最佳组，以便与下一次迭代进行比较.
Groups and TempGroups are 2D arrays, the first value being the group number and the second being the element number in that group.
InArray is a function I made (fairly self explanatory)
In this instance, I am using a comparison criteria to compare the most recent "best" set of groups with the current iteration of "tempgroups" and saving the best one, ready to be compared to the next iteration
没有帮助的链接:
如何遍历每种可能的组合的n张纸牌
虽然这很有用，但它只查看集合中一组的组合，我想查看集合中多个组的组合
Links that didn't help:
How can I iterate throught every possible combination of n playing cards
While this was useful, it only looked at the combinations of one group within the set, I would like to look at the combinations of multiple groups within the set
列出给定集合的所有排列值 这更多地关注排列(重新排列组的顺序，而不是组合)
Listing all permutations of a given set of values This looked more at permutations (rearranging the order of groups as opposed to the combinations)
我看过的几乎所有其他解决方案都属于这些类别之一
Pretty much all the other solutions I looked at fell into one of these categories
推荐答案
从概念上讲，这个问题并不难.我们要做的就是生成所有16!排列，并删除所有4个组的组内重复的4!.最后，我们需要删除整个组的重复4!.因此，我们应该获得将近300万个结果:
Conceptually, this problem isn't that hard. All we need to do is generate all 16! permutations, and remove 4! of within-group repeats for all 4 groups. Finally, we need to remove 4! of repeats for the groups as a whole. So we should obtain nearly 3 million results:
16! / (4!^5) = 2,627,625
例如，如果我们考虑词典顺序，我们有:
As an example, if we consider the first 10 permutations of 1 through 16 in lexicographical order, we have:
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的排列，我们将:
As you can see, all of these are identical as the last group is the only thing that is being permuted (which the OP doesn't want). If we continue generating and look at permutations 20 through 30 we have:
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遵循的新的自定义组合.
Finally at permutation #25, we get a new custom combination that the OP is after.
如果我们继续前进，最终置换#5606234726401(是的，超过5万亿)是一个例子，其中的组与前几个排列完全相同，仅对这些组进行了排列(同样，这些是排列方式)我们要避免):
If we keep going, eventually permutation #5606234726401 (yes, that is over 5 trillion) is an example of where the groups are exactly the same as the first few permutations, only these groups are permuted (again, these are the arrangements we want to avoid):
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)
重点是，我们需要一种避免这些组内以及组内置换的方法，因为生成和筛选大量置换所需的绝对计算能力(无论算法的效率如何)根本不可行
The point is, we need a method that will avoid these within-group as well as group permutations because the sheer computational power required (no matter how efficient are algorithm is) to generate and sift through that many permutations is simply not feasible.
我们需要一种不同的方法.让我们看一下16选择4的组合，例如450到460:
We need a different approach. Let's look at a set of the combinations of 16 choose 4, say 450 through 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为:
We note here, that if we were to fill in the other 3 groups with the combinations not present in the first 455 combinations, we would eventually replicate combinations 456 through 459. For example, the combinations 291 through 294 are:
291 (1 6 7 8)
292 (1 6 7 9)
293 (1 6 7 10)
294 (1 6 7 11)
如果我们要填写这些组合中每一个的补码的所有可能组合，请选择4(例如(2 3 4 5 9 10 11 12 13 14 15 16)表示291的补码)，前面显示的那些组合(456至459)将被考虑在内.
And if we were to fill in all of the possible combinations of the complement of each of these combinations choose 4 (e.g. (2 3 4 5 9 10 11 12 13 14 15 16) for the complement of 291), those combinations shown earlier (456 through 459) will already be accounted for.
这是一个不错的结果.这意味着我们可以简单地在第一个组"完成后停止生成结果(例如，当第一个组中的第一个数字保持为1时).当我们移到其他小组时，也会有同样的想法.
This is a nice result. This means we can simply stop generating results after the first "group" has completed (e.g. while the 1st number in the 1st group stays 1). The same thinking applies as we move to further groups.
下面，我们提供了一些帮助功能，用于计算组合，生成组合并获取向量的补码.组合生成器非常高效，可以在3秒钟内在旧的Windows机器上生成全部5200,300种组合，其中25种选择12.
Below we have some helper functions for counting combinations, generating combinations, and getting the complement of a vector. The combination generator is very efficient and can generate all 5,200,300 combinations of 25 choose 12 in just over 3 seconds on my old Windows machine.
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:
I know it is a bit much, but it is very general and decently fast. If you run Sub MasterGenerator and enter 8 for the # of datasets, and 2 for the number of groups like this:
您得到以下结果:
对于OP的特定情况，有超过200万个结果，因此我们不能一一打印出来.但是，使用Verbose = False运行时，自定义组合将在大约12秒内生成.
For the OP's specific case, there are over 2 million results so we can't print them all in one column. However, running with Verbose = False, the custom combinations are generated in about 12 seconds.
这篇关于通过16个群组中的4个群组的组合进行迭代的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
