Perl Weekly Challenge : Week 48

I've decided I'm going to try blogging about my attempts at the Perl Weekly Challenge which I've been doing since it started. Generally I do my challenge in Raku the language formally known as Perl6.

This weeks challenge has a couple of fun parts. If you've not tried it yet you might want to come back after you have.

Challenge 1

So I'd seen a video on this before it's called the Josephus Problem so I knew there was a mathematical solution to it.... but I couldn't remember it.

As is often the way I went a bit above and beyond and worked out a function to give the survivor number for any number of swordsmen. My thinking about it was simple. Get a list of number from 1 to 50, take the first two from the front. The first survives the second is dead. Put the survivor at the end of the list. Repeat until you have 1 survivor :

#| Calculate the survivor of the swordsmen suicide pact
multi sub MAIN(
    UInt $swords = 50, #= Number of swordsmen (default 50)
) {
    my @men = [1..$swords];
    while ( @men.elems > 1 ) {
        my ( $alive, $dead ) = @men.splice(0,2);
        @men.push($alive);
    }

    say "Survivor of $swords is number {@men[0]}";
}

With that I was able to run the test for lots of different value and worked out the mathematical solution. Given a number of swordsmen (s) we find p where p < s and p is a power of 2. Then the number of the survivor is the nth odd number where n = s - p.

For example for s = 50, p = 32 and n is the 18th odd number (indexed on 0) which is 37.

The code for this :

#| Calculate mathematically
multi sub MAIN(
    "math", 
    UInt $swords = 50, #= Number of swordsmen
) {
    my $low-power = (1,* * 2...*).first(* > $swords) div 2;
    say "Survivor of $swords is number {(1,3,5...*)[$swords - $low-power]}";
}

Couple of fun uses of Raku sequences one to generate the powers of 2 and the second to generate the list of odd numbers.

Challenge 2

For challenge 2 I initially worked on the theory I'll look at every date between 2020-01-01 and 2999-12-31 and look for palindromes. Turns out... that's a lot of days (357937 to be exact) and it take a while. Even when you use .hyper to thread the tests over multiple cores. But then I had a thought.

If I went through every month and day combination that's 12 x 31 (we'll worry about out of range values in a second) and that's only 372 to check. If we take the month and day and flip it to get a year if we can check it's valid and it's between our start and end dates.

#| Find the palendromic numbers (writen mmddyyy) between 2000-01-01 and 2999-01-01
sub MAIN() {
    my sub df( Date $d) {
        # Bleh American dates
        sprintf "%02d%02d%04d", .month, .day, .year given $d;
    }

    constant START = Date.new(2000,1,1,formatter => &df);
    constant END = Date.new(2999,12,31, formatter => &df);

    my @out;

    for (1..12) -> $month {
        for (1..31) -> $day {
            my $date;
            my $year = sprintf( "%02d%02d", $month, $day ).flip;
            try {
                $date = Date.new($year,$month,$day,formatter => &df);
            }
            next unless $date;
            next unless START <= $date <= END;
            @out.push($date);
        }
    }

    .say for @out.sort;
}

I hope that all makes sense. Feel free to drop a comment if you've got questions or thoughts.