Perl Weekly Challenge: Week 375
Challenge 1:
Single Common Word
You are given two array of strings.
Write a script to return the number of strings that appear exactly once in each of the two given arrays. String comparison is case sensitive.
Example 1
Input: @array1 = ("apple", "banana", "cherry")
@array2 = ("banana", "cherry", "date")
Output: 2
Example 2
Input: @array1 = ("a", "ab", "abc")
@array2 = ("a", "a", "ab", "abc")
Output: 2
"a" appears once in @array1 but appears twice in @array2, therefore, not counted.
Example 3
Input: @array1 = ("orange", "lemon")
@array2 = ("grape", "melon")
Output: 0
Example 4
Input: @array1 = ("test", "test", "demo")
@array2 = ("test", "demo", "demo")
Output: 0
Example 5
Input: @array1 = ("Hello", "world")
@array2 = ("hello", "world")
Output: 1
String comparison is case sensitive.
I managed to do this one in Raku as one-liner though stretching the definition of one-liner a little bit. It contains three separate statements and I've split them up into separate lines here for clarity.
The two arrays are brought in to the script as the first two command-line arguments,
each of which is a string consisting of array elements separated by whitespace.
We turn each string back into an array with .words() and then turn use .Bag()
to turn that into a Bag data structure. This is a specialized Hash who keys
are unique elements in an array and values are the frequency with each key appears.
my %a = @*ARGS[0].words.Bag;
my %b = @*ARGS[1].words.Bag;
Then we use the handy ∩ or intersection operator to determine which elements the
two Bags have in common. Unfortunately the result of this operation is a Set which
loses the frequency information so we need an additional step. We get the elements of the
Set with .keys() and then use .grep() to filter elements which have the same frequency
in %a and %b. We count those with .elems() and print the result with .say().
(%a ∩ %b).keys.grep({ %a{$_} == %b{$_} }).elems.say
The Perl version is considerably longer. .words() can be emulated with split() but we need extra support code for features unique to Raku such as Bags and the intersection
operator. Luckily the makeBag() and intersection() functions I wrote for previous
challenges were only a cut and paste away. With these, the core of the Perl version
looks like this, conceptually very similar to Raku.
my %a = makeBag(split /\s+/, $ARGV[0]);
my %b = makeBag(split /\s+/, $ARGV[1]);
say scalar grep { $a{$_} == $b{$_} } intersection([keys %a], [keys %b]);
Challenge 2:
Find K-Beauty
You are given a number and a digit (k).
Write a script to find the K-Beauty of the given number. The K-Beauty of an integer number is defined as the number of substrings of given number when it is read as a string has length of ‘k’ and is a divisor of given number.
Example 1
Input: $num = 240, $k = 2
Output: 2
Substring with length 2:
24: 240 is divisible by 24
40: 240 is divisible by 40
Example 2
Input: $num = 1020, $k = 2
Output: 3
Substring with length 2:
10: 240 is divisible by 10
02: 240 is divisible by 2
20: 240 is divisible by 20
Example 3
Input: $num = 444, $k = 2
Output: 0
Substring with length 2:
First "44": 444 is not divisible by 44
Second "44": 444 is not divisible by 44
Example 4
Input: $num = 17, $k = 2
Output: 1
Substring with length 2:
17: 17 is divisible by 17
Example 5
Input: $num = 123, $k = 1
Output: 2
Substring with length 1:
1: 123 is divisible by 1
2: 123 is not divisible by 2
3: 123 is divisible by 3
This challenge can be solved as a one-liner in both Raku and Perl. Once again, I've spread the code out for clarity.
We get the input from command-line arguments. I've shortened $num as mentioned
in the spec to $n to save a few characters.
my ($n, $k) = @*ARGS;
Then we use .map() and .substr() to get all the substrings of $n with length
$k starting from position 0 to length of $n - $k. Then we use .grep()
to find the substrings (treated as numbers) that are evenly divisible into $n
using the %% operator. Successful matches are counted with .elems() and the
result is printed with .say().
(0 .. $n.chars-$k).map({ $n.substr($_,$k) }).grep({ $n %% $_ }).elems.say
Perl doesn't have %% but we can work around the lack easily enough. Perl has
equivalents for the rest and the Perl version ends up slightly shorter overall.
my ($n,$k) = @ARGV;
say scalar grep { !($n % $_) } map { substr $n,$_,$k } 0..(length $n)-$k