Merge pull request #7687 from MatthiasMuth/muthm-207

Challenge 207 solutions in Perl by Matthias Muth

4 files changed, 104 insertions, 108 deletions

diff --git a/challenge-207/matthias-muth/README.md b/challenge-207/matthias-muth/README.md
index 45fcced0f0..e2df1b077b 100644
--- a/challenge-207/matthias-muth/README.md
+++ b/challenge-207/matthias-muth/README.md
@@ -1,125 +1,60 @@
-# All the permutations...
-**Challenge 206 solutions in Perl by Matthias Muth**
+# Almost one-liners.
+*Challenge 207 solutions in Perl by Matthias Muth*
 
-## Task 1: Shortest Time
+## Task 1: Keyboard Word
 
-> You are given a list of time points, at least 2, in the 24-hour clock format `HH:MM`.<br/>
-> Write a script to find out the shortest time in minutes between any two time points.
-
-The examples given are important for understanding that the shortest time between two time points might also span midnight.
-That means that if the difference between two points of time is _n_ minutes, the 'shortest' difference may be either _n_ or (1440 - _n_)
-(24 hours being 24 \* 60 = 1440 minutes).
-
-I reduced the problem of finding the shortest time difference between *any two* timepoints to finding the shortest time difference of *one* timepoint with the rest of a list. which results in this function:
-
-```perl
-use List::Utils qw( min );
-
-sub time_diffs( $fixed, @others ) {
-    # Return all differences between one timestamp and a list of others.
-    # Use the time difference spanning over midnight if it is shorter
-    # (by simply using the minimum of both).
-    return
-        map { my $d = abs( $fixed - $others[$_] ); min( $d, (24*60) - $d ); }
-            0..$#others;
-}
-```
-
-Using this function, the rest is straightforward:<br/>
-* Translate HH::MM times into minutes,
-* Find the minimum of each time in the list with the rest of the list, using the above function.
+> 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.
 
+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:
 ```perl
-sub shortest_time( @hhmm_times ) {
-    # Turn HH:MM times into number of minutes.
-    my @t = map { /^(\d+):(\d{2})$/; $1 * 60 + $2 } @hhmm_times;
-
-    # Return the minimum of the time differences of every element with all
-    # its successors. We can skip the last element, as it has no successor to
-    # build a difference with.
-    # We simplify the parameter list by just giving the whole
-    # slice instead of giving the first element and its successors separately.
-    return min( map time_diffs( @t[ $_ .. $#t ] ), 0 .. ( $#t - 1 ) );
-}
+/^( [qwertyuiop]* | [asdfghjkl]* | [zxcvbnm]* )$/xi
 ```
+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.
 
-Passing the parameters for `time_diffs`, I just pass a slice of the array. The first elemenet of the slice will be assigned to `$fixed` in the function, the rest of the parameters will be used for `@others`. I chose this as a compromise between self-explanation in the function and simplicity in the call.
-
-Note that for the last element in the list we don't need to call the function, since there won't be any time difference if we have just one value.
-
-## Task 2: Array Pairings
-
->You are given an array of integers having even number of elements..<br/>
->Write a script to find the maximum sum of the minimum of each pairs.
-
-Ahm, what??<br/>
-Ok, I see. the examples clear it up.<br/>
-Actually we need to walk through all permutations of the given list.
-Then for each permutation we need to use the 'minimum of each pair', sum them up, and then find the maximum of all those sums.
-Ok, understood now.
-
-So let's start by generating the permutations.
-
-Again, there are good recommendations in the [Perl FAQ](https://perldoc.perl.org/perlfaq4#How-do-I-permute-N-elements-of-a-list%3F):
-- Use the `List::Permutor` module on CPAN.
-- If the list is actually an array (which it is in our case), try the `Algorithm::Permute` module (also on CPAN).
-
-In any case, it is recommended to use an iterator to get the next permutation instead of generating all permutations beforehand, as the number of permutations (*n!*) rises very quickly with larger number of elements.
-
-In our case, I did a thorough analysis of the possible set of input data ;-).<br/>
-And as we only will need to solve the problem for two lists of only four elements each, I decided to go with a simple schoolbook recursive generation of the permutations.<br/>
-The result of the function will be a list of arrayrefs, each one representing one permutation. And for symmetry reasoens, and to avoid shuffling values around, I chose to use an arrayref as input parameter, too. 
-
+The function that returns all 'single keyboard row' words from a list then
+actually is a one-liner:
 ```perl
-sub permute( $a_ref ) {
-    return undef  unless defined $a_ref && ref $a_ref eq 'ARRAY';
-    return ()     if @$a_ref == 0;
-    return $a_ref if @$a_ref == 1;
-
-    my @permutations;
-    for my $i ( 0..$#$a_ref ) {
-        my @others = @$a_ref;
-        my $extracted = splice( @others, $i, 1, () );
-        push @permutations, [ $extracted, @$_ ]
-            for permute( [ @others ] );
-    }
-    return @permutations;
+sub keyboard_words {
+    return grep /^( [qwertyuiop]* | [asdfghjkl]* | [zxcvbnm]* )$/xi, @_;
 }
 ```
 
