perl-weekly-challenge Archives

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:

Perl Weekly Challenge 036: VIN Validation and the Knapsack Problem

VIN Validation

Write a program to validate given Vehicle Identification Number (VIN).

I followed the description at Wikipedia. Sometimes, it wasn’t exactly clear whether the described rule should be valid everywhere or just in a part of the world; the rules also developed with time, so older vehicles can bear VINs that would be considered invalid for a modern car.

Most of the validation is implemented in a single subroutine validate_vin. It takes two parameters, $vin and $sold: the second one says where the car was sold. "North America" and "China" are two values that trigger a different behaviour of the validator.

Perl Weekly Challenge 035: Binary Morse Code

The Encoder

Write a program to encode text into binary encoded Morse code.

Before we can encode Morse code into its binary representation, we need to encode normal text into Morse code. As a former Woodcraft member, I was able to write the following lines by heart:

my %to_morse = qw( a .-   b -... c -.-. d -..  e .    f ..-. g --.
                   h .... i ..   j .--- k -.-  l .-.. m --   n -.
                   o ---  p .--. q --.- r .-.  s ...  t -    u ..-
                   v ...- w .--  x -..- y -.-- z --.. );

The encoding subroutine is straightforward: split each word into separate characters, then replace each with the value from the above hash.

sub encode_to_morse {
    join '/', map $to_morse{$_} // "", split //, shift
}

Note that space is not present in the translation table, so it gets translated to an empty string, which creates the expected double slashes between words.

Perl Weekly Challenge 034: Slices and a Dispatch Table

Slices

Write a program that demonstrates using hash slices and/or array slices.

In the spirit of TIMTOWTDI I decided to write a single program that demonstrates both the tasks at the same time.

Let’s start with slices. Slices are parts of structures (arrays and hashes). Slicing has a special syntax by which you tell Perl which indices or keys you want to use to obtain a slice.

For example, consider the following array:

my @keys = qw( not_this_one
               this_one
               this_one_too
               it_was_enough );

Naturally, we want to select the second and third one. We can use

$keys[1], $keys[2]

or

map $keys[$_], 1, 2;

but there’s a shorter and cleaner syntax for the same:

@keys[1, 2]

Perl Weekly Challenge 033: Count Letters & Formatted Multiplication Table

Count Letters

Create a script that accepts one or more files specified on the command-line and count the number of times letters appeared in the files.

From the example we can see that we should count the letters in a case insensitive way (see the lc in the example below). Similarly to Challenge 032, we can use a hash to keep the counts.

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

my %count;
while (<>) {
    ++$count{ lc $1 } while /([a-zA-Z])/g;
}
for my $char (sort keys %count) {
    say "$char: $count{$char}";
}

Perl Weekly Challenge 032: Frequency Table & ASCII Bar Chart

Frequency Table

Create a script that either reads standard input or one or more files specified on the command-line. Count the number of times and then print a summary, sorted by the count of each entry.

The original title of the task was “Count instances”, but I’ve always known the output as the “frequency table”. For years, I’ve used the following bash script to produce it:

#! /bin/bash
cat "$@" | sort | uniq -c | sort -n

The first element in the pipeline is cat. It outputs all the files given to it as arguments, or the standard input if there are no arguments. sort sorts the output so duplicate lines are adjacent, which is needed for uniq. Its -c argument means “count”: it prepends the number of occurrences to each line. The final sort is invoked with -n for “numerical”, i.e. it sorts the output by the number of occurrences.

Creating a similar table in Perl is a FAQ. We store each line in a hash, incrementing the corresponding value while reading the input line by line.

If we look carefully at the assignment of the task, though, we can notice that the output should be formatted differently: the numbers should go last and the columns should be aligned. Also, there’s the extra credit which we definitely want.

About E. Choroba

user-pic I blog about Perl.