Merge pull request #10909 from torgnylyon/master

Add solutions for week 288

3 files changed, 94 insertions, 0 deletions

diff --git a/challenge-288/torgny-lyon/blog.txt b/challenge-288/torgny-lyon/blog.txt
new file mode 100644
index 0000000000..1a89b23872
--- /dev/null
+++ b/challenge-288/torgny-lyon/blog.txt
@@ -0,0 +1 @@
+https://www.abc.se/~torgny/pwc.html#288
diff --git a/challenge-288/torgny-lyon/perl/ch-1.pl b/challenge-288/torgny-lyon/perl/ch-1.pl
new file mode 100755
index 0000000000..341eae65ba
--- /dev/null
+++ b/challenge-288/torgny-lyon/perl/ch-1.pl
@@ -0,0 +1,23 @@
+#!/usr/bin/perl
+
+use v5.40;
+
+use Test::More tests => 4;
+
+sub is_palindrome {
+    my $l = length $_[0] / 2;
+    return ($l == 0
+            or substr($_[0], 0, $l) eq scalar reverse substr($_[0], -$l));
+}
+
+sub get_closest_palindrome {
+    my ($l, $h) = ($_[0] - 1, $_[0] + 1);
+    --$l until is_palindrome($l);
+    ++$h until is_palindrome($h);
+    return $h - $_[0] < $_[0] - $l ? $h : $l;
+}
+
+is(get_closest_palindrome(123),  121);
+is(get_closest_palindrome(2),    1);
+is(get_closest_palindrome(1400), 1441);
+is(get_closest_palindrome(1001), 999);
diff --git a/challenge-288/torgny-lyon/perl/ch-2.pl b/challenge-288/torgny-lyon/perl/ch-2.pl
new file mode 100755
index 0000000000..d818f4b59c
--- /dev/null
+++ b/challenge-288/torgny-lyon/perl/ch-2.pl
@@ -0,0 +1,70 @@
+#!/usr/bin/perl
+
+use v5.40;
+
+use Test::More tests => 3;
+
+sub mark_cell {
+    my ($matrix, $row, $column, $block) = @_;
+    $matrix->[$row][$column][1] = $block;
+    if ($row > 0
+            and $matrix->[$row - 1][$column][0] eq $matrix->[$row][$column][0]
+            and $matrix->[$row - 1][$column][1] == 0) {
+        mark_cell($matrix, $row - 1, $column, $block);
+    }
+    if ($column > 0
+            and $matrix->[$row][$column - 1][0] eq $matrix->[$row][$column][0]
+            and $matrix->[$row][$column - 1][1] == 0) {
+        mark_cell($matrix, $row, $column - 1, $block);
+    }
+    if ($row < $#$matrix
+            and $matrix->[$row + 1][$column][0] eq $matrix->[$row][$column][0]
+            and $matrix->[$row + 1][$column][1] == 0) {
+        mark_cell($matrix, $row + 1, $column, $block);
+    }
+    if ($column < $#{ $matrix->[0] }
+            and $matrix->[$row][$column + 1][0] eq $matrix->[$row][$column][0]
+            and $matrix->[$row][$column + 1][1] == 0) {
+        mark_cell($matrix, $row, $column + 1, $block);
+    }
+}
+
+sub get_largest_contiguous_block {
+    my $matrix = [ map { [ map { [ $_, 0] } @$_ ] } @{$_[0]} ];
+    my $block = 1;
+    my %sizes;
+    foreach my $row (0..$#$matrix) {
+        foreach my $column (0..$#{ $matrix->[0] }) {
+            unless ($matrix->[$row][$column][1]) {
+                mark_cell($matrix, $row, $column, $block++)
+            }
+            ++$sizes{ $matrix->[$row][$column][1] };
+        }
+    }
+    return (sort { $b <=> $a } values %sizes)[0];
+}
+
+my $example1 = [
+    [ 'x', 'x', 'x', 'x', 'o' ],
+    [ 'x', 'o', 'o', 'o', 'o' ],
+    [ 'x', 'o', 'o', 'o', 'o' ],
+    [ 'x', 'x', 'x', 'o', 'o' ],
+];
+
+my $example2 = [
+    [ 'x', 'x', 'x', 'x', 'x' ],
+    [ 'x', 'o', 'o', 'o', 'o' ],
+    [ 'x', 'x', 'x', 'x', 'o' ],
+    [ 'x', 'o', 'o', 'o', 'o' ],
+];
+
+my $example3 = [
+    [ 'x', 'x', 'x', 'o', 'o' ],
+    [ 'o', 'o', 'o', 'x', 'x' ],
+    [ 'o', 'x', 'x', 'o', 'o' ],
+    [ 'o', 'o', 'o', 'x', 'x' ],
+];
+
+is(get_largest_contiguous_block($example1), 11);
+is(get_largest_contiguous_block($example2), 11);
+is(get_largest_contiguous_block($example3), 7);