Merge pull request #1244 from choroba/ech047

Solve 047 (Roman Calculator and Gapful Number) by E. Choroba

3 files changed, 87 insertions, 0 deletions

diff --git a/challenge-047/e-choroba/perl/MyRoman.pm b/challenge-047/e-choroba/perl/MyRoman.pm
new file mode 100644
index 0000000000..4d8a5e1120
--- /dev/null
+++ b/challenge-047/e-choroba/perl/MyRoman.pm
@@ -0,0 +1,56 @@
+package MyRoman;
+
+use Exporter qw{ import };
+our @EXPORT_OK = qw{ from_roman to_roman };
+
+use warnings;
+use strict;
+
+my %from_roman = (
+    I => 1,
+    V => 5,
+    X => 10,
+    L => 50,
+    C => 100,
+    D => 500,
+    M => 1000,
+);
+sub from_roman {
+    my ($roman) = @_;
+    my $n = 0;
+    while ($roman =~ s/(I[VXLCDM]|X[LCDM]|C[DM])//) {
+        my ($minus, $plus) = split //, $1;
+        $n += $from_roman{$plus} - $from_roman{$minus};
+    }
+    $n += $from_roman{$_} for split //, $roman;
+    return $n
+}
+
+my %to_roman = reverse %from_roman;
+my %subtractive = (
+    'IIII'  => 'IV',
+    'VIIII' => 'IX',
+    'XXXX'  => 'XL',
+    'LXXXX' => 'XC',
+    'CCCC'  => 'CD',
+    'DCCCC' => 'CM',
+);
+my $subtractive_re = join '|',
+                     sort { length $b <=> length $a }
+                     keys %subtractive;
+sub to_roman {
+    my ($n) = @_;
+    my $roman = "";
+    while ($n) {
+        for my $i (sort { $b <=> $a } keys %to_roman) {
+            while ($n >= $i) {
+                $n -= $i;
+                $roman .= $to_roman{$i};
+            }
+        }
+    }
+    $roman =~ s/($subtractive_re)/$subtractive{$1}/g;
+    return $roman
+}
+
+__PACKAGE__
diff --git a/challenge-047/e-choroba/perl/ch-1.pl b/challenge-047/e-choroba/perl/ch-1.pl
new file mode 100755
index 0000000000..5e92e98fed
--- /dev/null
+++ b/challenge-047/e-choroba/perl/ch-1.pl
@@ -0,0 +1,16 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use feature qw{ say };
+
+use lib '.';
+use MyRoman qw{ to_roman from_roman }; # Extracted from PWC010/1.
+
+my ($n1, $op, $n2) = @ARGV;
+my $function = { '+' => sub { $_[0] + $_[1] },
+                 '-' => sub { $_[0] - $_[1] },
+                 '*' => sub { $_[0] * $_[1] },
+                 '/' => sub { int($_[0] / $_[1]) }
+               }->{$op}
+    or die "Unknown operator $op.";
+say to_roman($function->(map from_roman($_), $n1, $n2));
diff --git a/challenge-047/e-choroba/perl/ch-2.pl b/challenge-047/e-choroba/perl/ch-2.pl
new file mode 100755
index 0000000000..e8573a7470
--- /dev/null
+++ b/challenge-047/e-choroba/perl/ch-2.pl
@@ -0,0 +1,15 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use feature qw{ say };
+
+sub gapful_iterator {
+    my ($n) = @_;
+    my $iterator = sub {
+        $n++ until 0 == $n % join "", $n =~ /^(.)/, $n=~ /(.)$/;
+        $n++
+    };
+}
+
+my $iter = gapful_iterator(100);
+say $iter->() for 1 .. 20;