Hofstadter, Friday and Perl 6

by Arne Sommer

Hofstadter, Friday and Perl 6

Published 22. June 2019

This is my response to the Perl Weekly Challenge #13.

Challenge #13.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

The straightforward approach (with the emphasis on «forward») would be to start with 1. January of the specified year, and add days until we get a Friday. Then add a week at a time, and note the last date before the month number increases. This goes on until we reach the next year.

Perl 6 has a «Date» class that is the obvious choice when working with dates.

File: last-friday-forward
unit sub MAIN (Int $year = DateTime.now.year);    # [1]

my $date = Date.new($year, 1, 1);                 # [2]

$date.=succ while $date.day-of-week != 5;         # [2b]

my $old = $date;                                  # [3]

while $date.year == $year                         # [4]
{
  $old = $date;                                   # [3]
  $date.=later(days => 7);                        # [5]
  say $old if $old.month != $date.month;          # [5b]
}

[1] Defaulting to the current year is a nice touch. The «Date» class doesn't support the «now» method, so we have to use «DateTime» instead. Update: I should have used «Date.today.year». Thanks to Elizabeth Mattijsen for pointing it out (on Reddit).

[2] Start with 1. january of the year, and add one day at a time until we get a Friday [2b].

[3] We keep the old date in the «$old» variable, so that we can keep track of the changes in month numbers.

[4] We are finished when we have reached the next year.

[5] Add one week at a time, and print the date if the next one is in a different month [5b].

See docs.perl6.org/type/Date for more information about the «Date» class and available methods.

See docs.perl6.org/type/DateTime for more information about the «DateTime» class and available methods.

