view release on metacpan or  search on metacpan

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

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

		    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())){
			$best->is_completed(1);
		    }

		    my $cmp_func = sub {
			my ($str) = @_;			
			return sub{
			    my ($obj) = @_;
			    my $obj_str = $str_function->($obj);
			    if($obj_str eq $str){
				return 1;
			    }
			    else{ 
				return 0; 
			    }	    
			}
		    };			   
		    
		    my $best_str = $str_function->($best);

		    # If best is not a root node
		    if($best->{_depth} != 0){
			# descendant index is the unique index indicating which descendant
			# this node is of its antecedent.
			my $descendant_index = $best->{_descendant_index};
			my $antecedent = $best->{_antecedent};
			$$priority_queue->remove($best, $cmp_func->($best_str)); 
			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";	
		    }