perl-weekly-challenge Archives

Perl Weekly Challenge 053: Rotate Matrix and Vowel Strings

Rotate Matrix

Write a script to rotate the following matrix by given 90/180/270 degrees clockwise.
[ 1, 2, 3 ]
[ 4, 5, 6 ]
[ 7, 8, 9 ]

For example, if you rotate by 90 degrees then expected result should be like below

[ 7, 4, 1 ]
[ 8, 5, 2 ]
[ 9, 6, 3 ]

The easiest way to work with multidimensional data in Perl is PDL. Interestingly, I haven’t found a direct method to rotate a matrix in this way.

What I have found, though, was a method to transpose a matrix, which means to switch the columns and rows. The result for the sample input is

Perl Weekly Challenge 052: Stepping Numbers & Lucky Winner

Stepping Numbers

Write a script to accept two numbers between 100 and 999. It should then print all Stepping Numbers between them.

A number is called a stepping number if the adjacent digits have a difference of 1. For example, 456 is a stepping number but 129 is not.

The naive approach would be to iterate over all the numbers from 100 to 999 and check the difference between each adjacent digits.

use warnings;
use strict;
use feature qw{ say };

NUMBER: for my $n (100 .. 999) {
    my @digits = split //, $n;
    for my $i (1 .. $#digits) {
        next NUMBER
            unless 1 == abs($digits[$i - 1] - $digits[$i]);
    say $n;

In fact, for the given range this is enough. But if we try to print all the stepping numbers of length 7 (1_000_000 .. 9_999_999), it takes more than 10 seconds.

Perl Weekly Challenge 051: 3 Sum and Colourful Numbers

3 Sum

Given an array @L of integers. Write a script to find all unique triplets such that a + b + c is same as the given target T. Also make sure a <= b <= c.

Here is wiki page for more information.


@L = (-25, -10, -7, -3, 2, 4, 8, 10);

One such triplet for target 0 i.e. -10 + 2 + 8 = 0.

I hadn’t checked the wiki page before writing my solution; and I hadn’t changed the solution after I read it. Therefore, it presents the naive and inefficient solution that iterates over all the possible triplets (but not starting from 0 in the inner loops to avoid checking the same triplet several times).

Perl Weekly Challenge 050: Merge Intervals and Noble Integer

Merge Intervals

Write a script to merge the given intervals where ever possible.
[2,7], [3,9], [10,12], [15,19], [18,22]

The script should merge [2, 7] and [3, 9] together to return [2, 9].

Similarly it should also merge [15, 19] and [18, 22] together to return [15, 22].

The final result should be something like below:

[2, 9], [10, 12], [15, 22]

This sounds so similar to PWC 039 I first thought I could solve it in the same way. Unfortunately, Set::IntSpan gives a different result:

use warnings;
use strict;

use Set::IntSpan;

my @intervals = ([2, 7], [3, 9], [10, 12], [15, 19], [18, 22]);

my $set = 'Set::IntSpan'->new([@intervals]);

print $set; # 2-12,15-22

The reason is that the module only considers integers. There’s no integer between 9 and 10, so the spans 2-9 and 10-12 can be merged into one span 2-12.

Perl Weekly Challenge 049: Smallest Multiple and LRU Cache

Smallest Multiple

Write a script to accept a positive number as command line argument and print the smallest multiple of the given number consists of digits 0 and 1.

For example: For given number 55, the smallest multiple is 110 consisting of digits 0 and 1.

The simplest naive solution is to start from the input number, keep adding it to itself until the result consists of 0's and 1's exclusively.

use warnings;
use strict;
use feature qw{ say };

my $x = shift;
say "$x ", smallest_multiple($x);

sub smallest_multiple {
    my ($n) = @_;
    my $r = $n;
    $r += $n until $r =~ /^[01]+$/;

The problem of this solution is that it’s very slow for multiples of 9, as the result of the function is a very large number (111_111_111 for 9, 111_111_111_111_111_111 for 99).

Perl Weekly Challenge 048: Survivor and Palindrome Dates


There are 50 people standing in a circle in position 1 to 50. The person standing at position 1 has a sword. He kills the next person i.e. standing at position 2 and pass on the sword to the immediate next i.e. person standing at position 3. Now the person at position 3 does the same and it goes on until only one survives.
Write a script to find out the survivor.

I tried two different approaches to the problem.

The first one uses an array of living people and a variable $sword that stores the index of the person holding the sword. In each iteration of the loop, the next person is removed from the array, and the sword is passed to the next person.

The “next person” has a special cyclic meaning: at the end of the array, the sword must return to the beginning. This is achieved by using the modulo operator %. Note that we use it twice, once to find the person to kill, and once to find the person to pass the sword to—and each case uses a different array size in the modulo operation, as killing a person changes the size of the array.

Perl Weekly Challenge 046: Cryptic Message & Is the Room Open?

Cryptic Message

The communication system of an office is broken and message received are not completely reliable. To send message Hello, it ended up sending these following:
H x l 4 !
c e - l o
z e 6 l g
H W l v R
q 9 m # o

Similarly another day we received a message repeatedly like below:

P + 2 l ! a t o
1 e 8 0 R $ 4 u
5 - r ] + a > /
P x w l b 3 k \
2 e 3 5 R 8 y u
< ! r ^ ( ) k 0

Write a script to decrypt the above repeated message (one message repeated 6 times).

Even without reading the hint, the idea seems clear: for each column, the output should consist of its most frequent character. As usually, to count frequency, we’ll use a hash. To find the most frequent one, we’ll use max from List::Util.

Perl Weekly Challenge 045: Square Secret Code & Source Dumper

Square Secret Code

The square secret code mechanism first removes any space from the original message. Then it lays down the message in a row of 8 columns. The coded message is then obtained by reading down the columns going left to right.

For example, the message is “The quick brown fox jumps over the lazy dog”. The code message would be as below:

tbjrd hruto eomhg qwpe unsl ifoa covz kxey

Let’s start with the test:

use warnings;
use strict;

use Test::More tests => 1;
is square_secret_code('The quick brown fox jumps over the lazy dog'),
    'tbjrd hruto eomhg qwpe unsl ifoa covz kxey',

Let’s use a regex to extract groups of 8 letters from the message. Then split each group into individual letters and append each of them to a string corresponding to an output word.

use Syntax::Construct qw{ /r // };

sub square_secret_code {
    my ($message) = @_;
    my @code = ("") x 8;
    for my $group ($message =~ s/\s//gr =~ m/(.{1,8})/g) {
        $code[$_] .= (split //, $group)[$_] // "" for 0 .. 7;
    return join ' ', @code

Perl Weekly Challenge 044: One Hundred, Two Hundred

Only 100, please

You are given a string “123456789”. Write a script that would insert ”+” or ”-” in between digits so that when you evaluate, the result should be 100.

We can populate each place “between digits” with one of three possible values: a plus sign, minus sign, or nothing. To check all the possible permutations, we’ll use an indicator function similarly to The Knapsack Problem. In this case, though, there are three possible values, so we need to loop over numbers in the ternary numeral system.

The only operation we’ll need will be the increment, so we don’t need the full support for arithmetic in base 3. We can implement the increment ourselves: we start from the right of the number, change any 2 into 0 and move left. Once we find 0 or 1, we increment it and we’re done.

To create the expression, we just need to intersperse the digits with the operators. See the apply subroutine below.

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.

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.

About E. Choroba

user-pic I blog about Perl.