Week 161 Perl solutions

2 files changed, 120 insertions, 0 deletions

diff --git a/challenge-161/cheok-yin-fung/perl/ch-1.pl b/challenge-161/cheok-yin-fung/perl/ch-1.pl
new file mode 100644
index 0000000000..5cd113088f
--- /dev/null
+++ b/challenge-161/cheok-yin-fung/perl/ch-1.pl
@@ -0,0 +1,33 @@
+#!/usr/bin/perl
+# The Weekly Challenge 161
+# Task 1 Abecedarian Words
+use v5.22.0;
+use warnings;
+
+open DICT, "dictionary.txt" or die "unable to get the dictionary.\n";
+
+my %abec;
+
+# Get Words From Dictionary
+my $max = 1;
+foreach (<DICT>) {
+    chomp($_);
+    if (is_abec(lc $_)) {
+        push $abec{length $_}->@*, $_;
+        $max = length $_ if (length $_) > $max
+    }
+}
+
+
+# Print Out the Result
+for my $len (reverse 1..$max) {
+    next if !defined($abec{$len});
+    say join "\n", $abec{$len}->@*;
+}
+
+
+
+sub is_abec {
+    my $word = $_[0];
+    return (join "", sort split "", $word) eq $word;
+}
diff --git a/challenge-161/cheok-yin-fung/perl/ch-2.pl b/challenge-161/cheok-yin-fung/perl/ch-2.pl
new file mode 100644
index 0000000000..157845912a
--- /dev/null
+++ b/challenge-161/cheok-yin-fung/perl/ch-2.pl
@@ -0,0 +1,87 @@
+#!/usr/bin/perl
+# The Weekly Challenge 161
+# Task 2 Pangrams
+
+# BONUS: Doing The 3rd Suggestion, 
+# "Pangram such that each word "solves" exactly one new letter. 
+# For example, such a pangram might begin with:
+#    a ah hi hid die ice tea ..."
+
+use v5.22.0;
+use warnings;
+use List::Util qw/uniqstr all shuffle/;
+use Data::Dumper;
+
+
+# Import Word List
+
+open DICT, "dictionary.txt" or die "unable to get the dictionary.\n";
+
+my @pan;
+
+my @words;  # given it is about 30_000 words in the dictionary
+
+foreach (<DICT>) {
+    chomp($_);
+    push @words, $_;   
+}
+
+
+my @three_letter_words = grep {length $_ == 3} @words;
+my @four_letter_words = grep {length $_ == 4} @words;
+
+
+
+# Start Looking for Pangram
+
+my %found_alphabet;
+
+
+do {
+    %found_alphabet = ();
+    @pan = qw/a ah hi hid/;        # from task statement
+    update_found();
+
+    while (scalar @pan < 26 && defined($pan[-1])) {
+        push @pan, next_pan();
+        update_found();
+    }
+    say join " ", @pan if scalar @pan == 26;
+} while (!is_pangram(@pan));
+
+
+
+# ======================= Subroutines =====================
+
+sub update_found {
+    $found_alphabet{lc $_} = 1 for split "" , join "", @pan;
+}
+
+
+
+sub next_pan {
+    my $new_word;
+    my $fine = 0;
+    for my $w (shuffle (@three_letter_words, @four_letter_words)) {
+        if ((scalar grep { !$found_alphabet{$_} } split "", $w) == 1) {
+            $new_word = $w;
+            $fine = 1;
+            last;
+        }
+    }
+    warn "Cannot find new words\n" if !$fine;
+    return $new_word if $fine;
+}
+
+
+
+# TESTING Subroutine
+
+sub is_pangram {
+    my @components = @_;
+    my %test;
+    $test{$_} = 0 for ("a".."z");
+    $test{$_} = 1 for split "" , join "", @components;
+    return all {$test{$_} == 1} keys %test;
+}
+