Merge pull request #2252 from PerlBoy1967/branch-for-challenge-077

Task 1 and 2

2 files changed, 170 insertions, 0 deletions

diff --git a/challenge-077/perlboy1967/perl/ch-1.pl b/challenge-077/perlboy1967/perl/ch-1.pl
new file mode 100755
index 0000000000..fd40b30d59
--- /dev/null
+++ b/challenge-077/perlboy1967/perl/ch-1.pl
@@ -0,0 +1,85 @@
+#!/usr/bin/perl
+
+# Perl Weekly Challenge - 077
+# - https://perlweeklychallenge.org/blog/perl-weekly-challenge-077/
+#
+# Task 1 - Fibonacci Sum
+#
+# Author: Niels 'PerlBoy' van Dijke
+
+use strict;
+use warnings;
+
+# Unbuffered STDOUT
+$|++;
+
+use Algorithm::Combinatorics qw(combinations);
+use List::Util qw(sum);
+use Memoize;
+
+# Prototypes
+sub fibonacci ($);
+sub getFibonacciNumbersSmallerN ($);
+sub findFibonacciSumSolutions ($\@\@);
+
+memoize('fibonacci');
+
+my ($N) = @ARGV;
+
+die "Input must be integer value and >= 2"
+  unless (defined $N and $N =~ m#^[1-9][0-9]*$# and $N >= 2);
+
+my @solutions;
+
+my @fib = getFibonacciNumbersSmallerN($N);
+findFibonacciSumSolutions($N, @solutions, @fib);
+
+print "Input:\n";
+printf "\t%s = %d\n\n", '$N', $N;
+
+print "Output:\n";
+if (scalar @solutions) {
+  printf "\t%d as the sum of Fibonacci numbers (%s) is same as input number.\n",
+          scalar(@solutions), 
+          join(', ', map { '['.join(',',@$_).']' } @solutions);
+} else {
+  print "\tNo solution can be found.\n";
+}
+
+
+sub fibonacci ($) {
+  my ($n) = @_;
+
+  return 1 if ($n == 1 or $n == 2);
+
+  return fibonacci($n - 1) + fibonacci($n - 2);
+}
+
+
+sub getFibonacciNumbersSmallerN ($) {
+  my ($n) = @_;
+
+  my @fib;
+
+  my $i = 2;
+  my $f;
+
+  while ($f = fibonacci($i++) and $f < $n) {
+    push(@fib, $f);
+  }
+
+  return @fib;
+}
+
+
+sub findFibonacciSumSolutions($\@\@) {
+   my ($n, $arSol, $arFib) = @_;
+
+   foreach my $level (1 .. scalar @$arFib) {
+     my $iter = combinations($arFib, $level);
+     while (my $arCombi = $iter->next) {
+       push(@$arSol, $arCombi) 
+        if (sum(@$arCombi) == $n);
+     }
+  }
+}
diff --git a/challenge-077/perlboy1967/perl/ch-2.pl b/challenge-077/perlboy1967/perl/ch-2.pl
new file mode 100755
index 0000000000..0d01217511
--- /dev/null
+++ b/challenge-077/perlboy1967/perl/ch-2.pl
@@ -0,0 +1,85 @@
+#!/usr/bin/perl
+
+# Perl Weekly Challenge - 077
+# - https://perlweeklychallenge.org/blog/perl-weekly-challenge-077/
+#
+# Task 2 - Lonely X
+#
+# Author: Niels 'PerlBoy' van Dijke
+
+use strict;
+use warnings;
+
+use List::Util qw(sum);
+
+# Prototypes
+sub findLonelyXs (\@\@);
+sub isLonelyX (\@$$$$);
+sub printGrid ($\@);
+
+# Input grid
+my $g = [
+  [qw(0 0 x 0)],
+  [qw(x 0 0 0)],
+  [qw(x 0 0 x)],
+  [qw(0 x 0 0)],
+];
+
+
+sub findLonelyXs (\@\@) {
+  my ($arG, $arGC) = @_;
+
+  my $n = 0;
+  my $w = scalar @{$arG->[0]};
+  my $h = scalar @$arG;
+
+  for my $y (0 .. $h - 1) {
+    for my $x (0 .. $w - 1) {
+      my $res = isLonelyX(@$arG, $w, $h, $x, $y);
+      $n += $res;
+      $arGC->[$x][$y] = ($res ? '*' : $arG->[$x][$y]);
+    }
+  }
+
+  return $n;
+}
+
+
+sub isLonelyX (\@$$$$) {
+  my ($arG, $w, $h, $x, $y) = @_;
+
+  return 0 if ($arG->[$x][$y] ne 'x');
+
+  my @rowIdx = (($x-1 < 0 ? 0 : $x-1) .. ($x+1 > $w-1 ? $w-1 : $x+1));
+  my @colIdx = (($y-1 < 0 ? 0 : $y-1) .. ($y+1 > $h-1 ? $h-1 : $y+1));
+  my @check;
+
+  for my $row (@rowIdx) {
+    for my $col (@colIdx) {
+      push(@check, $arG->[$row][$col]);
+    }
+  }
+
+  return (scalar(grep { $_ eq 'x' }  @check) == 1);
+}
+
+
+sub printGrid ($\@) {
+  my ($title, $arG) = @_;
+
+  print "$title:\n";
+  for my $x (0 .. scalar @$arG - 1) {
+    printf "[ %s ]\n", join(' ', @{$arG->[$x]});
+  }
+  print "\n";
+}
+
+
+my $gLonely = []; 
+
+printGrid('Input', @$g);
+my $n = findLonelyXs(@$g, @$gLonely);
+printGrid('Output', @$gLonely);
+
+printf "%d lonely X's found (marked '*')\n", $n;
+