Perl Weekly Challenge 048: Survivor and Palindrome Dates
Survivor
There are 50 people standing in a circle in position 1 to 50. The person standing at position 1 has a sword. He kills the next person i.e. standing at position 2 and pass 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.
I tried two different approaches to the problem.
The first one uses an array of living people and a variable $sword
that stores the index of the person holding the sword. In each iteration of the loop, the next person is removed from the array, and the sword is passed to the next person.
The “next person” has a special cyclic meaning: at the end of the array, the sword must return to the beginning. This is achieved by using the modulo operator %
. Note that we use it twice, once to find the person to kill, and once to find the person to pass the sword to—and each case uses a different array size in the modulo operation, as killing a person changes the size of the array.
#! /usr/bin/perl
use warnings;
use strict;
use feature qw{ say };
my @people = 1 .. 50;
my $sword = 0;
while (@people > 1) {
$sword = (1 + $sword) % @people;
splice @people, $sword, 1;
$sword %= @people;
}
say $people[0];
The second approach doesn’t change the size of the array. Instead, it stores 1 in the array if the person corresponding to the array index is alive, or zero if they’re dead. When killing a person or passing the sword, we need to iterate the array to find the index of the following 1. That’s what the following
subroutine does. Again, “following” has a cyclic meaning and uses the modulo operator.
#! /usr/bin/perl
use warnings;
use strict;
use feature qw{ say };
my @people = (1) x 50;
my $sword = 0;
sub following {
do { $sword = (1 + $sword) % @people } until $people[$sword];
}
while (1 < (my $living = grep $_, @people)) {
following();
$people[$sword] = 0;
following();
}
say 1 + $sword;
Both the programs return the same answer: 37. Moreover, the second one can be easily extended to tell the whole story:
#! /usr/bin/perl
use warnings;
use strict;
use feature qw{ say };
my @people = (1) x 50;
my $sword = 0;
sub following {
do { $sword = (1 + $sword) % @people } until $people[$sword];
}
while (1 < (my $living = grep $_, @people)) {
print 1 + $sword, ' kills ';
following();
print 1 + $sword, $living == 2
? ' and the survivor is '
: ' and passes the sword to ';
$people[$sword] = 0;
following();
say 1 + $sword;
}
say 1 + $sword;
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.
Let’s ignore the fact that the date format is wrong (you can’t sort dates in this format easily; also why not use MM:SS:HH for timestamps analogically? See also xkcd #1179).
As usually, we used Time::Piece to handle dates. The basic algorithm is easy: just add one day to the date and check whether it’s a palindrome.
#! /usr/bin/perl
use warnings;
use strict;
use feature qw{ say };
use Time::Piece;
my $date = 'Time::Piece'->strptime('2000-01-01', '%Y-%m-%d');
while ($date->year < 3000) {
my $formatted = $date->strftime('%m%d%Y');
say $date->strftime('%B %-d, %Y')
if $formatted eq reverse $formatted;
$date += Time::Seconds::ONE_DAY;
}
The program outputs 36 different dates, but it takes more than 10 seconds on my machine to complete. We can introduce a simple optimisation, though: if the last two digits of the year reversed are greater than 12, the reversed date is invalid, as they represent its month, so we can skip the whole year. Similarly, if the first two digits of the year reversed are greater than 31, they represent an invalid day in the reversed date and the whole year can be skipped. Adding the following at the end of the loop
$date = 'Time::Piece'->strptime(($date->year + 1)
. '-01-01', '%Y-%m-%d')
if reverse(int($date->year / 100)) > 31
|| reverse($date->year % 100) > 12;
makes the program finish in less than a second, outputting the same 36 dates.
Leave a comment