Merge pull request #7580 from jacoby/master

#204 DAJ

2 files changed, 94 insertions, 0 deletions

diff --git a/challenge-204/dave-jacoby/perl/ch-1.pl b/challenge-204/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..9d60fba5b3
--- /dev/null
+++ b/challenge-204/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,51 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say postderef signatures state };
+
+my @examples = (
+
+    [ 1, 2, 2, 3 ],
+    [ 1, 3, 2 ],
+    [ 6, 5, 5, 4 ],
+    [ map { 7 } 1 .. 6 ],
+);
+
+for my $e (@examples) {
+    my $list = join ',', $e->@*;
+    my $out  = monotonic( $e->@* );
+    say <<"END";
+    Input:  \@array = ($list)
+    Output: $out
+END
+}
+
+# Monotone increasing: for i <= j , nums[i] <= nums[j]
+# Monotone decreasing: for i <= j , nums[i] >= nums[j]
+
+# first pass I wrote, I made it so that i was less than j by 1,
+# not all indexes less than j. (In my code, I reverse i and j
+# because I always use i for index of the main loop)
+
+# So, we test to see if there's been both increasing and decreasing.
+# The "spaceship" operator is most often used in sorting numeric
+# values, which will give us a 1 if the first value is larger
+# than the second, -1 if the opposite, and 0 if they're the same.
+# We watch for increasing and decreasing, and if we get values
+# for both, we return 0. At the end, if we don't find non-monotonic
+# values, we return 1.
+
+sub monotonic (@array) {
+    my $increasing = 0;
+    my $decreasing = 0;
+    for my $i ( 1 .. -1 + scalar @array ) {
+        for my $j ( 0 .. -1 + $i ) {
+            my $k = $array[$j] <=> $array[$i];
+            $decreasing++ if $k == -1;
+            $increasing++ if $k == 1;
+            return 0      if $decreasing && $increasing;
+        }
+    }
+    return 1;
+}
diff --git a/challenge-204/dave-jacoby/perl/ch-2.pl b/challenge-204/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..f86e879bed
--- /dev/null
+++ b/challenge-204/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,43 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say postderef signatures state };
+
+use JSON;
+my $json = JSON->new->space_after;
+
+my @examples = (
+
+    { r => 1, c => 4, matrix => [ [ 1, 2 ], [ 3, 4 ] ] },
+    { r => 3, c => 2, matrix => [ [ 1, 2, 3 ], [ 4, 5, 6 ] ] },
+    { r => 3, c => 2, matrix => [ [ 1, 2 ] ] },
+);
+
+for my $e (@examples) {
+    my ( $r, $c, $matrix ) = map { $e->{$_} } qw{r c matrix};
+    my $mj = $json->encode( $matrix );
+    my $o = reshape_matrix( $r, $c, $matrix );
+    my $j = $json->encode($o);
+    say <<"END";
+    Input:  \$matrix = $mj
+            \$r = $r
+            \$c = $c
+    Output: $j
+END
+}
+
+sub reshape_matrix ( $rows, $columns, $matrix ) {
+    my $output;
+    my @array = map { $_->@* } $matrix->@*; # flatten matrix to array
+    my $x     = scalar @array;
+    my $y     = $rows * $columns;
+    return 0 if $x != $y;
+    for my $i ( map { $_ - 1 } 1 .. $rows ) {
+        for my $j ( map { $_ - 1 } 1 .. $columns ) {
+            my $k = shift @array;
+            $output->[$i][$j] = $k;
+        }
+    }
+    return $output;
+}