AI-Pathfinding-SMAstar

 view release on metacpan or  search on metacpan

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

################################ subroutines ################################





use Tree::AVL;
use AI::Pathfinding::SMAstar::Examples::WordObj;
package AI::Pathfinding::SMAstar::Examples::PalUtils;


my $max_nodes_in_mem = 0;

sub length_no_spaces
{
    my ($w) = @_;    
    $w =~ s/\ //g;
    return length($w);
}



sub get_word_number_of_letters_that_have_repeats
{
    my ($word) = @_;    
    my @letters = split('', $word);
    my %letters_hash = ();

    foreach my $element (@letters) { $letters_hash{$element}++ }

    my $repeated_letters = 0;
    foreach my $element (keys %letters_hash){
	if($letters_hash{$element} > 1){
	    $repeated_letters++;
	}
    }
    
    return $repeated_letters;
}


#
# finds the number of times each letter appears within
# an entire list of words.   returns a hash of the letters
#
sub find_letter_frequencies
{
    my (@words) = @_;
    my %letters_freq;

    foreach my $w (@words)
    {
	@letters = split('', $w); 
	
	foreach my $l (@letters)
	{
	    $letters_freq{$l}++;
	}
    }

    return %letters_freq;
}


sub collisions_per_length
{
    my ($w, $phrase) = @_;

    if(!$w){ $w = "" }
    if(!$phrase){ $phrase = "" }


    my $length = length($w);
    $phrase =~ s/ //g;
    my @letters = split('', $w); 
    my @letters_seen = split('', $phrase); 
    my $collisions = 0;
    foreach my $l (@letters){	
	foreach my $ls (@letters_seen){
	    if($l eq $ls){
		$collisions++;
	    }
	}
    }
    my $val = $collisions/$length;

    return $val;
}




sub get_word_sparsity
{
    my ($word) = @_; 

    my $length = length($word);
    my $num_letters = num_chars_in_word_memo($word);

    my $sparseness = $length - $num_letters;

    return $sparseness;
}


{ my %memo_cache;
sub get_word_sparsity_memo
{
    my ($word) = @_; 

    if($memo_cache{$word}){
	return $memo_cache{$word};
    }
    else{
	my $length = length($word);
	my $num_letters = num_chars_in_word_memo($word);
	
	my $sparseness = $length - $num_letters;
	
	$memo_cache{$word} = $sparseness;
	return $sparseness;
    }
}
}


# get the highest number of times a letter 
# is repeated within a word.
sub get_word_highest_frequency
{
    my ($word) = @_;    
    my @letters = split('', $word);
    my %letters_hash = ();

    foreach my $element (@letters) { $letters_hash{$element}++ }

    my $most_frequent_letter_freq = 0;
    foreach my $element (keys %letters_hash){
	if($letters_hash{$element} > $most_frequent_letter_freq){
	    $most_frequent_letter_freq = $letters_hash{$element};
	}
    }    
    return $most_frequent_letter_freq;
}




sub get_letters
{
    my ($word) = @_;
    my @letter_set = ();
    my %letters_hash = ();
    my @letters = split('', $word);

    foreach my $element (@letters) { $letters_hash{$element}++ }

    foreach my $element (keys %letters_hash)
    {
	push(@letter_set, $element);
    }
    return @letter_set;
}



{ 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}){

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

    my @sorted_cands = sort(@cands);
    return @sorted_cands;
}


{my $memo_hash_ref  = {}; 
 sub get_cands_memo
 {
     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); 
	 # these are all the words in the dictionary that could end this pal.
	 $memo_hash_ref->{$cache_key} = \@cands;
	 return @cands;
     }
 }
}

