Perl Weekly Challenge: Week 210

Challenge 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 one was very easy.

First we join up the input (every single bit is a command-line argument.) into a string.

my $arg = @bits.join(q{});

Then we substitute the valid sequences with their decoded version as described in the spec.

$arg ~~ s:g/10/b/;
$arg ~~ s:g/11/c/;
$arg ~~ s:g/0/a/;

Finally, we check if the last character in the decoded string is a. If it is we print 1 otherwise we print 0.

say $arg ~~ /a$/ ?? 1 !! 0;

(Full code on Github.)

The Perl version works exactly the same way.

my $arg = join q{}, @ARGV;

$arg =~ s/10/b/g;
$arg =~ s/11/c/g;
$arg =~ s/0/a/g;

say $arg =~ /a$/ ? 1 : 0;

(Full code on Github.)

Challenge 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. The accounts can only be merged if they have at least one email address in common.

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", "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"] ]

This challenge was a lot more involved.

As is often the case in these challenges, I first had to think about how to get the input into the script. I could have squeezed the @accounts structure shown in the examples into command-line arguments but that would be awkward and require much extra code for parsing. So I thought as it is already in the form of Raku code, why not import it directly?

I copied the input from e.g. example 1 into a text file that looks like this:

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

The function getAccountsFrom() takes the file name of a file like that as a parameter and copies that entire file into a string with IO.slurp(). It is then regenerated into a Raku data structure with EVAL and returned.

sub getAccountsFrom($filename) {
    my $content = $filename.IO.slurp;
    my @accounts = EVAL($content);
    return @accounts;
}

Now normally this is not a good idea. Any arbitrary Raku code could be put in the input file and it would be run without hesitation. In fact EVAL is so dangerous, Raku doesn't let you use it without putting this at the top of the script:

use MONKEY-SEE-NO-EVAL;

As if to say "I told you this is a bad idea but you chose to go ahead anyway." For what it's worth, this is not production code and we know exactly what the input is going to be so I thought the risk is acceptable.

@accounts is passed to a function called mergeAccounts().

sub mergeAccounts(@accounts) {

It makes two passes through @accounts and creates two Hashes. One maps email addresses to account holder names and the other maps email addresses to all others connected in the same group.

    my %emailToName;
    my %emailToEmails;

In the first pass we build the connections.

    for @accounts -> @account {
        my $name = @account[0];
        my @emails = @account[1..*];

Each email addrees is mapped to the account holder's name.

        for @emails -> $email {
            %emailToName{$email} = $name;
        }

Then we connect all emails in this account to each other.

        for @emails -> $email {
            unless %emailToEmails{$email}:exists {
                %emailToEmails{$email} = Set.new();
            }
            %emailToEmails{$email} ∪= @emails.Set;
        }
    }

In the second pass we merge connected components. We need two define two variables. One stores emails that have been seen in the search mentioned below. The other is a Hash whose keys are names and whose values aree lists of email addresses. This holds the results.

    my %seen;
    my @result;

    for %emailToEmails.keys -> $email {
        if %seen{$email} {
            next;
        }

To find all connected emails we do a a breadth-first search through %emailToEmails.

        my @q = [$email];
        my $i = 0;
        while $i < @q.elems {
            my $current = @q[$i++];
            for %emailToEmails{$current}.keys -> $connected {
                unless %seen{$connected} {
                    %seen{$connected} = True;
                    @q.push($connected);
                }
            }
        }

Then we .sort() the connected emails and add them to @result removing duplicates along the way with .unique().

        my $name = %emailToName{$email};
        @result.push([$name, |@q.unique.sort]);
    }

Finally we return @result.

    return @result;
}

Putting this all together, MAIN() is only one line.

    mergeAccounts(getAccountsFrom($filename)).raku.say;

(Full code on Github.)

.raku() formats a data structure in a pretty way and .say() prints it out.

For Perl, we have to supply our own version of .unique(). And as a replacement for .raku() we shall use the Data::Dumper module which means we need this at the top of the script:

use Data::Dumper;
$Data::Dumper::Terse = 1;
$Data::Dumper::Indent = 1;

Other than that, the code is similar to the Raku version.

sub mergeAccounts ($accounts) {
    my %emailToName;
    my %emailToEmails;

    for my $account (@{$accounts}) {
        my $name = $account->[0];
        my @emails = @{$account}[1 .. scalar @{$account} - 1];

        for my $email (@emails) {
            $emailToName{$email} = $name;
        }

        # Connect all emails in this account to each other
        for my $email (@emails) {
            $emailToEmails{$email} //= {};
            for my $connected (@emails) {
                $emailToEmails{$email}->{$connected} = 1;
            }
        }
    }

    my %seen;
    my @result;

    for my $email (keys %emailToEmails) {
        if ($seen{$email}) {
            next;
        }

        my @q = ($email);
        my $i = 0;
        while ($i < @q) {
            my $current = $q[$i++];
            for my $connected (keys %{$emailToEmails{$current}}) {
                unless ($seen{$connected}) {
                    $seen{$connected} = 1;
                    push @q, $connected;
                }
            }
        }

        my $name = $emailToName{$email};
        push @result, [$name, sort(unique(@q))];
    }

    return \@result;
}

sub getAccountsFrom($filename) {
    open my $fh, '<', $filename or die "Could not open file: $!";
    local $/ = undef;
    my $content = <$fh>;
    close $fh;
    my $accounts = eval $content || die "Could not eval content: $@";
    return $accounts;
}

say Dumper(mergeAccounts(getAccountsFrom($ARGV[0])));

(Full code on Github.)