Perl Weekly Challenge: Week 19

Challenge 1:

Write a script to display months from the year 1900 to 2019 where you find 5 weekends i.e. 5 Friday, 5 Saturday and 5 Sunday.

Goody! a calendar problem again. Now one way of doing this could be to go through each month and count the Fridays, Saturdays, and Sundays to make sure there are five of each. But you can do better. The shortest interval which can contain five weekends is 31 days and then only if the first day is a Friday. The spec requires the five weekends to be entirely within one month. Therefore any month which has less than 31 days will never have five weekends. Furthermore, the months with 31 days will only have five weekends if they begin on a Friday.

I used the same approach as I used in challenge 13 i.e. counting elapsed days from an epoch (allowing for leap years). In this case January 1, 1900 is my day 0 though I actually begin counting from -31 to avoid having to special case that first January. Then I add the number of days in the month which gives me the day in the year of the first day of the month. I check if it is a Friday and if the month has 31 days and print if both criteria are true.

my @days = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);

my $elapsedDays = -31;

for my $year (1900 .. 2019) {
    for my $month (0 .. 11) {
        $elapsedDays += $days[$month];
        if (isLeap($year) && $month == FEBRUARY) {
            $elapsedDays++;
        }
        if ($days[$month] == 31 && $elapsedDays % WEEK == FRIDAY) {
            say sprintf("%02d/%d", $month + 1, $year);
        }
    }
}

(Full code on Github.)

In the Perl6 version of challenge 13, I didn't make use of the languages builtin in Date class. I did not repeat that mistake this time.

for 1900 .. 2019 -> $year {
    for 1 .. 12 -> $month {

        my $date = Date.new(year => $year, month => $month, day => 1,
            formatter => { sprintf("%02d/%d", .month, .year) }
        );

        if $date.days-in-month == 31 && $date.day-of-week == FRIDAY {
            say $date;
        }
    }
}

(Full code on Github.)

Challenge 2:

Write a script that can wrap the given paragraph at a specified column using the greedy algorithm.

This one was pretty easy if you just follow the algorithm in the wikipedia article. Though one ambiguity is what do you do if there is more than one whitespace between words? Do you preserve them or collapse them into one. My code sidesteps this problem and just assumes only one space.

This is Perl5:

sub wordWrap {
    my ($paragraph, $lineWidth) = @_;

    my $spaceLeft = $lineWidth + 1;

Ok, this did trip me up for a second. You need an extra space to account for the newline character.

    while ( $paragraph =~ /\G (?<word> \w+)(\W+)? /gcx ) {
        my $wordWidth = length $+{word};
        if ($wordWidth + 1 > $spaceLeft) {
            print "\n";
            $spaceLeft = $lineWidth - $wordWidth;
        } else {
            $spaceLeft -= ($wordWidth + 1);
        }
        print "$+{word} ";
    }
}

(Full code on Github.)

And this is Perl6:

sub wordWrap(Str $paragraph, Int $lineWidth) {
    my $spaceLeft = $lineWidth + 1;

    for $paragraph.words -> $word {

I couldn't figure out the Perl6 equivalent of my Perl5 regex but luckily .words can do the same thing.

        my $wordWidth = $word.chars;
        if $wordWidth + 1 > $spaceLeft {
            print "\n";
            $spaceLeft = $lineWidth - $wordWidth;
        } else {
            $spaceLeft -= ($wordWidth + 1);
        }
        print "$word ";
    }
    print "\n";

An oddity I noticed: In Perl5, you can say say wordWrap("a paragraph", 42); but if you try the same thing in Perl6, you get Nil printed out at the end. So I just add the last newline myself and call the function without say.

}

(Full code on Github.)