From 18e038cc7afbaeac56f72e39a795b1182c1760fd Mon Sep 17 00:00:00 2001
From: Mark <53903062+andemark@users.noreply.github.com>
Date: Mon, 24 Jul 2023 07:43:13 +0000
Subject: Challenge 227 Solutions (Raku)

---
 challenge-227/mark-anderson/raku/ch-1.raku | 92 ++++++++++++++++++++++++++++++
 challenge-227/mark-anderson/raku/ch-2.raku | 69 ++++++++++++++++++++++
 2 files changed, 161 insertions(+)
 create mode 100644 challenge-227/mark-anderson/raku/ch-1.raku
 create mode 100644 challenge-227/mark-anderson/raku/ch-2.raku

(limited to 'challenge-227')

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..dcb6459358
--- /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 $dow = $d.day-of-week;
+    my @d = map { $d.later(:month($_)) }, ^12;
+    say .fmt("%-15s") given $dow, +$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
+--------------------------------------
+
+It looks like the sequence repeats every 400 years so this
+program should also work.
+
+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 *
+}
+
+=end com
+
+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 }
+    }
+}
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
+}
-- 
cgit 


From 9b898557f361fa740f57772a6267a043703da2f8 Mon Sep 17 00:00:00 2001
From: Mark <53903062+andemark@users.noreply.github.com>
Date: Mon, 24 Jul 2023 07:58:11 +0000
Subject: Challenge 227 Solutions (Raku)

---
 challenge-227/mark-anderson/raku/ch-1.raku | 1 -
 1 file changed, 1 deletion(-)

(limited to 'challenge-227')

diff --git a/challenge-227/mark-anderson/raku/ch-1.raku b/challenge-227/mark-anderson/raku/ch-1.raku
index dcb6459358..a9b05ce374 100644
--- a/challenge-227/mark-anderson/raku/ch-1.raku
+++ b/challenge-227/mark-anderson/raku/ch-1.raku
@@ -14,7 +14,6 @@ for 1753..9999 -> $year
     my $dow = $d.day-of-week;
     my @d = map { $d.later(:month($_)) }, ^12;
     say .fmt("%-15s") given $dow, +$d.is-leap-year, +@d.grep(*.day-of-week == 7)
-     
 }
 
 I used the program above (piped through sort -u) to create the chart below.
-- 
cgit 


From 6b772cb64e72b62bb70c30b130ddf85a42d95342 Mon Sep 17 00:00:00 2001
From: Andrey Shitov <ash@Andreys-iMac.local>
Date: Mon, 24 Jul 2023 11:39:14 +0300
Subject: ash-227, task 1 in Raku

---
 challenge-227/ash/raku/ch-1.raku  | 42 +++++++++++++++++++++++++++++++++++++++
 challenge-227/ash/raku/ch-1a.raku | 12 +++++++++++
 challenge-227/ash/raku/ch-1b.raku |  7 +++++++
 3 files changed, 61 insertions(+)
 create mode 100644 challenge-227/ash/raku/ch-1.raku
 create mode 100644 challenge-227/ash/raku/ch-1a.raku
 create mode 100644 challenge-227/ash/raku/ch-1b.raku

(limited to 'challenge-227')

diff --git a/challenge-227/ash/raku/ch-1.raku b/challenge-227/ash/raku/ch-1.raku
new file mode 100644
index 0000000000..7adc344024
--- /dev/null
+++ b/challenge-227/ash/raku/ch-1.raku
@@ -0,0 +1,42 @@
+# Solution to the Task 1 of the Weekly Challenge 227
+# https://theweeklychallenge.org/blog/perl-weekly-challenge-227/#TASK1
+
+# Explanations:
+# https://andrewshitov.com/2023/07/24/counting-friday-the-13th-in-raku/
+
+# Test run:
+# $ raku ch-1.raku     
+# There are 2 Fridays the 13th in 2023:
+# 01-13-2023
+# 10-13-2023
+
+# $ raku ch-1.raku 2021
+# There is only one Friday the 13th in 2021:
+# 08-13-2021
+
+
+my $year = @*ARGS[0] // 2023;
+
+my @dates;
+for 1..12 -> $month {
+    my $dt = DateTime.new(year => $year, month => $month, day => 13);
+    if ($dt.day-of-week == 5) {
+        push @dates, $dt;
+    }
+}
+
+if @dates {
+    my $count = @dates.elems;
+
+    if $count == 1 {
+        say "There is only one Friday the 13th in $year:";
+    }
+    else {
+        say "There are {@dates.elems} Fridays the 13th in $year:";
+    }
+
+    .mm-dd-yyyy.say for @dates;
+}
+else {
+    say "There are no Friday the 13th in $year.";
+}
diff --git a/challenge-227/ash/raku/ch-1a.raku b/challenge-227/ash/raku/ch-1a.raku
new file mode 100644
index 0000000000..d81d426e9f
--- /dev/null
+++ b/challenge-227/ash/raku/ch-1a.raku
@@ -0,0 +1,12 @@
+sub count-friday-the13s($year) {
+    my $count = 0;
+
+    for 1..12 -> $month {
+        my $dt = DateTime.new(year => $year, month => $month, day => 13);
+        $count++ if $dt.day-of-week == 5;
+    }
+
+    return $count;
+}
+
+say count-friday-the13s(2023);
diff --git a/challenge-227/ash/raku/ch-1b.raku b/challenge-227/ash/raku/ch-1b.raku
new file mode 100644
index 0000000000..faf8d4516d
--- /dev/null
+++ b/challenge-227/ash/raku/ch-1b.raku
@@ -0,0 +1,7 @@
+sub count-friday-the13s($year) {
+    [+] map {
+        5 == DateTime.new(year => $year, month => $_, day => 13).day-of-week
+    }, 1..12;   
+}
+
+say count-friday-the13s(2023);
-- 
cgit 


From e95d4e36d8582956966a1ebd3cd7df48ab39089b Mon Sep 17 00:00:00 2001
From: Scimon <simon.proctor@gmail.com>
Date: Mon, 24 Jul 2023 10:13:54 +0100
Subject: Challenge 1

---
 challenge-227/simon-proctor/raku/ch-1.raku | 12 ++++++++++++
 1 file changed, 12 insertions(+)
 create mode 100644 challenge-227/simon-proctor/raku/ch-1.raku

(limited to 'challenge-227')

diff --git a/challenge-227/simon-proctor/raku/ch-1.raku b/challenge-227/simon-proctor/raku/ch-1.raku
new file mode 100644
index 0000000000..4cfb804d05
--- /dev/null
+++ b/challenge-227/simon-proctor/raku/ch-1.raku
@@ -0,0 +1,12 @@
+#!/usr/bin/env raku
+
+#| Given a year between 1753 and 9999 print the number of friday the 13ths
+sub MAIN(
+    Int() $year where 1753 <= * <= 9999 #= Year between 1753 and 9999
+) {
+    (1..12)
+    .map( -> $m { Date.new($year,$m,13) } )
+    .grep( -> $d { $d.day-of-week == 5 } )
+    .elems
+    .say;
+}
-- 
cgit 


From bc54598bbc43e5fa9e8d9735152968905cae94fc Mon Sep 17 00:00:00 2001
From: Lubos Kolouch <lubos@kolouch.net>
Date: Mon, 24 Jul 2023 15:43:33 +0200
Subject: feat(challenge-227/lubos-kolouch/perl,python/): Challenge 227 LK Perl
 Python

---
 challenge-227/lubos-kolouch/perl/ch-1.pl   | 28 ++++++++++++++++++
 challenge-227/lubos-kolouch/perl/ch-2.pl   | 46 ++++++++++++++++++++++++++++++
 challenge-227/lubos-kolouch/python/ch-1.py | 19 ++++++++++++
 challenge-227/lubos-kolouch/python/ch-2.py | 44 ++++++++++++++++++++++++++++
 4 files changed, 137 insertions(+)
 create mode 100644 challenge-227/lubos-kolouch/perl/ch-1.pl
 create mode 100644 challenge-227/lubos-kolouch/perl/ch-2.pl
 create mode 100644 challenge-227/lubos-kolouch/python/ch-1.py
 create mode 100644 challenge-227/lubos-kolouch/python/ch-2.py

(limited to 'challenge-227')

