Athanasius

Challenge 1: Write a script to print the date of the last Friday of every month in a given year

First thought was to use a module to look up the day of the week for the last day of each month in the given year, then work backwards (in each month) to get the last Friday. But — well, once the weekday of any day in the year is known, the rest can be calculated directly without a further module look-up.

Actually, no module look-up is really needed at all once the day-of-the-week of any day in any year is known. And since I know that 17^th June, 2019, is a Monday, I should be able to derive the solution from first principles, as it were, by counting backwards or forwards as needed. But working out leap years is tricky! So I compromised: one look-up for each given input year.

Perl 5 solution

I chose the DateTime module because it’s familiar (and also recommended in Task::Kensho::Dates). To verify user input of the desired year I used $RE{num}{int} from Regexp::Common. As always, I make heavy use of Const::Fast to separate compile-time data from the code proper:

File ch-1.pl

#!perl

use strict;
use warnings;
use Const::Fast;
use DateTime;
use Regexp::Common;

const my @DAYS_IN_MONTH  =>
        ( 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 );
const my $DAYS_IN_WEEK   =>    7;
const my $DEFAULT_YEAR   => 2019;
const my $FEBRUARY_INDEX =>    1;
const my @OFFSET_1ST_FRI => (  4,  3,  2,  1,  0,  6,  5 );
const my $USAGE          => "USAGE: perl $0 <year>";

$| = 1;

MAIN:
{
    my $year  = get_year();
    my $dt    = DateTime->new(year => $year, month => 1, day => 1);
    my $first = 1 + $OFFSET_1ST_FRI[ $dt->day_of_week - 1 ];
    my @days  = @DAYS_IN_MONTH;
     ++$days[ $FEBRUARY_INDEX ] if $dt->is_leap_year();

    print "\nLast Fridays in each month of $year:\n\n";

    for my $month (0 .. 11)
    {
        my $days  = $days[ $month ];
        my $last  = $first;
           $last += $DAYS_IN_WEEK until $last > $days;
           $first = $last - $days;
           $last -= $DAYS_IN_WEEK;

        printf "%4d/%02d/%02d\n", $year, ($month + 1), $last;
    }
}

sub get_year
{
    scalar @ARGV <= 1
        or die "\n$USAGE\n";

    my $year = $ARGV[0] // $DEFAULT_YEAR;

    $year =~ /^$RE{num}{int}$/
        or die "\nInvalid year '$year': must be an integer\n";

    return $year;
}

Perl 6 solution

Couldn’t find anything suitable in the Perl 6 Modules Directory under DATE, so I again used Perl 5’s DateTime via the indispensable Inline::Perl5 module. No need to manually validate user input in Perl 6: just declare the command-line parameter as Int:D $year and it’s taken care of (as is the Usage message, should one be needed).

File ch-1.p6

use v6;

use DateTime:from<Perl5>;

my Int constant $DAYS_IN_WEEK   :=    7;
my Int constant $DEFAULT_YEAR   := 2019;
my Int constant $FEBRUARY_INDEX :=    1;
my     constant @DAYS_IN_MONTH  := Array[Int].new: 
                31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31;
my     constant @OFFSET_1ST_FRI := Array[Int].new:
                                     4,  3,  2,  1,  0,  6,  5;

sub MAIN(Int:D $year = $DEFAULT_YEAR)
{
    my $dt    = DateTime.new( :$year, month => 1, day => 1 );
    my $first = 1 + @OFFSET_1ST_FRI[ $dt.day_of_week - 1 ];
    my @days  = @DAYS_IN_MONTH;
     ++@days[ $FEBRUARY_INDEX ] if $dt.is_leap_year;

    say "\nLast Fridays in each month of $year:\n";

    for 1 .. 12 -> Int $month
    {
        my $days  = @days[ $month - 1 ];
        my $last  = $first;
           $last += $DAYS_IN_WEEK until $last > $days;
           $first = $last - $days;
           $last -= $DAYS_IN_WEEK;

        printf "%4d/%02d/%02d\n", $year, $month, $last;
    }
}

Challenge 2: Demonstrate mutually recursive methods by generating Hofstadter Female and Male sequences

The most interesting thing about these sequences is that “F(n) is not equal to M(n) if and only if n+1 is a Fibonacci number” (OEIS Sequence A005378).

The key to recursion is to include a base case (stopping condition) to ensure that the recursion eventually ends. After that, it’s fairly plain sailing.