sub get_cands
{
    my ($word, $dictionary_rev) = @_;    
    
    my $cand = AI::Pathfinding::SMAstar::Examples::WordObj->new(
	_word => $word
	);

    my @substr_cands = get_substrs_memo($word, $dictionary_rev);
    my @superstr_cands = $dictionary_rev->acc_lookup($cand, 
						     \&AI::Pathfinding::SMAstar::Examples::WordObj::compare_up_to, 
						     \&AI::Pathfinding::SMAstar::Examples::WordObj::compare);        
    my @cands = (@substr_cands, @superstr_cands); 
    # these are all the words in the dictionary that could end this pal.
    return @cands;
}


sub match_remainder
{
    my ($word1, $word2) = @_;
   
    $word1 =~ s/\ //g;
    $word2 =~ s/\ //g;

    my $len1 = length($word1);
    my $len2 = length($word2);

    if(index($word1, $word2) != 0)
    {
	return;
    }
    my $remainder_word = substr($word1, $len2);
    return $remainder_word;
}



#
# memoized version of get_substrs-  for speed
#
{my $memo_hash_ref = {};
sub get_substrs_memo
{
    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.
sub fisher_yates_shuffle {
    my ($array) = @_;
    my $i;
    for ($i = @$array; --$i; ) {
        my $j = int rand ($i+1);
        next if $i == $j;
        @$array[$i,$j] = @$array[$j,$i];
    }
}

sub process_words
{
    my ($words) = @_;	
    my @word_objs;
    
    for(my $i = 0; $i < @$words; $i++) 
    {       
	my $word = $words->[$i];
	chomp($word);

	$word_objs[$i] = AI::Pathfinding::SMAstar::Examples::WordObj->new(
	    _word => $word,
	   
	    );		
    }
    return @word_objs;
}

sub process_words_by_density
{
    my ($words, 
	$max_score # 0:  no repeats, 1: 1 repeat, etc.
	) = @_;
    
    my @word_objs;
    
    my $i = 0;
    foreach my $word (@$words)

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

    return($candidate eq reverse($candidate));
}

sub join_strings
{
    my ($strings) = @_;
    my $candidate = join(' ', @$strings);
    
    return $candidate;    
}

sub make_one_word
{
    my ($phrase) = @_;    
    $phrase =~ s/\s//g;  
    return $phrase;
}


sub num_chars_in_word
{
    my ($word) = @_;
    my %hash;
    
    if(!$word) { return 0; }
    
    @hash{ split '', $word} = 1;
    my $num_keys = keys(%hash);
    
    return $num_keys;
}


{my %memo_cache;
sub num_chars_in_word_memo
{
    my ($word) = @_;

    if($memo_cache{$word}){	
	return $memo_cache{$word};		
    }
    else{
	my %hash;
	@hash{ split '', $word} = 1;
	my $num_keys = keys(%hash);
	
	$memo_cache{$word} = $num_keys;
	return $num_keys;
    }
}
}


{my %memo_cache;
sub num_chars_in_pal
{
    my ($pal) = @_;    
    my $num_keys;

    $pal =~ s/\ //g;
    my $length = length($pal);
    my $first_half = substr($pal, 0, $length/2 + 1);


    if($memo_cache{$first_half}){	
	return $memo_cache{$first_half};		
    }
    else{

	my %hash;
	@hash{ split '', $first_half } = 1;
	$num_keys = keys(%hash);
	
	$memo_cache{$pal} = $num_keys;
	return $num_keys;
    }
}
}

sub read_dictionary
{
    my ($in_file) = @_;
    
    unless(open(READF, "+<$in_file")){	
	return;
    }
	
    my @lines = <READF>;
       
    close(READF);
    
    return @lines;
}

sub read_dictionary_filter_by_density
{
    my ($in_file, $max_score) = @_;
    
    unless(open(READF, "+<$in_file")){	
	return;
    }
	
    my @lines = <READF>;
    my $num_lines = @lines;
       
    close(READF);

    my @filtered_words;
    
    my $i = 0;
    foreach my $word (@lines)
    {       	
	chomp($word);	
	my $sparsity = get_word_sparsity($word);

	if($sparsity <= $max_score){	  
	    $filtered_words[$i] = $word;			
	    $i++;
	}	
    }

    return ($num_lines, @filtered_words);