非递归生成所有排列(knuth)

' knuth给的算法

' 生成所有排列
Option   Explicit

Dim  result, counter
const  N  =   4
const  Format  =   10

Sub  Swap(byRef InArray, first,  second )

Dim  t
t  =  InArray(first)
InArray(first)  =  InArray( second ) 
InArray( second )  =  t

End Sub

Function  GenPer(byRef counter, N, Format)

Dim  c( 10 ), o( 10 ) ,t( 10 )
Dim  I, j, s, q, result
Dim  oLoopFlag, iLoopFlag

For  I  =   0   To  N  -   1
     c(I)  =   0
     o(I)  =   1
     t(I)  =  I
Next

oLoopFlag  =   True
counter  =   0

While  oLoopFlag

    For  I  =   0   To  N  -   1
    result  =  result  &  t(I)
    Next

   result  =  result  &   "   "
   counter  =  counter  +   1

    If  counter  Mod  Format  =   0   Then
    result  =  result  &   chr ( 13 )  &   chr ( 10 )
    End   If

   j  =  N  -   1
   s  =   0
   iLoopFlag  =   True

    While  iLoopFlag
    q  =  c(j)  +  o(j)
     If  q  >  j  or  q  <   0   Then
      If  j  =   1   Then
      iLoopFlag  =   False
      oLoopFlag  =   False
      Else  
       If  q  >  j  Then
      s  =  s  +   1
       End   If
      o(j)  =   - o(j)
      j  =  j  -   1
      End   If
     Else
     Swap t, j  -  c(j)  +  s, j  -  q  +  s
     c(j)  =  q
     iLoopFlag  =   False
     End   If
    Wend

Wend

Genper  =  result

End Function

result  =  GenPer(counter, N, Format)
result  =  result  &   chr ( 13 )  &   chr ( 10 )  &   " 总数: "   &  counter

MsgBox (result)