Add Perl solution to challenge 288

5 files changed, 193 insertions, 0 deletions

diff --git a/challenge-288/paulo-custodio/Makefile b/challenge-288/paulo-custodio/Makefile
new file mode 100644
index 0000000000..c3c762d746
--- /dev/null
+++ b/challenge-288/paulo-custodio/Makefile
@@ -0,0 +1,2 @@
+all:
+	perl ../../challenge-001/paulo-custodio/test.pl
diff --git a/challenge-288/paulo-custodio/perl/ch-1.pl b/challenge-288/paulo-custodio/perl/ch-1.pl
new file mode 100644
index 0000000000..51a042a37f
--- /dev/null
+++ b/challenge-288/paulo-custodio/perl/ch-1.pl
@@ -0,0 +1,59 @@
+#!/usr/bin/env perl
+
+# Challenge 288
+#
+# Task 1: Closest Palindrome
+# Submitted by: Mohammad Sajid Anwar
+# You are given a string, $str, which is an integer.
+#
+# Write a script to find out the closest palindrome, not including itself.
+# If there are more than one then return the smallest.
+#
+# The closest is defined as the absolute difference minimized between two
+# integers.
+#
+# Example 1
+# Input: $str = "123"
+# Output: "121"
+# Example 2
+# Input: $str = "2"
+# Output: "1"
+#
+# There are two closest palindrome "1" and "3". Therefore we return the smallest "1".
+# Example 3
+# Input: $str = "1400"
+# Output: "1441"
+# Example 4
+# Input: $str = "1001"
+# Output: "999"
+
+use Modern::Perl;
+
+sub is_palindrome {
+    my($n) = @_;
+    return "$n" eq join("", reverse split //, "$n");
+}
+
+sub next_palindrome {
+    my($n) = @_;
+    my $out;
+    for (my $i = 1; !defined($out) || $i <= $n; $i++) {
+        my $t = $n-$i;
+        if ($t >= 0 && is_palindrome($t)) {
+            if (!defined($out) || abs($out-$n) > abs($t-$n)) {
+                $out = $t;
+            }
+        }
+
+        $t = $n+$i;
+        if (is_palindrome($t)) {
+            if (!defined($out) || abs($out-$n) > abs($t-$n)) {
+                $out = $t;
+            }
+        }
+    }
+    return $out;
+}
+
+my $n = shift // 0;
+say next_palindrome($n);
diff --git a/challenge-288/paulo-custodio/perl/ch-2.pl b/challenge-288/paulo-custodio/perl/ch-2.pl
new file mode 100644
index 0000000000..fccda9c1cf
--- /dev/null
+++ b/challenge-288/paulo-custodio/perl/ch-2.pl
@@ -0,0 +1,97 @@
+#!/usr/bin/env perl
+
+# Challenge 288
+#
+# Task 2: Contiguous Block
+# Submitted by: Peter Campbell Smith
+# You are given a rectangular matrix where all the cells contain either x or o.
+#
+# Write a script to determine the size of the largest contiguous block.
+#
+# A contiguous block consists of elements containing the same symbol which
+# share an edge (not just a corner) with other elements in the block, and where
+# there is a path between any two of these elements that crosses only those
+# shared edges.
+#
+# Example 1
+#     Input: $matrix = [
+#                        ['x', 'x', 'x', 'x', 'o'],
+#                        ['x', 'o', 'o', 'o', 'o'],
+#                        ['x', 'o', 'o', 'o', 'o'],
+#                        ['x', 'x', 'x', 'o', 'o'],
+#                      ]
+#     Ouput: 11
+#
+#         There is a block of 9 contiguous cells containing 'x'.
+#         There is a block of 11 contiguous cells containing 'o'.
+# Example 2
+#     Input: $matrix = [
+#                        ['x', 'x', 'x', 'x', 'x'],
+#                        ['x', 'o', 'o', 'o', 'o'],
+#                        ['x', 'x', 'x', 'x', 'o'],
+#                        ['x', 'o', 'o', 'o', 'o'],
+#                      ]
+#     Ouput: 11
+#
+#         There is a block of 11 contiguous cells containing 'x'.
+#         There is a block of 9 contiguous cells containing 'o'.
+# Example 3
+#     Input: $matrix = [
+#                        ['x', 'x', 'x', 'o', 'o'],
+#                        ['o', 'o', 'o', 'x', 'x'],
+#                        ['o', 'x', 'x', 'o', 'o'],
+#                        ['o', 'o', 'o', 'x', 'x'],
+#                      ]
+#     Ouput: 7
+#
+#         There is a block of 7 contiguous cells containing 'o'.
+#         There are two other 2-cell blocks of 'o'.
+#         There are three 2-cell blocks of 'x' and one 3-cell.
+
+use Modern::Perl;
+
+my $SEEN = ' ';
+
+sub parse_matrix {
+    my(@m) = @_;
+    @m = map {[split //, $_]} @m;
+    return @m;
+}
+
+sub size_block {
+    my($m, $ch, $r, $c) = @_;
+    $m->[$r][$c] = $SEEN;
+    my $count = 1;
+    if ($r-1 >= 0 && $m->[$r-1][$c] eq $ch) {
+        $count += size_block($m, $ch, $r-1, $c);
+    }
+    if ($r+1 < @$m && $m->[$r+1][$c] eq $ch) {
+        $count += size_block($m, $ch, $r+1, $c);
+    }
+    if ($c-1 >= 0 && $m->[$r][$c-1] eq $ch) {
+        $count += size_block($m, $ch, $r, $c-1);
+    }
+    if ($c+1 < @{$m->[0]} && $m->[$r][$c+1] eq $ch) {
+        $count += size_block($m, $ch, $r, $c+1);
+    }
+    return $count;
+}
+
+sub max_block {
+    my(@m) = @_;
+    my $max_block = 0;
+    for my $r (0 .. @m-1) {
+        for my $c (0 .. @{$m[0]}-1) {
+            next if $m[$r][$c] eq $SEEN;
+            my $block = size_block(\@m, $m[$r][$c], $r, $c);
+            if ($block > $max_block) {
+                $max_block = $block;
+            }
+        }
+    }
+    return $max_block;
+}
+
+my @m = parse_matrix(@ARGV);
+my $max_block = max_block(@m);
+say $max_block;
diff --git a/challenge-288/paulo-custodio/t/test-1.yaml b/challenge-288/paulo-custodio/t/test-1.yaml
new file mode 100644
index 0000000000..b54e9c8e52
--- /dev/null
+++ b/challenge-288/paulo-custodio/t/test-1.yaml
@@ -0,0 +1,20 @@
+- setup:
+  cleanup:
+  args:     123
+  input:
+  output:   121
+- setup:
+  cleanup:
+  args:     2
+  input:
+  output:   1
+- setup:
+  cleanup:
+  args:     1400
+  input:
+  output:   1441
+- setup:
+  cleanup:
+  args:     1001
+  input:
+  output:   999
diff --git a/challenge-288/paulo-custodio/t/test-2.yaml b/challenge-288/paulo-custodio/t/test-2.yaml
new file mode 100644
index 0000000000..1c326b6caa
--- /dev/null
+++ b/challenge-288/paulo-custodio/t/test-2.yaml
@@ -0,0 +1,15 @@
+- setup:
+  cleanup:
+  args:     xxxxo xoooo xoooo xxxoo
+  input:
+  output:   11
+- setup:
+  cleanup:
+  args:     xxxxx xoooo xxxxo xoooo
+  input:
+  output:   11
+- setup:
+  cleanup:
+  args:     xxxoo oooxx oxxoo oooxx
+  input:
+  output:   7