【感恩节大礼：元素递增另类组合算法】之递归以及数组算法实现

香川群子

从m个元素中提取n个元素的算法有很多种。

今天给大家介绍一种超级简单的思路，及其代码实现方法。

思路说明：
如有m=6个的元素组合： a,b,c,d,xx,yyy
希望提取n=3个的组合时：

第1步，提取1个元素，得到所有Combin(6,1)=6的组合：
a
b
c
d
xx
yyy
这样一共6个

第2步，上述6个各自添加1个后续元素，得到所有Combin(6,2)=6*5/2=15个的组合：
a → ab/ac/ad/axx/ayyy
b → bc/bd/bxx/byyy
c → cd/cxx/cyyy
d → dxx/dyyy
xx → xxyyy
这样一共是6个

接下来以此类推，就能得到从m个元素中任意抽取n个元素的全部各种组合了。

…………
此过程中，为了提取n个元素，需要依次提取：
全部1个元素的组合→ 全部2个元素的组合→ 全部3个元素的组合→……→ 全部n个元素的组合


呵呵，就是这么简单、就是这么任性！


具体请看附件！ ZH2.zip (12.34 KB, 下载次数: 315)

2014-11-28 13:23 上传

点击文件名下载附件

香川群子

递归算法的代码实现：

1. Dim sj, jg(), k&, m&, n&, p&, w$
   
2. '定义公用变量、分别是：m个元素的数据sj数组、组合结果数组jg、记录序号k
   
3. '元素个数m、提取个数n、是否输出1-n的全部组合模式p、元素间分隔符号w
   
4. Sub GetCombin_dg() 'by kagawa 2014/11/28
   
5.     Dim tms#
   
6.     tms = Timer '代码运行起始时间tms
   
7.     m = [a1].End(4).Row: sj = [a1].Resize(m) 'A列m个元素读入数组sj
   
8.     n = [b1]: If n > m Then n = m '读取组合提取个数n
   
9.     w = [b2] '读取元素间分隔符w
   
10.     p = [b3]  '是否需要输出1-n的全部组合: p=1时输出全部/p=0是仅输出n个元素的组合
    
11.     [d1].CurrentRegion = "" '清空输出区域
    
12.    
    
13.     ReDim jg(2 ^ m, 1) '定以存放组合结果的数组jg
    
14.     k = 0: Call dgQZH("", 0, 0) '调用递归组合计算过程
    
15. 
    
16.     [d1].Resize(k, 2) = jg: If p Then [d1].Resize(k, 2).Sort [e1], 1 '输出组合结果并排序
    
17.     [b5] = k: [b6] = Format(Timer - tms, "0.000s") '代码运行耗时
    
18. End Sub
    
19. 
    
20. Sub dgQZH(r$, i&, t&) '递归组合过程代码
    
21.     Dim j&
    
22.     If p Or t = n Then jg(k, 0) = Mid(r, Len(w) + 1): jg(k, 1) = t: k = k + 1 '输出上一次拼接结果
    
23.     If t = n Then Exit Sub '拼接组合到n个元素后就可以停止向下递归、退出。
    
24.     For j = i + 1 To m '遍历本元素以后所有的元素
    
25.         Call dgQZH(r & w & sj(j, 1), j, t + 1) '每次拼接一个元素、然后进入下一层递归组合计算
    
26.     Next
    
27. End Sub
    

复制代码

香川群子

数组循环算法的代码实现：

解释略

1. Sub GetCombin_Arr() 'by kagawa 2014/11/28
   
2.     Dim i&, j&, k&, l&, m&, n&, p&, w$, tms#
   
3.     tms = Timer
   
4.    
   
5.     m = [a1].End(4).Row: sj = [a1].Resize(m)
   
6.     n = [b1]: If n > m Then n = m
   
7.     w = [b2]: p = [b3]
   
8.     [d1].CurrentRegion = ""
   
9.    
   
10.     ReDim jg(2 ^ m - 1, 2)
    
11.     For i = 1 To n - 1
    
12.         For j = j To k
    
13.             For l = jg(j, 2) + 1 To m
    
14.                 k = k + 1: jg(k, 1) = i: jg(k, 2) = l
    
15.                 If k > m Then jg(k, 0) = jg(j, 0) & w & sj(l, 1) Else jg(k, 0) = sj(l, 1)
    
16.             Next
    
17.         Next
    
18.     Next
    
19.     If p Then [d1].Resize(k + 1, 2) = jg
    
20.    
    
21.     ReDim jg2(WorksheetFunction.Combin(m, n), 1): i = 0
    
22.     For j = j To k
    
23.         For l = jg(j, 2) + 1 To m
    
24.             jg2(i, 0) = jg(j, 0) & w & sj(l, 1): jg2(i, 1) = n: i = i + 1
    
25.         Next
    
26.     Next
    
27.     [d1].Offset(p * (k + 1)).Resize(i, 2) = jg2
    
28.     [b5] = p * (k + 1) + UBound(jg2): [b6] = Format(Timer - tms, "0.000s")
    
29. End Sub
    

复制代码

香川群子

递归算法的顺序，其实是这样子的：

a → ab → abc;abd;abxx;abyyy
   → ac → acd;acxx;acyyy
   → ad → adxx;adyyy
   → axx → axxyyy
   → ayyy

b → bc → bcd;bcxx;bcyyy
   → bd → bdxx;bdyyy
   → bxx → bxxyyy
   → byyy

c  → cd → cdxx;cdyyy
   → cxx → cxxyyy
   → cyyy

d  → dxx → dxxyyy
   → dyyy

xx   → xxyyy

yyy

然后，可以根据提取到元素个数来排序，就OK啦。

香川群子

而数组循环算法中，已经安排了按字典顺序进行循环计算，所以输出结果不需要再经过排序。

香川群子

程序使用说明：
1. A1开始m个单元格内写入各个待组合元素
2. B1内写入需要提取的最大组合个数、范围[1-m]
3. B2内写入任意字符作为组合元素间的分隔符(如为空则无分隔)
4. B3内写入数字1时在D列输出m个元素的1-n的全部组合
   B3留空时，仅输出Combin(m,n)即从m个元素中抽取n个的组合
5. E列内容为提取组合中的元素个数n
   递归组合结果在B4=1时按E列的个数n进行排序、留空时不排序

by Excel Home 香川群子 2014/11/28

coby001

裙子，
把你的相关帖子汇总起来，做个 排列/组合 工具库吧~

天地有雪

感谢香川老师分享！又有知识可以学习了！

liucqa

都这么久了，你啥时候能学会用自文档化的方法来定义变量和写代码呢？

每次看你的程序太痛苦了，一堆jg、sj的，神一样的代码呀！

I 服了 you！

aoe1981

liucqa 发表于 2014-11-28 22:34
都这么久了，你啥时候能学会用自文档化的方法来定义变量和写代码呢？

每次看你的程序太痛苦了，一堆jg、 ...

还没有细看完下面的资料，感觉自文档就是让代码本身像文档一样，具有好的阅读性：
http://www.cnblogs.com/anderslly ... cumenting-code.html
这是个专业的建议，这是个重视团队精神的建议！