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

Use sets

release
Samuel Tardieu 2010-03-17 10:50:45 +01:00
parent ffafafd951
commit 14d1da94bb
1 changed files with 5 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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 ;