- Added solutions by Laurent Rosenfeld.

5 files changed, 96 insertions, 0 deletions

diff --git a/challenge-047/laurent-rosenfeld/blog.txt b/challenge-047/laurent-rosenfeld/blog.txt
new file mode 100644
index 0000000000..14fb3fbdd3
--- /dev/null
+++ b/challenge-047/laurent-rosenfeld/blog.txt
@@ -0,0 +1 @@
+http://blogs.perl.org/users/laurent_r/2020/02/perl-weekly-challenge-47-roman-calculator-and-gapful-numbers.html
diff --git a/challenge-047/laurent-rosenfeld/perl/ch-1.pl b/challenge-047/laurent-rosenfeld/perl/ch-1.pl
new file mode 100644
index 0000000000..8b4dffe035
--- /dev/null
+++ b/challenge-047/laurent-rosenfeld/perl/ch-1.pl
@@ -0,0 +1,43 @@
+use strict;
+use warnings;
+use feature qw/say/;
+
+
+my %rom_tab = (I => 1,  V => 5, X => 10, L => 50, C => 100, D => 500, M => 1000);
+
+sub from_roman {
+    my $roman = uc shift;
+    my $numeric = 0;
+    my $prev_letter = "M";
+    for my $letter (split //, $roman) {
+        $numeric -= 2 * $rom_tab{$prev_letter}
+            if $rom_tab{$letter} > $rom_tab{$prev_letter};
+        $numeric += $rom_tab{$letter};
+        $prev_letter = $letter;
+    }
+    return $numeric;
+}
+
+sub to_roman {
+    my $arabic = shift;
+    warn "$arabic out of bounds" unless $arabic > 0 and $arabic < 4000;
+    my %hash = %rom_tab;
+    $hash{$_->[0]} = $_->[1] for (['IV', 4], ['IX', 9], ['XL', 40],
+        ['XC', 90], ['CD', 400], ['CM', 900] );
+    my $roman = "";
+    for my $key (sort { $hash{$b} <=> $hash{$a} } keys %hash) {
+        my $num = int ($arabic / $hash{$key});
+        $roman .= $key x $num;
+        $arabic -= $hash{$key} * $num;
+    }
+    return $roman;
+}
+
+my @input;
+for (@ARGV) {
+    push @input, $_ if /[-+*\/]/;
+    push @input, from_roman $_ if /[ivxlcdm]+/i;
+}
+die "Need at least three parameters" if @input < 3; # we need at least 1 operator and two operands
+my $result = eval join ' ', @input;
+say "@ARGV = ", to_roman $result;
diff --git a/challenge-047/laurent-rosenfeld/perl/ch-2.pl b/challenge-047/laurent-rosenfeld/perl/ch-2.pl
new file mode 100644
index 0000000000..8fea58aa12
--- /dev/null
+++ b/challenge-047/laurent-rosenfeld/perl/ch-2.pl
@@ -0,0 +1,12 @@
+use strict;
+use warnings;
+use feature "say";
+
+my @gapful = ();
+my $current = 100;
+do {
+    my ($start, $end) = $current =~ /^(\d)\d+(\d)$/;
+    push @gapful, $current unless $current % ($start . $end);
+    $current ++;
+} until $#gapful >= 19;
+say "@gapful";
diff --git a/challenge-047/laurent-rosenfeld/raku/ch-1.p6 b/challenge-047/laurent-rosenfeld/raku/ch-1.p6
new file mode 100644
index 0000000000..1b997761a9
--- /dev/null
+++ b/challenge-047/laurent-rosenfeld/raku/ch-1.p6
@@ -0,0 +1,39 @@
+use v6;
+use MONKEY-SEE-NO-EVAL;
+
+subset Roman-str of Str where $_ ~~ /^<[IVXLCDMivxlcdm]>+$/;
+
+my %rom-tab = < 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 @ordered_romans = reverse sort { %rom-tab{$_} }, keys %rom-tab;
+
+sub from-roman (Roman-str $roman) {
+    my $numeric = 0;
+    my $prev_letter = "M";
+    for $roman.uc.comb -> $letter {
+        $numeric -= 2 * %rom-tab{$prev_letter}
+            if %rom-tab{$letter} > %rom-tab{$prev_letter};
+        $numeric += %rom-tab{$letter};
+        $prev_letter = $letter;
+    }
+    return $numeric;
+}
+
+sub to-roman (Int $arabic is copy where  { 0 < $_ < 4000 }) {
+    my $roman = "";
+    for @ordered_romans -> $key {
+        my $num = ($arabic / %rom-tab{$key}).Int;
+        $roman ~= $key x $num;
+        $arabic -= %rom-tab{$key} * $num;
+    }
+    return $roman;
+}
+
+my @input;
+for @*ARGS {
+    push @input, $_ if /<[-+*\/]>/;
+    push @input, from-roman $_ if m:i/<[ivxlcdm]>+/;
+}
+die "Need at least three parameters" if @input < 3; # we need at least 1 operator and two operands
+my $result = EVAL join ' ', @input;
+say "@*ARGS[] = ", to-roman $result;
diff --git a/challenge-047/laurent-rosenfeld/raku/ch-2.sh b/challenge-047/laurent-rosenfeld/raku/ch-2.sh
new file mode 100644
index 0000000000..ec6e9aef03
--- /dev/null
+++ b/challenge-047/laurent-rosenfeld/raku/ch-2.sh
@@ -0,0 +1 @@
+perl6 -e 'say (grep { $_ %% .comb[0,*-1].join}, 100..*)[0..19];'