[讨论]排列组合之最优算法

TGB

泓()你是日本人吗？语气有点像哟










完了，版主该不会认为我在灌水吧

lj1226189

太好了!真是太好了!可惜我功力太浅!有些地方有点看不懂!

43379677

好啊

[此贴子已经被作者于2007-11-13 8:39:52编辑过]

彭希仁

非递归排列组合的原理是地址搬移.

        For i = 1 To z
            If arr1(i + 1) - arr1(i) > 1 Then Exit For       找出后一位比当前位,大于1的数.并退出
        Next i

        arr1(i) = arr1(i) + 1                               当前位加1
        arr2(i) = arr2(i + 1) & " " & arr(arr1(i), 1)

        For j = i - 1 To 1 Step -1
            arr1(j) = j                                     后面的按位置号由大到小排序.......第四位4,第三位3,第二位2,第一位1.
            arr2(j) = arr2(j + 1) & " " & arr(j, 1)
        Next j

1000\5\4\3\2\1     程序从右向左找出后一位比当前位,大于1的数.即第六位的1000-1>5,当前位加5+1变成6,后面的按位置号由大到小排序.第四位4,第三位3,第二位2,第一位1.

1000\6\4\3\2\1    

1000\6\5\3\2\1

1000\6\5\4\2\1

1000\6\5\4\3\1

1000\6\5\4\3\2

1000\7\4\3\2\1

彭希仁

递归算法的法则是太极原理,一生二,二生四,四生八,八生十六

Sub xi(a, arr, x As Long, y As Long, z As Long, jj As Long)
    Call xi(a & " " & arr(x, 1), arr, x + 1, y + 1, z, jj)  '相当于1

    Call xi(a, arr, x + 1, y, z, jj)    '相当于0
End Sub

                                     1,                                                   0

                         1                      0                             1                0

               1             0              1        0                 1        0     1        0

递归是需要有退出程序的要不然就没完没了了   If x = UBound(arr) + 1 Then Exit Sub

 为了提高效率还得剪枝,即减少一些无用功,即前面0太多了,后面未计算的个数加上前面的已组合的个数都不足已最终组成需要的数量  If y + UBound(arr) - x + 1 < z Then Exit Sub

    If y = z Then             已满足Z个数的组合后打印结果并结果递归.
        jj = jj + 1
        Print #1, a
        Exit Sub
    End If

Sub peng()
    aa = Timer
    Dim jj As Long, cc As Long
    Open "d:\peng.txt" For Output As #1
    arr = Range("A1:A" & [A65536].End(xlUp).Row)
    Call xi("", arr, 1, 0, Cells(1, 2), jj)
    Close #1
    MsgBox "找到 " & jj & " 个解! 花费" & Format(Timer - aa, "0.00" & "保存在D:\peng.txt") & "秒"
End Sub

Sub xi(a, arr, x As Long, y As Long, z As Long, jj As Long)
    If y = z Then
        jj = jj + 1
        Print #1, a
        Exit Sub
    End If
    If x = UBound(arr) + 1 Then Exit Sub
    If y + UBound(arr) - x + 1 < z Then Exit Sub
    Call xi(a & " " & arr(x, 1), arr, x + 1, y + 1, z, jj)  '字附串和数字的处理速度是相差很大的
    Call xi(a, arr, x + 1, y, z, jj)
End Sub

abcd321abcd

彭弟的逻辑思维能力，我等望尘莫及。VBA功底，了得。向你学习！！！

白天睡觉

彭大师太厉害了,我觉得像看天书一样,有时间的话好好向你学习.

baoshaobo

佩服！有没有新手上路的启蒙教材？在这里谢谢啦！！！

乐习

冰冻三尺,非一日之寒啊!真是受教了!不过我个人觉得女儿长大更喜欢爸爸一些!所以有女儿的爸爸们应该感到幸福啊!

btking

慢慢跟楼主学习吧。