Add solutions to 214: Rank Score & Collect Points by E. Choroba

2 files changed, 88 insertions, 0 deletions

diff --git a/challenge-214/e-choroba/perl/ch-1.pl b/challenge-214/e-choroba/perl/ch-1.pl
new file mode 100755
index 0000000000..385e2ba1cf
--- /dev/null
+++ b/challenge-214/e-choroba/perl/ch-1.pl
@@ -0,0 +1,49 @@
+#! /usr/bin/perl
+use warnings;
+use strict;
+use experimental qw( signatures );
+
+{   my @MEDALS = qw( G S B );
+
+    sub rank_score(@scores) {
+        my %uniq;
+        @uniq{ sort { $a <=> $b } @scores } = reverse 0 .. $#scores;
+        return [map $MEDALS[$_] // 1 + $_, map $uniq{$_}, @scores]
+    }
+
+    sub rank_score_naive(@scores) {
+        return [
+            map $MEDALS[$_] // 1 + $_,
+            map {
+                my $s = $_;
+                scalar grep $s < $_, @scores
+            } @scores
+        ]
+    }
+}
+
+
+use Test2::V0;
+plan 2 * 4 + 1;
+
+for my $rank_score (*rank_score_naive{CODE}, *rank_score{CODE}) {
+    is $rank_score->(1, 2, 4, 3, 5), [qw[ 5 4 S B G ]], 'Example 1';
+    is $rank_score->(8, 5, 6, 7, 4), [qw[ G 4 B S 5 ]], 'Example 2';
+    is $rank_score->(3, 5, 4, 2), [qw[ B G S 4 ]], 'Example 3';
+    is $rank_score->(2, 5, 2, 1, 7, 5, 1), [qw[ 4 S 4 6 G S 6 ]], 'Example 4';
+}
+
+
+my @arr = map int rand 20, 1 .. 100;
+is rank_score_naive(@arr), rank_score(@arr), 'same';
+
+use Benchmark qw{ cmpthese };
+cmpthese(-3, {
+    naive     => sub { rank_score_naive(@arr) },
+    optimised => sub { rank_score(@arr) },
+});
+
+__END__
+             Rate     naive optimised
+naive      2214/s        --      -89%
+optimised 20641/s      832%        --
diff --git a/challenge-214/e-choroba/perl/ch-2.pl b/challenge-214/e-choroba/perl/ch-2.pl
new file mode 100755
index 0000000000..a057ae0dab
--- /dev/null
+++ b/challenge-214/e-choroba/perl/ch-2.pl
@@ -0,0 +1,39 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use experimental qw( signatures );
+
+use List::Util qw{ max };
+
+
+sub collect_points(@list) {
+    return max(_collect_points(@list))
+}
+
+sub _collect_points(@list) {
+    return scalar @list if 1 >= @list;
+
+    my %scores;
+    my $pos = 0;
+    while ($pos <= $#list) {
+        my $next = $pos;
+        ++$next while $next < $#list && $list[ $next + 1 ] == $list[$pos];
+
+        my @rest = _collect_points(@list[0 .. $pos - 1, $next + 1 .. $#list]);
+        my $length = 1 + $next - $pos;
+        @scores{ map $length * $length + $_, @rest } = ();
+        $pos = $next + 1;
+    }
+    return keys %scores
+}
+
+
+use Test::More tests => 4 + 2;
+
+is collect_points(2, 4, 3, 3, 3, 4, 5, 4, 2), 23, 'Example 1';
+is collect_points(1, 2, 2, 2, 2, 1), 20, 'Example 2';
+is collect_points(1), 1, 'Example 3';
+is collect_points(2, 2, 2, 1, 1, 2, 2, 2), 40, 'Example 4';
+
+is collect_points(1, 2), 2, 'Simple 2';
+is collect_points(1, 1), 4, 'Simple 4';