Merge pull request #1219 from rjt-pl/rjt_046

rjt's Week 046 solutions and blogs

7 files changed, 133 insertions, 12 deletions

diff --git a/challenge-046/ryan-thompson/README.md b/challenge-046/ryan-thompson/README.md
index e9331e27a2..e381ffa39b 100644
--- a/challenge-046/ryan-thompson/README.md
+++ b/challenge-046/ryan-thompson/README.md
@@ -1,23 +1,18 @@
 # Ryan Thompson
 
-## Solution links:
+## Solutions
 
-### Square Secret Code
+### Task 1 › Cryptic Message
 
  * [Perl](perl/ch-1.pl)
  * [Raku](raku/ch-1.p6)
 
-### Quine
+### Task 2 › 500 Doors
 
- * [Perl Cheaty](perl/ch-2.pl)
- * [Perl Trivial](perl/ch-2a.pl)
- * [Perl Colorful](perl/ch-2b.pl)
- * [Raku Cheaty](raku/ch-2.p6)
- * [Raku Quine](raku/ch-2a.p6)
+ * [Perl](perl/ch-2.pl)
+ * [Raku](raku/ch-2.p6)
 
 ## Blogs
 
-Two blog posts this week:
-
- * [Square Secret Code](http://www.ry.ca/2020/01/square-secret-code/)
- * [Quine](http://www.ry.ca/2020/02/quine/)
+ * [Task 1 › Cryptic Message](http://www.ry.ca/2020/02/cryptic-message/)
+ * [Task 2 › 500 Doors](http://www.ry.ca/2020/02/500-doors/)
diff --git a/challenge-046/ryan-thompson/blog.txt b/challenge-046/ryan-thompson/blog.txt
new file mode 100644
index 0000000000..e9a1fd28df
--- /dev/null
+++ b/challenge-046/ryan-thompson/blog.txt
@@ -0,0 +1 @@
+http://www.ry.ca/2020/02/cryptic-message/
diff --git a/challenge-046/ryan-thompson/blog1.txt b/challenge-046/ryan-thompson/blog1.txt
new file mode 100644
index 0000000000..111b7e060f
--- /dev/null
+++ b/challenge-046/ryan-thompson/blog1.txt
@@ -0,0 +1 @@
+http://www.ry.ca/2020/02/500-doors/
diff --git a/challenge-046/ryan-thompson/perl/ch-1.pl b/challenge-046/ryan-thompson/perl/ch-1.pl
new file mode 100755
index 0000000000..8fb1b9d198
--- /dev/null
+++ b/challenge-046/ryan-thompson/perl/ch-1.pl
@@ -0,0 +1,35 @@
+#!/usr/bin/env perl
+#
+# ch-1.pl - Cryptic Message
+#
+# Ryan Thompson <rjt@cpan.org>
+
+use warnings;
+use strict;
+use List::MoreUtils qw< frequency >;
+use List::Util      qw< reduce >;
+
+sub decode {
+    my @r = map y/ //dr, @_;
+    join '',   map { reduce { $_->{$a} > $_->{$b} ? $a : $b } keys %$_ }
+       reverse map { { frequency map chop, @r } } 1..length $r[0];
+}
+
+# Tests
+
+use Test::More;
+
+is decode('H x l 4 !',
+          'c e - l o',
+          'z e 6 l g',
+          'H W l v R',
+          'q 9 m # o') => 'Hello';
+
+is decode('P + 2 l ! a t o',
+          '1 e 8 0 R $ 4 u',
+          '5 - r ] + a > /',
+          'P x w l b 3 k \\',
+          '2 e 3 5 R 8 y u',
+          '< ! r ^ ( ) k 0') => 'PerlRaku';
+
+done_testing;
diff --git a/challenge-046/ryan-thompson/perl/ch-2.pl b/challenge-046/ryan-thompson/perl/ch-2.pl
new file mode 100755
index 0000000000..1a57fba328
--- /dev/null
+++ b/challenge-046/ryan-thompson/perl/ch-2.pl
@@ -0,0 +1,25 @@
+#!/usr/bin/env perl
+#
+# ch-2.pl - 500 Doors
+#
+# 2020 Ryan Thompson <rjt@cpan.org>
+
+use 5.010;
+use warnings;
+use strict;
+no warnings 'uninitialized';
+
+my $doors = shift || 500;
+
+# Justification: http://www.ry.ca/2020/02/500-doors/
+say join ' ', map { $_ * $_ } 1..int sqrt $doors;
+
+
+# That's fine, I can do it the hard way:
+my %door;
+for my $m (1..$doors) {
+    $door{$m*$_} ^= 1 for 1..$doors/$m;
+}
+say join ' ', grep { $door{$_} }
+              sort { $a <=> $b } keys %door;
+
diff --git a/challenge-046/ryan-thompson/raku/ch-1.p6 b/challenge-046/ryan-thompson/raku/ch-1.p6
new file mode 100755
index 0000000000..073be7cacb
--- /dev/null
+++ b/challenge-046/ryan-thompson/raku/ch-1.p6
@@ -0,0 +1,43 @@
+#!/usr/bin/env perl6
+
+# ch-1.p6 - Cryptic message
+#
+# Ryan Thompson <rjt@cpan.org>
+
+#| Decode extremely unreliable transmission
+sub decode( @strings ) {
+    my @col-count;
+    for @strings».split: ' ' -> $row {
+        @col-count[.key]{.value}++ for |$row.pairs;
+    }
+    @col-count».sort(-*.value)».first».key.join;
+}
+
+
+#
+# Testing
+#
+
+use Test;
+
+plan(3);
+is decode(('H x l 4 !',
+           'c e - l o',
+           'z e 6 l g',
+           'H W l v R',
+           'q 9 m # o')), 'Hello';
+
+is decode(('P + 2 l ! a t o',
+           '1 e 8 0 R $ 4 u',
+           '5 - r ] + a > /',
+           'P x w l b 3 k \\',
+           '2 e 3 5 R 8 y u',
+           '< ! r ^ ( ) k 0')), 'PerlRaku';
+
+is decode(('H x l 4 !',
+           'c e - l o',
+           'z e 6 l',    # Missing character
+           'H W l v R',
+           'q 9 m # o')), 'Hello';
+
+done-testing;
diff --git a/challenge-046/ryan-thompson/raku/ch-2.p6 b/challenge-046/ryan-thompson/raku/ch-2.p6
new file mode 100755
index 0000000000..5e799f5a9d
--- /dev/null
+++ b/challenge-046/ryan-thompson/raku/ch-2.p6
@@ -0,0 +1,21 @@
+#!/usr/bin/env perl6
+
+# ch-2.p6 - Doors that are square
+#
+# Ryan Thompson <rjt@cpan.org>
+
+sub MAIN( Int $doors = 500 ) {
+
+    # Justification: http://www.ry.ca/2020/02/500-doors/
+    say (1..$doors.sqrt.Int) »**» 2;
+
+
+    # That's fine, I can do it the hard way:
+    my %doors;
+    for 1..$doors -> $m {
+        %doors{$m*$_} ^^= 1 for 1..$doors/$m;
+    }
+
+    say %doors.grep({ .value })».key».Int.sort;
+
+}