Merge pull request #8470 from jaldhar/challenge-227

Challenge 227 by Jaldhar H. Vyas.

5 files changed, 288 insertions, 0 deletions

diff --git a/challenge-227/jaldhar-h-vyas/blog.txt b/challenge-227/jaldhar-h-vyas/blog.txt
new file mode 100644
index 0000000000..22952ead79
--- /dev/null
+++ b/challenge-227/jaldhar-h-vyas/blog.txt
@@ -0,0 +1 @@
+https://www.braincells.com/perl/2023/07/perl_weekly_challenge_week_227.html
diff --git a/challenge-227/jaldhar-h-vyas/perl/ch-1.pl b/challenge-227/jaldhar-h-vyas/perl/ch-1.pl
new file mode 100755
index 0000000000..5c62ba7683
--- /dev/null
+++ b/challenge-227/jaldhar-h-vyas/perl/ch-1.pl
@@ -0,0 +1,31 @@
+#!/usr/bin/perl
+use 5.030;
+use warnings;
+use DateTime;
+use English;
+
+sub usage {
+    print<<"-USAGE-";
+Usage:
+  $PROGRAM_NAME <year>
+  
+    <year>    year between 1753 to 9999
+-USAGE-
+    exit(0);
+}
+
+my $year = shift // usage;
+unless ($year >= 1753 && $year <= 9999) {
+    usage;
+}
+
+my $count = 0;
+
+for my $month (1 .. 12) {
+    my $date = DateTime->new(year => $year, month => $month,  day => 13);
+    if ($date->day_of_week == 5) {
+        $count++;
+    }
+}
+
+say $count;
diff --git a/challenge-227/jaldhar-h-vyas/perl/ch-2.pl b/challenge-227/jaldhar-h-vyas/perl/ch-2.pl
new file mode 100755
index 0000000000..2a7e91f9a4
--- /dev/null
+++ b/challenge-227/jaldhar-h-vyas/perl/ch-2.pl
@@ -0,0 +1,129 @@
+#!/usr/bin/perl
+use 5.030;
+use warnings;
+use experimental qw/ switch /;
+use English;
+
+sub usage {
+print STDERR <<"-END-";
+Usage:
+  $PROGRAM_NAME <arg1> <op> <arg2>
+  
+    <arg1>    Number in Roman numerals
+    <op>      Arithmetic operation (+, -, *, / or **)
+    <arg2>    Number in Roman numerals
+-END-
+    exit(1);
+}
+
+sub unprefix {
+    my ($num) = @_;
+
+    my @from = qw/ CM    CD   XC    XL   IX    IV   /;
+    my @roman =   qw/ DCCCC CCCC LXXXX XXXX VIIII IIII /;
+
+    for my $i (0 .. scalar @from - 1) {
+        $num =~ s/$from[$i]/$roman[$i]/g;
+    }
+
+    return $num;
+}
+
+sub normalize {
+    my ($num) = @_;
+    my @from = qw/ IIIII IIII VV VIV XXXXX XXXX LL LXL CCCCC CCCC DD DCD /;
+    my @roman =   qw/ V     IV   X  IX  L     XL   C  XC  D     CD   M  CM  /;
+
+    for my $i (0 .. scalar @from - 1) {
+        $num =~ s/$from[$i]/$roman[$i]/g;
+    }
+
+    return $num;
+}
+
+sub toEnglish {
+    my ($num) = @_;
+    my %values = (
+        'M' => 1000,
+        'D' => 500,
+        'C' => 100,
+        'L' => 50,
+        'X' => 10,
+        'V' => 5,
+        'I' => 1,
+    );
+
+    my $english = 0;
+
+    for my $digit (split //, unprefix($num))  {
+        $english += $values{$digit};
+    }
+
+    return $english;
+}
+
+sub toRoman {
+    my ($num) = @_; 
+    my $roman;
+
+    while ($num > 0) {
+        if ($num >= 1000) {
+            $roman .= 'M';
+            $num -= 1000;
+        }
+        elsif ($num >= 500) {
+            $roman .= 'D';
+            $num -= 500;
+        }
+        elsif ($num >= 100) {
+            $roman .= 'C';
+            $num -= 100;
+        }
+        elsif ($num >= 50) {
+            $roman .= 'L';
+            $num -= 50;
+        }
+        elsif ($num >= 10) {
+            $roman .= 'X';
+            $num -= 10;
+        }
+        elsif ($num >= 5) {
+            $roman .= 'V';
+            $num -= 5;
+        }
+        elsif ($num >= 1) {
+            $roman .= 'I';
+            $num -= 1;
+        }
+    }
+
+    return normalize($roman);
+}
+
+
+if (scalar @ARGV != 3) {
+    usage();
+}
+
+my ($arg1, $op, $arg2) = @ARGV;
+
+my $val;
+my $eng1 = toEnglish($arg1);
+my $eng2 = toEnglish($arg2);
+
+given ($op) {
+    when ('+')  { $val = $eng1 + $eng2; }
+    when ('-')  { $val = $eng1 - $eng2; }
+    when ('*')  { $val = $eng1 * $eng2; }
+    when ('/')  { $val = $eng1 / $eng2; }
+    when ('**') { $val = $eng1 ** $eng2; }
+    default     {  usage; }
+}
+
+given ($val) {
+    when ($_ == 0)      { say 'nulla'; }
+    when ($_ != int)    { say 'non potest'; }
+    when ($_ <= 0)      { say 'non potest'; }
+    when ($_ >= 4000)   { say 'non potest'; }
+    default             { say toRoman($val); }
+}
diff --git a/challenge-227/jaldhar-h-vyas/raku/ch-1.raku b/challenge-227/jaldhar-h-vyas/raku/ch-1.raku
new file mode 100755
index 0000000000..2a0f9bbead
--- /dev/null
+++ b/challenge-227/jaldhar-h-vyas/raku/ch-1.raku
@@ -0,0 +1,17 @@
+#!/usr/bin/raku
+
+
+sub MAIN(
+    $year where { $_ >= 1753 && $_ <= 9999 } #= year between 1753 to 9999
+) {
+    my $count = 0;
+
+    for 1 .. 12 -> $month {
+        my $date = Date.new(year => $year, month => $month,  day => 13);
+        if $date.day-of-week == 5 {
+            $count++;
+        }
+    }
+
+    say $count;
+}
\ No newline at end of file
diff --git a/challenge-227/jaldhar-h-vyas/raku/ch-2.raku b/challenge-227/jaldhar-h-vyas/raku/ch-2.raku
new file mode 100755
index 0000000000..dc8ea1ced1
--- /dev/null
+++ b/challenge-227/jaldhar-h-vyas/raku/ch-2.raku
@@ -0,0 +1,110 @@
+#!/usr/bin/raku
+
+sub unprefix(Str $num) {
+    my $unprefixed = $num;
+    my @from = qw/ CM    CD   XC    XL   IX    IV   /;
+    my @to =   qw/ DCCCC CCCC LXXXX XXXX VIIII IIII /;
+
+    for 0 ..^ @from.elems -> $i {
+        $unprefixed = $unprefixed.subst(@from[$i], @to[$i], :g);
+    }
+
+    return $unprefixed;
+}
+
+sub normalize(Str $num) {
+    my $normalized = $num;
+    my @from = qw/ IIIII IIII VV VIV XXXXX XXXX LL LXL CCCCC CCCC DD DCD /;
+    my @to =   qw/ V     IV   X  IX  L     XL   C  XC  D     CD   M  CM  /;
+
+    for 0 .. @from.end -> $i {
+        $normalized = $normalized.subst(@from[$i], @to[$i], :g);
+    }
+
+    return $normalized;
+}
+
+sub toEnglish($num) {
+    my %values = (
+        'M' => 1000,
+        'D' => 500,
+        'C' => 100,
+        'L' => 50,
+        'X' => 10,
+        'V' => 5,
+        'I' => 1,
+    );
+
+    my $english = 0;
+
+    for unprefix($num).comb -> $digit {
+        $english += %values{$digit};
+    }
+
+    return $english;
+}
+
+sub toRoman($num is copy) {
+    my $roman;
+
+    while $num > 0 {
+        if $num >= 1000 {
+            $roman ~= 'M';
+            $num -= 1000;
+        }
+        elsif $num >= 500 {
+            $roman ~= 'D';
+            $num -= 500;
+        }
+        elsif $num >= 100 {
+            $roman ~= 'C';
+            $num -= 100;
+        }
+        elsif $num >= 50 {
+            $roman ~= 'L';
+            $num -= 50;
+        }
+        elsif $num >= 10 {
+            $roman ~= 'X';
+            $num -= 10;
+        }
+        elsif $num >= 5 {
+            $roman ~= 'V';
+            $num -= 5;
+        }
+        elsif $num >= 1 {
+            $roman ~= 'I';
+            $num -= 1;
+        }
+    }
+
+    return normalize($roman);
+}
+
+sub MAIN(
+    Str $arg1, #= Number in Roman numerals
+    Str $op,   #= Arithmetic operation (+, -, *, / or **)
+    Str $arg2, #= Number in Roman numerals
+) {
+    my $val;
+    my $eng1 = toEnglish($arg1);
+    my $eng2 = toEnglish($arg2);
+
+    given $op {
+        when '+'  { $val = $eng1 + $eng2; }
+        when '-'  { $val = $eng1 - $eng2; }
+        when '*'  { $val = $eng1 * $eng2; }
+        when '/'  { $val = $eng1 / $eng2; }
+        when '**' { $val = $eng1 ** $eng2; }
+        default   {  &*USAGE(); }
+    }
+
+    given $val {
+        when $_ == 0      { say 'nulla'; }
+        when $_ != $_.Int { say 'non potest'; }
+        when $_ <= 0      { say 'non potest'; }
+        when $_ >= 4000   { say 'non potest'; }
+        default           { say toRoman($val); }
+    }
+
+}
\ No newline at end of file