steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

path-finding: add Dijkstra algorithm 

Dijkstra algorithm is a particular case of the A* algorithm with
the heuristic being set to 0.
db4
Samuel Tardieu 2010-11-11 10:59:05 +01:00 committed by Slava Pestov
parent c4a83d2d0b
commit 6994e6c8ee
3 changed files with 38 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
extra/path-finding/path-finding-docs.factor
View File

@ -3,7 +3,7 @@
USING: help.markup help.syntax ; USING: help.markup help.syntax ;
IN: path-finding IN: path-finding
{ <astar> <bfs> } related-words { <astar> <bfs> <dijkstra> } related-words
HELP: astar HELP: astar
{ $description "This tuple must be subclassed and its method " { $link cost } ", " { $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." "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 HELP: find-path
{ $values { $values
{ "start" "a node" } { "start" "a node" }

18
extra/path-finding/path-finding-tests.factor
View File

@ -120,3 +120,21 @@ MEMO: routes ( -- hash ) $[ { "ABD" "BC" "C" "DCE" "ECF" } [ unclip swap 2array
[ f ] [ "FA" first2 routes <bfs> find-path ] unit-test [ f ] [ "FA" first2 routes <bfs> find-path ] unit-test
[ "DC" ] [ "DC" first2 routes <bfs> find-path >string ] 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

8
extra/path-finding/path-finding.factor
View File

@ -74,6 +74,11 @@ M: bfs cost 3drop 1 ;
M: bfs heuristic 3drop 0 ; M: bfs heuristic 3drop 0 ;
M: bfs neighbours neighbours>> at ; 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> PRIVATE>
: find-path ( start target astar -- path/f ) : find-path ( start target astar -- path/f )
@ -87,3 +92,6 @@ PRIVATE>
: <bfs> ( neighbours -- astar ) : <bfs> ( neighbours -- astar )
[ bfs new ] dip >>neighbours ; [ bfs new ] dip >>neighbours ;
: <dijkstra> ( costs -- astar )
[ dijkstra new ] dip >>costs ;