- Added solutions by Athanasius.

2 files changed, 139 insertions, 0 deletions

diff --git a/challenge-005/athanasius/perl5/ch-1.pl b/challenge-005/athanasius/perl5/ch-1.pl
new file mode 100644
index 0000000000..af9bb1f8b6
--- /dev/null
+++ b/challenge-005/athanasius/perl5/ch-1.pl
@@ -0,0 +1,64 @@
+#!perl
+
+use strict;
+use warnings;
+use Const::Fast;
+
+# Downloaded from https://crosswordman.com/wordlist.html:
+const my $WORDFILE => 'UK Advanced Cryptics Dictionary.txt';
+const my @DEFAULT  =>  qw( parses );
+
+$| = 1;
+
+MAIN:
+{
+    my $dict = init_dict();
+
+    # Challenge 1
+
+    find_anagrams($dict, @ARGV ? @ARGV : @DEFAULT);
+}
+
+
+sub find_anagrams
+{
+    my ($dict, @input) = @_;
+
+    for my $word (@input)
+    {
+        my $target   = $word =~ s/[^A-Za-z]//gr;
+        my $key      = join '', sort split //, $target;
+        my @anagrams = $dict->{$key}->@*;
+        @anagrams = grep { $_ ne $target } @anagrams;
+
+        if (@anagrams)
+        {
+            printf "\nFound %d anagrams of '%s':\n%s\n", scalar @anagrams,
+            $word, join(', ', @anagrams);
+        }
+        else
+        {
+            printf "\nNo anagrams of '%s' found\n", $word;
+        }
+    }
+}
+
+sub init_dict
+{
+    my %dict;
+
+    open(my $fh, '<', $WORDFILE)
+        or die "Cannot open file '$WORDFILE' for reading, stopped";
+
+    while (<$fh>)
+    {
+        next if 1 .. / ^ -+ $ /x;       # Skip header
+        chomp;
+        push $dict{ join '', sort split //, $_ }->@*, $_;
+    }
+
+    close $fh
+        or die "Cannot close file '$WORDFILE', stopped";
+
+    return \%dict;
+}
diff --git a/challenge-005/athanasius/perl5/ch-2.pl b/challenge-005/athanasius/perl5/ch-2.pl
new file mode 100644
index 0000000000..34d1b90609
--- /dev/null
+++ b/challenge-005/athanasius/perl5/ch-2.pl
@@ -0,0 +1,75 @@
+#!perl
+
+use strict;
+use warnings;
+use Const::Fast;
+
+# Downloaded from https://crosswordman.com/wordlist.html:
+const my $WORDFILE => 'UK Advanced Cryptics Dictionary.txt';
+const my @DEFAULT  =>  qw( parses );
+
+$| = 1;
+
+MAIN:
+{
+    my $dict = init_dict();
+
+    # Challenge 2
+
+    find_most_anagrams($dict);
+}
+
+sub find_most_anagrams
+{
+    my ($dict) = @_;
+    my  $max   = 0;
+    my  @max_keys;
+
+    for my $key (keys %$dict)
+    {
+        my $count = scalar $dict->{$key}->@*;
+        if ($count >= $max)
+        {
+            @max_keys = () if $count > $max;
+            $max = $count;
+            push @max_keys, $key;
+        }
+    }
+
+    if (scalar @max_keys == 1)
+    {
+        my $key = $max_keys[0];
+        printf "\nThe sequence of characters with the most anagrams is '%s' " .
+               "with %d:\n%s\n", $key, $max, join(', ', $dict->{$key}->@*);
+    }
+    else
+    {
+        printf "\nThere are %d character sequences that produce %d anagrams " .
+               "each:\n", scalar @max_keys, $max;
+        for my $key (sort @max_keys)
+        {
+            printf "\n'%s' produces:\n%s\n", $key,
+                   join( ', ', $dict->{$key}->@* );
+        }
+    }
+}
+
+sub init_dict
+{
+    my %dict;
+
+    open(my $fh, '<', $WORDFILE)
+        or die "Cannot open file '$WORDFILE' for reading, stopped";
+
+    while (<$fh>)
+    {
+        next if 1 .. / ^ -+ $ /x;       # Skip header
+        chomp;
+        push $dict{ join '', sort split //, $_ }->@*, $_;
+    }
+
+    close $fh
+        or die "Cannot close file '$WORDFILE', stopped";
+
+    return \%dict;
+}