AI-Pathfinding-AStar
view release on metacpan or search on metacpan
- Major bug fixed that caused some paths to be incorrectly
determined due to an over-greedy implementation. Thanks, Flavio!
0.07 Tue Aug 08 07:00:00 2006
- Major changes introduced by Franc Carter which include:
- Speed optimizations by using a different Heap module and slightly restructured hash
- The welcome addition of a FindPathIncr() function that allows you to calculate paths in chunks
These are major changes about which I am very excited. Thank you again, Franc!
0.06 Mon Nov 28 19:00:00 2005
- no changes, CPAN refused to update the version number so I resubmitted
0.05 Fri Nov 25 09:30:00 2005
- fixed Makefile.PL to include a dependency on Heap::Simple::Perl to fix all the CPANTester reports
0.04 Mon Oct 17 17:30:00 2005
- finally made findpath() aware of the context in which it was called and it will now return either an array or array reference accordingly
- minor coding style tweaks
- minor documentation edits
0.03 Sat Oct 15 21:00:00 2005
NAME
AI::Pathfinding::AStar - Perl implementation of the A* pathfinding
algorithm
SYNOPSIS
package My::Map::Package;
use base AI::Pathfinding::AStar;
# Methods required by AI::Pathfinding::AStar
sub getSurrounding { ... }
package main;
use My::Map::Package;
my $map = My::Map::Package->new or die "No map for you!";
my $path = $map->findPath($start, $target);
print join(', ', @$path), "\n";
#Or you can do it incrementally, say 3 nodes at a time
my $state = $map->findPathIncr($start, $target, undef, 3);
while ($state->{path}->[-1] ne $target) {
print join(', ', @{$state->{path}}), "\n";
$state = $map->findPathIncr($start, $target, $state, 3);
}
print "Completed Path: ", join(', ', @{$state->{path}}), "\n";
DESCRIPTION
This module implements the A* pathfinding algorithm. It acts as a base
class from which a custom map object can be derived. It requires from
the map object a subroutine named "getSurrounding" (described below) and
provides to the object two routines called "findPath" and "findPathIncr"
(also described below.) It should also be noted that
AI::Pathfinding::AStar defines two other subs ("calcF" and "calcG")
which are used only by the "findPath" routines.
AI::Pathfinding::AStar requires that the map object define a routine
named "getSurrounding" which accepts the starting and target node ids
for which you are calculating the path. In return it should provide an
array reference containing the following details about each of the
immediately surrounding nodes:
* Node ID
* Cost to enter that node
lib/AI/Pathfinding/AStar.pm view on Meta::CPAN
use warnings;
use Carp;
our $VERSION = '0.10';
use Heap::Binomial;
use AI::Pathfinding::AStar::AStarNode;
my $nodes;
sub _init {
my $self = shift;
croak "no getSurrounding() method defined" unless $self->can("getSurrounding");
return $self->SUPER::_init(@_);
}
sub doAStar
{
my ($map, $target, $open, $nodes, $max) = @_;
my $n = 0;
FLOOP: while ( (defined $open->top()) && ($open->top()->{id} ne $target) ) {
#allow incremental calculation
last FLOOP if (defined($max) and (++$n == $max));
my $curr_node = $open->extract_top();
lib/AI/Pathfinding/AStar.pm view on Meta::CPAN
#change the parent
$surr_node->{parent} = $curr_node;
$surr_node->{g} = $possG;
$open->decrease_key($surr_node);
}
}
}
}
}
sub fillPath
{
my ($map,$open,$nodes,$target) = @_;
my $path = [];
my $curr_node = (exists $nodes->{$target}) ? $nodes->{$target} : $open->top();
while (defined $curr_node) {
unshift @$path, $curr_node->{id};
$curr_node = $curr_node->{parent};
}
return $path;
}
sub findPath {
my ($map, $start, $target) = @_;
my $nodes = {};
my $curr_node = undef;
my $open = Heap::Binomial->new;
#add starting square to the open list
$curr_node = AI::Pathfinding::AStar::AStarNode->new($start,0,0); # AStarNode(id,g,h)
$curr_node->{parent} = undef;
$curr_node->{cost} = 0;
lib/AI/Pathfinding/AStar.pm view on Meta::CPAN
$nodes->{$start} = $curr_node;
$open->add($curr_node);
$map->doAStar($target,$open,$nodes,undef);
my $path = $map->fillPath($open,$nodes,$target);
return wantarray ? @{$path} : $path;
}
sub findPathIncr {
my ($map, $start, $target, $state, $max) = @_;
my $open = undef;
my $curr_node = undef;;
my $nodes = {};
if (defined($state)) {
$nodes = $state->{'visited'};
$open = $state->{'open'};
}
else {
lib/AI/Pathfinding/AStar.pm view on Meta::CPAN
=head1 NAME
AI::Pathfinding::AStar - Perl implementation of the A* pathfinding algorithm
=head1 SYNOPSIS
package My::Map::Package;
use base AI::Pathfinding::AStar;
# Methods required by AI::Pathfinding::AStar
sub getSurrounding { ... }
package main;
use My::Map::Package;
my $map = My::Map::Package->new or die "No map for you!";
my $path = $map->findPath($start, $target);
print join(', ', @$path), "\n";
#Or you can do it incrementally, say 3 nodes at a time
my $state = $map->findPathIncr($start, $target, undef, 3);
while ($state->{path}->[-1] ne $target) {
print join(', ', @{$state->{path}}), "\n";
$state = $map->findPathIncr($start, $target, $state, 3);
}
print "Completed Path: ", join(', ', @{$state->{path}}), "\n";
=head1 DESCRIPTION
This module implements the A* pathfinding algorithm. It acts as a base class from which a custom map object can be derived. It requires from the map object a subroutine named C<getSurrounding> (described below) and provides to the object two routin...
AI::Pathfinding::AStar requires that the map object define a routine named C<getSurrounding> which accepts the starting and target node ids for which you are calculating the path. In return it should provide an array reference containing the followi...
=over
=item * Node ID
=item * Cost to enter that node
=item * Heuristic
lib/AI/Pathfinding/AStar/AStarNode.pm view on Meta::CPAN
package AI::Pathfinding::AStar::AStarNode;
use base 'Heap::Elem';
use strict;
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my ($id,$g,$h) = @_;
my $self = {};
$self->{id} = $id;
$self->{g} = $g;
$self->{h} = $h;
$self->{f} = $g+$h;
$self->{parent} = undef;
$self->{cost} = 0;
$self->{inopen} = 0;
$self->{heap} = undef;
bless ($self, $class);
return $self;
}
sub heap {
my ($self, $val) = @_;
$self->{heap} = $val if (defined $val);
return $self->{heap};
}
sub cmp {
my $self = shift;
my $other = shift;
return ($self->{f} <=> $other->{f});
}
1;
t/01_AI-Pathfinding-AStar.t view on Meta::CPAN
# @ . . | . . *
# . . . | . . .
# . . . . . . .
#
#Where . represents open squares and | represents walls. The @ represents our
#starting square and the * the target square. This module assumes that
#orthogonal moves cost 10 points and diagonal moves cost 140. The heuristic
#used is Manhattan, which simply counts the orthogonal distance between any 2
#squares whilst disregarding any barriers.
sub new
{
my $invocant = shift;
my $class = ref($invocant) || $invocant;
my $self = bless {}, $class;
$self->{map} = {};
for(my $x=1; $x<=7; $x++)
{
for(my $y=1; $y<=5; $y++)
{$self->{map}->{$x.'.'.$y} = 1;}
t/01_AI-Pathfinding-AStar.t view on Meta::CPAN
$self->{map}->{'4.2'} = 0;
$self->{map}->{'4.3'} = 0;
$self->{map}->{'4.4'} = 0;
return $self;
}
#some support routines
#get orthoganal neighbours
sub getOrth
{
my ($source) = @_;
my @return = ();
my ($x, $y) = split(/\./, $source);
push @return, ($x+1).'.'.$y, ($x-1).'.'.$y, $x.'.'.($y+1), $x.'.'.($y-1);
return @return;
}
#get diagonal neightbours
sub getDiag
{
my ($source) = @_;
my @return = ();
my ($x, $y) = split(/\./, $source);
push @return, ($x+1).'.'.($y+1), ($x+1).'.'.($y-1), ($x-1).'.'.($y+1), ($x-1).'.'.($y-1);
return @return;
}
#calculate the Heuristic
sub calcH
{
my ($source, $target) = @_;
my ($x1, $y1) = split(/\./, $source);
my ($x2, $y2) = split(/\./, $target);
return (abs($x1-$x2) + abs($y1-$y2));
}
#the routine required by AI::Pathfinding::AStar
sub getSurrounding
{
my ($self, $source, $target) = @_;
my %map = %{$self->{map}};
my ($src_x, $src_y) = split(/\./, $source);
my $surrounding = [];
#orthogonal moves cost 10, diagonal cost 140
foreach my $node (getOrth($source))
( run in 0.722 second using v1.01-cache-2.11-cpan-88abd93f124 )