【最优组合算法】之递归以及循环算法，及其组合结果输出实用附件

香川群子 · 发表于 2014-10-21 15:43

本帖最后由香川群子于 2014-10-22 16:08 编辑

组合算法很多，其中递归算法因为结构简单，容易写成通用的代码，很具有实用性。

但需要注意的是：递归的方法，速度效率肯定远远不如数组运算。
因此，虽然附件没有作限制，但仍不建议进行巨量组合的运算。

附件的特点，首先不用说，都是递归算法的代码。
其次、输出特点如下：

一、分3种输出方式：
① c=0 时，在同文件夹下生成 CombinResult.txt 的文本文件。组合数量大时效果好。

② c=1 时，合并组合结果为由指定分隔符w分隔的字符串后单列输出。

③ c=n 时，组合结果分为n列输出、各个输出区域之间空一列。

二、工作表输出时，可以按限制指定行数r进行多列(c=1时)、或多区域(c=n时)输出。

三、c=0 或 c=1 时可选择分隔符w（任意长度字符），如留空则组合结果无分隔。

…………具体下载附件试一试便知。

组合之递归算法.zip (15.54 KB, 下载次数: 523)

增加附件，加入了数组循环算法。
数组循环算法，速度可以提高很多倍。
但组合解数很多很多时，程序总耗时仅仅取决于输出组合内容的多少，
而此时，组合计算的耗时则完全可以忽略不计……

递归及循环的组合算法.zip (26.85 KB, 下载次数: 452)

再增加一个有趣的数组位置移动组合算法。
虽然速度效率没有Do循环的高，但算法逻辑清晰，值得学习。
但是没有把输出部分做完整，只做了最简单的输出小于工作表行数部分。

数组位置移动组合算法.zip (9.73 KB, 下载次数: 379)

香川群子 · 发表于 2014-10-21 16:08

本帖最后由香川群子于 2014-10-21 16:19 编辑

文本输出的递归过程主要代码如下：

Sub dgZH0(s$, i&, t&) 'by kagawa
For j = i + 1 To m - n + t
      If t = n Then
         k = k + 1: Print #1, Mid(s & w & sj(j, 1), Len(w) + 1)
      Else
         Call dgZH0(s & w & sj(j, 1), j, t + 1)
      End If
Next
End Sub

结构非常简单。
…………

工作表单列输出的递归过程主要代码如下：（含多列输出）
Sub dgZH1(s$, i&, t&) 'by kagawa
For j = i + 1 To m - n + t
      If t = n Then
         k = k + 1: jg(k, 1) = Mid(s & w & sj(j, 1), Len(w) + 1)
         If k = r Then [iv1].End(1).Offset(, 1).Resize(r) = jg: k = 0 '增加了多列输出部分
      Else
         Call dgZH1(s & w & sj(j, 1), j, t + 1)
      End If
Next
End Sub

结构也还是简单的…………

工作表多列输出的递归过程主要代码如下：（也含多列输出）
Sub dgZH2(a&(), i&, t&) 'by kagawa
For j = i + 1 To m - n + t
      a(t) = j
      If t = n Then
         k = k + 1
         For l = 1 To n '里面多了一层多列展开赋值的循环代码
            jg(k, l) = sj(a(l), 1)
         Next
         If k = r Then [iv1].End(1).Offset(, 2).Resize(r, n) = jg: k = 0 '这部分也是多列输出
      Else
         Call dgZH2(a, j, t + 1)
      End If
Next
End Sub

多了一个记录组合状态的数组，以及多列赋值的内层循环。
其它部分也还是差不多的。

hyqzzs · 发表于 2014-10-21 17:15

收藏学习，谢谢大侠

旺旺家 · 发表于 2014-10-21 17:32

香川老师，能告诉我，我这个问题的代码吗。非常感谢！
http://club.excelhome.net/thread-1156724-1-1.html

旺旺家 · 发表于 2014-10-21 17:32

麻烦告之。急于求算法。优化组合。

aoe1981 · 发表于 2014-10-21 18:42

值得学习，收藏！！！毫无疑问地顶帖！！！

张雄友 · 发表于 2014-10-21 19:00

