Perl Weekly Challenge: Week 48

This weeks challenges were fairly easy so my notes will be brief.

Challenge 1:

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.

At first glance it seems like this task could be disposed of with simple incrementation. Find the person with the sword, kill the next person, give the sword to the next person, kill the next person after him and so on. The gotcha is that as people get killed, "gaps" appear in the circle so finding the next person requires more than just an increment. Thus in my code I have do ... until loops that skip over "dead" members of the circle. (I.e. @people elements which are undef.)

my @people = (0 .. 49);

my $remaining = scalar @people;
my $next = 0;
my $victim = 1;

while ($remaining > 1) {
    $people[$victim] = undef;
    $remaining--;
    do {
        $next = ($next + 1) % 50;
    } until defined $people[$next];

    $victim = $next;
    do {
        $victim = ($victim + 1) % 50;
    } until defined $people[$victim];
}

Once we are down to the last one standing, we know there will only be one defined element left in @people so we can find it by grep()ing for it and then printing it out. One pet peeve I have with perl is that if you print() or say() something which begins with a paranthesis, you get an annoying and unsightly warning about say (or print) being called as a function. You can disambiguate by putting a + in front but this shouldn't be necessary IMO. And we mustn't forget to add 1 to the result because our array started from o but the people identifiers start from 1.

say +(grep { defined $_; } @people)[0] + 1;

(Full code on Github.)

Here's the Raku version. It's pretty much a straight port from Perl. Instead of do ... until we say repeat ... until and instead of assigning undef to dead elements we use Nil.

multi sub MAIN() {
    my @people = (0 .. 49);

    my $remaining = @people.elems;
    my $next = 0;
    my $victim = 1;

    while $remaining > 1 {
        @people[$victim] = Nil;
        $remaining--;
        repeat {
            $next = ($next + 1) % 50;
        } until defined @people[$next];

        $victim = $next;
        repeat {
            $victim = ($victim + 1) % 50;
        } until defined @people[$victim];
    }

    say @people.grep({ defined $_; })[0] + 1;
}

(Full code on Github.)

The survivor is person number 37.

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

My first thought was to loop through all the 1000 years but then it occured to me that I could substantially reduce that number. The first two digits of the palindrome date, the month, can only range from 01 to 12. Therefore the last two digits of the year must be their reverse. Any other year cannot have a palindrome date. So I start by grep()ing out valid years.

my @years =
    grep {
        / (?<year> \d\d) $ /gmx;
        grep { $_ == $+{year}} (10, 20, 30, 40, 50, 60 , 70, 80, 90, 1, 11, 21) 
    } (2000 .. 2999);

for my $year (@years) {

The month and the day will be the year in reverse. I used named capture groups to be able to easily identify these values when using them later.

    (reverse $year) =~ / \A (?<month> \d\d) (?<day> \d\d) \z /gmx;

At this point I was going to use the validation routines I've developed in previous challenges to make sure we have a true date but again a little reflection showed that it is not necessary. The first two digits of the year range from 20 to 29. Reversed, they will equal the day. But i.e. 92 is not a valid day; the maximum valid value is 31. So in practice, there will be no more palindrome dates after the 22nd century until the 30th century rolls around. The only valid values for day will be 2 (in the 20th century), 12 (in the 21st century), and 22 (in the 22nd century.) To simplify things, I just check if $day is less than 23. If it is, it is a true palindrome date and it gets printed out.

    if ($+{day} < 23) {
        say join q{/}, ($+{month}, $+{day}, $year);
    }
}

(Full code on Github.)

Again, the Raku version is just a straight port from Perl. In Raku, reverse() only works on lists. You have to use a strings .flip() method to reverse it.

my @years = (2000 .. 2999).grep({
    / $<year> = (\d\d) $ /;
    (10, 20, 30, 40, 50, 60 , 70, 80, 90, 1, 11, 21).grep({ $_ == $/<year>}) 
});

for @years -> $year {
    $year.flip ~~ / ^ $<month> = (\d\d) $<day> = (\d\d) $ /;

    if $/<day> < 23 {
        ($/<month>, $/<day>, $year).join(q{/}).say;
    }
}

(Full code on Github.)

The palindrome dates are: