This is my response to the Perl Weekly Challenge #46.
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:
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.
File: cryptic-simple
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]
[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.
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 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
HellR 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:
File: cryptic (changes only)
# 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]
}
[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 ce6lR HWlvR q9m#o'
cellR
cello
HellR
Hello
$ raku cryptic --verbose 'Hxl4! ce-lo ce6lR 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.
|
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».
File: room500-loop
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]
}
[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:
File: room500 (changes only)
# for 1 .. 500 -> $room
# {
# say "Room { $room.fmt('%3d')} is open" if @open[$room];
# }
say "Open rooms: { (1..500).grep({@open[$_] }).join(',') }.";
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:
File: room500-seq
my $open := { ++$ ** 2 } ...^ *>= 500; # [1]
say "Open Rooms: { $open.join(',') }."; # [2]
[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.
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(',') }.";
Note that you will get room 529 included if you forget one or both of «^»
and «.Int».
And that's it.