锯齿阵列排列

Question

我试图在经典的asp（vbscript）中创建一个多维数组的排列，并且我被严重卡住了。我尝试了我自己的几个函数，也尝试复制几个php版本，但我经常最终得到的东西要么进入缓冲区溢出/无限递归，要么得到的结果更像组合而不是排列，如果我明白正确的区别。

可以说是衬衫。衬衫可以有颜色，尺寸和款式。 （实际系统允许任意数量的“组”选项（想象颜色，尺寸等）以及每个组中的任意数量的选项（每个特定尺寸，每种特定颜色等）。

例如：

 
small med   lg  xl 
red  blue  green white 
pocket no-pocket 

注意的是，在阵列的任维中的元素的数量是预先未知;另，不是所有的第二尺寸将具有相同数量的元素

我需要通过每个可能的唯一选项来迭代每行都包含一个选项，在这个特定的例子中，会有32个选项（因为我需要忽略resul ts对于任何给定的选项都有一个空值，因为asp没有像我期望的那样真正处理锯齿阵列。所以： 红色小口袋 小冲没有口袋 蓝色小口袋 小蓝没有口袋 等

一次，我已经完成这个部分，我需要将它与一些标识从数据库整合，但我确信我可以自己做那部分。这是递归功能，正在杀死我。

任何人都能指出我在一个好的起点或帮助我？任何帮助深表感谢！

Answer 1

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

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 

一些提示/备注：想那genererates所有组合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 2

如果您只需要担心这四个固定的类别，只需使用嵌套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) 

调用具有索引= 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. 

Answer 3

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