laurent_r

These are some answers to the Week 209 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 March 26, 2023 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: Special Bit Characters

You are given an array of binary bits that ends with 0.

Valid sequences in the bit string are:

[0] -decodes-to-> "a"
[1, 0] -> "b"
[1, 1] -> "c"

Write a script to print 1 if the last character is an “a” otherwise print 0.

Example 1:

Input: @bits = (1, 0, 0)
Output: 1

The given array bits can be decoded as 2-bits character (10) followed by 1-bit character (0).

Example 2:

Input: @bits = (1, 1, 1, 0)
Output: 0

Possible decode can be 2-bits character (11) followed by 2-bits character (10) i.e. the last character is not 1-bit character.

This is an example of variable-length code. In order to decode such a bit string, we need to start from the beginning of the string. If the string starts with 0, then we have an "a" and can continue decoding with the next bit. If the string starts with 1, then we need to check the next digit, to figure out whether the first letter is a "b or a "c", and we can continue decoding with the third bit. And so on. So, for example, if we have the following string:

0110100100111011100

We will effectively split it as follows:

0 11 0 10 0 10 0 11 10 11 10 0,

yielding the following decoded string: "acababacbcba."

It is easy to see that such an encoding is totally unambiguous: at any point in the process, there can be only one decoded letter.

But if we pick one bit somewhere in the middle of the bit string, we can't know how to proceed. If it is a 0, this can be an "a", or the second bit of a "b". Similarly, if it is a 1, then it can be the first bit of a "b", or the first or the second bit of a "c". So, we can be sure to always unambiguously decode the string only if we start from the beginning. There are cases, however, where it is possible to decode part of the string starting from somewhere in the middle. For example, if we find two consecutive 0, we know that the second one can only be an "a" and proceed from there. We don't need to proceed from the beginning to find that the last letter in the above bit string is an "a". But, since we cannot be sure to meet such a situation, the best is to start from the beginning as explained above. For much longer strings, looking for the last occurrence of a "00" pattern, and proceed from the second 0 (an "a"), may be an interesting performance improvement, since we're really interested in finding out whether the final 0 is an "a" or the second bit of a "b". With the small examples at hand, this optimization would be useless.

Special Bit Characters in Raku

The program goes through the bit string and consume either one or two bits, depending on whether the current digit is a 0 or a 1. If the last bit (necessarily a 0) is the start of a group, then it is an "a". Otherwise, it is the second bit of a "10" group (i.e. of a "b"). Note that a loop statement alone, without three statements in parentheses, is just an infinite loop, from which we exit with either of the return statements.

sub ends-with-a (@in) {
    my $i = 0;
    my $end = @in.end;
    loop {
        return 1 if $i == $end;
        $i += @in[$i] == 0 ?? 1 !! 2;
        return 0 if $i > $end;
    }
}

for <1 0 0>, <1 1 1 0>, <0 0 0 1 0>, <1 1 0> -> @test {
    say (~ @test).fmt("%-12s => "), ends-with-a @test;
}

This program displays the following output:

$ raku ./main.raku
1 0 0        => 1
1 1 1 0      => 0
0 0 0 1 0    => 0
1 1 0        => 1

Special Bit Characters in Perl

This is a port to Perl of the above Raku program. Please refer to the previous sections if you need additional explanations.

use strict;
use warnings;
use feature "say";

sub ends_with_a {
    my $i = 0;
    my $end = $#_;
    while (1) {
        return 1 if $i == $end;
        $i += $_[$i] == 0 ? 1 : 2;
        return 0 if $i > $end;
    }
}

for my $test ([<1 0 0>], [<1 1 1 0>], 
    [<0 0 0 1 0>], [<1 1 0>]) {
    printf "%-12s => %d\n", "@$test", ends_with_a @$test;
}

This program displays the following output:

$ perl ./special-bit-characters.pl
1 0 0        => 1
1 1 1 0      => 0
0 0 0 1 0    => 0
1 1 0        => 1

