Add BFS search algorithm

diff --git a/extra/path-finding/path-finding-docs.factor b/extra/path-finding/path-finding-docs.factor
index dd66e4f76a91d69a715938951e8965075c8b6c0b..46f1048ba7983797c037be4cfc76c5c2100b57fd 100644 (file)
--- a/extra/path-finding/path-finding-docs.factor
+++ b/extra/path-finding/path-finding-docs.factor
@@ -3,6 +3,8 @@
 USING: help.markup help.syntax ;
 IN: path-finding
 
+{ <astar> <bfs> } related-words
+
 HELP: astar
 { $description "This tuple must be subclassed and its method " { $link cost } ", "
   { $link heuristic } ", and " { $link neighbours } " must be implemented. "
@@ -53,6 +55,16 @@ HELP: <astar>
   "may not be as efficient as subclassing the " { $link astar } " tuple."
 } ;
 
+HELP: <bfs>
+{ $values
+  { "neighbours" "an assoc" }
+  { "astar" "a astar tuple" }
+}
+{ $description "Build an astar object from the " { $snippet "neighbours" } " assoc. "
+  "When used with " { $link find-path } ", this astar tuple will use the breadth-first search (BFS) "
+  "path finding algorithm which is a particular case of the general A* algorithm."
+} ;
+
 HELP: find-path
 { $values
   { "start" "a node" }
@@ -74,12 +86,12 @@ HELP: considered
   "which have been examined during the A* exploration."
 } ;
 
-ARTICLE: "astar" "A* algorithm"
-"The " { $vocab-link "path-finding" } " vocabulary implements a graph search algorithm for finding the least-cost path from one node to another." $nl
-"The " { $link astar } " tuple may be derived from and its " { $link cost } ", " { $link heuristic } ", and " { $link neighbours } " methods overwritten, or the " { $link <astar> } " word can be used to build such an object from quotations." $nl
+ARTICLE: "path-finding" "Path finding using the A* algorithm"
+"The " { $vocab-link "path-finding" } " vocabulary implements a graph search algorithm for finding the least-cost path from one node to another using the A* algorithm." $nl
+"The " { $link astar } " tuple may be derived from and its " { $link cost } ", " { $link heuristic } ", and " { $link neighbours } " methods overwritten, or the " { $link <astar> } " or " { $link <bfs> } " words can be used to build a new tuple." $nl
 "Make an A* object:"
-{ $subsections <astar> }
+{ $subsections <astar> <bfs> }
 "Find a path between nodes:"
 { $subsections find-path } ;
 
-ABOUT: "astar"
+ABOUT: "path-finding"

diff --git a/extra/path-finding/path-finding-tests.factor b/extra/path-finding/path-finding-tests.factor
index 16614bb165f5b67fdca87dd05d1fbd87b2435adf..11a047cb89684cb0c2430a12d7246266213acc56 100644 (file)
--- a/extra/path-finding/path-finding-tests.factor
+++ b/extra/path-finding/path-finding-tests.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2010 Samuel Tardieu.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays assocs combinators hashtables kernel literals math math.functions
-math.vectors path-finding sequences sorting splitting strings tools.test ;
+math.vectors memoize path-finding sequences sorting splitting strings tools.test ;
 IN: path-finding.tests
 
 ! Use a 10x9 maze (see below) to try to go from s to e, f or g.
@@ -97,8 +97,10 @@ M: maze cost
 
 ! In this version, we will use the quotations-aware version through <astar>.
 
+MEMO: routes ( -- hash ) $[ { "ABD" "BC" "C" "DCE" "ECF" } [ unclip swap 2array ] map >hashtable ] ;
+
 : n ( pos -- neighbours )
-    $[ { "ABD" "BC" "C" "DCE" "ECF" } [ unclip swap 2array ] map >hashtable ] at ;
+    routes at ;
 
 : c ( from to -- cost )
     "" 2sequence H{ { "AB" 1 } { "AD" 2 } { "BC" 5 } { "DC" 2 } { "DE" 1 } { "EC" 2 } { "EF" 1 } } at ;
@@ -112,3 +114,9 @@ M: maze cost
 
 ! No path from D to B -- all nodes reachable from D must have been examined
 [ f "CDEF" ] [ "DB" test2 ] unit-test
+
+! Find a path using BFS. There are no path from F to A, and the path from D to
+! C does not include any other node.
+
+[ f ] [ "FA" first2 routes <bfs> find-path ] unit-test
+[ "DC" ] [ "DC" first2 routes <bfs> find-path >string ] unit-test

diff --git a/extra/path-finding/path-finding.factor b/extra/path-finding/path-finding.factor
index 74e12e1e38e7a47643b70db793b7027589ae9390..318801394025a1e7c8cb2e88d0edea785eaa0435 100644 (file)
--- a/extra/path-finding/path-finding.factor
+++ b/extra/path-finding/path-finding.factor
@@ -69,6 +69,11 @@ M: astar-simple cost cost>> call( n1 n2 -- c ) ;
 M: astar-simple heuristic heuristic>> call( n1 n2 -- c ) ;
 M: astar-simple neighbours neighbours>> call( n -- neighbours ) ;
 
+TUPLE: bfs < astar neighbours ;
+M: bfs cost 3drop 1 ;
+M: bfs heuristic 3drop 0 ;
+M: bfs neighbours neighbours>> at ;
+
 PRIVATE>
 
 : find-path ( start target astar -- path/f )
@@ -79,3 +84,6 @@ PRIVATE>
 
 : considered ( astar -- considered )
     in-closed-set>> members ;
+
+: <bfs> ( neighbours -- astar )
+    [ bfs new ] dip >>neighbours ;