Merge pull request #3481 from ccntrq/challenge-098

Challenge 098

2 files changed, 75 insertions, 0 deletions

diff --git a/challenge-098/alexander-pankoff/perl/ch-1.pl b/challenge-098/alexander-pankoff/perl/ch-1.pl
new file mode 100755
index 0000000000..19294205aa
--- /dev/null
+++ b/challenge-098/alexander-pankoff/perl/ch-1.pl
@@ -0,0 +1,33 @@
+#!/usr/bin/env perl
+use v5.20;
+use utf8;
+use strict;
+use warnings;
+use feature qw(say signatures);
+no warnings 'experimental::signatures';
+
+{
+    my ( $FILE, @numbers ) = @ARGV;
+    say readN( $FILE, $_ ) for @numbers;
+}
+
+sub readN ( $file, $chars ) {
+    state $filehandles = {};
+
+    my $fh;
+    if ( $filehandles->{$file} ) {
+        $fh = $filehandles->{$file};
+    }
+    else {
+        open( $fh, '<', $file );
+        $fh->binmode( ':utf8' );
+        $filehandles->{$file} = $fh;
+    }
+
+    my $out;
+    while ( $chars-- && !$fh->eof ) {
+        $out .= $fh->getc;
+    }
+
+    return $out;
+}
diff --git a/challenge-098/alexander-pankoff/perl/ch-2.pl b/challenge-098/alexander-pankoff/perl/ch-2.pl
new file mode 100755
index 0000000000..6031dfaebf
--- /dev/null
+++ b/challenge-098/alexander-pankoff/perl/ch-2.pl
@@ -0,0 +1,42 @@
+#!/usr/bin/env perl
+use v5.20;
+use utf8;
+use strict;
+use warnings;
+use feature qw(say signatures);
+no warnings 'experimental::signatures';
+
+use List::Util qw(first);
+
+{
+    my @N = @ARGV;
+    my $N = pop @N;
+
+    say join( " ", '@N:', @N );
+    say join( " ", '$N:', $N );
+    my ( $index, @new_N ) = search_insert_position( $N, @N );
+
+    my $human_index = $index + 1;
+
+    say @new_N == @N
+      ? "$human_index since the target $N is in the array at the index $human_index."
+      : "$human_index since the target $N is missing and should be placed at the index $human_index."
+}
+
+sub search_insert_position ( $target, @xs ) {
+    my $index = first_index( sub($x) { $x >= $target }, @xs );
+
+    if ( !$index ) {
+        return ( $#xs + 1, @xs, $target );
+    }
+    elsif ( $xs[$index] && $xs[$index] == $target ) {
+        return ( $index, @xs );
+    }
+    else {
+        return ( $index, @xs[ 0 .. $index - 1 ], $target, @xs[ $index .. $#xs ] );
+    }
+}
+
+sub first_index ( $cond, @xs ) {
+    first { $cond->( $xs[$_] ) } 0 .. $#xs;
+}