“有相同元素的排列”算法怎样实现？

aoe1981

好久没逛论坛了，水平又回到了幼儿园，深深感到岁月如梭，蹉跎失败，“学如逆水行舟，不进则退”，铁一般的规律！

如今神经发作，忽来冒泡，居然也只能是“求助”。论坛的规矩还是懂一些，已经被解决了n多次的问题最好是搜一搜，看一看，学一学，想一想，便这样做了。只是由于懒惰和笨拙，愈发地“惜时惜力”起来，浅浅地没有发现，便又急于发帖，像一个莽撞的新人。

关于“排列组合算法”，是香川群子女侠的长技，可资参考取用者良多，消化不尽。其众多算法，只曾较多关注了“递归组合”，所学零星散失，不成气候，难以应对今日之问题。论坛藏龙卧虎，必有“仙人指路”，寄望颇多。

题如下：

设有元素：1、2、2、3、3、3，能组成多少个不同的三位数？

m选n的排列，此处：m＝6，n＝3，难点在于m个元素中存在若干不定的相同元素。

我能算出来。

步骤（一）：整理不重复元素及其个数
元素1：1个
元素2：2个
元素3：3个

步骤（二）：确定不同元素的抽取个数，凑n
①1＋2＋0＝3
②1＋1＋1＝3
③0＋2＋1＝3
④1＋0＋2＝3
⑤0＋1＋2＝3
⑥0＋0＋3＝3
三个加数从左至右依次表示元素1、元素2、元素3的抽取个数。
这也算是一个特殊的凑数问题：加数1的最大值限制为1，加数2的最大值限制为2，加数3的最大值限制为3。我是手动罗列的，用代码光这一步，就够呛。

步骤（三）：确定m选n的不同组合
①1、2、2
②1、2、3
③2、2、3
④1、3、3
⑤2、3、3
⑥3、3、3


这些组合其实就是步骤（二）中不同元素抽取个数所对应的实际抽取元素。

步骤（四）：对每一个m选n组合的所有元素求取不重复全排列数
如果是m选m的不重复全排列数，是有公式可以直接求得的，难就难在“一般地m选n（n<m）的不重复排列数”的计算。
①3!/(1!2!)=3，具体有：122、212、221；
②3!/(1!1!1!)=6，具体有：123、132、213、231、312、321；
③3!/(2!1!)=3，具体有：223、232、322；
④3!/(1!2!)=3，具体有：133、313、331；
⑤3!/(1!2!)=3，具体有：233、323、332；
⑥3!/3!=1，具体有：333。


一共有：3＋6＋3＋3＋3＋1＝19（个）。
若是6个不同的元素，选取3个的排列有：6*5*4=120（个）；选取3个的组合有：6*5*4/3/2/1=20（个）。
上述6个元素的不重复全排列数为：6!/(1!2!3!)=720/12=60（个）。

显见，这种思路用代码实现起来极为不易，至少对于我而言。

实在是：冒昧了。

蓝桥玄霜

如果n比较小的话，可直接用多重循环+字典，获得需要的组合。
这个似乎很简单的。

zopey

从120个排列 筛选出19个。

zopey

附件如下

排列.zip (9.89 KB, 下载次数: 19)

2019-6-13 09:04 上传

点击文件名下载附件

aoe1981

zopey 发表于 2019-6-13 09:04
附件如下

大致是根据元素的位置序号生成所有排列，再根据位置序号置换回元素本身，然后再用字典去重，并累计重数。

排列算法尚需深入研究，这一句写法就很值得学习：

[a1].Resize(dic.Count, 2) = Application.Transpose(Array(dic.keys, dic.items))

感谢感谢，受教受教。

aoe1981

zopey 发表于 2019-6-13 09:04
附件如下

我不是习惯“递归”的方法实现排列，以下“递归排列”修改自香川女侠的“递归组合”算法：

1. Option Explicit
   
2. Dim sj$(), jg$(), m&, n&, cnt&, k&, ljf$, c%()
   
3. Sub 递归排列() 'aoe1981
   
4.     Dim sj0(), tms!, i&
   
5.     tms = Timer
   
6.     With Sht1
   
7.         m = .Range("b2").Value '元素总个数
   
8.         n = .Range("b4").Value '选取元素个数
   
9.         sj0 = .Range("a2").Resize(m).Value '元素
   
10.         ljf = .Range("b6").Value '连接符
    
11.         cnt = Application.Permut(m, n) '排列总数
    
12.         
    
13.         ReDim sj$(1 To m), c%(1 To m)
    
14.         For i = 1 To m '二维转一维
    
15.             sj(i) = sj0(i, 1)
    
16.         Next i
    
17.         
    
18.         ReDim jg$(1 To cnt, 1 To 1)
    
19.         k = 0
    
20.         Call dgPL("", 1)
    
21.         
    
22.         .Range("d2").Resize(Rows.Count - 1, 1).Value = ""
    
23.         .Range("d2").Resize(cnt, 1).Value = jg
    
24.     End With
    
25.     MsgBox "用时：" & Timer - tms & "秒，共产生：" & cnt & "个排列。"
    
26. End Sub
    
27. Sub dgPL(s$, t&)
    
28.     Dim j&
    
29.     For j = 1 To m
    
30.         If c(j) = 0 Then
    
31.             c(j) = 1
    
32.             If t = n Then
    
33.                 k = k + 1
    
34.                 jg(k, 1) = Mid(s & ljf & sj(j), 2)
    
35.                 c(j) = 0
    
36.             Else
    
37.                 Call dgPL(s & ljf & sj(j), t + 1)
    
38.                 c(j) = 0
    
39.             End If
    
40.         End If
    
41.     Next j
    
42. End Sub
    

复制代码