diff --git a/challenge-227/lubos-kolouch/perl/ch-1.pl b/challenge-227/lubos-kolouch/perl/ch-1.pl
new file mode 100644
index 0000000000..b39884e002
--- /dev/null
+++ b/challenge-227/lubos-kolouch/perl/ch-1.pl
@@ -0,0 +1,28 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use DateTime;
+
+sub friday_13ths {
+  my ($year) = @_;
+
+  my $dt = DateTime->new(
+    year => $year,
+    month => 1,
+    day => 1
+  );
+
+  my $friday_13_count = 0;
+
+  while ($dt->year == $year) {
+    if ($dt->day_of_week == 5 && $dt->day == 13) {
+      $friday_13_count++;
+    }
+    $dt->add(days => 1);
+  }
+
+  return $friday_13_count;
+}
+
+print friday_13ths(2023), "\n"; # 2
diff --git a/challenge-227/lubos-kolouch/perl/ch-2.pl b/challenge-227/lubos-kolouch/perl/ch-2.pl
new file mode 100644
index 0000000000..ab1caf8030
--- /dev/null
+++ b/challenge-227/lubos-kolouch/perl/ch-2.pl
@@ -0,0 +1,46 @@
+use Roman;
+
+sub roman_maths {
+    my ($expr) = @_;
+    # Parse the expression into two Roman numerals and the operation
+    my ($num1, $op, $num2) = split / /, $expr;
+    $num1 = arabic($num1);
+    $num2 = arabic($num2);
+    # Perform the operation
+    my $result;
+    if ($op eq '+') {
+        $result = $num1 + $num2;
+    } elsif ($op eq '-') {
+        $result = $num1 - $num2;
+    } elsif ($op eq '*') {
+        $result = $num1 * $num2;
+    } elsif ($op eq '/') {
+        if ($num2 == 0) {
+            return "non potest";  # they didn't do fractions
+        }
+        $result = int($num1 / $num2);
+    } elsif ($op eq '**') {
+        $result = $num1 ** $num2;
+    } else {
+        return "Invalid operation";
+    }
+    # Check the result
+    if ($result <= 0) {
+        return "nulla" if $result == 0;  # they didn't do negative numbers
+        return "non potest";
+    } elsif ($result > 3999) {
+        return "non potest";  # they only went up to 3999
+    }
+    # Convert the result back into a Roman numeral
+    return Roman($result);
+}
+
+print roman_maths("IV + V"), "\n";  # should print IX
+print roman_maths("M - I"), "\n";  # should print CMXCIX
+print roman_maths("X / II"), "\n";  # should print V
+print roman_maths("XI * VI"), "\n";  # should print LXVI
+print roman_maths("VII ** III"), "\n";  # should print CCCXLIII
+print roman_maths("V - V"), "\n";  # should print nulla
+print roman_maths("V / II"), "\n";  # should print non potest
+print roman_maths("MMM + M"), "\n";  # should print non potest
+print roman_maths("V - X"), "\n";  # should print non potest
diff --git a/challenge-227/lubos-kolouch/python/ch-1.py b/challenge-227/lubos-kolouch/python/ch-1.py
new file mode 100644
index 0000000000..1a2e1d0042
--- /dev/null
+++ b/challenge-227/lubos-kolouch/python/ch-1.py
@@ -0,0 +1,19 @@
+#!/usr/bin/env python
+# -*- coding: utf-8 -*-
+
+from datetime import datetime, timedelta
+
+
+def friday_13ths(year):
+    dt = datetime(year, 1, 1)
+    friday_13_count = 0
+
+    while dt.year == year:
+        if dt.weekday() == 4 and dt.day == 13:
+            friday_13_count += 1
+        dt += timedelta(days=1)
+
+    return friday_13_count
+
+
+print(friday_13ths(2023))  # 2
diff --git a/challenge-227/lubos-kolouch/python/ch-2.py b/challenge-227/lubos-kolouch/python/ch-2.py
new file mode 100644
index 0000000000..9c2e4a9ee2
--- /dev/null
+++ b/challenge-227/lubos-kolouch/python/ch-2.py
@@ -0,0 +1,44 @@
+#!/usr/bin/env python
+# -*- coding: utf-8 -*-
+
+import roman
+
+
+def roman_maths(expr):
+    # Parse the expression into two Roman numerals and the operation
+    num1, op, num2 = expr.split()
+    num1 = roman.fromRoman(num1.upper())
+    num2 = roman.fromRoman(num2.upper())
+    # Perform the operation
+    if op == '+':
+        result = num1 + num2
+    elif op == '-':
+        result = num1 - num2
+    elif op == '*':
+        result = num1 * num2
+    elif op == '/':
+        if num2 == 0:
+            return "non potest"  # they didn't do fractions
+        result = num1 // num2
+    elif op == '**':
+        result = num1 ** num2
+    else:
+        return "Invalid operation"
+    # Check the result
+    if result <= 0:
+        return "nulla" if result == 0 else "non potest"  # they didn't do negative numbers
+    elif result > 3999:
+        return "non potest"  # they only went up to 3999
+    # Convert the result back into a Roman numeral
+    return roman.toRoman(result)
+
+
+print(roman_maths("IV + V"))  # should print IX
+print(roman_maths("M - I"))  # should print CMXCIX
+print(roman_maths("X / II"))  # should print V
+print(roman_maths("XI * VI"))  # should print LXVI
+print(roman_maths("VII ** III"))  # should print CCCXLIII
+print(roman_maths("V - V"))  # should print nulla
+print(roman_maths("V / II"))  # should print non potest
+print(roman_maths("MMM + M"))  # should print non potest
+print(roman_maths("V - X"))  # should print non potest
-- 
cgit 


From e2ffd2e9cd047508a245b5b6ad8caf984b0e824a Mon Sep 17 00:00:00 2001
From: Mark <53903062+andemark@users.noreply.github.com>
Date: Mon, 24 Jul 2023 13:53:02 +0000
Subject: Challenge 227 Solutions (Raku)

---
 challenge-227/mark-anderson/raku/ch-1.raku | 43 +++++++++++++++---------------
 1 file changed, 22 insertions(+), 21 deletions(-)

(limited to 'challenge-227')

diff --git a/challenge-227/mark-anderson/raku/ch-1.raku b/challenge-227/mark-anderson/raku/ch-1.raku
index a9b05ce374..ffd28592fc 100644
--- a/challenge-227/mark-anderson/raku/ch-1.raku
+++ b/challenge-227/mark-anderson/raku/ch-1.raku
@@ -11,9 +11,8 @@ is friday-the-thirteenths(9999), 1;
 for 1753..9999 -> $year 
 {
     my $d = Date.new(:$year);
-    my $dow = $d.day-of-week;
     my @d = map { $d.later(:month($_)) }, ^12;
-    say .fmt("%-15s") given $dow, +$d.is-leap-year, +@d.grep(*.day-of-week == 7)
+    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.
@@ -43,8 +42,27 @@ Day Of Week  Leap Year      Fri 13ths
 7            1              3
 --------------------------------------
 
-It looks like the sequence repeats every 400 years so this
-program should also work.
+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 it looks like 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)
 {
@@ -72,20 +90,3 @@ sub friday-the-thirteenths($year where * ~~ 1753..9999)
         3 1 1 3 2 1 3 1 2 2 2 2 1 1 2 2 1 3 1 1
     >.Slip xx *
 }
-
-=end com
-
-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 }
-    }
-}
-- 
cgit 


From 9de2c426a8cee7362b2eff1c64f5378c18d574f3 Mon Sep 17 00:00:00 2001
From: Luca Ferrari <fluca1978@gmail.com>
Date: Mon, 24 Jul 2023 19:47:20 +0200
Subject: Task 1 done

Task 2 done

Task 1 plperl done

Task 2 plperl done

Task 1 done

Task 2 plpgsql done

Blog references
---
 challenge-227/luca-ferrari/blog-1.txt             |   1 +
 challenge-227/luca-ferrari/blog-2.txt             |   1 +
 challenge-227/luca-ferrari/blog-3.txt             |   1 +
 challenge-227/luca-ferrari/blog-4.txt             |   1 +
 challenge-227/luca-ferrari/blog-5.txt             |   1 +
 challenge-227/luca-ferrari/blog-6.txt             |   1 +
 challenge-227/luca-ferrari/postgresql/ch-1.plperl |  25 +++++
 challenge-227/luca-ferrari/postgresql/ch-1.sql    |  27 ++++++
 challenge-227/luca-ferrari/postgresql/ch-2.plperl |  80 ++++++++++++++++
 challenge-227/luca-ferrari/postgresql/ch-2.sql    | 108 ++++++++++++++++++++++
 challenge-227/luca-ferrari/raku/ch-1.p6           |  19 ++++
 challenge-227/luca-ferrari/raku/ch-2.p6           |  74 +++++++++++++++
 12 files changed, 339 insertions(+)
 create mode 100644 challenge-227/luca-ferrari/blog-1.txt
 create mode 100644 challenge-227/luca-ferrari/blog-2.txt
 create mode 100644 challenge-227/luca-ferrari/blog-3.txt
 create mode 100644 challenge-227/luca-ferrari/blog-4.txt
 create mode 100644 challenge-227/luca-ferrari/blog-5.txt
 create mode 100644 challenge-227/luca-ferrari/blog-6.txt
 create mode 100644 challenge-227/luca-ferrari/postgresql/ch-1.plperl
 create mode 100644 challenge-227/luca-ferrari/postgresql/ch-1.sql
 create mode 100644 challenge-227/luca-ferrari/postgresql/ch-2.plperl
 create mode 100644 challenge-227/luca-ferrari/postgresql/ch-2.sql
 create mode 100644 challenge-227/luca-ferrari/raku/ch-1.p6
 create mode 100644 challenge-227/luca-ferrari/raku/ch-2.p6

