E. Choroba

This week’s challenge was a bit easier than the recent ones, but I was glad for that. The Perl Conference in Riga is coming and I still don’t have my slides ready!

Five Weekends

Write a script to display months from the year 1900 to 2019 where you find 5 weekends, i.e. 5 Fridays, 5 Saturdays, and 5 Sundays.

I started by running the cal utility (part of the util-linux package) to see how such months might look. For example, this is the output of cal 1904 (5 weekends highlighted manually be me):

                               1904                               

       January               February                 March       
Su Mo Tu We Th Fr Sa   Su Mo Tu We Th Fr Sa   Su Mo Tu We Th Fr Sa
                1  2       1  2  3  4  5  6          1  2  3  4  5
 3  4  5  6  7  8  9    7  8  9 10 11 12 13    6  7  8  9 10 11 12
10 11 12 13 14 15 16   14 15 16 17 18 19 20   13 14 15 16 17 18 19
17 18 19 20 21 22 23   21 22 23 24 25 26 27   20 21 22 23 24 25 26
24 25 26 27 28 29 30   28 29                  27 28 29 30 31      
31                                                                
        April                   May                   June        
Su Mo Tu We Th Fr Sa   Su Mo Tu We Th Fr Sa   Su Mo Tu We Th Fr Sa
                1  2    1  2  3  4  5  6  7             1  2  3  4
 3  4  5  6  7  8  9    8  9 10 11 12 13 14    5  6  7  8  9 10 11
10 11 12 13 14 15 16   15 16 17 18 19 20 21   12 13 14 15 16 17 18
17 18 19 20 21 22 23   22 23 24 25 26 27 28   19 20 21 22 23 24 25
24 25 26 27 28 29 30   29 30 31               26 27 28 29 30      
                                                                  
        July                  August                September     
Su Mo Tu We Th Fr Sa   Su Mo Tu We Th Fr Sa   Su Mo Tu We Th Fr Sa
                1  2       1  2  3  4  5  6                1  2  3
 3  4  5  6  7  8  9    7  8  9 10 11 12 13    4  5  6  7  8  9 10
10 11 12 13 14 15 16   14 15 16 17 18 19 20   11 12 13 14 15 16 17
17 18 19 20 21 22 23   21 22 23 24 25 26 27   18 19 20 21 22 23 24
24 25 26 27 28 29 30   28 29 30 31            25 26 27 28 29 30   
31                                                                
       October               November               December      
Su Mo Tu We Th Fr Sa   Su Mo Tu We Th Fr Sa   Su Mo Tu We Th Fr Sa
                   1          1  2  3  4  5                1  2  3
 2  3  4  5  6  7  8    6  7  8  9 10 11 12    4  5  6  7  8  9 10
 9 10 11 12 13 14 15   13 14 15 16 17 18 19   11 12 13 14 15 16 17
16 17 18 19 20 21 22   20 21 22 23 24 25 26   18 19 20 21 22 23 24
23 24 25 26 27 28 29   27 28 29 30            25 26 27 28 29 30 31
30 31

The first thing I noticed was how confusing the week starting on Sunday was. Why does something called “weekend” include the first day of the next week?

The second observation was that for the 5 weekends to appear in one month, the month must have 31 days and it must start on a Friday. If it’s long enough but starts on a Thursday, it doesn’t contain the last Sunday (see December above), if it starts on a Friday but is shorter, the Sunday belongs to the next month again (see April).

I used the core module Time::Piece to handle the dates. We’re looking for months that have 31 days and start on a Friday. To move to the beginning of the next month, we can just forward the number of seconds corresponding to the number of days in the month. Time::Seconds provides the constant ONE_DAY that can be used to convert the number of days to seconds.

#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };

use Time::Piece;
use Time::Seconds;

my $date = 'Time::Piece'->strptime(
    '1900-01-01 12:00:00', '%Y-%m-%d %H:%M:%S');

while ($date->year < 2020) {
    next if $date->day ne 'Fri';

    say $date->strftime('%Y-%m') if $date->month_last_day == 31;

} continue {
    $date += $date->month_last_day * ONE_DAY;
}

Paragraph Wrapping

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

It’s a bit unclear what we should do with spaces immediately preceding or following a newline in the input. I decided to remove them. Similarly, I decided to break a word if it’s too long to fit onto a line itself.

To find the last space before the given position, I used the rindex function. If it returns -1, there’s no space and we must split the word.

#!/usr/bin/perl
use warnings;
use strict;

sub wrap_paragraph {
    my ($paragraph, $width) = @_;
    $paragraph =~ s/ *\n */ /g;
    my $out = "";
    while (length $paragraph) {
        my $pos;
        if (length $paragraph < $width) {
            $pos = length $paragraph;
        } else {
            $pos = rindex $paragraph, ' ', $width;
            $pos = $width if $pos < 0;
        }
        $out .= substr $paragraph, 0, $pos, "";
        $paragraph =~ s/^ +//;
        $out .= "\n" if length $paragraph;
    }
    return $out
}

Here are the tests I used to verify my solution:

use Test::More;

my %expected = (
    'a'                 => "a",
    'bcdef'             => "bcdef",
    'ghijkl'            => "ghijk\nl",
    'm no pq'           => "m no\npq",
    'rs tu vw'          => "rs tu\nvw",
    'xyz ab cd'         => "xyz\nab cd",
    'efgh ij kl'        => "efgh\nij kl",
    'mnopq rs tu'       => "mnopq\nrs tu",
    'vwxyza bc de'      => "vwxyz\na bc\nde",
    'fghijkl mn op'     => "fghij\nkl mn\nop",
    'qrstuvwx yz ab'    => "qrstu\nvwx\nyz ab",
    'cdefghijk lm no'   => "cdefg\nhijk\nlm no",
    'pqrstuvwxy za bc'  => "pqrst\nuvwxy\nza bc",
    'defghijklmn op qr' => "defgh\nijklm\nn op\nqr",
    "s\nt"              => "s t",
    "u\nv\n w"          => "u v w",
    << '__PAR__', << '__EXPECTED__' =~ s/\n$//r);
ABCDE
AABBCC
A BB CC
AA BB CC
AAA BB CC
AAAA BB CC
AAAAA BB CC
__PAR__
ABCDE
AABBC
C A
BB CC
AA BB
CC
AAA
BB CC
AAAA
BB CC
AAAAA
BB CC
__EXPECTED__

for my $in (keys %expected) {
    is wrap_paragraph($in, 5), $expected{$in}, $in;
    is wrap_paragraph($expected{$in}, 5), $expected{$in},
        "idempotent $expected{$in}";
}

done_testing();