AI-Pathfinding-SMAstar
view release on metacpan or search on metacpan
lib/AI/Pathfinding/SMAstar/Examples/Phrase.pm view on Meta::CPAN
my ($word_intersect, @differences) = AI::Pathfinding::SMAstar::Examples::PalUtils::word_collision($w,
\@sorted_letters_seen);
my $num_new_chars = $num_chars - $word_intersect;
#my $newcost = $collisions_per_length + $sparsity;
my $newcost = $collisions_per_length + $len_w;
my $new_cost_so_far = $cost + $cost_so_far;
#---------------------------------------------------------------------------
my $new_phrase = AI::Pathfinding::SMAstar::Examples::Phrase->new(
_word_list => $words,
#_words_w_cands_list => \@words_to_make_phrases,
_words_w_cands_list => $words_w_cands,
_dictionary => $dictionary,
_dictionary_rev => $dictionary_rev,
_start_word => $w,
_cand => $stored_c,
_word => $w,
_predecessor => $phrase_obj,
_dir => 0,
_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;
}
# ------------- 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;
}
}
#--------------------------------------------------------------------------
#--------------------------------------------------------------------------
my $len_c = length($c);
my $rev_c = reverse($c);
my $word_remainder;
if($len_c < $len_word){
$word_remainder = $c;
}
elsif($len_c > $len_word){
$word_remainder = $word;
}
my $rev_word_remainder = reverse($word);
my $num_cands = @cands;
my $match_remainder;
my $len_match_remainder;
my $newcost;
my $new_cost_so_far;
my $num_new_chars;
my $new_direction;
if($direction == 0){
if($len_c < $len_word){
$match_remainder = AI::Pathfinding::SMAstar::Examples::PalUtils::match_remainder($word, $rev_c);
$new_direction = 0;
}
elsif($len_c > $len_word){
$match_remainder = AI::Pathfinding::SMAstar::Examples::PalUtils::match_remainder($rev_c, $word);
$match_remainder = reverse($match_remainder);
$new_direction = 1;
}
}
elsif($direction == 1){
if($len_c < $len_word){
$match_remainder = AI::Pathfinding::SMAstar::Examples::PalUtils::match_remainder($rev_word, $c);
$match_remainder = reverse($match_remainder);
$new_direction = 1;
}
elsif($len_c > $len_word){
$match_remainder = AI::Pathfinding::SMAstar::Examples::PalUtils::match_remainder($c, $rev_word);
$new_direction = 0;
}
}
$len_match_remainder = defined($match_remainder) ? length($match_remainder) : 0;
#----------------Compute the Cost-------------------------------------------
if($len_c < $len_word){
$num_new_chars = 0;
$newcost = 0; # new candidate is a (reversed) substring of word
$new_cost_so_far = $cost + $cost_so_far;
}
elsif($len_c > $len_word){
lib/AI/Pathfinding/SMAstar/Examples/Phrase.pm view on Meta::CPAN
my @words_to_make_phrases;
my $stored_c;
my $num_successors = 0;
while(1){
# this is a continuation of the second case below, where there were no
# match-remainders for the phrase-so-far, i.e. the palindrome has a space
# in the middle with mirrored phrases on each side. 'cat tac' for example.
my $next_word = shift(@words_to_make_phrases);
if($next_word){
my $w = $next_word;
my $repeated_word_p = 0;
my $antecedent = $phrase_obj->{_predecessor};
my $antecedent_dir = $antecedent->{_dir};
while($antecedent){
if(defined($antecedent->{_word}) && $w eq $antecedent->{_word} && $antecedent_dir == 0){
$repeated_word_p = 1;
last;
}
$antecedent = $antecedent->{_predecessor};
if($antecedent){
$antecedent_dir = $antecedent->{_dir};
}
}
if($repeated_word_p || $w eq $word){
next; #skip this word, we are already looking at it
}
$num_successors++;
}
else{
my $c = shift(@cands);
if(!$c){
return $num_successors;
}
# ------------- 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;
}
}
#--------------------------------------------------------------------------
#--------------------------------------------------------------------------
my $len_c = length($c);
my $rev_c = reverse($c);
my $word_remainder;
if($len_c < $len_word){
$word_remainder = $c;
}
elsif($len_c > $len_word){
$word_remainder = $word;
}
my $rev_word_remainder = reverse($word);
my $num_cands = @cands;
my $match_remainder;
my $len_match_remainder;
if($len_c != $len_word){
$match_remainder = 1;
}
if($match_remainder){ # there is a length difference between the candidate and this word.
$num_successors++;
}
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.
#
#
# This is a special case since there is no match remainder.
# Because there is no remainder to create new phrase obj from, this
# section goes through the whole word list and creates phrase objects
# for each new word. The number of new characters offered by each
# word is recorded to help with guided search.
#
# Update: this case now only goes through the word list for which there
# are cands.
@words_to_make_phrases = @$words_w_cands;
#@words_to_make_phrases = @$words;
$stored_c = $c;
my $next_word = shift(@words_to_make_phrases);
my $w = $next_word;
my $repeated_word_p = 0;
my $antecedent = $phrase_obj->{_predecessor};
my $antecedent_dir = $antecedent->{_dir};
lib/AI/Pathfinding/SMAstar/Examples/Phrase.pm view on Meta::CPAN
my $stored_c;
return sub{
LABEL:
# this is a continuation of the second case below, where there were no
# match-remainders for the phrase-so-far, i.e. the palindrome has a space
# in the middle with mirrored phrases on each side. 'cat tac' for example.
my $next_word = shift(@words_to_make_phrases);
if($next_word){
my $w = $next_word;
my $repeated_word_p = 0;
my $antecedent = $phrase_obj->{_predecessor};
my $antecedent_dir = $antecedent->{_dir};
while($antecedent){
if(defined($antecedent->{_word}) && $w eq $antecedent->{_word} && $antecedent_dir == 0){
$repeated_word_p = 1;
last;
}
$antecedent = $antecedent->{_predecessor};
if($antecedent){
$antecedent_dir = $antecedent->{_dir};
}
}
if($repeated_word_p || $w eq $word){
goto LABEL;
#next; #skip this word, we are already looking at it
}
return 1;
}
else{
my $c = shift(@cands);
if(!$c){
return;
}
# ------------- 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;
}
}
#--------------------------------------------------------------------------
#--------------------------------------------------------------------------
my $len_c = length($c);
my $rev_c = reverse($c);
my $word_remainder;
if($len_c < $len_word){
$word_remainder = $c;
}
elsif($len_c > $len_word){
$word_remainder = $word;
}
my $rev_word_remainder = reverse($word);
my $num_cands = @cands;
my $match_remainder;
my $len_match_remainder;
if($len_c != $len_word){
$match_remainder = 1;
}
if($match_remainder){ # there is a length difference between the candidate and this word.
return 1;
}
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.
#
#
# This is a special case since there is no match remainder.
# Because there is no remainder to create new phrase obj from, this
# section goes through the whole word list and creates phrase objects
# for each new word. The number of new characters offered by each
# word is recorded to help with guided search.
#
# Update: this case now only goes through the word list for which there
# are cands.
@words_to_make_phrases = @$words_w_cands;
#@words_to_make_phrases = @$words;
$stored_c = $c;
my $next_word = shift(@words_to_make_phrases);
my $w = $next_word;
my $repeated_word_p = 0;
my $antecedent = $phrase_obj->{_predecessor};
my $antecedent_dir = $antecedent->{_dir};
( run in 1.077 second using v1.01-cache-2.11-cpan-7fcb06a456a )