AI-Pathfinding-AStar

 view release on metacpan or  search on metacpan

README  view on Meta::CPAN

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

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

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