鋸齒陣列排列

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