Perl Weekly Challenge 084

(Originally published on samirparikh.com. Apologies in advance for going into some of the minute details of my thought process but I thought this might help others who are learning the language like I am.)

As I mentioned in yesterday's post, I've been trying to learn the Perl programming language. You can read all the books and tutorials you want, but for me, the only way to really learn a language is to apply it to real world problems. Unfortunately for me, I currently don't have any real world problems (suitable to be solved by Perl) so I've been practicing by solving coding puzzles on the internet. In addition to making my way through the bioinformatics site Rosalind, I've also started working on the Perl Weekly Challenges. This week, I managed to muddle my way through the latest installment, Challenge 084. The deadline to submit solutions is fast approaching so if you haven't solved it yourself yet, you may want to come back to this post later.

Task 1

Task #1, "Reverse Integer", asks the following:

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

The approach I took to solve this was pretty simple. First, check whether the input supplied by the user was in fact an integer using the regulation expression /^[+-]?\d+\z/. Assuming an integer was supplied, I then check whether it exceeds the limit of a 32-bit signed integer. A 32-bit integer is 2 to the 32nd power (or 2^32) which equals 4,294,967,296. (Technically, 4,294,967,295 is the largest 32-bit unsigned integer since you have to also account for 0. The largest 32-bit signed integer is 2,147,483,647 (2^32 - 1), which also happens to be the eighth Mersenne prime number.) A signed integer, which has to account for both positive and negative values, has a range from -2,147,483,647 to 2,147,483,647.

Assuming we now have a valid integer, $number, we can reverse it using scalar reverse($number). The only edge case we have to consider is if the integer is negative. A simple solution could then be:

#!/usr/local/bin/perl

use warnings;
use strict;

chomp(my $number = <STDIN>);

die "Not an integer" unless $number =~ /^[+-]?\d+\z/;

if ($number > 2147483647 || $number < -2147483647) {
    print "0\n";
} else {
    if ($number < 0) {
        $number = $number * -1;
        print "-", scalar reverse($number), "\n";
    } else {
        print scalar reverse($number), "\n";
    }
}

Task 2

Task #2, "Find Square", was much more complex. It states:

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

The way I tackled this task was to break it down into a series of smaller, more manageable challenges that I could address one at a time. At a high-level, those smaller challenges were:

  1. Figure out how to take in the puzzle input and store that in a matrix.
  2. We know that the smallest square possible is 2x2. Determine the size of the largest square possible in the matrix, assuming that the input itself is not always square like in the examples provided.
  3. Go through all of the various squares for all possible square sizes and check whether all of the indices of the squares are equal to 1. If so, provide the required output.

The first sub-task was to figure out how to take the input and process it into a matrix, or a two-dimensional array. This ended up being the most complicated portion of the solution. My first assumption was that the puzzle input would be provided in a separate text file that would be provided as the first argument after the name of the script on the command line. For example, if the name of the Perl script is ch-2.pl and the input was provided in the file ch-2-input.txt, I would run the script on the command line like this:

$ ./ch-2.pl ch-2-input.txt

I am also assuming that the input file, ch-2-input.txt in this example, would be formatted as follows:

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

