Perl Weekly Challenge: Week 13
This week is the fastest I've completed the Perl Weekly Challenge having submitted the solutions to Mohammed by Wednesday. As we shall see, maybe I was a little too hasty...
Challenge 1:
Write a script to print the date of last Friday of every month of a given year. For example, if the given year is 2019 then it should print the following:
2019/01/25 2019/02/22 2019/03/29 2019/04/26 2019/05/31 2019/06/28 2019/07/26 2019/08/30 2019/09/27 2019/10/25 2019/11/29 2019/12/27
I am a huge calendar buff if you can imagine such a thing. Human cultures have created so many different ways of organizing time and it is so interesting how they have developed and been influenced by religious figures, monarchs, politicians, and even the occasional scientist.
I have contributed a few calendar related modules to the Perl DateTime project. DateTime gives you a complete toolkit for any kind of time or date related calculations and there also a few less powerful but still useful modules in Perls' standard library but for this challenge I wanted to avoid using any modules.
The current calendar system used in the Western world is called the Gregorian calendar, commissioned by Pope Gregory XIII in 1582 to replace the less accurate Julian calendar which had been in use since Roman times. However various countries adopted the Gregorian calendar at various times. Great Britain and her colonies (i.e. all the countries that count :-)) didn't get around to it until late 1752.
My code deals with the Gregorian calendar only and its epoch (start date) is January 1, 1753. If you want the last Fridays of a year before 1753 or you are from a country that adopted the Gregorian calendar at some other date, you will likely get incorrect results.
In the Gregorian calendar, a year usually has 365 days except "leap years" which
have one extra. A leap year occurs every 4 years except centennial years which
are not quadricentennial years. This logic is encapsulated in the isLeap()
function.
sub isLeap {
my ($year) = @_;
return ($year % 4 == 0 && ($year % 100 != 0 || $year % 400 == 0));
}
Because we know the epoch was a Monday, we can calculate the day of the week of any subsequent date by counting the number of elapsed days since the epoch modulo 7. First we find the number of elapsed days from the epoch to January 1 of the target year by multiplying the elapsed years by 365.
my $elapsedDays = ($year - 1753) * 365 + elapsedLeapDays($year);
my $newYearDay = ($elapsedDays + 1) % 7; # +1 because 1753/1/1 was a Monday.
The only complication is leap years have an extra day which we need to account
for. That logic is encapsulated in the elapsedLeapDays() function. Here
in my rush to complete the challenge, I made a huge mistake. My first attempt
at writing this function was only coincidentally correct for 2019 and failed for
almost every other year. Back when I was programming perl professionally, I always
added unit tests when writing code like this which would have caught the error
immediately but I've been cutting corners when doing these challenges. Luckily
I did notice the problem before the submission deadline so the code shown below
does the right thing.
sub elapsedLeapDays {
my ($year) = @_;
# Subtractions because we want 1-based years here.
return int(($year - 1753) / 4)
- int(($year - 1701) / 100) # exclude centennial years >= 1800
+ int(($year - 1601) / 400); # include quadricentennial years >= 2000
}
There are a fixed number of days in each Gregorian month so once we know the number of elapsed days from the epoch to January 1 of a year, we can find the elapsed days until the last day of each month in that year by adding a constant amount. (Well, almost constant; leap years require an adjustment.)
my @lastDays = (30, 58, 89, 119, 150, 180, 211, 242, 272, 303, 333, 364);
# account for Feb 29 in leap years.
if (isLeap($year)) {
for my $month (1 .. 11) {
$lastDays[$month]++;
}
}
Now we can calculate the day of the week of the last day of the month and having
that, it is a simple matter to determine the last Friday of the month by applying
an offset. We already know the year and the month; the last step is to determine
the date this last Friday occurred on by subtracting the last day of the previous
month. That will work for every month except for January which has no previous
month so for that we just add 1 (or subtract -1) from $lastFriday.
my @offset = (2, 3, 4, 5, 6, 0, 1);
for my $month (0 .. 11) {
my $lastDay = $lastDays[$month];
my $lastFriday = $lastDay - $offset[($newYearDay + $lastDay) % 7];
my $day = $lastFriday - (($month > 0) ? $lastDays[$month - 1] : -1);
say join q{/}, ($year, $month + 1, $day);
}
This is the Perl6 version. It too suffered from the elapsedLeapDays() bug.
Note the use of the div operator. It does integer division so the result
doesn't need to be processed with int().
isLeap() also had a bug which didn't exist in the Perl5 version. I routinely
use the divisibility or %% operator to do the equivalent of $x % $n == 0
in Perl5. So I thought I could check if a year is not divisible by 100 by writing
!$year %% 100. What that actually does is check if 0 is divisible by 100
which is never going to happen. Adding parentheses made it do the right thing.
If I have time I'm going to see if there is any interest in adding a !%% (or maybe !%?) operator to the Perl6 language.
sub elapsedLeapDays(Int $year) {
# Subtractions because we want 1-based years here.
return (($year - 1753) div 4)
- (($year - 1701) div 100) # exclude centennial years >= 1800
+ (($year - 1601) div 400); # include quadricentennial years >= 2000
}
sub isLeap(Int $year) {
# years divisible by 100 are not leap years unless they are divisble by 400.
return ($year %% 4 && (!($year %% 100) || $year %% 400));
}
multi sub MAIN(
Int $year where { $_ > 1752 } #= A four digit year greater than 1752
) {
my $elapsedDays = ($year - 1753) * 365 + elapsedLeapDays($year);
my $newYearDay = ($elapsedDays + 1) % 7; # +1 because 1753/1/1 was a Monday.
my @lastDays = (30, 58, 89, 119, 150, 180, 211, 242, 272, 303, 333, 364);
# account for Feb 29 in leap years.
if isLeap($year) {
for 1 .. 11 -> $month {
@lastDays[$month]++;
}
}
my @offset = (2, 3, 4, 5, 6, 0, 1);
for 0 .. 11 -> $month {
my $lastDay = @lastDays[$month];
my $lastFriday = $lastDay - @offset[($newYearDay + $lastDay) % 7];
my $day = $lastFriday - (($month > 0) ?? @lastDays[$month - 1] !! -1);
($year, $month + 1, $day).join('/').say;
}
}
Challenge 2:
Write a script to demonstrate Mutually Recursive methods. Two methods are mutually recursive if the first method calls the second and the second calls first in turn. Using the mutually recursive methods, generate Hofstadter Female and Male sequences.
F ( 0 ) = 1 ; M ( 0 ) = 0 F ( n ) = n − M ( F ( n − 1 ) ) , n > 0 M ( n ) = n − F ( M ( n − 1 ) ) , n > 0.
I read "Godel, Escher, and Bach" a long time ago and I don't remember this bit but now I'm curious. Codewise the script was pretty straightforward. This is Perl5.
sub female {
my ($n) = @_;
return ($n == 0) ? 1 : $n - male(female($n - 1));
}
sub male {
my ($n) = @_;
return ($n == 0) ? 0 : $n - female(male($n - 1));
}
my (@f, @m);
for my $n (0 .. 20) {
push @f, female($n);
push @m, male($n);
}
say 'Female: ', join ', ', @f;
say 'Male: ', join ', ', @m;
and this is Perl6. I used the multidispatch capability for separating the base
and normal cases of each recursive function. In MAIN() I used generators
to make lazy lists of the results of each series which is more efficient.
multi sub female(Int $n where { $_ == 0 }) {
return 1;
}
multi sub female(Int $n where { $_ > 0 }) {
return $n - male(female($n - 1));
}
multi sub male(Int $n where { $_ == 0 }) {
return 0;
}
multi sub male(Int $n where { $_ > 0 }) {
return $n - female(male($n - 1));
}
multi sub MAIN() {
say 'Female: ', ({ female((state $n = 0)++) } ... *)[0 .. 20].join(', ');
say 'Male: ', ({ male((state $n = 0)++) } ... *)[0 .. 20].join(', ');
}