0

我有一个映射程序，可以将版本化的语言代码从一个版本映射到另一个版本。该程序使用组合代码正确映射代码，但需要注意一个警告。我已经解析了映射文件，并且已经足够远地使用每个节点的选项来构造数组并计算给定数据的可能性数量。

考虑以下数据：

CodeA translates to: Array(1,1) = "CodeB|CodeC|CodeD|"
                     Array(1,2) = "CodeE|"
                     Array(1,3) = "CodeF|CodeG|"

这意味着 CodeA 转换为(CodeB or CodeC or CodeD) with codeE with (CodeF or CodeG)

代码首先计算可能性的数量（上面有 6 个），然后使数组变暗以适应结果字符串。我需要存储的字符串是映射的所有组合，即：

CodeB with CodeE with CodeF
CodeB with CodeE with CodeG
CodeC with CodeE with CodeF
CodeC with CodeE with CodeG
CodeD with CodeE with CodeF
CodeD with CodeE with CodeG

该代码需要使用具有多个映射的所有不同大小的数组。上面的例子很简单，但它可以变得更复杂，像这样：

CodeA translates to: Array(1,1) = "CodeB|CodeC|CodeD|"
                     Array(1,2) = "CodeE|"
                     Array(1,3) = "CodeF|CodeG|"
                     Array(2,1) = "CodeH|"
                     Array(2,2) = "CodeI|CodeJ|"
                     Array(2,3) = "CodeK|CodeL|CodeM|CodeN|"
                     Array(2,4) = "CodeO|"
                     Array(3,1) = "CodeQ|"
                     Array(3,2) = "CodeR|CodeS|"

这意味着 CodeA 转换为：((CodeB or CodeC or CodeD) with CodeE with (CodeF or CodeG))or (CodeH with (CodeI or CodeJ) with (CodeK or CodeL or CodeM or CodeN) with CodeO)or (CodeQ with (CodeR or CodeS))--- 96 个组合

该程序已经知道最大的第一个下标，因此代码如下所示：

for i = 1 to maxSubOne
    GET_COMBINATIONS(Array(i))
next i

有什么建议么？

4

1 回答 1

1

我认为这行得通...

编辑：更新Combine()以使其对提交的集合中包含的数组的基础不敏感，并将 Do-Loop 更改为 For-Next

Sub Tester()

    Dim arr(1 To 3, 1 To 4)
    arr(1, 1) = "CodeB|CodeC|CodeD|"
    arr(1, 2) = "CodeE|"
    arr(1, 3) = "CodeF|CodeG|"
    arr(2, 1) = "CodeH|"
    arr(2, 2) = "CodeI|CodeJ|"
    arr(2, 3) = "CodeK|CodeL|CodeM|CodeN|"
    arr(2, 4) = "CodeO|"
    arr(3, 1) = "CodeQ|"
    arr(3, 2) = "CodeR|CodeS|"

    DoCombinations arr

End Sub

Sub DoCombinations(arr As Variant)

Dim r As Long, c As Long
Dim nc As Long, nr As Long
Dim a
Dim col As Collection, col2 As New Collection
Dim final() As String, tmp

nr = UBound(arr, 1)
nc = UBound(arr, 2)

For r = 1 To nr 'loop through first dimension
    Set col = New Collection
    For c = 1 To nc
        tmp = arr(r, c)
        If Len(tmp) > 0 Then
            'remove any trailing "|"
            If Right(tmp, 1) = "|" Then
                tmp = Left(tmp, Len(tmp) - 1)
            End If
            col.Add Split(tmp, "|")
        End If
    Next c
    col2.Add Combine(col, "-")
Next r

'intermediate arrays
For Each a In col2
    Debug.Print "-----Intermediate-----"
    Debug.Print Join(a, vbLf)
Next a

final = Combine(col2 "-") 'final combination...
Debug.Print "-----Final-----"
Debug.Print Join(final, vbCrLf)

End Sub    

'create combinations from a collection of string arrays
Function Combine(col As Collection, SEP As String) As String()

    Dim rv() As String
    Dim pos() As Long, lengths() As Long, lbs() As Long, ubs() As Long
    Dim t As Long, i As Long, n As Long, ub As Long
    Dim numIn As Long, s As String, r As Long

    numIn = col.Count
    ReDim pos(1 To numIn)
    ReDim lbs(1 To numIn)
    ReDim ubs(1 To numIn)
    ReDim lengths(1 To numIn)
    t = 0
    For i = 1 To numIn  'calculate # of combinations, and cache bounds/lengths
        lbs(i) = LBound(col(i))
        ubs(i) = UBound(col(i))
        lengths(i) = (ubs(i) - lbs(i)) + 1
        pos(i) = lbs(i)
        t = IIf(t = 0, lengths(i), t * lengths(i))
    Next i
    ReDim rv(0 To t - 1) 'resize destination array

    For n = 0 To (t - 1)
        s = ""
        For i = 1 To numIn
            s = s & IIf(Len(s) > 0, SEP, "") & col(i)(pos(i)) 'build the string
        Next i
        rv(n) = s

        For i = numIn To 1 Step -1
            If pos(i) <> ubs(i) Then   'Not done all of this array yet...
                pos(i) = pos(i) + 1    'Increment array index
                For r = i + 1 To numIn 'Reset all the indexes
                    pos(r) = lbs(r)    '   of the later arrays
                Next r
                Exit For
            End If
        Next i
    Next n

    Combine = rv
End Function
于 2013-07-18T23:35:26.630 回答