## Perl Weekly Challenge 193: Binary String and Odd String

These are some answers to the Week 193 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on December 4, 2022 at 23:59). This blog post offers some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.

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
``````

For this task, all we need to do is to print all the integers between 0 and `(2 ** \$n) -1`, and to display the output in binary format.

### Binary String in Raku

This is so simple that we’ll do it in a Raku one-liner. We could use the built-in base method to convert the input integer into a binary string, or the built-in fmt routine. However, since we want to be concise for a one-liner, we’ll simply use the built-in printf function, with a `b` directive to obtain an unsigned binary integer format.

``````\$ raku -e 'sub MAIN (\$n) { printf "%03b ", \$_ for 0..2**\$n-1; }' 3
000 001 010 011 100 101 110 111
~
\$ raku -e 'sub MAIN (\$n) { printf "%04b ", \$_ for 0..2**\$n-1; }' 4
0000 0001 0010 0011 0100 0101 0110 0111 1000 1001 1010 1011 1100 1101 1110 1111
``````

We can slightly improve this one-liner by using the parameter passed to it in the formatting string, so that we don’t need to change the formatting string depending on the input parameter:

``````\$ raku -e 'sub MAIN (\$c) {printf "%.*b ", \$c, \$_ for 0..2**\$c-1;}' 3
000 001 010 011 100 101 110 111
``````

### Binary String in Perl

Here again, we’ll make a one-liner and use the `printf` function. Compared to the first Raku implementation, we use the input number in the formatting string, so that we don’t need to change the formatting string for different input integers.

``````\$ perl -e 'my \$c = shift; printf "%0\${c}b ", \$_ for 0..(2**\$c) - 1' 3
000 001 010 011 100 101 110 111
~
\$ perl -e 'my \$c = shift; printf "%0\${c}b ", \$_ for 0..(2**\$c) - 1' 4
0000 0001 0010 0011 0100 0101 0110 0111 1000 1001 1010 1011 1100 1101 1110 1111
``````

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.
``````

The difference array is an array containing the distances between the successive letter. The task description suggests that we use “positional value of alphabet starting with 0, i.e. a = 0, b = 1, … z = 25.” This can easily be done, but, since we compute only differences between letters, we could use any other positional arrangement, including ASCII. I’ll use the task description suggestion for Raku and ASCII values in Perl.

I did not understand at first what the odd difference array is supposed to be. Judging from the examples, it appears that several input strings will produce the same difference array (for example, ‘abc’ and ‘bcd’ will both produce the same `(1, 1)` array), and one (or possibly some) will produce unique difference arrays. And we’re supposed to find that (or those) unique array(s).

I’ll build a hash to store, for each difference array, the corresponding strings. Then I’ll loop over the hash keys and display those for which there is only one string in the value.

### Odd String in Raku

The `diff-array` subroutine computes the difference array for the input string. `%transco` is a hash containing the mapping between letters and integers. For each string in the input list, we store in the `result` hash the difference array as a key, and the list of strings as a value. We then display the `result` pairs for which the value has only one string.

``````my %transco = ("a".."z" Z 0..25).flat; # a => 0, b => 1 ...

sub diff-array (\$str) {
my @diff;
for 1..^\$str.chars -> \$i {
push @diff,
%transco{substr(\$str, \$i, 1)}
- %transco{substr(\$str, \$i-1, 1)};
}
return @diff;
}

for <adc wzy abc>, <aaa bob ccc ddd> -> @test {
my %result;
for @test -> \$st {
push %result, (diff-array \$st) => \$st;
}
# say %result;
for %result.keys -> \$k {
say @test, " -> ", %result{\$k} if %result{\$k}.elems == 1;
}
}
``````

This program display the following output:

``````\$ raku ./odd-string.raku
(aaa bob ccc ddd) -> bob
``````

### Odd String in Perl

This is a port to Perl of the Raku program above, except that, as mentioned earlier, we use the ASCII values (the built-in `ord` function) to compute the difference arrays. We obtain a hash of arrays and pick the hash items for which here is only one string.

``````use strict;
use warnings;
use feature qw/say/;
use Data::Dumper;

sub diff_array  {
my \$str = shift;
my @diff;
for my \$i (1.. length(\$str) - 1) {
push @diff,
ord(substr(\$str, \$i, 1))
- ord(substr(\$str, \$i-1, 1));
}
return "@diff";
}

for my \$test ([<adc wzy abc>], [<aaa bob ccc ddd>]) {
my %result;
for my \$st (@\$test) {
push @{\$result{diff_array \$st}}, \$st;
}
# say Dumper \%result;
for my \$k (keys %result) {
say "@\$test -> ", @{\$result{\$k}} if scalar @{\$result{\$k}} == 1;
}
}
``````

This program display the following output:

``````\$ perl  ./odd-string.pl