锯齿状数组的排列

Question

我正在尝试在经典 asp (vbscript) 中创建多维数组的排列，但我被严重卡住了。我已经尝试了自己的几个功能，还尝试复制几个 php 版本，但我经常会得到一些结果，要么进入缓冲区溢出/无限递归，要么我得到的结果更像是组合而不是排列，如果我正确理解了这些差异。

让我们说这是一件衬衫。衬衫可以有颜色、尺寸和款式。 （实际的系统允许任意数量的选项“组”（想想颜色、尺寸等）以及每个组内的任意数量的选项（每种特定尺寸、每种特定颜色等）。

例如：

小中号 lg xl 红色 蓝色 绿色 白色 口袋无口袋

请注意，数组任一维度的元素数量是事先未知的；此外，并非所有第二维度都具有相同数量的元素。

我需要遍历每行包含一个选项的每个可能的唯一选项。在这个特定示例中，将有 32 个选项（因为我需要忽略任何给定选项具有空值的结果，因为 asp 并没有像我期望的那样真正处理锯齿状数组。所以： 红色小口袋 小红色无口袋 蓝色的小口袋 小号蓝色无口袋 等等

完成这部分后，我需要将它与数据库中的一些 ID 集成，但我很确定我可以自己完成这部分。是递归函数要了我的命。

谁能给我指出一个好的起点或帮助我？非常感谢任何帮助！

Answer 1

20 行的通用解决方案！

Function Permute(parameters)

    Dim results, parameter, count, i, j, k, modulus

    count = 1
    For Each parameter In parameters
        count = count * (UBound(parameter) + 1)
    Next

    results = Array()
    Redim results(count - 1)

    For i = 0 To count - 1
        j = i
        For Each parameter In parameters
            modulus = UBound(parameter) + 1
            k = j Mod modulus
            If Len(results(i)) > 0 Then _
                results(i) = results(i) & vbTab
            results(i) = results(i) & parameter(k)
            j = j \ modulus
        Next
    Next

    Permute = results

End Function

Answer 2

为了避免术语问题：我写了一个小程序：

  Dim aaItems : aaItems = Array( _
      Array( "small", "med", "lg", "xl" ) _
    , Array( "red", "blue", "green", "white" ) _
    , Array( "pocket", "no-pocket" ) _
  )

  Dim oOdoDemo : Set oOdoDemo = New cOdoDemo.init( aaItems )
  oOdoDemo.run 33

这就是它的输出：

  0: small red pocket
  1: small red no-pocket
  2: small blue pocket
  3: small blue no-pocket
  4: small green pocket
  5: small green no-pocket
  6: small white pocket
  7: small white no-pocket
  8: med red pocket
  9: med red no-pocket
 10: med blue pocket
 11: med blue no-pocket
 12: med green pocket
 13: med green no-pocket
 14: med white pocket
 15: med white no-pocket
 16: lg red pocket
 17: lg red no-pocket
 18: lg blue pocket
 19: lg blue no-pocket
 20: lg green pocket
 21: lg green no-pocket
 22: lg white pocket
 23: lg white no-pocket
 24: xl red pocket
 25: xl red no-pocket
 26: xl blue pocket
 27: xl blue no-pocket
 28: xl green pocket
 29: xl green no-pocket
 30: xl white pocket
 31: xl white no-pocket
 32: small red pocket

如果这看起来像是解决您问题的种子，请直接说出来，我将发布 cOdoDemo 类的代码。

cOdoDemo 代码：

'' cOdoDemo - Q&D combinations generator (odometer approach)
'
' based on ideas from:
'  !! http://www.quickperm.org/index.php
'  !! http://www.ghettocode.net/perl/Buzzword_Generator
'  !! http://www.dreamincode.net/forums/topic/107837-vb6-combinatorics-lottery-problem/
'  !! http://stackoverflow.com/questions/127704/algorithm-to-return-all-combinations-of-k-elements-from-n
Class cOdoDemo

Private m_nPlaces    ' # of places/slots/digits/indices
Private m_nPlacesUB  ' UBound (for VBScript only)
Private m_aLasts     ' last index for each place => carry on
Private m_aDigits    ' the digits/indices to spin around

Private m_aaItems    ' init: AoA containing the elements to spin
Private m_aWords     ' one result: array of combined

Private m_nPos       ' current increment position

'' init( aaItems ) - use AoA of 'words' in positions to init the
''                   odometer
Public Function init( aaItems )
  Set init = Me
  m_aaItems   = aaItems
  m_nPlacesUB = UBound( m_aaItems )
  m_nPlaces   = m_nPlacesUB + 1
  ReDim m_aLasts(  m_nPlacesUB )
  ReDim m_aDigits( m_nPlacesUB )
  ReDim m_aWords(  m_nPlacesUB )
  Dim nRow
  For nRow = 0 To m_nPlacesUB
      Dim nCol
      For nCol = 0 To UBound( m_aaItems( nRow ) )
          m_aaItems( nRow )( nCol ) = m_aaItems( nRow )( nCol )
      Next
      m_aLasts( nRow ) = nCol - 1
  Next
  reset
