view release on metacpan or  search on metacpan

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

                         $max_cost,
	);
}



#################################################################
#
#  SMAstar search
#  Memory-bounded A* search
#
#
#################################################################
sub sma_star_tree_search
{
   
    my ($priority_queue,
	$goal_p,
	$successors_func,
	$eval_func,
	$backup_func,
	$log_function, # debug string func;  represent state object as a string.
	$str_function,
	$prog_function,
	$show_prog_func,
	$max_states_in_queue,
	$max_cost,
	) = @_;
    
    my $iteration = 0;
    my $num_states_in_queue = $$priority_queue->size();
    my $max_extra_states_in_queue = $max_states_in_queue;
    $max_states_in_queue = $num_states_in_queue + $max_extra_states_in_queue;    
    my $max_depth = ($max_states_in_queue - $num_states_in_queue);

    my $best; # the best candidate for expansion


    
    if($$priority_queue->is_empty() || !$$priority_queue){
	return;
    }
    else{
	my $num_successors = 0;
	
	# loop over the elements in the priority queue
	while(!$$priority_queue->is_empty()){
	    
	    # determine the current size of the queue
	    my $num_states_in_queue = $$priority_queue->{_size};
	    # get the best candidate for expansion from the queue
	    $best = $$priority_queue->deepest_lowest_cost_leaf_dont_remove();
    
	    #------------------------------------------------------
	    if(!$DEBUG){
		my $str = $log_function->($best);		 
		$show_prog_func->($iteration, $num_states_in_queue, $str);		    
	    }
	    else{	
		my $str = $log_function->($best);
		print "best is: " . $str_function->($best) . ", cost: " . $best->{_f_cost}  . "\n";
	    }
	    #------------------------------------------------------


	    if($best->$goal_p()) {			
		# goal achieved! iteration: $iteration, number of 
		# states in queue: $num_states_in_queue.
		return $best; 
	    }
	    elsif($best->{_f_cost} >= $max_cost){
		croak "\n\nSearch unsuccessful.  max_cost reached (cost:  $max_cost).\n";
	    }
	    else{	    
		my $successors_iterator = $best->$successors_func();		
		my $succ = $successors_iterator->();
			
		if($succ){
		    # if succ is at max depth and is not a goal node, set succ->fcost to infinity 
		    if($succ->depth() >= $max_depth && !$succ->$goal_p() ){                       
			$succ->{_f_cost} = $max_cost;                                                    
		    }                                                                             
		    else{                 
			# calling eval for comparison, and maintaining pathmax property		
			$succ->{_f_cost} = max($eval_func->($succ), $eval_func->($best));	
			my $descendant_index = $succ->{_descendant_index};
			$best->{_descendant_fcosts}->[$descendant_index] = $succ->{_f_cost};
		    }           
		}

		# determine if $best is completed, and if so backup values
		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; 

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

			if($antecedent){
			    $antecedent->{_descendants_produced}->[$descendant_index] = 0;			   
			}
		    }
		}
		
	        # there are no more successors of $best
		if(!$succ){ 
		    next;
		}

		my $antecedent;
		my @antecedents_that_need_to_be_inserted;

		# If the maximum number of states in the queue has been reached,
		# we need to remove the shallowest-highest-cost leaf to make room 
		# for more nodes.   That means we have to make sure that the antecedent
		# produces this descendant again at some point in the future if needed.
		if($num_states_in_queue > $max_states_in_queue){
		    my $shcl_obj = $$priority_queue->shallowest_highest_cost_leaf($best, $succ, $str_function);	

		    if(!$shcl_obj){
			croak "Error while pruning queue:   shallowest-highest-cost-leaf was null\n";	
		    }
		    $antecedent = $shcl_obj->{_antecedent};
		    if($antecedent){		
			my $antecedent_successors = \$antecedent->{_descendants_list};

			$antecedent->remember_forgotten_nodes_fcost($shcl_obj);
			$antecedent->{_forgotten_nodes_num} = $antecedent->{_forgotten_nodes_num} + 1;
			my $descendant_index = $shcl_obj->{_descendant_index};
		        # record the index of this descendant in the forgotten_nodes list
			$antecedent->{_forgotten_nodes_offsets}->{$descendant_index} = 1;			
			# flag the antecedent as not having this descendant in the queue
			$antecedent->{_descendants_produced}->[$descendant_index] = 0;
			$antecedent->{_descendant_fcosts}->[$descendant_index] = -1;		
			# flag the ancestor node as having deleted a descendant
			$antecedent->descendants_deleted(1);
			# update the number of descendants this node has in memory
			$antecedent->{_num_successors_in_mem} = $antecedent->{_num_successors_in_mem} - 1;				     
			# update the total number of nodes in the queue.
			$num_states_in_queue--;
			
		    }
		} # end if (num_states_on_queue > max_states)

		# if there is a successor to $best, insert it in the priority queue.
		if($succ){
		    $$priority_queue->insert($succ);
		    $best->{_num_successors_in_mem} = $best->{_num_successors_in_mem} + 1;
		}
		else{
		    croak "Error:  no successor to insert\n";
		}
	    }
	}
	continue {
	    $iteration++;
	}

	print "\n\nreturning unsuccessfully.   iteration: $iteration\n";	
	return;
    }
}    




sub max
{
    my ($n1, $n2) = @_;
    return ($n1 > $n2 ? $n1 : $n2);
}


sub fp_compare {
    my ($a, $b, $dp) = @_;
    my $a_seq = sprintf("%.${dp}g", $a);
    my $b_seq = sprintf("%.${dp}g", $b);
    
    

    if($a_seq eq $b_seq){
	return 0;
    }
    elsif($a_seq lt $b_seq){
	return -1;
    }
    else{ 
	return 1;
    }
}





1;
__END__
# Below is stub documentation for your module. You'd better edit it!

=head1 NAME

AI::Pathfinding::SMAstar - Simplified Memory-bounded A* Search


=head1 SYNOPSIS

 use AI::Pathfinding::SMAstar;
  

=head2 EXAMPLE

 ##################################################################
 #
 # This example uses a hypothetical object called FrontierObj, and
 # shows the functions that the FrontierObj class must feature in 
 # order to perform a path-search in a solution space populated by 
 # FrontierObj objects.
 #
 ##################################################################
 
 my $smastar = AI::Pathfinding::SMAstar->new(
        # evaluates f(n) = g(n) + h(n), returns a number
    	_state_eval_func           => \&FrontierObj::evaluate,

        # when called on a node, returns 1 if it is a goal
	_state_goal_p_func         => \&FrontierObj::goal_test,

        # must return the number of successors of a node
        _state_num_successors_func => \&FrontierObj::get_num_successors,      

        # must return *one* successor at a time
        _state_successors_iterator => \&FrontierObj::get_successors_iterator,   

        # can be any suitable string representation 
        _state_get_data_func       => \&FrontierObj::string_representation,  

        # gets called once per iteration, useful for showing algorithm progress