Solutions to challenge 214

2 files changed, 181 insertions, 0 deletions

diff --git a/challenge-214/jo-37/perl/ch-1.pl b/challenge-214/jo-37/perl/ch-1.pl
new file mode 100755
index 0000000000..c64b9ee1e7
--- /dev/null
+++ b/challenge-214/jo-37/perl/ch-1.pl
@@ -0,0 +1,83 @@
+#!/usr/bin/perl -s
+
+use v5.24;
+use autodie;
+use Test2::V0;
+use List::UtilsBy 'sort_by';
+
+our ($tests, $examples, $verbose);
+
+{
+    # Import the solution from week #9.
+    package CH_009;
+
+    # Without arguments, the called programm will die with a usage
+    # message.  Capture this message as success indicator.
+    local @ARGV;
+    do "../../../challenge-009/jo-37/perl/ch-2.pl";
+    die $@ unless $@ =~ /^usage: $0/;
+}
+
+run_tests() if $tests || $examples;	# does not return
+
+die <<EOS unless @ARGV;
+usage: $0 [-examples] [-tests] [N...]
+
+-examples
+    run the examples from the challenge
+ 
+-tests
+    run some tests
+
+N...
+    list of scores
+
+EOS
+
+
+### Input and Output
+
+say "(@{rank(@ARGV)})";
+
+
+### Implementation
+
+# Ranking was already done in week #9.  Reusing that implementation.
+# All it needs is a wrapper that prepares the subroutine arguments and
+# rearranges the result:
+# - expected input:
+#   * rank type (standard)
+#   * array of hashes containing an id and a score
+# - provided output:
+#   * array of hashes containing id, score and rank.
+# Using a running number as id, sort the result by id, pick the rank and
+# translate the first three ranks to gold, silver and bronze.
+sub rank {
+    my $id = 0;
+    [map $_->{rank} =~ s/^([123])$/(qw(G S B))[$1 - 1]/er,
+        sort_by {$_->{id}}
+        CH_009::rank(
+            CH_009->R_STD,
+            map +{id => $id++, score => $_}, @_
+        )->@*];
+}
+
+### Examples and tests
+
+sub run_tests {
+    SKIP: {
+        skip "examples" unless $examples;
+        
+        is rank(1,2,4,3,5),     [qw(5 4 S B G)],     'example 1';
+        is rank(8,5,6,7,4),     [qw(G 4 B S 5)],     'example 2';
+        is rank(3,5,4,2),       [qw(B G S 4)],       'example 3';
+        is rank(2,5,2,1,7,5,1), [qw(4 S 4 6 G S 6)], 'example 4';
+    }
+
+    SKIP: {
+        skip "tests" unless $tests;
+	}
+
+    done_testing;
+    exit;
+}
diff --git a/challenge-214/jo-37/perl/ch-2.pl b/challenge-214/jo-37/perl/ch-2.pl
new file mode 100755
index 0000000000..03ed8f137c
--- /dev/null
+++ b/challenge-214/jo-37/perl/ch-2.pl
@@ -0,0 +1,98 @@
+#!/usr/bin/perl -s
+
+use v5.24;
+use Test2::V0 '!float';
+use PDL 2.017;  # trimmed results from "rle"
+use PDL::NiceSlice;
+use experimental 'signatures';
+
+our ($tests, $examples, $verbose);
+
+run_tests() if $tests || $examples;	# does not return
+
+die <<EOS unless @ARGV;
+usage: $0 [-examples] [-tests] [-verbose] [N...]
+
+-examples
+    run the examples from the challenge
+ 
+-tests
+    run some tests
+
+-verbose
+    show moves
+
+N
+    list of numbers
+
+EOS
+
+
+### Input and Output
+
+main: {
+    my ($moves, $points) = collect_points(long [@ARGV]);
+    if ($verbose) {
+        say "(@ARGV)";
+        say "max points: $points";
+        printf "take (%3\$d)x%2\$d at %1\$d\n", $_->list for $moves->dog;
+    } else {
+        say $points;
+    }
+}
+
+
+### Implementation
+
+# Try all equal and consecutive numbers and find the maximum by
+# recursion into the remaining list.
+
+sub collect_points ($n, $coll=0) {
+    $n->badflag(1);
+    my ($count, $val) = rle $n;
+    # Break recursion on a single value.  Return the final selection as
+    # [[index, length, value]] and the squared length as score.
+    return (
+        long(0, $count(0), $val(0))->reshape(3, 1),
+        $coll + $count(0;-) ** 2
+    ) if $count->dim(0) == 1;
+    # Loop over all equal and consecutive numbers.  The loop variable is
+    # a piddle consisting of the part's offset and length.
+    my $max = 0;
+    my $move;
+    for my $sel (append(0, $count->cumusumover->(0:-2))->glue(1, $count, $val)
+            ->xchg(0, 1)->dog) {
+        my $m = $n->copy;
+        # Set the selection to BAD.
+        $m($sel(0):$sel(0)+$sel(1)-1) .= $m->badvalue;
+        # Recursion with the BAD elements removed.
+        my ($moves, $points) =
+            collect_points($m->where($m->isgood), $coll + $sel(1;-) ** 2);
+        # Record a new maximum along with the moves leading there.
+        ($move, $max) = ($sel->glue(1, $moves), $points) if $points > $max;
+    }
+    # Return the maximum and its moves.
+    ($move, $max);
+}
+
+
+
+### Examples and tests
+
+sub run_tests {
+    SKIP: {
+        skip "examples" unless $examples;
+
+        is collect_points(long(2,4,3,3,3,4,5,4,2)), 23, 'example 1';
+        is collect_points(long(1,2,2,2,2,1)), 20, 'example 2';
+        is collect_points(long([1])), 1, 'example 3';
+        is collect_points(long(2,2,2,1,1,2,2,2)), 40, 'example 4';
+    }
+
+    SKIP: {
+        skip "tests" unless $tests;
+	}
+
+    done_testing;
+    exit;
+}