To do all of this, I created a subroutine called define_matrix. It takes as its only argument ($_[0]) the filename that was provided when the script was run ($ARGV[0]). It goes through the file line-by-line using a while loop. For each line, it removes the leading left bracket and space ([_) and ending space and right bracket (_]) using two substitution regular expressions: s/\[ // and s/ \]//.

Each line is converted into a list and stored in the array @line using the split / / command. That list, or row of input, is then added to our matrix stored in @matrix using the push operator:

push (@matrix, [@line])

This command took me awhile to figure out because while I was familiar with the push operator, I was only accustomed to adding one scalar at a time to traditional array. I didn't know how to add an array (@line) to an existing array (@matrix) to create a "list of lists". The key to doing this is those brackets. If @matrix originally contains [1, 2, 3] and @line is equal to [4, 5, 6], then the command

push (@matrix, @line)

results in @matrix containing [[1, 2, 3], 4, 5, 6]. In other words, the first element in @matrix is [1, 2, 3], the second is 4, the third is 5 and so on. Including those brackets around @line gives me what I am looking for: [[1, 2, 3], [4, 5, 6]]. I believe these are called anonymous arrays, something I need to research further.

The @matrix isn't really a matrix or two-dimensional array as you normally would think. Rather, it is just a "list of lists". Each element of the "matrix" can be accessed using the appropriate row/column index. For example, $matrix[1][2] contains the element residing in the third column of the second row (since the row/column indices start at 0). In the example above, $matrix[1][2] would equal 6. (As I was trying to solve this problem, I found the CPAN module Data::Dumper indispensable in helping me figure out what was being stored in my arrays.)

Once we're done reading through the input file and composing our matrix, we're ready to return it, along with the number of rows and columns, back to the main program. Here again, I encountered another issue when trying to return a mix of scalars and arrays. When I originally tried

return (@matrix, $rows, $columns)

the number of rows and columns were appended to @matrix leaving $rows and $columns as UNDEF. Apparently Perl subroutines return a flat list; there's no good way that I am aware of (without using references) to do this more cleanly so I cheated and switched the order of the elements I was returning to

return ($rows, $columns, @matrix)

This automatically assigns the first elment to $rows, the second to $columns and everything else to @matrix.

The second sub-task was to find the largest possible square that can fit in our matrix. For this challenge, I was assuming that the number of rows (m) did not always equal the number of columns (n). Therefore, all I had to do was find the minimum between them using the CPAN module List::Util.

The final sub-task of this problem is to navigate all the possible squares and check whether all four indices are equal to 1. I do this via three nested loops:

  • The outer loop checks all possible square sizes, starting at 2x2 and then going up to and including the largest possible size.
  • The middle loop iterates through all of the possible columns for what will be the top left corner of the square we are checking.
  • The inner loop iterates through all of the possible rows for what will be the top left corner of the square we are checking.

A multi-part if statement checks the value of all four indices to see if they equal 1. If they do, we print the appropriate message and increment our counter. Phew!

Putting it all together, we get something like this:

#!/usr/local/bin/perl

use v5.10;
use warnings;
use strict;
use List::Util qw(min);

sub define_matrix {
    open (INPUT, '<', $_[0]) or die "$!: could not open file $_[0]";
    say "Input:";
    my (@line, @matrix, $rows, $columns);
    while (<INPUT>) {
        chomp;
        say $_;
        s/\[ //;
        s/ \]//;
        @line = split / /, $_;
        push (@matrix, [@line]);
    }
    close (INPUT) or die "$!: could not close file $_[0]";
    $rows    = scalar @matrix;
    $columns = scalar @line;
    return ($rows, $columns, @matrix);
}

my ($rows, $columns, @matrix) = &define_matrix($ARGV[0]);
my $max_square_size = min($rows, $columns);
my $match = 0;

for (   my $square_size = 2;
        $square_size <= $max_square_size;
        $square_size++
        ) {
    for (my $c = 0; $c <= $columns - $square_size; $c++) {
        for (my $r = 0; $r <= $rows - $square_size; $r++) {
# check top left, bottom left, top right and bottom right corners
            if (
                $matrix[$r][$c] == 1 &&
                $matrix[$r + $square_size - 1][$c] == 1 &&
                $matrix[$r][$c + $square_size - 1] == 1 &&
                $matrix[$r + $square_size - 1][$c + $square_size - 1] == 1
                ) {
                $match++;
                say "Found one square (${square_size}x${square_size}) " .
                "in the given matrix with four corners as 1 " .
                "starts at r=", $r + 1, "; c=", $c + 1, ".";
            }
        }
    }
}

I'm eager to see how others have solved this problem in the coming days to see where I can improve. I certainly appreciate the blog posts of Laurent Rosenfeld and his detailed explanations of his solutions. I also like that Mohammad hosts a GitHub repository with everyone's entries so you see how others assembled their solutions. Let's see how we get along with next week's challenges!

3 Comments

Parsing the input matrix can be made a lot simpler.

my @matrix = map [/([01])/g], grep /[01]/, <$fh>;

This:

my @newlist = map { BLOCK } @oldlist;

Is basically just a shortcut for:

my @newlist = ();
for my $item ( @oldlist ) {
    local $_ = $item;
    my @got = do { BLOCK };
    push @newlist, @got;
}

And if the block is just a simple expression like a regexp, then you don't need the curly braces. So for example, to lowercase a bunch of strings:

my @lowercase = map lc, @uppercase;

Leave a comment

About Samir Parikh

user-pic Someone who knows very little about programming and even less about Perl.