史上最酷的Excel VBA 组合算法 代码

yjh_27

ak47ok 发表于 2014-8-3 21:40
这个明白，没能力瞎想是没用的，
足彩的没有玩过、
我可是怀着崇高理想来学习这正交的，呵呵！

你不是已有31因素5水平的

去掉7个因素就是了。摆渡 正交表的构造详述  完整的正交试验设计介绍

yxrlqy

太牛了，学习了。

ak47ok

yjh_27 发表于 2014-9-15 10:23
你不是已有31因素5水平的

去掉7个因素就是了。摆渡 正交表的构造详述  完整的正交试验设计介绍

感谢关注！能有31因素的更好，广范围撒网，再用14因素13水平来精选。

aoe1981

香川群子 发表于 2013-7-4 22:43
这个是我的组合算法的核心部分代码

想要研究的话，看懂这部分就OK了。

　　下面是关于香川Do循环组合的理解与分析：
　　核心代码：

1. Do
   
2.     i = i + 1
   
3.     a(j) = i
   
4.     Mid(s, (j - 1) * l + 1, l) = sj(i)
   
5.     If j = n Then
   
6.         k = k + 1
   
7.         jg(k, 1) = s
   
8.         If i = m Then If j = 1 Then Exit Do Else j = j - 1: i = a(j) '循环出口1：仅在m选1时从此退出
   
9.     ElseIf i = m - n + j Then
   
10.         k = k + 1
    
11.         jg(k, 1) = s
    
12.         If j = 1 Then Exit Do Else j = j - 1: i = a(j) '循环出口2：m选2~n均从此退出
    
13.     Else
    
14.         j = j + 1
    
15.     End If
    
16. Loop
    

复制代码

　　研究截图：
　　

aoe1981

下面是关于两处输出结果的分析：

1. Do
   
2.     i = i + 1
   
3.     a(j) = i
   
4.     Mid(s, (j - 1) * l + 1, l) = sj(i)
   
5.     If j = n Then
   
6.         k = k + 1
   
7.         jg(k, 1) = s '此处输出第n位向前跳位时的组合结果
   
8.         If i = m Then If j = 1 Then Exit Do Else j = j - 1: i = a(j)
   
9.     ElseIf i = m - n + j Then
   
10.         k = k + 1
    
11.         jg(k, 1) = s '此处输出第n-1至1位向前跳位时的组合结果
    
12.         If j = 1 Then Exit Do Else j = j - 1: i = a(j) '当然第1位是没法向前跳位的，因此跳出循环
    
13.     Else
    
14.         j = j + 1
    
15.     End If
    
16. Loop
    

复制代码

aoe1981

这是我总结的跳位方法，来个文字的，备注下：
因此，可以粗略地想见，我们的跳位原则是：
1.从组合结果最后一个元素位置起，增加至本位置终止值，不能增加时，向前跳一位；
2.前位数值未达到其位终止值时，加1后继续后位循环；若前位值亦增加至其位终止值时，则继续前跳一位，重复本步。

顺便再说一句：
香川Do循环组合确实技术高超，思维巧妙，最重要的是想人们所不敢想，一个Do循环居然可以替代任意n层for循环……啧啧，奇之、服之！！！

香川群子

aoe1981 发表于 2014-10-22 20:22
这是我总结的跳位方法，来个文字的，备注下：
因此，可以粗略地想见，我们的跳位原则是：
1.从组合结果最 ...

嗯。你的理解是正确的。

我在生成组合循环过程中，主要使用了两个参数 i 和 j 。

其中， j 是组合位、变动取值范围 1 To n (需要抽取n个元素)
i 是组合抽取元素的序号、变动取值范围 1 To m (数据一共m个元素)

计算过程、规则如下：
1、初始化
j 从 1 To n到达末尾n位置，i 也从 1 To n (未到最大值m)

2、正式开始循环
a. 首先固定 j位置=n 即在末尾 n位置不变，而 i 进行 For循环从 i +1 To m；
b. j 从 n-1 To 1 倒序检查，读取该位置的 i 值，并+1 升位，
    然后检查升位以后的 i 值是否已达最高位置，即  i  = m-n+j 表明下一次已经不能升位了，
    且当前状态就是有效组合之一，所以直接记录。
c.  在b状态时，继续位置 j-1 向前移动、然后读取 i 值并检查，直到升位以后的 i +1 < m-n+j ，则表明可以向后升位了。
d.  在c状态时，则应位置 j+1 向后移动、然后把该位置的 i 值更新为 i +1……直到n-1位置。
f.   j 移动到末尾位置，可以回到a开始新的Do循环。

…………直至最后 j = 0时结束。

…………如果是 1、2、3、4、5、6 这m=6个数中任取n=4个进行组合，则过程如下：
① 初始化，
a = 1,2,3,?
此时，j=n=4、i =3

② 末尾位置递增到m=6
1,2,3,4
1,2,3,5
1,2,3,6

③ 检查j=n-1 To 1 并升位
1,2,4,？   由于4<最终组合 3,4,5,6中的5，可以j=j+1向后继续

④ j=n、末尾位置i+1递增直到m=6
1,2,4,5
1,2,4,6

⑤ 检查j=j-1=3 时，发现4+1=5已到最高位置(m-n+j)
1,2,5,6于是直接记录该有效组合


⑥ 继续向前检查
1,2,5,6 → 因为2+1<4 所以可以继续

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

ldy

好代码，收藏
顺便废话两句 ，COMBIN 组合       PERMUT排列   这两个函数是excel的内置函数
群子的代码要 移植到 Vb 或者VBS 等没有excel的环境中
需要 编写两句 代码来代替
    x = 1
    For i = 1 To n'''''组合
        x = x * (m - n + i) / i
    Next
等同于 x= Application.COMBIN(m,n)


    x = 1
    For i = 1 To n'''''排列
        x = x * (m - n + i)
    Next
等同于 x= Application.PERMUT(m,n)

貌似是高中数学教的
排列总数= 最大的n个数累乘            组合= 排列总数/ 最小n个数累乘

香川群子

ldy 发表于 2014-10-24 11:53
好代码，收藏
顺便废话两句 ，COMBIN 组合       PERMUT排列   这两个函数是excel的内置函数
群子的代码要 ...

如果是For i = 1 To Combin / Permut 循环，当然需要事先知道排列组合的结果总数。

但我的Do循环代码不需要事先知道 Cobin和Permut的计算结果。
在循环完成后，自然就得到了排列组合的结果总数k。

ldy

香川群子 发表于 2014-10-24 13:55
如果是For i = 1 To Combin / Permut 循环，当然需要事先知道排列组合的结果总数。

但我的Do循环代码 ...

确实是目前最优化的方法 ，Do 循环的次数，跟计算结果非常接近了
我现在加不了分了，送花