Permutations and Recursion

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

Perl Podcasts

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

Perl Weekly Challenge 085

(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!

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!

Adventures in Perl

(Originally published on samirparikh.com.)

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 nex…

About Samir Parikh

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