AI-Pathfinding-AStar-Rectangle
view release on metacpan or search on metacpan
Benchmark/perl-vs-xs.pl view on Meta::CPAN
#!/usr/bin/perl -W
use strict;
use warnings;
use Data::Dumper;
use Time::HiRes qw{ gettimeofday tv_interval };
use Benchmark qw( timethese cmpthese );
use constant WIDTH_X => 64;
use constant WIDTH_Y => 64;
my @map;
use AI::Pathfinding::AStar::Rectangle;
my $m = AI::Pathfinding::AStar::Rectangle->new({ width => WIDTH_X, heigth => WIDTH_Y });
for my $x (0 .. WIDTH_X - 1 )
{
for my $y (0 .. WIDTH_Y - 1 )
{
$map[$x][$y] = 1;
}
}
$map[5][$_] = 0 for 5 .. WIDTH_Y - 5;
$map[WIDTH_X - 5][$_] = 0 for 5 .. WIDTH_Y - 5;
$map[$_][5] = 0 for 5 .. WIDTH_X - 5;
$map[$_][WIDTH_Y - 5] = 0 for 5 .. WIDTH_X - 10;
$map[$_][10] = 0 for 10 .. WIDTH_X - 10;
$map[WIDTH_X - 10][$_] = 0 for 10 .. WIDTH_Y - 5;
$map[10][$_] = 0 for 10 .. WIDTH_Y - 10;
$map[$_][WIDTH_Y - 10] = 0 for 10 .. WIDTH_X - 15;
$map[WIDTH_X - 15][$_] = 0 for 15 .. WIDTH_Y - 10;
$map[$_][15] = 0 for 15 .. WIDTH_X - 15;
for my $x (0 .. WIDTH_X - 1 )
{
for my $y (0 .. WIDTH_Y - 1 )
{
$m->set_passability($x, $y, $map[$x][$y]) ;
}
}
my ( $x_start, $y_start ) = ( WIDTH_X >> 1, WIDTH_Y >> 1 );
my ( $x_end, $y_end ) = ( 0, 0 );
my $t0 = [gettimeofday];
my $path;
my $r = timethese( -1, {Perl=>sub { astar( $x_start, $y_start, $x_end, $y_end ) },
XS=>sub {$m->astar($x_start, $y_start, $x_end, $y_end);}});
cmpthese($r);
die;
for (0..99) {
$path = &astar( $x_start, $y_start, $x_end, $y_end );
}
print "Elapsed: ".tv_interval ( $t0 )."\n";
print "Path length: ".length($path)."\n";
# start end points
$map[ $x_start ][ $y_start ] = 3;
$map[ $x_end ][ $y_end ] = 4;
# draw path
my %vect = (
# x y
1 => [-1, 1, '|/'],
2 => [ 0, 1, '.|'],
3 => [ 1, 1, '|\\'],
4 => [-1, 0, '|<'],
6 => [ 1, 0, '|>'],
7 => [-1,-1, '|\\'],
8 => [ 0,-1, '\'|'],
9 => [ 1,-1, '|/']
);
my ( $x, $y ) = ( $x_start, $y_start );
for ( split //, $path )
{
$map[$x][$y] = '|o';
$x += $vect{$_}->[0];
$y += $vect{$_}->[1];
$map[$x][$y] = '|o';
}
printf "%02d", $_ for 0 .. WIDTH_X - 1;
print "\n";
for my $y ( 0 .. WIDTH_Y - 1 )
{
for my $x ( 0 .. WIDTH_X - 1 )
{
print $map[$x][$y] eq
'1' ? "|_" : (
$map[$x][$y] eq '0' ? "|#" : (
$map[$x][$y] eq '3' ? "|S" : (
$map[$x][$y] eq '4' ? "|E" : $map[$x][$y] ) ) );
}
print "$y\n";
}
sub astar
{
my ( $xs, $ys, $xe, $ye ) = @_;
my %close;
my ( %open, @g, @h, @r, @open_idx );
Benchmark/perl-vs-xs.pl view on Meta::CPAN
for ( "0.-1", "-1.1", "0.1", "1.1", "-1.0", "1.-1", "1.0", "-1.-1" )
{
my ( $xd, $yd ) = split /\./, $_;
my ( $xn, $yn ) = ( $x + $xd, $y + $yd );
next if $xn == WIDTH_X ||
$xn < 0 ||
$yn == WIDTH_Y ||
$yn < 0 ||
$close{$xn}{$yn} ||
$map[$xn][$yn] == 0;
my $ng = $g[$x][$y] + $cost{$_};
if ( $open{$xn}{$yn} )
{
if ( $ng < $g[$xn][$yn] )
{
$r[$xn][$yn] = [$x,$y];
$g[$xn][$yn] = $ng;
}
}
Benchmark/perl-vs-xs.pl view on Meta::CPAN
$x = $x2;
$y = $y2;
$Xend = $x1;
}
else
{
$x = $x1;
$y = $y1;
$Xend = $x2;
};
$obstacle+=!$map[$x][$y];
$pixel+=5;
while ( $x < $Xend )
{
$x++;
if ($d < 0) {$d += $inc1}
else
{
$y++;
$d += $inc2;
};
$obstacle+=!$map[$x][$y];
$pixel += 5;
};
return ( $obstacle << 3 ) + $pixel;
}
sub deb
{
my ( $x, $y, $xn, $yn, $g) = @_;
for my $j ( 0 .. WIDTH_Y - 1 )
{
for my $i ( 0 .. WIDTH_X - 1 )
{
if ( !$map[$i][$j] )
{
print " ##"
}
else
{
if ( $x == $i && $y == $j)
{
print "c";
}
elsif ( $xn == $i && $yn == $j )
0.02 Wed Apr 1 13:54:05 2009
- Some bugfixes
0.16 September 25 23:34 2010
- foreach_xy foreach_xy_set implemented in PP.
- added clone.
- added test for this functions
0.17 September 26 14:34 2010
- begin_x, end_x, last_x, last_y
- added typemap.
- added test 06 for this functions
- remove some duplicated code
0.18 September 26 15:24 2010
- added clone_rect for selection rectangle
0.19 September 28 05:35 2010
- added test for dastar algorithm
- Some doc fix
Changes
Makefile.PL
MANIFEST
ppport.h
README
Rectangle.xs
typemap
lib/AI/Pathfinding/AStar/Rectangle.pm
t/00-AI-Pathfinding-AStar-Rectangle.t
t/01-simple.t
t/02-passability.t
t/03-path-valid.t
t/04-astar.t
t/05-foreach.t
t/06-setstart.t
t/07-dastar.t
--- #YAML:1.0
name: AI-Pathfinding-AStar-Rectangle
version: 0.23
abstract: AStar algorithm on rectangle map
author:
- A.G. Grishaev <gtoly@cpan.org>
license: perl
distribution_type: module
configure_requires:
ExtUtils::MakeMaker: 0
build_requires:
ExtUtils::MakeMaker: 0
requires:
perl: 5.008001
Rectangle.xs view on Meta::CPAN
#define ARRAY_SIZE(x) (sizeof(x)/sizeof(x[0]))
#ifdef _MSC_VER
#define inline
#endif
inline bool is_hash(SV *x){
return SvTYPE(x) == SVt_PVHV;
}
struct map_item{
int g;
int h;
int k;
char prev;
char open;
char closed;
char reserved[1];
};
struct map_like{
unsigned int width;
unsigned int height;
signed int start_x;
signed int start_y;
signed int current_x;
signed int current_y;
unsigned char map[];
};
#ifndef PERL_UNUSED_VAR
# define PERL_UNUSED_VAR(var) if (0) var = var
#endif
#ifndef croak_xs_usage
#ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE
#define PERL_ARGS_ASSERT_CROAK_XS_USAGE assert(cv); assert(params)
Rectangle.xs view on Meta::CPAN
#ifdef XMULTICALL
void
foreach_xy(self, block)
SV * self;
SV * block;
PROTOTYPE: $&
CODE:
{
dVAR; dMULTICALL;
pmap newmap;
int x,y;
GV *agv,*bgv,*gv;
HV *stash;
I32 gimme = G_VOID;
SV **args = &PL_stack_base[ax];
SV *x1, *y1, *value;
AV *argv;
CV *cv;
if (!sv_isobject(self))
croak("Need object");
newmap = (pmap) SvPV_nolen(SvRV(self));
cv = sv_2cv(block, &stash, &gv, 0);
agv = gv_fetchpv("a", TRUE, SVt_PV);
bgv = gv_fetchpv("b", TRUE, SVt_PV);
SAVESPTR(GvSV(agv));
SAVESPTR(GvSV(bgv));
SAVESPTR(GvSV(PL_defgv));
x1 = sv_newmortal();
y1 = sv_newmortal();
SAVESPTR(GvAV(PL_defgv));
Rectangle.xs view on Meta::CPAN
av_push(argv, newSViv(20));
sv_2mortal((SV*) argv);
GvAV(PL_defgv) = argv;
}
value = sv_newmortal();
GvSV(agv) = x1;
GvSV(bgv) = y1;
GvSV(PL_defgv) = value;
PUSH_MULTICALL(cv);
if (items>2){
for(y =newmap->height-1 ; y>=0; --y){
for (x = 0; x < newmap->width; ++x){
sv_setiv(x1,x + newmap->start_x);
sv_setiv(y1,y + newmap->start_y);
sv_setiv(value, newmap->map[get_offset_abs(newmap, x,y)]);
MULTICALL;
}
}
}
else {
for(y =0; y< newmap->height; ++y){
for (x = 0; x < newmap->width; ++x){
sv_setiv(x1,x + newmap->start_x);
sv_setiv(y1,y + newmap->start_y);
sv_setiv(value, newmap->map[get_offset_abs(newmap, x,y)]);
MULTICALL;
}
}
}
POP_MULTICALL;
XSRETURN_EMPTY;
}
void
foreach_xy_set (self, block)
SV * self;
SV * block;
PROTOTYPE: $&
CODE:
{
dVAR; dMULTICALL;
pmap newmap;
int x,y;
GV *agv,*bgv,*gv;
HV *stash;
I32 gimme = G_VOID;
SV **args = &PL_stack_base[ax];
SV *x1, *y1, *value;
CV *cv;
if (!sv_isobject(self))
croak("Need object");
newmap = (pmap) SvPV_nolen(SvRV(self));
cv = sv_2cv(block, &stash, &gv, 0);
agv = gv_fetchpv("a", TRUE, SVt_PV);
bgv = gv_fetchpv("b", TRUE, SVt_PV);
SAVESPTR(GvSV(agv));
SAVESPTR(GvSV(bgv));
SAVESPTR(GvSV(PL_defgv));
x1 = sv_newmortal();
y1 = sv_newmortal();
value = sv_newmortal();
GvSV(agv) = x1;
GvSV(bgv) = y1;
GvSV(PL_defgv) = value;
PUSH_MULTICALL(cv);
for(y =0; y< newmap->height; ++y){
for (x = 0; x < newmap->width; ++x){
sv_setiv(x1,x + newmap->start_x);
sv_setiv(y1,y + newmap->start_y);
sv_setiv(value, newmap->map[get_offset_abs(newmap, x,y)]);
MULTICALL;
newmap->map[get_offset_abs(newmap, x, y)] = SvIV(*PL_stack_sp);
}
}
POP_MULTICALL;
XSRETURN_EMPTY;
}
#endif
typedef struct map_like * pmap;
static int path_weigths[10]={50,14,10,14,10,50,10,14,10,14};
bool check_options(pmap map, HV *opts){
SV ** item;
if (!hv_exists(opts, "width", 5))
return 0;
if (!hv_exists(opts, "height", 6))
return 0;
item = hv_fetch(opts, "width", 5, 0);
map->width = SvIV(*item);
item = hv_fetch(opts, "height", 6, 0);
map->height = SvIV(*item);
return 1;
}
void
inline init_move_offset(pmap map, int * const moves, int trim){
const int dx = 1;
const int dy = map->width + 2;
moves[0] = 0;
moves[5] = 0;
moves[1] = -dx + dy;
moves[2] = + dy;
moves[3] = +dx + dy;
moves[4] = -dx ;
moves[6] = +dx ;
moves[7] = -dx - dy;
moves[8] = - dy;
moves[9] = +dx - dy;
if (trim){
moves[0] = moves[8];
moves[5] = moves[9];
}
}
bool
inline on_the_map(pmap newmap, int x, int y){
if (x< newmap->start_x ||y< newmap->start_y ){
return 0;
}
else if (x - newmap->start_x >= (int )newmap->width || y - newmap->start_y >= (int)newmap->height){
return 0;
}
return 1;
}
int
inline get_offset(pmap newmap, int x, int y){
return ( (y - newmap->start_y + 1)*(newmap->width+2) + (x-newmap->start_x+1));
}
int
inline get_offset_abs(pmap newmap, int x, int y){
return ( (y + 1)*(newmap->width+2) + (x + 1));
}
void
inline get_xy(pmap newmap, int offset, int *x,int *y){
*x = offset % ( newmap->width + 2) + newmap->start_x - 1;
*y = offset / ( newmap->width + 2) + newmap->start_y - 1;
}
MODULE = AI::Pathfinding::AStar::Rectangle PACKAGE = AI::Pathfinding::AStar::Rectangle
void
clone(pmap self)
PREINIT:
SV *string;
SV *clone;
PPCODE:
string = SvRV(ST(0));
clone = sv_newmortal();
sv_setsv( clone, string );
clone = newRV_inc( clone );
sv_bless( clone, SvSTASH( string ));
XPUSHs( sv_2mortal(clone));
void
clone_rect(pmap self, IV begin_x, IV begin_y, IV end_x, IV end_y)
PREINIT:
SV *clone;
struct map_like re_map;
pmap newmap;
size_t map_size;
PPCODE:
if (!on_the_map( self, begin_x, begin_y ))
croak_xs_usage( cv, "left corner of rectangle is out of the map" );
if (!on_the_map( self, end_x, end_y ))
croak_xs_usage( cv, "rigth corner of rectangle is out of the map" );
if ( ! ( begin_x <= end_x ))
croak_xs_usage( cv, "attemp made to make zero width rectangle" );
if ( ! ( begin_y <= end_y ))
croak_xs_usage( cv, "attemp made to make zero height rectangle" );
clone = sv_newmortal();
sv_setpvn( clone, "", 0 );
re_map.width = end_x - begin_x + 1;
re_map.height = end_y - begin_y + 1;
map_size = sizeof(struct map_like)+(re_map.width + 2) * (re_map.height+2) *sizeof( char );
SvGROW( clone, map_size );
/* Initializing */
newmap = (pmap) SvPV_nolen( clone );
Zero(newmap, map_size, char);
newmap->width = re_map.width;
newmap->height = re_map.height;
newmap->start_x = begin_x;
newmap->start_y = begin_y;
SvCUR_set(clone, map_size);
/*Copy passability */
if (1) {
int x, y;
for ( x = begin_x; x <= end_x ; ++x ){
for ( y = begin_y; y <= end_y; ++y ){
newmap->map[ get_offset( newmap, x, y )]=
self->map[ get_offset( self, x, y )];
}
}
};
/*Prepare for return full object */
clone = newRV_inc( clone );
sv_bless( clone, SvSTASH( SvRV(ST(0) )));
XPUSHs( sv_2mortal(clone));
void
new(self, options)
SV * self;
SV * options;
INIT:
SV * object;
struct map_like re_map;
pmap newmap;
size_t map_size;
SV *RETVALUE;
PPCODE:
if (!(SvROK(options) && (is_hash(SvRV(options))))){
croak("Not hashref: USAGE: new( {width=>10, height=>20})");
}
if (!check_options(&re_map, (HV *) SvRV(options))){
croak("Not enough params: USAGE: new( {width=>10, height=>20})");
croak("Fail found mandatory param");
}
object = sv_2mortal(newSVpvn("",0));
SvGROW(object, map_size = sizeof(struct map_like)+(re_map.width + 2) * (re_map.height+2));
newmap = (pmap) SvPV_nolen(object);
Zero(newmap, map_size, char);
newmap->width = re_map.width;
newmap->height = re_map.height;
SvCUR_set(object, map_size);
RETVALUE = sv_2mortal( newRV_inc(object ));
sv_bless(RETVALUE, gv_stashpv( SvPV_nolen( self ), GV_ADD));
XPUSHs(RETVALUE);
void
start_x(pmap self, int newpos_x = 0 )
PPCODE:
if (items>1){
self->start_x = newpos_x;
XPUSHs(ST(0));
}
else {
mXPUSHi(self->start_x);
};
void
start_y(pmap self, int newpos_y = 0 )
PPCODE:
if (items>1){
self->start_y = newpos_y;
XPUSHs(ST(0));
}
else {
mXPUSHi(self->start_y);
}
void
width(pmap newmap)
PPCODE:
XPUSHs(sv_2mortal(newSViv(newmap->width)));
void
height(pmap newmap)
PPCODE:
mXPUSHi(newmap->height);
void
begin_y( pmap self )
PPCODE:
mXPUSHi(self->start_y);
void
end_y( pmap self )
PPCODE:
mXPUSHi(self->start_y + (signed) self->height -1) ;
void
begin_x( pmap self )
PPCODE:
mXPUSHi( self->start_x );
void
end_x( pmap self )
PPCODE:
mXPUSHi( self->start_x + (signed) self->width -1 );
void
last_x(pmap self)
PPCODE:
mXPUSHi(self->start_x + (signed)self->width -1);
void
last_y(pmap newmap)
PPCODE:
mXPUSHi(newmap->start_y + (signed)newmap->height-1);
void
set_start_xy(pmap self, x, y)
int x;
int y;
PPCODE:
//PerlIO_stdoutf("start(x,y) = (%d,%d)\n", x, y);
self->start_x = x;
self->start_y = y;
//PerlIO_stdoutf("start(x,y) = (%d,%d)\n", self->width, self->height);
XPUSHs( ST(0) );
void
get_passability(self, x, y)
SV * self;
int x;
int y;
INIT:
pmap newmap;
PPCODE:
if (!sv_isobject(self))
croak("Need object");
newmap = (pmap) SvPV_nolen(SvRV(self));
if ( ! on_the_map( newmap, x, y )){
XPUSHs(&PL_sv_no);
}
else {
int offset = ( (y - newmap->start_y + 1)*(newmap->width+2) + (x-newmap->start_x+1));
XPUSHs( sv_2mortal(newSViv( newmap->map[offset])));
}
void
set_passability(self, x, y, value)
pmap self;
int x;
int y;
int value;
PPCODE:
if ( ! on_the_map( self, x, y )){
warn("x=%d,y=%d outside map", x, y);
XPUSHs(&PL_sv_no);
}
else {
int offset = ( (y - self->start_y + 1)*(self->width+2) + (x-self->start_x+1));
self->map[offset] = value;
};
void
path_goto(self, x, y, path)
SV * self;
int x;
int y;
char *path;
INIT:
pmap newmap;
char * position;
int moves[10];
int gimme;
int offset;
int weigth;
PPCODE:
if (!sv_isobject(self))
croak("Need object");
newmap = (pmap) SvPV_nolen(SvRV(self));
offset = ( (y - newmap->start_y + 1)*(newmap->width+2) + (x-newmap->start_x+1));
init_move_offset(newmap, moves, 0);
position = path;
weigth = 0;
while(*position){
if (*position < '0' || *position>'9'){
goto last_op;
};
offset+= moves[ *position - '0'];
weigth+= path_weigths[ *position - '0' ];
++position;
};
gimme = GIMME_V;
if (gimme == G_ARRAY){
int x,y;
int norm;
norm = offset ;
x = norm % ( newmap->width + 2) + newmap->start_x - 1;
y = norm / ( newmap->width + 2) + newmap->start_y - 1;
mXPUSHi(x);
mXPUSHi(y);
mXPUSHi(weigth);
};
last_op:;
void
draw_path_xy( pmap newmap, int x, int y, char *path, int value )
PREINIT:
char *position;
int moves[10];
PPCODE:
if ( !on_the_map(newmap, x, y) ){
croak("start is outside the map");
}
else {
int offset = get_offset(newmap, x, y);
const int max_offset = get_offset_abs( newmap, newmap->width, newmap->height);
const int min_offset = get_offset_abs( newmap, 0, 0);
init_move_offset(newmap, moves,0);
newmap->map[offset] = value;
position = path;
while(*position){
if (*position < '0' || *position>'9'){
croak("bad path: illegal symbols");
};
offset+= moves[ *position - '0'];
if (offset > max_offset || offset < min_offset ||
offset % (int)(newmap->width + 2) == 0 ||
offset % (int)(newmap->width + 2) == (int) newmap->width + 1 ){
croak("path otside map");
}
newmap->map[offset] = value;
++position;
}
get_xy(newmap, offset, &x, &y);
mXPUSHi(x);
mXPUSHi(y);
}
void
is_path_valid(self, x, y, path)
SV * self;
int x;
int y;
char *path;
INIT:
pmap newmap;
char * position;
int moves[10];
int gimme;
PPCODE:
if (!sv_isobject(self))
croak("Need object");
newmap = (pmap) SvPV_nolen(SvRV(self));
if ( ! on_the_map( newmap, x, y )){
XPUSHs(&PL_sv_no);
}
else {
int offset = ( (y - newmap->start_y + 1)*(newmap->width+2) + (x-newmap->start_x+1));
int weigth = 0;
init_move_offset(newmap, moves,0);
position = path;
while(*position){
if (*position < '0' || *position>'9'){
XPUSHs(&PL_sv_no);
goto last_op;
};
offset+= moves[ *position - '0'];
if (! newmap->map[offset] ){
XPUSHs(&PL_sv_no);
goto last_op;
}
weigth+= path_weigths[ *position - '0' ];
++position;
}
// fprintf( stderr, "ok");
gimme = GIMME_V;
if (gimme == G_ARRAY){
int x,y;
int norm;
norm = offset ;
x = norm % ( newmap->width + 2) + newmap->start_x - 1;
y = norm / ( newmap->width + 2) + newmap->start_y - 1;
mXPUSHi(x);
mXPUSHi(y);
mXPUSHi(weigth);
}
XPUSHs(&PL_sv_yes);
}
last_op:;
void
dastar( self, from_x, from_y, to_x, to_y )
int from_x;
int from_y;
int to_x;
int to_y;
SV* self;
INIT:
pmap newmap;
int moves[10];
struct map_item *layout;
int current, end_offset, start_offset;
int *opens;
int opens_start;
int opens_end;
static U8 path_char[8]={'8','1','2','3','4','9','6','7'};
static int weigths[8] ={10,14,10,14,10,14,10,14};
int iter_num;
int finish[5];
int map_size;
PPCODE:
if (!sv_isobject(self))
croak("Need object");
newmap = (pmap) SvPV_nolen(SvRV(self));
if (!on_the_map(newmap, from_x, from_y) || !on_the_map(newmap, to_x, to_y)){
XPUSHs(&PL_sv_no);
goto last_op;
}
if (! newmap->map[get_offset(newmap, from_x, from_y)]
|| ! newmap->map[get_offset(newmap, to_x, to_y)]){
XPUSHs(&PL_sv_no);
goto last_op;
}
start_offset = get_offset(newmap, from_x, from_y);
end_offset = get_offset(newmap, to_x, to_y);
if (start_offset == end_offset){
XPUSHs(&PL_sv_no);
XPUSHs(&PL_sv_yes);
goto last_op;
}
map_size= (2+newmap->width) * (2+newmap->height);
Newxz(layout, map_size, struct map_item);
Newx(opens, map_size, int);
init_move_offset(newmap, moves, 1);
opens_start = 0;
opens_end = 0;
iter_num = 0;
current = start_offset;
layout[current].g = 0;
finish[0] = end_offset;
finish[1] = end_offset+1;
finish[2] = end_offset-1;
finish[3] = end_offset+newmap->width+2;
finish[4] = end_offset-newmap->width-2;
while( current != end_offset){
int i;
int g;
if ( 0
|| current == finish[1]
|| current == finish[2]
|| current == finish[3]
|| current == finish[4])
break;
layout[current].open = 0;
layout[current].closed = 1;
for(i=1; i<8; i+=2){
int nextpoint = current + moves[i];
if ( layout[nextpoint].closed || newmap->map[nextpoint] == 0 )
continue;
g = weigths[i] + layout[current].g;
if (layout[nextpoint].open ){
if (g < layout[nextpoint].g){
// int g0;
// g0 = layout[nextpoint].g;
layout[nextpoint].g = g;
layout[nextpoint].k = layout[nextpoint].h + g ;
layout[nextpoint].prev = i;
}
}
else {
int x, y;
int h;
int abs_dx;
int abs_dy;
get_xy(newmap, nextpoint, &x, &y);
layout[nextpoint].open = 1;
abs_dx = abs( x-to_x );
abs_dy = abs( y-to_y );
// layout[nextpoint].h = h = ( abs_dx + abs_dy )*14;
h = ( abs_dx + abs_dy )*10; // Manheton
#h = 10 * ((abs_dx> abs_dy)? abs_dx: abs_dy);
layout[nextpoint].h = h ;
Rectangle.xs view on Meta::CPAN
last_op:; // last resort Can't use return
void
astar( self, from_x, from_y, to_x, to_y )
int from_x;
int from_y;
int to_x;
int to_y;
SV* self;
INIT:
pmap newmap;
int moves[10];
struct map_item *layout;
int current, end_offset, start_offset;
int *opens;
int opens_start;
int opens_end;
static U8 path_char[8]={'8','1','2','3','4','9','6','7'};
static int weigths[8] ={10,14,10,14,10,14,10,14};
int iter_num;
int index;
int map_size;
PPCODE:
if (!sv_isobject(self))
croak("Need object");
newmap = (pmap) SvPV_nolen(SvRV(self));
if (!on_the_map(newmap, from_x, from_y) || !on_the_map(newmap, to_x, to_y)){
XPUSHs(&PL_sv_no);
goto last_op;
}
if (! newmap->map[get_offset(newmap, from_x, from_y)]
|| ! newmap->map[get_offset(newmap, to_x, to_y)]){
XPUSHs(&PL_sv_no);
goto last_op;
}
start_offset = get_offset(newmap, from_x, from_y);
end_offset = get_offset(newmap, to_x, to_y);
if (start_offset == end_offset){
XPUSHs(&PL_sv_no);
XPUSHs(&PL_sv_yes);
goto last_op;
}
map_size = (2+newmap->width) * (2+newmap->height);
Newxz(layout, map_size, struct map_item);
Newx(opens, map_size, int);
init_move_offset(newmap, moves, 1);
opens_start = 0;
opens_end = 0;
iter_num = 0;
current = start_offset;
layout[current].g = 0;
while( current != end_offset){
int i;
layout[current].open = 0;
layout[current].closed = 1;
for(i=0; i<8; ++i){
int nextpoint = current + moves[i];
int g;
if ( layout[nextpoint].closed || newmap->map[nextpoint] == 0 )
continue;
g = weigths[i] + layout[current].g;
if (layout[nextpoint].open ){
if (g < layout[nextpoint].g){
// int g0;
// g0 = layout[nextpoint].g;
layout[nextpoint].g = g;
layout[nextpoint].k = layout[nextpoint].h + g ;
layout[nextpoint].prev = i;
}
}
else {
int x, y;
int h;
int abs_dx;
int abs_dy;
get_xy(newmap, nextpoint, &x, &y);
layout[nextpoint].open = 1;
abs_dx = abs( x-to_x );
abs_dy = abs( y-to_y );
// layout[nextpoint].h = h = ( abs_dx + abs_dy )*14;
h = ( abs_dx + abs_dy )*10; // Manheton
#h = 10 * ((abs_dx> abs_dy)? abs_dx: abs_dy);
layout[nextpoint].h = h ;
examples/snake_labirint.pl view on Meta::CPAN
use strict;
use warnings;
no warnings 'once';
#~ $m->foreach_xy_set( sub { $a < 12 && 1<$b && $b <9 } );
#~ $m->draw_path( 5, 5, '1666666888' );
#~ exit;
my @from = (0,0);
my @to = (WIDTH_X >> 1, WIDTH_Y >> 1);
my @map;
{
# Generate map
for my $x (0 .. WIDTH_X - 1 )
{
for my $y (0 .. WIDTH_Y - 1 )
{
$map[$x][$y] = 1;
}
}
$map[5][$_] = 0 for 5 .. WIDTH_Y - 5;
$map[WIDTH_X - 5][$_] = 0 for 5 .. WIDTH_Y - 5;
$map[$_][5] = 0 for 5 .. WIDTH_X - 5;
$map[$_][WIDTH_Y - 5] = 0 for 5 .. WIDTH_X - 10;
$map[$_][10] = 0 for 10 .. WIDTH_X - 10;
$map[WIDTH_X - 10][$_] = 0 for 10 .. WIDTH_Y - 5;
$map[10][$_] = 0 for 10 .. WIDTH_Y - 10;
$map[$_][WIDTH_Y - 10] = 0 for 10 .. WIDTH_X - 15;
$map[WIDTH_X - 15][$_] = 0 for 15 .. WIDTH_Y - 10;
$map[$_][15] = 0 for 15 .. WIDTH_X - 15;
}
# copy map to map object
$m->foreach_xy_set( sub { $map[$a][$b] });
my ($path) = $m->astar(@to, @from);
sub swap(\@\@){
@_[0,1] = @_[1,0];;
}
#swap(@to, @from);
$m->draw_path(@to, $path);
lib/AI/Pathfinding/AStar/Rectangle.pm view on Meta::CPAN
our @ISA = qw(Exporter);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
# This allows declaration use AI::Pathfinding::AStar::Rectangle ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(create_map
) ] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw(
);
our $VERSION = '0.23';
lib/AI/Pathfinding/AStar/Rectangle.pm view on Meta::CPAN
local ($a, $b );
local $_;
for $a ( $self->start_x .. $self->last_x ){
for $b ( $self->start_y .. $self->last_y ){
$_ = $self->get_passability( $a, $b );
$self->set_passability( $a, $b, (scalar &$sub()) );
};
};
}
sub create_map($){
unshift @_, __PACKAGE__;
goto &new;
}
1 for ($a, $b); #suppress warnings
sub set_passability_string{
my $self = shift;
my $passability = shift;
die "Bad passabilitity param for set_passability_string" unless $self->width * $self->height == length( $passability );
lib/AI/Pathfinding/AStar/Rectangle.pm view on Meta::CPAN
}
sub get_passability_string{
my $self = shift;
my $buf = '';
$self->foreach_xy( sub { $buf.= chr( $_)} );
return $buf;
}
sub draw_path{
my $map = shift;
my ($x, $y) = splice @_, 0, 2;
my $path = shift;
my @map;
$map->foreach_xy( sub {$map[$a][$b]= $_} );
# draw path
my %vect = (
# x y
1 => [-1, 1, ],
2 => [ 0, 1, '.|'],
3 => [ 1, 1, '|\\'],
4 => [-1, 0, '|<'],
6 => [ 1, 0, '|>'],
7 => [-1,-1, '|\\'],
8 => [ 0,-1, '\'|'],
9 => [ 1,-1, '|/']
);
my @path = split //, $path;
print "Steps: ".scalar(@path)."\n";
for ( @path )
{
$map[$x][$y] = '|o';
$x += $vect{$_}->[0];
$y -= $vect{$_}->[1];
$map[$x][$y] = '|o';
}
printf "%02d", $_ for 0 .. $map->last_x;
print "\n";
for my $y ( 0 .. $map->last_y - 1 )
{
for my $x ( 0 .. $map->last_x - 1 )
{
print $map[$x][$y] eq
'1' ? "|_" : (
$map[$x][$y] eq '0' ? "|#" : (
$map[$x][$y] eq '3' ? "|S" : (
$map[$x][$y] eq '4' ? "|E" : $map[$x][$y] ) ) );
}
print "$y\n";
}
}
1;
__END__
=head1 NAME
AI::Pathfinding::AStar::Rectangle - AStar algorithm on rectangle map
=head1 SYNOPSIS
use AI::Pathfinding::AStar::Rectangle qw(create_map);
my $map = create_map({height=>10, width=>10});
#
# -or-
#
# $map = AI::Pathfinding::AStar::Rectangle->new({{height=>10, width=>10});
for my $x ($map->start_x..$map->last_x){
for my $y ($map->start_y..$map->last_y){
$map->set_passability($x, $y, $A[$x][$y]) # 1 - Can pass througth , 0 - Can't pass
}
}
my $path = $map->astar( $from_x, $from_y, $to_x, $to_y);
print $path, "\n"; # print path in presentation of "12346789" like keys at keyboard
=head1 DESCRIPTION
AI::Pathfinding::AStar::Rectangle provide abstraction for Rectangle map with AStar algoritm
=head1 OBJECT METHODS
=over 4
=item new { "width" => map_width, "height" => map_heigth }
Create AI::Pathfinding::AStar::Rectangle object. Object represent map with given height and width.
=item set_passability x, y, value # value: 1 - can pass through point, 0 - can't
Set passability for point(x,y)
=item get_passability (x,y)
Get passability for point
=item astar(from_x, from_y, to_x, to_y)
lib/AI/Pathfinding/AStar/Rectangle.pm view on Meta::CPAN
1 - mean go left-down
2 - down
3 - down-right
...
9 - right-up
=item dastar( from_x, from_y, to_x, to_y)
Return diagonal path with AI
=item width()
Get map width
=item height()
Get map height
=item start_x(), start_y()
Get/Set coords for leftbottom-most point
=item set_start_xy( self, x, y)
Set coordinates of left-bootom point
=item last_x(), last_y()
Get coords for right-upper point
=item foreach_xy( BLOCK )
Call BLOCK for every point on map.
$map->foreach_xy( sub { $A[$a][$b] = $_ })
($a, $b, $_) (x, y, passability)
=item foreach_xy_set( sub { $A[$a][$b] });
set passability for every point at map.
BLOCK must return passability for point ($a, $b);
$a and $b must be global var not declared as my, our,
=item is_path_valid( start_x, start_y, path)
Check if path is valid path, all points from ( start_x, start_y ) to path end is passable
In list context return ( end_x, end_y, weigth, true or false )
=item path_goto( start_x, start_y, path)
die "Invalid version number format: '$opt{'compat-version'}'\n";
}
die "Only Perl 5 is supported\n" if $r != 5;
die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $s >= 1000;
$opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s;
}
else {
$opt{'compat-version'} = 5;
}
my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
? ( $1 => {
($2 ? ( base => $2 ) : ()),
($3 ? ( todo => $3 ) : ()),
(index($4, 'v') >= 0 ? ( varargs => 1 ) : ()),
(index($4, 'p') >= 0 ? ( provided => 1 ) : ()),
(index($4, 'n') >= 0 ? ( nothxarg => 1 ) : ()),
} )
: die "invalid spec: $_" } qw(
AvFILLp|5.004050||p
AvFILL|||
}
$function = [$1, ''] if m{^DPPP_\(my_(\w+)\)};
$replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$};
$replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)};
$replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce};
$replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$};
if (m{^\s*$rccs\s+(\w+(\s*,\s*\w+)*)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) {
my @deps = map { s/\s+//g; $_ } split /,/, $3;
my $d;
for $d (map { s/\s+//g; $_ } split /,/, $1) {
push @{$depends{$d}}, @deps;
}
}
$need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)};
}
for (values %depends) {
my %s;
$_ = [sort grep !$s{$_}++, @$_];
push @flags, 'hint' if exists $hints{$f};
push @flags, 'warning' if exists $warnings{$f};
my $flags = @flags ? ' ['.join(', ', @flags).']' : '';
print "$f$flags\n";
}
exit 0;
}
my @files;
my @srcext = qw( .xs .c .h .cc .cpp -c.inc -xs.inc );
my $srcext = join '|', map { quotemeta $_ } @srcext;
if (@ARGV) {
my %seen;
for (@ARGV) {
if (-e) {
if (-f) {
push @files, $_ unless $seen{$_}++;
}
else { warn "'$_' is not a file.\n" }
}
}
else {
eval {
require File::Find;
File::Find::find(sub {
$File::Find::name =~ /($srcext)$/i
and push @files, $File::Find::name;
}, '.');
};
if ($@) {
@files = map { glob "*$_" } @srcext;
}
}
if (!@ARGV || $opt{filter}) {
my(@in, @out);
my %xsc = map { /(.*)\.xs$/ ? ("$1.c" => 1, "$1.cc" => 1) : () } @files;
for (@files) {
my $out = exists $xsc{$_} || /\b\Q$ppport\E$/i || !/($srcext)$/i;
push @{ $out ? \@out : \@in }, $_;
}
if (@ARGV && @out) {
warning("Skipping the following files (use --nofilter to avoid this):\n| ", join "\n| ", @out);
}
@files = @in;
}
return undef;
}
sub rec_depend
{
my($func, $seen) = @_;
return () unless exists $depends{$func};
$seen = {%{$seen||{}}};
return () if $seen->{$func}++;
my %s;
grep !$s{$_}++, map { ($_, rec_depend($_, $seen)) } @{$depends{$func}};
}
sub parse_version
{
my $ver = shift;
if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) {
return ($1, $2, $3);
}
elsif ($ver !~ /^\d+\.[\d_]+$/) {
t/01-simple.t view on Meta::CPAN
# change 'tests => 1' to 'tests => last_test_to_print';
use Test::More tests => 10+9+2+1;
1 for $Test::More::TODO;
our $T = 'AI::Pathfinding::AStar::Rectangle';
BEGIN{
eval "use ExtUtils::testlib;" unless grep { m/::testlib/ } keys %INC;
print "not ok $@" if $@;
$T = 'AI::Pathfinding::AStar::Rectangle';
eval "use $T qw(create_map);";
die "Can't load $T: $@." if $@;
}
use AI::Pathfinding::AStar::Rectangle qw(create_map);
my $a= $T->new({ width => 12, height => 15 });
ok($a);
is(ref ($a), $T);
is(ref create_map({width=>1, height=>1}), $T);
is($a->width, 12, 'width');
is($a->height, 15, 'height');
is($a->start_x, 0, 'start_x of new map eq 0');
is($a->start_y, 0, 'start_y of new map eq 0');
is($a->last_x, 11, 'last_x of new map eq 0');
is($a->last_y, 14, 'last_y of new map eq 0');
my $s='';
$a->foreach_xy( sub {$s.=$_} );
is($s, ('0' x (12*15)));
$a->set_start_xy(40, 50 );
is($a->start_x, 40, 'start_x of map eq 40');
is($a->start_y, 50, 'start_y of map eq 50');
is($a->last_x, 40+11, 'last_x of map eq 51');
is($a->last_y, 50+14, 'last_y of map eq 64');
$s='';
$a->foreach_xy( sub {$s.=$_} );
is($s, ('0' x (12*15)));
$a->set_start_xy( -40, -50 );
is($a->start_x, -40, 'start_x of map eq -40');
is($a->start_y, -50, 'start_y of map eq -50');
is($a->last_x, -40+11, 'last_x of map eq -29');
is($a->last_y, -50+14, 'last_y of map eq -36');
$a->start_x(0);
is($a->start_x, 0, "set start x");
$a->start_y(0);
is($a->start_y, 0, "set start y");
# 10 + 8
my $s_1='';
$a->foreach_xy_set( sub { 1;} );
t/02-passability.t view on Meta::CPAN
use Test::More 'no_plan';
use strict;
use warnings;
1 for $Test::More::TODO;
my $T;
BEGIN{
eval "use ExtUtils::testlib;" unless grep { m/::testlib/ } keys %INC;
print "not ok $@" if $@;
$T = 'AI::Pathfinding::AStar::Rectangle';
eval "use $T qw(create_map);";
die "Can't load $T: $@." if $@;
}
my $m= $T->new({ width => 12, height => 15 });
my $accum;
$accum = '';
for my $x(-2..14){
for my $y (-2..17){
$accum.= $m->get_passability($x,$y);
TYPEMAP
pmap MAP_OBJ
INPUT
MAP_OBJ
if ( !sv_isobject( $arg ) )
croak_xs_usage( cv, \"Need object\" );
$var = (pmap)SvPV_nolen(SvRV($arg));
OUTPUT
MAP_OBJ
sv_setiv($arg, (I32) $var);
( run in 0.485 second using v1.01-cache-2.11-cpan-49f99fa48dc )