Perl Weekly Challenge: Week 208
Challenge 1:
Minimum Index Sum
You are given two arrays of strings.
Write a script to find out all common strings in the given two arrays with minimum index sum. If no common strings found returns an empty list.
Example 1
Input: @list1 = ("Perl", "Raku", "Love")
@list2 = ("Raku", "Perl", "Hate")
Output: ("Perl", "Raku")
There are two common strings "Perl" and "Raku".
Index sum of "Perl": 0 + 1 = 1
Index sum of "Raku": 1 + 0 = 1
Example 2
Input: @list1 = ("A", "B", "C")
@list2 = ("D", "E", "F")
Output: ()
No common string found, so no result.
Example 2
Input: @list1 = ("A", "B", "C")
@list2 = ("C", "A", "B")
Output: ("A")
There are three common strings "A", "B" and "C".
Index sum of "A": 0 + 1 = 1
Index sum of "B": 1 + 2 = 3
Index sum of "C": 2 + 0 = 2
My first problem in doing this task was deciding how to get input into the script
from the command line. What I did was to have one argument, -, act as a divider.
arguments before the divider would go into @list1, arguments after the divider would
go into @list2. The code that expresses this is below:
my @list1;
my @list2;
my $destination = 'first';
for @strings -> $string {
if $string eq '-' {
$destination = 'second';
next;
}
if $destination eq 'first' {
@list1.push($string);
} elsif $destination eq 'second' {
@list2.push($string);
}
}
Now that we have two lists, the next task is to see which strings are common
to both. I did this by creating a hash whose keys are strings and whose values are
arrays of two elements. The first element contains the index of the string if it is
found in @list1. The second element contains the index of the if is found in @list2.
In both cases, the other element is set to -1 if it does not already have a value. This
ensures that both elements will have numeric values. I found this to be necessary as
if you only assign to the second element of an array, the first will be "autovivified" but its'
value will be undef. (which is not numeric.) If you only assign to the first element of an
array, the second will not exist at all. Situations like these play havoc with the attempt to find
duplicates. The code to implement all this is below:
my %common;
for 0 .. @list1.end -> $i {
%common{@list1[$i]}[0] = $i;
unless %common{@list1[$i]}[1]:exists {
%common{@list1[$i]}[1] = -1;
}
}
for 0 .. @list2.end -> $i {
unless %common{@list2[$i]}[0]:exists {
%common{@list2[$i]}[0] = -1;
}
%common{@list2[$i]}[1] = $i;
}
Now we can find the duplicate elements by iterating through the keys of the hash of strings and
finding the ones where both the elements of the value array are not -1. If this is the case,
the two values are added together and both the string and this sum are added as key and value in a
new hash called %indexsum.
my %indexsum;
for %common.keys -> $string {
if %common{$string}[0] != -1 && %common{$string}[1] != -1 {
%indexsum{$string} = %common{$string}.sum;
}
}
By sorting the values of %indexsum in ascending numeric order, we can find the minimum
index which will be the first value.
my $minimumindex = %indexsum.values.sort({ $^a <=> $^b }).first;
The last statement is a blockbuster. I spread it out over several lines for readability.
The first part just outputs an open parentheses. This is so the output will look like that in the spec.
say q{(} ~
We take the keys of %indexsum and find the one or more whose values are equal to the
minimum index. (See example 1 for why we need this.)
%indexsum
.keys
.grep({ %indexsum{$_} == $minimumindex })
Then we add quotation marks around each of those values. Again this is in order to make the output look like the spec.
.map({ q{"} ~ $_ ~ q{"}})
The values are sorted. This is not strictly necessary according to the spec but it makes the otherwise random order of hash values more fixed.
.sort
The values are joined together with commas and spaces and the closing parentheses is added.
.join(q{, })
~ q{)};
Usually when I translate a Raku script into Perl, I have to add all kinds of extra code to make up for the shortcomings in the standard facilities of the latter language. So I was pleasantly surprised to see that Perl has everything you need though sometimes in a more verbose way.
my @list1;
my @list2;
my $destination = 'first';
for my $string (@strings) {
if ($string eq '-') {
$destination = 'second';
next;
}
if ($destination eq 'first') {
push @list1, $string;
} elsif ($destination eq 'second') {
push @list2, $string;
}
}
my %common;
for my $i (0 .. scalar @list1 - 1) {
$common{$list1[$i]}->[0] = $i;
unless (exists $common{$list1[$i]}->[1]) {
$common{$list1[$i]}->[1] = -1;
}
}
for my $i (0 .. scalar @list2 - 1) {
unless (exists $common{$list2[$i]}->[0]) {
$common{$list2[$i]}->[0] = -1;
}
$common{$list2[$i]}->[1] = $i;
}
my %indexsum;
for my $string (keys %common) {
if ($common{$string}->[0] != -1 && $common{$string}->[1] != -1) {
$indexsum{$string} = $common{$string}->[0] + $common{$string}->[1];
}
}
my $minimumindex = (sort { $a <=> $b } values %indexsum)[0];
say q{(} . (
join q{, },
sort
map { q{"} . $_ . q{"}}
grep { $indexsum{$_} == $minimumindex }
keys %indexsum
) . q{)};
Challenge 2:
H-Index
You are given an array of integers in sequence with one missing and one duplicate.
Write a script to find the duplicate and missing integer in the given array. Return -1 if none found.
For the sake of this task, let us assume the array contains no more than one duplicate and missing.
Example 1
Input: @nums = (1,2,2,4)
Output: (2,3)
Duplicate is 2 and Missing is 3.
Example 2
Input: @nums = (1,2,3,4)
Output: -1
No duplicate and missing found.
Example 3
Input: @nums = (1,2,3,3)
Output: (3,4)
Duplicate is 3 and Missing is 4.
In the first iteration of my solution, I processed @nums two times one to find
the missing value, and one to find the duplicate. But then I thought I ought to
be able to do it in one go and came up with this.
First two variables are created. $missing will hold the missing integer
and the keys%count` will be integers found in the input and the values will be
the number of times each integer was found.
my $missing;
my %count;
So we loop through the integer array...
for 0 .. @nums.end -> $i {
...populating %count.
%count{@nums[$i]}++;
And we compare the current element to the one before it (unless we are at the first element.) If the difference between the two is greater than one...
if $i > 0 && @nums[$i] - @nums[$i - 1] > 1 {
It means the missing element was between the two. It is calculated and stored in $missing.
The spec says there will only be one missing element so we don't have to worry about duplicates etc.
$missing = @nums[$i] - 1;
}
}
Now we can find the duplicate by looking for any key in %count with a value greater than 1.
Again the spec says there will only be one but adding .first() at the end, has the benefit
of converting the array result of .grep() into a scalar value or Nil if is empty (i.e. a duplicate
was not found.)
my $duplicate = %count.keys.grep({ %count{$_} > 1; }).first;
If we haven't found a missing value we still might be find it out. If there is a duplicate...
if $duplicate {
...the missing value has not been found and the duplicate value is the last one in the array, the missing value must be one more than that.
if !defined $missing && $duplicate == @nums[*-1] {
$missing = @nums[*-1] + 1;
}
We print out the results in the format given by the spec.
say q{(} ~ ($duplicate, $missing).join(q{,}) ~ q{)};
In all other scenarios, either the missing or the duplicate value doesn't exist so we print -1.
} else {
say -1;
}
This is the Perl version.
my $missing;
my %count;
for my $i (0 .. scalar @nums - 1) {
$count{$nums[$i]}++;
if ($i > 0 && $nums[$i] - $nums[$i - 1] > 1) {
$missing = $nums[$i] - 1;
}
}
my $duplicate //= (grep { $count{$_} > 1; } keys %count)[0];
if ($duplicate) {
if (!defined $missing && $duplicate == $nums[-1]) {
$missing = $nums[-1] + 1;
}
say q{(} . (join q{,}, ($duplicate, $missing)) . q{)};
} else {
say "-1";
}