Dijkstra's algorithm: Difference between revisions
m
→{{header|EasyLang}}
m (→{{header|Tailspin}}: Add necessary type info) |
|||
| (10 intermediate revisions by 6 users not shown) | |||
Line 3,302:
5: distance = 11, 0 --> 2 --> 5
</pre>
=={{header|EasyLang}}==
<syntaxhighlight>
global con[][] n .
proc read . .
repeat
s$ = input
until s$ = ""
a = (strcode substr s$ 1 1) - 96
b = (strcode substr s$ 3 1) - 96
d = number substr s$ 5 9
if a > len con[][]
len con[][] a
.
con[a][] &= b
con[a][] &= d
.
con[][] &= [ ]
n = len con[][]
.
read
#
len cost[] n
len prev[] n
#
proc dijkstra . .
for i = 2 to len cost[]
cost[i] = 1 / 0
.
len todo[] n
todo[1] = 1
repeat
min = 1 / 0
a = 0
for i to len todo[]
if todo[i] = 1 and cost[i] < min
min = cost[i]
a = i
.
.
until a = 0
todo[a] = 0
for i = 1 step 2 to len con[a][] - 1
b = con[a][i]
c = con[a][i + 1]
if cost[a] + c < cost[b]
cost[b] = cost[a] + c
prev[b] = a
todo[b] = 1
.
.
.
.
dijkstra
#
func$ gpath nd$ .
nd = strcode nd$ - 96
while nd <> 1
s$ = " -> " & strchar (nd + 96) & s$
nd = prev[nd]
.
return "a" & s$
.
print gpath "e"
print gpath "f"
#
input_data
a b 7
a c 9
a f 14
b c 10
b d 15
c d 11
c f 2
d e 6
e f 9
</syntaxhighlight>
=={{header|Emacs Lisp}}==
<syntaxhighlight lang="lisp">
(defvar path-list '((a b 7)
(a c 9)
(a
(
(
(defun calculate-shortest-path (path-list)
(let (shortest-path)
(dolist (path path-list)
(add-to-list 'shortest-path (list (nth 0 path)
(nth 1 path)
nil
(nth 2 path))
't))
(dolist (path path-list)
(dolist (short-path shortest-path)
(when (equal (nth 0 path) (nth 1 short-path))
(let ((test-path (list (nth 0 short-path)
(nth 1 path)
(nth 0 path)
(+ (nth 2 path) (nth 3 short-path))))
is-path-found)
(dolist (short-path1 shortest-path)
(when (equal (seq-take test-path 2)
(seq-take short-path1 2))
(setq is-path-found 't)
(when (> (nth 3 short-path1) (nth 3 test-path))
(setcdr (cdr short-path1) (cddr test-path)))))
(when (not is-path-found)
(add-to-list 'shortest-path test-path 't))))))
shortest-path))
(add-to-list 'point-list to)
(setq matched-path
(seq-find (lambda (path) (equal (list from to) (seq-take path 2)))
shortest-path-list))
(add-to-list 'point-list (nth 2 matched-path))
(setq to (nth 2 matched-path))
(setq matched-path
(seq-find (lambda (path) (equal (list from to) (seq-take path 2)))
shortest-path-list)))
(if matched-path
(progn
(list 'route point-list 'distance distance))
nil)))
(format "%S" (find-shortest-route 'a 'e path-list))
</syntaxhighlight>
Line 3,404 ⟶ 3,451:
<pre>
(route (a c d e) distance 26)
</pre>
Line 3,519 ⟶ 3,559:
Some [A; C; D; E]
Some [A; C; F]
</pre>
=={{header|Forth}}==
{{trans|Commodore BASIC}}
<syntaxhighlight lang="FORTH">\ utility routine to increment a variable
: 1+! 1 swap +! ;
\ edge data
variable edge-count
0 edge-count !
create edges
'a , 'b , 7 , edge-count 1+!
'a , 'c , 9 , edge-count 1+!
'a , 'f , 14 , edge-count 1+!
'b , 'c , 10 , edge-count 1+!
'b , 'd , 15 , edge-count 1+!
'c , 'd , 11 , edge-count 1+!
'c , 'f , 2 , edge-count 1+!
'd , 'e , 6 , edge-count 1+!
'e , 'f , 9 , edge-count 1+!
\ with accessors
: edge 3 * cells edges + ;
: edge-from edge ;
: edge-to edge 1 cells + ;
: edge-weight edge 2 cells + ;
\ vertex data and acccessor
create vertex-names edge-count @ 2 * cells allot
: vertex-name cells vertex-names + ;
variable vertex-count
0 vertex-count !
\ routine to look up a vertex by name
: find-vertex
-1 swap
vertex-count @ 0 ?do
dup i vertex-name @ = if swap drop i swap leave then
loop
drop
;
\ routine to add a new vertex name if not found
: add-vertex
dup find-vertex dup -1 = if
swap vertex-count @ vertex-name !
vertex-count dup @ swap 1+!
swap drop
else
swap
drop
then
;
\ routine to add vertices to name table and replace names with indices in edges
: get-vertices
edge-count @ 0 ?do
i edge-from @ add-vertex i edge-from !
i edge-to @ add-vertex i edge-to !
loop
;
\ call it
get-vertices
\ variables to hold state during algorithm run
create been-visited
vertex-count @ cells allot
: visited cells been-visited + ;
create prior-vertices
vertex-count @ cells allot
: prior-vertex cells prior-vertices + ;
create distances
vertex-count @ cells allot
: distance cells distances + ;
variable origin
variable current-vertex
variable neighbor
variable current-distance
variable tentative
variable closest-vertex
variable minimum-distance
variable vertex
\ call with origin vertex name on stack
: dijkstra ( origin -- )
find-vertex origin !
been-visited vertex-count @ cells 0 fill
prior-vertices vertex-count @ cells -1 fill
distances vertex-count @ cells -1 fill
0 origin @ distance ! \ distance to origin is 0
origin @ current-vertex ! \ current vertex is the origin
begin
edge-count @ 0 ?do
i edge-from @ current-vertex @ = if \ if edge is from current
i edge-to @ neighbor ! \ neighbor vertex
neighbor @ distance @ current-distance !
current-vertex @ distance @ i edge-weight @ + tentative !
current-distance @ -1 = tentative @ current-distance @ < or if
tentative @ neighbor @ distance !
current-vertex @ neighbor @ prior-vertex !
then
else
then
loop
1 current-vertex @ visited ! \ current vertex has now been visited
-1 closest-vertex !
vertex-count @ 0 ?do
i visited @ 0= if
-1 minimum-distance !
closest-vertex @ dup -1 <> if
distance @ minimum-distance !
else
drop
then
i distance @ -1 <>
minimum-distance @ -1 = i distance @ minimum-distance @ < or
and if
i closest-vertex !
then
then
loop
closest-vertex @ current-vertex !
current-vertex @ -1 = until
cr
." Shortest path to each vertex from " origin @ vertex-name @ emit ': emit cr
vertex-count @ 0 ?do
i origin @ <> if
i vertex-name @ emit ." : " i distance @ dup
-1 = if
drop
." ∞ (unreachable)"
else
.
'( emit
i vertex !
begin
vertex @ vertex-name @ emit
vertex @ origin @ <> while
." ←"
vertex @ prior-vertex @ vertex !
repeat
') emit
then
cr
then
loop
;</syntaxhighlight>
{{Out}}
<pre>'a dijkstra
Shortest path to each vertex from a:
b: 7 (b←a)
c: 9 (c←a)
f: 11 (f←c←a)
d: 20 (d←c←a)
e: 26 (e←d←c←a)
ok
'b dijkstra
Shortest path to each vertex from b:
a: ∞ (unreachable)
c: 10 (c←b)
f: 12 (f←c←b)
d: 15 (d←b)
e: 21 (e←d←b)
ok</pre>
=={{header|Fortran}}==
<syntaxhighlight lang="FORTRAN">
program main
! Demo of Dijkstra's algorithm.
! Translation of Rosetta code Pascal version
implicit none
!
! PARAMETER definitions
!
integer , parameter :: nr_nodes = 6 , start_index = 0
!
! Derived Type definitions
!
enum , bind(c)
enumerator :: SetA , SetB , SetC
end enum
!
type tnode
integer :: nodeset
integer :: previndex ! previous node in path leading to this node
integer :: pathlength ! total length of path to this node
end type tnode
!
! Local variable declarations
!
integer :: branchlength , j , j_min , k , lasttoseta , minlength , nrinseta , triallength
character(5) :: holder
integer , dimension(0:nr_nodes - 1 , 0:nr_nodes - 1) :: lengths
character(132) :: lineout
type (tnode) , dimension(0:nr_nodes - 1) :: nodes
! character(2) , dimension(0:nr_nodes - 1) :: node_names
character(15),dimension(0:nr_nodes-1) :: node_names
! Correct values
!Shortest paths from node a:
! b: length 7, a -> b
! c: length 9, a -> c
! d: length 20, a -> c -> d
! e: length 26, a -> c -> d -> e
! f: length 11, a -> c -> f
!
nodes%nodeset = 0
nodes%previndex = 0
nodes%pathlength = 0
node_names = (/'a' , 'b' , 'c' , 'd' , 'e' , 'f'/)
!
! lengths[j,k] = length of branch j -> k, or -1 if no such branch exists.
lengths(0 , :) = (/ - 1 , 7 , 9 , -1 , -1 , 14/)
lengths(1 , :) = (/ - 1 , -1 , 10 , 15 , -1 , -1/)
lengths(2 , :) = (/ - 1 , -1 , -1 , 11 , -1 , 2/)
lengths(3 , :) = (/ - 1 , -1 , -1 , -1 , 6 , -1/)
lengths(4 , :) = (/ - 1 , -1 , -1 , -1 , -1 , 9/)
lengths(5 , :) = (/ - 1 , -1 , -1 , -1 , -1 , -1/)
do j = 0 , nr_nodes - 1
nodes(j)%nodeset = SetC
enddo
! Begin by transferring the start node to set A
nodes(start_index)%nodeset = SetA
nodes(start_index)%pathlength = 0
nrinseta = 1
lasttoseta = start_index
! Transfer nodes to set A one at a time, until all have been transferred
do while (nrinseta<nr_nodes)
! Step 1: Work through branches leading from the node that was most recently
! transferred to set A, and deal with end nodes in set B or set C.
do j = 0 , nr_nodes - 1
branchlength = lengths(lasttoseta , j)
if (branchlength>=0) then
! If the end node is in set B, and the path to the end node via lastToSetA
! is shorter than the existing path, then update the path.
if (nodes(j)%nodeset==SetB) then
triallength = nodes(lasttoseta)%pathlength + branchlength
if (triallength<nodes(j)%pathlength) then
nodes(j)%previndex = lasttoseta
nodes(j)%pathlength = triallength
endif
! If the end node is in set C, transfer it to set B.
elseif (nodes(j)%nodeset==SetC) then
nodes(j)%nodeset = SetB
nodes(j)%previndex = lasttoseta
nodes(j)%pathlength = nodes(lasttoseta)%pathlength + branchlength
endif
endif
enddo
! Step 2: Find the node in set B with the smallest path length,
! and transfer that node to set A.
! (Note that set B cannot be empty at this point.)
minlength = -1
j_min = -1
do j = 0 , nr_nodes - 1
if (nodes(j)%nodeset==SetB) then
if ((j_min== - 1).or.(nodes(j)%pathlength<minlength)) then
j_min = j
minlength = nodes(j)%pathlength
endif
endif
enddo
nodes(j_min)%nodeset = SetA
nrinseta = nrinseta + 1
lasttoseta = j_min
enddo
print* , 'Shortest paths from node ',trim(node_names(start_index))
do j = 0 , nr_nodes - 1
if (j/=start_index) then
k = j
lineout = node_names(k)
pete_loop: do
k = nodes(k)%previndex
lineout = trim(node_names(k)) // ' -> ' // trim(lineout)
if (k==start_index) exit pete_loop
enddo pete_loop
write (holder , '(i0)') nodes(j)%pathlength
lineout = trim(adjustl(node_names(j))) // ': length ' // trim(adjustl(holder)) // ', ' // trim(lineout)
print * , lineout
endif
enddo
stop
end program main
</syntaxhighlight>
{{out}}
<pre>
Shortest paths from node a
b: length 7, a -> b
c: length 9, a -> c
d: length 20, a -> c -> d
e: length 26, a -> c -> d -> e
f: length 11, a -> c -> f
</pre>
Line 4,210 ⟶ 4,564:
NB. verbs and adverb
parse_table=: ;:@:(LF&= [;._2 -.&CR)
mp=:
min=: <./ NB. minimum
Index=: (i.`)(`:6) NB. Index adverb
Line 7,261 ⟶ 7,615:
{{libheader|Wren-sort}}
{{libheader|Wren-set}}
<syntaxhighlight lang="
import "./trait" for Comparable
import "./sort" for Cmp, Sort
import "./set" for Set
var Edge = Tuple.create("Edge", ["v1", "v2", "dist"])
| |||