AI-Pathfinding-SMAstar
view release on metacpan or search on metacpan
lib/AI/Pathfinding/SMAstar.pm view on Meta::CPAN
# 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){
lib/AI/Pathfinding/SMAstar.pm view on Meta::CPAN
}
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{
lib/AI/Pathfinding/SMAstar/AVLQueue.pm view on Meta::CPAN
sub get_size{
my ($self) = @_;
my $avltree = $self->{_avltree};
my $size = $avltree->get_size();
return $size;
}
sub print{
my ($self, $delim) = @_;
my @tree_elts = $self->{_avltree}->get_list();
foreach my $obj (@tree_elts){
print $obj->{_start_word} . ", " . $obj->{_phrase} . ", " . $obj->{_queue_counter} . "\n";
}
print "\n\nobj_counts_tree:\n";
$self->{_obj_counts_tree}->print("*");
my $iterator = $self->{_obj_counts_tree}->get_keys_iterator();
print "\n\niterator keys:\n";
while(defined(my $key = $iterator->())){
print "iterator key: $key\n";
}
}
1;
lib/AI/Pathfinding/SMAstar/Examples/PalUtils.pm view on Meta::CPAN
{ my %memo_cache;
sub word_collision_memo
{
my ($word,
$sorted_letters_seen) = @_;
my $sorted_letters_seen_str = join('', @$sorted_letters_seen);
my $memo_key = $word . $sorted_letters_seen_str;
#print "sorted_letters_seen_str: $sorted_letters_seen_str\n";
if($memo_cache{$memo_key}){
return @{$memo_cache{$memo_key}};
}
else{
my @letters = split('', $word);
my @difference = ();
my %letters_hash = ();
my %letters_seen_hash = ();
lib/AI/Pathfinding/SMAstar/Examples/PalUtils.pm view on Meta::CPAN
{
my ($word, $dictionary_rev) = @_;
my $cand = AI::Pathfinding::SMAstar::Examples::WordObj->new(
_word => $word
);
my $cache_key = $word . $dictionary_rev;
my $cached_vals = $memo_hash_ref->{$cache_key};
if($cached_vals){
#print $spaces . "DING DING DING. cache hit!\n";
return @$cached_vals;
}
else{
my @substr_cands = get_substrs_memo($word, $dictionary_rev);
my @superstr_cands = $dictionary_rev->acc_lookup_memo($cand,
\&AI::Pathfinding::SMAstar::Examples::WordObj::compare_up_to,
\&AI::Pathfinding::SMAstar::Examples::WordObj::compare);
my @cands = (@substr_cands, @superstr_cands);
lib/AI/Pathfinding/SMAstar/Examples/PalUtils.pm view on Meta::CPAN
{
my ($word, $dictionary) = @_;
my @words;
my @matches;
my $cache_key = $word . $dictionary;
my $cached_vals = $memo_hash_ref->{$cache_key};
if($cached_vals1){
#print $spaces . "DING DING DING. cache hit!\n";
return @$cached_vals;
}
else{
for(my $i = 1; $i < length($word); $i++){
push(@words, substr($word, 0, $i));
}
foreach my $substring (@words){
#print "looking for matches on: \"$substring\"\n";
my $cand = AI::Pathfinding::SMAstar::Examples::WordObj->new(
_word => $substring
);
my $match_word = $dictionary->lookup($cand, \&AI::Pathfinding::SMAstar::Examples::WordObj::compare);
if($match_word){
# print "FOUND A MATCH: $match_word\n";
push(@matches, $match_word);
}
}
#print "no hashed value yet, creating one.\n";
$memo_hash_ref->{$cache_key} = \@matches;
return @matches;
}
}
}
sub get_substrs
{
my ($word, $dictionary) = @_;
my @words;
my @matches;
for(my $i = 1; $i < length($word); $i++){
push(@words, substr($word, 0, $i));
}
foreach my $substring (@words){
#print "looking for matches on: \"$substring\"\n";
my $cand = AI::Pathfinding::SMAstar::Examples::WordObj->new(
_word => $substring
);
my $match_word = $dictionary->lookup($cand, \&AI::Pathfinding::SMAstar::Examples::WordObj::compare);
if($match_word){
# print "FOUND A MATCH: $match_word\n";
push(@matches, $match_word);
}
}
return @matches;
}
# randomize an array. Accepts a reference to an array.
lib/AI/Pathfinding/SMAstar/Examples/PalUtils.pm view on Meta::CPAN
}
elsif($state == 2){
$spinny_thing = "|";
}
elsif($state == 3){
$spinny_thing = "/";
}
my ($progress) = @_;
my $stars = '*' x int($progress*10);
my $percent = sprintf("%.2f", $progress*100);
$percent = $percent >= 100 ? '100.00%' : $percent.'%';
print("\r$stars $spinny_thing $percent.");
flush(STDOUT);
}
}
sub show_search_depth_and_percentage {
my ($depth, $so_far, $total) = @_;
my $stars = '*' x int($depth);
my $amount_completed = $so_far/$total;
my $percentage = sprintf("%0.2f", $amount_completed*100);
print("\r$stars depth: $depth. completed: $percentage %");
flush(STDOUT);
}
sub show_search_depth_and_num_states {
my ($depth, $states) = @_;
my $stars = '*' x int($depth);
my $num_states = @$states;
print("\rdepth: $depth. num_states: $num_states");
flush(STDOUT);
}
{my $LINES=`tput lines`; # number of rows in current terminal window
my $COLUMNS=`tput cols`; # number of columns in current terminal window
sub show_progress_so_far {
my ($iteration, $num_states, $str, $opt_datum, $opt_datum2) = @_;
my $stars = '*' x int($iteration);
# print "\e[H"; # Put the cursor on the first line
# print "\e[J"; # Clear from cursor to end of screen
# print "\e[H\e[J"; # Clear entire screen (just a combination of the above)
# print "\e[K"; # Clear to end of current line (as stated previously)
# print "\e[m"; # Turn off character attributes (eg. colors)
# printf "\e[%dm", $N; # Set color to $N (for values of 30-37, or 100-107)
# printf "\e[%d;%dH", $R, $C; # Put cursor at row $R, column $C (good for "drawing")
#print "\e[H\e[J"; #clears the entire screen
printf "\e[%d;%dH", $LINES-1, 1; # Put cursor at row $R, column $C (good for "drawing")
print "\e[J"; #clears to end of screen
if($num_states > $max_nodes_in_mem){
$max_nodes_in_mem = $num_states;
}
print "\riteration: $iteration, num_states_in_memory: $num_states, max_states_in_mem: $max_nodes_in_mem\n";
printf "\e[%d;%dH", $LINES, 1; # Put cursor at row $R, column $C (good for "drawing")
print "\e[J"; #clears to end of screen
print "string: $str\e[J";
flush(STDOUT);
}
}
sub show_search_depth_and_num_states_debug {
}
{my $LINES=`tput lines`; # number of rows in current terminal window
my $COLUMNS=`tput cols`; # number of columns in current terminal window
sub show_progress_so_far_debug {
my ($depth, $prog, $num_states, $str, $num_successors) = @_;
my $stars = '*' x int($depth);
print "depth: $depth, string: $str, num_successors: $num_successors\n";
flush(STDOUT);
}
}
lib/AI/Pathfinding/SMAstar/Examples/Phrase.pm view on Meta::CPAN
_repeated_pal_hash_ref => $repeated_pal_hash_ref,
_letters_seen => \@sorted_letters_seen,
_cost => $newcost,
_cost_so_far => $new_cost_so_far,
_num_chars_so_far => $new_num_chars_so_far,
_num_new_chars => $num_new_chars,
_no_match_remainder => 1,
_depth => $depth+1,
);
#print "returning new phrase from first cond.\n";
$new_phrase->{_phrase} = $new_phrase->roll_up_phrase();
return $new_phrase;
}
else{
my $c = shift(@cands);
if(!$c){
return;
}
lib/AI/Pathfinding/SMAstar/Examples/Phrase.pm view on Meta::CPAN
# ------------- filter for repeated palcands for a particular word------
# ----------------------------------------------------------------------
# This will avoid many repeated patterns among palindromes to trim down the
# number redundant palindromes generated.
#
my $letters_seen_str = join("", @{$phrase_obj->{_letters_seen}});
if($letters_seen_str){
my $repeated_pal_hash_key;
$repeated_pal_hash_key = $word . "^" . $c . "^" . $letters_seen_str;
#print "\n\nrepeated_pal_hash_key: $repeated_pal_hash_key\n";
if(my $hash_val = $repeated_pal_hash_ref->{$repeated_pal_hash_key}){
# skip because '$word' <--> '$p' pattern has already appeared in a previous palindrome.
if($hash_val != $depth){
goto LABEL1;
# next; # skip
}
}
else{
#flag this candidate as already having been tested (below).
$repeated_pal_hash_ref->{$repeated_pal_hash_key} = $depth;
lib/AI/Pathfinding/SMAstar/Examples/Phrase.pm view on Meta::CPAN
_predecessor => $phrase_obj,
_dir => $new_direction,
_repeated_pal_hash_ref => $repeated_pal_hash_ref,
_letters_seen => \@sorted_letters_seen,
_cost => $newcost,
_cost_so_far => $new_cost_so_far,
_num_chars_so_far => $new_num_chars_so_far,
_num_new_chars => $num_new_chars,
_depth => $depth+1,
);
#print "returning new phrase from second cond.\n";
$new_phrase->{_phrase} = $new_phrase->roll_up_phrase();
return $new_phrase;
}
else{
#
# There is no match_remainder, so this candidate is the reverse
# of $word, or the phrase built so far is an "even" palindrome,
# i.e. it has a word boundary (space) in the middle.
#
#
lib/AI/Pathfinding/SMAstar/Examples/Phrase.pm view on Meta::CPAN
_repeated_pal_hash_ref => $repeated_pal_hash_ref,
_letters_seen => \@sorted_letters_seen,
_cost => $newcost,
_cost_so_far => $new_cost_so_far,
_num_chars_so_far => $new_num_chars_so_far,
_num_new_chars => $num_new_chars,
_no_match_remainder => 1,
_depth => $depth+1,
);
#print "returning new phrase from third cond.\n";
$new_phrase->{_phrase} = $new_phrase->roll_up_phrase();
return $new_phrase;
}
}
}
}
lib/AI/Pathfinding/SMAstar/Examples/Phrase.pm view on Meta::CPAN
# ------------- filter for repeated palcands for a particular word------
# ----------------------------------------------------------------------
# This will avoid many repeated patterns among palindromes to trim down the
# number redundant palindromes generated.
#
my $letters_seen_str = join("", @{$phrase_obj->{_letters_seen}});
if($letters_seen_str){
my $repeated_pal_hash_key;
$repeated_pal_hash_key = $word . "^" . $c . "^" . $letters_seen_str;
#print "\n\nrepeated_pal_hash_key: $repeated_pal_hash_key\n";
if(my $hash_val = $repeated_pal_hash_ref->{$repeated_pal_hash_key}){
# skip because '$word' <--> '$p' pattern has already appeared in a previous palindrome.
if($hash_val != $depth){
next; #skip
}
}
else{
#flag this candidate as already having been tested (below).
$repeated_pal_hash_ref->{$repeated_pal_hash_key} = $depth;
}
lib/AI/Pathfinding/SMAstar/Examples/Phrase.pm view on Meta::CPAN
# ------------- filter for repeated palcands for a particular word------
# ----------------------------------------------------------------------
# This will avoid many repeated patterns among palindromes to trim down the
# number redundant palindromes generated.
#
my $letters_seen_str = join("", @{$phrase_obj->{_letters_seen}});
if($letters_seen_str){
my $repeated_pal_hash_key;
$repeated_pal_hash_key = $word . "^" . $c . "^" . $letters_seen_str;
#print "\n\nrepeated_pal_hash_key: $repeated_pal_hash_key\n";
if(my $hash_val = $repeated_pal_hash_ref->{$repeated_pal_hash_key}){
# skip because '$word' <--> '$p' pattern has already appeared in a previous palindrome.
if($hash_val != $depth){
goto LABEL;
# next; #skip
}
}
else{
#flag this candidate as already having been tested (below).
$repeated_pal_hash_ref->{$repeated_pal_hash_key} = $depth;
lib/AI/Pathfinding/SMAstar/Examples/Phrase.pm view on Meta::CPAN
my ($pkg, $filename, $line_num) = caller();
if($self->{_predecessor}){
$antecedent = $self->{_predecessor};
$ant_phrase = $antecedent->{_phrase} ? $antecedent->{_phrase} : $antecedent->{_start_word};
}
else{
$antecedent->{_phrase} = "none";
}
# print " $line_num, destroying phrase object $self, '" . $self->{_start_word} . ", " . $self->{_phrase} .
# "', parent is $antecedent: '" . $ant_phrase . "' \n";
# if($line_num != 0){ # if not final sweep at program exit
# print " caller is: $pkg, $filename, $line_num\n";
# }
if($line_num == 0){ # line_num is zero
$d++;
# print "\$d : $d\n";
}
#${$self->{_predecessor}} = 0;
#${$self->{_descendants_list}} = 0;
delete $self->{_predecessor};
}
lib/AI/Pathfinding/SMAstar/PairObj.pm view on Meta::CPAN
}
return 1;
}
sub fp_equal {
my ($self, $A, $B, $dp) = @_;
return sprintf("%.${dp}g", $A) eq sprintf("%.${dp}g", $B);
}
1; # so the require or use succeeds
lib/AI/Pathfinding/SMAstar/PriorityQueue.pm view on Meta::CPAN
}
$self->{_size} = $self->{_size} + 1;
my $antecedent = $pobj->{_antecedent};
if($antecedent){
$antecedent->{_descendants_on_queue} = $antecedent->{_descendants_on_queue} + 1;
}
$pobj->is_on_queue(1);
}
sub print_trees_in_order
{
my ($self) = @_;
my $cost_hash_ref = $self->{_hash_of_trees_ref};
for my $cost_key (keys %$cost_hash_ref){
if(!$cost_hash_ref->{$cost_key}){
# no tree for this depth.
#print "no tree at key $depth_key\n";
}
else{
#print "contents of tree with depth $depth_key\n";
my $avltree = $cost_hash_ref->{$cost_key};
$$avltree->print();
}
}
}
#-----------------------------------
# get_list
#
# return a list of all objects in queue
#
lib/AI/Pathfinding/SMAstar/PriorityQueue.pm view on Meta::CPAN
last;
}
}
# if no non-zero depths, find the next highest key and loop back
my $next_highest_cost_key;
if($least_depth == 0){
$next_highest_cost_key = next_largest_element(\@cost_keys, $highest_cost_key);
$highest_cost_key = $next_highest_cost_key;
if(!$highest_cost_key){
print "no highest_cost_key found\n";
exit;
}
}
else{ # least depth is non-zero, so it's good
last;
}
} # Now have a good highest_cost_key, with a tree that has a good non-zero key queue somewhere in it.
lib/AI/Pathfinding/SMAstar/PriorityQueue.pm view on Meta::CPAN
}
if($obj1 < $obj2){
return -1;
}
return 1;
}
sub fp_equal {
my ($A, $B, $dp) = @_;
return sprintf("%.${dp}g", $A) eq sprintf("%.${dp}g", $B);
}
lib/AI/Pathfinding/SMAstar/TreeOfQueues.pm view on Meta::CPAN
my $fget_key = $self->{f_obj_get_key};
my $avl_compare = $self->{f_avl_compare};
my $key = $obj->$fget_key();
my $queue = AI::Pathfinding::SMAstar::AVLQueue->new(_key => $key);
my $avltree = \$self->{_avl_tree};
my $found_queue = $self->{_avl_tree}->lookup_obj($queue);
if(!$found_queue){
# print "TreeOfQueues::remove: did not find queue with key $key\n";
# $self->{_avl_tree}->print();
}
else { # found a queue here. remove obj
#print "TreeOfQueues::remove: found queue, removing obj using $cmp_func\n";
$found_queue->remove($obj, $cmp_func);
if($found_queue->is_empty()){
#print "TreeOfQueues::remove: found queue is now empty, removing queue from tree\n";
$$avltree->remove($found_queue);
}
}
}
sub largest_oldest{
my ($self) = @_;
my $avltree = \$self->{_avl_tree};
# $$avltree->print("-");
# get the avl tree with the largest key
my $queue = $$avltree->largest();
if($queue){
my $key = $queue->key();
my $obj = $queue->top();
return $obj;
}
else{
return;
}
}
sub pop_largest_oldest{
my ($self) = @_;
my $avltree = \$self->{_avl_tree};
# $$avltree->print("*");
# get the avl tree with the largest key
my $queue = $$avltree->largest();
if($queue){
my $key = $queue->key();
my $obj = $queue->pop_top();
if($queue->is_empty()){
$$avltree->remove($queue);
}
lib/AI/Pathfinding/SMAstar/TreeOfQueues.pm view on Meta::CPAN
}
else{
return;
}
}
sub smallest_oldest{
my ($self) = @_;
my $avltree = \$self->{_avl_tree};
# $$avltree->print("-");
# get the avl tree with the largest key
my $queue = $$avltree->smallest();
if($queue){
my $key = $queue->key();
my $obj = $queue->top();
return $obj;
}
else{
return;
}
}
sub pop_smallest_oldest{
my ($self) = @_;
my $avltree = \$self->{_avl_tree};
# $$avltree->print("*");
# get the avl tree with the largest key
my $queue = $$avltree->smallest();
if($queue){
my $key = $queue->key();
my $obj = $queue->pop_top();
if($queue->is_empty()){
$$avltree->remove($queue);
}
lib/AI/Pathfinding/SMAstar/TreeOfQueues.pm view on Meta::CPAN
sub pop_oldest_at{
my ($self, $key) = @_;
my $avltree = \$self->{_avl_tree};
my $queue_to_find = AI::Pathfinding::SMAstar::AVLQueue->new(_key => $key);
my $queue = $$avltree->lookup_obj($queue_to_find);
if($queue){
# print "TreeOfQueues::pop_oldest_at: found queue with key: $key\n";
my $obj = $queue->pop_top();
if($queue->is_empty()){
$$avltree->remove($queue);
}
return $obj;
}
else{
# print "TreeOfQueues::pop_oldest_at: did not find queue with key: $key\n";
return;
}
}
sub oldest_at{
my ($self, $key) = @_;
my $avltree = \$self->{_avl_tree};
my $queue_to_find = AI::Pathfinding::SMAstar::AVLQueue->new(_key => $key);
my $queue = $$avltree->lookup_obj($queue_to_find);
if($queue){
# print "TreeOfQueues::oldest_at: found queue with key: $key\n";
my $obj = $queue->top();
return $obj;
}
else{
# print "TreeOfQueues::oldest_at: did not find queue with key: $key\n";
return;
}
}
sub largest{
my ($self) = @_;
my $avltree = \$self->{_avl_tree};
return $$avltree->largest();
lib/AI/Pathfinding/SMAstar/TreeOfQueues.pm view on Meta::CPAN
sub get_queue{
my ($self, $key) = @_;
my $avltree = \$self->{_avl_tree};
my $queue_to_find = AI::Pathfinding::SMAstar::AVLQueue->new(_key => $key);
my $queue = $$avltree->lookup_obj($queue_to_find);
if($queue){
# print "TreeOfQueues::get_queue: found queue with key: $key\n";
return $queue;
}
else{
# print "TreeOfQueues::get_queue: did not find queue with key: $key\n";
return;
}
}
sub get_keys_iterator
{
lib/AI/Pathfinding/SMAstar/TreeOfQueues.pm view on Meta::CPAN
sub get_keys
{
my ($self) = @_;
my $avltree = \$self->{_avl_tree};
return $$avltree->get_keys();
}
sub print{
my ($self) = @_;
if($self->{_avl_tree}->is_empty()){
print "tree is empty\n";
}
my $get_key_func = $self->{f_obj_get_key};
my $get_data_func = $self->{f_obj_get_data};
my @queue_list = $self->{_avl_tree}->get_list();
foreach my $queue (@queue_list){
#print "queue is $queue\n";
my $queue_key = $queue->key();
#print "queue key: $queue_key\n";
my @objlist = $queue->get_list();
if(!@objlist){
print "queue at key $queue_key is empty\n";
}
print "queue at key $queue_key:\n";
foreach my $obj (@objlist){
my $key = $obj->$get_key_func;
my $word = $obj->$get_data_func;
print " key: $key, data: $word\n";
}
}
}
sub is_empty{
my ($self) = @_;
if($self->{_avl_tree}->is_empty()){
return 1;
lib/AI/Pathfinding/SMAstar/TreeOfQueues.pm view on Meta::CPAN
sub get_list{
my ($self) = @_;
my @objs;
if($self->{_avl_tree}->is_empty()){
return;
}
#$self->{_avl_tree}->print(">>>");
my @queue_list = $self->{_avl_tree}->get_list();
foreach my $queue (@queue_list){
my $queue_key = $queue->key();
my @objlist = $queue->get_list();
#print "get_list: size of queue at key: $queue_key is: " . @objlist . "\n";
push(@objs, @objlist);
}
return @objs;
}
1;
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');
t/AI-Pathfinding-SMAstar.t view on Meta::CPAN
my @rev_word_objs;
my $num_words;
my $sparsity;
my $max_states_in_queue;
my %letter_freq;
my $max_word_length = 0;
my $MAX_COST = 99;
#my $collisions_per_length = PalUtils::collisions_per_length("ocid", "abo gad abalones rot abdicators enol aba dagoba");
#print "collisions: $collisions_per_length\n";
#exit;
$dictionary_file = 't/test8.lst';
$min_letters = 4;
$sparsity = 2;
$max_states_in_queue = 4;
diag("\ncreating AVL trees");
t/AI-Pathfinding-SMAstar.t view on Meta::CPAN
fget_data => \&AI::Pathfinding::SMAstar::Examples::WordObj::word,
);
my $avltree_rev = Tree::AVL->new(
fcompare => \&AI::Pathfinding::SMAstar::Examples::WordObj::compare,
fget_key => \&AI::Pathfinding::SMAstar::Examples::WordObj::word,
fget_data => \&AI::Pathfinding::SMAstar::Examples::WordObj::word,
);
print STDERR "-" x 80 . "\n";
print STDERR "-" x 80 . "\n";
diag("reading dictionary '$dictionary_file'");
eval{
($num_words, @words) = AI::Pathfinding::SMAstar::Examples::PalUtils::read_dictionary_filter_by_density($dictionary_file, $sparsity);
};
is( $@, '', '$@ is not set after object insert' );
diag("loaded words: '$num_words'");
t/AI-Pathfinding-SMAstar.t view on Meta::CPAN
$max_word_length = $length;
}
}
$num_words_filtered = @words;
diag("$num_words words in the currently loaded dictionary. Minimum letters specified = $min_letters");
diag("$num_words_filtered words that meet the initial sparsity constraint max_sparsity = $sparsity.");
if(!@words){
print STDERR "no words to process. exiting\n";
exit;
}
@word_objs = AI::Pathfinding::SMAstar::Examples::PalUtils::process_words_by_density(\@words, $sparsity);
@rev_word_objs = AI::Pathfinding::SMAstar::Examples::PalUtils::process_rev_words_by_density(\@words, $sparsity);
if(!@word_objs){
print STDERR "no words achieve density specified by max sparsity $sparsity\n";
exit;
}
$num_word_objs = @word_objs;
diag("loading avl trees.");
for (my $i = 0; $i < @word_objs; $i++) {
show_progress($i/$num_words);
my $word = $word_objs[$i]->{_word};
my $rev_word = $rev_word_objs[$i]->{_word};
$avltree->insert($word_objs[$i]);
$avltree_rev->insert($rev_word_objs[$i]);
}
show_progress(1);
print STDERR "\n";
#
# Build the words-with-candidates list. This will be used for phrases that are
# palindromes with a space in the middle position. The descendants of these
# types of palindromes are found by sort-of starting all over again... any word becomes
# a candidate for the extension of the palindrome- any word that has candidates,
# that is. By building a list of only the words that have candidates,
# the search time is greatly reduced.
#
t/AI-Pathfinding-SMAstar.t view on Meta::CPAN
diag("building words_w_cands_list.");
foreach my $w (@words){
show_progress($i/$num_words);
my @candidates = AI::Pathfinding::SMAstar::Examples::PalUtils::get_cands_from_left($w, $avltree, $avltree_rev);
if(@candidates){
push(@words_w_cands, $w);
}
$i++;
}
show_progress(1);
print STDERR "\n";
my $num_words_w_cands = @words_w_cands;
diag("number of word/candidate pairs is: $num_words_w_cands.");
$avltree_height = $avltree->get_height();
$avltree_rev_height = $avltree_rev->get_height();
diag("AVL trees loaded. Heights are $avltree_height, $avltree_rev_height\n\n");
my @phrase_obj_list;
t/AI-Pathfinding-SMAstar.t view on Meta::CPAN
#----------------------------------------------------------------------------
sub log_function
{
my ($path_obj) = @_;
if(!$path_obj){
my ($pkg, $filename, $line) = caller();
print "$pkg, $filename, $line\n";
}
my $str = "";
# $cand is the parent's word (the candidate that generated this phrase)
my $cand = "";
my $cost = "";
my $cost_so_far = "";
my $num_new_chars = "";
t/AI-Pathfinding-SMAstar.t view on Meta::CPAN
$cost_so_far = $path_obj->{_state}->{_cost_so_far};
$num_new_chars = $path_obj->{_state}->{_num_new_chars};
$num_chars_so_far = $path_obj->{_state}->{_num_chars_so_far};
$letters_seen = $path_obj->{_state}->{_letters_seen};
$letters_seen_str = join("", @$letters_seen);
$phrase = defined($path_obj->{_state}->{_phrase}) ? $path_obj->{_state}->{_phrase} : "";
$evaluation = AI::Pathfinding::SMAstar::Path::fcost($path_obj);
$depth = $path_obj->{_depth};
$num_chars_so_far = sprintf("%02d", $num_chars_so_far);
$num_new_chars = sprintf("%02d", $num_new_chars);
$cost = sprintf("%02d", $cost);
$cost_so_far = sprintf("%02d", $cost_so_far);
$depth = sprintf("%02d", $depth);
my $specifier = "%" . $max_word_length . "s";
$str = sprintf($specifier, $str);
$evaluation = sprintf("%04f", $evaluation);
$letters_seen_str = sprintf("%26s", $letters_seen_str);
my $log_str = "";
$log_str = $log_str . "depth: $depth, ";
$log_str = $log_str . "eval: $evaluation, ";
$log_str = $log_str . "letters: '$letters_seen_str', ";
$log_str = $log_str . "'$str', ";
$log_str = $log_str . "'$phrase', ";
$log_str = $log_str . "cand: $cand";
t/AI-Pathfinding-SMAstar.t view on Meta::CPAN
}
elsif($state == 2){
$spinny_thing = "|";
}
elsif($state == 3){
$spinny_thing = "/";
}
my ($progress) = @_;
my $stars = '*' x int($progress*10);
my $percent = sprintf("%.2f", $progress*100);
$percent = $percent >= 100 ? '100.00%' : $percent.'%';
print STDERR "\r$stars $spinny_thing $percent.";
flush(STDERR);
}
}
( run in 0.680 second using v1.01-cache-2.11-cpan-de7293f3b23 )