From 8e003bf239ddb15fd7ea52e5a17451aaf778c4b1 Mon Sep 17 00:00:00 2001 From: Samuel Tardieu Date: Tue, 23 Mar 2010 09:52:51 +0100 Subject: [PATCH 1/2] Rename astar into path-finding --- extra/{astar => path-finding}/authors.txt | 0 .../path-finding-docs.factor} | 4 ++-- .../path-finding-tests.factor} | 6 +++--- .../astar.factor => path-finding/path-finding.factor} | 2 +- extra/{astar => path-finding}/summary.txt | 0 5 files changed, 6 insertions(+), 6 deletions(-) rename extra/{astar => path-finding}/authors.txt (100%) rename extra/{astar/astar-docs.factor => path-finding/path-finding-docs.factor} (94%) rename extra/{astar/astar-tests.factor => path-finding/path-finding-tests.factor} (94%) rename extra/{astar/astar.factor => path-finding/path-finding.factor} (99%) rename extra/{astar => path-finding}/summary.txt (100%) diff --git a/extra/astar/authors.txt b/extra/path-finding/authors.txt similarity index 100% rename from extra/astar/authors.txt rename to extra/path-finding/authors.txt diff --git a/extra/astar/astar-docs.factor b/extra/path-finding/path-finding-docs.factor similarity index 94% rename from extra/astar/astar-docs.factor rename to extra/path-finding/path-finding-docs.factor index 7c474bdb57..dd66e4f76a 100644 --- a/extra/astar/astar-docs.factor +++ b/extra/path-finding/path-finding-docs.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2010 Samuel Tardieu. ! See http://factorcode.org/license.txt for BSD license. USING: help.markup help.syntax ; -IN: astar +IN: path-finding HELP: astar { $description "This tuple must be subclassed and its method " { $link cost } ", " @@ -75,7 +75,7 @@ HELP: considered } ; ARTICLE: "astar" "A* algorithm" -"The " { $vocab-link "astar" } " vocabulary implements a graph search algorithm for finding the least-cost path from one node to another." $nl +"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 } " word can be used to build such an object from quotations." $nl "Make an A* object:" { $subsections } diff --git a/extra/astar/astar-tests.factor b/extra/path-finding/path-finding-tests.factor similarity index 94% rename from extra/astar/astar-tests.factor rename to extra/path-finding/path-finding-tests.factor index 6e2e2f4f1b..16614bb165 100644 --- a/extra/astar/astar-tests.factor +++ b/extra/path-finding/path-finding-tests.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2010 Samuel Tardieu. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays assocs astar combinators hashtables kernel literals math math.functions -math.vectors sequences sorting splitting strings tools.test ; -IN: astar.tests +USING: arrays assocs combinators hashtables kernel literals math math.functions +math.vectors 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. ! X means that a position is unreachable. diff --git a/extra/astar/astar.factor b/extra/path-finding/path-finding.factor similarity index 99% rename from extra/astar/astar.factor rename to extra/path-finding/path-finding.factor index 85b3108217..74e12e1e38 100644 --- a/extra/astar/astar.factor +++ b/extra/path-finding/path-finding.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2010 Samuel Tardieu. ! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs hash-sets heaps kernel math sequences sets shuffle ; -IN: astar +IN: path-finding ! This implements the A* algorithm. See http://en.wikipedia.org/wiki/A* diff --git a/extra/astar/summary.txt b/extra/path-finding/summary.txt similarity index 100% rename from extra/astar/summary.txt rename to extra/path-finding/summary.txt From b742df468b54ceeb26b94fd20944fbf643680717 Mon Sep 17 00:00:00 2001 From: Samuel Tardieu Date: Tue, 23 Mar 2010 10:24:01 +0100 Subject: [PATCH 2/2] Add BFS search algorithm --- extra/path-finding/path-finding-docs.factor | 22 +++++++++++++++----- extra/path-finding/path-finding-tests.factor | 12 +++++++++-- extra/path-finding/path-finding.factor | 8 +++++++ 3 files changed, 35 insertions(+), 7 deletions(-) diff --git a/extra/path-finding/path-finding-docs.factor b/extra/path-finding/path-finding-docs.factor index dd66e4f76a..46f1048ba7 100644 --- 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 +{ } 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: "may not be as efficient as subclassing the " { $link astar } " tuple." } ; +HELP: +{ $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 } " 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 } " or " { $link } " words can be used to build a new tuple." $nl "Make an A* object:" -{ $subsections } +{ $subsections } "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 16614bb165..11a047cb89 100644 --- 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 . +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 find-path ] unit-test +[ "DC" ] [ "DC" first2 routes find-path >string ] unit-test diff --git a/extra/path-finding/path-finding.factor b/extra/path-finding/path-finding.factor index 74e12e1e38..3188013940 100644 --- 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 ; + +: ( neighbours -- astar ) + [ bfs new ] dip >>neighbours ;