Perl Weekly Challenge 288.
My solutions (task 1 and task 2 ) to the The Weekly 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"
The closest palindrome to 0 is 1. The closest to any other one-digit
number n is n-1. If the number n is not a palindrome and is of
the form abc where b is empty or has a single digit and c is the
same length as a, then the
closest palindrome is aba' where a' is the same as a but with the
digits reversed. This way, the change is not larger than 10**d, with
d the number of digits of c. If the number is already a palindrome of the form
aba', then the closest palindrome is
ebe' where e=a-1. This fails however when there is a reduction in
the length of the word, as, for example, applied to 1001 it would
produce 99, while 999 is a closer palindrome. A solution is to insert
a 9 or replace the central digit by 99. The result fits a three-liner:
Examples:
perl -E '
for(@ARGV){say "$_ -> ", /^0$/?1:/^\d$/?$_-1:/^(.+)(.?)(??{reverse $1})$/?
($1-1).(length($1-1)==length($1)?$2:length($2)?99:9).reverse($1-1):
/^(.+)(.?)(??{"."x length $1})$/ && $1.$2.reverse $1}
' 123 2 1400 1001
Results:
123 -> 121
2 -> 1
1400 -> 1441
1001 -> 999
Other examples:
perl -E '
for(@ARGV){say "$_ -> ", /^0$/?1:/^\d$/?$_-1:/^(.+)(.?)(??{reverse $1})$/?
($1-1).(length($1-1)==length($1)?$2:length($2)?99:9).reverse($1-1):
/^(.+)(.?)(??{"."x length $1})$/ && $1.$2.reverse $1}
' 0 10800 10801
Results:
0 -> 1
10800 -> 10801
10801 -> 9999
I used the very nice ability of Perl regular expressions to execute code and incorporate the result into the expression, in order to recognize palindromes. The full code follows:
1 # Perl weekly challenge 288
2 # Task 1: Closest Palindrome
3 #
4 # See https://wlmb.github.io/2024/09/23/PWC288/#task-1-closest-palindrome
5 use v5.36;
6 die <<~"FIN" unless @ARGV;
7 Usage: $0 N1 N2...
8 to find the closest and smallest palindrome to the numbers N1 N2...
9 FIN
10 for(@ARGV){
11 say("Only digits allowed: $_"), next unless /^\d+$/;
12 my $original=$_;
13 s/^0+(.+)/$1/; # Remove leading zeroes
14 my $result =
15 /^0$/
16 ? 1 # Zero? Add one
17 : /^\d$/
18 ? $_-1 # Single digit? Subtract one
19 : /^(.+)(.?)(??{reverse $1})$/
20 ? ($1-1) # Palindrome? Decrease first part
21 .
22 (length($1-1)==length($1)
23 ? $2 # Conserved length? Insert middle part.
24 : length($2)
25 ? 99 # Finite middle part? Replace by 99
26 : 9 # or add a 9
27 )
28 . reverse($1-1) # Finish palindrome
29 : /^(.+)(.?)(??{"."x length $1})$/ # Generic case
30 && $1.$2.reverse $1 # Reverse first part
31 ;
32 say "$original -> $result";
33 }
Example:
./ch-1.pl 123 2 1400 1001 10800 10801 0 01 010
Results:
123 -> 121
2 -> 1
1400 -> 1441
1001 -> 999
10800 -> 10801
10801 -> 9999
0 -> 1
01 -> 0
010 -> 11
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.
I expected this problem to have a magical solution. I can first construct the conectivity
matrix C of the system, for which there is a row and a column for every
entry. If two entries are connected, i.e., one is to one side of the
other or above/below the other and they have the same symbol, then the
corresponding entry in the connectivity matrix is a one. If not, it is a
zero. Similarly, I can make a adjancency matrix A, a diagonal matrix
given by the number of conenctions of each node. Consider a
vector V with one entry for each node and for which each value is either
a 1 or a 0. If I multiply W=C·V each entry in W would be equal to
the number of its occupied neighbors. If all the occupied connected neighbors of
a node are full then the result for that node would be the number of such
neighbors. If I subtract that number of neighbors, the result is
zero. Thus, if I multiply the so called Laplacian matrix, L=C-A by a
vector with 1’s at all sites of a
given contiguous block, the result is 0. In other words, that vector
is an eigenvector of L corresponding to an eigenvalue 0. Thus, the
multiplicity of the eigenvalues of L with value 0 is the number of
connected components. I expected the number of finite values in each
eigenvector to be the size of the corresponding connected
cluster. Finally, if V_i is an eigenvector, the size of the
corresponding block may be obtained through the participation ratio
P=(Σ |V_i|^2)^2/Σ |V_i|^4. Notice that if V_i has a relatively
large value ≈α and almost constant for N entries, the numerator
would be ≈N^2|α|^4 while the denominator would be
≈N|α|^4. Nevertheless, as a linear combination of eigenvectors with
the same eigenvalue is also an eigenvector, in general, the eigenvectors
of L are a linear
combinations of the vectors described above, with possibly
different entries corresponding to nodes of different components.
Thus, the approach above did work some examples but failed for others.
I started over again by building the connectivity matrix. I initialize a vector with a 0 entry for each site. I occupy one site and multiply repeatedly by the connectivity matrix, adding adjacent sites to the vector, until no further sties are occupied. That corresponds to a filled cluster. I note its size, add a particle and iterate again until I fill a second cluster, and continue similarly until I fill all the clusters and identify the largest.
I assume the inputs are provided in @ARGV as string representations
of the matrix of the form "[[oxxo...][xoxo...]...]". I convert each
argument to a numerical matrix, translating x->1 and o->0. I use
the Perl Data Language PDL to manipulate tha resulting matrices.
If the input matrix is of dimensions N×M the connectivity matrix
would be of dimensions NM×NM. I take advantage of the reshape
capability of PDL to treat the same matrix as a four dimensional hypercube
with dimensions N×M×N×M such that the i,j,k,l element is a 1 iff
there is a connection between site i,j and site k,l.
The full code is:
1 # Perl weekly challenge 288
2 # Task 2: Contiguous Block
3 #
4 # See https://wlmb.github.io/2024/09/23/PWC288/#task-2-contiguous-block
5 use v5.36;
6 use experimental qw(try);
7 use PDL;
8 use PDL::NiceSlice;
9
10 sub PDL::md :lvalue ($t) { # take diagonal i=k j=l of 4d matrix with indices ijkl
11 $t->diagonal(0,2)->diagonal(1,2);
12 }
13
14 die <<~"FIN" unless @ARGV;
15 Usage: $0 M1 M2...
16 to find the size of the largest contiguous component of the matrices
17 M1 M2...
18 Each matrix M1 should be a string of the form [[oxxo...][xoxo...]...]
19 i.e., a matrix of rows formed of cells, each of which is occupied by
20 either an 'x' or an 'o'
21 FIN
22 # Slices to shift 4d matrices ijkl along the horizontal ik or vertical jl directions.
23 my @slices=("1:-1,:,0:-2", "0:-2,:,1:-1","1:-1,:,1:-1", "0:-2,:,0:-2");
24 for(@ARGV){
25 my $orig=$_;
26 my $matrix;
27 try {
28 die("Invalid string: $_") unless /^\[\s*(\[\s*[xoXO]+\s*\]\,?)+\s*\]$/;
29 s/o|O/0,/g;
30 s/x|X/1,/g;
31 $matrix=pdl($_);
32 } catch($e) {
33 warn $e;
34 next;
35 }
36 my $connectivity=zeroes($matrix->dims, $matrix->dims); # i,j,k,l
37 map {$_->md.=$matrix(0:-2)==$matrix(1:-1)} # check horizontal...
38 map{$connectivity("$_,:")}@slices[0,1] if($matrix->dim(0)>1);
39 map {$_->md.=$matrix(:,0:-2)==$matrix(:,1:-1)} # and vertical connections
40 map{$connectivity(":,$_")}@slices[0,1] if($matrix->dim(1)>1);
41 my $dim=$matrix->nelem;
42 my $connectivity_matrix=$connectivity->reshape($dim,$dim); # ij,kl
43 my $occupied=zeroes(1,$dim); # empty column vector
44 my $largest=0; # size of largest cluster
45 my $cluster=0; # total occupied sites
46 for(0..$dim-1){
47 next if $occupied(0,$_); # skip if already occupied
48 $occupied(0,$_).=1; # add traveller
49 while(1){
50 my $next=$occupied|(($connectivity_matrix x $occupied)!=0);
51 last if all($next==$occupied);
52 $occupied=$next; # update visited sites
53 }
54 $cluster+=my $current=$occupied->sum-$cluster;
55 $largest=$current if $current>$largest;
56 }
57 say "$orig -> $largest";
58 }
Examples:
./ch-2.pl "[ [xxxxo][xoooo][xoooo][xxxoo] ]" "[ [xxxxx][xoooo][xxxxo][xoooo] ]" \
"[ [xxxoo][oooxx][oxxoo][oooxx] ]"
Results:
[ [xxxxo][xoooo][xoooo][xxxoo] ] -> 11
[ [xxxxx][xoooo][xxxxo][xoooo] ] -> 11
[ [xxxoo][oooxx][oxxoo][oooxx] ] -> 7
Some degenerate examples:
./ch-2.pl "[ [x] ]" "[ [xxoxxx] ]" "[ [x][x][o][x] ]"
Results:
[ [x] ] -> 1
[ [xxoxxx] ] -> 3
[ [x][x][o][x] ] -> 2
I could compress the code above into a six liner, removing some tests and some generality. I changed the input format to something that can be understood directly by PDL. It was fun, but the result is not too illustrative, though.
Examples:
perl -MPDL -MPDL::NiceSlice -E '
sub PDL::d :lvalue ($t) {$t->diagonal(0,2)->diagonal(1,2)}for(@ARGV){$o=$_;$m=pdl($_);
@s=("1:-1,:,0:-2", "0:-2,:,1:-1","1:-1,:,1:-1", "0:-2,:,0:-2");$c=zeroes($m->dims, $m->dims);
map {$_->d.=$m(0:-2)==$m(1:-1)}map{$c("$_,:")}@s[0,1];map {$_->d.=$m(:,0:-2)==$m(:,1:-1)}
map{$c(":,$_")}@s[0,1];$dim=$m->nelem;$c_m=$c->reshape($dim,$dim);$p=zeroes(1,$dim);$b=0;$l=0;
for(0..$dim-1){next if $p(0,$_);$p(0,$_).=1;while(1){$x=$p|(($c_m x $p)!=0);last if all($x==$p);
$p=$x;}$l+=$u=$p->sum-$l;$b=$u if $u>$b;}say ": $o -> $b";}
' "[ [1,1,1,1,0][1,0,0,0,0][1,0,0,0,0][1,1,1,0,0] ]" \
"[ [1,1,1,1,1][1,0,0,0,0][1,1,1,1,0][1,0,0,0,0] ]" \
"[ [1,1,1,0,0][0,0,0,1,1][0,1,1,0,0][0,0,0,1,1] ]"
Results:
: [ [1,1,1,1,0][1,0,0,0,0][1,0,0,0,0][1,1,1,0,0] ] -> 11
: [ [1,1,1,1,1][1,0,0,0,0][1,1,1,1,0][1,0,0,0,0] ] -> 11
: [ [1,1,1,0,0][0,0,0,1,1][0,1,1,0,0][0,0,0,1,1] ] -> 7