Despite the holiday week here in the U.S., I was able to tackle this week’s Perl Weekly Challenge. I have to say that this week’s challenge was the most satisfying for me as it allowed me to not only come up with a novel solution (for me!), but it also provided an opportunity for me to leverage two areas of Perl programming that have been a real challenge for me: recursion and references. The deadline to submit solutions for this challenge 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, “Array of Product”, asks the following:

You are given an array of positive integers @N.

Write a script to return an array @M where $M[i] is the product of all elements of @N except the index $N[i].

Example 1:

        Input:
            @N = (5, 2, 1, 4, 3)
        Output:
            @M = (24, 60, 120, 30, 40)
        
            $M[0] = 2 x 1 x 4 x 3 = 24
            $M[1] = 5 x 1 x 4 x 3 = 60
            $M[2] = 5 x 2 x 4 x 3 = 120
            $M[3] = 5 x 2 x 1 x 3 = 30
            $M[4] = 5 x 2 x 1 x 4 = 40

Example 2:

        Input:
            @N = (2, 1, 4, 3)
        Output:
            @M = (12, 24, 6, 8)
        
            $M[0] = 1 x 4 x 3 = 12
            $M[1] = 2 x 4 x 3 = 24
            $M[2] = 2 x 1 x 3 = 6
            $M[3] = 2 x 1 x 4 = 8

Like many of my prior solutions, I settled for using a brute force technique to solve this task. I used an outer for loop iterating a variable $i which moves through each element in the input array @N. An inner for loop using the variable $j does the same thing. Both loops start at index 0 and go through the last index of the array. An if statement checks to see whether or not $i and $j are equal. If they are not, we update the running $product variable which is keeping track of our current product for $M[0], $M[1], etc. to satisfy the “product of all elements of @N except the index $N[i]” portion of the requirement. If i$ and $j are equal, we just move on to the next value of $j. Once we are done executing the inner loop for a given value of $i, we update our output array @M by pushing the current value of $product into the end of the array @M.

This was actually the easy part.

The difficult part was formatting the output to match what was given in the challenge. Not only do you have to print the summary of the products of the elements, e.g.:

@M = (24, 60, 120, 30, 40)

but you also have to print the individual products for each element of @M:

$M[0] = 2 x 1 x 4 x 3 = 24
$M[1] = 5 x 1 x 4 x 3 = 60
$M[2] = 5 x 2 x 4 x 3 = 120
$M[3] = 5 x 2 x 1 x 3 = 30
$M[4] = 5 x 2 x 1 x 4 = 40

The tricky part is you have to print the summary before the individual line items have been determined (i.e. you don’t know what the final elements of the array @M are until you calculate them all).

To solve this portion of the problem, I relied on two string variables: $m_string and $output_string. The former string contains each individual product equation for each element of the array @M:

$M[2] = 5 x 2 x 4 x 3 = 120

I update $m_string by “building it up” during each iteration of the inner for my $j loop by adding each element of the input array @N and the multiplication sign (“x”). The multiplication symbol is printed before each number and thus is not required for the first element, hence the if ($first) statement. At the conclusion of the inner for loop, I update $m_string with the final product:

$m_string .= " = " . $product;

and then append the whole string to $output_string which contains the overall detailed line items:

$output_string .= "\t". $m_string . "\n";

Once we are done executing through both of our loops, I can then print the summary of the @M array followed by the detailed line items which are stored in $output_string. I thought this was a pretty clever solution (for me) to storing the intermediate results before we had to print them. Originally, I was going to write the intermediate results to a temporary file but then thought better of it. Putting it all together, we come up with our solution:

use warnings;
use strict;
use diagnostics;
use v5.10;

# run program as:
# $ ./ch-1.pl "100, 4, 50, 3, 2"
my @N = split /, /, $ARGV[0];
my @M;
my $output_string = "";

for (my $i = 0; $i < scalar(@N); $i++) {
    my $product = 1;
    my $m_string = "\$M[" . $i . "] = ";
    my $first = 1;
    for (my $j = 0; $j < scalar(@N); $j++) {
        my $print_x;
        if ($i != $j) {
            $product = $product * $N[$j];
            if ($first) {
                $print_x = "";
                $first = 0;
            } else {
                $print_x = " x ";
            }
            $m_string .= $print_x . $N[$j]; 
        }
    }
    push (@M, $product);
    $m_string .= " = " . $product;
    $output_string .= "\t". $m_string . "\n";
}

say "Input:\n\t\@N = (", join(", ", @N), ")";
say "Output:";
say "\t\@M = (", join(", ", @M), ")\n";
say "$output_string";

Task 2

Task #2, “Spiral Matrix”, was the one I was both most looking forward to and dreading at the same time! The task states:

You are given m x n matrix of positive integers.

Write a script to print a spiral matrix as a list.

Example 1:

        Input:
            [ 1, 2, 3 ]
            [ 4, 5, 6 ]
            [ 7, 8, 9 ]
        Ouput:
            [ 1, 2, 3, 6, 9, 8, 7, 4, 5 ]

Example 2:

        Input:
            [  1,  2,  3,  4 ]
            [  5,  6,  7,  8 ]
            [  9, 10, 11, 12 ]
            [ 13, 14, 15, 16 ]
        Output:
            [ 1, 2, 3, 4, 8, 12, 16, 15, 14, 13, 9, 5, 6, 7, 11, 10 ]

