added solutions

2 files changed, 130 insertions, 9 deletions

diff --git a/challenge-005/adam-russell/perl5/ch-1.pl b/challenge-005/adam-russell/perl5/ch-1.pl
index dfc66d51de..e1b0c61e0a 100644
--- a/challenge-005/adam-russell/perl5/ch-1.pl
+++ b/challenge-005/adam-russell/perl5/ch-1.pl
@@ -1,12 +1,63 @@
 use strict;
 use warnings;
+##
+# Write a program which prints out all anagrams for a given word.
+##
+use constant DICTIONARY => "/usr/share/dict/words";  
+my %word_product;
+my %letter_factor = (
+    e => 2,
+    t => 3,
+    a => 5,
+    o => 7,
+    i => 11,
+    n => 13,
+    s => 17,
+    h => 19,
+    r => 23,
+    d => 29,
+    l => 31,
+    c => 37,
+    u => 41,
+    m => 43,
+    w => 47,
+    f => 53,
+    g => 59,
+    y => 61,
+    p => 67,
+    b => 71,
+    v => 73,
+    k => 79,
+    j => 83,
+    x => 89,
+    q => 97,
+    z => 101  
+);  
 
-my $x = shift;  # some number argument
-
-for ( my $y = 2; $y <= $x; $y++ ) {
-    next if $x % $y;
-    $x /= $y;
-    print $y, "\n";
-    redo;
-}
-
+##
+# Main
+##
+my $test_word = $ARGV[0];  
+$test_word =~ tr/-//d;
+my @letters = split(//, $test_word);
+my $test_word_product = 1;
+map {$test_word_product *= $_} map{$letter_factor{$_}} @letters;
+open(WORDS, DICTIONARY);  
+while(<WORDS>){
+    chomp($_);
+    my $word = lc($_);
+    $word =~ tr/-//d;
+    @letters = split(//, $word);
+    my $product = 1;
+    map {$product *= $_} map{$letter_factor{$_}} @letters;  
+    $word_product{$word} = $product;   
+}  
+close(WORDS);
+delete($word_product{$test_word}); 
+my @anagrams = grep {$word_product{$_} == $test_word_product} keys(%word_product);   
+if(@anagrams){
+    print "$test_word: " . join(" ", @anagrams) . "\n"; 
+}   
+else{
+    print "$test_word: No anagrams found.\n";        
+}   
diff --git a/challenge-005/adam-russell/perl5/ch-2.pl b/challenge-005/adam-russell/perl5/ch-2.pl
index e69de29bb2..577e6bc354 100644
--- a/challenge-005/adam-russell/perl5/ch-2.pl
+++ b/challenge-005/adam-russell/perl5/ch-2.pl
@@ -0,0 +1,70 @@
+use strict;
+use warnings;  
+##
+# Write a program to find the sequence of characters that has the most anagrams.
+##
+my %word_product;
+my %letter_factor = (
+    e => 2,
+    t => 3,
+    a => 5,
+    o => 7,
+    i => 11,
+    n => 13,
+    s => 17,
+    h => 19,
+    r => 23,
+    d => 29,
+    l => 31,
+    c => 37,
+    u => 41,
+    m => 43,
+    w => 47,
+    f => 53,
+    g => 59,
+    y => 61,
+    p => 67,
+    b => 71,
+    v => 73,
+    k => 79,
+    j => 83,
+    x => 89,
+    q => 97,
+    z => 101
+);
+my %factor_letter = reverse(%letter_factor);  
+
+sub prime_factor{
+    my $x = shift(@_); 
+    my @factors;    
+    for (my $y = 2; $y <= $x; $y++){
+        next if $x % $y;
+        $x /= $y;
+        push @factors, $y;
+        redo;
+    }
+    return @factors;  
+}
+
+##
+# Main
+##
+while(<>){
+    chomp($_);
+    my $word = lc($_);
+    $word =~ tr/-//d;
+    my @letters = split(//, $word);
+    my $product = 1;
+    map {$product *= $_} map{$letter_factor{$_}} @letters;
+    $word_product{$word} = $product;
+}
+
+my @words = keys(%word_product);
+my %product_count;  
+for my $word (@words){
+    $product_count{$word_product{$word}} ||= 0;  
+    $product_count{$word_product{$word}}++; 
+}
+
+my @sorted = sort {$product_count{$b} <=> $product_count{$a}} keys %product_count;
+print join(" ", map {$factor_letter{$_}} prime_factor($sorted[0])) . "\n";