Merge pull request #4010 from stuart-little/stuart-little_111_perl

1st commit on 111_perl

2 files changed, 77 insertions, 0 deletions

diff --git a/challenge-111/stuart-little/perl/ch-1.pl b/challenge-111/stuart-little/perl/ch-1.pl
new file mode 100755
index 0000000000..ed5ce9c098
--- /dev/null
+++ b/challenge-111/stuart-little/perl/ch-1.pl
@@ -0,0 +1,33 @@
+#!/usr/bin/perl
+use warnings;
+use v5.12;
+
+# run <script>
+
+use feature qw(signatures);
+no warnings qw(experimental::signatures);
+
+use List::AllUtils qw(bsearchidx reduce);
+
+sub searchMatrix($needle,$mat) {
+    my $flat = reduce {my @a = (@$a, @$b); \@a} @$mat;
+    return ((bsearchidx {$_ - $needle} @$flat) >= 0) ? (1) : (0);
+}
+
+my $ar = [
+    [  1,  2,  3,  5,  7 ],
+    [  9, 11, 15, 19, 20 ],
+    [ 23, 24, 25, 29, 31 ],
+    [ 32, 33, 39, 40, 42 ],
+    [ 45, 47, 48, 49, 50 ],
+    ];
+say "Array:";
+for (@$ar) {
+    say "@$_";
+}
+say "";
+my @toSearch=(1,35,39,100);
+for (@toSearch) {
+    say "Found $_?";
+    say searchMatrix($_,$ar);
+}
diff --git a/challenge-111/stuart-little/perl/ch-2.pl b/challenge-111/stuart-little/perl/ch-2.pl
new file mode 100755
index 0000000000..9f9f24c1fe
--- /dev/null
+++ b/challenge-111/stuart-little/perl/ch-2.pl
@@ -0,0 +1,44 @@
+#!/usr/bin/perl
+use warnings;
+use v5.12;
+
+# run <script> <path-to-dict-file, one word per line>
+
+use feature qw(signatures);
+no warnings qw(experimental::signatures);
+
+use List::AllUtils qw(zip_by all);
+
+sub isSorted($word) {
+    my @word = split //, lc $word;
+    my @wordl=@word[0..(length $word)-2];
+    my @wordr=@word[1..(length $word)-1];
+    my @diffs = zip_by {ord($_[1]) - ord($_[0])} \@wordl, \@wordr;
+    return ((lc $word) =~ /^[a-z]+$/) && (all {$_ >= 0} @diffs);
+}
+
+sub longestWith($list,$pred) {
+    my $length=0;
+    my @res=();
+    for (@$list) {
+	my $l=length($_);
+	next if (! &$pred($_));
+        $l > $length && do {
+	    $length = $l;
+	    @res=($_,);
+	    next;
+	};
+	$l == $length && push @res, $_;
+    }
+    return \@res;
+}
+
+my @words;
+open(my $fh, '<', $ARGV[0]);
+while (<$fh>) {
+    chomp;
+    push @words, $_;
+}
+
+my @res=@{longestWith(\@words,\&isSorted)};
+for (@res) {say};