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

彭希仁

可以改为由记事本输出啊

lb_bn

彭总的又一经典之作，学习了。

robinob

我果然是初学者……请问该怎么修改？能否指点一下。

老伙计2008

我把楼主的非递归算法优化一下，速度提高7%。
注：虽然速度快了一些，但是增加一些局限性，即数字个数不能超过255个，且最大数字不能大意255。反过来再看这个局限性，这个问题基本可以忽略，因为即便100数字选10个，在普通的微机上也是实现不了的。这是我的初步判断，我没敢试 ，觉得试了也没意义。
代码如下：
Sub pengxi()
    aa = Timer
    Dim x%, arr() As Byte
    Dim i%
    Dim j%
    Dim jj As Long
    a = [A65536].End(xlUp).Row + 1
    arrx = Range("A1:A" & a)
    ReDim arr(1 To UBound(arrx))
    For i = 1 To UBound(arrx)
        arr(i) = arrx(i, 1)
    Next
    z = Cells(1, 2)
    ReDim arr1(1 To z + 1) As Long   '存地址
    ReDim arr2(1 To z + 1)   '存组合
   
    Open "d:\peng.txt" For Output As #1
    For i = z To 1 Step -1    '初始化
        arr1(i) = i
        arr2(i) = arr2(i + 1) & " " & arr(i)
    Next i
    arr1(z + 1) = 1000
    Do
        jj = jj + 1                   '输出结果
        Print #1, arr2(1)

        For i = 1 To z
            If arr1(i + 1) - arr1(i) > 1 Then Exit For
        Next i

        arr1(i) = arr1(i) + 1
        arr2(i) = arr2(i + 1) & " " & arr(arr1(i))

        For j = i - 1 To 1 Step -1
            arr1(j) = j
            arr2(j) = arr2(j + 1) & " " & arr(j)
        Next j
    Loop While arr1(z) < a
    Close #1
    MsgBox "找到 " & jj & " 个解! 花费" & Format(Timer - aa, "0.00" & "保存在D:\peng.txt") & "秒"
End Sub

[ 本帖最后由 老伙计2008 于 2009-11-15 13:37 编辑 ]

robinob

彭老师～啊是很忙～我还在翘首企盼～请教了些同学～玩VB的不多……还请老师帮忙～

老伙计2008

研究了好几天，也没有搞清楚彭版的代码。
所以不知道到该算法怎么把组合输出到数字型数组？
请彭版指点！

彭希仁

原帖由 老伙计2008 于 2009-11-13 12:57 发表
研究了好几天，也没有搞清楚彭版的代码。
所以不知道到该算法怎么把组合输出到数字型数组？
请彭版指点！

这东西是不太好理解,其实是由最简单FOR嵌套演变而来.那几个数组,你可以当成各个FOR的变量

老伙计2008

我慢慢消化吧

robinob

……彭老师，额～
是不是需要考验我一下……那或者，您告诉我，我该从哪部分入手了解怎样改这个输出吧？呵呵，希望您能指点一下。

彭希仁

老伙计2008不是已经改好了吗?