Perl Weekly Challenge: Week 46
Challenge 1:
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 # oSimilary 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 0Write 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.
Taking the hint, it seems one character is repeated twice in every column. That repeated character is what we need to find to decode this message.
In Perl, I represented the message as an array of arrays like this:
my @message = (
[ qw{ P + 2 l ! a t o }],
[ qw{ 1 e 8 0 R $ 4 u }],
[ qw{ 5 - r ] + a > / }],
[ qw{ P x w l b 3 k \ }],
[ qw{ 2 e 3 5 R 8 y u }],
[ qw{ < ! r ^ ( ) k 0 }],
);
Now we need to flip this array 90° to make the columns into rows. Unfortunately, there isn't an easy way to do this in Perl (unlike Raku as we shall see.) so we have to write a little code.
my @rotated;
for my $i (0 .. scalar @message - 1) {
for my $j (0 .. scalar @{$message[$i]} - 1) {
push @{$rotated[$j]}, $message[$i][$j];
}
}
Now we have to pick out the pertinant characters from our new rows. I did it all
in one line which is probably not the best idea for future readability and maintenance
but it works for me right now. Going roughly from right to left, first we take each
element of the rotated 2D array with map() and sort() its' elements. This way all the characters
of the same kind will be next to each other. Then they are compacted into a single
string with join(). This now 1D array is again map()ed and in each element, a regex is
run to find a pair of the same character. This character is returned reducing the array to a
list of characters. Finally the list is join()ed back up into a string%mdash;the answer and printed out.
say join q{}, map { /(.)\1/; $1; } map { join q{}, sort @{$_}; } @rotated;
Raku has the [Z] operator which does the job of rotating the @message in one
fell swoop. As a result we can actually make this a one-liner.
perl6 -e '
([Z] (
[qw{ P + 2 l ! a t o }],
[qw{ 1 e 8 0 R $ 4 u }],
[qw{ 5 - r ] + a > / }],
[qw{ P x w l b 3 k \ }],
[qw{ 2 e 3 5 R 8 y u }],
[qw{ < ! r ^ ( ) k 0 }],
)).map({ .sort.join.match(/ (.)$0 /); $0 }).join.say;
'
In case you were wondering, the secret message is:
PerlRaku
Challenge 2:
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.
I have a sneaking suspicion there is some mathematical formula to do this problem quickly but I don't know it and 500 is a small enough number to process by brute force.
In Perl, first I created an array to represent the 500 rooms. Because Perl doesn't
have a Boolean data type, I'm going to use 0 and 1 to represent whether a rooms'
door is closed or open. I also have a variable $end to represent the last element
of @rooms as we will be using this several times.
my @rooms = (0) x 500;
my $end = scalar @rooms - 1;
Now we do each employees turn. If the door is open it gets closed and vice versa. We have two sets of coordinates here; the employees from 1 to 500 and the array indexes from 0 to 499 so a little arithmetic is involved in places.
for my $i (0 .. $end) {
for my $j (0 .. $end) {
if (($j + 1) % ($i + 1) == 0) {
$rooms[$j] = ($rooms[$j]) ? 0 : 1;
}
}
}
And finally, we print the number of each room whose door is still open.
for my $i (0 .. $end) {
if ($rooms[$i]) {
print $i + 1, q{ };
}
}
print "\n";
For Raku I followed the same method. One advancement in Raku is a genuine boolean
data type. This means I don't need to use 1 and 0 and can also flip
door states with the NOT operator (!).
constant $end = 500;
my Bool @rooms[$end];
for 0 ..^ $end -> $i {
for 0 ..^ $end -> $j {
if ($j + 1) %% ($i + 1) {
@rooms[$j] = !@rooms[$j];
}
}
}
for 0 ..^ $end -> $i {
if @rooms[$i] {
print $i + 1, q{ };
}
}
print "\n";
The output of both versions is:
1 4 9 16 25 36 49 64 81 100 121 144 169 196 225 256 289 324 361 400 441 484
...which is the easily calculable sequence of square numbers less than 500. I knew there had to be some kind of shortcut.