End Function ' init

'' reset() - start afresh: all indices/digit set to 0 (=> first word), next
''           increment at utmost right
Public Sub reset()
  For m_nPos = 0 To m_nPlacesUB
      m_aDigits( m_nPos ) = 0
  Next
  m_nPos = m_nPlacesUB
End Sub ' reset

'' tick() - increment the current position and deal with carry
Public Sub tick()
  m_aDigits( m_nPos ) = m_aDigits( m_nPos ) + 1
  If m_aDigits( m_nPos ) > m_aLasts( m_nPos ) Then ' carry to left
     For m_nPos = m_nPos - 1 To 0 Step -1
         m_aDigits( m_nPos ) = m_aDigits( m_nPos ) + 1
         If m_aDigits( m_nPos ) <= m_aLasts( m_nPos ) Then ' carry done
            Exit For
         End If
     Next
     For m_nPos = m_nPos + 1 To m_nPlacesUB ' zero to right
         m_aDigits( m_nPos ) = 0
     Next
     m_nPos = m_nPlacesUB ' next increment at utmost right
  End If
End Sub ' tick

'' map() - build result array by getting the 'words' for the
''         indices in the current 'digits'
Private Sub map()
  Dim nIdx
  For nIdx = 0 To m_nPlacesUB
      m_aWords( nIdx ) = m_aaItems( nIdx )( m_aDigits( nIdx ) )
  Next
End Sub ' map

'' run( nMax ) - reset the odometer, tick/increment it nMax times and
''               display the mapped/translated result
Public Sub run( nMax )
  reset
  Dim oPad : Set oPad = New cPad.initWW( Len( CStr( nMax ) ) + 1, "L" )
  Dim nCnt
  For nCnt = 0 To nMax - 1
      map
      WScript.Echo oPad.pad( nCnt ) & ":", Join( m_aWords )
      tick
  Next
End Sub ' run

End Class ' cOdoDemo

一些提示/备注：想象一个里程表，它按数字顺序生成 6 (7?) 个位置/数字的所有组合。现在想象一个里程表，它可以让您为每个位置/插槽指定一个序列/有序的“数字”/单词/项目集。此规范由 aaItems 完成。

这是 cPad 的代码，在 .run() 中使用：

''= cPad - Q&D padding
Class cPad
Private m_nW
Private m_sW
Private m_sS
Private m_nW1
Public Function initWW( nW, sW )
  m_nW       = nW
  m_nW1      = m_nW + 1
  m_sW       = UCase( sW )
  m_sS       = Space( nW )
  Set initWW = Me
End Function
Public Function initWWC( nW, sW, sC )
  Set initWWC = initWW( nW, sW )
  m_sS        = String( nW, sC )
End Function
Public Function pad( vX )
  Dim sX : sX = CStr( vX )
  Dim nL : nL = Len( sX )
  If nL > m_nW Then
     Err.Raise 4711, "cPad::pad()", "too long: " & nL & " > " & m_nW
  End If
  Select Case m_sW
    Case "L"
      pad = Right( m_sS & sX, m_nW )
    Case "R"
      pad = Left( sX & m_sS, m_nW )
    Case "C"
      pad = Mid( m_sS & sX & m_sS, m_nW1 - ((m_nW1 - nL) \ 2), m_nW )
    Case Else
      Err.Raise 4711, "cPad::pad() Unknown m_sW: '" & m_sW & "'"
  End Select
End Function
End Class ' cPad

抱歉，缺少文档。我会尽力回答你所有的问题。

Answer 3

如果您只需要担心这四个固定类别，只需使用嵌套的 for 循环即可。

如果类别的数量可能发生变化，递归解决方案很容易定义：

  permute(index, permutation[1..n], sources[1..n])
  1. if index > n then print(permutation)
  2. else then
  3     for i = 1 to sources[index].length do
  4.       permutation[index] = sources[index][i]
  5.       permute(index+1, permutation, sources)

使用 index=0 和空排列调用以获得最佳结果（源是包含您的类别的数组）。

例子：

  index = 1
  sources = [[blue, red, green], [small, medium, large], [wool, cotton, NULL], [shirt, NULL, NULL]].
  permutation = [NULL, NULL, NULL, NULL]

  permute(index, permutation, sources)
   note: n = 4 because that's how many categories there are
   index > n is false, so...
   compute length of sources[1]:
    sources[1][1] isn't NULL, so...
    sources[1][2] isn't NULL, so...
    sources[1][3] isn't NULL, so...
    sources[1].length = 3

   let i = 1... then permutation[1] = sources[1][1] = blue
   permute(2, permutation, sources)

   etc.