rjt's #161 Perl solutions and blogs

5 files changed, 195 insertions, 8 deletions

diff --git a/challenge-161/ryan-thompson/README.md b/challenge-161/ryan-thompson/README.md
index 3dd1e955d3..499e779053 100644
--- a/challenge-161/ryan-thompson/README.md
+++ b/challenge-161/ryan-thompson/README.md
@@ -1,19 +1,31 @@
 # Ryan Thompson
 
-## Week 110 Solutions
+## Week 161 Solutions
 
-### Task 1 › Phone Number Validation
+### Task 1 › Abecedarian Words
 
  * [Perl](perl/ch-1.pl)
- * [Raku](raku/ch-1.raku)
 
-### Task 2 › Transpose CSV File
+ #### Synopsis
+
+     ./ch-1.pl [--dict=path/to/dict.txt --benchmark --test]
+
+ * `--benchmark` - Runs benchmarking on every different solution
+ * `--test` - Unit tests showing all solutions produce equal results
+ * `--dict=file` - Alternate dictionary file to use (uses `../../../data/dictionary.txt` by default)
+
+### Task 2 › Pangrams
 
  * [Perl](perl/ch-2.pl)
- * [Raku](raku/ch-2.raku)
 
-## Blogs
+#### Usage
 
- * [Phone Number Validation](https://ry.ca/2021/04/phone-number-validation)
- * [Transpose CSV File](https://ry.ca/2021/04/transpose-csv-file)
+    ./ch-2.pl [--dict=path/to/dict.txt --min=length]
+
+ * `--dict=file` - Alternate dictionary file to use (default: `../../../data/dictionary.txt`)
+ * `--min=length` - Minimum word length (default: 4)
+
+## Blogs
 
+ * [Abecedarian Words](https://ry.ca/2022/04/abecedarian-words)
+ * [Pangrams](https://ry.ca/2022/04/pangrams)
diff --git a/challenge-161/ryan-thompson/blog.txt b/challenge-161/ryan-thompson/blog.txt
new file mode 100644
index 0000000000..eedbe00a2a
--- /dev/null
+++ b/challenge-161/ryan-thompson/blog.txt
@@ -0,0 +1 @@
+https://ry.ca/2022/04/abecedarian-words/
diff --git a/challenge-161/ryan-thompson/blog1.txt b/challenge-161/ryan-thompson/blog1.txt
new file mode 100644
index 0000000000..105731ec5a
--- /dev/null
+++ b/challenge-161/ryan-thompson/blog1.txt
@@ -0,0 +1 @@
+https://ry.ca/2022/04/pangrams/
diff --git a/challenge-161/ryan-thompson/perl/ch-1.pl b/challenge-161/ryan-thompson/perl/ch-1.pl
new file mode 100755
index 0000000000..88fdc6a85f
--- /dev/null
+++ b/challenge-161/ryan-thompson/perl/ch-1.pl
@@ -0,0 +1,115 @@
+#!/usr/bin/env perl
+#
+# ch-1.pl - Abecedarian words
+#
+# 2022 Ryan Thompson <rjt@cpan.org>
+
+use 5.010;
+use warnings;
+use strict;
+use autodie;
+no warnings 'uninitialized';
+
+use Getopt::Long;
+use File::Slurper qw< read_lines >;
+use Benchmark qw<cmpthese :hireswallclock>;
+use List::Util qw< any all reduce >;
+
+my %o = (dict => '../../../data/dictionary.txt');
+GetOptions(\%o, qw< dict=s test benchmark >)
+    or die "Usage: $0 [--dict=path/to/dict.txt] [--test] [--benchmark]\n";
+
+#
+# Optional part! This one's for you, Colin. :-)
+#
+# Most DOS floppy bit errs abort boot.
+# Best bet for a fix now is to beg for a copy of my floppy!
+# Or, go for almost any beer or gin. Any buzz, not choosy.
+#
+
+
+# Challenge output requirement
+
+our @words = read_lines($o{dict}); # "our" helps Benchmark. Use my normally.
+say for sort { length $a <=> length $b } abcd_words(@words);
+
+
+# Here are the abecedarian filters themselves
+
+sub is_abcd_sort   { $_ eq join '', sort split // }
+
+sub is_abcd_reduce { '~' ne reduce { $a gt $b ? '~' : $b } split // }
+
+sub is_abcd_regex  { /^a*b*c*d*e*f*g*h*i*j*k*l*m*n*
+                       o*p*q*r*s*t*u*v*w*x*y*z*$/x }
+
+sub is_abcd_loop   {
+    my $last;
+    for my $ch (split //) {
+        return if $last gt $ch;
+        $last = $ch;
+    }
+    $_;
+}
+
+# Two different C versions, for fun
+
+use Inline 'C' => <<'END'
+/* This does the actual checking, used by the next two functions */
+int __is_abcd(unsigned char *s) {
+    unsigned char last = 0;
+    for (unsigned char *p = s; *p; last = *p, p++ )
+        if (last > *p)
+            return 0;
+
+    return 1;
+}
+
+/* Boolean, works on $_ */
+int is_abcd_inline() {
+    SV *var = get_sv("_", GV_ADD);
+    unsigned char *s = SvPVutf8_nolen(var);
+
+    return __is_abcd(s);
+}
+
+/* Process the entire list */
+void abcd_words(SV *word, ...) {
+    Inline_Stack_Vars;
+
+    Inline_Stack_Reset;
+    for (int i = 0; i < Inline_Stack_Items; i++) {
+        if (__is_abcd(SvPV(Inline_Stack_Item(i), PL_na)))
+            Inline_Stack_Push(Inline_Stack_Item(i));
+    }
+    Inline_Stack_Done;
+}
+END
+;
+
+
+#
+# Tests
+#
+
+my %filters = map { $_ => "grep \&is_abcd_$_, \@words" } 
+    qw< sort regex loop reduce inline >;
+
+$filters{inlAll} = "abcd_words(\@words)";
+
+if ($o{test}) {
+    use Test::More;
+    # Loop version will be our reference version, but it doesn't matter,
+    # as any discrepancy will throw an error
+    my $abcd= [ grep  &is_abcd_loop, @words ];
+
+    is_deeply [ eval $filters{$_} ], $abcd, $_ for sort keys %filters;
+
+    done_testing;
+}
+
+#
+# Benchmarking
+#
+
+cmpthese(-5 => \%filters) if $o{benchmark};
diff --git a/challenge-161/ryan-thompson/perl/ch-2.pl b/challenge-161/ryan-thompson/perl/ch-2.pl
new file mode 100755
index 0000000000..88fef18bf3
--- /dev/null
+++ b/challenge-161/ryan-thompson/perl/ch-2.pl
@@ -0,0 +1,58 @@
+#!/usr/bin/env perl
+#
+# ch-2.pl - Pangram generator
+#
+# 2022 Ryan Thompson <rjt@cpan.org>
+
+use 5.010;
+use warnings;
+use strict;
+
+use List::Util    qw< uniq >;
+use File::Slurper qw< read_lines >;
+use Getopt::Long;
+
+no warnings 'uninitialized';
+
+my %o = (dict => '../../../data/dictionary.txt', min => 4);
+GetOptions(\%o, qw< dict=s min=i >)
+    or die "Usage: $0 [--dict=path/to/dict.txt]\n";
+
+my @words   = grep { $o{min} < length } read_lines($o{dict});
+
+my @pangram = pangram(@words);
+
+printf "Pangram is %d words / %d letters long \n\n%s\n",
+    scalar(@pangram), length("@pangram"), "@pangram";
+
+# Greedy pangram generator. At every step, looks for the word that
+# maximizes new_letters * 2 - word_length.
+sub pangram {
+    my @pangram;  # Pangram gets built here
+    my %has;
+
+    # Trade some space for time
+    my %words = map { $_ => [ uniq split // ] } @_;
+
+    while (keys %has < 26) {
+        my %best = (word => undef, score => -26);
+
+        for my $word (keys %words) {
+            my $new = grep { !$has{$_} } @{$words{$word}};
+            if ($new == 0) {
+                delete $words{$word};
+                next;
+            }
+
+            my $score = $new * 2 - length;
+            %best = (word => $word, score => $score)
+                if $score > $best{score};
+        }
+
+        # Put the best word in the @pangram
+        push @pangram, $best{word};
+        $has{$_} = 1 for @{$words{$best{word}}};
+    }
+
+    @pangram;
+}