Challenge 208 Perl solutions by Matthias Muth

4 files changed, 212 insertions, 43 deletions

diff --git a/challenge-208/matthias-muth/README.md b/challenge-208/matthias-muth/README.md
index e2df1b077b..075f8b59f2 100644
--- a/challenge-208/matthias-muth/README.md
+++ b/challenge-208/matthias-muth/README.md
@@ -1,60 +1,133 @@
-# Almost one-liners.
-*Challenge 207 solutions in Perl by Matthias Muth*
+# Juggling with indexes.
+*Challenge 208 solutions in Perl by Matthias Muth*
 
-## Task 1: Keyboard Word
+## Task 1: Minimum Index Sum
 
-> You are given an array of words.<br/>
-> Write a script to print all the words in the given array that can be types
-using alphabet on only one row of the keyboard.
+> You are given two arrays of strings.<br/>
+> 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.
 
-Perl's regular expressions make this a simple task.<br/>
-We just need to check whether the word that we examine consists of only
-characters from one of the three sets of characters containing the keys of one
-row of the keyboard. This is a regular expression that does that for us:
+Let's take one step at a time for this one:
+
+'All common strings':<br/>
+For checking whether a string is contained in both arrays, we use a typical Perl pattern and create an 'existence' hash from the first array's strings.
+Later we can go through the strings from the second array
+and check for each one whether it exists in the first array
+by simply checking the existence of a hash entry for that string.<br/>
+The typical Perl pattern to create that hash looks like this:
+```perl
+    my %index1 = map { ( $list1[$_] => 1 ) } 0..$#list1;
+```
+Actually, as we will also need the strings *index* within the first array later, we don't store the typical `1`, but that index value:
 ```perl
-/^( [qwertyuiop]* | [asdfghjkl]* | [zxcvbnm]* )$/xi
+    my %index1 = map { ( $list1[$_] => $_ ) } 0..$#list1;
 ```
-The `x` modifier allows for whitespace in the pattern definition to make it
-more readable,
-and the `i` modifier makes sure that upper case as well as lower case
-characters are matched.
+We only need to create this hash for the first array of strings.
+For the second one we can loop over the strings, using the second string index as the loop index.
 
-The function that returns all 'single keyboard row' words from a list then
-actually is a one-liner:
+'Minimum index sum':<br/>
+So we need the sum of the two indexes into the first and the second array for every string,
+and we need to store all those sums to later find their minimum.<br/>
+And we need to keep the information about which string generated each sum.<br/>
+So why don't we create another hash, this time using the *sum* as the key, and the string as the value?<br/>
+For finding the minimum in the end, we then can do `min( keys %strings_by_index_sum )`.<br/>
+And the strings to be returned are the `value` of that minimum's hash entry.<br/>
+String**s**? Plural?<br/>
+Oh, yes, the same index sum can be generated by more that one string (this case exists in the examples!).
+So we should not store a string as the value, but an arrayref,
+onto which we push whichever string generates that index sum.
+Looks like this:
 ```perl
-sub keyboard_words {
-    return grep /^( [qwertyuiop]* | [asdfghjkl]* | [zxcvbnm]* )$/xi, @_;
-}
+    my %strings_by_index_sum;
+    for ( 0..$#list2 ) {
+        if ( exists $index1{ $list2[$_] } ) {
+            my $index_sum = $index1{ $list2[$_] } + $_;
+            push @{$strings_by_index_sum{$index_sum}}, $list2[$_];
+        }
+    }
+```
+
+Now it's time to return what we found.<br/>
+As already explained, we get the minimum of the keys of our special hash, and return the strings in that hash entry.<br/>
+To avoid an empty list in the `min(...)` call (which leads to a warning),
+we guard this computation by checking whether anything was found at all, returning an empty list if not.<br/>
+So:
+```perl
+    return
+        %strings_by_index_sum
+        ? sort @{$strings_by_index_sum{ min( keys %strings_by_index_sum ) } }
+        : ();
 ```
+Putting everything together:
 
