1st commit on 100_perl

2 files changed, 52 insertions, 0 deletions

diff --git a/challenge-100/stuart-little/perl/ch-1.pl b/challenge-100/stuart-little/perl/ch-1.pl
new file mode 100755
index 0000000000..9a83d2dc3f
--- /dev/null
+++ b/challenge-100/stuart-little/perl/ch-1.pl
@@ -0,0 +1,22 @@
+#!/usr/bin/perl
+use warnings;
+use v5.12;
+
+# run <script> <time in format hh:mm[am/pm]; 'am' or 'pm' can be capitalized or surrounded by spaces> 
+
+use feature qw(signatures);
+no warnings qw(experimental::signatures);
+use List::MoreUtils qw(any);
+
+sub convTime ($time) {
+    $time =~ m/(\d+)\:(\d+)(.*)/;
+    my ($h,$m) = ($1,$2);
+    my $mode = $3;
+    (index(lc $mode, "am") != -1) && return qq|${\ do {sprintf("%02d", $h % 12)}}:$m|;
+    (index(lc $mode, "pm") != -1) && return qq|${\ do {sprintf("%02d", ($h % 12) + 12)}}:$m|;
+    my $mer = (any {$_ == $h} (0..11)) ? (" am") : (" pm");
+    my $modh = (any {$_ == $h} (1..12)) ? ($h) : (($h-12) % 24);  
+    return qq|${\ do {sprintf("%02d", $modh)}}:$m$mer|;    
+}
+
+say convTime(join "", @ARGV);
diff --git a/challenge-100/stuart-little/perl/ch-2.pl b/challenge-100/stuart-little/perl/ch-2.pl
new file mode 100755
index 0000000000..958c998619
--- /dev/null
+++ b/challenge-100/stuart-little/perl/ch-2.pl
@@ -0,0 +1,30 @@
+#!/usr/bin/perl
+use warnings;
+use v5.12;
+
+# run <script> <space-separated array entries, right-to-left and top-to-bottom>
+
+use feature qw(signatures);
+no warnings qw(experimental::signatures);
+use List::AllUtils qw(min zip_by);
+
+sub mins($ar) {
+    my @mins = ($ar->[0], (map {min $ar->[$_], $ar->[$_+1]} (0..(scalar @{$ar}-2))), $ar->[-1]);
+    return \@mins;
+}
+
+sub redStep($sm,$bg) {
+    my $size=scalar @{$sm};
+    my @zipped = zip_by {$_[0] + $_[1]} mins($sm), [$bg->@[0..$size]];
+    return [@zipped, $bg->@[$size+1..scalar @{$bg}-1]];
+}
+
+my $sm = [@ARGV[0,]];
+my $bg = [@ARGV[1..$#ARGV]];
+while ((scalar @$bg) > (my $size=scalar @$sm)) {
+    my $processed = redStep($sm,$bg);
+    $sm = [$processed->@[0..$size]];
+    $bg = [$processed->@[$size+1..scalar @{$processed}-1]];
+}
+
+say min @$sm;