VB程序，路徑問題，求修改

思路可能有點問題:

創(chuàng)新互聯(lián)從2013年成立，先為共青城等服務(wù)建站，共青城等地企業(yè)，進(jìn)行企業(yè)商務(wù)咨詢服務(wù)。為共青城企業(yè)網(wǎng)站制作PC+手機(jī)+微官網(wǎng)三網(wǎng)同步一站式服務(wù)解決您的所有建站問題。

看下圖:

根據(jù)樓主的思路,A到D最短的路徑是A-B-C-D,實際上這是最長的路徑

最短的路徑應(yīng)該是A-C-D

一個VB自動實現(xiàn)最短路徑的程序

最近我也在整這個呢，據(jù)說找最短路徑的是A*算法,不過我不喜歡看別人的代碼（因為看不懂）只看原理，你可以找一下AStar算法方面的資料，原理比較簡單，不過實現(xiàn)起來比較麻煩，我用的是VB.NET實現(xiàn)的，我用用它來走迷宮，而且找的是最短路徑，經(jīng)過幾天努力，基本實現(xiàn)了（見 ），不過還有很多有待改進(jìn)的地方。我不是計算機(jī)專業(yè)的，當(dāng)然也沒學(xué)過數(shù)據(jù)結(jié)構(gòu)，你那兩個問題我都搞不懂，不過有一點提示就是A星算法。

用vb.net編寫的floyd算法求兩點間的最短路徑，怎么輸出path經(jīng)過的頂點序列？

用遞歸調(diào)用 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 坐標(biāo)最短路徑

做出來了，代碼如下，可能有點亂，但我測試可用

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 "坐標(biāo)錯誤": Exit Function '防止數(shù)據(jù)錯誤

n = UBound(X())

ReDim p(n) As Long

p(0) = 0: num = 1

For i = 1 To n

p(i) = i 'p()數(shù)組依次存儲從0到n共n+1個數(shù)

num = num * i '計算num，num表示的是n個坐標(biāo)（除X(0),Y(0)以外)共有n！種排列

Next

ReDim Stance(num - 1) As Double '定義數(shù)組存儲每種連接方法的總距離

ReDim NewX(n)

ReDim NewY(n)

For i = 0 To n - 1 'Stance（0）是按照原坐標(biāo)順序依次連接的總距離

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()數(shù)組的n個數(shù)（除0以外）進(jìn)行排列，每產(chǎn)生一種排列方式，坐標(biāo)數(shù)組的數(shù)據(jù)就對應(yīng)交換，并計算這一路徑的總距離

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 '將遞減子序列前的數(shù)字與序列中比它大的第一個數(shù)交換

temp = X(i): X(i) = X(j): X(j) = temp '與之對應(yīng)的X Y也交換

temp = Y(i): Y(i) = Y(j): Y(j) = temp

For j = n To 1 Step -1 '將這部分排列倒轉(zhuǎn)

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經(jīng)過的頂點序列？

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

'從起始點開始經(jīng)過K個點后到達(dá)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'避免重復(fù)走一點

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

'計算經(jīng)過各點后到達(dá)最后一個點的最短距離

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

求一個關(guān)于 dijkstra 用vb 編輯的程序 用于計算多個點關(guān)于其中某點的最短路徑問題

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

Print

Next i

Print String(88, "-")

End Sub

大概是這樣