path-finding: add Dijkstra algorithm
Dijkstra algorithm is a particular case of the A* algorithm with the heuristic being set to 0.db4
parent
c4a83d2d0b
commit
6994e6c8ee
|
@ -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" }
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
|
Loading…
Reference in New Issue