Merge pull request #2233 from jacoby/master

77 and I think 76?

2 files changed, 134 insertions, 0 deletions

diff --git a/challenge-077/dave-jacoby/perl/ch-1.pl b/challenge-077/dave-jacoby/perl/ch-1.pl
new file mode 100755
index 0000000000..6dc2865d99
--- /dev/null
+++ b/challenge-077/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,63 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ say signatures state };
+no warnings qw{ experimental };
+
+use Carp;
+use Getopt::Long;
+use List::Util qw{ max sum0 uniq };
+
+my $n = 9;
+GetOptions( 'n=i' => \$n );
+croak "n < 1" if $n < 1;
+
+fib_sum($n);
+
+#
+sub fib_sum ( $n ) {
+    my @fib = reverse fib_list($n);
+    my @list = ( [] );
+    my @sums;
+    my %no;
+
+    while (@list) {
+        my $entry = shift @list;
+        for my $fib (@fib) {
+            next if grep { $_ == $fib } $entry->@*;
+            my $new->@* = sort { $b <=> $a } $fib, $entry->@*;
+            my $sum = sum0 $new->@*;
+            my $join = join ',', $new->@*;
+            next if $no{$join}++;
+            push @list, $new if $sum < $n;
+            push @sums, $new if $sum == $n;
+        }
+    }
+
+    if ( scalar @sums ) {
+        for my $sum (@sums) {
+            my $s = scalar $sum->@*;
+            my $p = join ' + ', $sum->@*;
+            say qq{$s as ($n = $p)};
+        }
+    }
+    else { print 0 }
+}
+
+# creates a list of fibonacci values where each value is
+# less than n and greater than zero, because zero is useless
+# in summation
+sub fib_list( $n ) {
+    my @output = ( 0, 1 );
+    my $i = 2;
+
+    while ( max(@output) < $n ) {
+        $output[$i] = $output[ $i - 1 ] + $output[ $i - 2 ];
+        my $max = max(@output);
+        $i++;
+    }
+
+    @output = uniq grep { $_ } grep { $_ <= $n } @output;
+    return @output;
+}
diff --git a/challenge-077/dave-jacoby/perl/ch-2.pl b/challenge-077/dave-jacoby/perl/ch-2.pl
new file mode 100755
index 0000000000..f35435cb75
--- /dev/null
+++ b/challenge-077/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,71 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ say signatures state };
+no warnings qw{ experimental };
+
+use List::Util qw{ first };
+
+my @input = (
+    [ [qw[ O O X ]], [qw[ X O O ]], [qw[ X O O ]], ],
+    [ [qw( O O X O)], [qw( X O O O)], [qw( X O O X)], [qw( O X O O)], ]
+);
+
+for my $input (@input) {
+    say join "\n    ", '', map { join ' ', $_->@* } $input->@*;
+    say '';
+
+    my $c = lonely_x($input);
+    if    ( $c == 0 ) { say "No lonely Xs were found" }
+    elsif ( $c == 1 ) { say "One lonely X was found" }
+    else              { say "$c lonely Xs were found" }
+}
+
+# lonely_x takes an arrayref containing a two-dimensional array
+# representing an m x n matrix containing only X and O, and
+# returns a count of "lonely Xs", which are Xs without an
+# X in a bordering position. If none are found, it returns
+# zero
+
+sub lonely_x ( $input ) {
+
+    my $c = 0;
+    my $x = scalar $input->@*;
+    my $y = scalar $input->[0]->@*;
+
+    # X and y are the outer bounds of the matrix. 
+    # i and j are the location within the matrix.
+    # p is the value in the current "center".
+    # ii and jj are the bordering locations to i and j
+    # pp is the value in the current border location
+
+    # if pp is X, we know that i,j is not lonely,
+    # and thus we used he named next to get to the 
+    # next. If, instead, we get to the end of the ii,jj
+    # loops, it must be lonely and we increment our 
+    # "lonely X" count.
+
+    for my $i ( 0 .. $x ) {
+    OUT: for my $j ( 0 .. $y ) {
+            my $p = $input->[$i][$j];
+            next unless defined $p;
+            my $ok = 'X' eq $p ? 1 : 0;
+            next unless $ok;
+
+            for my $ii ( $i - 1 .. $i + 1 ) {
+                next if $ii < 0;
+                for my $jj ( $j - 1 .. $j + 1 ) {
+                    next if $jj < 0;
+                    next if $i == $ii && $j == $jj;
+                    my $pp = $input->[$ii][$jj];
+                    next unless defined $pp;
+                    next OUT if $pp eq 'X';
+                }
+            }
+            $c++;
+        }
+    }
+
+    return $c;
+}