Merge pull request #12880 from choroba/ech344

Solve 344: Array Form Compute & Array Formation by E. Choroba

2 files changed, 95 insertions, 0 deletions

diff --git a/challenge-344/e-choroba/perl/ch-1.pl b/challenge-344/e-choroba/perl/ch-1.pl
new file mode 100755
index 0000000000..ab1a636e4b
--- /dev/null
+++ b/challenge-344/e-choroba/perl/ch-1.pl
@@ -0,0 +1,61 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use experimental qw( signatures );
+
+sub array_form_compute($x, @ints) {
+    my $y = join "", @ints;
+    return split //, $x + $y
+}
+
+sub array_form_compute_array($x, @ints) {
+    splice @ints, 0, 0, (0) x (length($x) - @ints) if @ints < length $x;
+    my @x = split //, $x;
+    splice @x, 0, 0, (0) x (@ints - @x) if @x < @ints;
+    for my $i (1 .. @x) {
+        $ints[ -$i ] += $x[ -$i ];
+        if ($i != @x && $ints[ -$i ] > 9) {
+            $ints[ -$i ] -= 10;
+            ++$ints[ -$i - 1 ];
+        }
+    }
+    if ($ints[0] > 9) {
+        $ints[0] -= 10;
+        unshift @ints, 1;
+    }
+    return @ints
+}
+
+use Test2::V0;
+plan(5 * 2 + 100);
+
+for my $array_form_compute (\&array_form_compute, \&array_form_compute_array) {
+    is [$array_form_compute->(12, 1, 2, 3, 4)], [1, 2, 4, 6], 'Example 1';
+    is [$array_form_compute->(181, 2, 7, 4)], [4, 5, 5], 'Example 2';
+    is [$array_form_compute->(1, 9, 9, 9)], [1, 0, 0, 0], 'Example 3';
+    is [$array_form_compute->(9999, 1, 0, 0, 0, 0)], [1, 9, 9, 9, 9],
+        'Example 4';
+    is [$array_form_compute->(1000, 0)], [1, 0, 0, 0], 'Example 5';
+}
+
+for (1 .. 100) {
+    my $x = int rand 10000;
+    my @ints = split //, int rand 10000;
+    warn "$x @ints";
+    is array_form_compute($x, @ints), array_form_compute_array($x, @ints),
+        "Same $x @ints";
+}
+
+use Benchmark qw{ cmpthese };
+my $x = int rand 100_000;
+my @ints = split //, int rand 100_000;
+cmpthese(-3, {
+    plus => sub { array_form_compute($x, @ints) },
+    arr  => sub { array_form_compute_array($x, @ints) }
+});
+
+__END__
+
+         Rate  arr plus
+arr  434213/s   -- -56%
+plus 985269/s 127%   --
diff --git a/challenge-344/e-choroba/perl/ch-2.pl b/challenge-344/e-choroba/perl/ch-2.pl
new file mode 100755
index 0000000000..ff12b2a69d
--- /dev/null
+++ b/challenge-344/e-choroba/perl/ch-2.pl
@@ -0,0 +1,34 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use experimental qw( signatures );
+
+use constant { true => !!1, false => !!0 };
+
+sub array_formation($source, $target) {
+    return true if ! @$source && ! @$target;
+    for my $i (0 .. $#$source) {
+        my $start = $source->[$i];
+        next if grep @$target >= @$start
+             && $target->[$_] != $start->[$_], 0 .. $#$start;
+        return true
+            if @$start <= @$target
+            && array_formation([@$source[grep $_ != $i, 0 .. $#$source]],
+                               [@$target[$#$start + 1 .. $#$target]]);
+    }
+    return false
+}
+
+use Test2::V0;
+plan(5 + 2);
+
+is array_formation([[2,3], [1], [4]], [1, 2, 3, 4]), true, 'Example 1';
+is array_formation([[1,3], [2,4]], [1, 2, 3, 4]), false, 'Example 2';
+is array_formation([[9,1], [5,8], [2]], [5, 8, 2, 9, 1]), true, 'Example 3';
+is array_formation([[1], [3]], [1, 2, 3]), false, 'Example 4';
+is array_formation([[7,4,6]], [7, 4, 6]), true, 'Example 5';
+
+is array_formation([[1,2,3],[4],[5,6],[1,2],[3,4,5]], [1,2,3,4,5,1,2,3,4,5,6]),
+    true, 'Backtracking';
+is array_formation([[1,2,3],[4],[5,6],[1,2],[3,4]], [1,2,3,4,5,6,1,2,3,4,5]),
+    false, 'Backtracking to false';