Well, it is until the sequence becomes even moderately long, at which point (depending on the nature of the recursion) performance may grind almost to a halt. In which case the answer (provided memory is not at a premium) is memoization, which trades memory for speed by caching the results of recursive function calls. The best reference I know for memoization is “Chapter 3: Caching and Memoization” in Higher-Order Perl by Mark Jason Dominus.

Without memoization, the Perl 5 script below takes 51 seconds to compute Hofstadter Female and Male sequences 100 terms long. With memoization, it completes in 0.007 seconds: a speed-up of 4 orders of magnitude!

Perl 5 solution

For memoization I use the Memoize module by Mark Jason Dominus himself. Subroutine seq takes a function pointer as its first argument and calls the function repeatedly to accumulate the required number of terms in the series.

File ch-2.pl

#!perl

use strict;
use utf8;
use warnings;
use Const::Fast;
use Memoize;
use Regexp::Common;

const my $DEFAULT =>  21;
const my $USAGE   => "perl $0 [ <series_length> ]";

$| = 1;

MAIN:
{
    @ARGV <= 1
        or die "\n$USAGE\n";

    my $n = $ARGV[0] // $DEFAULT;

    $n =~ /^$RE{num}{int}$/ && $n > 0
    or die "\nInvalid series length '$n': must be an integer > 0\n";

    --$n;  # Convert series length to index of final term
           # (series is zero-based)

    memoize('F');
    memoize('M');

    for my $func ('F', 'M')
    {
        printf "\n%s(%s%d): %s\n", $func, ($n == 0 ? '' : '0..'), $n,
                                join( ', ', seq(\&{$func}, $n)->@* );
    }
}

# Accumulate terms ( X(0) .. X(max) ), where X is either F or M

sub seq
{
    my ($func, $max) = @_;     # max ∊ N ∪ {0}

    my   @series;
    push @series, $func->($_) for 0 .. $max;

    return \@series;
}

sub F       # Find term n in the "Female" series
{
    my ($n) = @_;           # n ∊ N ∪ {0}

    return $n == 0 ? 1                          # Base case
                   : $n - M( F($n - 1) );       # Mutual recursion
}

sub M       # Find term n in the "Male" series
{
    my ($n) = @_;           # n ∊ N ∪ {0}

    return $n == 0 ? 0                          # Base case
                   : $n - F( M($n - 1) );       # Mutual recursion
}

Perl 6 solution

This time there’s a choice of modules for memoization. I chose Sub::Memoized which provides is memoized as a subroutine trait. Note also the use of subset together with where to achieve fine-grained validation of subroutine arguments.

(Also noteworthy, for a Perl 6 novice like me, is the use of the colon in my %funcs = (:&F, :&M);. This is a simpler way of writing my %funcs = (F => &F, M => &M);. See the paragraph beginning “And this other variant, to be used in routine invocation” in the Perl 6 documentation for class Pair.)

File ch-2.p6

use v6;

use Sub::Memoized;

my Int constant $DEFAULT := 21;

subset Non-negative-integer of Int where * >= 0;
subset Positive-integer     of Int where * >  0;

sub MAIN(Positive-integer:D $length = $DEFAULT)
{
    # Convert length to index of final term
    my Int $n      = $length - 1;
    my Str $format = "\n" ~ '%s(%s%d): %s' ~ "\n";
    my Str $prefix = $n == 0 ?? '' !! '0..';
    my     %funcs  = (:&F, :&M);

    $format.printf: $_, $prefix, $n, seq(%funcs{$_}, $n).join(', ')
        for < F M >;
}

# seq(): Accumulate terms X(0), X(1), .. X(max), where X is either
#        F or M

sub seq(Sub:D $func, Non-negative-integer:D $max --> Array)
{
    my     @series;
    push   @series, $func($_) for 0 .. $max;

    return @series;
}

# F(): Find term n in the "Female" series

sub F(Non-negative-integer:D $n --> Non-negative-integer) is memoized
{
    return $n == 0 ?? 1                         # Base case
                   !! $n - M( F($n - 1) );      # Mutual recursion
}

# M(): Find term n in the "Male" series

sub M(Non-negative-integer:D $n --> Non-negative-integer) is memoized
{
    return $n == 0 ?? 0                         # Base case
                   !! $n - F( M($n - 1) );      # Mutual recursion
}

Challenge 3: Find the details of a given word using the Words API

Signed up to RapidAPI without a problem. However, WordsAPI requires a subscription, which in turn requires submission of credit card details (even though the Basic Plan is free). I won’t do this, on principle — it’s just asking for trouble.