香川女侠的“递归组合”算法如下：

1. Option Explicit
   
2. Dim sj$(), jg$(), m&, n&, cnt&, k&, ljf$
   
3. Sub 递归组合() 'kagawa
   
4.     Dim sj0(), tms!, i&
   
5.     tms = Timer
   
6.     With Sht
   
7.         m = .Range("b2").Value '元素总个数
   
8.         n = .Range("b4").Value '选取元素个数
   
9.         sj0 = .Range("a2").Resize(m).Value '元素
   
10.         ljf = .Range("b6").Value '连接符
    
11.         cnt = Application.Combin(m, n) '组合总数
    
12.         
    
13.         ReDim sj$(1 To m)
    
14.         For i = 1 To m '二维转一维
    
15.             sj(i) = sj0(i, 1)
    
16.         Next i
    
17.         
    
18.         ReDim jg$(1 To cnt, 1 To 1)
    
19.         k = 0
    
20.         Call dgZH("", 0, 1)
    
21.         
    
22.         .Range("d2").Resize(Rows.Count - 1, 1).Value = ""
    
23.         .Range("d2").Resize(cnt, 1).Value = jg
    
24.     End With
    
25.     MsgBox "用时：" & Timer - tms & "秒，共产生：" & cnt & "个组合。"
    
26. End Sub
    
27. Sub dgZH(s$, i&, t&)
    
28.     Dim j&
    
29.     For j = i + 1 To m
    
30.         If t = n Then
    
31.             k = k + 1
    
32.             jg(k, 1) = Mid(s & ljf & sj(j), 2)
    
33.         Else
    
34.             Call dgZH(s & ljf & sj(j), j, t + 1)
    
35.         End If
    
36.     Next j
    
37. End Sub
    

复制代码

附件如下：
我的排列算法_aoe1981.zip (29.11 KB, 下载次数: 14)

2019-6-13 21:39 上传

点击文件名下载附件

或许您的代码更高效，我的侧重点在于“实现”，其实也并无什么“庞大”的应用需求。标记变量c(i)算是粗糙地受了您的影响。
当然，这也是直接生成所有排列，再去重的思路。去重部分我没做，数据透视表等也可以轻易实现。
看来，“有相同元素的排列”直接生成的算法是困难的。也有可能是我在一楼的计算思路本身就是繁琐的。解决非常问题，或许必是要有“非常的思路”，我便只作胡想罢了。

zopey

sub 不能直接返回结果，要通过 定义 N个公共变量 传递，这一点不如 function。

香川群子

1. Option Explicit
   
2. Dim sj, a&(), jg(), m&, n&, k&, z&, cnt&
   
3. Sub 递归不重复组合() 'by kagawa
   
4.     Dim i&, tms#
   
5.     tms = Timer
   
6.    
   
7.     m = [a1].End(4).Row: [b1] = m '元素总数m
   
8.     [a1].Resize(m).Sort [a1], 1, , , 2 '去重复前 待组合元素需要排序！
   
9.     sj = WorksheetFunction.Transpose([a1].Resize(m))
   
10.     n = [b2] '排列/组合取数n
    
11.     z = [b3] '模式z：排列=1/组合=0或留空
    
12.    
    
13.     ReDim a&(m), jg(1000, n) '定义排列重复标记数组a、输出结果数组jg
    
14.     k = 0: cnt = 0: Call dgBcfZH(0, 0) '递归计算
    
15.    
    
16.     jg(0, 0) = "k= " & k
    
17.     For i = 1 To n
    
18.         jg(0, i) = "a" & i
    
19.     Next
    
20.     [e1].CurrentRegion = "": If k Then [e1].Resize(k + 1, n + 1) = jg
    
21. End Sub
    
22. Sub dgBcfZH(i&, t&)
    
23.     Dim j&, j2&, s$
    
24.     cnt = cnt + 1
    
25.    
    
26.     If t = n Then '取数达到n时 记录结果并退出递归
    
27.         k = k + 1
    
28.         jg(k, 0) = k
    
29.         For j2 = 1 To n
    
30.             jg(k, j2) = jg(0, j2 - 1)
    
31.         Next
    
32.         Exit Sub '退出递归
    
33.     End If
    
34.    
    
35.     For j = IIf(z, 1, i + 1) To m 'z=1排列/z=0组合
    
36.         If a(j) = 0 Then '本元素未取用时
    
37.             s = sj(j)
    
38.             If s <> jg(0, t) Then '本元素和上一组合位置内容不重复时
    
39.                 a(j) = 1 '标记已使用
    
40.                 jg(0, t) = s: jg(0, t + 1) = "" '更新组合记录，并清空下一位置
    
41.                 Call dgBcfZH(j, t + 1)
    
42.                 a(j) = 0 '回溯时恢复本元素未使用状态
    
43.             End If
    
44.         End If
    
45.     Next
    
46. End Sub
    

复制代码

香川群子

我研究过，利用各种组合状态标记，计算比较之后输出不重复排列/组合的算法，也成功了。

但是，比较代码运行速度发现，还是很简单地用先组合，再检查本次组合元素是否和上次的记录不同，这样的递归算法，既简单，速度也快。

不重复排列算法，和不重复组合算法的差别并不大。
排列每次需要循环遍历1 To m，且需检查是否该元素已被使用过。
而组合每次仅需循环 i+1 To m ，而且无需检查是否已被使用过（肯定是未被使用过的。）

心如止水/v

aoe1981 发表于 2019-6-13 21:45
我不是习惯“递归”的方法实现排列，以下“递归排列”修改自香川女侠的“递归组合”算法：

jg(k, 1) = Mid(s & ljf & sj(j), 2)这一句，如果连接符为空时，mid第二参数应该为1