-I have put each of the next two steps into a function of its own.<br/>
-The first one splits the array into pairs and returns the sum on the smaller of the two values in each pair.<br/>
-I am a fan of `map` calls, more efficient and most of the times easier to write than `for` loops.
-My way of splitting up into pairs in a `map` uses the classical `0..$#a` loop values,
-but skipping every other iteration using a `$_ % 2 == 0` criterion with a 0 to add to the sum.
-
-The alternative is to increase the 'loop value' by two for each iteration, but I don't find a nice way to write that.
-(Running through half of the array while doubling the loop variable doesn't look obvious enough for me.)
-
-Actually, the iteration for the last value is not needed, so in fact we use `0..($#a-1)`.
-
+## 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
-use List::Util qw( min max sum );
-
-sub sum_of_min_of_pairs( @a ) {
-    return undef
-        unless @a % 2 == 0;
-    return sum(
-        map $_ % 2 == 0 ? min( $a[$_], $a[ $_ + 1 ] ) : 0, 0..( $#a - 1 )
-    );
+sub h_index {
+    my @sorted = sort { $b <=> $a } @_;
+    return scalar grep $sorted[$_] >= 1 + $_, 0..$#sorted;
 }
 ```
 
-The second function combines the generation of permutations and the `sum_of_min_of_pairs` computation for each of the permutations,
-and returns the challenge result for the input array:
+Ok, **almost** a one-liner...! ;-)
 
-```perl
-sub max_of_sums( @a ) {
-    return undef
-        unless @a % 2 == 0;
-    return
-        max( map sum_of_min_of_pairs( @$_ ), permute( [ @a ] ) );
-}
-```
 
 **Thank you for the challenge!**
+
diff --git a/challenge-207/matthias-muth/blog.txt b/challenge-207/matthias-muth/blog.txt
new file mode 100644
index 0000000000..1bcf9a8e0e
--- /dev/null
+++ b/challenge-207/matthias-muth/blog.txt
@@ -0,0 +1 @@
+https://github.com/MatthiasMuth/perlweeklychallenge-club/tree/muthm-207/challenge-207/matthias-muth#readme
diff --git a/challenge-207/matthias-muth/perl/ch-1.pl b/challenge-207/matthias-muth/perl/ch-1.pl
new file mode 100755
index 0000000000..a91d1a5696
--- /dev/null
+++ b/challenge-207/matthias-muth/perl/ch-1.pl
@@ -0,0 +1,31 @@
+#!/usr/bin/env perl
+#
+#       The Weekly Challenge - Perl & Raku
+#       (https://theweeklychallenge.org)
+#
+#       Challenge 207 Task 1: Keyboard Word
+#
+#       Perl solution by Matthias Muth.
+#
+
+use strict;
+use warnings;
+
+sub keyboard_words {
+    return grep /^( [qwertyuiop]* | [asdfghjkl]* | [zxcvbnm]* )$/xi, @_;
+}
+
+use Test::More;
+
+do {
+    is_deeply
+        [ keyboard_words( @{$_->{INPUT}} ) ], $_->{EXPECTED},
+        "keyboard_words( @{$_->{INPUT}} ) == ( @{$_->{EXPECTED}} )";
+} for (
+    { INPUT    => [ qw( Hello Alaska Dad Peace ) ],
+      EXPECTED => [ qw( Alaska Dad ) ] },
+    { INPUT    => [ "OMG","Bye" ],
+      EXPECTED => [] },
+);
+
+done_testing;
diff --git a/challenge-207/matthias-muth/perl/ch-2.pl b/challenge-207/matthias-muth/perl/ch-2.pl
new file mode 100755
index 0000000000..e52eeb2478
--- /dev/null
+++ b/challenge-207/matthias-muth/perl/ch-2.pl
@@ -0,0 +1,29 @@
+#!/usr/bin/env perl
+#
+#       The Weekly Challenge - Perl & Raku
+#       (https://theweeklychallenge.org)
+#
+#       Challenge 207 Task 2: H-Index
+#
+#       Perl solution by Matthias Muth.
+#
+
+use strict;
+use warnings;
+
+sub h_index {
+    my @sorted = sort { $b <=> $a } @_;
+    return scalar grep $sorted[$_] >= 1 + $_, 0..$#sorted;
+}
+
+use Test::More;
+
+do {
+    is h_index( @{$_->{INPUT}} ), $_->{EXPECTED},
+        "h_index( @{$_->{INPUT}} ) == $_->{EXPECTED}";
+} for (
+    { INPUT => [ 10,8,5,4,3 ], EXPECTED => 4 },
+    { INPUT => [ 25,8,5,3,3 ], EXPECTED => 3 },
+);
+
+done_testing;