Merge pull request #2605 from choroba/ech083

Solve 083: Words Length & Flip Array by E. Choroba

2 files changed, 123 insertions, 0 deletions

diff --git a/challenge-083/e-choroba/perl/ch-1.pl b/challenge-083/e-choroba/perl/ch-1.pl
new file mode 100755
index 0000000000..5c08848abc
--- /dev/null
+++ b/challenge-083/e-choroba/perl/ch-1.pl
@@ -0,0 +1,48 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+# Substitution returns the number of substitutions.
+sub words_length_subst {
+    local ($_) = @_;
+    s/^\S+//, s/\S+$//;
+    return s/\S/ /g
+}
+
+# Or remove the words and all whitespace and measure the length.
+sub words_length {
+    local ($_) = @_;
+    s/^\S+//, s/\S+$//, s/ //g;
+    return length
+}
+
+# Transliteration returns the number of replaced chars and is fast.
+sub words_length_trans {
+    local ($_) = @_;
+    s/^\S+//, s/\S+$//;
+    return tr/\t\n\r\f\ck //c
+}
+
+use Test::More tests => 6;
+my %examples = ('The Weekly Challenge'                    => 6,
+                'The purpose of our lives is to be happy' => 23);
+
+for my $sub (\&words_length_subst, \&words_length, \&words_length_trans) {
+    for my $example (keys %examples) {
+        is $sub->($example), $examples{$example};
+    }
+}
+
+use Benchmark qw{ cmpthese };
+my $s = join ' ', map { 'x' x rand 10 } 1 .. 100;
+cmpthese(-3, {
+    subst => sub { words_length_subst($s) },
+    len   => sub { words_length($s) },
+    trans => sub { words_length_trans($s) },
+});
+
+__END__
+          Rate subst   len trans
+subst  12326/s    --  -79%  -90%
+len    59388/s  382%    --  -50%
+trans 119673/s  871%  102%    --
diff --git a/challenge-083/e-choroba/perl/ch-2.pl b/challenge-083/e-choroba/perl/ch-2.pl
new file mode 100755
index 0000000000..2d3ff437da
--- /dev/null
+++ b/challenge-083/e-choroba/perl/ch-2.pl
@@ -0,0 +1,75 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+use List::Util qw{ sum first };
+
+sub flip_array {
+    my @arr = @_;
+    my %best = (flip_tally => 0, sum => sum(@arr));
+    my @signs = (1) x @arr;
+    $signs[-1] = -1;
+  INDICATOR:
+    while (1) {
+        my $sum = sum(map $arr[$_] * $signs[$_], 0 .. $#arr);
+        %best = (flip_tally => scalar(grep $_ == -1, @signs), sum => $sum)
+            if $sum < $best{sum} && $sum > 0;
+        my $last_flip = $#signs;
+
+        while ($signs[$last_flip] == -1) {
+            $signs[$last_flip] = 1;
+            --$last_flip;
+            last INDICATOR if $last_flip < 0;
+        }
+        $signs[$last_flip] = -1;
+    }
+    return $best{flip_tally}
+}
+
+sub flip_array_dp {  # DP stands for Dynamic Programming
+    my @arr = @_;
+    my %sums = (0 => 0);
+    my %best;
+    for my $element (@arr) {
+        my %next;
+        for my $sum (keys %sums) {
+            for my $multiply_add ([1, 0], [-1, 1]) {
+                my $new_sum = $sum + $element * $multiply_add->[0];
+                my $new_flip_tally = $sums{$sum} + $multiply_add->[1];
+                $next{$new_sum} = $new_flip_tally
+                    if ! exists $next{$new_sum}
+                    || $next{$new_sum} > $new_flip_tally;
+            }
+        }
+        %sums = %next;
+    }
+    my $best = first { $_ > 0 } keys %sums;
+    for my $sum (keys %sums) {
+        $best = $sum if $sum > 0 && $sum < $best;
+    }
+    return $sums{$best}
+}
+
+use Test::More tests => 7;
+
+is flip_array(3, 10, 8), 1, 'Example 1';
+is flip_array(12, 2, 10), 1, 'Example 2';
+is flip_array(1 .. 20), 6, 'long';
+# Uncomment if you want to wait for years.
+# is flip_array_dp(1 .. 100), 30, 'very long';
+
+is flip_array_dp(3, 10, 8), 1, 'Example 1';
+is flip_array_dp(12, 2, 10), 1, 'Example 2';
+is flip_array_dp(1 .. 20), 6, 'long';
+is flip_array_dp(1 .. 100), 30, 'very long';
+
+use Benchmark qw{ cmpthese };
+cmpthese(-3, {
+    naive => sub { flip_array(15 .. 30) },
+    dp    => sub { flip_array_dp(15 .. 30) },
+});
+
+__END__
+        Rate naive    dp
+naive 5.18/s    --  -98%
+dp     268/s 5068%    --