关于vbnet计算最短路径的信息
VB程序,路径问题,求修改
思路可能有点问题:
创新互联从2013年成立,先为共青城等服务建站,共青城等地企业,进行企业商务咨询服务。为共青城企业网站制作PC+手机+微官网三网同步一站式服务解决您的所有建站问题。
看下图:
根据楼主的思路,A到D最短的路径是A-B-C-D,实际上这是最长的路径
最短的路径应该是A-C-D
一个VB自动实现最短路径的程序
最近我也在整这个呢,据说找最短路径的是A*算法,不过我不喜欢看别人的代码(因为看不懂)只看原理,你可以找一下AStar算法方面的资料,原理比较简单,不过实现起来比较麻烦,我用的是VB.NET实现的,我用用它来走迷宫,而且找的是最短路径,经过几天努力,基本实现了(见 ),不过还有很多有待改进的地方。我不是计算机专业的,当然也没学过数据结构,你那两个问题我都搞不懂,不过有一点提示就是A星算法。
用vb.net编写的floyd算法求两点间的最短路径,怎么输出path经过的顶点序列?
用递归调用 Sub Path(ByVal i As Integer, ByVal j As Integer)
Dim k As Integer
Dim x1, y1, x2, y2 As Integer
k = s(i, j)
If k = 0 Then
Exit Sub
End If
Path(i, k)
Path(k, j)
VB 坐标最短路径
做出来了,代码如下,可能有点乱,但我测试可用
Private Function OrderXY(X() As Double, Y() As Double)
Dim i, j, k, m, n, num, temp As Double
Dim NewX() As Double
Dim NewY() As Double
Dim Smin As Double '定义最短总距离
If UBound(X()) UBound(Y()) Then MsgBox "坐标错误": Exit Function '防止数据错误
n = UBound(X())
ReDim p(n) As Long
p(0) = 0: num = 1
For i = 1 To n
p(i) = i 'p()数组依次存储从0到n共n+1个数
num = num * i '计算num,num表示的是n个坐标(除X(0),Y(0)以外)共有n!种排列
Next
ReDim Stance(num - 1) As Double '定义数组存储每种连接方法的总距离
ReDim NewX(n)
ReDim NewY(n)
For i = 0 To n - 1 'Stance(0)是按照原坐标顺序依次连接的总距离
Stance(0) = Stance(0) + Sqr((Y(i + 1) - Y(i)) * (Y(i + 1) - Y(i)) + (X(i + 1) - X(i)) * (X(i + 1) - X(i)))
Next
Smin = Stance(0)
For k = 0 To n
NewX(k) = X(k)
NewY(k) = Y(k)
Next
i = n - 1
'下面对p()数组的n个数(除0以外)进行排列,每产生一种排列方式,坐标数组的数据就对应交换,并计算这一路径的总距离
Do While i 0
If p(i) p(i + 1) Then
For j = n To i + 1 Step -1 '从排列右端开始
If p(i) = p(j) Then Exit For '找出递减子序列
Next
temp = p(i): p(i) = p(j): p(j) = temp '将递减子序列前的数字与序列中比它大的第一个数交换
temp = X(i): X(i) = X(j): X(j) = temp '与之对应的X Y也交换
temp = Y(i): Y(i) = Y(j): Y(j) = temp
For j = n To 1 Step -1 '将这部分排列倒转
i = i + 1
If i = j Then Exit For
temp = p(i): p(i) = p(j): p(j) = temp
temp = X(i): X(i) = X(j): X(j) = temp
temp = Y(i): Y(i) = Y(j): Y(j) = temp
Next
m = m + 1
For k = 0 To n - 1
Stance(m) = Stance(m) + Sqr((Y(k + 1) - Y(k)) * (Y(k + 1) - Y(k)) + (X(k + 1) - X(k)) * (X(k + 1) - X(k)))
Next
If Stance(m) = Smin Then
Smin = Stance(m)
For k = 0 To n
NewX(k) = X(k): NewY(k) = Y(k)
Next
End If
i = n
End If
i = i - 1
Loop
For k = 0 To n
X(k) = NewX(k): Y(k) = NewY(k)
Next '此时的X() Y() 就按照最短路径排列
End Function
用vb.netl编写的floyd算法求两点间的最短路径,怎么输出path经过的顶点序列?
Function Min(x() as integer,y() as integer) as double
dim i,j,k,a
dim m() as double
dim s() as string
dim mins as string
redim m(ubound(x),ubound(x))
redim s(ubound(x),ubound(x))
for i=1 to ubound(x)-1 '从起始点0点到i点的距离
m(i,0)=((x(i)-x(0))^2+(y(i)-y(0))^2)^0.5
s(i,0)="0-" cstr(i)
next
'从起始点开始经过K个点后到达i点的最短距离m(i,k),s为各点的连线如"0-3-2-1-4"
for k=1 to ubound(x)-2
for i=1 to ubound(x)-1
m(i,k)=10^307
for j=1 to ubound(x)-1
if instr(s(j,k-1),cstr(i))=0 then'避免重复走一点
a=((x(i)-x(j))^2+(y(i)-y(j))^2)^0.5
if a+m(j,k-1)m(i,k) then
m(i,k)=a+m(j,k-1)
s(i,k)=s(j,k-1) "-" cstr(i)
endif
end if
next
next
next
'计算经过各点后到达最后一个点的最短距离
min=10^307
for j=1 to ubound(x)-1
a=((x(ubound(x))-x(j))^2+(y(ubound(x))-y(j))^2)^0.5
if a+m(j,ubound(x)-2)min then
min=a+m(j,ubound(x)-2)
mins=s(j,ubound(x)-2) "-" cstr(ubound(x))
end if
next
msgbox "最短距离:" min vbcrlf "最短路径:" mins
End function
private sub Command1_Click
dim x(5) as integer
dim y(5) as integer
dim m as double
x(0)=0
y(0)=0
x(1)=40
y(1)=600
......
x(5)=1000
y(5)=1000
m=min(x,y)
End sub
求一个关于 dijkstra 用vb 编辑的程序 用于计算多个点关于其中某点的最短路径问题
Option Explicit
Private Sub Command1_Click()
Dim a() As Double, bigN As Double, s As String, items As Variant, items1 As Variant
Dim maxNode As Long, i As Long, j As Long
Dim s1$, s2$, s3$, s4$, s5$, s6$, s7$, s8$, s9$
'assume all the data are much smaller than 1E+20
bigN = 1E+20
'following s is the input data for the matrix a(), m will be the above big number
'for bigger problem, the data in matrix a() should be read from a text file
s = "0,3,m,3,m,m,m,m,m;3,0,3,m,2,m,m,m,m;m,2,0,m,m,4,m,m,m;3,m,m,0,3,m,3,m,m;m,2,m,3,0,2,m,3,m;m,m,4,m,2,0,m,m,5;m,m,m,3,m,m,0,4,m;m,m,m,m,3,m,4,0,2;m,m,m,m,m,5,m,2,0"
items = Split(s, ";")
maxNode = UBound(items)
ReDim a(maxNode, maxNode)
For i = 0 To maxNode
items1 = Split(items(i), ",")
For j = 0 To maxNode
If items1(j) = "m" Then
a(i, j) = bigN
Else
a(i, j) = items1(j)
End If
Next j
Next i
Print "The Adjacency Matrix:"
PrintOut a()
Floyd a()
End Sub
Private Sub Floyd(a() As Double)
'All-Pairs Shortest Paths (Floyd's algorithm), coded by btef (please let this line remain)
Dim maxNode As Long, b() As String
Dim ii As Long, i As Long, j As Long
maxNode = UBound(a)
ReDim b(maxNode, maxNode)
For i = 0 To maxNode
For j = 0 To maxNode
If a(i, j) 1E+20 Then
b(i, j) = i "-" j
End If
Next j
Next i
'PrintOut b()
For ii = 0 To maxNode
For i = 0 To maxNode
If i ii Then
For j = 0 To maxNode
If j ii And j i Then
If a(i, ii) + a(ii, j) a(i, j) Then
a(i, j) = a(i, ii) + a(ii, j)
b(i, j) = b(i, ii) Mid(b(ii, j), InStr(b(ii, j), "-"))
End If
End If
Next j
End If
Next i
'PrintOut a()
'PrintOut b()
Next ii
Print "The Shortest Distances:"
PrintOut a()
Print "The Shortest Paths:"
PrintOut b()
End Sub
Private Sub PrintOut(a As Variant)
Dim i As Long, j As Long, maxNode As Long
maxNode = UBound(a)
For i = 0 To maxNode
For j = 0 To maxNode
Print a(i, j),
Next j
Next i
Print String(88, "-")
End Sub
大概是这样
标题名称:关于vbnet计算最短路径的信息
文章转载:http://ybzwz.com/article/dsegcoi.html