Merge pull request #8435 from andemark/challenge-227-Raku

Challenge 227 Solutions (Raku)

2 files changed, 161 insertions, 0 deletions

diff --git a/challenge-227/mark-anderson/raku/ch-1.raku b/challenge-227/mark-anderson/raku/ch-1.raku
new file mode 100644
index 0000000000..2436393bb4
--- /dev/null
+++ b/challenge-227/mark-anderson/raku/ch-1.raku
@@ -0,0 +1,92 @@
+#!/usr/bin/env raku
+use Test;
+
+is friday-the-thirteenths(2023), 2;
+is friday-the-thirteenths(1753), 2;
+is friday-the-thirteenths(1761), 3;
+is friday-the-thirteenths(9999), 1;
+
+=begin com
+
+for 1753..9999 -> $year 
+{
+    my $d = Date.new(:$year);
+    my @d = map { $d.later(:month($_)) }, ^12;
+    say .fmt("%-15s") given $d.day-of-week, +$d.is-leap-year, +@d.grep(*.day-of-week == 7)
+}
+
+I used the program above (piped through sort -u) to create the chart below.
+
+Jan 1st 
+Day Of Week  Leap Year      Fri 13ths
+--------------------------------------
+1            0              2
+1            1              2
+
+2            0              2
+2            1              1
+
+3            0              1
+3            1              2
+
+4            0              3
+4            1              2
+
+5            0              1
+5            1              1
+
+6            0              1
+6            1              1
+
+7            0              2
+7            1              3
+--------------------------------------
+
+That chart can be translated into the following program.
+
+sub friday-the-thirteenths($year where * ~~ 1753..9999)
+{
+    my $d = Date.new(:$year);
+    
+    given $d.day-of-week
+    {
+        when 1  { 2 }
+        when 2  { $d.is-leap-year ?? 1 !! 2 }
+        when 3  { $d.is-leap-year ?? 2 !! 1 }
+        when 4  { $d.is-leap-year ?? 2 !! 3 }
+        when 7  { $d.is-leap-year ?? 3 !! 2 }
+        default { 1 }
+    }
+}
+
+But the sequence repeats every 400 years so this 
+can be written without creating a Date object.
+
+=end com
+
+sub friday-the-thirteenths($year where * ~~ 1753..9999)
+{
+    .[$year - 1753] given
+    <
+        2 2 1 2 1 2 2 1 3 1 1 3 2 1 3 1 2 2 2 2
+        1 1 2 2 1 3 1 1 2 2 1 2 1 2 2 1 3 1 1 3
+        2 1 3 1 2 2 2 1 3 1 1 3 2 1 3 1 2 2 2 2
+        1 1 2 2 1 3 1 1 2 2 1 2 1 2 2 1 3 1 1 3
+        2 1 3 1 2 2 2 2 1 1 2 2 1 3 1 1 2 2 1 2
+        1 2 2 1 3 1 1 3 2 1 3 1 2 2 2 2 1 1 2 2
+        1 3 1 1 2 2 1 2 1 2 2 1 3 1 1 3 2 1 3 1
+        2 2 2 2 1 1 2 2 2 1 3 1 2 2 2 2 1 1 2 2
+        1 3 1 1 2 2 1 2 1 2 2 1 3 1 1 3 2 1 3 1
+        2 2 2 2 1 1 2 2 1 3 1 1 2 2 1 2 1 2 2 1
+        3 1 1 3 2 1 3 1 2 2 2 2 1 1 2 2 1 3 1 1
+        2 2 1 2 1 2 2 1 3 1 1 3 2 1 3 1 2 2 2 2
+        1 1 2 2 1 3 1 1 2 2 1 2 1 2 2 1 3 1 1 3
+        2 1 3 1 2 2 2 2 1 1 2 2 1 3 1 1 2 2 1 2
+        1 2 2 1 3 1 1 3 2 1 3 1 2 2 2 2 1 1 2 2
+        1 3 1 1 2 2 1 2 1 2 2 1 3 1 1 3 2 1 3 1
+        2 2 2 2 1 1 2 2 1 3 1 1 2 2 1 2 1 2 2 1
+        3 1 1 3 2 1 3 1 1 2 2 1 3 1 1 3 2 1 3 1
+        2 2 2 2 1 1 2 2 1 3 1 1 2 2 1 2 1 2 2 1
+        3 1 1 3 2 1 3 1 2 2 2 2 1 1 2 2 1 3 1 1
+    >.Slip xx *
+}
diff --git a/challenge-227/mark-anderson/raku/ch-2.raku b/challenge-227/mark-anderson/raku/ch-2.raku
new file mode 100644
index 0000000000..41499a9ae8
--- /dev/null
+++ b/challenge-227/mark-anderson/raku/ch-2.raku
@@ -0,0 +1,69 @@
+#!/usr/bin/env raku
+use MONKEY-SEE-NO-EVAL;
+use Test;
+
+is roman-maths('IV + V'),     'IX';
+is roman-maths('M - I'),      'CMXCIX';
+is roman-maths('X / II'),     'V';
+is roman-maths('XI * VI'),    'LXVI';
+is roman-maths('VII ** III'), 'CCCXLIII';
+is roman-maths('V - V'),      'nulla';
+is roman-maths('V / II'),     'non potest';
+is roman-maths('MMM + M'),    'non potest';
+is roman-maths('V - X'),      'non potest';
+
+sub roman-maths($s)
+{
+    my ($a, $op, $b) = $s.split(/\s+/);
+
+    given EVAL "{r2a($a)} $op {r2a($b)}"
+    {
+        when 0  { 'nulla' }
+        when    any($_ > 3999, .narrow !~~ UInt) { 'non potest' }
+        default { a2r($_) }
+    }
+}
+
+sub a2r($a)
+{
+    my @a = $a.polymod(10 xx 3);
+
+    my @r = [ flat q{}, <I II III IV V VI VII VIII IX> ],
+            [ flat q{}, <X XX XXX XL L LX LXX LXXX XC> ],
+            [ flat q{}, <C CC CCC CD D DC DCC DCCC CM> ],
+            [ flat q{}, <M MM MMM> ];
+
+    (3...0).map({ @r[$_; @a[$_]] }).join
+}
+
+sub r2a($r)
+{
+    grammar Roman
+    {
+        has $.arabic is rw;
+
+        token TOP 
+        { 
+            <thousands>? <nine-hundred>? <five-hundred>? <four-hundred>?  
+            <hundreds>?  <ninety>?       <fifty>?        <forty>?         
+            <tens>?      <nine>?         <five>?         <four>? 
+            <ones>?  
+        }
+    
+        token thousands    { M+ { $.arabic += $/.chars * 1000 } }
+        token nine-hundred { CM { $.arabic += 900             } }
+        token five-hundred { D  { $.arabic += 500             } }
+        token four-hundred { CD { $.arabic += 400             } }
+        token hundreds     { C+ { $.arabic += $/.chars * 100  } }
+        token ninety       { XC { $.arabic += 90              } }
+        token fifty        { L  { $.arabic += 50              } }
+        token forty        { XL { $.arabic += 40              } }
+        token tens         { X+ { $.arabic += $/.chars * 10   } }
+        token nine         { IX { $.arabic += 9               } }
+        token five         { V  { $.arabic += 5               } }
+        token four         { IV { $.arabic += 4               } }
+        token ones         { I+ { $.arabic += $/.chars        } } 
+    }
+    
+    Roman.parse($r).arabic
+}