I was excited because I’ve solved similar spiral challenges like this before using Python, specifically Problem 28 of the Project Euler series of coding problems. In my version, I used a series of for loops to work my way around a two-dimensional array. But for this task of Challenge 088, I wanted to try my hand at using a recursive solution which has been a pain point for me. I also got the sense that this problem would also require me to work with Perl references and multi-dimensional arrays, other areas where I’ve been struggling. But despite these reservations, I plowed ahead and here is what I did.

The main portion of the solution resides in the subroutine return_spiral. I pass it a two-dimensional array, @array, which is formulated using the subroutine define_matrix which I’ve used before. The purpose of return_spiral is to return an array, @spiral, comprised solely of those elements around the perimeter of @array, starting at the top-left corner and then moving in a clockwise fashion, plus the resulting two-dimensional matrix that remains. For example, if we were to pass it the array @array in Example 2 from above:

[  1,  2,  3,  4 ]
[  5,  6,  7,  8 ]
[  9, 10, 11, 12 ]
[ 13, 14, 15, 16 ]

the subroutine should return a simple array @spiral:

(1, 2, 3, 4, 8, 12, 16, 15, 14, 13, 9, 5)

and the remaining two-dimensional array:

[  6,  7 ]
[ 10, 11 ]

which gets passed back to the subroutine in a recursive fashion. To make it recursive, I’d need a statement like:

return ( @spiral, &return_spiral(@array) );

To get the elements around the perimeter of the array, there are four steps (since there are four “sides” to the matrix):

1. Get the elements in the first row using the statement push ( @spiral, @{$array[0]} ).
2. Get the elements in the right column, going down, using the for my $y loop
3. Get the elements of the last row (in reverse order) using the statement push ( @spiral, reverse ( @{$array[$#array]} ) ).
4. Get the elements of the left column, going up, using the for my $i loop.

All recursive functions need what is called a “base case”, or terminating condition. Otherwise, you’d end up in an endless loop. For my subroutine, I actually came up with four base cases which would cause the subroutine to ultimately finish by just returning the spiral portion of the array. Those four cases are:

1. The array has just one row.
2. The array has just one column.
3. The array has just two rows.
4. The array has just two columns.

I check the first two conditions near the beginning of the subroutine. Assuming that the array passed to return_spiral has at least two rows and two columns, I check the third and fourth terminating conditions after we’ve done one “lap” around the array to define @spiral. The checks for the third and fourth base cases is done by the if statement:

if (scalar( @array ) == 2 || scalar ( @{$array[0]} ) == 2)

If that if statement is true, that means that the array that was originally passed to return_spiral only had two rows or two columns, in which case one “lap” around the array is all we need.

If we haven’t hit a base case, the subroutine “trims” off the peripheral elements we’ve populated in the array @sprial using a series of shift and pop statements and concludes with returning both the @sprial array (which contains all of the elements around the perimeter of the original array) and by recursively calling the subroutine itself with the remaining interior elements of @array. The resulting script becomes:

use v5.10;
use warnings;
use strict;

# assumptions:
# matrix does not have to be square
# spiral is clockwise

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

sub return_spiral {
    my @array = @_;
    my @spiral;
# handle special cases
# just one row
    if (scalar(@array) == 1) {
        return ( @{$array[0]} );
# just one column
    } elsif ( scalar ( @{$array[0]} ) == 1 ) {
        for (my $i = 0; $i < scalar(@array); $i++) {
            push ( @spiral, @{$array[$i]}[0] );
        }
        return ( @spiral );
# we have at least a 2 x 2 array
    } else {
# get first row
        push ( @spiral, @{$array[0]} );
# get right column
        my $right_ci = scalar ( @{$array[0]} ) - 1;
        for (my $y = 1; $y < scalar ( @array ); $y++) {
            push ( @spiral, @{$array[$y]}[$right_ci] );
        }
# remove last element from last row
        pop ( @{$array[$#array]} );
# get last row in reversed order
        push ( @spiral, reverse ( @{$array[$#array]} ) );
# get left column
        for (my $i = ($#array - 1); $i > 0; $i--) {
            push ( @spiral, @{$array[$i]}[0] );
        }
# check if resulting array is empty (i.e. we were originally sent
# just a two-row or two-column array to begin with
        if (scalar( @array ) == 2 || scalar ( @{$array[0]} ) == 2) {
            return ( @spiral );
        } else {
# trim array
# trim top row:
            shift @array;
# trim bottom row:
            pop @array;
# remove first and last element from remaining rows
            for (my $i = 0; $i < scalar(@array); $i++) {
                shift ( @{$array[$i]} );
                pop   ( @{$array[$i]} );
            }
            return ( @spiral, &return_spiral(@array) );
        }
    }
}

my @matrix = &define_matrix($ARGV[0]);
my @spiral2 = &return_spiral(@matrix);
say "Output:";
say "[ ", join(", ", @spiral2), " ]";

I suppose that I could have combined the “trim” operations with the statements where I traverse the perimeter in the first place to populate @spiral to tighten up the script, but in the end, that wasn’t an optimization I had the energy to pursue.

As I said before, I really enjoyed working on this week’s tasks and solving the programming and algorithmic challenges they presented. I’m eager to see how others in the Perl Weekly Challenge community came up with their own solution as there is always so much to learn from them. Until next time!