Finding Squares in Matrices

I don't usually take part in the Perl Weekly Challenge but one of this week's challenges caught my eye. I thought it could be a fun thing to attempt and decided to use Zydeco to help solve it.

The problem is that you're given a matrix of 0s and 1s:

You need to find any squares (equal length sides) where all four corners are 1s:

Arguably it's not a task best suited for object-oriented programming; a more functional style might suit the problem better, but this is how I did it.

use strict;
use warnings;
package Weekly84 {
use Zydeco;
class Matrix {
# public required attribute
has cells! ( type => ArrayRef[ArrayRef[Bool, 1], 1] );
# lazy attributes
has n, m ( is => lazy, isa => PositiveInt, init_arg => undef );
method _build_m = scalar @{ $self->cells };
method _build_n = scalar @{ $self->cells->[0] };
# private method which acts as helper for factories
method $process ( $text ) {
[ map [ /([01])/g ], grep /[01]/, split /\n/, $text ]
}
# factories to make a new Matrix object from an ArrayRef or Str
multi factory new_matrix ( ArrayRef $cells )
= $class->new( cells => $cells );
multi factory new_matrix ( Str $text )
= $class->new( cells => $class->$process($text) );
# method to fetch a cell
method cell ( PositiveInt $x, PositiveInt $y ) {
confess 'Out of range' if $x > $self->m;
confess 'Out of range' if $y > $self->n;
$self->cells->[$x-1][$y-1];
}
# detect a square with size $size and top left corner at $x, $y
method has_square ( Int $x, Int $y, PositiveInt $size ) {
$self->cell( $x, $y ) and
$self->cell( $x+$size, $y ) and
$self->cell( $x+$size, $y+$size ) and
$self->cell( $x, $y+$size );
}
# find all squares within the matrix
method find_squares ( Bool $verbose = false ) {
my $smallest_axis = ( $self->m < $self->n ) ? 'm' : 'n';
my $max_size = $self->$smallest_axis();
my @found;
X: for my $x ( 1 .. $self->m ) {
Y: for my $y ( 1 .. $self->n ) {
SIZE: for my $size ( 1 .. $max_size ) {
next Y if $size + $x > $self->m;
next Y if $size + $y > $self->n;
if ( $self->has_square( $x, $y, $size ) ) {
say "Found size $size square at $x, $y." if $verbose;
push @found, [ $x, $y, $size ];
}
}
}
}
say "Found ", scalar( @found ), " squares." if $verbose;
return @found;
}
}
}
'Weekly84'->new_matrix( <<'MATRIX' )->find_squares(1);
[ 0 1 0 1 0 1 0 0 1 ]
[ 1 0 1 0 0 0 0 0 0 ]
[ 1 1 0 1 0 0 0 0 0 ]
[ 1 1 1 1 0 1 0 0 1 ]
MATRIX
view raw pw-84-matrix.pl hosted with ❤ by GitHub

Sample output:

Found size 2 square at 1, 2.
Found size 3 square at 1, 6.
Found size 2 square at 2, 1.
Found size 1 square at 3, 1.
Found 4 squares.

Leave a comment

Sign in to comment.

About Toby Inkster

user-pic I'm tobyink on CPAN, IRC and PerlMonks.