我靠，我看了短命10年都值了。

张雄友 · 发表于 2014-10-21 19:05

本帖最后由张雄友于 2014-10-21 19:15 编辑

香川群子，灰袍法师，小fisher，百度不到去谷歌，aoe1981 真是这方面的人才啊！！！

晓宁宁 · 发表于 2014-10-21 19:12

虽然不懂，但还是觉得很厉害。

张雄友 · 发表于 2014-10-21 19:17

真的很有用，顶！

Dim sj, jg(), m&, n&, k&, r&, c&, w$, cnt&
Sub Combin_dg() 'by kagawa
tms = Timer
m = [a1].End(4).Row: sj = [a1].Resize(m): [a:a].EntireColumn.AutoFit
n = [b2]: k = WorksheetFunction.Combin(m, n)
w = [b4]
r = [b5]: If r = 0 Then r = 50000: [b5] = r
c = Val([b6]): If c Then cnt = ((k - 1) \ r + 1) * IIf(c = 1, 1, n + 1) + 6: If cnt > Columns.Count Then MsgBox cnt & " > " & Columns.Count & " Err !": Exit Sub
[e1].Resize(, Columns.Count - 5) = 1: [e1].CurrentRegion = "": [e1] = "Output": [b9:b12] = "":
k = 0: cnt = 0: tm1 = Timer
If c = 0 Then
Open ActiveWorkbook.Path & "\CombinResult.txt" For Output As #1
Call dgZH0("", 0, 1)
Close #1
ElseIf c = 1 Then
ReDim jg(1 To r, 1 To 1)
Call dgZH1("", 0, 1)
If [b3] > r Then [iv1].End(1).Offset(, 1).Resize(k) = jg
[f1].Resize(, [b7]).EntireColumn.AutoFit
Else '
c = n: [b6] = n
[f1].Resize(, 1 + [b7]).ColumnWidth = [a1].ColumnWidth
ReDim a&(1 To n): ReDim jg(1 To r, 1 To n)
Call dgZH2(a, 0, 1)
If [b3] > r Then [iv1].End(1).Offset(, 2).Resize(k, n) = jg
End If
[d1] = "": [b9] = cnt
If c And [b3] < r Then
[b10] = Format(Timer - tm1, "0.000"): tm2 = Timer
[f1].Resize(k, c) = jg: [f1].Resize(, c).EntireColumn.AutoFit: [b11] = Format(Timer - tm2, "0.000")
End If
[b12] = Format(Timer - tms, "0.000")
MsgBox Format(Timer - tms, "0.000s ") & Format([b3], "#,##0") & "/" & Format(cnt, "#,##0")
End Sub
Sub dgZH0(s$, i&, t&) 'by kagawa
Dim j&
cnt = cnt + 1
For j = i + 1 To m - n + t
If t = n Then k = k + 1: Print #1, Mid(s & w & sj(j, 1), Len(w) + 1) Else Call dgZH0(s & w & sj(j, 1), j, t + 1)
Next
End Sub
Sub dgZH1(s$, i&, t&) 'by kagawa
Dim j&
cnt = cnt + 1
For j = i + 1 To m - n + t
If t = n Then
k = k + 1: jg(k, 1) = Mid(s & w & sj(j, 1), Len(w) + 1)
If k = r Then [iv1].End(1).Offset(, 1).Resize(r) = jg: k = 0
Else
Call dgZH1(s & w & sj(j, 1), j, t + 1)
End If
Next
End Sub
Sub dgZH2(a&(), i&, t&) 'by kagawa
Dim j&, l&
cnt = cnt + 1
For j = i + 1 To m - n + t
a(t) = j
If t = n Then
k = k + 1
For l = 1 To n
jg(k, l) = sj(a(l), 1)
Next
If k = r Then [iv1].End(1).Offset(, 2).Resize(r, n) = jg: k = 0
Else
Call dgZH2(a, j, t + 1)
End If
Next
End Sub

复制代码

		自动登录	找回密码
密码			免费注册

[原创] 【最优组合算法】之递归以及循环算法，及其组合结果输出实用附件

评分

点评

评分

点评

评分

点评