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.

use warnings;
use strict;

use List::Util qw{ max };

my @message_sets = (['Hxl4!', 'ce-lo', 'ze6lg', 'HWlvR', 'q9m#o'],
                    ['P+2l!ato', '1e80R$4u', '5-r]+a>/', 'Pxwlb3k\\',
                     '2e35R8yu', '<!r^()k0']);

for my $messages (@message_sets) {
    my @frequency;
    for my $message (@$messages) {
        ++$frequency[$_]{ substr $message, $_, 1 }
            for 0 .. length($message) - 1;
    for my $position (@frequency) {
        my $max = max(values %$position);
        $position->{$_} == $max and print for keys %$position;
    print "\n";

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.

Let’s start with the naive approach: loop over all the employees, changing the status of all the doors they open or close. We’ll represent the doors as an array, each element can be either 0 (closed) or 1 (open).

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

my $MAX = 500;

my @doors = (0) x $MAX;  # All closed.
for my $employee (0 .. $MAX - 1) {
    $doors[$_] = ! $doors[$_]
        for grep 0 == (1 + $_) % (1 + $employee), 0 .. $MAX - 1;
say join ' ', map 1 + $_, grep $doors[$_], 0 .. $MAX;

Before we analyse the output, let’s try to simplify the code. Instead of looping over all the employees, we can loop over the doors instead. For each door d numbered 1 .. 500, an employee e can change its state if and only if e divides d. Therefore, if the number of divisors of d is even, the final state of the door is the same as the initial one, and even number of divisors corresponds to an even number of employees operating on the door, which means the final state will be changed. This leads to much shorter code and easier to understand, too:

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

say join ' ', grep {
    my $door = $_;
    1 == (grep 0 == $door % $_, 1 .. 500) % 2
} 1 .. 500;

The outputs of the two programs are identical. But we can also easily detect the pattern which leads to an even shorter and simpler implementation:

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

say join ' ', map $_ ** 2, 1 .. sqrt 500;

Interestingly, running each of the programs 200 times to benchmark them shows the simpler the code is, the faster it runs (this is not a general rule, though). The naive implementation took 6.5s, the simpler one 5.4s, while the last one took less than 0.9s.

Leave a comment

About E. Choroba

user-pic I blog about Perl.