Perl Weekly Challenge: Week 234
Challenge 1:
Common Characters
You are given an array of words made up of alphabetic characters only.
Write a script to return all alphabetic characters that show up in all words including duplicates.
Example 1
Input: @words = ("java", "javascript", "julia")
Output: ("j", "a")
Example 2
Input: @words = ("bella", "label", "roller")
Output: ("e", "l", "l")
Example 3
Input: @words = ("cool", "lock", "cook")
Output: ("c", "o")
We can solve this in Raku as one slightly long line of code.
say q{(},([∩] @*ARGS.map({$_.comb.BagHash})).map({|($_.key x $_.value).comb}).sort.map({"\"$_\""}).join(q{, }),q{)}
Starting from somewhere in the middle, @*ARGS.map({$_.comb.BagHash}) takes the command-line arguments, separates each one
into its constituent characters and stores them as a data type called a BagHash. This is like a std::multiset in C++ i.e. it
is a set that can store multiple elements of the same value. The is neccessary for e.g. example 2 where their are two duplicate l's.
The [∩] calculates the intersection of these sets. However the result (which is also a BagHash) isn't in the format we need.
It's keys are unique types of element in the input (characters in our case) and its values are the number of times that element
occurred. So to take example 2, the result will contain 'l' => 2 but what we actually want is 'l', 'l'.
map({|($_.key x $_.value).comb}) takes care of this. the x makes a string that duplicates the operand before it as many times as the operand after it. | is used to "flatten" all these strings into one big list and .comb() separates them out individual
characters again.
.sort() sorts this list of characters in ascending alphabetical order and the rest of the code is just for printing the output
in the formate used in the examples.
For Perl, I needed to supply my own intersection() function. I had used one in previous challenges but it
was ad-hoc and hacky so it was time to do it again properly. I came up with this:
sub intersection {
It takes a number of sets (expressed as list references) as parameters and for each one it takes the unique elements
(I recycled a unique() function I had written for previous challenges) and for each one, if it has not been seen before,
creates a key in a hash. If the element had been seen before in another set (i.e. there was already a key for it.) one is added
to the value for that key.
my @sets = @_;
my %count;
for my $set (@sets) {
for my $elem (unique($set)) {
if (!exists $count{$elem}) {
$count{$elem} = 1;
} else {
$count{$elem}++;
}
}
}
Afterwards, we filter the hash with grep() to find the keys whose values are equal to the
number of sets being compared. If they are equal, that key represents an interesecting element.
return [ grep { $_ if $count{$_} == scalar @sets } keys %count ];
}
And this should work in most scenarios except for that pesky example 2. Because I used unique()
in my intersection() function, I only get back one 'l' in the output not two.
What I needed instead was distinct() but there is a problem. The intersection() function assumes an element is intersecting
if the number of occurences is equal to the number of sets. But imagine a scenario where set A has 1 element E, set B has 2 Es
and set C has none. This would add up to 3 so E would be considered as intersecting but actually it's not. In other words the
problem is how to distinguish between distinct elements in one set? There are possible data structures that could be built up
with hashes of hashes or hashes of lists but I came up with in my opinion a more straightforward and elegant idea:
sub distinct {
my ($arr) = @_;
We have an array to store the distinct values. We still have a hash whose keys are unique elements...
my %unique;
my @distinct;
for my $elem (@{$arr}) {
...but this time instead of essentially ignoring the values as in the original unique() function,
they are incremented each time the element is seen.
$unique{$elem}++;
And a concatenation of the element and the current value is added to @distinct.
push @distinct, "$elem$unique{$elem}";
}
return @distinct;
}
The upshot is that instead of returning a list like ('e', 'l') this function will return ('e0', 'l0', 'l1') so
intersection() can check if all sets contain l0 independently of whether thay contain l1.
intersection() itself only needs two changes.
sub intersection {
my @sets = @_;
my %count;
for my $set (@sets) {
unique() is replaced by distinct().
for my $elem (distinct($set)) {
if (!exists $count{$elem}) {
$count{$elem} = 1;
} else {
$count{$elem}++;
}
}
}
And before returning, the appended numbers are removed from the list of intersecting elements.
return [ map { [split //, $_]->[0] } grep { $_ if $count{$_} == scalar @sets } keys %count ];
}
Now the rest of the solution is very easy. It works just like the Raku version.
my @words = map { [ split //, $_ ] } @ARGV;
say
q{(},
( join q{, }, map { "\"$_\"" } ( sort @{intersection( @words )} ) ),
q{)};
Challenge 2:
Unequal Triplets
You are given an array of positive integers.
Write a script to find the number of triplets (i, j, k) that satisfies num[i] != num[j], num[j] != num[k] and num[k] != num[i].
Example 1
Input: @ints = (4, 4, 2, 4, 3)
Ouput: 3
(0, 2, 4) because 4 != 2 != 3
(1, 2, 4) because 4 != 2 != 3
(2, 3, 4) because 2 != 4 != 3
Example 2
Input: @ints = (1, 1, 1, 1, 1)
Ouput: 0
Example 3
Input: @ints = (4, 7, 1, 10, 7, 4, 1, 1)
Output: 28
triplets of 1, 4, 7 = 3x2×2 = 12 combinations
triplets of 1, 4, 10 = 3×2×1 = 6 combinations
triplets of 4, 7, 10 = 2×2×1 = 4 combinations
triplets of 1, 7, 10 = 3x2x1 = 6 combinations
One of the things I love about Raku is how you can chain together methods to make an efficient, easy to read pipeline. The solution to this challenge is a perfect example of this.
Given a list of integers (which is taken from the command-line arguments,)
@ints
.keys() is something you would typically use on a hash but I discovered that if you call it on a list, you get the
indexes of the elements of the list.
.keys
Then we use .combinations() to get every triplet of indexes.
.combinations(3)
These are tested and filtered with .grep().
.grep({
This line which matches the indexes in the triplet with their corresponding list elements is not strictly necessary but it makes the code easier to read.
my ($i, $j, $k) = @$_.map({ @ints[$_] });
For instance I can transcribe the criterion from the spec into code almost verbatim.
$i != $j && $j != $k && $k != $i;
})
Now we have a list of successfully matching combinations. .elems() counts them.
.elems
And .say() prints this out.
.say;
This is the Perl version.
my %ints;
each() does the same job .keys() did above with some extra features and slightly more verbosity.
while (my ($key, $value) = each @ARGV) {
$ints{$key} = $value;
}
say scalar grep {
my ($i, $j, $k) = map { $ints{$_} } @{$_};
$i != $j && $j != $k && $k != $i;
I had to provide my own combinations() function but luckily I already had it from many previous challenges.
} combinations([keys %ints], 3);