Merge pull request #3047 from pauloscustodio/088-perl

Add Perl solution to challenge 088

4 files changed, 191 insertions, 0 deletions

diff --git a/challenge-088/paulo-custodio/README b/challenge-088/paulo-custodio/README
new file mode 100644
index 0000000000..87dc0b2fbd
--- /dev/null
+++ b/challenge-088/paulo-custodio/README
@@ -0,0 +1 @@
+Solution by Paulo Custodio
diff --git a/challenge-088/paulo-custodio/perl/ch-1.pl b/challenge-088/paulo-custodio/perl/ch-1.pl
new file mode 100644
index 0000000000..b50126943a
--- /dev/null
+++ b/challenge-088/paulo-custodio/perl/ch-1.pl
@@ -0,0 +1,51 @@
+#!/usr/bin/perl
+
+# Challenge 088
+# 
+# TASK #1 › Array of Product
+# Submitted by: Mohammad S Anwar
+# You are given an array of positive integers @N.
+# 
+# Write a script to return an array @M where $M[i] is the product of all elements
+# of @N except the index $N[i].
+# 
+# Example 1:
+# Input:
+#     @N = (5, 2, 1, 4, 3)
+# Output:
+#     @M = (24, 60, 120, 30, 40)
+# 
+#     $M[0] = 2 x 1 x 4 x 3 = 24
+#     $M[1] = 5 x 1 x 4 x 3 = 60
+#     $M[2] = 5 x 2 x 4 x 3 = 120
+#     $M[3] = 5 x 2 x 1 x 3 = 30
+#     $M[4] = 5 x 2 x 1 x 4 = 40
+# Example 2:
+# Input:
+#     @N = (2, 1, 4, 3)
+# Output:
+#     @M = (12, 24, 6, 8)
+# 
+#     $M[0] = 1 x 4 x 3 = 12
+#     $M[1] = 2 x 4 x 3 = 24
+#     $M[2] = 2 x 1 x 3 = 6
+#     $M[3] = 2 x 1 x 4 = 8
+
+use strict;
+use warnings;
+use 5.030;
+
+my @N = @ARGV;
+my @M = array_product(@N);
+say "(", join(", ", @M), ")";
+
+sub array_product {
+	my(@n) = @_;
+	my @m = (1) x scalar(@n);				# initialize the products to 1
+	for my $i (0 .. $#n) {
+		for my $j (0 .. $#m) {
+			$m[$j] *= $n[$i] if $i != $j;	# multiply if not the same index
+		}
+	}
+	return @m;
+}
diff --git a/challenge-088/paulo-custodio/perl/ch-2.pl b/challenge-088/paulo-custodio/perl/ch-2.pl
new file mode 100644
index 0000000000..f22077c7d3
--- /dev/null
+++ b/challenge-088/paulo-custodio/perl/ch-2.pl
@@ -0,0 +1,71 @@
+#!/usr/bin/perl
+
+# Challenge 088
+# 
+# TASK #2 › Spiral Matrix
+# Submitted by: Mohammad S Anwar
+# You are given m x n matrix of positive integers.
+# 
+# Write a script to print spiral matrix as list.
+# 
+# Example 1:
+# Input:
+#     [ 1, 2, 3 ]
+#     [ 4, 5, 6 ]
+#     [ 7, 8, 9 ]
+# Ouput:
+#     [ 1, 2, 3, 6, 9, 8, 7, 4, 5 ]
+# Example 2:
+# Input:
+#     [  1,  2,  3,  4 ]
+#     [  5,  6,  7,  8 ]
+#     [  9, 10, 11, 12 ]
+#     [ 13, 14, 15, 16 ]
+# Output:
+#     [ 1, 2, 3, 4, 8, 12, 16, 15, 14, 13, 9, 5, 6, 7, 11, 10 ]
+	
+use strict;
+use warnings;
+use 5.030;
+
+# read matrix from input
+my @m;
+my $ncols;
+while (<>) {
+	my @cols = split(' ', s/\D/ /gr);		# ignore all but numbers
+	die "invalid matrix\n" if defined($ncols) && $ncols != scalar(@cols);
+	$ncols = scalar(@cols);
+	push @m, \@cols;
+}
+
+# compute spiral
+my @s = spiral(@m);   
+say "[ ", join(", ", @s), " ]";
+
+
+sub spiral {
+	my(@m) = @_;
+	my @s;
+	while (@m) {
+		push @s, @{$m[0]};					# put top row left-right
+		shift @m;
+		last unless @m;
+		
+		if (@{$m[0]}) {
+			for my $r (0 .. $#m) {			# put right column top-bottom
+				push @s, pop @{$m[$r]};
+			}
+		}
+		
+		push @s, reverse @{$m[-1]};			# put bottom row right-left
+		pop @m;
+		last unless @m;
+		
+		if (@{$m[0]}) {
+			for my $r (reverse 0 .. $#m) {	# put left column top-bottom
+				push @s, shift @{$m[$r]};
+			}
+		}
+	}
+	return @s;
+}
diff --git a/challenge-088/paulo-custodio/test.pl b/challenge-088/paulo-custodio/test.pl
new file mode 100644
index 0000000000..e2512af0a2
--- /dev/null
+++ b/challenge-088/paulo-custodio/test.pl
@@ -0,0 +1,68 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More;
+use 5.030;
+
+my $in = "in.txt";
+
+is capture("perl perl/ch-1.pl 5 2 1 4 3"), "(24, 60, 120, 30, 40)\n";
+is capture("perl perl/ch-1.pl 2 1 4 3  "), "(12, 24, 6, 8)\n";
+is capture("perl perl/ch-1.pl 0 1 4 3  "), "(12, 0, 0, 0)\n";
+is capture("perl perl/ch-1.pl 1 1 1 1  "), "(1, 1, 1, 1)\n";
+
+spew($in, <<END);
+[ 5 ]
+END
+is capture("perl perl/ch-2.pl <$in"), "[ 5 ]\n";
+
+spew($in, <<END);
+[ 1, 2, 3 ]
+END
+is capture("perl perl/ch-2.pl <$in"), "[ 1, 2, 3 ]\n";
+
+spew($in, <<END);
+[ 1, 2, 3 ]
+[ 7, 8, 9 ]
+END
+is capture("perl perl/ch-2.pl <$in"), "[ 1, 2, 3, 9, 8, 7 ]\n";
+
+spew($in, <<END);
+[ 1 ]
+[ 4 ]
+[ 7 ]
+END
+is capture("perl perl/ch-2.pl <$in"), "[ 1, 4, 7 ]\n";
+
+spew($in, <<END);
+[ 1, 2, 3 ]
+[ 4, 5, 6 ]
+[ 7, 8, 9 ]
+END
+is capture("perl perl/ch-2.pl <$in"), "[ 1, 2, 3, 6, 9, 8, 7, 4, 5 ]\n";
+
+spew($in, <<END);
+[  1,  2,  3,  4 ]
+[  5,  6,  7,  8 ]
+[  9, 10, 11, 12 ]
+[ 13, 14, 15, 16 ]
+END
+is capture("perl perl/ch-2.pl <$in"), 
+	"[ 1, 2, 3, 4, 8, 12, 16, 15, 14, 13, 9, 5, 6, 7, 11, 10 ]\n";
+
+unlink($in);
+done_testing;
+
+sub capture {
+	my($cmd) = @_;
+	my $out = `$cmd`;
+	$out =~ s/[ \t\v\f\r]*\n/\n/g;
+	return $out;
+}
+
+sub spew {
+	my($file, $text) = @_;
+	open(my $fh, ">", $file) or die "write $file: $!\n";
+	print $fh $text;
+}