The dates are correct, but on the form «2019-06-28». We could have used a custom formatter (see docs.perl6.org/type/Date#(Dateish)_method_formatter), but it is easier to just fix the output with a string transformation.

File: last-friday-forward (changes only)
  say $current.Str.trans("-" => "/") if $current.month != $date.month;

The «trans» method doesn't work on «Date» objects, so we have to stringify it first with the «Str» method.

Running it:

$ perl6 last-friday-forward
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

A BIG Warning

The program makes a «Date» object («$date»), and works with that single object.

Then we introduce a new variable («$old»), which we set up like this: «$old = $date». This does not give us a new object, merely a second pointer to the first object. So when we later change the date (with the «pred» method) this is visible for both variables. Right?

Well, no. The «pred» method doesn't change the object, but returns a new version with the date changed. Then we use the «.=» shortcut to assign the new value back to the original variable. (We could have written it as «$date = $date.pred» to make it clearer.) So we have two different objects, and the code works.

The documentation for «Date» actually states this up front: «A Date is an immutable object identifying a day in the Gregorian calendar.» Immutable means read only, so any change will give a new object.

Backwards

The straightforward approach was to start at 1. January, but it is possible to start at 31. December and work our way backwards as well:

File: last-friday-backward
unit sub MAIN (Int $year = DateTime.now.year);

my $date = Date.new($year, 12, 31);            # [1]

$date.=pred while $date.day-of-week != 5;      # [1a]

my @dates = ($date);                           # [1b]

my $current-month = 12;                        # [2]

for ^11                                        # [4]
{
  $date.=earlier(days => 7) while $date.month == $current-month;  # [3]
  $current-month--;                            # [3a]
  @dates.push: $date;                          # [3b]
}

.Str.trans("-" => "/").say for @dates.reverse; # [5]

[1] Start with the last day of the year, and subtract one day at a time until we reach a Friday [1a] - which is the the last Friday in December. Save that date [1b].

[2] The current month, that we have printed the last Friday for, is December - or 12 as a number.

[3] Subtract one week from the date in a loop, until we arrive at a different month number. That gives us the last Friday in that month. Take note of the new month number [3a] and save the date [3b].

[4] Do step [3] in a loop 11 times. This gives us all the 12 months; December from [1] and the rest (November down to January) from [4].

[5] print the dates in correct order (by reversing them).

Running it:

$ perl6 last-friday-backward
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

This version has only one «Date» object. The second one has been replaced with a month counter (integer).

Forward and backward

It is possible to make it even more compact, by starting with the last day in each month, and going back until we reach a Friday:

File: last-friday
unit sub MAIN (Int $year = DateTime.now.year);

for 1 .. 12 -> $month
{
  my $date = Date.new($year, $month, Date.new($year, $month, 1).days-in-month);

  $date.=pred while $date.day-of-week != 5;

  say $date.Str.trans("-" => "/");
}

The only non-trivial part is the line where we get the last day in the month. The «Date.new» constructor doesn't have a way of specifying "the last day", so we have to use the «days-in-month» method on a Date object to get it.

The use of a «while» loop is not very efficient, as we construct a new «Date» object each time. We could use the «earlier» method instead, with the number of days as argument:

File: last-friday-shorter
unit sub MAIN (Int $year = DateTime.now.year);

for 1 .. 12 -> $month
{
  my $date = Date.new($year, $month, Date.new($year, $month, 1).days-in-month);

  say $date.earlier(days => $date.day-of-week < 5
    ?? ($date.day-of-week + 2)
    !! ($date.day-of-week - 5) ).Str.trans("-" => "/");
}

It is more compact as well (if you ignore the newlines added to make it fit the page width), but much harder to understand.

A One-Liner

Making a one-liner out of it is the next logical step.

This requires the use of a code block with a parameter. The parameter is declared up front, and the block is called like a procedure with the argument in trailing parens:

-> $a { say $a }(12);  # -> 12

This code prints «12».

And here we have the one-liner:

File: last-friday-oneliner
-> $year
{
  -> $month
  {
    -> $date
    {
      say $date.earlier(days => $date.day-of-week < 5
        ?? ( $date.day-of-week + 2 )
        !! ( $date.day-of-week - 5)
      ).Str.trans("-" => "/") 
    }(Date.new($year, $month, Date.new($year, $month, 1).days-in-month))
  }($_) for 1 .. 12
}(@*ARGS[0] // DateTime.now.year);

It was difficult to program, but it works. And it gives the correct answer.

I have added newlines to make it easier to read, and fit the screen width. It is hard to understand, and even harder if you remove the newlines.

I have included the program as a single line as «last-friday-oneliner-actually» in the zip file. (In addition to the «#!» line.)

Challenge #13.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

The challenge doesn't say how many values we should compute, so I have chosen to get them on the command line.

File: hofstadter-FM (partial)
unit sub MAIN ($limit = 10);        # [1]

multi sub F (0) { return 1; }       # [2]

multi sub F (Int $n where $n > 0)   # [2]
{
  return $n − M( F($n − 1) )
}

multi sub M (0) { return 0; }       # [2]

multi sub M (Int $n where $n > 0)   # [2]
{
  return $n − F( M($n − 1) );
}

say "  ", (    $_.fmt("%2d") for ^$limit ).join(" "); # [3]
say "F:", ( F($_).fmt("%2d") for ^$limit ).join(" "); # [3]
say "M:", ( M($_).fmt("%2d") for ^$limit ).join(" "); # [3]

[1] The number of values to show, with 10 as the default.

[2] Note how similar the code is to the mathematical formula given in the challenge. Multiple dispatch («multi sub») is ideal here.

[3] Print the required number of values. First a counter, then the F sequence, and finally the M sequence.

Running it:

$ perl6 hofstadter-FM 20
   0  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19
F: 1  1  2  2  3  3  4  5  5  6  6  7  8  8  9  9 10 11 11 12
M: 0  0  1  2  2  3  4  4  5  6  6  7  7  8  9  9 10 11 11 12

Even more like the formula

We don't have to use sigils in Perl 6. Prefix the variable name with «\» (a backslash) in the declaration, and you have a sigilless variable.

We van get rid of the «return» statements as well, as the last evaluated value in a procedure is the return value if we don't specify one.

File: hofstadter-FM2
unit sub MAIN ($limit = 10);

multi sub F (0) { 1; }

multi sub F (Int \n where n > 0)
{
  n − M( F(n − 1) ); 
}

multi sub M (0) { 0; }

multi sub M (Int \n where n > 0)
{
  n − F( M(n − 1) ); 
}

say "  ", (    $_.fmt("%2d") for ^$limit ).join(" ");
say "F:", ( F($_).fmt("%2d") for ^$limit ).join(" ");
say "M:", ( M($_).fmt("%2d") for ^$limit ).join(" ");

The code is very similar to the mathematical formula.

Recursion Caveat

Using recursion gives compact code, and in this case a call to «F» or «M» doesn't involve computing the same value again and again. But the value is computed again when we call the same procedure with the argument increased with 2, as we do in the program.

This is essentially a caching problem, and Perl 6 has a built in solution: a Sequence. If we use a Sequence as an iteratior (e.g. in a «for» loop) the values are forgotten once used, but they are kept around if we access it as an array.

I am fond of «gather/take», so a first try at the Sequences could look like this:

File: hofstadter-FM-sequence (partial)
my $F := gather
{
  take 1;
  loop { state $index++; take $index - $M[$F[$index -1]]; }
}

my $M := gather
{
  take 0;
  loop { state $index++; take $index - $F[$M[$index -1]]; }
}

The program aborts with a compile time error, as «$F» refer to «$M» before it has been declared.

Predefining «$M» does the trick:

File: hofstadter-FM-sequence
unit sub MAIN ($limit = 10);

my $M;
my $F := gather
{
  take 1;
  loop { state $index++; take $index - $M[$F[$index -1]]; }
}

$M := gather
{
  take 0;
  loop { state $index++; take $index - $F[$M[$index -1]]; }
}

say "  ", (    $_.fmt("%2d") for ^$limit ).join(" ");
say "F:", ( $F[$_].fmt("%2d") for ^$limit ).join(" ");
say "M:", ( $M[$_].fmt("%2d") for ^$limit ).join(" ");

The output statements use array access instead of a procedure call, but the code looks almost the same.

Running it:

$ perl6 hofstadter-FM-sequence
   0  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19
F: 1  1  2  2  3  3  4  5  5  6  6  7  8  8  9  9 10 11 11 12
M: 0  0  1  2  2  3  4  4  5  6  6  7  7  8  9  9 10 11 11 12

We can compare the time consumption with the Unix «time» command:

CommandTime
hofstadter-FM-sequence 400,002 seconds
hofstadter 404,600 seconds
hofstadter-FM-sequence 100   0,230 seconds
hofstadter 10022 minutes

Conclusion: Recursion is elegant, but can be really really slow.