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 {$_->[0]} grep {$i//=$_->[1]; $i==$_->[1]} nsort_by {$_->[1]}
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 {$_->[0]} grep {$i//=$_->[1]; $i==$_->[1]} nsort_by {$_->[1]}
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 {$_->[0]} grep {$i//=$_->[1]; $i==$_->[1]} nsort_by {$_->[1]}
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 #
4 # See https://wlmb.github.io/2023/03/13/PWC208/#task-1-minimum-index-sum
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 {$_->[0]} # extract string part
19 grep {
20 $smallest//=$_->[1]; # initialize with lowest index sum
21 $smallest==$_->[1] # compare index sum with lowest
22 }
23 nsort_by {$_->[1]} # 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 #
4 # See https://wlmb.github.io/2023/03/13/PWC208/#task-2-duplicate-and-missing
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)
Bad example:
./ch-2.pl 1 2 2 3 3
Results:
More than one duplicate
Another bad example:
./ch-2.pl 1 4
Results:
More than one missing
Written on March 13, 2023