Solving Perl Weekly Challenge 084

2 tasks from Perl Weekly Challenge 084. One for reversing interes while keeping thsign, another one is to count the number of squares with all 4 corners being 1 whthin a 01 matrix.

Task #1: Reverse Integer

Submitted by: Mohammad S Anwar

You are given an integer $N.

Write a script to reverse the given integer and print the result. Print 0 if the result doesn’t fit in 32-bit signed integer.

The number 2,147,483,647 is the maximum positive value for a 32-bit signed binary integer in computing.
Example 1:

Input: 1234
Output: 4321

Example 2:

Input: -1234
Output: -4321

Example 3:

Input: 1231230512
Output: 0

In Perl, the conversion between numbers and strings happens automatically based on what operators are being used. To flip a number, you just feed into a function that flip the string -- which is reverse under scalar context:

# Perl -- flip-integer.pl - v1
use v5.32;

sub flip_integer($n) {
    my $o = reverse($n);
}

my $o = flip_integer(1234);

say $o; #=> 4321

BTW, reverse works very differently under list context -- in which the input list is reversed. It diffs so much that I consider it to be just a different function than when it is under scalar context.

# Perl
use v5.32;

my @o = reverse(1234, 5678);
say join " ", @o;
#=> 5678 1234

my $o = reverse(1234, 5678);
say $o;
#=> 87654321

While automatic type coercion has its benefit, there are downsides as well. reverse-ing negative numbers, or numbers with zeros would really reveal the stringy nature of it. Let's try processing @ARGV:

# Perl - flip-integer.pl - v2
use v5.32;

sub flip_integer {
    my $n = shift;
    my $o = reverse($n);
    return $o;
}

for my $n (@ARGV) {
    my $o = flip_integer($n);
    say "$n -> $o";
}

For example:

# perl flip-integer.pl 1234 00100 -678 
1234 -> 4321
00100 -> 00100
-678 -> 876-

In these examples, the output for -678 should be -876, while the output for 00100 should be 1. This tells us that the sign of the input must be extracted, as well as leading zeros.

This task comes with an extra statement that the result should be 0 when it exceed the range of 32 bit integer. The integers in perl are now 64 bits. I'm just going to manually put this constraint at the end instead of doing proper overflow detection:

Here's the final version:

# Perl - flip-integer.pl - v3
use v5.32;

sub flip_integer {
    my $n = shift;
    my $sign = $n < 0 ? -1 : 1;
    my $o = $sign * reverse(abs($n));
    return (-2**31 <= $o < 2**31) ? $o : 0;
}

for my $n (@ARGV) {
    my $o = flip_integer($n);
    say "$n -> $o";
}

The Raku version looks more or less the same, although the string-flipping subroutine is named, well, flip:

# Raku
sub reverse-integer (Int $n) {
    my $sign = $n < 0 ?? -1 !! 1;
    my $o = $sign * flip abs $n;
    return (-2³¹ ≤ $o < 2³¹) ?? $o !! 0;
}

for @*ARGS -> $n {
    say $n ~ " -> " ~ reverse-integer($n.Int);
}

I explicitly let the type of input $n of the reverse-integer subroutine to be Int, but it does not seem to effect much comparing to the version without this type annotation. The code seems to work exactly the same when the input is indeed an integer. It differs when the input is not integer. If we havev input $n = 3.14, without the type annotation on reverse-integer, we get 41.3 on the way out. While $n.Int gives us 3.

BTW, feeding 3.14 to flip-integer.pl would give us 41.3 as well. We could add $n - int($n) upon subroutine entry to convert the number to integer.

TASK #2 › Find Square

Submitted by: Mohammad S Anwar

You are given matrix of size m x n with only 1 and 0.

Write a script to find the count of squares having all four corners set as 1.
Example 1:

Input: [ 0 1 0 1 ]
[ 0 0 1 0 ]
[ 1 1 0 1 ]
[ 1 0 0 1 ]

Output: 1

Explanation:
There is one square (3x3) in the given matrix with four corners as 1 starts at r=1;c=2.

[ 1 0 1 ]
[ 0 1 0 ]
[ 1 0 1 ]

Example 2:

Input: [ 1 1 0 1 ]
[ 1 1 0 0 ]
[ 0 1 1 1 ]
[ 1 0 1 1 ]

Output: 4

Explanation:
There is one square (4x4) in the given matrix with four corners as 1 starts at r=1;c=1.
There is one square (3x3) in the given matrix with four corners as 1 starts at r=1;c=2.
There are two squares (2x2) in the given matrix with four corners as 1. First starts at r=1;c=1 and second starts at r=3;c=3.
Example 3:

Input: [ 0 1 0 1 ]
[ 1 0 1 0 ]
[ 0 1 0 0 ]
[ 1 0 0 1 ]

Output: 0

Brute-force solutoin first: Find all squares with the length of its side being 2, 3, 4... up to min(m,n). The answer is just the count of these squares.

Here's the solution written in Perl:

use v5.32;
use List::Util qw(min);

sub find_squares {
    my $matrix = shift;

    say "\n# Matrix";
    for my $row (@$matrix) {
        say join " ", @$row;
    }

    say "#=> squares -> " . squares($matrix);
}

sub squares {
    my ($matrix, $s) = @_;
    my $h = @$matrix;
    my $w = @{$matrix->[0]};

    my $c = 0;
    for my $s (2..min($w,$h)) {
        for my $i (0..$h-$s) {
            for my $j (0..$w-$s) {
                if (1 == $matrix->[$i][$j] == $matrix->[$i+$s-1][$j] == $matrix->[$i][$j+$s-1] == $matrix->[$i+$s-1][$j+$s-1]) {
                    $c += 1;
                }
            }
        }
    }
    return $c;
}

The core part of this algorithm, the squares subroutine, is just a good old style of 3-level nested for loops for enumerating squares of all sizes. No fancy syntax or languages features.

Here's the Raku version:

sub find-squares(@matrix) {
    say "\n# Matrix";
    say .gist for @matrix;
    say "#=> squares -> " ~ squares(@matrix);
}

sub squares(@matrix) {
    return (2 .. min(@matrix.elems, @matrix[0].elems)).map(
        -> $s {
            ((0..@matrix.elems-$s) X (0..@matrix[0].elems-$s)).grep(
                -> @c {
                    1 == [[0,0], [$s-1,0], [0,$s-1], [$s-1, $s-1]]
                    .map({ $_ <<+>> @c })
                    .map({ @matrix[ $_[0] ][ $_[1] ] })
                    .all
                }
            ).elems
        }).sum;
}

It is really convenient to have one X operator to yield the cross product of 2 sets. One short expressions replaces a 2-level nested loop.

In the part to tell whether all 4 corners are all 1s, I use the hyperoperator <<+>> and all-Junction, with the intention to familirize myself with these language features as well as evaluating the overall readibilty.

Roughly speaking, until I fully grasp the intuitive meaning of those operators, it still takes a big chunk of brain power to fully understand those expressions. I shall keep trying and see if they can be used to produce some nice and readible code.

本文為〈解 Perl Weekly Challenge 084〉之英文版。