Permutation of jagged array

Question

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!

Yimin Rong · Answer 1 · 2013-07-25T14:13:58.797

2

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

edited Jul 25 '13 at 14:13

answered Jan 18 '13 at 22:48

Yimin Rong

1,890
4
31
48

very nice (+1); but Trim() removes only spaces, not tabs. – Ekkehard.Horner Jul 25 '13 at 13:53
Thanks, didn't know that - using tab because it's easier to use as a delimiter when splitting. Fixed. – Yimin Rong Jul 25 '13 at 14:15

Ekkehard.Horner · Accepted Answer · 2011-07-20T18:08:04.810

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.

That's it! The only minor quibble is that #32 and #0 are the same, but I can easily ignore the duplicate. — Bradley Staples, Jul 20 '11 at 17:44
I had to do a few minor edits, but this is just what I needed. Thanks again! — Bradley Staples, Jul 20 '11 at 19:25

Patrick87 · Answer 3 · 2011-07-20T16:25:22.790

0

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.

edited Jul 20 '11 at 16:25

answered Jul 20 '11 at 15:55

Patrick87

27,682
3
38
73

I'm not sure that will work, even once translated to vbscript. As far as I'm aware, I can't get the length of "sources[index]", but rather just the largest number of entries in the 2nd dimension [ ubound(sources,2) ] which may have more entries that I need. Also, vbscript doesn't seem to let me do arrays without a fixed size first, so adding entries to permutation() on the fly would be an issue. I could use redim preserve, but that clones the array each time and would ratchet up the resources used, depending on how much recursion is going on. – Bradley Staples Jul 20 '11 at 16:18
Just scan each sources[index] from left to right, until you get to an empty/null value in your 2-D array. In other words, it's a relatively simple problem to calculate the number of legitimate entries in an array. You don't need to add entries to permutation "on the fly"; the dim of permutations needs to be the number of categories you have (n). See my example above. – Patrick87 Jul 20 '11 at 16:21
Or am I not understanding what you need? If the number of categories can change dynamically at runtime, just recompute the whole shebang every time the number of categories changes. No biggie. You can also calculate the number of elements in each category ahead of time (e.g. right before the computation) if you'd rather. – Patrick87 Jul 20 '11 at 16:29
I think we're on the same page; I'm working on translating what you edited now to see if I can get it working. And yes, the number of categories (and number of 2nd dimension entries per category) vary, depending a product by product basis. – Bradley Staples Jul 20 '11 at 17:20

Permutation of jagged array

3 Answers3

Linked