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 `push`

ing 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, "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 ]
Output:
[ 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):

- Get the elements in the first row using the statement
`push ( @spiral, @{$array[0]} )`

. - Get the elements in the right column, going down, using the
`for my $y`

loop - Get the elements of the last row (in reverse order) using the statement
`push ( @spiral, reverse ( @{$array[$#array]} ) )`

. - 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:

- The array has just one row.
- The array has just one column.
- The array has just two rows.
- 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!

]]>You're correct about the "arrays of arrays" part. This is one area of Perl that has been challenging for me. I just need to find time to read through all of the excellent documentation!

]]>In one of my earlier posts describing how I solved the Perl Weekly Challenge tasks, I mentioned that I got a bit lazy and resorted to using a CPAN module to determine all of the combinations of elements to satisfy the conditions of the puzzle. One of the things that drew me to Perl in the first place is the almost 200,000 ready-to-go modules available in CPAN to help you solve almost any conceivable problem. Chances are, if you have a programming issue to solve, someone else already has. There's a reason the "C" in CPAN stands for "Comprehensive"! As someone who is trying to learn Perl, I think it's a valuable skill to know how to search the archive and leverage these modules. It's what allows you to extend Perl beyond it's standard capabilities. And truth be told, I know that a big part of solving combination and permutation problems often requires the use of recursive functions, something I can never get my head around no matter what programming language I'm using. But something has been nagging me over the past few days since I wrote that blog article to the point where the guilt about being too lazy and the void left about not really understanding recursion finally pushed me over the edge to tackle this one more time.

Recursion is the act of solving a complex problem by breaking it down into smaller and smaller subsets of the same problem. A classic example is using recursion to determine the next number in the Fibonacci sequence. Beginning with 0 and then 1, each successive number in the Fibonacci sequence is equal to the sum of the prior two numbers. Therefore, if F0 = 0 and F1 = 1, then the third number, represented by F2, is equal to F1 + F0. Therefore:

F2 = F1 + F0

F2 = 1 + 0

F2 = 1

Likewise, the fourth number in the sequence, F3, can be calculated as:

F3 = F2 + F1

F3 = (F1 + F0) + F1

F3 = 1 + 0 + 1

F3 = 2

Therefore, the first 10 numbers in the Fibonacci sequence are:

0, 1, 1, 2, 3, 5, 8, 13, 21, 34, ...

You can generalize the sequence such that

Fn = Fn-1 + Fn-2

for `n > 1`

and using this information, we can create a *recursive* function in Perl (or any other language) as follows:

```
sub fibonacci {
if ($_[0] == 0) {
return 0;
} elsif ($_[0] == 1) {
return 1;
} else {
return &fibonacci($_[0] - 1) + &fibonacci($_[0] - 2);
}
}
print &fibonacci(7), "\n"; # 13
```

The function is *recursive* because it calls itself. The reason this doesn't turn into an endless loop is that we first check whether a "base case", or terminating condition, is satisfied *before* we have the function call itself. In this situation, the base case is whenever `n = 0`

or `n = 1`

. Recursion can be used to algorithmically solve other problems as well, such as calculating the factorial of a number or in solving the Towers of Hanoi puzzle. For my case though, I wanted to see if I could come up with a function to calculate all of the permutations of the elements of an array without using a Perl CPAN module.

There are many tutorials and articles on the internet that show you various implementations of a recursive function to derive permutations. And there are no shortage of Perl-specific implementations as well. For example, the Perl FAQ page contains an implementation as does the Perl Cookbook. For my implementation, however, I took inspiration from CPalli's article on a Python implementation of a recursive function to find permutations. I found his writeup to be more insightful and easier to understand than many of the other articles I came across. I encourage you to read it before continuing here as it will help explain the logic behind my Perl port of it. The key insight I took away from CPalli's post is that to find the `n!`

(factorial) permutations of `n`

elements in an array, you temporarily remove one element, find all the permutations of the remaining elements, and then add the element you originally removed back to the permutations you found. This gives you all possible permutations for your elements. The base case in this example is if you only have one element, in which case the only permutation is that element itself.

To illustrate this with the simple example of three elements (1, 2, 3), he has a neat visualization that demonstrates this recursive property:

```
1 2 P[3] = 1 2 3
1 P[2 3] =
1 3 P[1] = 1 3 2
2 1 P[3] = 2 1 3
P[1 2 3] = 2 P[1 3] =
2 3 P[1] = 2 3 1
3 1 P[2] = 3 1 2
3 P[1 2] =
3 2 P[1] = 3 2 1
```

This can be generalized to:

```
1 P[2 3 .. N]
2 P[1 3 .. N]
P[1 2 .. N] = ..
..
N P[1 2 .. (N-1)]
```

which can form the basis of our recursive function. Again, CPalli does a nice job in his blog post detailing a recursive solution to this using Python. He walks through an example and shows how the permutations are derived step-by-step. Using his example, I came up with the following Perl implementation:

```
#!/usr/local/bin/perl
use warnings;
use strict;
use v5.10;
sub perm {
my @out;
my @in = @_;
if (scalar(@in) == 1) {
return @in;
} else {
for my $i (0 .. $#in) {
foreach (&perm(@in[0 .. $i-1], @in[$i+1 .. $#in])) {
push(@out, $in[$i].$_);
}
}
}
return @out;
}
say join(", ", &perm(1 .. 3)); # 123, 132, 213, 231, 312, 321
```

The key insight I referred to earlier is implemented in the `push`

function, specifically this bit here:

```
$in[$i].$_
```

which adds back the element that was originally removed (`$in[$i]`

) to the permutations of the remaining elements that were returned by the recursive call to the `perm`

subroutine in the preceding line.

It works, but I'm not terribly happy about it. My main issue is that the subroutine returns an array of the permutations in a string format (e.g. `123, 132, 213, 231, 312, 321`

), like the Python implementation it was modeled on. I'd prefer if each permutation was returned as an array, something like:

```
[[1,2,3], [1,3,2], [2,1,3], [2,3,1], [3,1,2], [3,2,1]]
```

That way, you can more easily iterate through the results which is typically what you want to do with the permutations. If anyone has any suggestions on how to make that happen, perhaps with the use of references and arrays of arrays or something similar, please let me know! I've already started thinking about this!

*Apologies for the unclear subscripts above when discussing the Fibonacci sequence. I'm not sure how to create subscripts using the Moveable Type flavor of Markdown.*

Like any well-entrenched programming language, Perl has a rich history and a number of personalities who shape and lead its community. In addition to wanting to learn its syntax and how to write simple scripts with it, I'm also trying to learn more about that history and the people who influence it today. I do this by following some blogs (which perhaps I'll write about later) and reading online books and articles but the best way for me is to listen to relevant podcasts. I'm an avid podcast listener and love learning about new concepts or technologies while walking the dog, doing the dishes, or pre-pandemic, sitting in traffic. Over the past few weeks, I've been listening to some contemporary as well as not so recent Perl-related podcasts and thought I'd share some select episodes that others may find interesting:

Software Engineering Radio Episode 432 with brian d foy on Perl 7. This episode was recently published on 30 October 2020 and was fun to listen to as host Gavin Henry speaks with brian about not only Perl's history, but also where Perl 7 development fits in with Perl 5 and what developers should be thinking about regarding a future transition. Along with Randall Schwartz and Tom Phoenix, brian was a co-author of "Learning Perl" which is what I used to pick up most of what I know about Perl and the author of The Effective Perler web site.

Mapping the Journey Episode 13 with Damian Conway, author of "Perl Best Practices and, along with chromatic and Curtis "Ovid" Poe of "Perl Hacks". In this episode from 2017, host Pramod Shashidhara talks with Damian on the development and evolution of Perl 6, which is now known as Raku. I'm barely able to wrap my head around Perl, let alone Raku, but it was still interesting to hear about some of the considerations and philosophies that went into the design of what is now known as the sister language to Perl.*

System Smarts Episode 203, from 2016, with the man himself, Larry Wall. This is the only podcast episode I've found with the creator of Perl and was delighted to hear what a humble, thoughtful and engaging person Larry Wall is. I had never heard of his earlier work, such as the Unix updating tool Patch) and found his thoughts on technology and community really fascinating to listen to.

