1

従来の ASP (vbscript) で多次元配列の順列を作成しようとしていますが、非常に行き詰っています。私は自分自身のいくつかの関数を試し、いくつかのphpバージョンをコピーしようとしましたが、バッファオーバーフロー/無限再帰に陥るか、順列よりも組み合わせのような結果が得られることがよくあります.違いを正しく理解しています。

シャツ用としましょう。シャツには、色、サイズ、およびスタイルを指定できます。(実際のシステムでは、任意の数のオプションの「グループ」(色、サイズなど) と、各グループ内の任意の数のオプション (それぞれの特定のサイズ、それぞれの特定の色など) が許可されます。

例えば：

スモール メッド LG XL
赤 青 緑 白
ポケットなしポケット

配列のいずれかの次元の要素数は事前に不明であることに注意してください。また、すべての 2 次元が同じ数の要素を持つわけではありません。

各行のオプションを含む、考えられる一意のオプションをそれぞれ反復処理する必要があります。この特定の例では、32 個のオプションがあります (任意のオプションに対して空の値を持つ結果を無視する必要があるためです。なぜなら、asp は期待どおりにギザギザの配列を実際には処理しないからです。つまり: 小さな赤いポケット 小さな赤ポケットなし 青 ポケット小 青 ポケットなし etc.

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

良い出発点で私を指摘したり、私を助けてくれる人はいますか? どんな助けでも大歓迎です！

4

3 に答える 3

2

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
于 2013-01-18T22:48:17.533 に答える
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 によって行われます。

これは、.run() で使用される cPad のコードです。

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

不足しているドキュメントについて申し訳ありません。私はあなたのすべての質問に答えようとします。

于 2011-07-20T17:21:04.387 に答える
0

これら 4 つの固定カテゴリだけを気にする必要がある場合は、ネストされた 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 で順列を空にして呼び出します (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.
于 2011-07-20T15:55:42.957 に答える