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 ]
    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):

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!

(Originally published on samirparikh.com.)

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.

(Originally published on samirparikh.com.)

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

(Originally published on samirparikh.com.)

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

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

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!