The Changelog Episode 133 "All Things Perl" with Curtis "Ovid" Poe. In addition to "Perl Hacks" above, Ovid is also the author of "Beginning Perl" which is another book I need to read. I'm a big fan of "The Changelog" so it was good to find this episode in their back catalog from 2014. You get to hear how Ovid chose his nickname, the role of object oriented programming in Perl and the evolution of Perl 6 and the differences between Perl 5.

FLOSS Weekly. Randall Schwartz, who is one of the authors of "Learning Perl", "Intermediate Perl" and a host of other books, is also the host of FLOSS Weekly, a podcast on the TWiT network covering "free, libre and open source software". Because of his connection to the language, there have been a number of past episodes that cover Perl's history, community and projects. Some of the episodes I have listened to include:

- Episode 4 with chromatic.
- Episode 96 on BioPerl which is a collection of modules used in the study of bioinformatics and is used by the Human Genome Project.
- Episode 189 with Jeffrey Thalhammer to discuss his project PerlCritic which is a CPAN module "for creating and applying coding standards to Perl source code."
- Episode 544 with Sawyer X to look at the current state of Perl 5.

Code-Maven Open Source (CMOS) Podcast. Hosted by Gabor Szabo, who also runs the Perl Maven web site and has published a book by the same name, this podcast is a series of short interviews with a number of people involved in the open source and Perl communities. This podcast was the first time I came across Perl projects such as Dancer and Mojolicious.

I really enjoyed listening to these episodes over the past few weeks and they have given me a better appreciation of just how varied and active the Perl community continues to be. If anyone has any other suggestions for Perl-related (or frankly, any other) podcasts that interest you, please do share!

**If you enjoyed this episode, be sure to subscribe to this podcast. In addition to his interview with Damian, Pramod has been able to bag interviews with James Gosling, the creator of Java, Bjarne Stroustrup, the designer of C++, Dave Cheney, a leading contributor to Go, and Matt Mullenweg, the CEO of Automattic, which owns WordPress.com and Tumblr.*

The latest installment of the Perl Weekly Challenge just dropped so I thought I would take a crack at it. Please note that the challenge is still currently open (as of date of publishing) in case you are participating.

Task #1 asks the following:

You are given an array of real numbers greater than zero.

Write a script to find if there exists a triplet

`(a,b,c)`

such that`1 < a+b+c < 2`

. Print 1 if you succeed otherwise 0.

`Example 1:`

`Input: @R = (1.2, 0.4, 0.1, 2.5)`

`Output: 1 as 1 < 1.2 + 0.4 + 0.1 < 2`

`Example 2:`

`Input: @R = (0.2, 1.5, 0.9, 1.1)`

`Output: 0`

`Example 3:`

`Input: @R = (0.5, 1.1, 0.3, 0.7)`

`Output: 1 as 1 < 0.5 + 1.1 + 0.3 < 2`

For the purposes of this task, I assumed that the array of real numbers would be provided in quotes as an argument to the script when you run it:

```
$ ./ch-1.pl "0.5, 1.1, 0.3, 0.7, 0.1, 0.3, 0.2"
```

Therefore, to get the numbers into my `@data`

array, I used the `split`

operator on `$ARGV[0]`

.

I'm afraid I may have been a bit lazy on this challenge and just used a brute-force approach to go through all of the three-number combinations (e.g. *k=3*) using the CPAN module `Algorithm::Combinatorics`

. Also, instead of just returning one combination that meets the triplet requirement, I decided to return all possible combinations if there are more than one. Putting it all together, I came up with:

```
#!/usr/local/bin/perl
use warnings;
use strict;
use feature 'say';
use Algorithm::Combinatorics qw/combinations permutations/;
use List::Util qw/sum/;
# run program as:
# $ ./ch-1.pl "0.5, 1.1, 0.3, 0.7"
my @data = split /, /, $ARGV[0];
my $citer = combinations(\@data, 3);
my $notFound = 1;
while (my $c = $citer->next) {
if (sum(@$c) > 1 && sum(@$c) < 2) {
say "found triplet such that 1 < ", join( " + ", @$c), " < 2";
$notFound = 0;
}
}
say "no triplets found such that 1 < a+b+c < 2" if $notFound;
```

