Merge pull request #3467 from choroba/ech098

Add solutions to 098: Read N Characters & Search Insert Position

2 files changed, 118 insertions, 0 deletions

diff --git a/challenge-098/e-choroba/perl/ch-1.pl b/challenge-098/e-choroba/perl/ch-1.pl
new file mode 100755
index 0000000000..ddf9ab1e41
--- /dev/null
+++ b/challenge-098/e-choroba/perl/ch-1.pl
@@ -0,0 +1,47 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use utf8;
+
+=head1 098/1
+
+This is very unusual. What should happen if we refer to the same file
+in a different way, e.g. C<file.txt> versus C<./file.txt>? Creating an
+object for each file would have made more sense.
+
+=cut
+
+{   my %fh;
+    sub readN {
+        my ($file, $chars) = @_;
+        unless (exists $fh{$file}) {
+            open $fh{$file}, '<:encoding(UTF-8)', $file;
+        }
+        read $fh{$file}, my ($buffer), $chars;
+        return $buffer
+    }
+}
+
+use Test::More tests => 6;
+
+{   my $FILE = 'input.txt';
+    open my $out, '>', $FILE or die $!;
+    print {$out} '1234567890';
+    close $out;
+
+    is readN($FILE, 4), '1234';
+    is readN($FILE, 4), '5678';
+    is readN($FILE, 4), '90';
+
+    unlink $FILE;
+}
+{   my $FILE = 'utf8.txt';
+    open my $out, '>:encoding(UTF-8)', $FILE or die $!;
+    print {$out} 'žluťoučký kůň';
+    close $out;
+
+    is readN($FILE,  1), 'ž', 'utf-8';
+    is readN($FILE, 12), 'luťoučký kůň', 'utf-8';
+    is readN($FILE,  1), "", 'eof';
+    unlink $FILE;
+}
diff --git a/challenge-098/e-choroba/perl/ch-2.pl b/challenge-098/e-choroba/perl/ch-2.pl
new file mode 100755
index 0000000000..6888476ce2
--- /dev/null
+++ b/challenge-098/e-choroba/perl/ch-2.pl
@@ -0,0 +1,71 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+=head1 Search Insert Position
+
+For larger arrays, binary search is much faster.
+
+=cut
+
+sub loop {
+    my ($array, $value) = @_;
+    my $i = 0;
+    ++$i until $i > $#$array || $array->[$i] >= $value;
+
+    splice @$array, $i, 0, $value
+        unless $i <= $#$array && $array->[$i] == $value;
+    return $i
+}
+
+sub binary_search {
+    my ($array, $value) = @_;
+    my ($from, $to) = (0, $#$array);
+    while ($from != $to) {
+        my $middle = int(($from + $to) / 2);
+        if (($array->[$middle] // $value) >= $value) {
+            $to = $middle;
+        } else {
+            $from = $from == $middle ? $to : $middle;
+        }
+    }
+    ++$from if @$array && $value > $array->[-1];
+
+    splice @$array, $from, 0, $value
+        unless $from <= $#$array && $array->[$from] == $value;
+    return $from
+}
+
+use Test::More tests => 60;
+
+sub test {
+    my ($value, $before, $after, $index, $name) = @_;
+    my $before_clone = [@$before];
+    is loop($before, $value), $index, "$name index loop";
+    is binary_search($before_clone, $value), $index, "$name index binary";
+    is_deeply $before, $after, "$name array loop";
+    is_deeply $before_clone, $after, "$name array binary";
+}
+
+test(3, [1, 2, 3, 4], [1, 2, 3, 4], 2, 'Example 1');
+test(6, [1, 3, 5, 7], [1, 3, 5, 6, 7], 3, 'Example 2');
+test(10, [12, 14, 16, 18], [10, 12, 14, 16, 18], 0, 'Example 3');
+test(19, [11, 13, 15, 17], [11, 13, 15, 17, 19], 4, 'Example 4');
+
+test(1, [1 .. 10], [1 .. 10], 0, 'Find start');
+test(10, [1 .. 10], [1 .. 10], 9, 'Find end');
+test(1, [], [1], 0, 'Empty');
+test(3, [3], [3], 0, 'Find single');
+test(1, [2], [1, 2], 0, 'Prepend single');
+test(3, [2], [2, 3], 1, 'Append single');
+test(1, [1, 2], [1, 2], 0, 'Find pair left');
+test(2, [1, 2], [1, 2], 1, 'Find pair right');
+test(2, [1, 3], [1, 2, 3], 1, 'Insert pair');
+test(0, [1, 2], [0, 1, 2], 0, 'Prepend pair');
+test(3, [1, 2], [1, 2, 3], 2, 'Append pair');
+
+use Benchmark qw{ cmpthese };
+cmpthese(-3, {
+    loop   => sub { loop(         my $arr = [1 .. 1000], 500) },
+    binary => sub { binary_search(my $arr = [1 .. 1000], 500) },
+});