Perl Weekly Challenge 043: Olympic Rings and Self-Descriptive Numbers

Olympic Rings

There are 5 rings in the Olympic Logo [as shown below]. They are colour coded as in Blue, Black, Red, Yellow and Green. We have allocated some numbers to these rings as below: Blue: 8, Yellow: 7, Green: 5, Red: 9. The Black ring is empty currently. You are given the numbers 1, 2, 3, 4 and 6. Write a script to place these numbers in the rings so that the sum of numbers in each ring is exactly 11.

My first idea was to go over all the possible permutation of the numbers and report those that satisfy the sum condition. I chose Math::Combinatorics as the module to handle the permutations.

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

use Math::Combinatorics;

my $SUM = 11;
my ($red, $green, $yellow, $blue) = (9, 5, 7, 8);

my $mc = 'Math::Combinatorics'->new(data => [1, 2, 3, 4, 6]);
while (my ($black, $red_green, $black_green, $black_yellow, $blue_yellow)
           = $mc->next_permutation
) {
    my @sums = ($red + $red_green,
                $green + $red_green + $black_green,
                $black + $black_green + $black_yellow,
                $yellow + $black_yellow + $blue_yellow,
                $blue + $blue_yellow);
    say join ' ',
        $red_green, $black_green, $black, $black_yellow, $blue_yellow
        unless grep $_ != $SUM, @sums;
}

It tries all the 120 possible permutations, but from a computer point of view, it’s not so many. While finishing the solution, I already saw it could be solved in a much faster and straightforward way.

Perl Weekly Challenge 040: Multiple Arrays & Sort SubList

Multiple Arrays

You are given two or more arrays. Write a script to display values of each list at a given index.

For example:

Array 1: [ I L O V E Y O U ]
Array 2: [ 2 4 0 3 2 0 1 9 ]
Array 3: [ ! ? £ $ % ^ & * ]

We expect the following output:

I 2 !
L 4 ?
O 0 £
V 3 $
E 2 %
Y 0 ^
O 1 &
U 9 *

The pound sign is not part of the standard ASCII, so we’ll need to properly encode it. The use utf8; clause tells perl that the script itself contains UTF-8 encoded characters, the binmode function sets the encoding for the given filehandle, i.e. standard output.

Perl Weekly Challenge 039: Guest Book and Reverse Polish Notation

Guest Book

A guest house had a policy that the light remain ON as long as the at least one guest is in the house. There is guest book which tracks all guest in/out time. Write a script to find out how long in minutes the light were ON.
1) Alex    IN: 09:10 OUT: 09:45
2) Arnold  IN: 09:15 OUT: 09:33
3) Bob     IN: 09:22 OUT: 09:55
4) Charlie IN: 09:25 OUT: 10:05
5) Steve   IN: 09:33 OUT: 10:01
6) Roger   IN: 09:44 OUT: 10:12
7) David   IN: 09:57 OUT: 10:23
8) Neil    IN: 10:01 OUT: 10:19
9) Chris   IN: 10:10 OUT: 11:00

If we visualise the input, we’ll see that it represents the easy case: the first guest turns the light on, and it stays on until the last guest leaves. But in the general case, the guest house might be empty several times a day, causing the lights being turned off and back on repeatedly.

Fortunately, CPAN has a tool to handle even the general case. It uses so called Inversion Lists: instead of storing each minute, we just store the times when the light changes its state. I first learned about the concept in the PerlMonks article RFC: The Lazy Manager’s Calendar with Inversion Lists.

Perl Weekly Challenge 038: Date Finder and Word Game

Date Finder

Create a script to accept a 7 digits number, where the first number can only be 1 or 2. The second and third digits can be anything 0-9. The fourth and fifth digits corresponds to the month i.e. 01, 02, 03…, 11, 12. And the last 2 digits respresents the days in the month i.e. 01, 02, 03…, 29, 30, 31. Your script should validate if the given number is valid as per the rule and then convert into human readable format date.

RULES

  1. If 1st digit is 1, then prepend 20 otherwise 19 to the 2nd and 3rd digits to make it 4-digits year.
  2. The 4th and 5th digits together should be a valid month.
  3. The 6th and 7th digits together should be a valid day for the above month.

For example, the given number is 2230120, it should print 1923-01-20.

As we’ve done several times, we’ll use the core module Time::Piece to handle dates.

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

use Time::Piece;

sub validate {
    my ($number) = @_;

First, we’ll check the length of the input string.

    die 'Invalid length' unless length $number == 7;

Perl Weekly Challenge 037: Weekdays and Daylight Gain/Loss

Weekdays

Write a script to calculate the total number of weekdays (Mon-Fri) in each month of the year 2019.

I used the core module Time::Piece and its companion from the same distribution, Time::Seconds. Let’s start on the first day of the month, and keep adding one day while we stay in the same month. Along the way, count the days that aren’t Saturdays and Sundays.

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

use Time::Piece;
use Time::Seconds qw{ ONE_DAY };

sub days_in_month {
    my ($month) = @_;
    my $date = 'Time::Piece'->strptime("2019 $month 1 12:00",
                                       '%Y %b %d %H:%M');
    my $count = 0;
    while ($date->month eq $month) {
        ++$count unless grep $date->day eq $_, qw( Sat Sun );
        $date += ONE_DAY;
    }
    return $count
}

And here’s a test that the numbers are correct: