11
\$\begingroup\$

In order to become more familiar with Perl I have implemented a code kata from here.

The task was to write a program which prints out all anagrams for a given word. I'd appreciate your review of my solution:

get_anagrams.pl

use strict;
use warnings;

require 'anagrams.pm';

use feature 'say';


my $number_of_arguments = $#ARGV + 1;
if ($number_of_arguments != 1) {
    say 'Usage: get_anagrams.pl word';
    exit 1;
}

foreach my $word (get_permutations($ARGV[0])) {
    say $word;
}

anagrams.pm

use strict;
use warnings;


sub get_permutations
{
    my $string = shift;

    my @permutations = ();
    my @letters = split //, $string;
    my $number_of_letters = scalar(@letters);

    if ( $number_of_letters == 1 ) {
        push @permutations, $letters[0];
    }
    elsif ( $number_of_letters == 2 ) {
        push @permutations, $letters[0] . $letters[1];
        push @permutations, $letters[1] . $letters[0];
    }
    elsif ( $number_of_letters > 2 ) {
        for ( my $i = 0 ; $i < $number_of_letters ; $i++ ) {
            my $first_letter_in_word = $letters[$i];
            my $other_letters = remove_letter_by_index($string, $i);
            foreach my $sub_permutation ( get_permutations($other_letters) ) {
                push @permutations, $first_letter_in_word . $sub_permutation;
            }
        }
    }

    return @permutations;
}

sub remove_letter_by_index
{
    my ( $string, $index ) = @_;
    my $result = '';

    my @letters = split //, $string;
    my $number_of_letters = scalar(@letters);

    for ( my $i = 0 ; $i < $number_of_letters ; $i++ ) {
        if ( $i != $index ) {
            $result = $result . $letters[$i];
        }
    }
    return $result;
}

sub is_element_in_list
{
    my ( $element, @list ) = @_;

    if ( not $element ) {
        return 0;
    }

    foreach my $item (@list) {
        if ( $item eq $element ) {
            return 1;
        }
    }
    return 0;
}

return 1;

anagrams.t

use strict;
use warnings;

require "anagrams.pm";

use feature 'say';

use Test::More tests => 20;


my $sample_string = 'a';
my @retrieved_permutations = get_permutations($sample_string);
ok(is_element_in_list('a', @retrieved_permutations));
ok(scalar(@retrieved_permutations) == 1);

$sample_string = 'ab';
@retrieved_permutations = get_permutations($sample_string);
ok(is_element_in_list('ab', @retrieved_permutations));
ok(is_element_in_list('ba', @retrieved_permutations));
ok(scalar(@retrieved_permutations) == 2);

$sample_string = 'abc';
@retrieved_permutations = get_permutations($sample_string);
ok(is_element_in_list('abc', @retrieved_permutations));
ok(is_element_in_list('acb', @retrieved_permutations));
ok(is_element_in_list('bac', @retrieved_permutations));
ok(is_element_in_list('bca', @retrieved_permutations));
ok(is_element_in_list('cab', @retrieved_permutations));
ok(is_element_in_list('cba', @retrieved_permutations));
ok(scalar(@retrieved_permutations) == 6);

$sample_string = 'abcd';
@retrieved_permutations = get_permutations($sample_string);
ok(is_element_in_list('abcd', @retrieved_permutations));
ok(is_element_in_list('acbd', @retrieved_permutations));
ok(is_element_in_list('dbac', @retrieved_permutations));
ok(scalar(@retrieved_permutations) == 24);

$sample_string = 'abcdefg';
@retrieved_permutations = get_permutations($sample_string);
ok(is_element_in_list('abcdefg', @retrieved_permutations));
ok(is_element_in_list('abcedfg', @retrieved_permutations));
ok(is_element_in_list('acbdefg', @retrieved_permutations));
ok(scalar(@retrieved_permutations) == 5040);
\$\endgroup\$
0

1 Answer 1

6
\$\begingroup\$

You have written very self-documenting code! That's good. However, you seem somewhat new to Perl, so I'll walk you through some Perl-specific best practices and idioms.

Namespaces/Packages/Modules, use vs. require

You have put your implementation into a separate file anagrams.pm, which you load via require 'anagrams.pm'. When writing a Perl module, we should put it into its own namespace. There is a relationship between file paths and package names: a package Foo::Bar::Baz should reside in a file Foo/Bar/Baz.pm. It is customary for package names to use PascalCase. Lower-case names are only used for pragmas such as strict or warnings that modify how Perl itself behaves. While package names look hierarchical, they are only so by convention: Foo::Bar is not technically an “inner package” of Foo, although names are often used in this manner. Top-level package names should not be used for “real” code, since this is likely to clash with package names from CPAN (the open-source Perl module repository). The Local:: namespace can be used to avoid clashes, since no CPAN module will ever use it. However, if you want to distribute your module, you should reserve a namespace: either by publishing your code in CPAN under a specific module name, or by registering a PAUSE account name. The PAUSE account name can be used as a reserved namespace. E.g. I have some unpublished personal software under the AMON:: prefix.

Assuming you do not intend to distribute your code, using the name Local::Anagrams might be sensible.

To load a module, there are three main techniques available:

  • require 'path' is rarely used, since the module system is often preferable.
  • require Module::Name searches for Module/Name.pm in all registered module locations at runtime. This form is only used for deferred module loading, where we only want to load a module if a specific code path was taken.
  • use Module::Name is like require Module::Name, but at “compile time”. It is the preferred module loading mechanism, since it allows the loaded module to put symbols into the loading namespace.

The problem with namespaces is that symbol names become tediously long. For example, the get_permutations sub from Local::Anagrams would be accessed as Local::Anagrams::get_permutations. When loading our module with use, we can allow certain symbols to be exported from our namespace. Traditionally, the built-in Exporter module is used. In the package-global variable @EXPORT_OK, we list the names of all subroutines we want to make available. The useing module can then list the sub names it wants to import:

package Local::Anagrams;
use strict;
use warnings;
use Exporter 'import';
our @EXPORT_OK = qw/ get_permutations is_element_in_list /;

...

Then in get_anagrams.pl:

use Local::Anagrams 'get_permutations';

And in anagrams.t:

use Local::Anagrams qw/ get_permutations is_element_in_list /;

In larger software systems, exporting symbols doesn't really scale and may still introduce name clashes. The Sub::Exporter module allows the importing module to customize the imported subroutines, but at some point you might give up and prefer to deliver your functionality via an object-oriented rather than procedural interface.

Previously, I said that Perl searches for modules in “all registered module locations”. These can be inspected in the @INC global variable. For example, the current working directory . is usually part of @INC. But unless you install your custom modules via CPAN, they will not generally be in one of the expected locations. If we want to load a module relative to the location of a script, we have to add a new module location:

# in get_anagrams.pl:
use FindBin;  # finds the location of our script
use lib "$FindBin::Bin/../lib";

use Local::Anagrams;

This assumes a standard project directory layout such as

anagrams-project/
  bin/
    get_anagrams.pl
  lib/
    Local/
      Anagrams.pm
  t/
    anagrams.t

For tests, I don't use Find::Bin. Instead, I supply the library directory to the test runner, e.g. perl -Ilib t/anagrams.t or prove -l t.

get_anagrams.pl

All Perl scripts should use a shebang – generally #!/usr/bin/perl or #!/usr/bin/env perl. While this is only used on Unix systems or in some web servers, I'd still recommend using it even on Windows.

my $number_of_arguments = $#ARGV + 1 is a complicated way of saying my $number_of_arguments = @ARGV. Actually, the variable $number_of_arguments is useless here, and you could use @ARGV directly.

Error messages should go on STDERR, not STDOUT. This becomes really important when your program is used in a pipe, or with shell redirection. E.g. perl get_anagrams.pl > anagrams.txt would write the error to the file rather than displaying it to the user. Instead:

say STDERR "Usage: get_anagrams.pl <word>";
exit 1;

Note that after STDERR there is no comma. You could also use method syntax:

use IO::File;
...

STDERR->say("Usage: get_anagrams.pl <word>");
exit 1;

If the exact exit code is not relevant, you could just throw an exception with die, which would have the same effect, except for the exit code being 255 (= -1):

die "Usage: get_anagrams.pl <word>\n";

If you do not want to hardcode the name of the executed program, you can use the special $0 variable:

die "Usage: $0 <word>\n";

This may or may not result in a better error message.

It may not be the most readable style, but I like the statement modifier versions of Perl's control flow constructs a lot. For example, I'd write your loop as

say for get_permutations shift @ARGV;

When say or print aren't given an explicit argument, they default to the implicit $_ context variable, which is used by for/foreach loops when not given an explicit loop variable.

get_permutations():

When looping over all indices of an array, do not use a C-style for loop. Instead, use a range-base loop

for my $i (0 .. $#letters) { ... }

or just instruct Perl to iterate over all indices with keys @letters (available since v5.12.0):

for my $i (keys @letters) { ... }

Note that for and foreach are synonymous, so you have no reason to type out the longer name.

Your algorithm doesn't handle the empty string. get_permutations('') should return the single-element list ''. With it, all cases can be reduced to the two alternatives zero-length or n-length input strings; special-casing 1 and 2 is unnecessary.

sub get_permutations {
  my ($string) = @_;
  my @letters = split //, $string;

  return '' if not @letters;

  my @permutations;
  for my $i (keys @letters) {
    ...
  }
  return @permutations
}

The pattern

for my $var (@input) {
  push @output, simple_expression($var);
}

can be reduced to

push @output, map { simple_expression($_) } @input;

though some people prefer explicit loops for readability.

remove_letters_by_index

Try to avoid single-character operations whenever possible, since these are not at all efficient in Perl. We can implement this function without having to split the string. To remove d (index 3) in the string abcdef, we concatenate the string with indices 0–2 (length 3) and 4–5 (length 2):

0 1 2 3 4 5 
|a|b|c|d|e|f|

substr("abcdef", 0, 3) . substr("abcdef", 3+1);

substr takes a start index and a length. Care has to be taken that the substr starting index is a legal index, which is relevant when we are trying to remove the last character.

sub remove_letters_by_index {
  my ($string, $index) = @_;
  return substr($string, 0, $index) if $index + 1 >= length $string;
  return substr($string, 0, $index) . substr($string, $index + 1);
}

We could also just ask Perl to delete a specific character in a string:

sub remove_letters_by_index {
  my ($string, $index) = @_;
  substr($string, $index, 1) = '';
  return $string;
}

With arrays, two similar solutions are possible. We can use the splice function to remove elements from a list:

sub remove_letters_by_index {
  my ($string, $index) = @_;
  my @letters = split //, $string;
  splice @letters, $index, 1;
  return join '', @letters;
}

Or we can use slices to access a range in the list. Slices use a list of indices, which can be generated by a range, and ranges use two indices as inclusive bounds. Since empty ranges do not pose any issue, we do not have to special-case the last character.

sub remove_letters_by_index {
  my ($string, $index) = @_;
  my @letters = split //, $string;
  return join '', @letters[0 .. $index - 1, $index + 1 .. $#letters];
}

is_element_in_list

This function is only ever used in the tests, so it should rather be defined in the test file. It has nothing to do with the single responsibility of the anagrams module, which is finding anagrams.

You require that the $element be a truthy value, and report any falsey values as not found. The following scalars are falsey: undef, 0, '', '0', and any object that has overloaded boolean context or logical negation. Of these values, '' and '0' may legitimately occur in a list of anagrams: get_permutations('') and get_permutations('0'). If you are trying to guard against undef values, always test for definedness. And don't just return a failure – if this is an error, throw an error!

use Carp; # exports `croak`

# `croak` is like `die`, but reports the location
# where `is_element_in_list` was called.
croak "element must be defined" if not defined $element;

The @list is unnecessarily copied. When you pass arrays or hashes to a Perl subroutine, they are flatted to a list. The code

my @array = (1, 2, 3);
some_sub(@array);
my %hash (a => 1, b => 2);
some_sub(%hash);

is effectively equivalent to

some_sub(1, 2, 3);
some_sub('a', 1, 'b', 2);

To avoid this, we can pass array references. An array reference $ref = \@array is a scalar value. To access the array under the reference, we need to dereference it as @$ref or @{ $ref } and can access elements like $ref->[0]. Then:

sub is_element_in_list {
  my ($needle, $haystack_ref) = @_;

  croak "needle must be defined" if not defined $needle;

  for my $item (@$haystack_ref) {
    return 1 if $needle eq $item;
  }

  return 0;
}

Called as:

ok(is_element_in_list('abc', \@retrieved_permutations));

While modules must return a true value, this is usually accomplished with just 1; rather than return 1;.

\$\endgroup\$
1
  • \$\begingroup\$ Thank you for the breadth and depth of your review! I have implemented all suggestions except of say for get_permutations shift @ARGV; as I need some time to understand that Perl mimics grammar. \$\endgroup\$
    – Janux
    Commented Aug 2, 2015 at 17:06

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.