path-finding: add Dijkstra algorithm

Dijkstra algorithm is a particular case of the A* algorithm with
the heuristic being set to 0.

diff --git a/extra/path-finding/path-finding-docs.factor b/extra/path-finding/path-finding-docs.factor
index 46f1048ba7983797c037be4cfc76c5c2100b57fd..a41959db69fd27dff77cdc733147024e711cfa40 100644 (file)
--- a/extra/path-finding/path-finding-docs.factor
+++ b/extra/path-finding/path-finding-docs.factor
@@ -3,7 +3,7 @@
 USING: help.markup help.syntax ;
 IN: path-finding
 
-{ <astar> <bfs> } related-words
+{ <astar> <bfs> <dijkstra> } related-words
 
 HELP: astar
 { $description "This tuple must be subclassed and its method " { $link cost } ", "
@@ -65,6 +65,17 @@ HELP: <bfs>
   "path finding algorithm which is a particular case of the general A* algorithm."
 } ;
 
+HELP: <dijkstra>
+{ $values
+  { "costs" "an assoc" }
+}
+{ $description "Build an astar object from the " { $snippet "costs" } " assoc. "
+  "The assoc keys are edges of the graph, while the corresponding values are assocs whose keys are "
+  "the edges that can be reached and whose values are the costs to reach those edges. When used with "
+  { $link find-path } ", this astar tuple will use the Dijkstra path finding algorithm which is "
+  "a particular case of the general A* algorithm."
+} ;
+
 HELP: find-path
 { $values
   { "start" "a node" }

diff --git a/extra/path-finding/path-finding-tests.factor b/extra/path-finding/path-finding-tests.factor
index 11a047cb89684cb0c2430a12d7246266213acc56..0e9b5289b11a3de262f07aaa0a18f3333f42cda1 100644 (file)
--- a/extra/path-finding/path-finding-tests.factor
+++ b/extra/path-finding/path-finding-tests.factor
@@ -120,3 +120,21 @@ MEMO: routes ( -- hash ) $[ { "ABD" "BC" "C" "DCE" "ECF" } [ unclip swap 2array
 
 [ f ] [ "FA" first2 routes <bfs> find-path ] unit-test
 [ "DC" ] [ "DC" first2 routes <bfs> find-path >string ] unit-test
+
+<<
+
+! Build the costs as expected by the dijkstra word.
+
+MEMO: costs ( -- costs )
+    routes keys [ dup dup n [ dup [ c ] dip swap 2array ] with { } map-as >hashtable 2array ] map >hashtable ;
+
+: test3 ( fromto -- path considered )
+    first2 costs <dijkstra> [ find-path ] [ considered natural-sort >string ] bi ;
+
+>>
+
+! Check path from A to C -- all nodes but F must have been examined
+[ "ADC" "ABCDE" ] [ "AC" test3 [ >string ] dip ] unit-test
+
+! No path from D to B -- all nodes reachable from D must have been examined
+[ f "CDEF" ] [ "DB" test3 ] unit-test

diff --git a/extra/path-finding/path-finding.factor b/extra/path-finding/path-finding.factor
index cd63a5c8d52c78cc48301811ac91f579263b717b..4b11616c201c91633e48f66bf0b63e9feb9b17f0 100644 (file)
--- a/extra/path-finding/path-finding.factor
+++ b/extra/path-finding/path-finding.factor
@@ -74,6 +74,11 @@ M: bfs cost 3drop 1 ;
 M: bfs heuristic 3drop 0 ;
 M: bfs neighbours neighbours>> at ;
 
+TUPLE: dijkstra < astar costs ;
+M: dijkstra cost costs>> swapd at at ;
+M: dijkstra heuristic 3drop 0 ;
+M: dijkstra neighbours costs>> at keys ;
+
 PRIVATE>
 
 : find-path ( start target astar -- path/f )
@@ -87,3 +92,6 @@ PRIVATE>
 
 : <bfs> ( neighbours -- astar )
     [ bfs new ] dip >>neighbours ;
+
+: <dijkstra> ( costs -- astar )
+    [ dijkstra new ] dip >>costs ;