Merge pull request #3079 from pauloscustodio/077-perl

Add Perl solution to challenge 077

4 files changed, 169 insertions, 0 deletions

diff --git a/challenge-077/paulo-custodio/README b/challenge-077/paulo-custodio/README
new file mode 100644
index 0000000000..87dc0b2fbd
--- /dev/null
+++ b/challenge-077/paulo-custodio/README
@@ -0,0 +1 @@
+Solution by Paulo Custodio
diff --git a/challenge-077/paulo-custodio/perl/ch-1.pl b/challenge-077/paulo-custodio/perl/ch-1.pl
new file mode 100644
index 0000000000..11f6eaf540
--- /dev/null
+++ b/challenge-077/paulo-custodio/perl/ch-1.pl
@@ -0,0 +1,61 @@
+#!/usr/bin/perl
+
+# Challenge 077
+# 
+# TASK #1 › Fibonacci Sum
+# Submitted by: Mohammad S Anwar
+# You are given a positive integer $N.
+# 
+# UPDATE: 2020-09-07 09:00:00
+# Write a script to find out all possible combination of Fibonacci Numbers required to get $N on addition.
+# 
+# You are NOT allowed to repeat a number. Print 0 if none found.
+# 
+# Example 1:
+# Input: $N = 6
+# 
+# Output:
+#     1 + 2 + 3 = 6
+#     1 + 5 = 6
+# Example 2:
+# Input: $N = 9
+# 
+# Output:
+#     1 + 8 = 9
+#     1 + 3 + 5 = 9
+
+use strict;
+use warnings;
+use 5.030;
+use Math::Combinatorics;
+use List::Util 'sum';
+
+my($N) = shift;
+
+# compute list of Fibonacci numbers up to input
+my @fib = (0, 1);
+compute_fib($N);
+
+# terms for addition are the Fibonacci numbers except the first two terms (0,1)
+my @terms = @fib[2 .. $#fib];
+
+my @out;
+for my $k (1 .. scalar(@terms)) {
+	my $combinat = Math::Combinatorics->new(count => $k, data => \@terms);
+	while(my @set = $combinat->next_combination) {
+		if (sum(@set) == $N) {
+			push @out, join(" + ", sort @set)." = $N\n";
+		}
+	}
+}
+
+# sort result so that it is deterministic
+print sort(@out);
+
+
+sub compute_fib {
+	my($target) = @_;
+	while ($fib[-1] < $target) {
+		push @fib, $fib[-1]+$fib[-2];
+	}
+}
diff --git a/challenge-077/paulo-custodio/perl/ch-2.pl b/challenge-077/paulo-custodio/perl/ch-2.pl
new file mode 100644
index 0000000000..4185fcd343
--- /dev/null
+++ b/challenge-077/paulo-custodio/perl/ch-2.pl
@@ -0,0 +1,60 @@
+#!/usr/bin/perl
+
+# Challenge 077
+# 
+# TASK #2 › Lonely X
+# Submitted by: Mohammad S Anwar
+# 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.
+# 
+# Example 1:
+# Input: [ O O X ]
+#        [ X O O ]
+#        [ X O O ]
+# 
+# Output: 1 as there is only one X at the first row last column surrounded by only O.
+# Example 2:
+# Input: [ O O X O ]
+#        [ X O O O ]
+#        [ X O O X ]
+#        [ O X O O ]
+# 
+# Output: 2
+# 
+#     a) First  X found at Row 1 Col 3.
+# 
+#     b) Second X found at Row 3 Col 4.
+
+use strict;
+use warnings;
+use 5.030;
+
+my @m = @ARGV;
+for (@m) { $_ = [split //, $_]; }
+
+my $lonely = 0;
+for my $row (0 .. $#m) {
+	for my $col (0 .. $#{$m[0]}) {
+		if ($m[$row][$col] eq 'X') {
+			my $neigh = 0;
+			for my $dr (-1 .. 1) {
+				for my $dc (-1 .. 1) {
+					if (!($dr == 0 && $dc == 0)) {
+						if ($row+$dr >= 0 && $row+$dr <= $#m) {
+							if ($col+$dc >= 0 && $col+$dc <= $#{$m[0]}) {
+								if ($m[$row+$dr][$col+$dc] eq 'X') {
+									$neigh++;
+								}
+							}
+						}
+					}
+				}
+			}
+			$lonely++ if $neigh==0;
+		}
+	}
+}
+			
+say $lonely;
+
diff --git a/challenge-077/paulo-custodio/test.pl b/challenge-077/paulo-custodio/test.pl
new file mode 100644
index 0000000000..807d92325d
--- /dev/null
+++ b/challenge-077/paulo-custodio/test.pl
@@ -0,0 +1,47 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More;
+use 5.030;
+
+is capture("perl perl/ch-1.pl 6"), <<END;
+1 + 2 + 3 = 6
+1 + 5 = 6
+END
+
+is capture("perl perl/ch-1.pl 9"), <<END;
+1 + 3 + 5 = 9
+1 + 8 = 9
+END
+
+is capture("perl perl/ch-1.pl 100"), <<END;
+1 + 13 + 2 + 21 + 3 + 5 + 55 = 100
+1 + 13 + 2 + 21 + 55 + 8 = 100
+1 + 2 + 3 + 34 + 5 + 55 = 100
+1 + 2 + 3 + 5 + 89 = 100
+1 + 2 + 34 + 55 + 8 = 100
+1 + 2 + 8 + 89 = 100
+13 + 21 + 3 + 55 + 8 = 100
+3 + 34 + 55 + 8 = 100
+3 + 8 + 89 = 100
+END
+
+is capture("perl perl/ch-2.pl ".
+				"OOX ".
+				"XOO ".
+				"XOO "), "1\n";
+is capture("perl perl/ch-2.pl ".
+				"OOXO ".
+				"XOOO ".
+				"XOOX ".
+				"OXOO "), "2\n";
+
+done_testing;
+
+sub capture {
+	my($cmd) = @_;
+	my $out = `$cmd`;
+	$out =~ s/[ \t\v\f\r]*\n/\n/g;
+	return $out;
+}