-## Task 2: H-Index
-
->You are given an array of integers containing citations a researcher has
-received for each paper.<br/>
->Write a script to compute the researchers `H-Index`. For more information please checkout the [wikipedia page](https://en.wikipedia.org/wiki/H-index).
-
-The Wikipedia page describes well how the `H-Index` can be computed from the
-list of numbers of citations.
-Starting with the list, sorted in descending order,
-we can compare each number in the list with its index.
-As long as the number is higher than the index, that publication counts for
-the `H-Index`.
-The `H-Index` then is the maximum of those indexes that match the criteria.
-
-Instead of stopping at the last hit and using that index as a result,
-we get the same result if we count all citations that fulfill the criteria.
-As usual in Perl, there is more than one way to do it.
-For me, the simplest one is to `grep` the indexes that match,
-and then count them using the `scalar` operator. Like so:
 ```perl
-sub h_index {
-    my @sorted = sort { $b <=> $a } @_;
-    return scalar grep $sorted[$_] >= 1 + $_, 0..$#sorted;
+sub min_index_sum {
+    my @list1 = @{$_[0]};
+    my @list2 = @{$_[1]};
+    my %index1 = map { ( $list1[$_] => $_ ) } 0..$#list1;
+    my %strings_by_index_sum;
+    for ( 0..$#list2 ) {
+        if ( exists $index1{ $list2[$_] } ) {
+            my $index_sum = $index1{ $list2[$_] } + $_;
+            push @{$strings_by_index_sum{$index_sum}}, $list2[$_];
+        }
+    }
+    return
+        %strings_by_index_sum
+        ? sort @{$strings_by_index_sum{ min( keys %strings_by_index_sum ) } }
+        : ();
 }
 ```
 
-Ok, **almost** a one-liner...! ;-)
+## Task 2: Duplicate and Missing
+
+>You are given an array of integers in sequence with one missing and one duplicate.<br/>
+Write a script to find the duplicate and missing integer in the given array. Return -1 if none found.<br/>
+For the sake of this task, let us assume the array contains no more than one duplicate and missing.
 
+In this task, for finding a duplicate value we need to go through the array and compare every value to the previous one.<br/>
+This immediately makes me think of using `List::Util`'s `reduce` function,
+which already does the job of looping over the array for us,
+as well as the job of handing us two values at a time (the `$a`and `$b` special variables) for use in a code block that we supply.
+
+Within that code block, we can check for a duplicate value and set a variable if we found one,
+Similarly, we can also check for a missing value between the previous entry and the current one:
+```perl
+    reduce {
+        $dup     = $b     if $b == $a;
+        $missing = $b - 1 if $a < $b - 1;
+        $b;
+    } @_;
+```
+(We mustn't forget to return `$b` from the code block, it will be the next iteration's `$a`.)
+
+There is a special case where we might 'miss' the missing value:<br/>
+When the duplicate values happen to be at the end of the array,
+the 'missing' value is the one that is now hidden by the repeated value in the last position.
+
+We can assume that that value is the missing one if we know that there is a duplicate
+(and the rules state that there will be *at maximum* one duplicate),
+and if we haven't detected a missing value before.<br/>
+If we did *not* find a duplicate when we arrive there, we need to return `-1` anyways,
+so in that case we don't need to worry about whether we have a missing value, and which one, at all.
+
+To summarize this solution:
+
+```perl
+use List::Util qw( reduce );
+
+sub dup_and_missing {
+    my ( $dup, $missing );
+    reduce {
+        $dup     = $b     if $a == $b;
+        $missing = $b - 1 if $a < $b - 1;
+        $b;
+    } @_;
+    return
+        defined $dup
+        ? ( $dup, $missing // ( $_[-1] + 1 ) )
+        : -1;
+}
+```
 
 **Thank you for the challenge!**
 
