Perl Weekly Challenge: Week 227
Challenge 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.
I love calendar problems. This time I'm going to show you my Perl solution first because it gave me an opportunity to
use my favourite toolkit for calendar problems, DateTime. I don't normally
use external modules in these challenges but anything related to dates and times is fraught with peril so using a well-tested
piece of code that handles all the edge casess is a must.
So first we load DateTime.
use DateTime;
We need to store the number of Friday the 13ths found.
my $count = 0;
For each of the twelve months of $year we create a DateTime object set to the 13th
of that month.
for my $month (1 .. 12) {
my $date = DateTime->new(year => $year, month => $month, day => 13);
The .day_of_week() method returns the day of the week beginning with Monday as a number from 1 to 7. So Friday is 5.
if ($date->day_of_week == 5) {
$count++;
}
}
Finally we print the days found.
say $count;
Date handling is part of Rakus' standard library via the Date class. The API is similar to DateTime so the code is essentially
the same.
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;
Challenge 2:
Roman Maths
Write a script to handle a 2-term arithmetic operation expressed in Roman numerals.
Example 1
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)
There was a similar problem in PWC 47 which I thought I could simply reuse. However there I had only implemented addition and subtraction. Now I would have to add multiplication, division and exponentiation and though I suppose I could implement them in terms of addition and subtraction that's a lot of work. So I decided to take the cowardly way out and convert the Roman manuals to our modern ones, do the calculation and then convert the answer back to roman numerals.
So the first thing I needed was a function to convert Roman numerals to English. (Actually Arabic. (Actually Hindu)). The
problem is that some Roman numerals are prefixed. For example 9 is IX or "one before ten." This makes them more difficult to parse. In my old code I had a function, unprefix() that converted such numerals to a postfix order.
sub unprefix(Str $num) {
my $unprefixed = $num;
Luckily, there are not that many prefix numbers so we can easily make a conversion table. I no longer recall why I did this as two arrays, it could (and probably should) have been a hash.
my @from = qw/ CM CD XC XL IX IV /;
my @to = qw/ DCCCC CCCC LXXXX XXXX VIIII IIII /;
We just scan $num for prefixed numbers and replace them with their unprefixed versions.
for 0 ..^ @from.elems -> $i {
$unprefixed = $unprefixed.subst(@from[$i], @to[$i], :g);
}
Then we return the unprefixed version of $num.
return $unprefixed;
}
Now back to our Roman to English conversion function...
sub toEnglish($num) {
Again we set up a conversion table (this time it is a hash) mapping the Roman digits to numeric values.
my %values = (
'M' => 1000,
'D' => 500,
'C' => 100,
'L' => 50,
'X' => 10,
'V' => 5,
'I' => 1,
);
We declare a variable to store the result.
my $english = 0;
After splitting the unprefix()ed version of the numeral into digits, we increase
$english by the value of each digit...
for unprefix($num).comb -> $digit {
$english += %values{$digit};
}
...and return the final result.
return $english;
}
Now in MAIN() we can have code like this to perform the operations.
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; }
If the operation specified on the command line was not one of the ones we support, we print a usage message and stop the script.
default { &*USAGE(); }
}
Now we need a function to convert the result of whatever calculation we did, back into a Roman numeral.
That's what the toRoman() function does.
Because function parameters are immutable in Raku by default, we must specify the is copy role to indicate we
are going to change the value of $num.
sub toRoman($num is copy) {
This is where we will assemble the Roman numeral.
my $roman;
While $num is not zero, we steadily whittle it down, adding Roman digits to $roman as we go.
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;
}
}
Now we have some kind of Roman numeral but it may not be in the standard form. For example,
by this procedure, 9 would by VIIII not IX as it should be. So before returning it, we run it
through another function from my old code called normalize().
return normalize($roman);
}
normalize() is basically the reverse of unprefix() (so perhaps I should have called it reprefix?)
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;
}
Back in MAIN() again we have code like this which also checks for errors.
given $val {
If the result was 0...
when $_ == 0 { say 'nulla'; }
If it was a fraction...
when $_ != $_.Int { say 'non potest'; }
or if it was out of bounds...
when $_ <= 0 { say 'non potest'; }
when $_ >= 4000 { say 'non potest'; }
If it suffers from none of those problems, we convert the result back to a Roman numeral and print it out.
default { say toRoman($val); }
}
This is the Perl version. It works the same way as in Raku.
sub unprefix {
my ($num) = @_;
my @from = qw/ CM CD XC XL IX IV /;
my @to = qw/ DCCCC CCCC LXXXX XXXX VIIII IIII /;
for my $i (0 .. scalar @from - 1) {
$num =~ s/$from[$i]/$to[$i]/g;
}
return $num;
}
sub normalize {
my ($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 my $i (0 .. scalar @from - 1) {
$num =~ s/$from[$i]/$to[$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);
}
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); }
}
If you run my solutions under a Unix/Linux shell and want to do multiplication or exponentiation, there is one caveat. * is
significant to the shell so you should wrap it in quotes like '*' or '**' or it won't work.