rjt's Week 047 solutions and blogs

6 files changed, 115 insertions, 6 deletions

diff --git a/challenge-047/ryan-thompson/README.md b/challenge-047/ryan-thompson/README.md
index e381ffa39b..4994e028ce 100644
--- a/challenge-047/ryan-thompson/README.md
+++ b/challenge-047/ryan-thompson/README.md
@@ -1,18 +1,18 @@
 # Ryan Thompson
 
-## Solutions
+## Week 047 Solutions
 
-### Task 1 › Cryptic Message
+### Task 1 › Roman Calculator
 
  * [Perl](perl/ch-1.pl)
- * [Raku](raku/ch-1.p6)
+ * **Raku:** No Raku solution this week, sorry.
 
-### Task 2 › 500 Doors
+### Task 2 › Gapful Numbers
 
  * [Perl](perl/ch-2.pl)
  * [Raku](raku/ch-2.p6)
 
 ## Blogs
 
- * [Task 1 › Cryptic Message](http://www.ry.ca/2020/02/cryptic-message/)
- * [Task 2 › 500 Doors](http://www.ry.ca/2020/02/500-doors/)
+ * [Task 1 › Roman Calculator](http://www.ry.ca/2020/02/roman-calculator/)
+ * [Task 2 › Gapful Numbers](http://www.ry.ca/2020/02/gapful-numbers/)
diff --git a/challenge-047/ryan-thompson/blog.txt b/challenge-047/ryan-thompson/blog.txt
new file mode 100644
index 0000000000..e3e2368cb2
--- /dev/null
+++ b/challenge-047/ryan-thompson/blog.txt
@@ -0,0 +1 @@
+http://www.ry.ca/2020/02/roman-calculator/
diff --git a/challenge-047/ryan-thompson/blog1.txt b/challenge-047/ryan-thompson/blog1.txt
new file mode 100644
index 0000000000..585b9926b4
--- /dev/null
+++ b/challenge-047/ryan-thompson/blog1.txt
@@ -0,0 +1 @@
+http://www.ry.ca/2020/02/gapful-numbers/
diff --git a/challenge-047/ryan-thompson/perl/ch-1.pl b/challenge-047/ryan-thompson/perl/ch-1.pl
new file mode 100644
index 0000000000..594d24cf62
--- /dev/null
+++ b/challenge-047/ryan-thompson/perl/ch-1.pl
@@ -0,0 +1,73 @@
+#!/usr/bin/env perl
+#
+# ch-1.pl - Roman calculator
+#
+# Ryan Thompson <rjt@cpan.org>
+
+use 5.010;
+use warnings;
+use strict;
+no warnings 'uninitialized';
+use List::Util qw<sum first>;
+use Test::More;
+
+my %rom = (I => 1, V => 5, X => 10, L => 50, C => 100, D => 500, M => 1000,
+                  IV => 4,IX =>  9,XL => 40,XC =>  90,CD => 400,CM =>  900);
+my @mor = map { [ $rom{$_} => $_ ] } sort { $rom{$b} <=> $rom{$a} } keys %rom;
+
+use Data::Dump qw/dd/;
+dd @mor;
+
+say roman_expr(join ' ', @ARGV) and exit if @ARGV;
+
+# Perform arbitrary expressions using Roman numerals
+sub roman_expr {
+    my $expr = shift;
+    $expr =~ s/\b([IVXLCDM]+)\b/roman_to_arabic($1)/eg;
+    die "Invalid expression" if $expr =~ m![^ 0-9+*%/()-]!;
+
+    arabic_to_roman( eval $expr );
+}
+
+sub roman_to_arabic {
+    sum map { $rom{$_} } pop =~ /(I[VX]|X[LC]|C[DM]|[IVXLCDM])/g 
+}
+
+sub arabic_to_roman {
+    my $n = shift;
+    my $r = '';
+    while ($n) {
+        my ($val, $rom) = @{( first { $_->[0] <= $n } @mor )};
+        $n -= $val;
+        $r .= $rom;
+    }
+    $r;
+}
+
+#
+# Testing code
+#
+my %tests = (
+    I           => 1,
+    XXXIX       => 39,
+    CLX         => 160,
+    CCXXXVII    => 237,
+    CDXXXVIII   => 438,
+    DCCCXLVIII  => 848,
+    MLXVI       => 1066,
+    MM          => 2000,
+    MMXX        => 2020,
+);
+my @order = sort { $tests{$a} <=> $tests{$b} } keys %tests;
+
+is roman_to_arabic($_), $tests{$_}, "$_ => $tests{$_}" for @order;
+is arabic_to_roman($tests{$_}), $_, "$tests{$_} => $_" for @order;
+
+my %expr = (
+    XL      => 'XXXIX + I',
+    DCLXXV  => 'CCXXXVII + CDXXXVIII',
+    XIV     => '(CCXXXVII + CDXXXVIII) % XIII ** II / XII',
+);
+is roman_expr($expr{$_}), $_, "$_ = $expr{$_}" for sort keys %expr;
+
+done_testing;
diff --git a/challenge-047/ryan-thompson/perl/ch-2.pl b/challenge-047/ryan-thompson/perl/ch-2.pl
new file mode 100644
index 0000000000..aa47621fa4
--- /dev/null
+++ b/challenge-047/ryan-thompson/perl/ch-2.pl
@@ -0,0 +1,24 @@
+#!/usr/bin/env perl
+#
+# ch-2.pl - Print first 20 gapful numbers
+#           Ref: https://oeis.org/A108343
+#
+# Ryan Thompson <rjt@cpan.org>
+
+use 5.010;
+use warnings;
+use strict;
+
+say for first_n_gapful(shift // 20);
+
+sub is_gapful(_) { $_ = pop; not $_ % join '', (split '')[0,-1] }
+
+# Print the first n gapful numbers
+sub first_n_gapful {
+    my $N = shift;
+    my @r;
+    for ($_ = 100; @r < $N; $_++) {
+        push @r, $_ if is_gapful;
+    }
+    @r;
+}
diff --git a/challenge-047/ryan-thompson/raku/ch-2.p6 b/challenge-047/ryan-thompson/raku/ch-2.p6
new file mode 100644
index 0000000000..a0b8cf1858
--- /dev/null
+++ b/challenge-047/ryan-thompson/raku/ch-2.p6
@@ -0,0 +1,10 @@
+#!/usr/bin/env perl6
+
+# ch-2.p6 - Gapful numbers
+#
+# Ryan Thompson <rjt@cpan.org>
+
+my @gapful = (100..∞).grep: &is-gapful;
+say @gapful[^20];
+
+sub is-gapful( Int \n ) { n ≥ 100 and n %% n.comb[0,*-1].join }