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

Merge branch 'for-slava' of git://git.rfc1149.net/factor

release
Slava Pestov 2010-03-23 04:34:36 -04:00
parent 1e4e66d6a2 f62d414bd1
commit 0a47b9c0ae
2 changed files with 7 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
extra/astar/astar-docs.factor
View File

@ -62,8 +62,7 @@ HELP: find-path
", or f if no such path exists" } ", or f if no such path exists" }
} }
{ $description "Find a path between " { $snippet "start" } " and " { $snippet "target" } { $description "Find a path between " { $snippet "start" } " and " { $snippet "target" }
" using the A* algorithm. The " { $snippet "astar" } " tuple must have been previously " " using the A* algorithm."
" built using " { $link <astar> } "."
} ; } ;
HELP: considered HELP: considered
@ -77,6 +76,7 @@ HELP: considered
ARTICLE: "astar" "A* algorithm" 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 "astar" } " 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
"Make an A* object:" "Make an A* object:"
{ $subsections <astar> } { $subsections <astar> }
"Find a path between nodes:" "Find a path between nodes:"

10
extra/astar/astar.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2010 Samuel Tardieu. ! Copyright (C) 2010 Samuel Tardieu.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs heaps kernel math sequences sets shuffle ; USING: accessors assocs hash-sets heaps kernel math sequences sets shuffle ;
IN: astar IN: astar
! This implements the A* algorithm. See http://en.wikipedia.org/wiki/A* ! This implements the A* algorithm. See http://en.wikipedia.org/wiki/A*
@ -24,10 +24,10 @@ TUPLE: (astar) astar goal origin in-open-set open-set ;
(add-to-open-set) ; (add-to-open-set) ;
: ?add-to-open-set ( node astar -- ) : ?add-to-open-set ( node astar -- )
2dup astar>> in-closed-set>> key? [ 2drop ] [ add-to-open-set ] if ; 2dup astar>> in-closed-set>> in? [ 2drop ] [ add-to-open-set ] if ;
: move-to-closed-set ( node astar -- ) : move-to-closed-set ( node astar -- )
[ astar>> in-closed-set>> conjoin ] [ in-open-set>> delete-at ] 2bi ; [ astar>> in-closed-set>> adjoin ] [ in-open-set>> delete-at ] 2bi ;
: get-first ( astar -- node ) : get-first ( astar -- node )
[ open-set>> heap-pop drop dup ] [ move-to-closed-set ] bi ; [ open-set>> heap-pop drop dup ] [ move-to-closed-set ] bi ;
@ -58,7 +58,7 @@ TUPLE: (astar) astar goal origin in-open-set open-set ;
: (init) ( from to astar -- ) : (init) ( from to astar -- )
swap >>goal swap >>goal
H{ } clone over astar>> (>>g) H{ } clone over astar>> (>>g)
H{ } clone over astar>> (>>in-closed-set) { } <hash-set> over astar>> (>>in-closed-set)
H{ } clone >>origin H{ } clone >>origin
H{ } clone >>in-open-set H{ } clone >>in-open-set
<min-heap> >>open-set <min-heap> >>open-set
@ -78,4 +78,4 @@ PRIVATE>
astar-simple new swap >>heuristic swap >>cost swap >>neighbours ; astar-simple new swap >>heuristic swap >>cost swap >>neighbours ;
: considered ( astar -- considered ) : considered ( astar -- considered )
in-closed-set>> keys ; in-closed-set>> members ;