VB的Dijkstra算法

luoshuishuishang 2015-09-24 06:40:20
本人用VB编了1个Dijkstra算法的最短路径程序,运行出现问题,各位帮忙看看。

Option Explicit
Private cols As Collection
Private beginPoint As String
Private endPoint As String
Private desert() As String
Private source() As String

Private Sub Command1_Click()
ReDim desert(0)
desert(0) = "A"
Cal "D"
End Sub

Private Sub Form_Load()
InitMap ("A")
End Sub
Private Sub InitMap(ByVal begin As String)
Dim points As Point
Dim index1 As Integer
Dim index2 As Integer
Dim index3 As Integer
Dim tempArray(2) As String
Dim find As Boolean
Set cols = New Collection

Set points = New Point
points.sourcePoint = "A"
points.endPoint = "B"
points.PointLength = 1
cols.Add points

Set points = New Point
points.sourcePoint = "A"
points.endPoint = "D"
points.PointLength = 2
cols.Add points

Set points = New Point
points.sourcePoint = "D"
points.endPoint = "E"
points.PointLength = 1
cols.Add points

Set points = New Point
points.sourcePoint = "B"
points.endPoint = "E"
points.PointLength = 4
cols.Add points

Set points = New Point
points.sourcePoint = "B"
points.endPoint = "C"
points.PointLength = 2
cols.Add points

Set points = New Point
points.sourcePoint = "C"
points.endPoint = "E"
points.PointLength = 1
cols.Add points
ReDim source(0)
ReDim desert(0)
desert(0) = begin
'查找出节点
For index1 = 1 To cols.Count
tempArray(0) = cols(index1).sourcePoint
tempArray(1) = cols(index1).endPoint
For index2 = 0 To 1
find = False
If (tempArray(index2) <> begin) Then
For index3 = LBound(source) To UBound(source)
If (tempArray(index2) = source(index3)) Then
find = True
Exit For
End If
Next
If (find = False) Then
If (UBound(source) > 0 Or index2 > 0) Then
ReDim Preserve source(UBound(source) + 1)
End If
source(UBound(source)) = tempArray(index2)
End If
End If
Next
Next

End Sub

Private Sub Cal(ByVal endNode As String)
Dim temp As Collection
Dim index As Long
Dim minlen As Long
Dim tempLen As Long
Dim sourcePoint As String
Dim desertPoint As String
minlen = 0
While (UBound(desert) <> UBound(source))
Set temp = New Collection
GetChildNodes desert(UBound(desert)), temp
minlen = 0
For index = 1 To temp.Count
'计算最短路径
tempLen = FindLen(desert(UBound(desert)), temp(index))
If (minlen = 0) Then
minlen = tempLen
desertPoint = temp(index)
Else
If (minlen > tempLen) Then
desertPoint = temp(index)
End If
End If
Next
If (desertPoint <> "") Then
ReDim Preserve desert(UBound(desert) + 1)
desert(UBound(desert)) = desertPoint
If (desertPoint = endNode) Then
Exit Sub
End If
End If
Wend
End Sub
Private Sub GetChildNodes(ByVal sourcePoint As String, ByRef col As Collection)
Dim index As Integer
For index = 1 To cols.Count
If (cols(index).sourcePoint = sourcePoint) Then
col.Add cols(index).endPoint
End If
Next
End Sub
Private Function FindLen(ByVal sourcePoint As String, ByVal endPoint As String) As Long
Dim index As Long
For index = 1 To cols.Count
If (cols(index).sourcePoint = sourcePoint And cols(index).endPoint = endPoint) Then
FindLen = cols(index).PointLength
Exit For
End If

Next
End Function

...全文
103 2 打赏 收藏 举报
写回复
2 条回复
切换为时间正序
当前发帖距今超过3年,不再开放新的回复
发表回复
红牛工作室 2015-10-03
VB吧已经有人发了一个最短路径的算法了
  • 打赏
  • 举报
回复
赵4老师 2015-09-28
代码功能归根结底不是别人帮自己看或讲解或注释出来的;而是被自己静下心来花足够长的时间和精力亲自动手单步或设断点或对执行到某步获得的中间结果显示或写到日志文件中一步一步分析出来的。 提醒:再牛×的老师也无法代替学生自己领悟和上厕所!
  • 打赏
  • 举报
回复
发帖
VB基础类

7617

社区成员

VB 基础类
社区管理员
  • VB基础类社区
加入社区
帖子事件
创建了帖子
2015-09-24 06:40
社区公告
暂无公告