RosettaCodeData/Task/Dijkstras-algorithm/M2000-Interpreter/dijkstras-algorithm.m2000

88 lines
2.0 KiB
Plaintext

Module Dijkstra`s_algorithm {
const max_number=1.E+306
GetArr=lambda (n, val)->{
dim d(n)=val
=d()
}
term=("",0)
Edges=(("a", ("b",7),("c",9),("f",14)),("b",("c",10),("d",15)),("c",("d",11),("f",2)),("d",("e",6)),("e",("f", 9)),("f",term))
Document Doc$="Graph:"+{
}
ShowGraph()
Doc$="Paths"+{
}
Print "Paths"
For from_here=0 to 5
pa=GetArr(len(Edges), -1)
d=GetArr(len(Edges), max_number)
Inventory S=1,2,3,4,5,6
return d, from_here:=0
RemoveMin=Lambda S, d, max_number-> {
ss=each(S)
min=max_number
p=0
while ss
val=d#val(eval(S,ss^)-1)
if min>val then let min=val : p=ss^
end while
=s(p!) ' use p as index not key
Delete S, eval(s,p)
}
Show_Distance_and_Path$=lambda$ d, pa, from_here, max_number (n) -> {
ret1$=chr$(from_here+asc("a"))+" to "+chr$(n+asc("a"))
if d#val(n) =max_number then =ret1$+ " No Path" :exit
let ret$="", mm=n, m=n
repeat
n=m
ret$+=chr$(asc("a")+n)
m=pa#val(n)
until from_here=n
=ret1$+format$("{0::-4} {1}",d#val(mm),strrev$(ret$))
}
while len(s)>0
u=RemoveMin()
rem Print u, chr$(u-1+asc("a"))
Relaxed()
end while
For i=0 to len(d)-1
line$=Show_Distance_and_Path$(i)
Print line$
doc$=line$+{
}
next
next
Clipboard Doc$
End
Sub Relaxed()
local vertex=Edges#val(u-1), i
local e=Len(vertex)-1, edge=(,), val
for i=1 to e
edge=vertex#val(i)
if edge#val$(0)<>"" then
val=Asc(edge#val$(0))-Asc("a")
if d#val(val)>edge#val(1)+d#val(u-1) then return d, val:=edge#val(1)+d#val(u-1) : Return Pa, val:=u-1
end if
next
end sub
Sub ShowGraph()
Print "Graph"
local i
for i=1 to len(Edges)
show_edges(i)
next
end sub
Sub show_edges(n)
n--
local vertex=Edges#val(n), line$
local e=each(vertex 2 to end), v2=(,)
While e
v2=array(e)
line$=vertex#val$(0)+if$(v2#val$(0)<>""->"->"+v2#val$(0)+format$(" {0::-2}",v2#val(1)),"")
Print line$
Doc$=line$+{
}
end while
end sub
}
Dijkstra`s_algorithm