# Perl Weekly Challenge 208.

My solutions (task 1 and task 2 ) to the The Weekly Challenge - 208.

# Task 1: Minimum Index Sum

``````Submitted by: Mohammad S Anwar
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
``````

I’ll assume the inputs are given in `@ARGV` as two space separated strings. I emulate the two sets with hashes and use the elements indices as the hash values. Then I filter the common elements, order them and choose those with the minimum index sums. This yields a three and a half liner. The starting index is not relevant, so I start from 1 and save some space.

Example 1:

``````perl -MList::UtilsBy=nsort_by -E '(\$l, \$m)=map {[split " "]} @ARGV; @l{@\$l}=(1..@\$l);
@m{@\$m}=(1..@\$m);@r=map {\$_->} grep {\$i//=\$_->; \$i==\$_->} nsort_by {\$_->}
map {[\$_, \$l{\$_}+\$m{\$_}]} grep {defined \$m{\$_}} keys %l; say "(@\$l), (@\$m) -> (@r)";
' "Perl Raku Love" "Raku Perl Hate"
``````

Results:

``````(Perl Raku Love), (Raku Perl Hate) -> (Perl Raku)
``````

Example 2:

``````perl -MList::UtilsBy=nsort_by -E '(\$l, \$m)=map {[split " "]} @ARGV; @l{@\$l}=(1..@\$l);
@m{@\$m}=(1..@\$m);@r=map {\$_->} grep {\$i//=\$_->; \$i==\$_->} nsort_by {\$_->}
map {[\$_, \$l{\$_}+\$m{\$_}]} grep {defined \$m{\$_}} keys %l; say "(@\$l), (@\$m) -> (@r)";
' "A B C" "D E F"
``````

Results:

``````(A B C), (D E F) -> ()
``````

Example 3:

``````perl -MList::UtilsBy=nsort_by -E '(\$l, \$m)=map {[split " "]} @ARGV; @l{@\$l}=(1..@\$l);
@m{@\$m}=(1..@\$m);@r=map {\$_->} grep {\$i//=\$_->; \$i==\$_->} nsort_by {\$_->}
map {[\$_, \$l{\$_}+\$m{\$_}]} grep {defined \$m{\$_}} keys %l; say "(@\$l), (@\$m) -> (@r)";
' "A B C" "C A B"
``````

Results:

``````(A B C), (C A B) -> (A)
``````

The full code is slightly longer/clearer. I also, just for fun, test the experimental `refalias` and `declared_refs` features, which I had never used before. That way I save a couple of dereferences and sigils.

`````` 1  # Perl weekly challenge 208
2  # Task 1:  Minimum Index Sum
3  #
5  use v5.36;
6  use List::UtilsBy qw(nsort_by);
7  use feature qw(refaliasing declared_refs);
8  no warnings qw(experimental::refaliasing experimental::declared_refs);
9  die <<~"FIN" unless @ARGV==2;
10      Usage: \$0 S1 S2
11      to find the common space separated substrings of S1 and S2 with the minimum index sum
12      FIN
13  my (\@list1, \@list2)=map {[split " "]} @ARGV; # Save a couple of \$'s
14  my (%list1, %list2);
15  @list1{@list1} = (0..@list1-1);
16  @list2{@list2} = (0..@list2-1);
17  my \$smallest;
18  my @results = map {\$_->}                   # extract string part
19                grep {
20  	          \$smallest//=\$_->;        # initialize with lowest index sum
21  		  \$smallest==\$_->          # compare index sum with lowest
22                }
23                nsort_by {\$_->}              # sort by index sums
24                map {
25                    [\$_, \$list1{\$_}+\$list2{\$_}] # [string, index sum]
26                }
27                grep {defined \$list2{\$_}}       # common strings go through
28                keys %list1;
29  say "(@list1), (@list2) -> (@results)";       # print result
``````

Examples:

``````./ch-1.pl "Perl Raku Love" "Raku Perl Hate"
./ch-1.pl "A B C" "D E F"
./ch-1.pl "A B C" "C A B"
``````

Results:

``````(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

``````Submitted by: Mohammad S Anwar
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.
``````

Assuming the input is ordered with not more than one duplicate, I loop through the array comparing the current value with the previous to find the last missing and duplicate number. If I find no missing number, I use the last+1 as missing. This yields a one liner:

``````perl -E '@l=@ARGV;\$p=shift @l; for(@l){\$d=\$_ if \$_==\$p; \$m=\$p+1 if \$_>\$p+1; \$p=\$_}
\$m//=\$p+1; \$r=\$d?"(\$d \$m)":-1; say "@ARGV -> \$r";' 1 2 2 4
perl -E '@l=@ARGV;\$p=shift @l; for(@l){\$d=\$_ if \$_==\$p; \$m=\$p+1 if \$_>\$p+1; \$p=\$_}
\$m//=\$p+1; \$r=\$d?"(\$d \$m)":-1; say "@ARGV -> \$r";' 1 2 3 4
perl -E '@l=@ARGV;\$p=shift @l;  for(@l){\$d=\$_ if \$_==\$p; \$m=\$p+1 if \$_>\$p+1; \$p=\$_}
\$m//=\$p+1; \$r=\$d?"(\$d \$m)":-1; say "@ARGV -> \$r";' 1 2 3 3
``````

Results:

``````1 2 2 4 -> (2 3)
1 2 3 4 -> -1
1 2 3 3 -> (3 4)
``````

For the full code, I do check the assumed conditions.

`````` 1  # Perl weekly challenge 208
2  # Task 2:  Duplicate and Missing
3  #
5  use v5.36;
6  die <<~"FIN" unless @ARGV;
7      Usage: \$0 N1 [N2...]
8      to find missing numbers and duplicates in the list N1 N2...
9      FIN
10  my @list=sort {\$a <=> \$b} @ARGV;
11  my \$previous=shift @list;
12  my @duplicates;
13  my @missing;
14  for(@list){
15      push @duplicates, \$_ if \$_==\$previous;
16      push @missing, \$previous+1..\$_-1;
17      \$previous=\$_
18  }
19  push @missing, \$previous+1 unless @missing; # missing after last for default
20  die "More than one duplicate\n" if @duplicates>1;
21  die "More than one missing\n" if @missing>1;
22  my \$result=@duplicates?"(@duplicates @missing)":-1;
23  say "@ARGV -> \$result";
``````

Example:

``````./ch-2.pl 1 2 2 4
./ch-2.pl 1 2 3 4
./ch-2.pl 1 2 3 3
``````

Results:

``````1 2 2 4 -> (2 3)
1 2 3 4 -> -1
1 2 3 3 -> (3 4)
``````

``````./ch-2.pl 1 2 2 3 3
``````

Results:

``````More than one duplicate
``````

``````./ch-2.pl 1 4
``````More than one missing