我正在尝试在经典的asp(vbscript)中创建一个多维数组的排列,而我却被严重困住了。我已经尝试了我自己的几个函数,并尝试复制几个PHP版本,但我经常最终得到的东西要么进入缓冲区溢出/无限递归,要么我得到的结果更像是组合而不是排列,如果我理解正确的差异。
让我们说这是衬衫。衬衫可以有颜色,尺寸和款式。 (实际系统允许任意数量的“组”选项(想想颜色,大小等)以及每组中的任意数量的选项(每个特定大小,每种特定颜色等)。
例如:
small med lg xl red blue green white pocket no-pocket
请注意,数组的任一维度中的元素数量都是事先未知的;此外,并非所有第二维都具有相同数量的元素。
我需要遍历每个可能包含每行选项的唯一选项。在这个特定的例子中,将有32个选项(因为我需要忽略任何给定选项具有空值的结果,因为asp并不像我期望的那样真正处理锯齿状数组。所以: 小红色口袋 小红色无口袋 小蓝口袋 小蓝色无口袋 等
一旦我完成了这个部分,我就需要将它与数据库中的一些ID集成,但我很确定我可以自己做这部分。这是让我失望的递归功能。
任何人都能指出我在一个良好的起点或帮助我吗?任何帮助都非常感谢!
答案 0 :(得分: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
答案 1 :(得分: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完成。
这是crp的代码,用于.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
抱歉缺少文档。我会尽力回答你的所有问题。
答案 2 :(得分:0)
如果您只需要担心这四个固定类别,只需使用嵌套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.