Perl Weekly Challenge: Week 209
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.
There are several ways to approach this challenge, I chose to use regular expressions.
First the bits (which are taken from command-line arguments) are joined into one string;
my $arg = @bits.join(q{});
Then a series of regular expression replace each sequence mentioned in the spec with its' corresponding letter.
$arg ~~ s:g/10/b/;
$arg ~~ s:g/11/c/;
$arg ~~ s:g/0/a/;
If the letter at the end is an a, we print 1 otherwise 0.
say $arg ~~ /a$/ ?? 1 !! 0;
It is just as simple in Perl.
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;
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"] ]
The first order of business is to get the account information into the script. I chose to do it with a series
of command-line arguments where each argument is an account. Within an account, the name is first followed by
email addresses each separated by spaces. So for example 1, the input would look like this: "A a1@a.com a2@a.com" "B b1@b.com" "A a3@a.com a1@a.com".
A hash will hold the merged accounts.
my %merges;
Each command-line argument...
for @args -> $arg {
...is split into a list of parts.
my @temp = $arg.words;
The first part which is the account name, is removed from the list with .shift().
my $name = @temp.shift;
The name becomes a key in our hash and the rest of the list is added to its' values. If there is more than one account with the same name, there will be multiple address lists under that key.
%merges{$name}.push(@temp);
}
Now for each account...
for %merges.keys -> $key {
We compare its' address lists in combinations of two.
for 0 ..^ %merges{$key}.elems - 1 -> $i {
for $i ^..^ %merges{$key}.elems -> $j {
Treating each list as a set, if the intersection of the two sets (found with the ∩ operator) has elements, it means they
have at least one address in common.
if (%merges{$key}[$i] ∩ %merges{$key}[$j]).elems {
In that case, we merge the two lists by making the first list, the union (found with the ∪ operator) of the two list/sets...
%merges{$key}[$i] = (%merges{$key}[$i] ∪ %merges{$key}[$j]).keys;
...and the second list empty.
%merges{$key}[$j] = ();
}
}
}
}
I'm not a 100% sure I've got that right but it works for the examples.
Now we can output our results. It's simply a matter of iterating through the keys of %merges and then for each key
through the values. The code is more complicated only because I was trying to match the format of the output in the examples.
my @output;
for %merges.keys -> $key {
for %merges{$key}.values -> $value {
if @$value.elems {
@output.push(q{[} ~ [ $key, | @$value ].map({ q{"} ~ $_ ~ q{"} }).join(q{, }) ~ q{]});
}
}
};
say q{[ }, @output.sort({ @$^a cmp @$^b }).join(",\n"), q{ ]};
For Perl, I had to provide my own union() and intersection() functions to replace missing functionality from Raku. Armed
with those, it was a straightforward translation from the Raku version.
my %merges;
for my $arg (@ARGV) {
my @temp = split /\s+/, $arg;
my $name = shift @temp;
push @{$merges{$name}}, [@temp];
}
for my $key (keys %merges) {
for my $i (0 .. scalar @{$merges{$key}} - 2) {
for my $j ($i + 1 .. scalar @{$merges{$key}} - 1) {
if (scalar intersection(\@{$merges{$key}->[$i]}, \@{$merges{$key}->[$j]})) {
@{$merges{$key}}[$i] = [ union(\@{$merges{$key}->[$i]}, \@{$merges{$key}->[$j]}) ];
@{$merges{$key}}[$j] = [];
}
}
}
}
my @output;
for my $key (keys %merges) {
for my $value (@{$merges{$key}}) {
if (scalar @{$value}) {
push @output,
q{[} .
(join q{, }, map { q{"} . $_ . q{"} } ( $key, @{$value} )) .
q{]};
}
}
};
say q{[ }, (join ",\n", sort { $a cmp $b } @output), q{ ]};