level 1
sub main
dim orig,dest,nodeno as integer
Dim label(),s(), f(),dis(),path() As float
dim u,v,i,j,k,lengths,v1,mark,dismin as float
nodeno=24 '节点的个数
ReDim dis(nodeno*nodeno) '路径数组 一维数组
ReDim label(nodeno) '与起始点的距离数组
ReDim s(nodeno) '永久标记数组
ReDim f(nodeno) '前向点数组
ReDim Path(nodeno) '路径数组
update link set toll=0 '让toll全部变成0，而最短路变成1
orig=1 '输入任意的起始点
dest =21 '输入任意的目的点
for i= 1 to nodeno
for j=1 to nodeno
dis((i-1)*nodeno+j)=10^20 '令点与点之间出行时间为无穷大，dis((i-1)*nodeno+j)在二维数组中就是dis(i,j)的意思
next
next
fetch first from link
Do While Not EOT(link)
dis((link.init-1)*nodeno+link.term)=link.FreeFLowTime '提取路段中的出行时间
fetch next from link
loop
for i = 1 to nodeno
Path(i)=0 '初始化最短路径，令所有最短路径数组元素都为0
next
f(orig) = orig
label(orig) = 0
For i = 1 To nodeno
If i <> orig Then
label(i) = 10^20
End If
Next
s(1) = orig '首先令起始点为永久标记点。
u = orig '将起始点作为当前点
lengths = 1 '当前永久标记集合中点的数量
While lengths < nodeno
For i = 1 To nodeno
mark = 0 '用于区别是否是永久标记点
For j = 1 To lengths
If i = s(j) Then
mark = 1
End If
Next
If mark = 0 Then
v = i
If label(v) > (label(u) + dis((u-1)*nodeno+v)) Then
label(v) = (label(u) + dis((u-1)*nodeno+v))
f(v) = u
End If
End If
Next '更新临时标号的最短路径值，更新临时标号的前点
v1 = 0
k = 10^20
For i = 1 To nodeno
mark = 0
For j = 1 To lengths
If i = s(j) Then
mark = 1
End If
Next
If mark = 0 Then
v = i
If k > label(v) Then
k = label(v)
v1 = v '比较各临时标号点与起始点距离值，将距离值最小的作为固定标号点
End If
End If
Next
s(lengths + 1) = v1 's()数组中按先后顺序存储了永久标记点
u = v1 '更新当前固定标号点
lengths = lengths + 1
Wend
dismin = label(dest) '输出最短距离
note label(dest)
Path(1) = dest
i = 1
while Path(i) <> orig
'note path(i)
path(i+1)=f(path(i))
select * from link where (init=path(i+1) and term=path(i)) into newtab
update newtab set toll = 1
i=i+1
wend
select * from link where toll=1 into selection
End sub
2015年09月14日 08点09分
