Perl Weekly Challenge: Week 277
Challenge 1:
Count Common
You are given two array of strings,
@words1and@words2.Write a script to return the count of words that appears in both arrays exactly once.
Example 1
Input: @words1 = ("Perl", "is", "my", "friend")
@words2 = ("Perl", "and", "Raku", "are", "friend")
Output: 2
The words "Perl" and "friend" appear once in each array.
Example 2
Input: @words1 = ("Perl", "and", "Python", "are", "very", "similar")
@words2 = ("Python", "is", "top", "in", "guest", "languages")
Output: 1
Example 3
Input: @words1 = ("Perl", "is", "imperative", "Lisp", "is", "functional")
@words2 = ("Crystal", "is", "similar", "to", "Ruby")
Output: 0
The Raku solution takes, what else?, one line.
(@*ARGS[0].words.Bag.grep({ $_.value == 1 }) ∩ @*ARGS[1].words.Bag.grep({ $_.value == 1 })).elems.say
As usual we take input from the command-line. In this case two strings which contain words separated by spaces.
Each of these get split into lists of words with .word(). The list is converted into a Bag which is another
data type somewhat like a hash where the keys are items found in the list and the values are the number of times
that item occurs. As we just want the words that only appear once we filter them out with .grep(). After both
sets of words have been processed, the intersection operator ∩ is used to find ones which occur in both. These
are counted with .elems() and the result is printed with .say().
For Perl, we need a function to replace the intersection operator; I already had one from previous challenges. Here it is again with a small update for modern Perl function signatures.
sub intersection($arr1, $arr2) {
my %intersection;
for my $i (@{$arr1}, @{$arr2}) {
$intersection{$i}++;
}
return grep { $intersection{$_} > 1 } keys %intersection;
}
We also need some way to get a list of unique words so I wrote a function called as
you might expect, uniqueWords(). It takes as it's sole parameter, a list of words.
sub uniqueWords(@words) {
A hash is built up whose keys are words from the list and the values are the number of times that word occurs.
my %freq;
for my $word (@words) {
$freq{$word}++;
}
All we have to do is return the list of keys whose values are 1.
return grep { $freq{$_} == 1 } keys %freq;
}
These functions are used in the main part of the script which is one line though spread out over several lines
for legibility. split() is used here in place of Rakus' .words().
say scalar intersection(
[uniqueWords(split /\s+/, $ARGV[0])],
[uniqueWords(split /\s+/, $ARGV[1])]
);
Challenge 2:
Strong Pair
You are given an array of integers,
@ints.Write a script to return the count of all strong pairs in the given array.
A pair of integers x and y is called strong pair if it satisfies: 0 < |x - y| < min(x, y).
Example 1
Input: @ints = (1, 2, 3, 4, 5)
Output: 4
Strong Pairs: (2, 3), (3, 4), (3, 5), (4, 5)
Example 2
Input: @ints = (5, 7, 1, 7)
Output: 1
Strong Pairs: (5, 7)
A Raku one-liner once again.
@*ARGS.unique.combinations(2).grep({ 0 < ($_[0] - $_[1]).abs < $_.min }).elems.say
The integers are take from the command line. To prevent duplicate combinations, we first have to
filter them with .unique(). Then the actual pairs are created with .combinations(2). .grep() filters
them to find strong pairs by using the definition given in the spec almost verbatim. Strong pairs found are
counted with .elems() and the result is printed with .say().
For Perl we need replacements for .combinations(), .min() and .unique() all of which I had from
previous challenges. With them, the core of the Perl solution is also one line.
say scalar grep { 0 < abs($_->[0] - $_->[1]) < min(@{$_}) } combinations(2, unique(@ARGV));