Task 2: Merge Account

You are given an array of accounts, i.e. name with list of email addresses.

Write a script to merge the accounts where possible.

Example 1:

Input: 
    @accounts = [ ["A", "a1@a.com", "a2@a.com"],
                  ["B", "b1@b.com"],
                  ["A", "a3@a.com", "a1@a.com"] ]
                ]

Output: [ ["A", "a1@a.com", "a2@a.com", "a3@a.com"],
          ["B", "b1@b.com"] ]

Example 2:

Input: 
    @accounts = [ ["A", "a1@a.com", "a2@a.com"],
                  ["B", "b1@b.com"],
                  ["A", "a3@a.com"],
                  ["B"m "b2@b.com", "b1@b.com"] ]

Output: [ ["A", "a1@a.com", "a2@a.com"],
          ["A", "a3@a.com"],
          ["B", "b1@b.com", "b2@b.com"] ]

Merge Account in Raku

We use a hash of hashes to merge items belonging to the same name and remove possible duplicates.

sub merge-account (@in) {
    my %merged;
    for @in -> @part {
        my ($key, @values) = @part;
        %merged{$key}{$_} = True for @values;
    }
    return %merged;
}

my @tests = ( <A a1@a.com a2@a.com>, 
              <B b1@b.com>,
              <A a3@a.com a1@a.com> ),
            ( <A a1@a.com a2@a.com>,
              <B b1@b.com>,
              <A a3@a.com>,
              <B b2@b.com b1@b.com> );
for @tests -> @test {
    say @test, " => ";
    my %merged = merge-account @test;
    for %merged.keys.sort -> $k {
        say "\t[", (join " ", $k, |%merged{$k}.keys.sort), "]";
    };
    say "";
}

This program displays the following output:

$ raku ./merge-account.raku
((A a1@a.com a2@a.com) (B b1@b.com) (A a3@a.com a1@a.com)) => 
    [A a1@a.com a2@a.com a3@a.com]
    [B b1@b.com]

((A a1@a.com a2@a.com) (B b1@b.com) (A a3@a.com) (B b2@b.com b1@b.com)) => 
    [A a1@a.com a2@a.com a3@a.com]
    [B b1@b.com b2@b.com]

Merge Account in Perl

This is a port to Perl of the previous Raku program. We use a hash of hashes to merge items belonging to the same name and remove possible duplicates.

use strict;
use warnings;
use feature "say";

sub merge_account {
    my %merged;
    for my $part (@_) {
        # say   Dumper $part;
        my ($key, @values) = @$part;
        $merged{$key}{$_} = 1 for @values;
    }
    # say %merged;
    return \%merged;
}

my @tests = ( [ [<A a1\@a.com a2\@a.com>], 
                [<B b1\@b.com>],
                [<A a3\@a.com a1\@a.com>] ],

              [ [<A a1\@a.com a2\@a.com>],
                [<B b1\@b.com>],
                [<A a3\@a.com>],
                [<B b2\@b.com b1\@b.com>] ] );

for my $test (@tests) {
    # say Dumper $test, " => ";
    for my $part (@$test) {
        print join " ", @$part;
        print " - ";
    }
    say " =>";
    my %merged = %{merge_account @$test};
    for my $k (sort keys %merged) {
        say "\t[", (join " ", $k, sort keys %{$merged{$k}}), "]";
    };
    say "";
}

This program displays the following output:

$ perl  ./merge-account.pl
A a1@a.com a2@a.com - B b1@b.com - A a3@a.com a1@a.com -  =>
        [A a1@a.com a2@a.com a3@a.com]
        [B b1@b.com]

A a1@a.com a2@a.com - B b1@b.com - A a3@a.com - B b2@b.com b1@b.com -  =>
        [A a1@a.com a2@a.com a3@a.com]
        [B b1@b.com b2@b.com]

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 April 2, 2023. And, please, also spread the word about the Perl Weekly Challenge if you can.