Merge pull request #8447 from pme/challange-227

Challange 227

3 files changed, 187 insertions, 0 deletions

diff --git a/.gitignore b/.gitignore
index 040286b6c4..2225210db6 100644
--- a/.gitignore
+++ b/.gitignore
@@ -18,6 +18,7 @@ ch_2
 go.mod
 go.sum
 tags
+update
 
 # Perl Inline module
 _Inline
diff --git a/challenge-227/peter-meszaros/perl/ch-1.pl b/challenge-227/peter-meszaros/perl/ch-1.pl
new file mode 100755
index 0000000000..4e787af59b
--- /dev/null
+++ b/challenge-227/peter-meszaros/perl/ch-1.pl
@@ -0,0 +1,41 @@
+#!/usr/bin/env perl
+
+# 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.
+
+use strict;
+use warnings;
+use Date::Calc qw/Day_of_Week/;
+use Test::More;
+use Data::Dumper;
+
+my $cases = [
+	1753,
+	2023,
+	9999,
+];
+
+sub friday13th
+{
+    my $y = shift;
+	my $c = 0;
+	for my $m (1..12) {
+		my $dow = Day_of_Week($y, $m, 13);
+		++$c if $dow == 5; # Friday
+	}
+	return $c;
+}
+
+is(friday13th($cases->[0]),    2, 'year 1753');
+is(friday13th($cases->[1]),    2, 'year 2023');
+is(friday13th($cases->[2]),    1, 'year 9999');
+done_testing();
+
+exit 0;
diff --git a/challenge-227/peter-meszaros/perl/ch-2.pl b/challenge-227/peter-meszaros/perl/ch-2.pl
new file mode 100755
index 0000000000..63171d54a3
--- /dev/null
+++ b/challenge-227/peter-meszaros/perl/ch-2.pl
@@ -0,0 +1,145 @@
+#!/usr/bin/env perl
+
+# 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)
+
+use strict;
+use warnings;
+use POSIX qw/floor/;
+use Test::More;
+use Data::Dumper;
+
+my $cases = [
+    ['IV',  '+',  'V'  ], # 0
+    ['M',   '-',  'I'  ], # 1
+    ['X',   '/',  'II' ], # 2
+    ['XI',  '*',  'VI' ], # 3
+    ['VII', '**', 'III'], # 4
+    ['V',   '-',  'V'  ], # 5
+    ['V',   '/',  'II' ], # 6
+    ['MMM', '+',  'M'  ], # 7
+    ['V',   '-',  'X'  ], # 8
+];
+
+sub roman2arabic
+{
+    my $r = shift;
+
+    my $sum = 0;
+    my @chars = split //, $r;
+    for (my $i=0; $i < @chars; ++$i) {
+        my $c = $chars[$i];
+        if ($c eq 'I') {
+            ++$sum;
+        } elsif ($c eq 'V') {
+            $sum += (($sum == 0 || $chars[$i-1] ne 'I') ?    5 :   3);
+        } elsif ($c eq 'X') {
+            $sum += (($sum == 0 || $chars[$i-1] ne 'I') ?   10 :   8);
+        } elsif ($c eq 'L') {
+            $sum += (($sum == 0 || $chars[$i-1] ne 'X') ?   50 :  30);
+        } elsif ($c eq 'C') {
+            $sum += (($sum == 0 || $chars[$i-1] ne 'X') ?  100 :  80);
+        } elsif ($c eq 'D') {
+            $sum += (($sum == 0 || $chars[$i-1] ne 'C') ?  500 : 300);
+        } elsif ($c eq 'M') {
+            $sum += (($sum == 0 || $chars[$i-1] ne 'C') ? 1000 : 800);
+        } else {
+            undef $sum;
+        }
+    }
+	return $sum;
+}
+
+sub arabic2roman
+{
+    my $n = shift;
+
+    return undef if $n < 0 || 4000 <= $n;
+
+	my @nums = qw/I V X L C D M/;
+	my $count = 0;
+	my $res = '';
+
+    my @chars = split //, $n;
+    for (my $i=$#chars; $i >= 0; --$i) {
+		my $r;
+        my $num = $chars[$i];
+		if (1 <= $num && $num < 4) {
+			$r .=  ($nums[$count] x $num); 
+			$count += 2;
+		} elsif (4 <= $num && $num < 9) {
+			$count += 2;
+			if ($num == 4) {
+				$r .= $nums[$count - 2];
+			}
+			$r .= $nums[$count - 1];
+			$r .= ($nums[$count - 2] x (($num - 5) < 0 ? 0 : ($num - 5))); 
+
+		} elsif ($num == 9) {
+			$count += 2;
+			$r .= $nums[$count - 2] . $nums[$count];
+		} elsif ($num == 0) {
+			$count += 2;
+		}
+		$res = $r . $res;
+    }
+
+    return $res;
+}
+
+sub roman_maths
+{
+    my $exp = shift;
+
+    my ($left, $op, $right) = @$exp;
+
+    my $l = roman2arabic($left);
+    my $r = roman2arabic($right);
+    
+    my $res;
+    if ($op eq '+') {
+        $res = $l + $r;
+    } elsif ($op eq '-') {
+        $res = $l - $r;
+    } elsif ($op eq '*') {
+        $res = $l * $r;
+    } elsif ($op eq '/') {
+        $res = $l / $r;
+    } elsif ($op eq '**') {
+        $res = $l ** $r;
+    } else {
+        print "Invalid operator: $op\n";
+		return;
+    }
+    if ($res == 0) {
+        $res = 'nulla';
+    } elsif ($res < 0 || $res > 3999 || $res != floor($res)) {
+        $res = 'non potest';
+    } else {
+        $res = arabic2roman($res);
+    }
+    return $res;
+}
+
+is(roman_maths($cases->[0]), 'IX',         'IV + V');
+is(roman_maths($cases->[1]), 'CMXCIX',     'M - I');
+is(roman_maths($cases->[2]), 'V',          'X / II');
+is(roman_maths($cases->[3]), 'LXVI',       'XI * VI');
+is(roman_maths($cases->[4]), 'CCCXLIII',   'VII ** III');
+is(roman_maths($cases->[5]), 'nulla',      'V - V');
+is(roman_maths($cases->[6]), 'non potest', 'V / II');
+is(roman_maths($cases->[7]), 'non potest', 'MMM + M');
+is(roman_maths($cases->[8]), 'non potest', 'V - X');
+done_testing();
+
+exit 0;