Merge pull request #7027 from jo-37/contrib

Solutions to challenge 189

2 files changed, 160 insertions, 0 deletions

diff --git a/challenge-189/jo-37/perl/ch-1.pl b/challenge-189/jo-37/perl/ch-1.pl
new file mode 100755
index 0000000000..1a6bf09e20
--- /dev/null
+++ b/challenge-189/jo-37/perl/ch-1.pl
@@ -0,0 +1,68 @@
+#!/usr/bin/perl -s
+
+use v5.16;
+use Test2::V0;
+use List::Util 'reduce';
+
+our ($tests, $examples, $target);
+
+run_tests() if $tests || $examples;	# does not return
+
+die <<EOS unless $target && @ARGV;
+usage: $0 [-examples] [-tests] [-target=t] [--] [C...]
+
+-examples
+    run the examples from the challenge
+ 
+-tests
+    run some tests
+
+-target=t
+    use t as target character
+
+C...
+    some characters
+
+EOS
+
+
+### Input and Output
+
+say smallest_char($target, @ARGV);
+
+
+### Implementation
+
+# Example 5 contradicts the task's description as 'v' is not contained
+# in the given array.  Implementing according to the example anyways as
+# it is an interesting twist.
+sub smallest_char {
+    my $t = shift;
+    # Select a new candidate if it is larger than the target and smaller
+    # than an existing previous candidate.  Initializing $a with the
+    # target gives the target as result if there is no matching
+    # character in the array.
+	reduce {$b gt $t && ($b lt $a || $a eq $t) ? $b : $a} $t, @_;
+}
+
+
+### Examples and tests
+
+sub run_tests {
+    SKIP: {
+        skip "examples" unless $examples;
+
+        is smallest_char(qw(b e m u g)), 'e', 'Example 1';
+        is smallest_char(qw(a d c e f)), 'c', 'Example 2';
+        is smallest_char(qw(o j a r)),   'r', 'Example 3';
+        is smallest_char(qw(a d c a f)), 'c', 'Example 4';
+        is smallest_char(qw(v t g a l)), 'v', 'Example 5';
+    }
+
+    SKIP: {
+        skip "tests" unless $tests;
+	}
+
+    done_testing;
+    exit;
+}
diff --git a/challenge-189/jo-37/perl/ch-2.pl b/challenge-189/jo-37/perl/ch-2.pl
new file mode 100755
index 0000000000..5948418152
--- /dev/null
+++ b/challenge-189/jo-37/perl/ch-2.pl
@@ -0,0 +1,92 @@
+#!/usr/bin/perl -s
+
+use v5.16;
+use Test2::V0;
+
+our ($tests, $examples);
+
+run_tests() if $tests || $examples;	# does not return
+
+die <<EOS unless @ARGV;
+usage: $0 [-examples] [-tests] [N1 N2...]
+
+-examples
+    run the examples from the challenge
+ 
+-tests
+    run some tests
+
+N1 N2 ...
+    some integer numbers
+
+EOS
+
+
+### Input and Output
+
+main: {
+    local $" = ', ';
+    say "(@{[min_subarr(@ARGV)]})";
+}
+
+
+### Implementation
+
+# Inspired by Colin's solution to task 1 from week 180.
+#
+# The minimum subarray can be detected in a single pass, if the right
+# data is recorded.  For each number in the given array this is:
+# - the number of occurrences
+# - the position of the first occurrence
+# - the position of the last occurrence
+# We found a new candidate for the shortest subarray having the same
+# "degree" as the given whenever the current number's count is larger
+# than the current maximum or the count equals the current maximum but
+# the subarray is shorter.
+
+sub min_subarr {
+	my %stats;
+    # Initialize the minimum.
+    my $min = {cnt => 0};
+    while (my ($i, $n) = each @_) {
+        # Initialize $n's slot if necessary and create a shortcut.
+        my $s = $stats{$n} //= {};
+        # Count occurrences and record the start position.
+        $s->{start} = $i unless $s->{cnt}++;
+        # Record the (current) end position.
+        $s->{end} = $i;
+        # Identify a new minimum candidate.
+        $min = $s if $s->{cnt} > $min->{cnt} ||
+            $s->{cnt} == $min->{cnt} &&
+            $s->{end} - $s->{start} < $min->{end} - $min->{start};
+    }
+
+    # Return the found minimum subarray.
+    @_[$min->{start} .. $min->{end}];
+}
+
+
+### Examples and tests
+
+sub run_tests {
+    SKIP: {
+        skip "examples" unless $examples;
+
+        is [min_subarr(1, 3, 3, 2)], [3, 3], 'Example 1';
+        is [min_subarr(1, 2, 1, 3)], [1, 2, 1], 'Example 2';
+        is [min_subarr(1, 3, 2, 1, 2)], [2, 1, 2], 'Example 3';
+        is [min_subarr(1, 1, 2, 3, 2)], [1, 1], 'Example 4';
+        is [min_subarr(2, 1, 2, 1, 1)], [1, 2, 1, 1], 'Example 5';
+    }
+
+    SKIP: {
+        skip "tests" unless $tests;
+
+        is [min_subarr(1, 1, 1)], [1, 1, 1], 'Full array';
+        is [min_subarr(1, 2, 3, 4, 5, 1)], [1, 2, 3, 4, 5, 1], 'Full array';
+        is [min_subarr(1, 2, 3)], [1], 'Single element';
+	}
+
+    done_testing;
+    exit;
+}