AI-Pathfinding-SMAstar

 view release on metacpan or  search on metacpan

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

		if($best->is_completed()){


		    # remove from queue first, back up fvals, then insert back on queue. 
		    # this way, it gets placed in its rightful place on the queue.		    
		    my $fval_before_backup = $best->{_f_cost};
		   
		    # STEPS:
		    # 1) remove best and all antecedents from queue, but only if they are 
		    #    going to be altered by backing-up fvals.    This is because 
		    #    removing and re-inserting in queue changes temporal ordering,
		    #    and we don't want to do that unless the node will be
		    #    placed in a new cost-bucket/tree.
		    # 2) then backup fvals
		    # 3) then re-insert best and all antecedents back on queue.


		    # Check if need for backup fvals		    
		    $best->check_need_fval_change();
		   
		    my $cmp_func = sub {
			my ($str) = @_;			
			return sub{
			    my ($obj) = @_;
			    my $obj_path_str = $str_function->($obj);
			    if($obj_path_str eq $str){
				return 1;
			    }
			    else{ 
				return 0; 
			    }	    
			}
		    };

		    my $antecedent = $best->{_antecedent};
		    my %was_on_queue;
		    my $i = 0;

		    # Now remove the offending nodes from queue, if any
		    if($best->need_fval_change()){
			
			# remove best from the queue
			$best = $$priority_queue->deepest_lowest_cost_leaf();  
		    
			while($antecedent){
			    my $path_str = $str_function->($antecedent);	
			    
			    if($antecedent->is_on_queue() && $antecedent->need_fval_change()){
				$was_on_queue{$i} = 1;
				$$priority_queue->remove($antecedent, $cmp_func->($path_str));  	
			    }
			    $antecedent = $antecedent->{_antecedent};
			    $i++;
			}
		    }
		    
	
		    #   Backup fvals
		    if($best->need_fval_change()){
			$best->$backup_func();			
		    }

		    
		    # Put everything back on the queue
		    if($best->need_fval_change()){
			$$priority_queue->insert($best);
			my $antecedent = $best->{_antecedent};
			my $i = 0;
			while($antecedent){
			    if($was_on_queue{$i} && $antecedent->need_fval_change()){  
                                # the antecedent needed fval change too.
				$$priority_queue->insert($antecedent);
			    }
			    if($antecedent->need_fval_change()){
				# set need_fval_change back to 0, so it will not be automatically  seen as 
				# needing changed in the future.  This is important, since we do not want
				# to remove an element from the queue *unless* we need to change the fcost. 
				# This is because when we remove it from the queue and re-insert it, it
				# loses its seniority in the queue (it becomes the newest node at its cost 
				# and depth) and will not be removed at the right time when searching for
				# deepest_lowest_cost_leafs or shallowest_highest_cost_leafs.
				$antecedent->{_need_fcost_change} = 0;
			    }

			    $antecedent = $antecedent->{_antecedent};
			    $i++;			    
			}
			# Again, set need_fval_change back to 0, so it will not be automatically 
			# seen as needing changed in the future.
			$best->{_need_fcost_change} = 0;
		    }
		}


		#
		# If best's descendants are all in memory, mark best as completed.
                #
		if($best->all_in_memory()) { 
		    
		    if(!($best->is_completed())){

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

    if (@_) { $self->{_is_on_queue} = shift }
    return  $self->{_is_on_queue};
}

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

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



	

sub compare
{
    my ($min_letters) = @_;

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

	_descendant_index        => undef,	
	_descendant_fcosts       => [],
	_descendants_on_queue    => 0,

	_descendands_deleted     => 0,
	_is_completed            => 0,
	_num_successors          => undef,
	_num_successors_in_mem   => 0,
	_is_on_queue             => 0,
	_iterator_index          => 0,      # to remember index of iterator for descendants
	_need_fcost_change       => 0,      # boolean

	@_,    # attribute override
    };

    return bless $self, $class;
        
}

##############################################
# accessors

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

    if (@_) { $self->{_is_on_queue} = shift }
    return  $self->{_is_on_queue};
}

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

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




# new version 8
sub remember_forgotten_nodes_fcost
{
    my ($self, $node) = @_;      

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

    
    

#-----------------------------------------------------------------------------------------------
#
# Check whether we need to backup the fvals for a node when it is completed (recursive)
# Sets flags throughout path object's lineage, indicating whether fvals need to be updated.
#
#-----------------------------------------------------------------------------------------------
sub check_need_fval_change
{
    my ($self, $descendant_fcost, $descendant_ind) = @_;
 

    my $descendant_index = $self->{_descendant_index};

    if(!$self->is_completed()){
        # node not completed. no need to update fcost.
	$self->need_fval_change(0);
	return;
    }

    my $fcost = $self->{_f_cost};
    my $least_fcost2 = 99;
       
    
    my $min = sub {	
	my ($n1, $n2) = @_;
	return ($n1 < $n2 ? $n1 : $n2);

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

	$j++;	
    }
    
    # if no successors, this node cannot lead to 
    # goal, so set fcost to infinity.
    if($self->{_num_successors} == 0){ 
	$least_fcost2 = 99;
    }
  
    if($least_fcost2 != $fcost){		
        # setting need_fcost_change to 1
	$self->need_fval_change(1);
	my $antecedent = $self->{_antecedent};
	
	# recurse on the antecedent
	if($antecedent){
	    $antecedent->check_need_fval_change($least_fcost2, $descendant_index);
	}	
    }
}





#-----------------------------------------------------------------------------------------------
#

t/AI-Pathfinding-SMAstar.t  view on Meta::CPAN

#!/usr/bin/perl

# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl AI-Pathfinding-SMAstar.t'

#########################

# change 'tests => 1' to 'tests => last_test_to_print';

use Test::More tests => 9;



BEGIN { use_ok('AI::Pathfinding::SMAstar');
        use_ok('Tree::AVL');
	use_ok('AI::Pathfinding::SMAstar::Examples::PalUtils');
	use_ok('AI::Pathfinding::SMAstar::Examples::WordObj');
	use_ok('AI::Pathfinding::SMAstar::Examples::Phrase');