Perl Weekly Challenge: Week 193
In other news, I'm doing the Advent of Code in Raku once again. We're up to day 4 and so far it's been pretty easy thanks to the power of Raku. I also translate the solutions to Kotlin and it is interesting to see how competetive Raku is in terms of speed and expressiveness compared to this much more widely used language.
I usually run out steam by day 18 or so (out of 25) let's see if I can actually finish this year!
Onwards to the challenges...
Challenge 1:
Binary String
You are given an integer,
$n > 0.Write a script to find all possible binary numbers of size
$n.
Example 1
Input: $n = 2
Output: 00, 11, 01, 10
Example 2
Input: $n = 3
Output: 000, 001, 010, 100, 111, 110, 101, 011
This is so easy we can make it a one-liner in Raku.
First we assign the first command-line argument to $n. This is not strictly necessary but makes the
rest of the code a little short. Then we define a range of values from the minimum binary number to the maximum
using the x operator to make end-points of the appropriate length. For example when $n = 2, the range will
be from 00 .. 11. If $n = 3, the range will be from 000 .. 111. In each case, Raku is smart enough to fill
in all the intermediate binary numbers. All that remains is to .join() them together with commas and spaces and
output the result.
my $n = @*ARGS[0]; (("0" x $n) .. ("1" x $n)).join(q{, }).say;
The Perl version could have been a one-liner too but it has additional hurdles due to not being able to handle
binary numeric ranges nearly as handily as Raku does. What I did was to generate the end-points just as I did in
the Raku version but append 0b to the beginning so Perl would understand that these are binary numbers. Unfortunately this caused them to be treated as strings. The usual trick of putting 0 + in front of them to force
numeric context didn't seem to work. I ended up using the oct() function (I have ranted many times about how this is badly named) to convert them to decimal numbers. This gave me a range of the appropriate length and contents but in decimal. I had to add a map() to convert them back into binary numbers using sprintf("%b") Using sprintf() also allowed me to pad the binary numbers to the required length with leading zeros.
my ($n) = @ARGV;
say join q{, }, map { sprintf('%0*b', $n, $_); } oct('0b' . ('0' x $n)) .. oct('0b' . ('1' x $n));
Challenge 2:
Odd String
You are given a list of strings of same length,
@s.Write a script to find the odd string in the given list. Use positional value of alphabet starting with
0, i.e.a = 0, b = 1, ... z = 25.Find the difference array for each string as shown in the example. Then pick the odd one out.
Example 1
Input: @s = ("adc", "wzy", "abc")
Output: "abc"
Difference array for "adc" => [ d - a, c - d ]
=> [ 3 - 0, 2 - 3 ]
=> [ 3, -1 ]
Difference array for "wzy" => [ z - w, y - z ]
=> [ 25 - 22, 24 - 25 ]
=> [ 3, -1 ]
Difference array for "abc" => [ b - a, c - b ]
=> [ 1 - 0, 2 - 1 ]
=> [ 1, 1 ]
The difference array for "abc" is the odd one.
Example 2
Input: @s = ("aaa", "bob", "ccc", "ddd")
Output: "bob"
Difference array for "aaa" => [ a - a, a - a ]
=> [ 0 - 0, 0 - 0 ]
=> [ 0, 0 ]
Difference array for "bob" => [ o - b, b - o ]
=> [ 14 - 1, 1 - 14 ]
=> [ 13, -13 ]
Difference array for "ccc" => [ c - c, c - c ]
=> [ 2 - 2, 2 - 2 ]
=> [ 0, 0 ]
Difference array for "ddd" => [ d - d, d - d ]
=> [ 3 - 3, 3 - 3 ]
=> [ 0, 0 ]
The difference array for "bob" is the odd one.
Although the spec talks about a difference array, the data structure I shall use in my solution ia a hash where the keys are difference arrays and the values are the strings which have that difference array. I gave it the trés imaginative name `%results."
my %results;
For each string...
for (@strings) -> $string {
We first convert it into an array of numbers where, as the spec suggests, a = 1, b = 2 and so on. This is
done via the .ord() method which returns the ASCII (Unicode actually...) value of a character. Subtracting that
from 'a'.ord gives the appropriate number.
my @values = $string.comb.map({ $_.ord - 'a'.ord; });
Now we declare a variable to hold the difference array.
my @diff;
We then compare each element of @values from the second to the last with the element preceding it and
add the difference between each pair of elements to @diff.
for 1 ..^ @values.elems -> $i {
@diff.push(@values[$i] - @values[$i - 1]);
}
Finally @diff, converted to a string, becomes a key in %results (it may already exist there) and the string is
added to its values.
%results{@diff.join(q{,})}.push($string);
}
Once all the strings have been processed in this way we can just go through %results and find the key
which only has one value. That's the odd one. However there is one more step; the value is an array with one
element. We need to convert that into a string and then we can output it.
%results{%results.keys.grep({ %results{$_}.elems == 1; })}.Str.say;
The Perl version is pretty similar. There are a couple of places...
my %results;
for my $string (@strings) {
my @values = map { ord($_) - ord('a') } split //, $string;
my @diff;
for my $i (1 .. scalar @values - 1) {
push @diff, $values[$i] - $values[$i - 1];
}
...such as here...
push @{$results{join(q{,}, @diff)}}, $string;
}
...and here where we have to cast the hash value in order to treat it as a list which is quite awkward compared to Raku.
say $results{ (grep { scalar @{$results{$_}} == 1 } keys %results)[0] }[0];