Permutation of jagged array

I'm trying to create a permutation of a multidimensional array in classic asp (vbscript) and I'm seriously stuck. I've tried several functions of my own and also tried copying several php versions over, but I often end up with something that either goes into a buffer overflow / infinite recursion or I get results that are more like a combination than a permutation, if I understand the differences correctly.

Lets say it's for a shirt. The shirt can have colors, sizes, and styles. (The actual system allows for any number of "groups"开发者_运维百科 of options (think color, size, etc) and also any number of options within each group (each particular size, each particular color,etc).

For example:

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

Note that the number of elements in either dimension of the array are unknown beforehand; also, not all second dimensions will have the same number of elements.

I need to iterate through each possible unique option that contains an option from each row. In this particular example, there would be 32 options (because I need to ignore results that have an empty value for any given option, since asp doesn't really handle a jagged array the way I would expect. So: small red pocket small red no-pocket small blue pocket small blue no-pocket etc.

Once I have this part done, I'll need to integrate it with some IDs from the database, but I'm fairly sure I can do that part on my own. It's the recursive function that's killing me.

Anyone able to point me in a good starting place or help me out? Any help is MUCH appreciated!

To avoid problems of terminology: I wrote a small program:

  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

and that's its output:

  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

If that looks like a seed to a solution of your problem, just say so and I will post the code for the cOdoDemo class.

Code for 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

Some hints/remarks: Think of an odometer that genererates all combinations for 6 (7?) places/digits in numerical order. Now imagine an odometer that lets you specify a sequence/ordered set of 'digits'/words/items for each place/slot. This specification is done by aaItems.

This is the code for cPad, used in .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

Sorry for the missing documentation. I'll try to answer all your question.

Generic solution in 20 lines!

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

If you only have to worry about those four fixed categories, just use nested for loops.

If the number of categories may change, a recursive solution is easy to define:

  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)

Call with index=0 and permutation empty for best results (sources is an array of arrays containing your categories).

Example:

  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.