【发布时间】：2020-03-23 12:45:53
【问题描述】：
目标
在将递归解决方案转换为迭代解决方案时，我正在尝试创建一组 UDT（状态），如下所示。
我的尝试和问题
由于集合中不允许 UDT，堆栈的集合实现不起作用。
由于大约 10 倍的性能时间（提高性能是通过堆栈在迭代解决方案中实现的唯一目标），因此无法将 UDT 实现为类。
我无法在 VBA 中找到本机堆栈对象。
问题
有没有比将 UDT 实现为类的计算成本更低的方法将 UDT 添加到堆栈中？
仅供参考
解决方案是 O(n!((n-1)/2)!)，我的目标是在
代码概览
Public Type state
items() As item2
path As String
End Type
Public Type item2
b As Integer
g As Integer
n As String
End Type
Sub fuse3(initialState As state)
Dim stack As collection
Dim top As state
Dim bestResult As result2
stack.Add initialState
While stack.Count > 0
top = stack.item(stack.Count) '{ This is a pop
stack.Remove (stack.Count) '{
...
...
Wend
End Sub
完整代码
Option Explicit
Option Base 1
Dim paths_explored As Double
Public Type state
items() As item2
path As String
End Type
Public Type item2
b As Integer
g As Integer
n As String
End Type
Public Type result2
v As Integer
p As String
End Type
'Recursive
Sub Fuser3()
Dim secs1, secs2 As Single
secs1 = Timer()
Dim markedABase As Boolean
markedABase = True
'note, if gem value is 1337 this means it was marked as the base and should not be fused onto others
' and also means that 1337 should be subtracted from the final answer
'
'input data
Dim item1 As item2
item1.b = 100
item1.g = 1337
item1.n = "1"
Dim item2 As item2
item2.b = 100
item2.g = 64
item2.n = "2"
Dim item3 As item2
item3.b = 120
item3.g = 64
item3.n = "3"
Dim item4 As item2
item4.b = 120
item4.g = 64
item4.n = "4"
Dim item5 As item2
item5.b = 100
item5.g = 64
item5.n = "5"
Dim item6 As item2
item6.b = 260
item6.g = 24
item6.n = "6"
Dim item7 As item2
item7.b = 191
item7.g = 30
item7.n = "7"
Dim item8 As item2
item8.b = 197
item8.g = 30
item8.n = "8"
Dim item9 As item2
item9.b = 187
item9.g = 30
item9.n = "9"
Dim inputItems(7) As item2
inputItems(1) = item1
inputItems(2) = item2
inputItems(3) = item3
inputItems(4) = item4
inputItems(5) = item5
inputItems(6) = item6
inputItems(7) = item7
'inputItems(8) = item8
'inputItems(9) = item9
Dim inputPath As String
inputPath = "If you asked Doll, she would would fuse "
paths_explored = 0
'function
Dim initialState As state
initialState.items = inputItems
initialState.path = inputPath
Dim answer As result2
answer = fuse3(initialState)
secs2 = Timer()
If markedABase Then
MsgBox (answer.v - 1337 & " in " & paths_explored & " loops, " & secs2 - secs1 & " seconds " & answer.p)
Else
MsgBox (answer.v & " in " & paths_explored & " loops, " & secs2 - secs1 & " seconds " & answer.p)
End If
End Sub
Function fuse3(initialState As state) As result2
Dim stack As collection
Dim top As state
Dim bestResult As result2
stack.Add initialState
While stack.Count > 0
top = stack.item(stack.Count) '{ This is a pop
stack.Remove (stack.Count) '{
Dim items() As item2
items = top.items
Dim path As String
path = top.path
Select Case UBound(items)
Case 0
'error
Case 1
Dim result As Integer
result = items(1).b + items(1).g
If result > bestResult.v Then
bestResult.v = result
bestResult.p = path
End If
Case Else
Dim i As Integer
Dim j As Integer
Dim k As Integer
For i = 1 To UBound(items)
For j = 1 To UBound(items)
If i = j Then
Else
If items(j).b + items(j).g < items(i).b Or items(j).g = 1337 Then
Else
Dim fPath As String
fPath = path + items(j).n + "-->" + items(i).n + ", "
ReDim newItems(UBound(items) - 1) As item2
'newItems = items
'remove item j by not copying it over
For k = 1 To UBound(items)
If k = i Then
If k < j Then
newItems(k).b = Application.WorksheetFunction.RoundUp((items(i).b + items(j).b + items(j).g) / 2, 0)
newItems(k).g = items(k).g
newItems(k).n = items(k).n
Else
newItems(k - 1).b = Application.WorksheetFunction.RoundUp((items(i).b + items(j).b + items(j).g) / 2, 0)
newItems(k - 1).g = items(k).g
newItems(k - 1).n = items(k).n
End If
Else
If k < j Then
newItems(k).b = items(k).b
newItems(k).g = items(k).g
newItems(k).n = items(k).n
ElseIf k > j Then
newItems(k - 1).b = items(k).b
newItems(k - 1).g = items(k).g
newItems(k - 1).n = items(k).n
End If
End If
Next
Dim newState As state
newState.items = newItems
newState.path = fPath
stack.Add newState
End If
End If
Next
Next
End Select
Wend
End Sub
【问题讨论】：
-
你有一个可行的递归解决方案吗？
-
是的，您认为它是否相关/应该添加到帖子中？
-
我认为您应该将其发布在 CodeReview 上。
-
连接起来的字符串怎么样？
标签： vba recursion optimization collections stack