Merge pull request #6169 from rjt-pl/master

rjt's week 166 & week 77

9 files changed, 225 insertions, 39 deletions

diff --git a/challenge-077/ryan-thompson/README.md b/challenge-077/ryan-thompson/README.md
index 698e3ee64f..92d6fbb5b7 100644
--- a/challenge-077/ryan-thompson/README.md
+++ b/challenge-077/ryan-thompson/README.md
@@ -1,19 +1,15 @@
 # Ryan Thompson
 
-## Week 056 Solutions
+## Week 077 Solutions
 
-### Task 1 › Diff-K
+### Task 1 › Fibonacci Sum
 
  * [Perl](perl/ch-1.pl)
- * [Raku](raku/ch-1.p6)
 
-### Task 2 › Path Sum
+### Task 2 › Lonely X
 
  * [Perl](perl/ch-2.pl)
- * [Raku](raku/ch-2.p6)
 
 ## Blogs
 
- * [Diff-K](https://ry.ca/2020/04/diff-k/)
- * [Path Sum](https://ry.ca/2020/04/path-sum/)
-
+ * None this week.
diff --git a/challenge-077/ryan-thompson/perl/ch-1.pl b/challenge-077/ryan-thompson/perl/ch-1.pl
new file mode 100755
index 0000000000..a1b3dd7c29
--- /dev/null
+++ b/challenge-077/ryan-thompson/perl/ch-1.pl
@@ -0,0 +1,25 @@
+#!/usr/bin/env perl
+#
+# ch-1.pl - Fibonacci Sum
+#
+# 2022 Ryan Thompson <rjt@cpan.org>
+
+use 5.016;
+use warnings;
+use strict;
+no warnings 'uninitialized';
+
+my $N = shift // die "Usage: $0 <integer>\n";
+
+my @fib = (1,2);
+push @fib, $fib[-1] + $fib[-2] while $fib[-1] < $N;
+pop @fib if $fib[-1] > $N;
+
+sub {
+    my $n = shift;
+
+    return say join(" + ", @_) . " == $N" if $n == 0;
+
+    __SUB__->($n-$_, @_, $_) for grep { $_ <= $n and $_ > $_[-1] } @fib;
+
+}->($N);
diff --git a/challenge-077/ryan-thompson/perl/ch-2.pl b/challenge-077/ryan-thompson/perl/ch-2.pl
new file mode 100755
index 0000000000..170a3977dd
--- /dev/null
+++ b/challenge-077/ryan-thompson/perl/ch-2.pl
@@ -0,0 +1,42 @@
+#!/usr/bin/env perl
+#
+# ch-2.pl - Lonely X
+#
+# 2022 Ryan Thompson <rjt@cpan.org>
+
+use 5.010;
+use warnings;
+use strict;
+use List::Util qw< any all >;
+
+sub X() { $_->[1] }  # Convenient aliases
+sub Y() { $_->[0] }  # (syntactic sugar!)
+
+my @ex2 = ([ qw< o o x o > ],
+           [ qw< x o o o > ],
+           [ qw< x o o x > ],
+           [ qw< o x o o > ]);
+
+say "There are " . lonely_x(@ex2) . " lonely 'x's";
+
+sub lonely_x {
+    my $xmax = $#{$_[0]};
+    my $count = 0;
+
+    for my $y (0..$#_) {
+        for my $x (0..$xmax) {
+            next if $_[$y][$x] ne 'x';
+
+            next if any {     $_[Y][X] eq 'x'    }
+                   grep {  Y >= 0 && Y <= $#_
+                    and    X >= 0 && X <= $xmax  }
+                    map {     [ $y+Y, $x+X ]     }
+                   grep { not (X == 0 && Y == 0) }
+                    map { my $yp = $_; map { [$yp,$_] } -1..1 } -1..1;
+
+            say "x at row $y, col $x is lonely";
+            $count++;
+        }
+    }
+    $count;
+}
diff --git a/challenge-166/ryan-thompson/README.md b/challenge-166/ryan-thompson/README.md
index c1ce0dcf40..dafa7e82f7 100644
--- a/challenge-166/ryan-thompson/README.md
+++ b/challenge-166/ryan-thompson/README.md
@@ -1,46 +1,28 @@
 # Ryan Thompson
 
-## Week 165 Solutions
+## Week 166 Solutions
 
-### Task 1 › SVG
+### Task 1 › Hexadecimal Words
 
  * [Perl](perl/ch-1.pl)
 
     $ ./ch-1.pl [options]
 
-        --height=N          Height in pixels
-        --width=N           Width in pixels
-        --stroke=N          Stroke width
-        --line-color=str    Line color (CSS color value)
-        --point-color=str   Point color (CSS color value)
-        --radius=N          Point radius
-        --nocredits         Disable credits in SVG file
+        --dict=/path/to/dict    Dictionary location
+        --length=8              Target word or phrase length
+        --max-sub=0.2           Ratio of # substitutions / word length
+        --min-length=3          Minimum word length
+        --nopretty              Print hex only, otherwise, pretty print
 
-### Task 2 › Line of Best Fit
+ * [Perl, simplified](perl/ch-1-short.pl)
 
- * [Perl](perl/ch-2.pl)
-
-    $ ./ch-2.pl
-
-### Bonus › Point Generator
-
- * [Perl](perl/gen_points.pl)
-
-    $ ./gen_points.pl [options]
+### Task 2 › K-Directory Diff
 
-        --height=N      Height in pixels
-        --width=N       Width in pixels
-
-        --slope=N       Slope
-        --m=N
-
-        --intercept=N   y-intercept
-        --b=N
-
-### Recommended Pipeline
+ * [Perl](perl/ch-2.pl)
 
-    $ ./gen_points.pl [options] | ./ch-2.pl | ./ch-1.pl
+    $ ./ch-2.pl dir1 dir2 ...
 
 ## Blogs
 
- * [Simple SVG Generator](https://ry.ca/2022/05/simple-svg-generator/)
+ * [Hexadecimal Words](https://ry.ca/2022/05/hexadecimal-words/)
+ * [K-Directory Diff](https://ry.ca/2022/05/k-directory-diff/)
diff --git a/challenge-166/ryan-thompson/blog.txt b/challenge-166/ryan-thompson/blog.txt
new file mode 100644
index 0000000000..e14d70eb73
--- /dev/null
+++ b/challenge-166/ryan-thompson/blog.txt
@@ -0,0 +1 @@
+https://ry.ca/2022/05/hexadecimal-words/
diff --git a/challenge-166/ryan-thompson/blog1.txt b/challenge-166/ryan-thompson/blog1.txt
new file mode 100644
index 0000000000..7ba241cb6b
--- /dev/null
+++ b/challenge-166/ryan-thompson/blog1.txt
@@ -0,0 +1 @@
+https://ry.ca/2022/05/k-directory-diff/
diff --git a/challenge-166/ryan-thompson/perl/ch-1-short.pl b/challenge-166/ryan-thompson/perl/ch-1-short.pl
new file mode 100755
index 0000000000..ee0d74aef8
--- /dev/null
+++ b/challenge-166/ryan-thompson/perl/ch-1-short.pl
@@ -0,0 +1,13 @@
+#!/usr/bin/env perl
+#
+# pwc_hexwords.pl - Hexwords for PWC
+#
+# 2022 Ryan Thompson <rjt@cpan.org>
+
+use 5.010;
+use File::Slurper qw< read_lines >;
+
+my $dict = $ARGV[0] // '../../../data/dictionary.txt';
+
+say for map {     y/olist/01157/r    }
+       grep { /^[0-9a-folist]{2,8}$/ } read_lines($dict);
diff --git a/challenge-166/ryan-thompson/perl/ch-1.pl b/challenge-166/ryan-thompson/perl/ch-1.pl
new file mode 100755
index 0000000000..76480a2ed6
--- /dev/null
+++ b/challenge-166/ryan-thompson/perl/ch-1.pl
@@ -0,0 +1,76 @@
+#!/usr/bin/env perl
+#
+# pwc_hexwords.pl - Hexwords for PWC
+#
+# 2022 Ryan Thompson <rjt@cpan.org>
+
+use 5.016;
+use warnings;
+use strict;
+use File::Slurper qw< read_lines >;
+use List::Util    qw< sum max >;
+use Getopt::Long;
+no warnings 'uninitialized';
+
+sub filter(_);
+
+my %o = (       dict => '../../../data/dictionary.txt', 
+              length => 8, 
+           'max-sub' => 0.2,
+        'min-length' => 3,
+              pretty => 1
+);
+GetOptions(\%o, qw< dict=s max-sub=f length=i min-length=i pretty! >);
+
+my %words =  map {            @$_          }
+            grep {          filter         }
+             map { [$_ => y/olist/01157/r] }
+            grep {  /^[0-9a-folist]{2,}$/  } read_lines($o{dict});
+
+my @words   = sort keys %words;
+my @phrases = get_phrases();
+
+$o{pretty} ? pretty_print(@phrases) 
+           : say join '', map { $words{$_} } @$_ for @phrases;
+
+# Pretty print the output
+sub pretty_print {
+    my $spaces = -1 + max map { 0+@$_ } @_;
+    for (@_) {
+        my $phrase = join ' ', map ucfirst, @$_;
+        my $hexphrase = join '', map { $words{$_} } @$_;
+        printf "%@{[$o{length}+$spaces]}s => %$o{length}s\n",
+                $phrase, $hexphrase;
+    }
+}
+
+# Get unique n-word phrases of length $o{length} (recursive)
+sub get_phrases {
+    my @phrases;
+
+    sub {
+        my $len = sum map { length } @_;
+
+                                return if $len >  $o{length};
+        push @phrases, [@_] and return if $len == $o{length};
+
+        __SUB__->(@_, $_) for grep { $_ ge $_[-1] } @words;
+    }->();
+
+    @phrases;
+}
+
+# Perform any desired filtering of results. Takes an array of
+# [ orig_word => hex_word ] and returns true if it should be included
+sub filter(_) {
+    my ($orig, $hex) = @{$_[0]};
+
+    # Count number of substitutions in the word
+    my $subs =()= ($orig ^ $hex) =~ /[^\0]/g;
+    return if $subs > length($hex)*$o{'max-sub'};
+
+    return if length($hex) > $o{length};
+    return if length($hex) < $o{'min-length'};
+
+    return 1; # pass
+}
diff --git a/challenge-166/ryan-thompson/perl/ch-2.pl b/challenge-166/ryan-thompson/perl/ch-2.pl
new file mode 100755
index 0000000000..6a8ec9c83c
--- /dev/null
+++ b/challenge-166/ryan-thompson/perl/ch-2.pl
@@ -0,0 +1,50 @@
+#!/usr/bin/env perl
+#
+# dirdiff - Compare two or more directories and report differences
+#
+# 2003-2021 Ryan Thompson <rjt@cpan.org>
+
+use 5.010;
+use warnings;
+use strict;
+no warnings 'uninitialized';
+
+use File::Slurp qw< read_dir >;
+use List::Util  qw< uniq all max >;
+
+die "Usage: $0 dir1 dir2 ..." if @ARGV < 2;
+
+my @dirs = @ARGV; # Preserve order
+my %dirs = read_all_dirs(@dirs);
+my @uniq = uniq sort map { keys %{$dirs{$_}{files}} } keys %dirs;
+
+# This format string is used for headings and directory contents
+my $fmt = join(" | ", map { "%-$dirs{$_}{maxlen}s" } @dirs) . "\n";
+
+printf $fmt, @dirs;
+printf $fmt, map { '-' x $dirs{$_}{maxlen} } @dirs; # Divider
+
+# Main event: Output files that do not exist in all @dirs
+for my $file (@uniq) {
+    my @files = map { $dirs{$_}{files}{$file} ? $file : '' } @dirs;
+    next if all { length } @files; # Exists in all directories
+
+    printf $fmt, @files;
+}
+
+# Read all dirs, calculate their max filename length, and return the works
+# $result{dir1}{files}{fileA} = 1 if fileA exists in dir1
+# $result{dir1}{maxlen} = maximum filename length in dir1
+sub read_all_dirs {
+    map {
+        my $dir = $_;
+        my %hash = map  { $_ => 1 } 
+                   map  { -d "$dir/$_" ?  "${_}/" : $_ }
+                   grep { -f "$dir/$_" or -d "$dir/$_" } read_dir($dir);
+
+        $dir => {
+            files  => \%hash,
+            maxlen => max map length, keys %hash, $dir
+        }
+    } @_ 
+}