view release on metacpan or  search on metacpan

lib/AI/Pathfinding/SMAstar/AVLQueue.pm  view on Meta::CPAN

#
# Queue.pm
#
# Implementation of a queue based on a binary tree
# A tree structure is used rather than a heap to allow 
# infrequent, but necessary, arbitrary access to elements 
# in the middle of the queue in log(n) time
# 
# This is primarily necessary to facilitat the SMAstar 
# path-finding algorithm.
#
#
# Author:  matthias beebe
# Date :  June 2008
#
#
package AI::Pathfinding::SMAstar::AVLQueue;

use Tree::AVL;
use AI::Pathfinding::SMAstar::PairObj;
use Carp;
use strict;



##################################################
#  AVLQueue constructor 
##################################################
sub new {
    my $invocant = shift;
    my $class   = ref($invocant) || $invocant;
    my $self = {
	_key         => undef, # for comparisons with other queues, etc.

	_avltree         => Tree::AVL->new(fcompare => \&AI::Pathfinding::SMAstar::AVLQueue::compare_obj_counters,
					   fget_key => \&AI::Pathfinding::SMAstar::AVLQueue::obj_counter,
					   fget_data => \&AI::Pathfinding::SMAstar::AVLQueue::obj_value),
	
	_counter     => 0,
	
	_obj_counts_tree => Tree::AVL->new(fcompare => \&AI::Pathfinding::SMAstar::PairObj::compare_keys_numeric,
					   fget_key => \&AI::Pathfinding::SMAstar::PairObj::key,
					   fget_data => \&AI::Pathfinding::SMAstar::PairObj::val),
		
        @_,    # Override previous attributes
    };
    return bless $self, $class;
}



##############################################
# accessor
##############################################

sub key
{
    my $self = shift;
    if (@_) { $self->{_key} = shift }
    return $self->{_key};	
}





#############################################################################
#
# other methods
#
#############################################################################


sub get_keys_iterator
{
    my ($self) = @_;
    return $self->{_obj_counts_tree}->get_keys_iterator();
}



sub compare_obj_counters{
    my ($obj, $arg_obj) = @_;

     if ($arg_obj){
	my $arg_key = $arg_obj->{_queue_counter};
	my $key = $obj->{_queue_counter};
	
	if($arg_key > $key){
	    return(-1);
	}
	elsif($arg_key == $key){
	    return(0);
	}
	elsif($arg_key < $key){
	    return(1);
	}	
    }
    else{
	croak "AVLQueue::compare_obj_counters: error: null argument object\n";
    }
}