aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--challenge-288/bob-lied/README6
-rw-r--r--challenge-288/bob-lied/perl/ch-1.pl109
-rw-r--r--challenge-288/bob-lied/perl/ch-2.pl125
3 files changed, 237 insertions, 3 deletions
diff --git a/challenge-288/bob-lied/README b/challenge-288/bob-lied/README
index 6b0793f9e8..75c8311b34 100644
--- a/challenge-288/bob-lied/README
+++ b/challenge-288/bob-lied/README
@@ -1,4 +1,4 @@
-Solutions to weekly challenge 287 by Bob Lied
+Solutions to weekly challenge 288 by Bob Lied
-https://perlweeklychallenge.org/blog/perl-weekly-challenge-287/
-https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-287/bob-lied
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-288/
+https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-288/bob-lied
diff --git a/challenge-288/bob-lied/perl/ch-1.pl b/challenge-288/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..f019e3bf74
--- /dev/null
+++ b/challenge-288/bob-lied/perl/ch-1.pl
@@ -0,0 +1,109 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# Copyright (c) 2024, Bob Lied
+#=============================================================================
+# ch-1.pl Perl Weekly Challenge 288 Task 1 Closest Palindrome
+#=============================================================================
+# 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 v5.40;
+use List::Util qw/min/;
+
+use Getopt::Long;
+my $Verbose = false;
+my $DoTest = false;
+my $Benchmark = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose, "benchmark:i" => \$Benchmark);
+exit(!runTest()) if $DoTest;
+exit( runBenchmark($Benchmark) ) if $Benchmark;
+
+say closest($_) for @ARGV;
+
+sub closest($str)
+{
+ my $len = length($str);
+ return $str-1 if $len == 1;
+
+ my @possible = ( 10**$len + 1, 10**($len-1) - 1 ); # 10*1 and 99*9
+
+ my $leftHalf = substr($str, 0, int(($len + 1)/2));
+
+ for my $left ( $leftHalf-1, $leftHalf, $leftHalf+1 )
+ {
+ # For even lengths, mirror the left. For odd, don't double middle digit
+ my $right = reverse( ($len%2) ? substr($left, 0, length($left)-1) : $left );
+ push @possible, "$left$right" unless "$left$right" eq $str;
+ }
+
+ # Find the minimum differences
+ my $nearest = $possible[0];
+ my $min = abs($possible[0] - $str);
+ for my $p ( @possible )
+ {
+ my $diff = abs($p - $str);
+ if ( $diff < $min )
+ {
+ $min = $diff;
+ $nearest = $p;
+ }
+ elsif ( $diff == $min && $p < $nearest )
+ {
+ $nearest = $p;
+ }
+ }
+ return $nearest;
+}
+
+sub brute($str)
+{
+ my $start = +$str; # Numeric
+ my $delta = 0;
+
+ while ( ++$delta )
+ {
+ my $p = $start - $delta;
+ return $p if "$p" eq reverse("$p");
+
+ $p = $start + $delta;
+ return $p if "$p" eq reverse("$p");
+ }
+}
+
+sub runTest
+{
+ use Test2::V0;
+
+ is( closest( "123"), 121, "Example 1");
+ is( closest( "2"), 1, "Example 2");
+ is( closest("1400"), 1441, "Example 3");
+ is( closest("1001"), 999, "Example 4");
+
+ is( closest("146899325"), 146898641, "Big odd-sized number");
+ is( closest("1467899325"), 1467887641, "Big even-sized number");
+ is( closest("1467809321"), 1467777641, "Big even-sized number");
+
+ done_testing;
+}
+
+sub runBenchmark($repeat)
+{
+ use Benchmark qw/cmpthese/;
+
+ cmpthese($repeat, {
+ reverse => sub { closest("146899325") },
+ brute => sub { brute("146899325") },
+ });
+}
diff --git a/challenge-288/bob-lied/perl/ch-2.pl b/challenge-288/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..8a68cb3dfb
--- /dev/null
+++ b/challenge-288/bob-lied/perl/ch-2.pl
@@ -0,0 +1,125 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# Copyright (c) 2024, Bob Lied
+#=============================================================================
+# ch-2.pl Perl Weekly Challenge 288 Task 2 Contiguous Block
+#=============================================================================
+# 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'], ]
+# Output: 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'], ]
+# Output: 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'], ]
+# Output: 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 v5.40;
+
+use Getopt::Long;
+my $Verbose = false;
+my $DoTest = false;
+my $Benchmark = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose, "benchmark:i" => \$Benchmark);
+exit(!runTest()) if $DoTest;
+exit( runBenchmark($Benchmark) ) if $Benchmark;
+
+say contblock($_) for @ARGV;
+
+sub contBlock($matrix)
+{
+ my $lastRow = $matrix->$#*;
+ my $lastCol = $matrix->[0]->$#*;
+ my $maxSize = 0;
+
+ for my $row ( 0 .. $lastRow )
+ {
+ for my $col ( 0 .. $lastCol )
+ {
+ my $cell = $matrix->[$row][$col];
+ next if $cell eq '#';
+
+ my $count = 0;
+ my @toDo = ( [$row, $col] );
+ while ( @toDo )
+ {
+ my ($r, $c) = shift(@toDo)->@*;
+
+ next unless $matrix->[$r][$c] eq $cell;
+ $matrix->[$r][$c] = '#';
+ $count++;
+
+ push @toDo, [$r-1,$c ] if $r > 0;
+ push @toDo, [$r+1,$c ] if $r < $lastRow;
+ push @toDo, [$r ,$c-1] if $c > 0;
+ push @toDo, [$r ,$c+1] if $c < $lastCol;
+ }
+ $maxSize = $count if $count > $maxSize;
+ }
+ }
+ return $maxSize;
+}
+
+# Debugging aid
+sub show($matrix)
+{
+ say join(' ', $_->@*) for $matrix->@*;
+}
+
+
+sub runTest
+{
+ use Test2::V0;
+ my $matrix = [ ['x', 'x', 'x', 'x', 'o'],
+ ['x', 'o', 'o', 'o', 'o'],
+ ['x', 'o', 'o', 'o', 'o'],
+ ['x', 'x', 'x', 'o', 'o'], ];
+ is( contBlock($matrix), 11, "Example 1");
+
+ $matrix = [ ['x', 'x', 'x', 'x', 'x'],
+ ['x', 'o', 'o', 'o', 'o'],
+ ['x', 'x', 'x', 'x', 'o'],
+ ['x', 'o', 'o', 'o', 'o'], ];
+ is( contBlock($matrix), 11, "Example 2");
+
+ $matrix = [ ['x', 'x', 'x', 'o', 'o'],
+ ['o', 'o', 'o', 'x', 'x'],
+ ['o', 'x', 'x', 'o', 'o'],
+ ['o', 'o', 'o', 'x', 'x'], ];
+ is( contBlock($matrix), 7, "Example 3");
+
+ done_testing;
+}
+
+sub runBenchmark($repeat)
+{
+ use Benchmark qw/cmpthese/;
+
+ cmpthese($repeat, {
+ label => sub { },
+ });
+}
generated by cgit (git 2.34.1) at 2026-02-27 11:17:38 +0000