view release on metacpan or  search on metacpan

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

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