Data update

Task/Dijkstras-algorithm/EasyLang/dijkstras-algorithm.easy

@@ -0,0 +1,73 @@
+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

Task/Dijkstras-algorithm/Forth/dijkstras-algorithm.fth

@@ -0,0 +1,158 @@
+\ 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
+;