Perl Weekly Challenge 013: Last Fridays and Hofstadter Female and Male Sequences

Last Fridays

Write a script to print the date of last Friday of every month of a given year.

To handle dates, I used Time::Piece, a core module since 5.10. It has no method to get the last Friday of a month directly, so I tried a simple trick: get the first day of the next month, subtract one day, and continue to subtract days until we get a Friday.

Time::Piece does all the date maths in seconds. I also used Time::Seconds to get the constant ONE_DAY so I didn’t have to count it myself (60 * 60 * 24, right?)

use warnings;
use strict;

use Time::Piece;
use Time::Seconds;

sub last_fridays {
    my ($year) = @_;
    my @fridays = map _last_friday($year, $_), 2 .. 12;
    push @fridays, _last_friday($year + 1, 1);
    return @fridays

sub _last_friday {
    my ($year, $month) = @_;
    my $date = 'Time::Piece'->strptime("$year/$month/1", '%Y/%m/%d');

    $date -= ONE_DAY;
    $date -= ONE_DAY until $date->fullday eq 'Friday';

    return $date->strftime('%Y/%m/%d');

use Test::More tests => 1;

my @list = last_fridays(2019);
chomp( my @expected = <DATA> );

is_deeply \@list, \@expected;


The code worked but I didn’t like the loop at the end of each month. If we knew what day the first day of the next month was, there must be a formula to calculate the number of days to subtract directly. Let’s see:

First day of the next month wday Days to substract

We need to add 1 to the current wday, but we need to turn 8 to 1. We can do this by using the modulo operator, but it changes 7 to 0, which we need to further compensate by ||.

    my $diff = ($date->wday + 1) % 7 || 7;
    $date = $date - $diff * ONE_DAY;

Hofstadter Female and Male Sequences

I used Function::Parameters to make the definition of the functions as close as possible to the ones given at Wikipedia.

use warnings;
use strict;

use Function::Parameters;

fun F ($n) { $n ? $n - M(F($n - 1)) : 1 }
fun M ($n) { $n ? $n - F(M($n - 1)) : 0 }

use Test::More;

    [map F($_), 0 .. 20],
    [1, 1, 2, 2, 3, 3, 4, 5, 5, 6, 6, 7, 8, 8, 9, 9, 10, 11, 11, 12, 13];

    [map M($_), 0 .. 20],
    [0, 0, 1, 2, 2, 3, 4, 4, 5, 6, 6, 7, 7, 8, 9, 9, 10, 11, 11, 12, 12];


It works, but we aren’t done yet. Try using a larger $n, e.g. 99. On my machine, it takes about 1.3 seconds, and it gives the warning

Deep recursion on subroutine "main::F" at ...

twice. Using even larger $n’s slows the program rapidly and the number of the warnings grows.

If we analyse the flow of the program, we’ll see that we’re counting the function many times with the same argument. We can speed up our code by caching the return value for each argument. There’s even a core module (since 5.8) to do that for us: Memoize. Adding the following two lines makes the program finish in under 0.07 seconds:

use Memoize;
memoize('F', 'M');

Lightning fast! Why don't we use memoization all the time?

There are two reasons. First, it only works for pure functions, i.e. subroutines whose output only depends on the input values, with no side effects. And second, we pay a price for each memoized value: it has to be stored somewhere, right?

In fact, memoizing just one of the functions gives almost the same speed benefit (we only call the other function once for each $n), but consumes only half the memory.

Leave a comment

About E. Choroba

user-pic I blog about Perl.