laurent_r

These are some answers to the Week 46 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a couple of days (February 9, 2020). This blog post offers some solutions to this challenge, please don’t read on if you intend to complete the challenge on your own.

Garbled 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).

HINT: Look for characters repeated in a particular position in all six messages received.

Basically, the idea is that any letter that is repeated at the same position in several transmissions is deemed to be correct. For example, in the case of the first message, the letter ‘H’ occurs twice in the first position of the message, so the message is deemed to start with ‘H.’ Similarly, in the second position, we have twice an ‘e,’ and so on to complete the word ‘Hello.’

Garbled Message in Perl

Although it could undoubtedly be done directly, I decided that the easiest way was first to perform a matrix transposition on the data and then to explore the resulting lines to find duplicate letters.

use strict;
use warnings;
use feature "say";

my $garbled = <<'END_MSG';
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
END_MSG

my @AoA = map { [ split /\s+/, $_] } split /[\r\n]+/, $garbled;
my @transposed;
for my $i (0 .. $#AoA) {
  $transposed[$_][$i] = $AoA[$i][$_] for 0.. scalar @{$AoA[$i]} -1;
}
my @msg = "";
for my $line_ref (@transposed) {
    my %counter;
    $counter{$_}++ for @$line_ref;
    push @msg, grep { $counter{$_} > 1 } keys %counter;
}
say @msg;

This program displays the following output:

$ perl garbled.pl
PerlRaku

Garbled Message in Raku

Just as in Perl, I first made a matrix transposition of the data and then looked for duplicate letters in each line:

use v6;

my $garbled = q:to/END_MSG/;
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
END_MSG

my @AoA = map { my @a = split /\s+/, $_; @a }, split /<[\r\n]>+/, $garbled;
my @transposed;
for (0 .. @AoA.end) -> $i {
    @transposed[$_][$i] = @AoA[$i][$_] for 0.. (@AoA[$i]).elems -1;
}
my @msg = "";
for @transposed -> $line {
    my BagHash $counter;
    $counter{$_}++ for @$line;
    push @msg, grep { $counter{$_} > 1 }, keys $counter;
}
say join "", @msg;

This program produces the same output:

$ perl6 garbled.p6
PerlRaku

Is the room open?

There are 500 rooms in a hotel with 500 employees having keys to all the rooms. The first employee opened main entrance door of all the rooms. The second employee then closed the doors of room numbers 2,4,6,8,10 and so on to 500. The third employee then closed the door if it was opened or opened the door if it was closed of rooms 3,6,9,12,15 and so on to 500. Similarly, the fourth employee did the same as the third but only room numbers 4,8,12,16 and so on to 500. This goes on until all employees has had a turn.

Write a script to find out all the rooms still open at the end.

There is an analytical way to solve this problem (as we’ll see later), but let’s just apply the process as described in the task formulation.

Open Rooms in Perl

Note that in the program below, we’re limiting the number of doors and employees to 50 (the MAX constant`), rather than 500, This is just to make the output shorter and easier to read.

use strict;
use warnings;
use feature "say";
use Data::Dumper;
use constant MAX => 50;

# 1 => open, 0 => closed

my @rooms = (1) x (MAX + 1); # (first employee)
my $start = 1;
for (2..MAX) {
    $start++;
    my $door = $start;
    while ($door <= MAX) {
        $rooms[$door] = $rooms[$door] ? 0 : 1;
        $door += $start;
    }
}
say join " ", @rooms[1..MAX];

This program displays the following output:

$ perl hotel.pl
1 0 0 1 0 0 0 0 1 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 1 0

There are a few interesting things to notice in the pattern of the result, but we’ll come back to that after the Raku solution.

Open Rooms in Raku

We’re also limiting the number of doors and employees to 50 (the MAX constant), rather than 500, to make the output shorter and easier to read.

use v6;
constant MAX = 50;
my @rooms = 1 xx MAX + 1; # (first employee)
my $start = 1;
for 2..MAX {
    $start++;
    my $door = $start;
    while $door <= MAX {
        @rooms[$door] = @rooms[$door] ?? 0 !! 1;
        $door += $start;
    }
  # say [+] @rooms[1..MAX];
}
say join " ", @rooms[1..MAX];

This displays the same output as the Perl program.

Further Analysis

I was originally surprised at the small number of doors open at the end of the process. I thought it would be interesting to see how the number of open doors evolves with each iteration. Reactivating the line commented out in the Raku program above makes it possible to see that (we’re now using the 500 rooms of the original task description):

250
250
293
277
276
269
243
260
248
247
244
... (Lines omitted for brevity)
28
27
26
25
24
23
22

Rather than giving out all the numbers, let’s plot them on a chart:

The pattern is somewhat unexpected: after some relatively large oscillations at the very beginning, the number of open doors oscillates around 250 doors until about the 250th employee, and, after that, it starts to decline quite regularly done. That’s interesting, but I’m not quite sure what to make of that.

So I decided to examine something else: let’s look at which doors are open at the end of the process. For this, I changed the last line of the Raku program to:

say join " ", grep {@rooms[$_]}, 1..MAX;

This is the output of this modified program:

$ perl6 hotel.p6
1 4 9 16 25 36 49 64 81 100 121 144 169 196 225 256 289 324 361 400 441 484

Now, that’s very interesting: one can immediately see that the open doors at the end of the process are those whose room number are perfect squares.

Some tests showed that this seems to remain true for other values of the MAX constant.

The reason for it seems to be the following: at the end of the process, a door is open if it has been changed an odd number of times and closed if it has been changed an even number of times. And, during the iterations, a door is changed each time the number being examined divides evenly the room number. In addition, perfect squares are the only numbers that have an odd number of unique divisors (for example, 16 has five unique divisors: 1, 2, 4, 8 16), so they are the only ones that are changed an odd number of times and correspond to doors that are open at the end of the process. Any number that is not a perfect square, by contrast, has an even number of divisors. This might be worth a more rigorous mathematical demonstration, but I guess you get the point.

So, finally, to list the doors which are open at the end of the process, we could just use a Perl one-liner:

$ perl -E 'say join " ", map {$_**2} 1..500**.5;'
1 4 9 16 25 36 49 64 81 100 121 144 169 196 225 256 289 324 361 400 441 484

Or a Raku one-liner:

$ perl6 -e 'say join " ", map {$_**2}, 1..500**.5;'
1 4 9 16 25 36 49 64 81 100 121 144 169 196 225 256 289 324 361 400 441 484

Wrapping up

The next week Perl Weekly Challenge is due to start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on Sunday, February 16, 2020. And, please, also spread the word about the Perl Weekly Challenge if you can.