From ddacd8a265fea6aeb2ae5241c8e9abe469941deb Mon Sep 17 00:00:00 2001 From: Bob Lied Date: Sun, 29 Sep 2024 08:37:04 -0500 Subject: Week 288 solutions --- challenge-288/bob-lied/README | 6 +- challenge-288/bob-lied/perl/ch-1.pl | 109 +++++++++++++++++++++++++++++++ challenge-288/bob-lied/perl/ch-2.pl | 125 ++++++++++++++++++++++++++++++++++++ 3 files changed, 237 insertions(+), 3 deletions(-) create mode 100644 challenge-288/bob-lied/perl/ch-1.pl create mode 100644 challenge-288/bob-lied/perl/ch-2.pl 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 { }, + }); +} -- cgit