solutions for challenge 077

5 files changed, 125 insertions, 0 deletions

diff --git a/challenge-077/adam-russell/blog.txt b/challenge-077/adam-russell/blog.txt
index e69de29bb2..12184efc93 100644
--- a/challenge-077/adam-russell/blog.txt
+++ b/challenge-077/adam-russell/blog.txt
@@ -0,0 +1 @@
+http://www.rabbitfarm.com/cgi-bin/blosxom/2020/09/13#pwc077
diff --git a/challenge-077/adam-russell/perl/ch-1.pl b/challenge-077/adam-russell/perl/ch-1.pl
index e69de29bb2..de9eee9cd1 100644
--- a/challenge-077/adam-russell/perl/ch-1.pl
+++ b/challenge-077/adam-russell/perl/ch-1.pl
@@ -0,0 +1,45 @@
+use strict;
+use warnings;
+##
+# You are given a positive integer $N.
+# Write a script to find out all possible combination 
+# of Fibonacci Numbers required to get $N on addition.
+# Repeated numbers are not allowed. Print 0 if none found.
+##
+sub nearest_fibonacci{
+    my($n) = @_;
+    my @f = (1, 1);
+    while($f[@f - 1] <= $n){
+        my $f = $f[@f - 1] + $f[@f - 2];
+        push @f, $f;
+    }
+    pop @f;
+    return @f;
+}
+
+sub fibonacci_sum{
+    my($n, $fibonacci) = @_;
+    my @sum_terms;
+    my $number_terms = @{$fibonacci}; 
+    for my $i (0 .. (2**$number_terms - 1)){
+        my $b = sprintf("%0" . $number_terms . "b", $i); 
+        my @b = split(//, $b);
+        my @f;
+        for my $i (0 .. (@b - 1)){
+            push @f, $fibonacci->[$i] if $b[$i] == 1;
+        }
+        my $sum = unpack("%32I*", pack("I*", @f)); 
+        push @sum_terms, \@f if $sum == $n;
+    }
+    return @sum_terms;
+}
+
+MAIN:{
+    my $n = $ARGV[0];
+    my @f = nearest_fibonacci($n);
+    my @sum_terms = fibonacci_sum($n, \@f);
+    print "No Fibonacci Terms sum to $n.\n" if !@sum_terms;
+    for my $term (@sum_terms){
+        print join(" + ", @{$term}) . " = $n\n";
+    }
+}
\ No newline at end of file
diff --git a/challenge-077/adam-russell/perl/ch-2.pl b/challenge-077/adam-russell/perl/ch-2.pl
index e69de29bb2..d5103086ef 100644
--- a/challenge-077/adam-russell/perl/ch-2.pl
+++ b/challenge-077/adam-russell/perl/ch-2.pl
@@ -0,0 +1,79 @@
+use strict;
+use warnings;
+##
+# You are given m x n character matrix consists of O and X only.
+# Write a script to count the total number of X surrounded by O only. 
+# Print 0 if none found.
+## 
+use boolean;
+use Lingua::EN::Numbers::Ordinate;
+
+use Data::Dump q/pp/;
+
+my $test0 = [["O", "O", "X"], ["X", "O", "O"], ["X", "O", "O"]];
+my $test1 = [["O", "O", "X", "O"], ["X", "O", "O", "O"], ["X", "O", "O", "X"], ["O", "X", "O", "O"]];
+
+sub check_x{
+    my($i, $matrix) = @_;
+    my @indices = (
+        ##
+        # For any X we have a maximum of eight places to check
+        # which are labelled A, B, C, D, E, F, G, and H.
+        #  A B C
+        #  D X E
+        #  F G H
+        ##
+        [$i->[0] - 1, $i->[1] - 1], #A
+        [$i->[0] - 1, $i->[1]],     #B
+        [$i->[0] - 1, $i->[1] + 1], #C
+        [$i->[0], $i->[1] - 1],     #D
+        [$i->[0], $i->[1] + 1],     #E
+        [$i->[0] + 1, $i->[1] - 1], #F
+        [$i->[0] + 1, $i->[1]],     #G
+        [$i->[0] + 1, $i->[1] + 1]  #H
+    );
+    for my $check (@indices){
+        next if($check->[0] < 0 || $check->[1] < 0);# ignore any impossible (negative index) locations
+        next if($check->[0] >= @{$matrix} || $check->[1] >= @{$matrix->[0]});# ignore any impossible (row or column index out of bounds) locations
+        return false if($matrix->[$check->[0]]->[$check->[1]] eq "X");
+    }
+    return true;
+}
+
+sub x_search{
+    my($matrix) = @_;
+    my @x;
+    my $row_index = -1;
+    for my $row (0 .. (@{$matrix} - 1)){
+        $row_index++;
+        my $column_index = 0;
+        for my $column (0 .. (@{$matrix->[$row_index]} - 1)){
+            if($matrix->[$row]->[$column] eq "X"){
+                push @x, [$row, $column] if(check_x([$row, $column], $matrix));
+            }
+        }
+    }
+    return @x;
+}
+
+MAIN:{
+    my @x = x_search($test0);
+    for my $row (@{$test0}){
+        for my $column (@{$row}){
+            print "$column ";
+        }
+        print "\n";
+    }
+    print "1 X found at Row " . ($x[0]->[0] + 1) . " Column " . ($x[0]->[1] + 1) . ".\n";
+    print "\n";
+    @x = x_search($test1);
+    for my $row (@{$test1}){
+        for my $column (@{$row}){
+            print "$column ";
+        }
+        print "\n";
+    }
+    for my $i (0 .. (@x - 1)){
+        print ordinate($i+1) . " X found at Row " . ($x[$i]->[0] + 1) . " Column " . ($x[$i]->[1] + 1) . ".\n";
+    }
+}
\ No newline at end of file
diff --git a/challenge-077/adam-russell/prolog/ch-1.p b/challenge-077/adam-russell/prolog/ch-1.p
deleted file mode 100644
index e69de29bb2..0000000000
--- a/challenge-077/adam-russell/prolog/ch-1.p
+++ /dev/null
diff --git a/challenge-077/adam-russell/prolog/ch-2.p b/challenge-077/adam-russell/prolog/ch-2.p
deleted file mode 100644
index e69de29bb2..0000000000
--- a/challenge-077/adam-russell/prolog/ch-2.p
+++ /dev/null