Merge pull request #9854 from choroba/ech263

Add solutions to 263: Target Index & Merge Items by E. Choroba

2 files changed, 92 insertions, 0 deletions

diff --git a/challenge-263/e-choroba/perl/ch-1.pl b/challenge-263/e-choroba/perl/ch-1.pl
new file mode 100755
index 0000000000..00a96e9263
--- /dev/null
+++ b/challenge-263/e-choroba/perl/ch-1.pl
@@ -0,0 +1,62 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use experimental qw( signatures );
+
+sub target_index_naive($target, @ints) {
+    my @sorted = sort { $a <=> $b } @ints;
+    return grep $sorted[$_] == $target, 0 .. $#sorted
+}
+
+sub target_index_binsearch($target, @ints) {
+    my @sorted = sort { $a <=> $b } @ints;
+    my ($left, $right) = (0, $#sorted);
+    while ($left < $right - 1) {
+        my $middle = int(($left + $right) / 2);
+        if ($sorted[$middle] < $target) {
+            $left = $middle;
+        } else {
+            $right = $middle;
+        }
+    }
+    my $i = $sorted[$left] == $target ? $left : $right;
+    return unless $sorted[$i] == $target;  # Not found.
+
+    my $from = $i;
+    --$from while $sorted[$from] == $target;
+
+    my $to = $i;
+    ++$to while $sorted[$to] == $target;
+
+    return $from + 1 .. $to - 1
+}
+
+
+use Test2::V0;
+plan 2 * 3 + 1;
+
+for my $target_index (
+    *target_index_naive{CODE},
+    *target_index_binsearch{CODE}
+) {
+    is [$target_index->(2, 1, 5, 3, 2, 4, 2)], [1, 2], 'Example 1';
+    is [$target_index->(6, 1, 2, 4, 3, 5)], [], 'Example 2';
+    is [$target_index->(4, 5, 3, 2, 4, 2, 1)], [4], 'Example 3';
+}
+srand;
+my @large = map int rand 1000, 0 .. 2000;
+my $target = 123;
+is  [target_index_binsearch($target, @large)],
+    [target_index_naive($target, @large)],
+    'same';
+
+use Benchmark qw{ cmpthese };
+cmpthese(-3, {
+    naive     => sub { target_index_naive($target, @large) },
+    binsearch => sub { target_index_binsearch($target, @large) },
+});
+
+__END__
+            Rate     naive binsearch
+naive     2021/s        --      -26%
+binsearch 2728/s       35%        --
diff --git a/challenge-263/e-choroba/perl/ch-2.pl b/challenge-263/e-choroba/perl/ch-2.pl
new file mode 100755
index 0000000000..83e49825a2
--- /dev/null
+++ b/challenge-263/e-choroba/perl/ch-2.pl
@@ -0,0 +1,30 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use experimental qw( signatures );
+
+sub merge_items($items1, $items2) {
+    my %merge;
+    for my $tuple (@$items1, @$items2) {
+        $merge{ $tuple->[0] } += $tuple->[1];
+    }
+    return [map [$_ => $merge{$_}], keys %merge]
+}
+
+use Test2::V0;
+plan 3;
+
+is merge_items([[1, 1], [2, 1], [3, 2]],
+               [[2, 2], [1, 3]]),
+    bag { item $_ for [1, 4], [2, 3], [3, 2] },
+    'Example 1';
+
+like merge_items([[1, 2], [2, 3], [1, 3], [3, 2] ],
+                 [[3, 1], [1, 3] ]),
+    bag { item $_ for [1, 8], [2, 3], [3, 3] },
+    'Example 2';
+
+is merge_items([[1, 1], [2, 2], [3, 3]],
+               [[2, 3], [2, 4]]),
+    bag { item $_ for [1, 1], [2, 9], [3, 3] },
+    'Example 3';