Merge branch 'master' of github.com:manwar/perlweeklychallenge-club

89 files changed, 622643 insertions, 30 deletions

diff --git a/challenge-005/adam-russell/blog.txt b/challenge-005/adam-russell/blog.txt
new file mode 100644
index 0000000000..cae252cc33
--- /dev/null
+++ b/challenge-005/adam-russell/blog.txt
@@ -0,0 +1 @@
+https://adamcrussell.livejournal.com/1433.html
diff --git a/challenge-005/adam-russell/perl5/ch-1.pl b/challenge-005/adam-russell/perl5/ch-1.pl
new file mode 100644
index 0000000000..e9293ff9a4
--- /dev/null
+++ b/challenge-005/adam-russell/perl5/ch-1.pl
@@ -0,0 +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  
+);  
+
+##
+# Main
+##
+my $test_word = lc($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
new file mode 100644
index 0000000000..577e6bc354
--- /dev/null
+++ 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";   
diff --git a/challenge-005/andrezgz/perl5/ch-1.pl b/challenge-005/andrezgz/perl5/ch-1.pl
new file mode 100644
index 0000000000..f054952971
--- /dev/null
+++ b/challenge-005/andrezgz/perl5/ch-1.pl
@@ -0,0 +1,59 @@
+#!/usr/bin/perl
+
+# https://perlweeklychallenge.org/blog/perl-weekly-challenge-005/
+# Challenge #1
+# Write a program which prints out all anagrams for a given word.
+# For more information about Anagram, please check this wikipedia page.
+# https://en.wikipedia.org/wiki/Anagram
+
+# An anagram may be a phrase, but I limit this code only to words of the same length as the given one,
+# because even if I can make a phrase (string of words using the considered letters) it may not have sense.
+
+# I've reused code from the previous challenge
+# https://github.com/manwar/perlweeklychallenge-club/blob/master/challenge-004/andrezgz/perl5/ch-2.pl
+
+use strict;
+use warnings;
+
+die "Usage: ch-1.pl <words_file> <word>" if scalar(@ARGV) < 2;
+
+my $words_file = $ARGV[0];
+my $given_word = $ARGV[1];
+
+open(my $fh, "<", $words_file) or die "Could not open words file '$words_file': $!";
+
+while( my $word = <$fh> ) {
+    chomp $word; #remove new line trailing string
+    print $word.$/ if is_word_anagram( lc $word , lc $given_word);
+}
+close $fh;
+
+#Return 1 if $word is an anagram for $given_word
+sub is_word_anagram {
+    my ( $word, $given_word ) = @_;
+
+    return 0 if ( length $word != length $given_word ); #all letters must be used in a word anagram
+    return 0 if ( $word eq $given_word );               #the word must not be the given one
+
+    my %letters = get_hashed_letters($given_word);
+
+    foreach my $l (split //,$word ){
+        return 0 unless (exists $letters{ $l } && $letters{ $l } > 0);
+        $letters{ $l }--;
+    }
+    return 1;
+}
+
+{
+    my %letters; #generate the hash only once
+
+    #Make a hash with available letters and quantity
+    sub get_hashed_letters {
+        my ( $given_word ) = @_;
+        return %letters if (keys %letters);
+        for my $l (split //,$given_word ){
+            $letters{ lc($l) }++;
+        }
+        return %letters
+    }
+}
diff --git a/challenge-005/andrezgz/perl5/ch-2.pl b/challenge-005/andrezgz/perl5/ch-2.pl
new file mode 100644
index 0000000000..608cb9c1e4
--- /dev/null
+++ b/challenge-005/andrezgz/perl5/ch-2.pl
@@ -0,0 +1,45 @@
+#!/usr/bin/perl
+
+# https://perlweeklychallenge.org/blog/perl-weekly-challenge-005/
+# Challenge #2
+# Write a program to find the sequence of characters that has the most anagrams.
+
+# An anagram may be a phrase, but I limit this code only to words of the same length as the given one,
+# because even if I can make a phrase (string of words using the considered letters) it may not have sense.
+
+use strict;
+use warnings;
+
+die "Usage: ch-2.pl <words_file>" if scalar(@ARGV) != 1;
+
+my $words_file = $ARGV[0];
+
+open(my $fh, "<", $words_file) or die "Could not open words file '$words_file': $!";
+
+my %anagrams;
+my %candidates;
+my $max_anagrams = 0;
+
+while( my $word = <$fh> ) {
+    chomp $word; #remove new line trailing string
+
+    my $k = join( '', sort split //, lc $word); #identifier for words with same letters
+    push @{$anagrams{$k}}, $word;
+
+    my $k_anagrams = @{$anagrams{$k}};
+    next if ($k_anagrams < $max_anagrams);                          # not a candidate right now
+    $candidates{$k} = 1;                                            # it's a candidate
+    $max_anagrams = $k_anagrams if ( $k_anagrams > $max_anagrams ); # the best candidate at the moment
+
+}
+close $fh;
+
+print "Sequence of characters with the most anagrams ($max_anagrams)".$/;
+
+#Check only candidates to avoid looping over the complete %anagrams hash
+foreach my $k (keys %candidates) {
+    next if @{$anagrams{$k}} != $max_anagrams;
+    print join( ',', split //, $k)
+        . " => "
+        . join(",", sort {lc($a) cmp lc($b)} @{$anagrams{$k}}) . $/;
+}
diff --git a/challenge-005/arne-sommer/blog.txt b/challenge-005/arne-sommer/blog.txt
new file mode 100644
index 0000000000..41b8948747
--- /dev/null
+++ b/challenge-005/arne-sommer/blog.txt
@@ -0,0 +1 @@
+https://perl6.eu/anagrams.html
diff --git a/challenge-005/arne-sommer/perl6/ch-1.p6 b/challenge-005/arne-sommer/perl6/ch-1.p6
new file mode 100755
index 0000000000..660283c160
--- /dev/null
+++ b/challenge-005/arne-sommer/perl6/ch-1.p6
@@ -0,0 +1,23 @@
+#! /usr/bin/env perl6
+
+unit sub MAIN (Str $word is copy where $word !~~ /\W/,
+  :$dictionary where $dictionary.IO.r = "/usr/share/dict/british-english");
+
+$word .= lc;
+
+my $dict = get-dictionary($dictionary);
+ 
+print "Anagrams:";
+
+for $word.comb.permutations>>.join.unique -> $candidate
+{
+  # next if $candidate eq $word;
+  print " $candidate" if $dict{$candidate};
+}
+print "\n";
+
+sub get-dictionary ($file where $file.IO.r) is export
+{
+  return $file.IO.lines.grep(* !~~ /\W/)>>.lc.Set;
+}
+
diff --git a/challenge-005/arne-sommer/perl6/ch-2.p6 b/challenge-005/arne-sommer/perl6/ch-2.p6
new file mode 100755
index 0000000000..b70495d4a5
--- /dev/null
+++ b/challenge-005/arne-sommer/perl6/ch-2.p6
@@ -0,0 +1,25 @@
+#! /usr/bin/env perl6
+
+unit sub MAIN (Str :$dictionary where $dictionary.IO.r = "dict-UK.txt");
+
+my $dict = get-dictionary($dictionary);
+
+my %count;
+
+%count{ .comb.sort.join }++ for $dict.keys;
+
+my $ma