Task #2 says:

You are given a positive integer

`$N`

.Write a script to find if it can be expressed as

`a ^ b`

where`a > 0`

and`b > 1`

. Print 1 if you succeed otherwise 0.

`Example 1:`

`Input: 8`

`Output: 1 as 8 = 2 ^ 3`

`Example 2:`

`Input: 15`

`Output: 0`

`Example 3:`

`Input: 125`

`Output: 1 as 125 = 5 ^ 3`

Again, I'm not really proud of this effort as I just came up with another brute-force solution. For each number, I find the nth root (represented by the variable `$b`

) from 2 up to the number itself. I then round the result (stored in the variable `$a`

) down using the `floor`

function and raise it back up to the power of `$b`

. If the result equals the number we were given, we have found a solution and then print the result to `STDOUT`

. This works because only roots that result in an integer equal the result of taking their `floor`

.

The resulting script can be written as:

```
#!/usr/local/bin/perl
use v5.10;
use POSIX;
use strict;
use warnings;
my ($a, $b,);
my $number = $ARGV[0];
my $notFound = 1;
for (my $b = 2; $b < $number; $b++) {
$a = $number ** (1 / $b);
if (floor($a) ** $b == $number) {
say floor($a), " ^ ", $b, " = ", $number;
$notFound = 0;
}
}
say "0" if $notFound;
```

I'll be interested in what others come up with as these solutions are not efficient for large numbers or arrays but they were easy to come up with, code and test. If you are interested in participating, please remember that the entry deadline is 23:59 GMT Sunday 08 November 2020. Good luck!

]]>We've never met or connected before but I feel like I kind of know you by following your work here, on your YouTube videos and most importantly, the Perl Weekly Challenges you run. As I mentioned on a recent blog post, I never thought I would dip my toes in the Perl waters but your work and contributions to the community were a big factor in it. I'm sorry to hear of the tough times you've been experiencing but am hoping you find your way through it to emerge even stronger and healthier on the other end. Thanks again for all you to for this community.

Samir

]]>Unfortunately, the `map`

function is not something I'm particularly familiar with. Any background, context or otherwise help you could also provide would be greatly appreciated!

Thanks

Samir

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, "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, "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:

- Figure out how to take in the puzzle input and store that in a matrix.
- 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.
- 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!

]]>I will definitely do my best to share what I learn and look forward to seeing what others find too.

Samir

]]>Thank you for your comments and advice! I am familiar with PerlMonks (many of the answers to the questions I was looking for could be found there) and I have signed up for an account. You can find me there as Leudwinus.

I've also been following some of the mailing lists (comp.lang.perl.misc and perl.beginners) as well. Like D, Perl seems to have a great community.

Samir

]]>Just over one year ago, I wrote about how I had become enchanted with the D programming language as part of my journey in exploring new programming languages. I still really like D for all of the reasons I wrote about, but as I alluded to in the conclusion of that piece, I fully expected to “get distracted by the next new shiny thing that comes along.” Turns out that the next new shiny thing happens to be … Perl!

That’s right: a language that Larry Wall first developed back in 1987 happens to have caught my fancy and I’m as surprised as anyone.

When I first started learning Python over ten years ago, I would come across snippets of Perl in solutions submitted to things like Project Euler or in various forum threads. Perl programs had the most opaque and impenetrable syntax I had ever seen, filled with @ after & followed by more $ symbols than I could count. But the further I got into the bioinformatics problems on the Rosalind site, the more I started to understand the power, brevity and design of Perl. It was refreshing to see that regular expressions were treated as a first class citizen and that there were similarities to how Perl and Bash scripts were written (which, to some, could be a disadvantage!) And the more I read about it, the more I began to appreciate its rich heritage and its history alongside the development of Unix.

I picked up a copy of the seventh edition of “Learning Perl” and started educating myself on the language. In order to get some practice and apply what I’ve been learning, I’m redoing some of the Rosalind problems I had originally done in D as well as trying to participate in Mohammad Anwar’s Perl Weekly Challenge.

I’ll do my best to update this site on whatever I learn but if the past six months or so are any indication, don’t hold your breath. And who knows, by the time I find the time to publish a new post, I may be onto something else!

]]>