The Cryptic Raku Room

[55] Published 7. February 2020.

This is my response to the Perl Weekly Challenge #46.

Challenge #46.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 # o Similary 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.

I have decided to code the 5 or 6 strings as a single compact string, with a space between the original strings (see [1] below). This is because a slurpy array, which I would have used to support a variable number of strings as command line arguments, doesn't support default values.

unit sub MAIN ($string is copy = 'Hxl4! ce-lo ze6lg HWlvR q9m#o', # [1] :$verbose, # [2] :$another); # [3] $string = 'P+2l!ato 1e80R$4u 5-r]+a>/ Pxwlb3k\ 2e35R8yu <!r^()k0' if $another; # [3a] my @strings = $string.words; # [4] my $max = @strings>>.chars.max; # [5] say ": Max length: $max" if $verbose; # [2a] my @result; # [6] for ^$max -> $index # [7] { @result.push: @strings.map({ $_.substr($index,1) // "" }).repeated.unique; # 8a ######## # 8b ######### # 8b ############## # 8c ### # 8d ### # 8e ## say ": Pos $index : { @strings.map({ $_.substr($index,1) // "" }) }" ~ " -> { @strings.map({ $_.substr($index,1) // "" }).repeated.unique }" if $verbose; # [2b] } say @result.join; # [9]

File: cryptic-simple

[1] The default value, if none are given. Note «is copy» so that we can overwrite the value in [3a]. Procedure arguments are read only by default.

[2] Verbose mode, to help debugging.

[3] Use «--another» to select the other message set given in the challenge [3a].

[4] Split the single input line into separate words (5 or 6 with the default messages).

[5] Get the length of the longest word (in case they have different length), and use that in [7].

[6] The reconstructed text, as an array of single characters. (That is not 100% correct, but I'll get back to that in the «Ambiguous Input» section.)

[7] Iterate over the indices of the strings.

[8] We start with all the characters in position $index in the strings [8b] (and fall back to an empty string if undefined (see [5]) [8c]). Then we sort out the characters that occur more than one time (by removing the first instance of every one [8d]), and finally removing duplicates [8e]. The result is pushed onto the result array [8a].

[9] Print the result.

Running it:

$ raku cryptic-simple Hello $ raku cryptic-simple --verbose : Max length: 5 : Pos 0 : H c z H q -> H : Pos 1 : x e e W 9 -> e : Pos 2 : l - 6 l m -> l : Pos 3 : 4 l l v # -> l : Pos 4 : ! o g R o -> o Hello $ raku cryptic-simple --another PerlRaku $ raku cryptic-simple --another --verbose : Max length: 8 : Pos 0 : P 1 5 P 2 < -> P : Pos 1 : + e - x e ! -> e : Pos 2 : 2 8 r w 3 r -> r : Pos 3 : l 0 ] l 5 ^ -> l : Pos 4 : ! R + b R ( -> R : Pos 5 : a $ a 3 8 ) -> a : Pos 6 : t 4 > k y k -> k : Pos 7 : o u / \ u 0 -> u PerlRaku

Verbose mode shows what is going on.

Ambiguous Input

The two examples given in the challenge, and used above, are unambiguous. So what would happen if we have input where more than one character is repeated?

Let us try (by swapping the «g» with an «R»:

$ raku cryptic-simple --verbose 'Hxl4! ce-lo ze6l R HWlvR q9m#o' : Max length: 5 : Pos 0 : H c z H q -> H : Pos 1 : x e e W 9 -> e : Pos 2 : l - 6 l m -> l : Pos 3 : 4 l l v # -> l : Pos 4 : ! o R R o -> R o Hell R o

The result of [8] for position 4 is two letters «R» and «o». They are pushed to the array, as a list. So the value we get for that position is not a single character, but a list. When we print that (in two places above), they are interpolated as shown.

So the data is ok, but we have a problem with the presentation. Let us fix that:

# say @result.join; expand("", @result); # [1] sub expand ($current, @strings) # [2] { say ":a: $current | @strings[]" if $verbose; # [3] my $copy = $current; # [4] for ^@strings.elems -> $index # [5] { my $curr = @strings[$index]; # [6] say ":b: $curr at $index" if $verbose; # [3a] if $curr.elems > 1 # [7] { if $verbose { say ":c: $copy | $_" for @$curr } # [3b] expand($copy ~ $_, @strings[$index+1 .. Inf]) for @$curr; # [8] return; # [8a] } else # [7b] { say ":d: $curr" if $verbose; # [3c] $copy ~= $curr; # [9] } } say $copy; # [10] }

File: cryptic (changes only)

[1] The «expand» procedure does the output itself, one or more times, so we just call it.

[2] It takes two arguments; the string so far (initially ""), and the rest of the array to parse.

[3] Verbose output is really helpful in explaining what is going on.

[4] A Copy of the input variable, as we pass it along in recursive calls without messing up the original value.

[5] Iterate over the rest of the array.

[6] Get the current letter(s).

[7] If it is a list

[8] • expand all versions (once for each letter) and return when the recursion has run its course [8a].

[9] &if not, add the letter (and let the next iteration (in [5]) go on with the next letter.

[10] Print the string.

Running it, with the arrays marked in red/span> to make it easier to see ehat is going on:

$ raku cryptic 'Hxl4! ce-lo ze6lR HWlvR q9m#o' HellR Hello $ raku cryptic --verbose 'Hxl4! ce-lo ze6lR HWlvR q9m#o' : Max length: 5 : Pos 0 : H c z H q -> H : Pos 1 : x e e W 9 -> e : Pos 2 : l - 6 l m -> l : Pos 3 : 4 l l v # -> l : Pos 4 : ! o R R o -> R o :a: | H e l l R o :b: H at 0 :d: H :b: e at 1 :d: e :b: l at 2 :d: l :b: l at 3 :d: l :b: R o at 4 :c: Hell | R :c: Hell | o :a: HellR | HellR :a: Hello | Hello

Another example, with multiple duplicates:

$ raku cryptic 'Hxl4! ce-lo c e6l R HWlvR q9m#o' cellR cello HellR Hello $ raku cryptic --verbose 'Hxl4! ce-lo c e6l R HWlvR q9m#o' : Max length: 5 : Pos 0 : H c c H q -> c H : Pos 1 : x e e W 9 -> e : Pos 2 : l - 6 l m -> l : Pos 3 : 4 l l v # -> l : Pos 4 : ! o R R o -> R o :a: | c H e l l R o :b: c H at 0 :c: | c :c: | H :a: c | e l l R o :b: e at 0 :d: e :b: l at 1 :d: l :b: l at 2 :d: l :b: R o at 3 :c: cell | R :c: cell | o :a: cellR | cellR :a: cello | cello :a: H | e l l R o :b: e at 0 :d: e :b: l at 1 :d: l :b: l at 2 :d: l :b: R o at 3 :c: Hell | R :c: Hell | o :a: HellR | HellR :a: Hello | Hello

It works.

Challenge #46.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.

The complicated rule about what the employees do with the doors can be simplified as: «changes the state of the door: open -> closed or closed -> open».

unit sub MAIN (:$verbose); # [3] my @open; # [1] for 1 .. 500 -> $employee # [2] { print "E: $employee | Rooms:" if $verbose; # [3] for ($employee, $employee + $employee ... 500) -> $index # [4] { print " $index" if $verbose; # [3] @open[$index] = ! @open[$index]; # [5] } say "" if $verbose; # [3] } for 1 .. 500 -> $room # [6] { say "Room { $room.fmt('%3d')} is open" if @open[$room]; # [7] }

File: room500-loop

[1] The initial state is «closed» (undefined -> False).

[2] For each employee (with the number as key).

[3] Verbose mode is helpful here as well.

[4] Iterate over the rooms starting with the employee number and adding that number until we reach the end (room 500).

[5] Change the state of the door.

[6] Iterate over the rooms,

[7] printing the line if the door is open.

Running it:

$ raku room500-loop Room 1 is open Room 4 is open Room 9 is open Room 16 is open Room 25 is open Room 36 is open Room 49 is open Room 64 is open Room 81 is open Room 100 is open Room 121 is open Room 144 is open Room 169 is open Room 196 is open Room 225 is open Room 256 is open Room 289 is open Room 324 is open Room 361 is open Room 400 is open Room 441 is open Room 484 is open

Verbose mode shows what is going on here, and I have abridged the output to make it readable:

E: 1 | Rooms: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 ... 500 E: 2 | Rooms: 2 4 6 8 10 12 14 16 18 20 22 24 26 28 30 32 34 36 38 40 ... 500 E: 3 | Rooms: 3 6 9 12 15 18 21 24 27 30 33 36 39 42 45 48 51 54 57 60 ... 498 E: 4 | Rooms: 4 8 12 16 20 24 28 32 36 40 44 48 52 56 60 64 68 72 76 ... 500 E: 5 | Rooms: 5 10 15 20 25 30 35 40 45 50 55 60 65 70 75 80 85 90 95 ... 500 E: 6 | Rooms: 6 12 18 24 30 36 42 48 54 60 66 72 78 84 90 96 102 108 ... 498 E: 7 | Rooms: 7 14 21 28 35 42 49 56 63 70 77 84 91 98 105 112 119 ... 497 E: 8 | Rooms: 8 16 24 32 40 48 56 64 72 80 88 96 104 112 120 128 136 ... 496 E: 9 | Rooms: 9 18 27 36 45 54 63 72 81 90 99 108 117 126 135 144 ... 495 ... E: 30 | Rooms: 30 60 90 120 150 180 210 240 270 300 330 360 390 420 450 480 E: 31 | Rooms: 31 62 93 124 155 186 217 248 279 310 341 372 403 434 465 496 E: 32 | Rooms: 32 64 96 128 160 192 224 256 288 320 352 384 416 448 480 E: 33 | Rooms: 33 66 99 132 165 198 231 264 297 330 363 396 429 462 495 E: 34 | Rooms: 34 68 102 136 170 204 238 272 306 340 374 408 442 476 E: 35 | Rooms: 35 70 105 140 175 210 245 280 315 350 385 420 455 490 E: 36 | Rooms: 36 72 108 144 180 216 252 288 324 360 396 432 468 E: 37 | Rooms: 37 74 111 148 185 222 259 296 333 370 407 444 481 E: 38 | Rooms: 38 76 114 152 190 228 266 304 342 380 418 456 494 E: 39 | Rooms: 39 78 117 156 195 234 273 312 351 390 429 468 E: 40 | Rooms: 40 80 120 160 200 240 280 320 360 400 440 480 E: 41 | Rooms: 41 82 123 164 205 246 287 328 369 410 451 492 E: 42 | Rooms: 42 84 126 168 210 252 294 336 378 420 462 E: 43 | Rooms: 43 86 129 172 215 258 301 344 387 430 473 E: 44 | Rooms: 44 88 132 176 220 264 308 352 396 440 484 E: 45 | Rooms: 45 90 135 180 225 270 315 360 405 450 495 E: 46 | Rooms: 46 92 138 184 230 276 322 368 414 460 E: 47 | Rooms: 47 94 141 188 235 282 329 376 423 470 E: 48 | Rooms: 48 96 144 192 240 288 336 384 432 480 E: 49 | Rooms: 49 98 147 196 245 294 343 392 441 490 E: 50 | Rooms: 50 100 150 200 250 300 350 400 450 500

«Ex is short for Employee, and it is followed by a list of rooms where the door changes state. The list of rooms must be correct for the algorithm to work, and verbose mode shows that it is.

The loop can be replaced by «grep», and that gives more compact output as well:

# for 1 .. 500 -> $room # { # say "Room { $room.fmt('%3d')} is open" if @open[$room]; # } say "Open rooms: { (1..500).grep({@open[$_] }).join(',') }.";

File: room500 (changes only)

Running it:

$ raku room500 Open rooms: 1,4,9,16,25,36,49,64,81,100,121,144,169,196,225,256,289,324,\ 361,400,441,484.

Inspecting the room numbers reveal that the open rooms are the integers squared: «1 (1**2), 4 (2**2), 9 (3**2)» and so on.

We can write a very compact program armed with that fact:

my $open := { ++$ ** 2 } ...^ *>= 500; # [1] say "Open Rooms: { $open.join(',') }."; # [2]

File: room500-seq

[1] I have set up status of the rooms as a Sequence. It is ususal to start with an initial value, as e.g. in the Fibonacci Sequence, but we can start with the general rule as done here. It starts with the anonymous state variable « $ » which pops into existence with an initially undefined value. We increase it (coered from undefined to 0, and increased from 0 to 1) with a prefix « ++ ». Then we square the number, giving the value we require. The sequence goes on until the value is greater than 500. The sequence stops before this value, as we specified the sequence operator as « ...^ » (which means «up to, but not including).

[2] Print the entire sequence.

The output is the same as before:

$ raku room500-seq Open rooms: 1,4,9,16,25,36,49,64,81,100,121,144,169,196,225,256,289,324,\ 361,400,441,484.

Feel free to consider this algorithm as cheating.

Infinite Sequence

It is possible to use an infinite sequence, but that leaves us with a halting problem as we only have 500 rooms (and don't want to know that room 529 is open).

Using «grep» on an infinite sequence (as in e.g. $open.grep( * <= 500) ) will not work, as it would have to calculate the entire infinite sequence.

What would work, is using an array slice. But we have to calculate the upper limit first: $open[0 ..^ sqrt(500).Int] .

my $open := { ++$ ** 2 } ... *; say "Open Rooms: { $open[0 ..^ sqrt(500).Int].join(',') }.";

File: room500-infseq

Note that you will get room 529 included if you forget one or both of « ^ » and « .Int ».

And that's it.