Also test the derivation variant of astar
parent
604ccb0a3a
commit
db106486f1
|
@ -4,8 +4,6 @@ USING: arrays assocs astar combinators hashtables kernel literals math math.func
|
||||||
math.vectors sequences sorting splitting strings tools.test ;
|
math.vectors sequences sorting splitting strings tools.test ;
|
||||||
IN: astar.tests
|
IN: astar.tests
|
||||||
|
|
||||||
<<
|
|
||||||
|
|
||||||
! Use a 10x9 maze (see below) to try to go from s to e, f or g.
|
! Use a 10x9 maze (see below) to try to go from s to e, f or g.
|
||||||
! X means that a position is unreachable.
|
! X means that a position is unreachable.
|
||||||
! The costs model is:
|
! The costs model is:
|
||||||
|
@ -13,6 +11,10 @@ IN: astar.tests
|
||||||
! - going down costs 1 point
|
! - going down costs 1 point
|
||||||
! - going left or right costs 2 points
|
! - going left or right costs 2 points
|
||||||
|
|
||||||
|
<<
|
||||||
|
|
||||||
|
TUPLE: maze < astar ;
|
||||||
|
|
||||||
: reachable? ( pos -- ? )
|
: reachable? ( pos -- ? )
|
||||||
first2 [ 2 * 5 + ] [ 2 + ] bi* $[
|
first2 [ 2 * 5 + ] [ 2 + ] bi* $[
|
||||||
" 0 1 2 3 4 5 6 7 8 9
|
" 0 1 2 3 4 5 6 7 8 9
|
||||||
|
@ -28,20 +30,21 @@ IN: astar.tests
|
||||||
8 X X X X X X X X X X"
|
8 X X X X X X X X X X"
|
||||||
"\n" split ] nth nth CHAR: X = not ;
|
"\n" split ] nth nth CHAR: X = not ;
|
||||||
|
|
||||||
: neighbours ( pos -- neighbours )
|
M: maze neighbours
|
||||||
first2
|
drop
|
||||||
{ [ 1 + 2array ] [ 1 - 2array ] [ [ 1 + ] dip 2array ] [ [ 1 - ] dip 2array ] } 2cleave
|
first2
|
||||||
4array
|
{ [ 1 + 2array ] [ 1 - 2array ] [ [ 1 + ] dip 2array ] [ [ 1 - ] dip 2array ] } 2cleave
|
||||||
[ reachable? ] filter ;
|
4array
|
||||||
|
[ reachable? ] filter ;
|
||||||
|
|
||||||
: heuristic ( from to -- cost )
|
M: maze heuristic
|
||||||
v- [ abs ] [ + ] map-reduce ;
|
drop v- [ abs ] [ + ] map-reduce ;
|
||||||
|
|
||||||
: cost ( from to -- cost )
|
M: maze cost
|
||||||
2dup [ first ] bi@ = [ [ second ] bi@ > 1 5 ? ] [ 2drop 2 ] if ;
|
drop 2dup [ first ] bi@ = [ [ second ] bi@ > 1 5 ? ] [ 2drop 2 ] if ;
|
||||||
|
|
||||||
: test1 ( to -- path considered )
|
: test1 ( to -- path considered )
|
||||||
{ 1 1 } swap [ neighbours ] [ cost ] [ heuristic ] <astar> [ find-path ] [ considered ] bi ;
|
{ 1 1 } swap maze new [ find-path ] [ considered ] bi ;
|
||||||
>>
|
>>
|
||||||
|
|
||||||
! Existing path from s to f
|
! Existing path from s to f
|
||||||
|
@ -73,8 +76,6 @@ IN: astar.tests
|
||||||
! Non-existing path from s to g -- all positions must have been considered
|
! Non-existing path from s to g -- all positions must have been considered
|
||||||
[ f 26 ] [ { 1 7 } test1 length ] unit-test
|
[ f 26 ] [ { 1 7 } test1 length ] unit-test
|
||||||
|
|
||||||
<<
|
|
||||||
|
|
||||||
! Look for a path between A and C. The best path is A --> D --> C. C will be placed
|
! Look for a path between A and C. The best path is A --> D --> C. C will be placed
|
||||||
! in the open set early because B will be examined first. This checks that the evaluation
|
! in the open set early because B will be examined first. This checks that the evaluation
|
||||||
! of C is correctly replaced in the open set.
|
! of C is correctly replaced in the open set.
|
||||||
|
@ -92,6 +93,10 @@ IN: astar.tests
|
||||||
! A ---> D ---------> E ---> F
|
! A ---> D ---------> E ---> F
|
||||||
! (2) (1) (1)
|
! (2) (1) (1)
|
||||||
|
|
||||||
|
<<
|
||||||
|
|
||||||
|
! In this version, we will use the quotations-aware version through <astar>.
|
||||||
|
|
||||||
: n ( pos -- neighbours )
|
: n ( pos -- neighbours )
|
||||||
$[ { "ABD" "BC" "C" "DCE" "ECF" } [ unclip swap 2array ] map >hashtable ] at ;
|
$[ { "ABD" "BC" "C" "DCE" "ECF" } [ unclip swap 2array ] map >hashtable ] at ;
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue