laurent_r

These are some answers to the Week 48 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a couple of days (February 23, 2020). This blog post offers some solutions to this challenge, please don’t read on if you intend to complete the challenge on your own.

Task 1: The Survivor

There are 50 people standing in a circle in positions 1 to 50. The person standing at position 1 has a sword. He kills the next person i.e. standing at position 2 and passes on the sword to the immediate next, i.e. person standing at position 3. Now the person at position 3 does the same and it goes on until only one survives.

Write a script to find out the survivor.

This is sometimes called the Josephus Problem, named after Flavius Josephus, a Jewish historian of the 1st century who allegedly escaped collective suicide of defeated Jewish soldiers trapped by Roman soldiers by finding the right position to be the survivor.

The idea is that you remove every second person in a circle until there is only one person left, and the problem is to find the rank of that last person. There is an analytical solution (well two different ones, depending on whether the initial number of persons is even or odd), but it’s more fun to do it in the way the task is described (at least if you set aside the gory details about the sword and the killing).

We’ll set up the initial 50 persons (or whatever other number) in an array and, at each step in the process, remove the first two persons in the row, while adding the first one at then end of the array.

Survivor in Perl

This first implementation does just what we have described above: we shift the first person in the array and push him or her at the end of the array and shift (i.e. remove) the second person, and we do that in a loop until there is only one person left:

use strict;
use warnings;
use feature "say";

my $number = shift // 50;
my @persons = 1 .. $number; # we can do that because 
                            # we don't use the array indices
do {
    push @persons, shift @persons;
    shift @persons;
    say "@persons";
} until @persons == 1;
say "Person @persons is the survivor.\n";

We will first run this program with a parameter of 10, because it will be easier to visualize the process with only ten steps:

$ perl survivor.pl 10
3 4 5 6 7 8 9 10 1
5 6 7 8 9 10 1 3
7 8 9 10 1 3 5
9 10 1 3 5 7
1 3 5 7 9
5 7 9 1
9 1 5
5 9
5
Person 5 is the survivor.

Commenting out the intermediate array displays and passing a parameter of 50 (or no parameter to use the default value), we’ll find that the survivor is the person with number 37:

$ perl survivor.pl
Person 37 is the survivor.

Although this is really not a problem here, there is a slight inefficiency in the above implementation: at each step through the process, we’re checking how many persons are left in the array. In fact, we are eliminating one person at each step, and therefore know in advance that we want to iterate through the process one time less that the initial number of persons (e.g. 49 times for an initial count of 50). Thus, we can use a for loop without having to check the array size:

use strict;
use warnings;
use feature "say";

my $number = shift // 50;

my @persons = 1 .. $number;
for (1.. $number - 1) {
    push @persons, shift @persons;
    shift @persons;
} 
say "Person @persons is the survivor.\n";

This also prints that person 37 is the survivor.

Survivor in Raku

Our Raku solution will be almost the same as the second Perl solution. In fact, the for loop is exactly the same, only the retrieval of the parameter passed to the program and the printing statement at the end are slightly different:

use v6;

my $number = @*ARGS ?? @*ARGS[0] !! 50;

my $number = 50;
my @persons = 1 .. $number;

for (1.. $number - 1) {
    push @persons, shift @persons;
    shift @persons;
}
say "Person @persons[] is the survivor.\n";

And this prints out the same:

$ perl6 survivor.p6
Person 37 is the survivor.

Task 2: Palindrome Dates

Write a script to print all Palindrome Dates between 2000 and 2999. The format of date is mmddyyyy. For example, the first one was on October 2, 2001 as it is represented as 10022001.

The first idea might be to check every date within the given range, but that’s a lot of dates (more than 365,000 dates), and that brute force approach might take quite a bit of time and is quite inelegant.

We can very strongly reduce the number of dates to be checked by noticing that for every mmdd month-day combination, there can be at most only one year to produce a palindromic date; conversely, for any year in the range, there can be at most only one date that is a palindrome. So we can either check every month-day combination or check every year of the range. I decided to go for this second solution, because, as we shall see, we can still strongly reduce the number of possibilities that we need to check (and the code will be slightly simpler).

Of course, we’ll also need to make sure that the dates we produce are valid.

Palindrome Dates in Perl

We start with the idea of checking every year in the range. Suppose we’re looking at 2001, we reverse the year and get 1002 which, if the format is mmdd, corresponds to Oct. 2, 2001. 2000, on the other hand, cannot have a palindromic date since 00 isn’t a valid month number. 2002 is a palindromic year, but we can’t find a palindromic date in it because 20 isn’t a valid month number.

Now, consider year 2301, which produces in reverse 1032. The number 32 cannot be a day in the month, and the same reasoning applies to any year thereafter, so that we only need to check the range between 2001 and 2299, and we end up with only about 300 dates to check. As a side consequence, all the tentative days in month that we will find will be 02, 12, or 22. The very good news here is that any month can have such days in month, and we don’t need to worry about months with 28, 29, 30, and 31 days. In other words, we can check that the tentative day in month is in the 01-31 range (although, in fact, checking the 01-22 range would be sufficient), and that the tentative month is in the 01-12 range. As a result (and contrary to what I initially thought), we don’t even need to use any module to check that the dates we obtain are correct, they are bound to be valid.

Thus, our program is fairly simple:

use strict;
use warnings;
use feature "say";

for my $year (2000 .. 2300) {
    my ($month, $day) = (reverse $year) =~ /(\d\d)(\d\d)/;
    next if $month > 12 or $month < 1 or $day > 31 or $day < 1;
    say "$month/$day/$year is a palindromic date.";
}

Running this program produces 36 palindromic dates in the 2000-2999 range:

$ perl palindromic_date.pl
10/02/2001 is a palindromic date.
01/02/2010 is a palindromic date.
11/02/2011 is a palindromic date.
02/02/2020 is a palindromic date.
12/02/2021 is a palindromic date.
03/02/2030 is a palindromic date.
04/02/2040 is a palindromic date.
05/02/2050 is a palindromic date.
06/02/2060 is a palindromic date.
07/02/2070 is a palindromic date.
08/02/2080 is a palindromic date.
09/02/2090 is a palindromic date.
10/12/2101 is a palindromic date.
01/12/2110 is a palindromic date.
11/12/2111 is a palindromic date.
02/12/2120 is a palindromic date.
12/12/2121 is a palindromic date.
03/12/2130 is a palindromic date.
04/12/2140 is a palindromic date.
05/12/2150 is a palindromic date.
06/12/2160 is a palindromic date.
07/12/2170 is a palindromic date.
08/12/2180 is a palindromic date.
09/12/2190 is a palindromic date.
10/22/2201 is a palindromic date.
01/22/2210 is a palindromic date.
11/22/2211 is a palindromic date.
02/22/2220 is a palindromic date.
12/22/2221 is a palindromic date.
03/22/2230 is a palindromic date.
04/22/2240 is a palindromic date.
05/22/2250 is a palindromic date.
06/22/2260 is a palindromic date.
07/22/2270 is a palindromic date.
08/22/2280 is a palindromic date.
09/22/2290 is a palindromic date.

Palindrome Dates in Raku

We can translate the same program into Raku. Please read the reasoning in the Perl section just above (if you didn’t) to understand why we limit the range to the 2000..2300 range and why we don’t need to further verify the validity of the obtained dates.

use v6;

for 2000 .. 2300 -> $year {
    my ($month, $day) = ($year.flip ~~ /(\d\d)(\d\d)/)[0, 1];
    next if $month > 12 or $month < 1 or $day > 31 or $day < 1;
    say "$month/$day/$year is a palindromic date.";
}

This produces the same result as before:

$ perl6 palindromic_date.p6
10/02/2001 is a palindromic date.
01/02/2010 is a palindromic date.
11/02/2011 is a palindromic date.
[Lines omitted for brevity]
08/22/2280 is a palindromic date.
09/22/2290 is a palindromic date.

Wrapping up

The next week Perl Weekly Challenge is due to start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on Sunday, March 1, 2020. And, please, also spread the word about the Perl Weekly Challenge if you can.