Merge pull request #8444 from choroba/ech227

Add solutions to 227: Friday 13th & Roman Maths by E. Choroba

2 files changed, 104 insertions, 0 deletions

diff --git a/challenge-227/e-choroba/perl/ch-1.pl b/challenge-227/e-choroba/perl/ch-1.pl
new file mode 100755
index 0000000000..6dfc339631
--- /dev/null
+++ b/challenge-227/e-choroba/perl/ch-1.pl
@@ -0,0 +1,51 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use experimental qw( signatures );
+
+# We can't use Time::Piece, it can't handle years before 1900.
+use POSIX qw{ strftime };
+
+use constant YEAR_START => 1900;
+
+
+{   my %FRIDAY_13TH;
+    my $year = 2000;
+    while (14 != keys %FRIDAY_13TH && $year <= 2100) {
+        $FRIDAY_13TH{ _weekday_and_leap($year) } //= _count_fridays($year);
+    } continue {
+        ++$year;
+    }
+
+    sub friday_13th($year) {
+        return $FRIDAY_13TH{ _weekday_and_leap($year) }
+    }
+}
+
+
+sub _count_fridays($year) {
+    $year -= YEAR_START;
+    my $count = 0;
+    for my $month (0 .. 11) {
+        # If a month starts on a Sunday, it has Friday the 13th.
+        ++$count if 0 == strftime('%w', 0, 0, 0, 1, $month, $year);
+    }
+    return $count
+}
+
+sub _weekday_and_leap($year) {
+    $year -= YEAR_START;
+    my $wd = strftime('%w', 0, 0, 0, 0, 0, $year);
+    my $is_leap = '29' eq strftime('%d', 0, 0, 0, 0, 2, $year) ? 1 : 0;
+    return "$is_leap$wd"
+}
+
+
+use Test::More tests => 1 + 12;
+
+is friday_13th(2023), 2, 'Example';
+is friday_13th(1753), 2, 'First year';
+is friday_13th(9999), 1, 'Last year';
+is friday_13th(2015), 3, 'Wikipedia: Three';
+is friday_13th($_), 2, "Wikipedia: Two $_" for 2017 .. 2020, 2023, 2024;
+is friday_13th($_), 1, "Wikipedia: One $_" for 2016, 2021, 2022;
diff --git a/challenge-227/e-choroba/perl/ch-2.pl b/challenge-227/e-choroba/perl/ch-2.pl
new file mode 100755
index 0000000000..97451602f3
--- /dev/null
+++ b/challenge-227/e-choroba/perl/ch-2.pl
@@ -0,0 +1,53 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use experimental qw( signatures );
+
+use lib '../../../challenge-047/e-choroba/perl';
+use MyRoman qw{ from_roman to_roman };
+
+use constant {
+    ZERO       => 'nulla',
+    IMPOSSIBLE => 'non potest',
+};
+
+my %OP = (
+    '+'  => sub { $_[0] +  $_[1] },
+    '-'  => sub { $_[0] -  $_[1] },
+    '/'  => sub { $_[0] /  $_[1] },
+    '*'  => sub { $_[0] *  $_[1] },
+    '**' => sub { $_[0] ** $_[1] },
+);
+
+sub roman_maths($expression) {
+    my ($r1, $op, $r2)
+        = $expression =~ m{^([IVXLCDM]+) ([-+*/]|\*\*) ([IVXLCDM]+)$}
+        or die 'Parser error';
+
+    my ($n1, $n2) = map from_roman($_), $r1, $r2;
+    my $result = $OP{$op}->($n1, $n2);
+
+    return ZERO if 0 == $result;
+
+    return IMPOSSIBLE if $op eq '/' && $n1 % $n2
+                      || $result > 3999
+                      || $result < 0;
+
+    return to_roman($result)
+}
+
+use Test::More tests => 9 + 2;
+
+is roman_maths('IV + V'), 'IX', 'Example 1';
+is roman_maths('M - I'), 'CMXCIX', 'Example 2';
+is roman_maths('X / II'), 'V', 'Example 3';
+is roman_maths('XI * VI'), 'LXVI', 'Example 4';
+is roman_maths('VII ** III'), 'CCCXLIII', 'Example 5';
+
+is roman_maths('V - V'), 'nulla', 'Zero';
+is roman_maths('V / II'), 'non potest', 'Fraction';
+is roman_maths('MMM + M'), 'non potest', 'Overflow';
+is roman_maths('V - X'), 'non potest', 'Negative';
+
+ok ! defined eval { roman_maths('ABCD ^ XYZ'); 1 }, 'Dies';
+like $@, qr/^Parser error/, 'Exception';