laurent_r

These are some answers to the Week 208 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on March 19, 2023 at 23:59). This blog post offers some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.

Task 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 3:

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

Minimum Index Sum in Raku

We need to find the intersection between two arrays of strings. Once we’ve found the intersection, we need to keep the intersection items that have the smallest sum of indexes in the original array. So, it looked like it would be nice to use Bags for the input (with the index as weight integer for each item), and the ∩ or (&) infix intersection operator,infix%E2%88%AA) to generate the result. It turns out that this might not be the best choice, because the integer weight associated with a bag item is signifying how many copies of that element are considered “in the bag”. So, if the weight is 0, it means the item is not in the bag and is lost during bag construction. Since array indexes start at 0, we’d be losing the first item of each array. The problem is solved by assigning the index incremented by 1 to the weight. This easily solves the problem, but makes the solution slightly less elegant than I originally hoped it to be.

sub min-sum-idx (@s1, @s2) {
    my $b1 = (map {@s1[$_] => $_ + 1}, 0..@s1.end).Bag;
    my $b2 = (map {@s2[$_] => $_ + 1}, 0..@s2.end).Bag;
    my $result = (map { $_ =>  $b1{$_} + $b2{$_}},  
        ($b1 ∩ $b2).keys).Bag;
    my $min = $result.values.min;
    return grep {$result{$_} == $min}, $result.keys;
}

for (<Perl Raku Love>, <Raku Perl Hate>), 
    (<A B C>, <D E F>), (<A B C>, <C A B>) 
        -> @test {
            say "@test[0] - @test[1]".fmt("%-35s => "), 
                min-sum-idx |@test;
}

This program displays the following output:

$ raku ./min-sum_idx.raku
Perl Raku Love - Raku Perl Hate    => (Perl Raku)
A B C - D E F                      => ()
A B C - C A B                      => (A)

Minimum Index Sum in Perl

For porting the above Raku program to Perl, we replace Bags with hashes. We use a grep to construct the @result intersection of the two input arrays, and a loop to compute the minimum array index sum.

use strict;
use warnings;
use feature "say";

sub min_sum_idx {
    my @s1 = @{$_[0]};
    my @s2 = @{$_[1]};

    my %h1 = map {$s1[$_] => $_ } 0..$#s1;
    my %h2 = map {$s2[$_] => $_ } 0..$#s2;
    my @result = grep { exists $h1{$_} } @s2;
    return "()" unless @result;
    my %res = map { $_ => $h1{$_} + $h2{$_} } @result;
    my $min = $res{$result[0]};
    for my $k (keys %res) { 
        $min = $res{$k} if $res{$k} < $min;
    }
    return grep {$res{$_} == $min} @result;
}

for my $test ( [[<Perl Raku Love>], [<Raku Perl Hate>]], 
    [[<A B C>], [<D E F>]], [[<A B C>], [<C A B>]] ) {

    printf "%-14s - %-16s => ", 
        "@{$test->[0]}", "@{$test->[1]}";
    say join " ", min_sum_idx @$test;
}

This program displays the following output:

$ perl  ./min-sum-idx.pl
Perl Raku Love - Raku Perl Hate   => Raku Perl
A B C          - D E F            => ()
A B C          - C A B            => A

Task 2: Duplicate and Missing

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.

First, we are told that the integers are in sequence. This presumably means that they are sorted in ascending order. If not, we could just add a call to the built-in sort routine at the beginning of our code.

Second, the task specification tells us what to do when there is no missing item and no duplicate, but not what to do when only one of these two values is missing. I’ve decided to report something like (3, -) when 3 is a duplicate and there is no missing item, and (-, 3) when 3 is a missing value and there is no duplicate.

Duplicate and Missing in Raku

We simply loop over the input array values and

1. Report a duplicate if one value is equal to the previous one, and

2. Report a missing item if the current item is not one more than the previous one.

   sub dupe-and-missing (@nums) { my ($dupe, $missing); for 1..@nums.end -> $i { if @nums[$i] == @nums[$i-1] { $dupe = @nums[$i]; } elsif @nums[$i] - @nums[$i-1] != 1 { $missing = @nums[$i-1] + 1; } } return “($dupe, $missing)” if $dupe and $missing; return “-1” unless $dupe or $missing; return “($dupe, -)” if $dupe; # no missing item return “(-, $missing)”; # no dupe }

   for <1 2 2 4>, <1 2 3 4>, <1 2 3 3>, <1 2 4 5>, <1 1 3 4>, <1 3 4 5>, <1 2 2 3 5> -> @test { say “@test[]”.fmt(“%-12s => “), dupe-and-missing @test; }

This program displays the following output:

$ raku ./dupe_missing.raku
1 2 2 4      => (2, 3)
1 2 3 4      => -1
1 2 3 3      => (3, -)
1 2 4 5      => (-, 3)
1 1 3 4      => (1, 2)
1 3 4 5      => (-, 2)
1 2 2 3 5    => (2, 4)

Duplicate and Missing in Perl

This is a straight port to Perl of the Raku program above:

use strict;
use warnings;
use feature "say";

sub dupe_and_missing {
    my @nums = @_;
    my ($dupe, $missing);
    for my $i (1..$#nums) {
        if ($nums[$i] == $nums[$i-1]) {
            $dupe = $nums[$i];
        } elsif ($nums[$i] - $nums[$i-1] != 1) {
            $missing = $nums[$i-1] + 1;
        }
    }
    return "($dupe, $missing)" if $dupe and $missing;
    return "-1" unless $dupe or $missing;
    return "($dupe, -)" if $dupe;
    return "(-, $missing)";
}

for my $test ([<1 2 2 4>], [<1 2 3 4>], [<1 2 3 3>], 
    [<1 2 4 5>], [<1 1 3 4>], [<1 3 4 5>], [<1 2 2 3 5>]) {
    printf "%-12s => ", "@$test";
    say dupe_and_missing @$test;
}

This program displays the following output:

$ perl  ./dupe-missing.pl
1 2 2 4      => (2, 3)
1 2 3 4      => -1
1 2 3 3      => (3, -)
1 2 4 5      => (-, 3)
1 1 3 4      => (1, 2)
1 3 4 5      => (-, 2)
1 2 2 3 5    => (2, 4)

Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on March 26, 2023. And, please, also spread the word about the Perl Weekly Challenge if you can.