Continues from previous week.
Welcome to the Raku review for Week 046 of the Weekly Challenge! For a quick overview, go through the original tasks and recap of the weekly challenge.
Getting in Touch
Email › Email me (Ryan) with any feedback about this review.
GitHub › Submit a pull request for any issues you may find with this page.
Twitter › Join the discussion on Twitter!
We’d greatly appreciate any feedback you’d like to give.
Table of Contents
Task 1
[ Arne Sommer | Javier Luque | Kevin Colyer | Laurent Rosenfeld | Luca Ferrari | Mark Anderson | Markus Holzer | Noud Aldenhoven | Roger Bell West | Ruben Westerberg | Ryan Thompson | Simon Proctor | Ulrich Rieke ]
Task 2
[ Arne Sommer | Colin Crain | Jaldhar H. Vyas | Javier Luque | Kevin Colyer | Laurent Rosenfeld | Luca Ferrari | Mark Anderson | Markus Holzer | Noud Aldenhoven | Roger Bell West | Ruben Westerberg | Ryan Thompson | Simon Proctor | Ulrich Rieke ]
Blogs
Task #1 - Cryptic Message
This task had us resolving “unreliable transmissions” that were sent repeatedly, each time with errors in different locations in the string, such as this one:
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
That spells PerlRaku, which you can arrive at by noticing that only one character in each column will be repeated.
My general observations
Both example ciphers show that each plaintext character appears exactly twice in each column, and the other characters appear exactly once. Naturally, some hackers relied on this and printed all characters that appeared twice. Some hackers took a more permissive or general interpretation, and calculated the frequency of each character, printing whichever character appeared most often in each column.
Arne Sommer
Arne Sommer’s solution accepts a string of rows separated by spaces, which he then splits to @strings (rows), calculates the $max row length, and iterates over the character indices:
$string = 'P+2l!ato 1e80R$4u 5-r]+a>/ Pxwlb3k\ 2e35R8yu <!r^()k0' if $another;
my @strings = $string.words;
my $max = @strings>>.chars.max;
my @result;
for ^$max -> $index {
@result.push: @strings.map({ $_.substr($index,1) // "" }).repeated.unique;
}
say @result.join;
The @result is built up by taking the character at $index from each string, and looking for the .repeated characters. .unique ensures that if there are more than two of the same character, that only one will be returned. (e.g., <A x A y A>.repeated.unique = (A), whereas <A x A y A>.repeated = (A A)).
Ambiguous Input
Arne also submitted a more in-depth solution that better handles ambiguous input (i.e., more than one character is repeated). The main difference is the addition of a recursive expand routine as follows:
expand( "", @result );
sub expand ( $current, @strings ) {
my $copy = $current;
for ^@strings.elems -> $index {
my $curr = @strings[$index];
if $curr.elems > 1 {
expand( $copy ~$_, @strings[ $index + 1 .. Inf ] ) for @$curr;
return;
} else {
$copy ~= $curr;
}
} say $copy;
}
expand runs on the @result from the first solution. If more than one character is repeated, @result would contain a sublist, e.g., we might get (H (e u) l l o). The unmodified first solution would print He ullo, which is not ideal. So expand takes these sublists (if $curr.elems > 1), and branches so that every possible result will be printed. In this case, Hello and Hullo, but in general the number of output lines will be the product of all sublist lengths. This is a good way of disambiguating results for an imperfect transmission method such as this.
Arne’s solutions include some verbose output, which provides good introspection into how they work, so I recommend you try them out for yourself, and read Arne’s excellent blog:
Blog › The Cryptic Raku Room
Javier Luque
Javier Luque’s solution accepts a multiline string, gets the length of the first line, and then starts building the frequency table:
# Initialize the columns hash
my @column_hash;
my ($first_line) = $message.split("\n", 2);
my $length = $first_line.split(" ").join.chars;
@column_hash[0 .. $length - 1] = {};
# Parse the cryptic message
for ($message.split("\n")) -> $line {
my $i = 0;
for ($line.split(" ")) -> $char {
@column_hash[$i++].{$char}++;
}
}
The loop splits the input into lines, and then builds a @column_hash, which is a mapping of a character’s count in a particular column. From there, each column is processed, and the most frequent character is appended to the $output:
# Sort
my $output = '';
for (@column_hash) -> %column {
$output = $output ~
%column.keys.sort(
{ %column.{$^b} <=> %column.{$^a} }
)[0];
}
say $output;
Blog › PERL WEEKLY CHALLENGE – 046 – Perl Weekly Challenge
Kevin Colyer
Kevin Colyer’s solution also accepts a multiline string in $m, taking advantage of Raku’s string builtin .lines to split it into @m. (Kevin uses .words as well, since his input has spaces between each character):
my %seen;
my $unscramble="";
my @m;
for $m.lines { @m.push( .words.list ) };
Now Kevin iterates from 0 to one less than the first row’s length ($m[0].elems), to get his $column index. He maintains a %seen frequency map for each column and appends the character seen twice to the $unscrambled output string:
for ^@m[0].elems -> $c {
my %seen;
%seen{ @m[$_][$c] }++ for ^@m.elems;
$unscramble~=%seen.grep( *.value==2)>>.key;
}
Laurent Rosenfeld
Laurent Rosenfeld’s solution also accepts a multiline string with space-separated characters, but uses a more complex map and split chain to turn it into an array of arrays (AoA), which he then transposes to a column-major representation:
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;
}
Now, the results are easy; each $line in @transposed corresponds to a column in the original input, so Laurent can simply tally the characters and select the character that appears more than once (assuming there is no ambiguity):
my @msg = "";
for @transposed -> $line {
my BagHash $counter;
$counter{$_}++ for @$line;
push @msg, grep { $counter{$_} > 1 }, keys $counter;
}
say join "", @msg;
I like the transposition approach.
Blog › Garbled Message and Room Open
Luca Ferrari
Luca Ferrari’s solution accepts an array of strings with space-separated characters, in @message. Luca turns the input into an AoA, transposed at the same time:
my @chars;
my $decoded;
for @message -> $single-line {
for $single-line.split( '', :skip-empty ) {
next if ! $_.trim;
@chars[ $++ ].push: $_;
}
}
As with Laurent’s solution, all Luca has to do now is count the characters in each sublist and append the one that appears more than once:
for @chars -> @line {
for @line -> $searching_for {
if @line.grep( { $_ eq $searching_for} ).elems > 1 {
$decoded ~= $searching_for;
last;
}
}
}
Blog › Encoded messages and open rooms
Mark Anderson
Mark Anderson’s solution accepts a multiline string with space-separated characters, and compactly turns that into an AoA:
my @AoL;
my $result;
for $msg.split(/\n/, :skip-empty) -> $str {
@AoL.push($str.trim-trailing.comb(/\S/).List);
}
Mark then transposes @AoL with [Z], so each $list is a column. Then, Mark uses a regex on $lists string representation to find the repeated character:
for [Z] @AoL -> $list {
$list.Str ~~ /(\S) .* {} :my $letter = $0; $letter/;
$result ~= $letter;
}
Markus Holzer
Markus Holzer’s solution accepts a multi-line string, uses zip to transpose it, and then uses the Bag representation of each column list to make finding the most frequent character very concise thanks to maxpairs, which returns the pair(s) with the maximum value:
[~] zip(
$encrypted.lines.map: *.words
).map(
*.Bag.maxpairs[0].key
);
Impressive.
Noud Aldenhoven
Noud Aldenhoven’s solution accepts an AoA as input, and then decrypt works on a transposed version of that:
sub decrypt(@a) {
return [~] ([Z] @a).map({ select-double($_) });
}
The select-double routine takes a column list and returns the character that appears most frequently:
sub select-double(@a) {
for @a -> $elm {
if (@a.grep($elm).elems == 2) {
return $elm;
}
}
}
This is a nice modular approach to the problem.
Roger Bell West
Roger Bell West’s solution accepts strings from standard input, and puts those into a column-character frequency map (@place):
my @place;
for lines() {
.chomp;
my @k=comb(/\S/,$_);
map {@place[$_]{@k[$_]}++}, (0..@k.end);
}
The putout is then printed character-wise by iterating over each column in @place, sorting in decreasing numeric order and printing the first (most frequent) result:
for @place -> %h {
my @v=values %h;
my @k=keys %h;
my @i=sort {@v[$^b] <=> @v[$^a]}, (0..@v.end);
print @k[@i[0]];
}
print "\n";
Ruben Westerberg
Ruben Westerberg’s solution accepts an AoA, and then iterates over each column index. The most frequent character key/value pair is fetched by taking a vertical slice of @inComming as a Bag, and then taking all pairs that appear twice. The key is the character itself, so that’s what Ruben pushes to the result:
my @decoded;
for (0..@inComming[0]-1) {
my $col=@inComming[0..@inComming-1;$_].Bag.grep({$_.value==2});
@decoded.push: $col>>.key;
}
put @decoded.join: "";
Ruben has done a great job of producing concise, expressive code that I was able to understand more or less instantly.
Ryan Thompson
My solution accepts an array of @strings, splits those into rows, and then maintains a column-character frequency map in @col-count:
my @col-count;
for @strings».split: ' ' -> $row {
@col-count[.key]{.value}++ for |$row.pairs;
}
After that, I built up the result by sorting in decreasing numerical order by value, picking the first (most frequent) result, grabbing its key, and joining everything together:
@col-count».sort(-*.value)».first».key.join;
Blog › Cryptic Message
Simon Proctor
Simon Proctor’s solution accepts an AoA in $data, doing the decoding with one statement (I’ve added some whitespace):
zip( $data.List )
.map( { Bag.new($_) } )
.map( *.pairs
.sort( { $^b.value cmp $^a.value } )
.first
.key )
.join("")
Here again we see zip being used to transpose the matrix, and the Bag representation to enable sorting by value. The .first.key is the most frequent character.
It’s important to note that, unlike Perl’s cmp (based on C’s strcmp) which is a stringwise 3-way comparator, Raku’s cmp is generic, so it will compare integers as integers, here.
Ulrich Rieke
Ulrich Rieke’s solution accepts an array of @strings, and then iterates through each column index, building up a %letterfrequency map for the current column:
my $len = @words[0].chars ;
my $decoded ;
for (0..$len - 1 ) -> $i {
my %letterfrequency ;
for @words -> $word {
%letterfrequency{ $word.substr( $i , 1 ) }++ ;
}
Following a reverse-numerical order sort, the first element of @sorted (the most frequent character) is appended to the $decoded output:
my @sorted = %letterfrequency.keys.sort( {
%letterfrequency{$^b} <=> %letterfrequency{$^a} } ) ;
$decoded ~= @sorted[ 0 ] ;
}
Task #2 - Is The Room Open? (500 Doors)
Here is Mohammad’s description:
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.
Types of Solutions
1. Nested Loops
Most people solved this with some form of a nested loop. The outer loop for each employee (i), and the inner loop corresponds to each 1/i door that employee will toggle. This results in an efficiency of O(n × (1/1 + 1/2 + ⋯ + 1/n)) ≈ O(n × log n). For a problem size of n = 500, that’s absolutely fine. However, with a little bit of math, it’s possible to simplify things even more:
2. Square Numbers
Many people noticed that the doors left open are the square numbers (1², 2²=4, 3²=9, etc.). Some decided to implement this pattern as an algorithm, resulting in trivial code with O(sqrt(n)) complexity.
The main difficulty behind using this method is demonstrating its correctness, yet several people managed to do just that, with explanations or informal proofs of why only perfect square numbered doors would be open.
Correctness proofs are an important topic in computer science, so I’m glad to see some effort being put into it here!
Of course, neither of these solutions is necessarily “better” in the context of this challenge. The square numbers solution (2) is the result of analysis and math, while the looping solution (1) is a better showcase of the language features and coding ability. Both skills are tremendously important, and I’m quite sure everyone I’m reviewing today is capable of either method; it’s just a matter of what they decide to submit.
Arne Sommer
Arne Sommer’s solution uses nested loops to toggle the doors in @open:
my @open;
for 1 .. 500 -> $employee {
for ($employee, $employee + $employee ... 500) -> $index {
@open[$index] = ! @open[$index];
}
}
say "Open rooms: { (1..500).grep({@open[$_] }).join(',') }.";
The inner loop will only iterate over every $employeeth index.
Blog › The Cryptic Raku Room
Colin Crain
Colin Crain’s solution has an outer loop for each employee, but the inner loop builds a list of @doors that employee will toggle, and then applies it like a mask over @hotel using zip+XOR (Z+^):
my @hotel = 0 xx $size;
for (1..$size) -> $emp {
my @doors = map { $_ %% $emp ?? 1 !! 0 }, ( 1..$size );
@hotel = @hotel Z+^ @doors;
}
Then it’s just a matter of printing the numbers of the @hotel rooms that are
open:
for (0..$size-1) {
printf "room %3s is open\n", $_+1 if @hotel[$_];
}
Jaldhar H. Vyas
Jaldhar H. Vyas’s solution uses a nested loop to toggle each door iff the employee number, $i divides the room number, $j:
constant $end = 500;
my Bool @rooms[$end];
for 0 ..^ $end -> $i {
for 0 ..^ $end -> $j {
if ($j + 1) %% ($i + 1) {
@rooms[$j] = !@rooms[$j];
}
}
}
Printing the results is accomplished similarly, taking care to work with the 0-based indexing set up in the previous section:
for 0 ..^ $end -> $i {
if @rooms[$i] {
print $i + 1, q{ };
}
}
print "\n";
Javier Luque
Javier Luque’s solution uses a nested loop as well:
my @doors;
@doors[0 .. 500] = 0;
for (1 .. 500) -> $employee {
for ($employee .. 500 ) -> $door {
next unless $door % $employee == 0;
@doors[$door] = (@doors[$door]) ?? 0 !! 1;
}
}
for (1 .. 500) -> $i {
say "Door: " ~ $i ~ " is open."
if (@doors[$i]);
}
Blog › 046 – Perl Weekly Challenge
Kevin Colyer
Kevin Colyer’s solution does a nested loop as well, but optimizes the inner loop by incrementing $i by the $employee number:
my Int @doors = 1 xx 500;
for 2..500 -> $e {
my $i=0;
while $i < 500 {
@doors[$i] = 1 - @doors[$i];
$i+=$e;
}
}
say @doors.sum;
Kevin outputs @doors.sum, which effectively counts how many doors are open. I modified that line to read @doors.pairs.grep(*.value)».key, and Kevin’s code does indeed find the correct doors, though there was never really any doubt.
Laurent Rosenfeld
Laurent Rosenfeld’s solution does the efficient nested looping method as well:
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 join " ", @rooms[1..MAX];
Laurent opted to print a string of 1s and 0s (1 = open, 0 = closed). In his blog, Laurent took the time to do some interesting analysis of this problem.
Blog › Garbled Message and Room Open
Luca Ferrari
Luca Ferrari’s solution stores his door status in a %rooms hash, but the resulting code is similar to array-based nested loop solutions:
my %rooms = ( 1 .. $room-count).map: * => False;
for 1 .. $room-count -> $employee {
%rooms{ $_ } = ! %rooms{ $_ } if $_ %% $employee for 1 .. $room-count;
}
Since %rooms is a hash, the room numbers (keys) will be in random order, so
they must be sorted:
say "Room $_ is Open" if %rooms{ $_ } for %rooms.keys.sort: *.Int <=> *.Int;
Blog › Encoded messages and open rooms
Mark Anderson
Mark Anderson’s solution has a little fun with control flow in the nested loop:
my \open = True;
my @doors = open xx 500;
for 1 .. 500 -> $emp {
NEXT {
for $emp, $emp*2 ... 500 -> $door {
@doors[$door-1] ?^= open;
}
}
say $emp if @doors[$emp-1];
}
Mark also uses a special sequence to loop over $empth door in the inner loop. Finally, you’ll notice the output line is inside the top-level loop; this works because $emp-1's door will never be toggled once it is $emp's turn through the loop.
Markus Holzer
Markus Holzer’s solution makes note of the fact that only the square numbered doors will be open (check the link for his informal proof). He then offers three ways to generate the list of square numbers below 500:
say "Open rooms: ", ( 1..500 ).grep: *.&is-open;
sub is-open( $room ) { $room.sqrt.narrow ~~ Int }
say "Open rooms: ", (1..500.sqrt.Int).map: * ** 2;
say "Open rooms: ", (1..500.sqrt.Int)>>²; # nicest idiom by jnthn
jnthn, of course is Jonathan Worthington (GitHub).
Noud Aldenhoven
Noud Aldenhoven’s solution also prints out a list of square numbers, and also includes an informal proof in the comments of his solution. Here is the code:
say "Open rooms:";
say $_**2 for 1..(500.sqrt);
Noud’s blog contains essentially the same proof, but with better typesetting than you can get in a Raku source file:
Blog › Is the room open?
Roger Bell West
Roger Bell West’s solution loops efficiently, thanks to the C-style inner loop, which advances the index by the current employee $number:
my @rooms=1 xx 500;
for 2..500 -> $n {
loop (my $k=$n-1 ; $k <500 ; $k+=$n) {
@rooms[$k]=1-@rooms[$k];
}
}
map {say $_+1}, grep {@rooms[$_]==1}, (0..@rooms.end);
Ruben Westerberg
Ruben Westerberg’s solution generates an intermediate @index array, which is essentially a mask of doors to toggle for the current employee ($i):
my @doors=False xx 500; #doors initally closed
@doors[$_]=!@doors[$_] for 0..499; #First person opens all
for (2..500) -> $i {
my @index=($i, {$_+$i} ... * >= 500).grep(* <= 500).map: *-1;
@doors[$_]=!@doors[$_] for @index;
}
put @doors>>.Num;
Ruben’s @doors is an array of Bools, so he coerces each to a Num in order to output a string of 1s (open) and 0s (closed).
Ryan Thompson
My submission includes two solutions. The first is to simply output the square numbers directly:
say (1..$doors.sqrt.Int) »**» 2;
As justification for the above method, I provided an informal correctness proof in my blog, linked below.
For completeness, I decided to also submit a looping solution:
my %doors;
for 1..$doors -> $m {
%doors{$m*$_} ^^= 1 for 1..$doors/$m;
}
say %doors.grep(*.value)».key».Int.sort;
The looping is optimal, as I only loop over every $m doors ($m is the current employee). For the output, I simply pull out all doors with a value and sort them numerically.
As a dispassionate reviewer of my own code a week later, I don’t know why I used a hash, here. An array would have been cleaner, avoiding a potentially costly sort:
say %doors.grep(*.value)».key».Int.sort; # <-- This
say @doors.pairs.grep(*.value)».key; # <-- Becomes this
Blog › Is the Room Open? (500 Doors)
Simon Proctor
Simon Proctor’s solution loops optimally, thanks to the increment in the while loop:
my @doors-open = 501 xx False;
for 1..500 -> $inc {
my $cur = $inc;
while $cur <= 500 {
@doors-open[$cur] = ! @doors-open[$cur];
$cur += $inc;
}
}
Since Simon added a dummy element zero, for 501 elements in total, he can work directly with 1-based indexing, which simplifies everything, including the output loop:
for 1..500 -> $door {
say "$door is Open" if @doors-open[$door];
}
Ulrich Rieke
Ulrich Rieke’s solution begins by
defining a custom flip routine, that returns the opposite of the open or
closed keyword passed in:
sub flip( $state ) {
return $state eq "open" ?? "closed" !! "open" ;
}
The main body of Ulrich’s solution is a familiar nested loop:
my @current = "open" xx 500 ;
for (2..500) -> $i {
if ( $i < 251 ) {
for ($i , 2 * $i ... 500 ) -> $j {
@current[ $j - 1 ] = flip( @current[ $j - 1] ) ;
}
}
else {
@current[ $i - 1 ] = flip( @current[ $i - 1 ] ) ;
}
}
At this point, @current is an array of strings, closed or open,
accordingly. So Ulrich then zips that into @doors to map the open/closed
state to the room number:
my @doors = @current Z (1..500) ;
That is a neat way to do it. I would normally use @current.pairs (or @current.antipairs in this case), but it’s always nice to consider another way to do the same thing.
for @doors -> $pair {
say "door {$pair[ 1 ]} is open!" if $pair[0] eq "open" ;
}
See Also
Blogs this week:
Arne Sommer › The Cryptic Raku Room
Javier Luque › 046 – Perl Weekly Challenge
Laurent Rosenfeld › Garbled Message and Room Open
Luca Ferrari › Encoded messages and open rooms
Noud Aldenhoven › Is the room open?
Ryan Thompson › Cryptic Message | Is the Room Open? (500 Doors)