Merge pull request #2839 from jacoby/master

Challenge 88

2 files changed, 103 insertions, 0 deletions

diff --git a/challenge-088/dave-jacoby/perl/ch-1.pl b/challenge-088/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..87e37c0613
--- /dev/null
+++ b/challenge-088/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,36 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ say signatures state };
+no warnings qw{ experimental };
+
+use JSON;
+use List::Util qw{ product };
+
+my $json = JSON->new;
+my @examples;
+push @examples, [ 5, 2, 1, 4, 3 ];
+push @examples, [ 2, 1, 4, 3 ];
+
+if (@ARGV) {
+    @examples = ();
+    push @examples, [ map { int $_ } @ARGV ];
+}
+
+for my $example (@examples) {
+    my $output->@* = array_of_products($example);
+    say $json->encode($example);
+    say $json->encode($output);
+    say '';
+}
+
+sub array_of_products( $arrayref ) {
+    my $end = -1 + scalar $arrayref->@*;
+    my @output;
+    for my $i ( 0 .. $end ) {
+        push @output,
+            product map { $arrayref->[$_] } grep { $_ != $i } 0 .. $end;
+    }
+    return @output;
+}
diff --git a/challenge-088/dave-jacoby/perl/ch-2.pl b/challenge-088/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..3eb437f1e2
--- /dev/null
+++ b/challenge-088/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,67 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ say signatures state };
+no warnings qw{ experimental };
+
+use JSON;
+my $json = JSON->new->space_after;
+
+my @examples;
+push @examples, [ [ 1, 2, 3 ], [ 4, 5, 6 ], [ 7, 8, 9 ], ];
+
+push @examples,
+    [ [ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ], [ 9, 10, 11, 12 ],
+    [ 13, 14, 15, 16 ], ];
+
+for my $example (@examples) {
+    my $out->@* = spiral_matrix($example);
+    say $json->encode($out);
+    say '';
+}
+
+sub spiral_matrix( $example ) {
+    my @output;
+    my $mask = [];
+    for my $row ( $example->@* ) {
+        push $mask->@*, [ map { 0 } $row->@* ];
+    }
+    my $i = 0;
+    my $x = 0;
+    my $y = 0;
+    my @move;
+    push @move, sub { $y++ };
+    push @move, sub { $x++ };
+    push @move, sub { $y-- };
+    push @move, sub { $x-- };
+    my @back;
+    push @back, sub { $y-- };
+    push @back, sub { $x-- };
+    push @back, sub { $y++ };
+    push @back, sub { $x++ };
+
+    while (1) {
+        push @output, $example->[$x][$y];
+        $mask->[$x][$y] = 1;
+        my $m = $json->encode($mask);
+        my $s = $m =~ /0/ ? 1 : 0;
+        last unless $s;
+        $move[$i]->();
+        if ( !$example->[$x][$y] || $mask->[$x][$y] ) {
+            $back[$i]->();
+            $i = ( $i + 1 ) % 4;
+            $move[$i]->();
+        }
+    }
+    return @output;
+}
+
+sub check_mask( $mask ) {
+    for my $i ( $mask->@* ) {
+        my @z = grep { /0/ } $i->@*;
+        return 0 unless scalar @z;
+    }
+    return 1;
+}
+