ギザギザの配列の置換

Question

古典的なasp（vbscript）で多次元配列の置換を作成しようとしていますが、私は真剣に立ち往生しています。私は自分自身のいくつかの関数を試してきましたが、いくつかのPHPバージョンをコピーしてみましたが、バッファオーバーフロー/無限再帰のいずれかになるか、まるで置換のような結果が得られます。違いを正しく理解しています。

シャツ用です。シャツは色、サイズ、スタイルを持つことができます。 （実際のシステムでは、色、サイズなどを考慮して、任意の数のグループのオプション（色、サイズなどを考えてください）、各グループ内の任意の数のオプション（それぞれの特定のサイズや色など）を指定することができます。

例：

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

アレイの寸法のいずれかの要素の数が予め知られていないことに注意してください。私は、可能な各ユニークなオプションを反復処理する必要もなく、全ての第2の次元は、同じ数の要素を有することになる

。各行のオプションが含まれています。この特定の例では、32個のオプションがあります（これは、 tsは空の値を持っています。なぜなら、aspは私が期待していたようにギザギザの配列を本当に扱っていないからです。だから、： 小さな赤いポケット 小さな赤い無ポケット 小さな青いポケット 小さな青い無ポケット など

私はこの部分が完了したら、私は、データベースから、いくつかのIDとそれを統合する必要があります、私は自分自身でその部分を行うことができると確信しています。それは私を殺す再帰関数です。

良いスタート地点を指すことができますか、誰かが私を助けてくれますか？どんな助けでも大歓迎です！

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 

いくつかのヒント/備考：番号順に6（？7）場所/数字のためのすべての組み合わせをgenereratesオドメーターと考えてください。次に、各場所/スロットの順序/順序付けされた「数字」/単語/項目のセットを指定できるオドメーターを想像してください。この仕様はaaItemsによって行われます。不足しているドキュメントの

''= 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 

申し訳ありません：

この

は.RUNで使用CPADのコード、（）です。あなたの質問にすべて答えようとします。

Answer 2

これら4つの固定カテゴリについて心配する必要がある場合は、入れ子のforループを使用するだけです。

カテゴリの数は変更することができる場合は、再帰的な解決策を定義するのは簡単である：最良の結果を得るために、空のインデックス= 0および順列と

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 = 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