diff --git a/challenge-208/matthias-muth/blog.txt b/challenge-208/matthias-muth/blog.txt
new file mode 100644
index 0000000000..49014cdac7
--- /dev/null
+++ b/challenge-208/matthias-muth/blog.txt
@@ -0,0 +1 @@
+https://github.com/MatthiasMuth/perlweeklychallenge-club/tree/muthm-208/challenge-208/matthias-muth#readme
diff --git a/challenge-208/matthias-muth/perl/ch-1.pl b/challenge-208/matthias-muth/perl/ch-1.pl
new file mode 100755
index 0000000000..b8332a3e2b
--- /dev/null
+++ b/challenge-208/matthias-muth/perl/ch-1.pl
@@ -0,0 +1,51 @@
+#!/usr/bin/env perl
+#
+#       The Weekly Challenge - Perl & Raku
+#       (https://theweeklychallenge.org)
+#
+#       Challenge 208 Task 1: Minimum Index Sum
+#
+#       Perl solution by Matthias Muth.
+#
+
+use strict;
+use warnings;
+
+use List::Util qw( min );
+
+sub min_index_sum {
+    my @list1 = @{$_[0]};
+    my @list2 = @{$_[1]};
+    my %index1 = map { ( $list1[$_] => $_ ) } 0..$#list1;
+    my %strings_by_index_sum;
+    for ( 0..$#list2 ) {
+        if ( exists $index1{ $list2[$_] } ) {
+            my $index_sum = $index1{ $list2[$_] } + $_;
+            push @{$strings_by_index_sum{$index_sum}}, $list2[$_];
+        }
+    }
+    return
+        %strings_by_index_sum
+        ? sort @{$strings_by_index_sum{ min( keys %strings_by_index_sum ) } }
+        : ();
+}
+
+use Test::More;
+
+do {
+    is_deeply
+        [ min_index_sum( $_->{INPUT_1}, $_->{INPUT_2} ) ], $_->{EXPECTED},
+        "min_index_sum( [ @{$_->{INPUT_1}} ], [ @{$_->{INPUT_2}} ] ) == ( @{$_->{EXPECTED}} )";
+} for (
+    { INPUT_1  => [ "Perl", "Raku", "Love" ],
+      INPUT_2  => [ "Raku", "Perl", "Hate" ],
+      EXPECTED => [ "Perl", "Raku" ] },
+    { INPUT_1  => [ "A", "B", "C" ],
+      INPUT_2  => [ "D", "E", "F" ],
+      EXPECTED => [] },
+    { INPUT_1  => [ "A", "B", "C" ],
+      INPUT_2  => [ "C", "A", "B" ],
+      EXPECTED => [ "A" ] },
+);
+
+done_testing;
diff --git a/challenge-208/matthias-muth/perl/ch-2.pl b/challenge-208/matthias-muth/perl/ch-2.pl
new file mode 100755
index 0000000000..92db80038a
--- /dev/null
+++ b/challenge-208/matthias-muth/perl/ch-2.pl
@@ -0,0 +1,44 @@
+#!/usr/bin/env perl
+#
+#       The Weekly Challenge - Perl & Raku
+#       (https://theweeklychallenge.org)
+#
+#       Challenge 208 Task 2: Duplicate and Missing
+#
+#       Perl solution by Matthias Muth.
+#
+
+use strict;
+use warnings;
+
+use List::Util qw( reduce );
+
+sub dup_and_missing {
+    my ( $dup, $missing );
+    reduce {
+        $dup     = $b     if $a == $b;
+        $missing = $b - 1 if $a < $b - 1;
+        $b;
+    } @_;
+    return
+        defined $dup
+        ? ( $dup, $missing // ( $_[-1] + 1 ) )
+        : -1;
+}
+
+use Test::More;
+
+do {
+    is_deeply [ dup_and_missing( @{$_->{INPUT}} ) ], $_->{EXPECTED},
+        "dup_and_missing(" . join( ",", @{$_->{INPUT}} ) . ") == "
+        . ( @{$_->{EXPECTED}} > 1
+            ? ( "(" . join( ",", @{$_->{EXPECTED}} ) . ")" )
+            : $_->{EXPECTED}->[0] );
+} for (
+    { INPUT => [ 1,2,2,4 ], EXPECTED => [ 2,3 ] },
+    { INPUT => [ 1,2,3,4 ], EXPECTED => [ -1 ]},
+    { INPUT => [ 1,2,3,3 ], EXPECTED => [ 3,4 ] },
+    { INPUT => [ 11,12,12,13,15,16,17 ], EXPECTED => [ 12,14 ] },
+);
+
+done_testing;