Merge pull request #8457 from polettix/polettix/pwc227

Add polettix's solution to challenge-227

6 files changed, 234 insertions, 0 deletions

diff --git a/challenge-227/polettix/blog.txt b/challenge-227/polettix/blog.txt
new file mode 100644
index 0000000000..bcbb3eece6
--- /dev/null
+++ b/challenge-227/polettix/blog.txt
@@ -0,0 +1 @@
+https://etoobusy.polettix.it/2023/07/28/pwc227-friday-13th/
diff --git a/challenge-227/polettix/blog1.txt b/challenge-227/polettix/blog1.txt
new file mode 100644
index 0000000000..5e279af04a
--- /dev/null
+++ b/challenge-227/polettix/blog1.txt
@@ -0,0 +1 @@
+https://etoobusy.polettix.it/2023/07/29/pwc227-roman-maths/
diff --git a/challenge-227/polettix/perl/ch-1.pl b/challenge-227/polettix/perl/ch-1.pl
new file mode 100644
index 0000000000..c1e6f8dab7
--- /dev/null
+++ b/challenge-227/polettix/perl/ch-1.pl
@@ -0,0 +1,29 @@
+#!/usr/bin/env perl
+use v5.24;
+use warnings;
+use experimental 'signatures';
+
+say $_, ' ', friday_13th($_) for @ARGV;
+
+sub friday_13th ($year) {
+   return scalar grep { dow($year, $_, 13) == 5 } 1 .. 12;
+}
+
+sub dow ($y, $m, $d) {
+   state $calculator = $ENV{DOW_TIMEGM} ? \&dow_timegm : \&dow_algorithm;
+   return $calculator->($y, $m, $d);
+}
+
+sub dow_timegm ($y, $m, $d) {
+   require Time::Local;
+   my $epoch = Time::Local::timegm_modern(30, 30, 12, $d, $_ - 1, $y);
+   return (gmtime($epoch))[6];
+}
+
+# https://en.wikipedia.org/wiki/Determination_of_the_day_of_the_week
+sub dow_algorithm ($y, $m, $d) {
+   state $t = [0, 3, 2, 5, 0, 3, 5, 1, 4, 6, 2, 4];
+   use integer;
+   --$y if $m < 3;
+   return ($y + $y / 4 - $y / 100 + $y / 400 + $t->[$m - 1] + $d) % 7;
+}
diff --git a/challenge-227/polettix/perl/ch-2.pl b/challenge-227/polettix/perl/ch-2.pl
new file mode 100644
index 0000000000..830414922d
--- /dev/null
+++ b/challenge-227/polettix/perl/ch-2.pl
@@ -0,0 +1,96 @@
+#!/usr/bin/env perl
+use v5.24;
+use warnings;
+use experimental 'signatures';
+
+say $_, ' => ', roman_maths($_) for @ARGV;
+
+sub roman_maths ($expression) {
+   my ($first, $op, $second) = $expression =~ m{
+      \A\s* ([IVXLCDM]+) \s* ([-+/*] | \*\*) \s* ([IVXLCOM]+) \s*\z
+   }mxs or return 'nescio';
+   $first  = roman2dec_no_validate($first)  // return 'nescio';
+   $second = roman2dec_no_validate($second) // return 'nescio';
+   my $result = $op eq '+' ? ($first + $second)
+      : $op eq '-' ? ($first - $second)
+      : $op eq '*' ? ($first * $second)
+      : $op eq '/' ? ($first % $second ? -1 : $first / $second)
+      : $op eq '**' ? ($first ** $second) : 'nescio';
+   return dec2roman($result);
+   return 'non potest';
+}
+
+sub dec2roman ($dec) {
+   return 'nulla' if $dec == 0;
+   return 'non potest' if $dec < 0 || $dec >= 4000;
+   my $retval = '';
+   while ($dec > 0) {
+      if ($dec >= 1000) {
+         $retval .= 'M' x int($dec / 1000);
+         $dec %= 1000;
+      }
+      elsif ($dec >= 900) {
+         $retval .= 'CM';
+         $dec -= 900;
+      }
+      elsif ($dec >= 500) {
+         $retval .= 'D';
+         $dec -= 500;
+      }
+      elsif ($dec >= 400) {
+         $retval .= 'CD';
+         $dec -= 400;
+      }
+      elsif ($dec >= 100) {
+         $retval .= 'C' x int($dec / 100);
+         $dec %= 100;
+      }
+      elsif ($dec >= 90) {
+         $retval .= 'XC';
+         $dec -= 90;
+      }
+      elsif ($dec >= 50) {
+         $retval .= 'L';
+         $dec -= 50;
+      }
+      elsif ($dec >= 40) {
+         $retval .= 'XL';
+         $dec -= 40;
+      }
+      elsif ($dec >= 10) {
+         $retval .= 'X' x int($dec / 10);
+         $dec %= 10;
+      }
+      else {
+         state $lookup = [qw< * I II III IV V VI VII VIII IX >];
+         $retval .= $lookup->[$dec];
+         $dec = 0;
+      }
+   }
+   return $retval;
+}
+
+sub roman2dec_no_validate ($string) {
+   state $value_for = {
+      I => 1,
+      V => 5,
+      X => 10,
+      L => 50,
+      C => 100,
+      D => 500,
+      M => 1000,
+   };
+   my $accumulator = 0;
+   my $following = 0; # good enough initialization
+   for my $letter (reverse split m{}mxs, $string) {
+      my $this = $value_for->{$letter};
+      if ($this >= $following) {
+         $accumulator += $this;
+      }
+      else {
+         $accumulator -= $this;
+      }
+      $following = $this;
+   }
+   return $accumulator;
+}
diff --git a/challenge-227/polettix/raku/ch-1.raku b/challenge-227/polettix/raku/ch-1.raku
new file mode 100644
index 0000000000..dd5daec932
--- /dev/null
+++ b/challenge-227/polettix/raku/ch-1.raku
@@ -0,0 +1,7 @@
+#!/usr/bin/env raku
+use v6;
+sub MAIN (*@years) { @years.map({ put $_, ' ', friday_13th($_) }) }
+
+sub friday_13th ($year) {
+   (1..12).grep({ Date.new($year, $_, 13).day-of-week == 5 }).elems
+}
diff --git a/challenge-227/polettix/raku/ch-2.raku b/challenge-227/polettix/raku/ch-2.raku
new file mode 100644
index 0000000000..c343d1ed50
--- /dev/null
+++ b/challenge-227/polettix/raku/ch-2.raku
@@ -0,0 +1,100 @@
+#!/usr/bin/env raku
+use v6;
+sub MAIN (*@expressions) { put($_, ' => ', roman-maths($_)) for @expressions }
+
+sub roman-maths ($expression) {
+   my $match = $expression ~~ /
+   ^^
+      \s* (<[ I V X L C D M]>+)
+      \s* (<[ \- \+ \/ \*\* \* ]>+)
+      \s* (<[ I V X L C O M]>+)
+      \s*
+   $$/ or return 'nescio';
+   my $first = $match[0].Str;
+   my $op = $match[1].Str;
+   my $second = $match[2].Str;
+   $first  = roman2dec-no-validate($first)  // return 'nescio';
+   $second = roman2dec-no-validate($second) // return 'nescio';
+   my $result = $op eq '+' ?? ($first + $second)
+      !! $op eq '-' ?? ($first - $second)
+      !! $op eq '*' ?? ($first * $second)
+      !! $op eq '/' ?? ($first % $second ?? -1 !! $first / $second)
+      !! $op eq '**' ?? ($first ** $second) !! 'nescio';
+   return dec2roman($result);
+   return 'non potest';
+}
+
+sub dec2roman ($dec is copy) {
+   return 'nulla' if $dec == 0;
+   return 'non potest' if $dec < 0 || $dec >= 4000;
+   my $retval = '';
+   while $dec > 0 {
+      if $dec >= 1000 {
+         $retval ~= 'M' x ($dec div 1000);
+         $dec %= 1000;
+      }
+      elsif $dec >= 900 {
+         $retval ~= 'CM';
+         $dec -= 900;
+      }
+      elsif $dec >= 500 {
+         $retval ~= 'D';
+         $dec -= 500;
+      }
+      elsif $dec >= 400 {
+         $retval ~= 'CD';
+         $dec -= 400;
+      }
+      elsif $dec >= 100 {
+         $retval ~= 'C' x ($dec div 100);
+         $dec %= 100;
+      }
+      elsif $dec >= 90 {
+         $retval ~= 'XC';
+         $dec -= 90;
+      }
+      elsif $dec >= 50 {
+         $retval ~= 'L';
+         $dec -= 50;
+      }
+      elsif $dec >= 40 {
+         $retval ~= 'XL';
+         $dec -= 40;
+      }
+      elsif $dec >= 10 {
+         $retval ~= 'X' x ($dec div 10);
+         $dec %= 10;
+      }
+      else {
+         state @lookup = < * I II III IV V VI VII VIII IX >;
+         $retval ~= @lookup[$dec];
+         $dec = 0;
+      }
+   }
+   return $retval;
+}
+
+sub roman2dec-no-validate ($string) {
+   state %value_for =
+      I => 1,
+      V => 5,
+      X => 10,
+      L => 50,
+      C => 100,
+      D => 500,
+      M => 1000,
+   ;
+   my $accumulator = 0;
+   my $following = 0; # good enough initialization
+   for $string.comb.reverse -> $letter {
+      my $this = %value_for{$letter};
+      if $this >= $following {
+         $accumulator += $this;
+      }
+      else {
+         $accumulator -= $this;
+      }
+      $following = $this;
+   }
+   return $accumulator;
+}