排列组合

treenewbee

m取n排列组合在不预先生成全部列表的情况下，按大小顺序如何快速取得某个索引号对应的字符串或某个字符串对应的索引号？
如：
49选 6一共13983816个组合，如何取得额第1000000个组合是什么？或“24 29 33 37 40 45”排第几？

百度不到去谷歌

你这个问题题意要说清楚一点 排列组合本身就有好多种排法  你说的索引谁知道是哪一种呢?

treenewbee

谢谢回复。
按大小排序。
1     01 02 03 04 05
2     01 02 03 04 06
3     01 02 03 04 07
......
x     04 07 09 10 49
x+1 04 07 09 11 12
........

treenewbee

搜到一个，
http://blog.csdn.net/northwolves/article/details/5717001
改写了一下，感觉效率不怎么高：

1. Function SeqNum(ByVal m As Long, ByVal n As Long, ByVal s As String) As Long
   
2.     Dim i&, j&, d
   
3.     d = Split(s)
   
4.     SeqNum = 1
   
5.     Do
   
6.         j = j + 1
   
7.         If j < d(i) Then
   
8.             SeqNum = SeqNum + WorksheetFunction.Combin(m - j, n - i - 1)
   
9.         Else
   
10.             i = i + 1
    
11.         End If
    
12.     Loop Until j = d(n - 1)
    
13. End Function
    
14. 
    
15. Sub Test()
    
16.     MsgBox SeqNum(49, 6, "24 29 33 37 40 45")
    
17. End Sub
    

复制代码

香川群子

原来你参考的是狼版的大作……原理思路是正确的。

不过我的自定义函数还能比狼版略胜一筹： 大约快50-60%

1. Function SeqNum&(s$, m&)
   
2.     Dim i&, j&, k&, n&, t
   
3.     t = Split(s)
   
4.     n = UBound(t)
   
5.     For j = 0 To n - 1
   
6.         For i = i + 1 To t(j) - 1
   
7.             k = k + WorksheetFunction.Combin(m - i, n - j)
   
8.         Next
   
9.     Next
   
10.     SeqNum = k + t(n) - t(n - 1)
    
11. End Function

复制代码

速度比较测试代码：

1. Sub SpeedCompare()
   
2.     Dim c&, i&, j&, m&, s$, tms#
   
3.    
   
4.     m = 49
   
5.     s = "24 29 33 37 40 45"
   
6.    
   
7.     c = 3 '代码反复运行次数c(10的幂指数)
   
8.     Debug.Print vbCr; "Run Count: "; Format(10 ^ c, "#,##0")
   
9.     For i = 1 To 2
   
10.         tms = Timer
    
11.         For j = 1 To 10 ^ c
    
12.             Run "Test" & i, s, m
    
13.         Next
    
14.         Debug.Print "Test" & i & ": " & Format(Timer - tms, "0.0000s")
    
15.     Next
    
16.     Debug.Print "k1:"; test1(s, m)
    
17.     Debug.Print "k2:"; test2(s, m)
    
18.     Debug.Print "--End--"
    
19. End Sub
    
20. 
    
21. Function test1(s$, m&) '你的函数，我把变量名按我的习惯改了
    
22.     Dim i&, j&, k&, n&, t
    
23.     t = Split(s)
    
24.     n = UBound(t) '组合个数n可以Ubound计算得到，不需要作为参数输入
    
25.     k = 1
    
26.     Do
    
27.         j = j + 1
    
28.         If j < t(i) Then
    
29.             k = k + WorksheetFunction.Combin(m - j, n - i)
    
30.         Else
    
31.             i = i + 1
    
32.         End If
    
33.     Loop Until j = t(n)
    
34.     test1 = k
    
35. End Function
    
36. 
    
37. Function test2(s$, m&) 'by kagawa
    
38.     Dim i&, j&, k&, n&, t
    
39.     t = Split(s)
    
40.     n = UBound(t)
    
41.     For j = 0 To n - 1
    
42.         For i = i + 1 To t(j) - 1
    
43.             k = k + WorksheetFunction.Combin(m - i, n - j)
    
44.         Next
    
45.     Next
    
46.     test2 = k + t(n) - t(n - 1)
    
47. End Function
    

复制代码

我的算法采用两层For循环，比Do循环效率更高一些。
而且，最后一步是直接计算得到，减少了一次循环。

这个，大概就是我的代码算法效率更高一些的原因吧。

香川群子

另外，更正一下。

楼主的要求，不是Permut排列，而是Combin组合。

即，计算按字典顺序的组合结果中，第k个序号的组合结果s是什么？
以及，已知组合结果s，问对应序号k是多少？


字典顺序是指：
所有组合结果，已按从小到大排序。(字典顺序、或A-Z升序）

字典顺序的英文是：Lexicographic Order

举例：1-6任选4个元素组合的字典顺序是：
1、2、3、4
1、2、3、5
1、2、3、6
1、2、4、5
1、2、4、6
1、2、5、6
1、3、4、5
1、3、4、6
1、3、5、6
1、4、5、6
2、3、4、5
2、3、4、6
2、3、5、6
2、4、5、6
3、4、5、6

香川群子

如果计算一次，用我的代码或狼版的代码都很快速。

如果要在一个代码过程中反复引用、计算，
那么我也有提速的算法……事先把各种Combin结果计算存入数组，
然后在以后的计算中直接调用该数组中的组合计算结果、而不需要每次WorksheetFunction.Combin()计算。

这样可以提高速度很多。

香川群子

计算任意m选n组合中所有Combin计算结果的代码：

1. Sub CombinSeq()
   
2.     Dim m&, n&
   
3.     m = [a1]: n = [b1]
   
4.     ReDim zhx&(m - n, n - 1)  'n-2
   
5.     zhx(0, n - 1) = 1
   
6.     For i = 1 To m - n
   
7.         For j = 0 To n - 1 'n-2
   
8.             zhx(i, j) = Application.Combin(m - i - j, n - j - 1)
   
9.         Next
   
10.     Next
    
11.     [e3] = Application.Combin(m, n)
    
12.     [a4].CurrentRegion = ""
    
13.     [a4].Resize(m - n + 1, n) = zhx
    
14. End Sub

复制代码

此结果一般不需要输出到工作表，可以作为公共数组变量、或全局数组变量，
然后随时被计算过程调用。

我有这方面的计算实例。

香川群子

已知序号求组合结果的自定义函数：

1. Sub test()
   
2.     MsgBox CK(49, 6, 13789132) & vbcr & "24 29 33 37 40 45"
   
3. End Sub
   
4. 
   
5. Function CK(m&, n&, k&)
   
6.     Dim i&, j&, l&, p&, q&, r&
   
7.     r = k
   
8.     ReDim x(1 To n)
   
9.     For i = 1 To n - 1
   
10.         For j = 1 To m - n + 1
    
11.             q = WorksheetFunction.Combin(m - i - p, n - i) 'm-n-p
    
12.             If r > q Then r = r - q: p = p + 1 Else l = l + j: Exit For
    
13.         Next
    
14.         x(i) = l
    
15.     Next
    
16.     x(n) = (r - 1) Mod (m - l + 1) + l + 1
    
17.     CK = Join(x)
    
18. End Function

复制代码

treenewbee

群子女侠果然出手不凡，学习了！