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 );
    for my $x (0 .. WIDTH_X - 1 )
    {
        for my $y (0 .. WIDTH_Y - 1 )
        {
            $g[$x][$y] = 0;
            $r[$x][$y] = 0;
            $h[$x][$y] = 0;
        }
    }
    my %cost = (
        "0.-1"  =>  5, #|.
        "1.-1"  =>  7, #/.
        "1.0"   =>  5, #.-
        "1.1"   =>  7, #`\
        "0.1"   =>  5, #`|
        "-1.1"  =>  7, # 
        "-1.0"  =>  5,
        "-1.-1" =>  7
    );
    my $it = 0;
    my $oindx = 0;
    my ( $x, $y ) = ( $xs, $ys );
    while ( $x != $xe || $y != $ye )
    {
        $close{$x}{$y} = 1;
        $open{$x}{$y} = 0;

        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 );