(limited to 'challenge-227')

diff --git a/challenge-227/luca-ferrari/blog-1.txt b/challenge-227/luca-ferrari/blog-1.txt
new file mode 100644
index 0000000000..fa2952f623
--- /dev/null
+++ b/challenge-227/luca-ferrari/blog-1.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/07/24/PerlWeeklyChallenge227.html#task1
diff --git a/challenge-227/luca-ferrari/blog-2.txt b/challenge-227/luca-ferrari/blog-2.txt
new file mode 100644
index 0000000000..a598730e67
--- /dev/null
+++ b/challenge-227/luca-ferrari/blog-2.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/07/24/PerlWeeklyChallenge227.html#task2
diff --git a/challenge-227/luca-ferrari/blog-3.txt b/challenge-227/luca-ferrari/blog-3.txt
new file mode 100644
index 0000000000..851f75b38c
--- /dev/null
+++ b/challenge-227/luca-ferrari/blog-3.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/07/24/PerlWeeklyChallenge227.html#task1plperl
diff --git a/challenge-227/luca-ferrari/blog-4.txt b/challenge-227/luca-ferrari/blog-4.txt
new file mode 100644
index 0000000000..1a7bc7ba29
--- /dev/null
+++ b/challenge-227/luca-ferrari/blog-4.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/07/24/PerlWeeklyChallenge227.html#task2plperl
diff --git a/challenge-227/luca-ferrari/blog-5.txt b/challenge-227/luca-ferrari/blog-5.txt
new file mode 100644
index 0000000000..4bfd9bf593
--- /dev/null
+++ b/challenge-227/luca-ferrari/blog-5.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/07/24/PerlWeeklyChallenge227.html#task1plpgsql
diff --git a/challenge-227/luca-ferrari/blog-6.txt b/challenge-227/luca-ferrari/blog-6.txt
new file mode 100644
index 0000000000..15c3922562
--- /dev/null
+++ b/challenge-227/luca-ferrari/blog-6.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2023/07/24/PerlWeeklyChallenge227.html#task2plpgsql
diff --git a/challenge-227/luca-ferrari/postgresql/ch-1.plperl b/challenge-227/luca-ferrari/postgresql/ch-1.plperl
new file mode 100644
index 0000000000..9cc242ad14
--- /dev/null
+++ b/challenge-227/luca-ferrari/postgresql/ch-1.plperl
@@ -0,0 +1,25 @@
+--
+-- Perl Weekly Challenge 227
+-- Task 1
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-227/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc227;
+
+CREATE OR REPLACE FUNCTION
+pwc227.task1_plperl( int )
+RETURNS int
+AS $CODE$
+   my ( $year ) = @_;
+   my $fridays = 0;
+   
+   use DateTime;
+   my $day = DateTime->new( year => $year, day => 13, month => 1 );
+   while ( $day->month <= 12 && $day->year == $year ) {
+   	 $fridays++ if ( $day->day_abbr eq 'Fri' );
+	 $day->add(  months => 1  );
+   }
+
+   return $fridays;
+$CODE$
+LANGUAGE plperlu;
diff --git a/challenge-227/luca-ferrari/postgresql/ch-1.sql b/challenge-227/luca-ferrari/postgresql/ch-1.sql
new file mode 100644
index 0000000000..fea32c14fa
--- /dev/null
+++ b/challenge-227/luca-ferrari/postgresql/ch-1.sql
@@ -0,0 +1,27 @@
+--
+-- Perl Weekly Challenge 227
+-- Task 1
+--
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-227/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc227;
+
+CREATE OR REPLACE FUNCTION
+pwc227.task1_plpgsql( y int)
+RETURNS int
+AS $CODE$
+DECLARE
+	fridays int := 0;
+	m int;
+BEGIN
+	FOR m IN 1 .. 12 LOOP
+	    IF extract( dow FROM make_date( y, m, 13 ) ) = 5 THEN
+	       fridays := fridays + 1;
+	    END IF;
+	END LOOP;
+
+	RETURN fridays;
+END
+$CODE$
+LANGUAGE plpgsql;
diff --git a/challenge-227/luca-ferrari/postgresql/ch-2.plperl b/challenge-227/luca-ferrari/postgresql/ch-2.plperl
new file mode 100644
index 0000000000..802920a72b
--- /dev/null
+++ b/challenge-227/luca-ferrari/postgresql/ch-2.plperl
@@ -0,0 +1,80 @@
+--
+-- Perl Weekly Challenge 227
+-- Task 2
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-227/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc227;
+
+CREATE OR REPLACE FUNCTION
+pwc227.task2_plperl( text, text, text )
+RETURNS text
+AS $CODE$
+   use v5.20;
+   my ( $left, $operator, $right ) = @_;
+
+   my $symbols = {
+          1 => 'I',
+	  4 => 'IV',	  
+	  5 => 'V',	  
+	  9 => 'IX',	  
+	 10 => 'X',	  
+	 40 => 'XL',
+	 50 => 'L',
+	 90 => 'XC',
+	 100 => 'C',
+	 400 => 'CD',
+	 500 => 'D',
+	 900 => 'CM',
+	1000 => 'M'
+      };
+
+
+   my $unsymbols = {};
+   $unsymbols->{ $symbols->{ $_ } } = $_   for ( keys $symbols->%* );
+
+
+
+   use Sub::Recursive;
+
+   my $to_roman = recursive {
+      my ( $number ) = @_;
+
+      
+
+
+      return '' if ! $number;
+
+      for my $arabic ( sort  { $b <=> $a } keys $symbols->%* ) {
+      	  if ( $number >= $arabic ) {
+	     return $symbols->{ $arabic } . $REC->( $number - $arabic );
+	  }
+      }
+
+   };
+
+
+   my $to_arabic = sub {
+      my ( $number ) = @_;
+      my $value = 0;
+      for my $roman ( reverse sort keys $unsymbols->%* ) {
+      	  $value += $unsymbols->{ $roman } while $number =~ s/^$roman//i;
+      }
+
+      return $value;
+   };
+
+
+   my $result = 0;
+   given ( $operator ) {
+   	 when (/\+/) { $result = $to_arabic->( $left ) + $to_arabic->( $right ); }
+    	 when (/\-/) { $result = $to_arabic->( $left ) - $to_arabic->( $right ); }
+   	 when (/\//) { $result = $to_arabic->( $left ) / $to_arabic->( $right ); }
+   	 when (/\*/) { $result = $to_arabic->( $left ) * $to_arabic->( $right ); }	 
+   }
+
+   return undef if ( $result < 1 );
+   return $to_roman->( $result );
+
+$CODE$
+LANGUAGE plperlu;
diff --git a/challenge-227/luca-ferrari/postgresql/ch-2.sql b/challenge-227/luca-ferrari/postgresql/ch-2.sql
new file mode 100644
index 0000000000..df110b1be6
--- /dev/null
+++ b/challenge-227/luca-ferrari/postgresql/ch-2.sql
@@ -0,0 +1,108 @@
+--
+-- Perl Weekly Challenge 227
+-- Task 2
+--
+-- See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-227/>
+--
+
+CREATE SCHEMA IF NOT EXISTS pwc227;
+
+
+CREATE  TABLE IF NOT EXISTS pwc227.roman( r text, n int );
+
+TRUNCATE TABLE pwc227.roman;
+
+INSERT INTO pwc227.roman
+VALUES
+('I', 1 )
+,( 'IV', 4 )
+,( 'V', 5 )
+,( 'IX', 9 )
+,( 'X', 10 )
+,( 'XL', 40 )
+,( 'L', 50 )
+,( 'XC', 90 )
+,( 'C', 100 )
+,( 'CD', 400 )
+,( 'D', 500 )
+,( 'CM', 900 )
+,( 'M', 1000 );
+
+
+
+
+CREATE OR REPLACE FUNCTION
+pwc227.to_roman( n int )
+RETURNS text
+AS $CODE$
+
+DECLARE
+	roman_value text := '';
+        current_record pwc227.roman%rowtype;
+BEGIN
+	IF n <= 0 THEN
+	   RETURN NULL;
+	END IF;
+
+	IF n = 1 THEN
+	   RETURN 'I';
+	END IF;
+
+	FOR current_record IN SELECT * FROM pwc227.roman ORDER BY n DESC LOOP
+
+	    WHILE n >= current_record.n LOOP
+	       roman_value := roman_value || current_record.r;
+	       n := n - current_record.n;
+	    END LOOP;
+	END LOOP;
+
+	RETURN roman_value;
+END
+$CODE$
+LANGUAGE plpgsql;
+
+
+CREATE OR REPLACE FUNCTION
+pwc227.from_roman( r text )
+RETURNS int
+AS $CODE$
+DECLARE
+	v int := 0;
+	current_record pwc227.roman%rowtype;
+BEGIN
+	FOR current_record IN SELECT * FROM pwc227.roman ORDER BY n DESC LOOP
+	    WHILE r ~ ( '^' || current_record.r)	   LOOP
+	       v := v + current_record.n;
+	       r := regexp_replace( r, '^' || current_record.r, '' );
+	    END LOOP;
+	END LOOP;
+
+	RETURN v;
+END
+$CODE$
+LANGUAGE plpgsql;
+
+
+
+CREATE OR REPLACE FUNCTION
+pwc227.task2_plpgsql( a text, op text, b text )
+RETURNS text
+AS $CODE$
+DECLARE
+	v int;
+BEGIN
+	IF op = '+' THEN
+	   v := pwc227.from_roman( a ) + pwc227.from_roman( b );
+	ELSIF op = '-' THEN
+	   v := pwc227.from_roman( a ) - pwc227.from_roman( b );
+	ELSIF op = '*' THEN
+	  v := pwc227.from_roman( a ) * pwc227.from_roman( b );
+	ELSIF op = '/' THEN
+   	  v := pwc227.from_roman( a ) / pwc227.from_roman( b );
+	END IF;
+
+	RETURN pwc227.to_roman( v );
+
+END
+$CODE$
+LANGUAGE plpgsql;
diff --git a/challenge-227/luca-ferrari/raku/ch-1.p6 b/challenge-227/luca-ferrari/raku/ch-1.p6
new file mode 100644
index 0000000000..c9068592ab
--- /dev/null
+++ b/challenge-227/luca-ferrari/raku/ch-1.p6
@@ -0,0 +1,19 @@
+#!raku
+
+#
+# Perl Weekly Challenge 227
+# Task 1
+#
+# See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-227/>
+#
+
+sub MAIN( Int $year where { 1753 <= $year <= 9999 }, Bool :$verbose = True ) {
+    my @fridays;
+    for 1 .. 12 -> $month {
+	my $day = Date.new( year => $year, day => 13, month => $month );
+	@fridays.push: $day if ( $day.day-of-week == 5 );
+    }
+
+    @fridays.elems.say;
+    @fridays.join( ', ' ).say if $verbose;
+}
diff --git a/challenge-227/luca-ferrari/raku/ch-2.p6 b/challenge-227/luca-ferrari/raku/ch-2.p6
new file mode 100644
index 0000000000..c57f2c3963
--- /dev/null
+++ b/challenge-227/luca-ferrari/raku/ch-2.p6
@@ -0,0 +1,74 @@
+#!raku
+
+#
+# Perl Weekly Challenge 227
+# Task 2
+#
+# See <https://perlweeklychallenge.org/blog/perl-weekly-challenge-227/>
+#
+
+sub rom-to-num($r) {
+    [+] gather $r.uc ~~ /
+        ^
+        [
+        | M  { take 1000 }
+        | CM { take 900 }
+        | D  { take 500 }
+        | CD { take 400 }
+        | C  { take 100 }
+        | XC { take 90 }
+        | L  { take 50 }
+        | XL { take 40 }
+        | X  { take 10 }
+        | IX { take 9 }
+        | V  { take 5 }
+        | IV { take 4 }
+        | I  { take 1 }
+        ]+
+        $
+    /;
+}
+
+
+my %symbols =
+    1 => 'I',
+    4 => 'IV',
+    5 => 'V',
+    9 => 'IX',
+    10 => 'X',
+    40 => 'XL',
+    50 => 'L',
+    90 => 'XC',
+    100 => 'C',
+    400 => 'CD',
+    500 => 'D',
+    900 => 'CM',
+    1000 => 'M'
+;
+
+sub arabic-to-roman( $number ) {
+    return ''  if $number == 0;
+
+    for %symbols.keys.sort( { $^b <=> $^a } ) {
+	if $number >= $_ {
+	    return %symbols{ $_ } ~ arabic-to-roman( $number - $_ );
+	}
+    }
+
+}
+
+sub MAIN( *@s where { @s.elems == 3 } ) {
+
+    my @operands = rom-to-num( @s[ 0 ] ), rom-to-num( @s[ 2 ] );
+    my $result;
+    given ( @s[ 1 ] ) {
+	when '+' { $result = [+] @operands; }
+	when '-' { $result = [-] @operands; }
+	when '*' { $result = [*] @operands; }
+	when '/' { $result = [/] @operands; }
+
+    }
+
+    exit if $result <= 0;
+    say arabic-to-roman( $result );
+}
-- 
cgit 


From 7ff3c614762e0ab63c6ea0d88c882c916dcc8cf2 Mon Sep 17 00:00:00 2001
From: David Ferrone <zapwai@gmail.com>
Date: Mon, 24 Jul 2023 11:28:03 -0400
Subject: Week 227

---
 challenge-227/zapwai/perl/ch-1.pl | 63 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 63 insertions(+)
 create mode 100644 challenge-227/zapwai/perl/ch-1.pl

(limited to 'challenge-227')

diff --git a/challenge-227/zapwai/perl/ch-1.pl b/challenge-227/zapwai/perl/ch-1.pl
new file mode 100644
index 0000000000..2084afe097
--- /dev/null
+++ b/challenge-227/zapwai/perl/ch-1.pl
@@ -0,0 +1,63 @@
+use v5.30;
+my $year = 2023;	    # between 1753 (begins on monday) and 9999
+my $str;
+say "Input: \$year = $year";
+say "Output: " . fri_13_count($year);
+say $str;
+
+sub fri_13_count {
+    my $year = shift;
+    return check_each_month(start_day($year), is_leap($year));
+}
+
+sub is_leap {
+    my $year = shift;
+    my $ans = 0;
+    unless ( $year % 100 == 0 ) {
+	$ans = 1 if ( $year % 4 == 0 );
+    }
+    $ans = 1 if ( $year % 400 == 0 );
+    return $ans;
+}
+
+sub start_day {
+    my $year = shift;
+    my $day;
+    my @day = ('M', 'T', 'W', 'H', 'F', 'S', 'N');
+    # Move ahead one day each year (two after a leap year)
+    my $steps = ($year - 1753) % 400;
+    my $cnt = 0;
+    unless ($steps == 0) {
+	for my $i (1 .. $steps) {
+	    $cnt = ($cnt + 1) % 7;
+	    $cnt = ($cnt + 1) % 7 if (is_leap(-1 + $year + $i - $steps));
+	}
+    }
+    $day = $day[$cnt];
+    return $day;
+}
+
+sub check_each_month {
+    my ($start_day, $leap) = @_;
+    my @day = ('M', 'T', 'W', 'H', 'F', 'S', 'N');    
+    my @gap = (12, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30);
+    $gap[1]++ if ($leap);
+    my $number_of_fri13 = 0;
+    my $cnt = 0;    # day of the week, convoluted for readability, heh
+    for (0 .. $#day) {
+	$cnt = $_ if ($day[$_] eq $start_day);
+    }
+    # start_day is jan 1. We add 12 days to check jan 13. (month i = 0)
+    # add 31 days to check Feb 13. (month i = 1)
+    # Add 28 (or 29 if $leap == 1) to check Mar 13. etc.
+
+    for my $i (0 .. 11) {
+	$cnt = ($cnt + $gap[$i]) % 7;
+	my $day = $day[$cnt];	
+	if ($day eq 'F') {
+	    $number_of_fri13++;
+	    $str .= $i+1 ."-13-$year is a Friday.\n";
+	}
+    }
+    return $number_of_fri13;
+}
-- 
cgit 


From 7dabef518a49a50cfb199ccc917e85f14f12743a Mon Sep 17 00:00:00 2001
From: Thomas Köhler <jean-luc@picard.franken.de>
Date: Mon, 24 Jul 2023 18:02:57 +0200
Subject: Add solution 227
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Signed-off-by: Thomas Köhler <jean-luc@picard.franken.de>
---
 challenge-227/jeanluc2020/blog-1.txt   |  1 +
 challenge-227/jeanluc2020/blog-2.txt   |  1 +
 challenge-227/jeanluc2020/perl/ch-1.pl | 50 ++++++++++++++++++++++++++
 challenge-227/jeanluc2020/perl/ch-2.pl | 64 ++++++++++++++++++++++++++++++++++
 4 files changed, 116 insertions(+)
 create mode 100644 challenge-227/jeanluc2020/blog-1.txt
 create mode 100644 challenge-227/jeanluc2020/blog-2.txt
 create mode 100755 challenge-227/jeanluc2020/perl/ch-1.pl
 create mode 100755 challenge-227/jeanluc2020/perl/ch-2.pl

(limited to 'challenge-227')

diff --git a/challenge-227/jeanluc2020/blog-1.txt b/challenge-227/jeanluc2020/blog-1.txt
new file mode 100644
index 0000000000..39a82175a5
--- /dev/null
+++ b/challenge-227/jeanluc2020/blog-1.txt
@@ -0,0 +1 @@
+http://gott-gehabt.de/800_wer_wir_sind/thomas/Homepage/Computer/perl/theweeklychallenge-227-1.html
diff --git a/challenge-227/jeanluc2020/blog-2.txt b/challenge-227/jeanluc2020/blog-2.txt
new file mode 100644
index 0000000000..57782e3dad
--- /dev/null
+++ b/challenge-227/jeanluc2020/blog-2.txt
@@ -0,0 +1 @@
+http://gott-gehabt.de/800_wer_wir_sind/thomas/Homepage/Computer/perl/theweeklychallenge-227-2.html
diff --git a/challenge-227/jeanluc2020/perl/ch-1.pl b/challenge-227/jeanluc2020/perl/ch-1.pl
new file mode 100755
index 0000000000..511da5268c
--- /dev/null
+++ b/challenge-227/jeanluc2020/perl/ch-1.pl
@@ -0,0 +1,50 @@
+#!/usr/bin/perl
+# https://theweeklychallenge.org/blog/perl-weekly-challenge-227/#TASK1
+#
+# Task 1: Friday 13th
+# ===================
+#
+# You are given a year number in the range 1753 to 9999.
+#
+# Write a script to find out how many dates in the year are Friday 13th, assume that the current Gregorian calendar applies.
+#
+## Example
+##
+## Input: $year = 2023
+## Output: 2
+##
+## Since there are only 2 Friday 13th in the given year 2023 i.e. 13th Jan and 13th Oct.
+#
+############################################################
+##
+## discussion
+##
+############################################################
+#
+# This is a classic "use a module from CPAN" problem.
+# DateTime lets us do all we need here very simple.
+# Just create a new DateTime object for the 13th of each
+# month of the given year and check whether its weekday is
+# Friday.
+
+use strict;
+use warnings;
+use DateTime;
+
+friday_13th(2023);
+
+sub friday_13th {
+   my $year = shift;
+   print "Input: \$year = $year\n";
+   my $count = 0;
+   foreach my $month (1..12) {
+      my $dt = DateTime->new(
+         year => $year,
+         month => $month,
+         day => 13
+      );
+      $count++ if $dt->day_of_week == 5;
+   }
+   print "Output: $count\n";
+}
+
diff --git a/challenge-227/jeanluc2020/perl/ch-2.pl b/challenge-227/jeanluc2020/perl/ch-2.pl
new file mode 100755
index 0000000000..5a25d434fb
--- /dev/null
+++ b/challenge-227/jeanluc2020/perl/ch-2.pl
@@ -0,0 +1,64 @@
+#!/usr/bin/perl
+# https://theweeklychallenge.org/blog/perl-weekly-challenge-227/#TASK2
+#
+# Task 2: Roman Maths
+# ===================
+#
+# Write a script to handle a 2-term arithmetic operation expressed in Roman numeral.
+#
+# Example
+#
+# IV + V     => IX
+# M - I      => CMXCIX
+# X / II     => V
+# XI * VI    => LXVI
+# VII ** III => CCCXLIII
+# V - V      => nulla (they knew about zero but didn't have a symbol)
+# V / II     => non potest (they didn't do fractions)
+# MMM + M    => non potest (they only went up to 3999)
+# V - X      => non potest (they didn't do negative numbers)
+#
+############################################################
+##
+## discussion
+##
+############################################################
+#
+# We use the Roman module from CPAN to convert from/to Roman
+# numbers. The rest is handling the operand and the special
+# cases for the results
+#
+use strict;
+use warnings;
+use Roman;
+
+roman_maths("IV", "+", "V");
+roman_maths("M", "-", "I");
+roman_maths("X", "/", "II");
+roman_maths("XI", "*", "VI");
+roman_maths("VII", "**", "III");
+roman_maths("V", "-", "V");
+roman_maths("V", "/", "II");
+roman_maths("MMM", "+", "M");
+roman_maths("V", "-", "X");
+
+sub roman_maths {
+   my ($num1, $oper, $num2) = @_;
+   print "Input: $num1 $oper $num2\n";
+   $num1 = arabic($num1);
+   $num2 = arabic($num2);
+   my $result;
+   eval "\$result = $num1 $oper $num2;";
+   die "eval error $@" if $@;
+   if($result != int($result)) {
+      print "Output: non potest\n";
+   } elsif ( $result < 0 ) {
+      print "Output: non potest\n";
+   } elsif ( $result > 3999 ) {
+      print "Output: non potest\n";
+   } elsif ( $result == 0) {
+      print "Output: nulla\n";
+   } else {
+      print "Output: " . uc(roman($result)) . "\n";
+   }
+}
-- 
cgit 


From 44b098ef8855915224da82de7ba6a305631b8368 Mon Sep 17 00:00:00 2001
From: Andrey Shitov <ash@Andreys-iMac.local>
Date: Mon, 24 Jul 2023 21:15:04 +0300
Subject: ash-227, task 2 in Raku

---
 challenge-227/ash/raku/blog.txt  |   1 +
 challenge-227/ash/raku/ch-2.raku | 136 +++++++++++++++++++++++++++++++++++++++
 2 files changed, 137 insertions(+)
 create mode 100644 challenge-227/ash/raku/blog.txt
 create mode 100644 challenge-227/ash/raku/ch-2.raku

(limited to 'challenge-227')

diff --git a/challenge-227/ash/raku/blog.txt b/challenge-227/ash/raku/blog.txt
new file mode 100644
index 0000000000..c4139e7043
--- /dev/null
+++ b/challenge-227/ash/raku/blog.txt
@@ -0,0 +1 @@
+https://andrewshitov.com/2023/07/24/counting-friday-the-13th-in-raku/
diff --git a/challenge-227/ash/raku/ch-2.raku b/challenge-227/ash/raku/ch-2.raku
new file mode 100644
index 0000000000..d455539197
--- /dev/null
+++ b/challenge-227/ash/raku/ch-2.raku
@@ -0,0 +1,136 @@
+# Solution to the Task 1 of the Weekly Challenge 227
+# https://theweeklychallenge.org/blog/perl-weekly-challenge-227/#TASK1
+
+# Explanations: TBD
+
+# Test run:
+# $ raku ch-2.raku
+# IV + V => (9) IX
+# M - I => (999) CMXCIX
+# X / II => (5) V
+# XI * VI => (66) LXVI
+# VII ** III => (343) CCCXLIII
+# V - V => (0) nulla (they knew about zero but didn't have a symbol)
+# V / II => (2.5) non potest (they didn't do fractions)
+# MMM + M => (4000) non potest (they only went up to 3999)
+# V - X => (-5) non potest (they didn't do negative numbers)
+
+grammar RomanArithmetics {
+    rule TOP {
+        <roman-number> <op> <roman-number> {
+            my $n1 = $<roman-number>[0].made;
+            my $n2 = $<roman-number>[1].made;
+
+            my $n;
+            given ~$<op> {
+                when '+'  {$n = $n1 +  $n2}
+                when '-'  {$n = $n1 -  $n2}
+                when '*'  {$n = $n1 *  $n2}
+                when '/'  {$n = $n1 /  $n2}
+                when '**' {$n = $n1 ** $n2}
+            }
+
+            $/.make($n)
+        }
+    }
+
+    token op {
+        '+' | '-' | '*' | '/' | '**'
+    }
+
+    token roman-number {
+        <thousands>? <hundreds>? <tens>? <ones>? {
+            $/.make(
+                ($<thousands>.made // 0) +
+                ($<hundreds>.made  // 0) +
+                ($<tens>.made      // 0) +
+                ($<ones>.made      // 0)
+            )
+        }
+    }
+
+    token thousands {
+        | M    { $/.make(1000) }   | MM   { $/.make(2000) }
+        | MMM  { $/.make(3000) }   | MMMM { $/.make(4000) }
+    }
+
+    token hundreds {
+        | C    { $/.make(100) }    | CC   { $/.make(200) }
+        | CCC  { $/.make(300) }    | CD   { $/.make(400) }
+        | D    { $/.make(500) }    | DC   { $/.make(600) }
+        | DCC  { $/.make(700) }    | DCCC { $/.make(800) }
+        | CM   { $/.make(900) }
+    }
+
+    token tens {
+        | X    { $/.make(10) }     | XX   { $/.make(20) }
+        | XXX  { $/.make(30) }     | XL   { $/.make(40) }
+        | L    { $/.make(50) }     | LX   { $/.make(60) }
+        | LXX  { $/.make(70) }     | LXXX { $/.make(80) }
+        | XC   { $/.make(90) }
+    }
+
+    token ones {
+        | I    { $/.make(1) }      | II   { $/.make(2) }
+        | III  { $/.make(3) }      | IV   { $/.make(4) }
+        | V    { $/.make(5) }      | VI   { $/.make(6) }
+        | VII  { $/.make(7) }      | VIII { $/.make(8) }
+        | IX   { $/.make(9) }
+    }
+}
+
+sub to-roman($n is copy) {
+    state @roman = 
+        1000 => < M MM MMM >,
+        100 => < C CC CCC CD D DC DCC DCCC CM >,
+        10  => < X XX XXX XL L LX LXX LXXX XC >,
+        1   => < I II III IV V VI VII VIII IX >;
+
+    my $roman;
+
+    for @roman -> $x {
+        my $digit = ($n / $x.key).Int; 
+        $roman ~= $x.value[$digit - 1] if $digit;
+        $n %= $x.key;
+    }
+
+    return $roman;
+}
+
+sub compute($input) {
+    my $answer = RomanArithmetics.parse($input).made;
+
+    my $output = "$input => ($answer) ";
+
+    if $answer != $answer.round {
+        $output ~= "non potest (they didn't do fractions)";
+    }
+    elsif $answer >= 4000 {
+        $output ~= "non potest (they only went up to 3999)";
+    }
+    elsif $answer == 0 {
+        $output ~= "nulla (they knew about zero but didn't have a symbol)";
+    }
+    elsif $answer < 0 {
+        $output ~= "non potest (they didn't do negative numbers)";
+    }
+    else {
+        $output ~= to-roman($answer);
+    }
+
+    return $output;
+}
+
+my @test-cases =
+    'IV + V',
+    'M - I',
+    'X / II',
+    'XI * VI',
+    'VII ** III',
+    'V - V',
+    'V / II',
+    'MMM + M',
+    'V - X'
+;
+
+say compute($_) for @test-cases;
-- 
cgit 


From 89442316d39ca2ea6a32f5986a088e02ad279cc8 Mon Sep 17 00:00:00 2001
From: Mark <53903062+andemark@users.noreply.github.com>
Date: Mon, 24 Jul 2023 19:10:33 +0000
Subject: Challenge 227 Solutions (Raku)

---
 challenge-227/mark-anderson/raku/ch-1.raku | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

(limited to 'challenge-227')

diff --git a/challenge-227/mark-anderson/raku/ch-1.raku b/challenge-227/mark-anderson/raku/ch-1.raku
index ffd28592fc..2436393bb4 100644
--- a/challenge-227/mark-anderson/raku/ch-1.raku
+++ b/challenge-227/mark-anderson/raku/ch-1.raku
@@ -59,8 +59,8 @@ sub friday-the-thirteenths($year where * ~~ 1753..9999)
     }
 }
 
-But it looks like the sequence repeats every 400 years 
-so this can be written without creating a Date object.
+But the sequence repeats every 400 years so this 
+can be written without creating a Date object.
 
 =end com
 
-- 
cgit 


From 4f439166cdbd495f31ed0aa6b64666ad5634cb0f Mon Sep 17 00:00:00 2001
From: Andrey Shitov <ash@Andreys-iMac.local>
Date: Mon, 24 Jul 2023 23:51:09 +0300
Subject: ash-227: blog link for task 2

---
 challenge-227/ash/raku/blog1.txt | 1 +
 challenge-227/ash/raku/ch-2.raku | 3 ++-
 2 files changed, 3 insertions(+), 1 deletion(-)
 create mode 100644 challenge-227/ash/raku/blog1.txt

(limited to 'challenge-227')

diff --git a/challenge-227/ash/raku/blog1.txt b/challenge-227/ash/raku/blog1.txt
new file mode 100644
index 0000000000..93de417122
--- /dev/null
+++ b/challenge-227/ash/raku/blog1.txt
@@ -0,0 +1 @@
+https://andrewshitov.com/2023/07/24/calculator-with-roman-numbers-in-raku/
diff --git a/challenge-227/ash/raku/ch-2.raku b/challenge-227/ash/raku/ch-2.raku
index d455539197..8d448bc7ce 100644
--- a/challenge-227/ash/raku/ch-2.raku
+++ b/challenge-227/ash/raku/ch-2.raku
@@ -1,7 +1,8 @@
 # Solution to the Task 1 of the Weekly Challenge 227
 # https://theweeklychallenge.org/blog/perl-weekly-challenge-227/#TASK1
 
-# Explanations: TBD
+# Explanations: 
+# https://andrewshitov.com/2023/07/24/calculator-with-roman-numbers-in-raku/
 
 # Test run:
 # $ raku ch-2.raku
-- 
cgit 


From 3ca3e81cc69d5d6421f91d1fad0fd7fb4eb3146d Mon Sep 17 00:00:00 2001
From: robbie-hatley <Robbie.Hatley@gmail.com>
Date: Mon, 24 Jul 2023 23:09:02 -0700
Subject: Robbie Hatley's solutions to The Weekly Challenge 227

---
 challenge-227/robbie-hatley/blog.txt     |   1 +
 challenge-227/robbie-hatley/perl/ch-1.pl | 145 +++++++++++++++++++++++++++++++
 challenge-227/robbie-hatley/perl/ch-2.pl | 130 +++++++++++++++++++++++++++
 3 files changed, 276 insertions(+)
 create mode 100644 challenge-227/robbie-hatley/blog.txt
 create mode 100755 challenge-227/robbie-hatley/perl/ch-1.pl
 create mode 100755 challenge-227/robbie-hatley/perl/ch-2.pl

(limited to 'challenge-227')

diff --git a/challenge-227/robbie-hatley/blog.txt b/challenge-227/robbie-hatley/blog.txt
new file mode 100644
index 0000000000..c84a8c4014
--- /dev/null
+++ b/challenge-227/robbie-hatley/blog.txt
@@ -0,0 +1 @@
+https://hatley-software.blogspot.com/2023/07/robbie-hatleys-solutions-to-weekly_24.html
\ No newline at end of file
diff --git a/challenge-227/robbie-hatley/perl/ch-1.pl b/challenge-227/robbie-hatley/perl/ch-1.pl
new file mode 100755
index 0000000000..ba6b6c4d71
--- /dev/null
+++ b/challenge-227/robbie-hatley/perl/ch-1.pl
@@ -0,0 +1,145 @@
+#! /bin/perl -CSDA
+
+=pod
+
+--------------------------------------------------------------------------------------------------------------
+COLOPHON:
+This is a 110-character-wide Unicode UTF-8 Perl-source-code text file with hard Unix line breaks ("\x0A").
+¡Hablo Español! Говорю Русский. Björt skjöldur. ॐ नमो भगवते वासुदेवाय. 看的星星，知道你是爱。麦藁雪、富士川町、山梨県。
+
+--------------------------------------------------------------------------------------------------------------
+TITLE BLOCK:
+Solutions in Perl for The Weekly Challenge 227-1.
+Written by Robbie Hatley on Mon Jul 24, 2023.
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM DESCRIPTION:
+Task 1: Friday 13th
+Submitted by: Peter Campbell Smith
+You are given a year number in the range 1753 to 9999. Write a script to find out how many dates in the year
+are Friday 13th, assume that the current Gregorian calendar applies.
+
+Example: Input: $year = 2023 Output: 2
+Since there are only 2 Friday 13th in the given year 2023 i.e. 13th Jan and 13th Oct.
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM NOTES:
+Let's use the number 0-6 to stand for days-of-week from a Sunday through the next Saturday. Because we're
+only interested in years 1753+, lets use 13 December 1752 as "epoch". That was a Wednesday, so our starting
+offset is 3. Then make an array to hold elements indexed from 1753 through 9999 (representing the years),
+with element being a ref to an array of elements indexed 0 through 11 (representing the months), with each
+inner element being "starting offset plus days elapsed from epoch to the 13th of the current month".
+The starting offset 3 only has to be added once, to the entry for 13 January 1753; every subsequent month
+from February 1753 through December 9999 is just the number from the previous month plus the number of days
+in the previous month. Then to get the "Friday The 13th"s for each year, just take each month's number
+modulo 7; each 5 is a Friday The 13th.
+
+--------------------------------------------------------------------------------------------------------------
+IO NOTES:
+Input is via either built-in variables or via @ARGV. If using @ARGV, provide one argument which must be a
+double-quoted array positive integers in the range 1753-9999, in proper Perl syntax, like so:
+./ch-1.pl "(1794,1846,2017,8462)"
+
+Output is to STDOUT and will be each input year followed by the "Friday The 13th"s in that year.
+
+=cut
+
+# ------------------------------------------------------------------------------------------------------------
+# PRELIMINARIES:
+
+use v5.36;
+use strict;
+use warnings;
+use utf8;
+use Sys::Binmode;
+use Time::HiRes 'time';
+$"=', ';
+
+# ------------------------------------------------------------------------------------------------------------
+# SUBROUTINES:
+
+sub days_in_february ($year) {
+   if ( 0 == $year%100 ) {
+      return ( (0 == $year%400) ? 29 : 28 );
+   }
+   else {
+      return ( (0 == $year%4) ? 29 : 28 );
+   }
+}
+
+sub days_in_month ($year, $month) {
+   if    (  0 == $month ) { return 31;                      }
+   elsif (  1 == $month ) { return days_in_february($year); }
+   elsif (  2 == $month ) { return 31;                      }
+   elsif (  3 == $month ) { return 30;                      }
+   elsif (  4 == $month ) { return 31;                      }
+   elsif (  5 == $month ) { return 30;                      }
+   elsif (  6 == $month ) { return 31;                      }
+   elsif (  7 == $month ) { return 31;                      }
+   elsif (  8 == $month ) { return 30;                      }
+   elsif (  9 == $month ) { return 31;                      }
+   elsif ( 10 == $month ) { return 30;                      }
+   elsif ( 11 == $month ) { return 31;                      }
+}
+
+sub year_is_valid ($year) {
+   return 0 if $year !~ m/^[1-9]\d\d\d$/;
+   return 0 if $year < 1753;
+   return 1;
+}
+
+# ------------------------------------------------------------------------------------------------------------
+# MAIN BODY OF PROGRAM:
+
+# Start timer:
+my $t0 = time;
+
+# Array of month names:
+my @month_names = qw( January February March April May June July August September October November December );
+
+# @t = Array of thirteenths:
+my @t;
+$t[1752]->[11] = 3; # Starting offset is 3 because 13 December 1752 was a Wednesday.
+for my $year (1753..9999) {
+   for my $month (0..11) {
+      if ( 0 == $month ) {
+         $t[$year]->[$month] = $t[$year-1]->[11] + 31;
+      }
+      else {
+         $t[$year]->[$month] = $t[$year]->[$month-1] + days_in_month($year,$month-1);
+      }
+   }
+}
+
+# Default inputs:
+my @years =
+(
+   2022,
+   2023,
+   2024,
+);
+
+# Non-default inputs:
+@years = eval($ARGV[0]) if @ARGV;
+
+# Main loop:
+for my $year (@years) {
+   say '';
+   if ( ! year_is_valid($year) ) {
+      say "Year $year is invalid. Year must be in range 1753-9999.";
+      next;
+   }
+   say "Friday the 13ths in year $year:";
+   my $tcount = 0;
+   for my $month (0..11) {
+      if ( 5 == $t[$year]->[$month]%7 ) {
+         say "Friday 13 $month_names[$month], $year";
+         ++$tcount;
+      }
+   }
+   say "Total Friday The 13ths in $year = $tcount";
+}
+
+# Determine and print execution time:
+my $µs = 1000000 * (time - $t0);
+printf("\nExecution time was %.0fµs.\n", $µs);
diff --git a/challenge-227/robbie-hatley/perl/ch-2.pl b/challenge-227/robbie-hatley/perl/ch-2.pl
new file mode 100755
index 0000000000..7929f8d1a0
--- /dev/null
+++ b/challenge-227/robbie-hatley/perl/ch-2.pl
@@ -0,0 +1,130 @@
+#! /bin/perl -CSDA
+
+=pod
+
+--------------------------------------------------------------------------------------------------------------
+COLOPHON:
+This is a 110-character-wide Unicode UTF-8 Perl-source-code text file with hard Unix line breaks ("\x0A").
+¡Hablo Español! Говорю Русский. Björt skjöldur. ॐ नमो भगवते वासुदेवाय. 看的星星，知道你是爱。麦藁雪、富士川町、山梨県。
+
+--------------------------------------------------------------------------------------------------------------
+TITLE BLOCK:
+Solutions in Perl for The Weekly Challenge 227-2.
+Written by Robbie Hatley on Mon Jul 24, 2023.
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM DESCRIPTION:
+Task 2: Roman Maths
+Submitted by: Peter Campbell Smith
+Write a script to handle a 2-term arithmetic operation expressed in Roman numeral.
+Examples:
+IV + V     => IX
+M - I      => CMXCIX
+X / II     => V
+XI * VI    => LXVI
+VII ** III => CCCXLIII
+V - V      => nulla (they knew about zero but didn't have a symbol)
+V / II     => non potest (they didn't do fractions)
+MMM + M    => non potest (they only went up to 3999)
+V - X      => non potest (they didn't do negative numbers)
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM NOTES:
+I'm sooooo not going to make roman-to-arabic or arabic-to-roman converters. Let's see what CPAN has to offer.
+Ah, it has "Text::Roman". Fine I'll use that. The rest is just expression validity checking, operator parsing,
+Latin output phrasing ("nulla" or "non potest" where appropriate), and other such details.
+
+--------------------------------------------------------------------------------------------------------------
+IO NOTES:
+Input is via either built-in variables or via @ARGV. If using @ARGV, provide one argument which must be a
+double-quoted array of single-quoted roman-math expressions, with operators separated from operands with
+white space, in proper Perl syntax, like so:
+./ch-2.pl "('MCMLXIX - MCMLIV', 'XIV / VII')"
+
+Output is to STDOUT and will be each expression followed by its result.
+
+=cut
+
+# ------------------------------------------------------------------------------------------------------------
+# PRELIMINARIES:
+
+use v5.36;
+use strict;
+use warnings;
+use utf8;
+use Sys::Binmode;
+use Time::HiRes 'time';
+use Text::Roman ':all';
+$"=', ';
+
+# ------------------------------------------------------------------------------------------------------------
+# SUBROUTINES:
+
+# Does given string represent a valid operator?
+sub isopera ($o) {
+   return ( $o =~ m/(?:^\+$)|(?:^-$)|(?:^\*$)|(?:^\/$)|(?:^\*\*$)/ );
+}
+
+# Perform a calculation using Roman numerals:
+sub computare ($e) {
+   my @array = split /\s+/, $e;
+   return "INVALID EXPRESSION" if ( 3 != scalar @array );
+   my ($x, $o, $y) = @array;
+   return "INVALID EXPRESSION" if ( ! isroman($x) );
+   return "INVALID EXPRESSION" if ( ! isopera($o) );
+   return "INVALID EXPRESSION" if ( ! isroman($y) );
+   my $result = 0;
+   if    ( '+'  eq $o ) {
+      $result = roman2int($x)  + roman2int($y);
+   }
+   elsif ( '-'  eq $o ) {
+      $result = roman2int($x)  - roman2int($y);
+   }
+   elsif ( '*'  eq $o ) {
+      $result = roman2int($x)  * roman2int($y);
+   }
+   elsif ( '/'  eq $o ) {
+      $result = roman2int($x)  / roman2int($y);
+   }
+   elsif ( '**' eq $o ) {
+      $result = roman2int($x) ** roman2int($y);
+   }
+   return 'nulla'      if 0 == $result;               # no symbol for 0
+   return 'non potest' if 0 != $result - int $result; # no fractions
+   return 'non potest' if $result > 3999;             # no numbers > 3999
+   return 'non potest' if $result <    0;             # no numbers <    0
+   return int2roman($result);
+}
+
+# ------------------------------------------------------------------------------------------------------------
+# MAIN BODY OF PROGRAM:
+
+# Start timer:
+my $t0 = time;
+
+# Default inputs:
+my @expressions =
+(
+   'IV + V',
+   'M - I',
+   'X / II',
+   'XI * VI',
+   'VII ** III',
+   'V - V',
+   'V / II',
+   'MMM + M',
+   'V - X',
+);
+
+# Non-default inputs:
+@expressions = eval($ARGV[0]) if @ARGV;
+
+# Main loop:
+for my $expression (@expressions) {
+   say '';
+   say "$expression = ", computare($expression);
+}
+
+# Determine and print execution time:
+my $µs = 1000000 * (time - $t0);
+printf("\nExecution time was %.0fµs.\n", $µs);
-- 
cgit 


From b8fc2d39ff9af2f77eb7e31caa9fb0bacd37869c Mon Sep 17 00:00:00 2001
From: deadmarshal <adeadmarshal@gmail.com>
Date: Tue, 25 Jul 2023 10:10:34 +0330
Subject: TWC227

---
 challenge-227/deadmarshal/blog.txt     |  1 +
 challenge-227/deadmarshal/perl/ch-1.pl | 16 ++++++++++++++++
 challenge-227/deadmarshal/perl/ch-2.pl | 25 +++++++++++++++++++++++++
 3 files changed, 42 insertions(+)
 create mode 100644 challenge-227/deadmarshal/blog.txt
 create mode 100644 challenge-227/deadmarshal/perl/ch-1.pl
 create mode 100644 challenge-227/deadmarshal/perl/ch-2.pl

(limited to 'challenge-227')

diff --git a/challenge-227/deadmarshal/blog.txt b/challenge-227/deadmarshal/blog.txt
new file mode 100644
index 0000000000..dc3c1dcd72
--- /dev/null
+++ b/challenge-227/deadmarshal/blog.txt
@@ -0,0 +1 @@
+https://deadmarshal.blogspot.com
diff --git a/challenge-227/deadmarshal/perl/ch-1.pl b/challenge-227/deadmarshal/perl/ch-1.pl
new file mode 100644
index 0000000000..ad8789b8a8
--- /dev/null
+++ b/challenge-227/deadmarshal/perl/ch-1.pl
@@ -0,0 +1,16 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Time::Piece;
+
+sub friday_13th{
+  my ($count,$year) = (0,@_);
+  foreach my $month(1..12){
+    my $d = Time::Piece->strptime("$year-$month-13", "%Y-%m-%d");
+    $count++ if $d->day_of_week == 5;
+  }
+  $count
+}
+
+printf "%d\n", friday_13th(2023);
+
diff --git a/challenge-227/deadmarshal/perl/ch-2.pl b/challenge-227/deadmarshal/perl/ch-2.pl
new file mode 100644
index 0000000000..19895ee12c
--- /dev/null
+++ b/challenge-227/deadmarshal/perl/ch-2.pl
@@ -0,0 +1,25 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Roman;
+
+sub roman_maths
+{
+  my ($n1,$n2,$r) = (arabic($_[0]),arabic($_[2]));
+  eval "\$r = $n1 $_[1] $n2;";
+  die "Error: $@" if $@;
+  if($r != int($r) || $r < 0 || $r > 3999){return "non potest"}
+  elsif($r == 0){return "nulla"}
+  uc(roman($r));
+}
+
+printf "%s\n", roman_maths('IV','+','V');
+printf "%s\n", roman_maths('M','-','I');
+printf "%s\n", roman_maths('X','/','II');
+printf "%s\n", roman_maths('XI','*','VI');
+printf "%s\n", roman_maths('VII','**','III');
+printf "%s\n", roman_maths('V','-','V');
+printf "%s\n", roman_maths('V','/','II');
+printf "%s\n", roman_maths('MMM','+','M');
+printf "%s\n", roman_maths('V','-','X');
+
-- 
cgit 


From 772446dea828af06e7d7d3b7ab7995d53985a8a6 Mon Sep 17 00:00:00 2001
From: Luis Mochan <mochan@fis.unam.mx>
Date: Tue, 25 Jul 2023 01:22:58 -0600
Subject: Solve PWC227

---
 challenge-227/wlmb/blog.txt     |  1 +
 challenge-227/wlmb/perl/ch-1.pl | 21 ++++++++++++
 challenge-227/wlmb/perl/ch-2.pl | 74 +++++++++++++++++++++++++++++++++++++++++
 3 files changed, 96 insertions(+)
 create mode 100644 challenge-227/wlmb/blog.txt
 create mode 100755 challenge-227/wlmb/perl/ch-1.pl
 create mode 100755 challenge-227/wlmb/perl/ch-2.pl

(limited to 'challenge-227')

diff --git a/challenge-227/wlmb/blog.txt b/challenge-227/wlmb/blog.txt
new file mode 100644
index 0000000000..4083bbf912
--- /dev/null
+++ b/challenge-227/wlmb/blog.txt
@@ -0,0 +1 @@
+https://wlmb.github.io/2023/07/24/PWC227/
diff --git a/challenge-227/wlmb/perl/ch-1.pl b/challenge-227/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..1572dfdae4
--- /dev/null
+++ b/challenge-227/wlmb/perl/ch-1.pl
@@ -0,0 +1,21 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 227
+# Task 1:  Friday 13th
+#
+# See https://wlmb.github.io/2023/07/24/PWC227/#task-1-friday-13th
+use v5.36;
+use PDL;
+my $days_to_month=pdl[[0,3,3,6,1,4,6,2,5,0,3,5], # days to start of month nonleap and leap
+	              [0,3,4,0,2,5,0,3,6,1,4,6]];
+die <<~"FIN" unless @ARGV;
+    Usage: $0 Y1 [Y2...]
+    to find how many Friday 13 are in the years Y1, Y2...
+    FIN
+for(@ARGV){
+    my $year=$_%400; # Cycle repeats after 400 years
+    my $previous_leaps=(floor(($year+3)/4)-floor(($year+3)/100))%7; # Leap years before start of given year
+    my $start=($year+$previous_leaps)%7; # starting weekday of year, counting from saturday=0
+    my $given_is_leap=($year==0 || ($year%100!=0 && $year%4==0))||0;
+    my $begginings=($days_to_month->slice("",[$given_is_leap,0,0])+$start)%7;
+    say "$_->", ($begginings==1)->sumover;
+}
diff --git a/challenge-227/wlmb/perl/ch-2.pl b/challenge-227/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..8fe7efef3c
--- /dev/null
+++ b/challenge-227/wlmb/perl/ch-2.pl
@@ -0,0 +1,74 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 227
+# Task 2:  Roman Maths
+#
+# See https://wlmb.github.io/2023/07/24/PWC227/#task-2-roman-maths
+use v5.36;
+use experimental qw(try);
+use POSIX qw(floor);
+use List::Util qw(sum);
+my %ops=   # generate code for several binary operators
+    map{$_ => eval "sub(\$x, \$y){\$x $_ \$y}"}
+    qw(+ - * / ** %);
+
+die <<~"FIN" unless @ARGV;
+    Usage: $0 "x1 op1 y1" ["x2 op2 y2"...]
+    to perform operations op_n between pairs numbers x_n and y_n expressed
+    in Roman numerals.
+    FIN
+for(@ARGV){
+    try{say "$_ ->", evaluate($_)}
+    catch($e){say "$_ failed: $e"}
+}
+
+sub evaluate($exp){
+    my ($x, $op, $y)=split " ", $exp;
+    die "Undefined operation $op" unless defined $ops{$op};
+    my $result=$ops{$op}->(map {toD($_)}($x,$y));
+    return $result==0                                ?"nulla"
+	:($result>3999||$result<0||$result!=floor $result)?"non potest"
+	:toR($result)
+}
+
+sub toD($R){ # Roman to decimal
+    $R=~/^                 # Identify components
+	(M{0,3})           # thousands
+        (CM|CD|D?(C{0,3})) # Hundreds
+    	(XC|XL|L?(X{0,3})) # tens
+	(IX|IV|V?(I{0,3})) # units
+     	$/x
+    or die "Failed to convert $R to decimal";
+    my($FM, $M,$D,$C,$L,$X,$V,$I)=map {$_//""} (undef, $1,$2,$3,$4,$5,$6,$7);
+    my $result=	sum map {
+	    my ($fives, $ones, $mult,$nine, $four, $five)=@$_;
+	    local $_=$fives;
+	    $mult*((m/^$nine/?9:m/^$four/?4:m/^$five/?5:0)+split "",$ones);
+    } (
+	    [$FM,$M, 1000, qr/MX/, qr/MX/, qr/X/],
+	    [$D, $C,  100, qr/CM/, qr/CD/, qr/D/],
+	    [$L, $X,   10, qr/XC/, qr/XL/, qr/L/],
+	    [$V, $I,    1, qr/IX/, qr/IV/, qr/V/],
+    );
+    return $result; #$thousands+$hundreds+$tens+$units;
+}
+
+sub toR($N){
+    return "non potest" if $N>3999 or $N < 0 or $N!=floor $N; # too large, negative, non integer
+    return "nulla" if $N==0;
+    return
+	join "",
+	map {
+	    my ($div, $nine, $five, $four, $one)=@$_;
+	    my $n=($N%(10*$div))/$div;
+	    my $r0=$n>=9?$nine:$n>=5?$five:$n>=4?$four:"";
+            $n%=5;
+	    my $r1=$n<4? $one x $n: "";
+	    "$r0$r1";
+    }
+    (
+     [1000, "MX", "X", "MX", "M"],
+     [ 100, "CM", "D", "CD", "C"],
+     [  10, "XC", "L", "XL", "X"],
+     [   1, "IX", "V", "IV", "I"],
+    )
+}
-- 
cgit 


From 35a6c9d80058586c7bda26124216f9b77daf35c5 Mon Sep 17 00:00:00 2001
From: "E. Choroba" <choroba@matfyz.cz>
Date: Tue, 25 Jul 2023 10:18:00 +0200
Subject: Add solutions to 227: Friday 13th & Roman Maths by E. Choroba

---
 challenge-227/e-choroba/perl/ch-1.pl | 51 ++++++++++++++++++++++++++++++++++
 challenge-227/e-choroba/perl/ch-2.pl | 53 ++++++++++++++++++++++++++++++++++++
 2 files changed, 104 insertions(+)
 create mode 100755 challenge-227/e-choroba/perl/ch-1.pl
 create mode 100755 challenge-227/e-choroba/perl/ch-2.pl

(limited to 'challenge-227')

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 };
+