Perl Weekly Challenge Week 013

Fridays and Mutually Recursive methods

Perl Weekly Challenge - 013

Published 19 June 2019.

Come with me now on a journey through time and space as I workout how to solve this week's challenges.

Challenge 1

Problem Statement

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
                

Assumptions

Initial Thoughts

If I can find the first date of a year which is a Friday and the number of days in the year, then I can workout all of the dates of Fridays in a year. Then I add them positionally to an array by month and the last assignment for each position will be the last Friday of the month.

Research

What Perl modules can I use to achieve this?

time and localtime seem like the only base modules and both refer me to DateTime module on CPAN for something more comprehensive.

Learning Perl also suggests DateTime as well as Time::Moment.

Perl Best Practices suggests DateTime in it's recommended CPAN modules.

How do I find the week day of the first day of the year given? Math Forum comes to the rescue with Formula for the First Day of a Year.

    Here is a formula for finding the day of the week for ANY date.

       N = d + 2m + [3(m+1)/5] + y + [y/4] - [y/100] + [y/400] + 2

    where d is the number or the day of the month, m is the number of the
    month, and y is the year. The brackets around the divisions mean to
    drop the remainder and just use the integer part that you get.

    Also, a VERY IMPORTANT RULE is the number to use for the months for
    January and February. The numbers of these months are 13 and 14 of the
    PREVIOUS YEAR. This means that to find the day of the week of New
    Year's Day this year, 1/1/98, you must use the date 13/1/97. (It
    sounds complicated, but I will do a couple of examples for you.)

    After you find the number N, divide it by 7, and the REMAINDER of that
    division tells you the day of the week; 1 = Sunday, 2 = Monday, 3 =
    Tuesday, etc; BUT, if the remainder is 0, then the day is Saturday,
    that is: 0 = Saturday.
                

DateTime has a method day_of_week() which should return 5 for any Fridays, which seems simpler.

    $dt->day_of_week()
     Returns the day of the week as a number, from 1..7, with 1 being Monday
     and 7 being Sunday.
                

How do I get the number of days in a year? 365 days or 366 in a leap year. DateTime has a method is_leap_year() or I could work it out from the following rules:

        The Gregorian Calendar
    Every year that is exactly divisible by four is a leap year, except for
    years that are exactly divisible by 100, but these centurial years are
    leap years if they are exactly divisible by 400. For example, the years
    1700, 1800, and 1900 are not leap years, but the year 2000 is.
                

Having the date of the first Friday of the year and the length of the year in days how do I find the dates of the other Fridays? DateTime lists an $dt->add( parameters for DateTime::Duration ) method in Math Methods, I could use the parameter weeks => 1 to add 7 days to the date.

Second Thoughts

I'm going to implement the Dr Math formula as a subroutine to give me the date of the first Friday of a year. Then I'll use DateTime object methods to work out the other Fridays. I'll stop when DateTime method $dt->year() changes and not bother counting days. Then I'll add them to an array of size 12 to find the last Fridays of the month.

Problems Encountered

Had to use $dt->clone method on the DateTime objects as initially the array was filled with the last Friday calculated in my while loop. This is something I need to learn more about. I presume I added 12 references to the same DateTime object which finally held the state of the first Friday of the following year. Using the clone method created a copy of the DateTime object with state as at the time of cloning.

Code

#!/usr/bin/env perl
# Author: Steven Wilson
# Date: 2019-06-17

use strict;
use warnings;
use feature qw / say /;
use DateTime;
use Test::Simple tests => 3;

ok( get_first_day_of_year(2019) == 3, "First day of 2019 is a Tuesday" );
ok( get_first_day_of_year(2005) == 0, "First day of 2005 is a Saturday" );
ok( get_first_friday_of_year(2019)->strftime("%Y/%m/%d") eq "2019/01/04",
    "Date of first friday in 2019 is 2019/01/04." );

my @all = get_last_fridays_of_month_for_year(2019);
for (@all) {
    say $_->strftime("%Y/%m/%d");
}

sub get_last_fridays_of_month_for_year {
    my $year        = shift;
    my @all_fridays = get_all_fridays_for_year($year);
    my @last_fridays;
    for (@all_fridays) {
        $last_fridays[ $_->month - 1 ] = $_;
    }
    return @last_fridays;
}

sub get_all_fridays_for_year {
    my $year   = shift;
    my $friday = get_first_friday_of_year($year);
    my @all_fridays;
    while ( $friday->year() == $year ) {
        push @all_fridays, $friday->clone();
        $friday->add( weeks => 1 );
    }
    return @all_fridays;
}

sub get_first_friday_of_year {
    my $year         = shift;
    my $first_friday = 7 - get_first_day_of_year($year);
    my $dt           = DateTime->new(
        year  => $year,
        month => 1,
        day   => $first_friday,
    );
    return $dt;
}

sub get_first_day_of_year {
    my $year = shift;
    my $y    = $year - 1;
    my $m    = 13;
    my $d    = 1;
    my $N
        = $d
        + ( 2 * $m )
        + int( 3 * ( $m + 1 ) / 5 )
        + $y
        + int( $y / 4 )
        - int( $y / 100 )
        + int( $y / 400 )
        + 2;
    return $N % 7;    # 0 .. 6 represents Saturday .. Friday
}
                

Challenge 2

Problem Statement

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.
                

Initial thoughts

Looks straightforward enough, I just have to create 2 subroutines using these formulas. Lets see how straightforward it turns out to be...

Code

#!/usr/bin/env perl
# Author: Steven Wilson
# Date: 2019-06-17

use strict;
use warnings;

my $n = 20;

print "female sequence: ";
for ( 0 .. $n ) {
    my $value = female($_);
    print "$value, ";
}
print "...\n";

print "  male sequence: ";
for ( 0 .. $n ) {
    my $value = male($_);
    print "$value, ";
}
print "...\n";

sub female {
    my $n = shift;
    if ( $n == 0 ) {
        return 1;
    }
    elsif ( $n > 0 ) {
        return ( $n - male( female( $n - 1 ) ) );
    }
}

sub male {
    my $n = shift;
    if ( $n == 0 ) {
        return 0;
    }
    elsif ( $n > 0 ) {
        return ( $n - female( male( $n - 1 ) ) );
    }
}
                

They have base cases (where n == 0), move towards the base in each call ($n -1) and they call themselves and each other so they are mutually recursive.

Output

Output of running the above code

Problems Encountered

Initially I had named my subroutines 'f' and 'm' and couldn't get the correct output unless I had the prefix '&' in the call. I eventually figured out that 'm' is a builtin function which pattern matches strings, therefore, the prefix was needed to call my subroutine.