laurent_r

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.

Task 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

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

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

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
(adc wzy abc) -> abc
(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
adc wzy abc -> abc
aaa bob ccc ddd -> bob

Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on December 11, 2022. And, please, also spread the word about the Perl Weekly Challenge if you can.