Perl 6 small stuff #19: a challenge of niven numbers and word ladders

After a week’s hiatus I’ve returned to the Perl Weekly Challenge. This is the seventh challenge so far. As before there are two excercises. The first one is to calculate all niven numbers between 0 and 50. Niven numbers are integers that are divisible by the sum of its digits. I.e. 47 is a niven number if 47 / (4 + 7) is an integer without remainder (it’s not, as the result is 4.2727; 48 is, as 48/(4+8) is 4).

These kinds of operations are called modulo operations or mods. Most programming languages use the operator % for this, so that you can check for this by testing whether 47 % (4 + 7) == 0. But Perl6 has an additional operator, a shorthand for the former, and is written as 47 %% (4 + 7). %% returns True or False and lets you ignore the == 0 part.

To find the individual digits of a number we use the .comb method. That returns a list with the individual digits (I’ve used .comb on earlier challenges as well, but then to divide strings into their individual characters). On the combed list we use something called a reduction operator, specifically [+]. What this does is that it loops through the list and adds all of the numbers within. Where you once would have written something like my $result = 0; $result += $_ for 1, 2, 3, 4, 5; say $result; you can now do the same with a simple say [+] 1, 2, 3, 4, 5 . There are lots of these reduction operators. They save time, so look into them.

Knowing these two things it becomes apparaent that calculating Niven numbers with Perl 6 can be done with a simple and reasonably readable one-liner.

.say if $_ %% [+] .comb for 0..50;

That’s it.

The second excercise is a little harder: “A word ladder is a sequence of words [w0, w1, …, wn] such that each word wi in the sequence is obtained by changing a single character in the word wi-1. All words in the ladder must be valid English words. Given two input words and a file that contains an ordered word list, implement a routine (e.g., find_shortest_ladder(word1, word2, wordlist)) that finds the shortest ladder between the two input words.”

There are a lot of givens and requirements, so you should look at the web page of challenge 7 to see them all. But the most important of them is that the two words you want to create a ladder between, has to be of the same length. And the list of words you use for this must also only contain words of that length. Additionally you’re also only supposed to compare lowercase words.

Knowing all that, here’s my attempt at excercise 2.

File: challenge2.p6
#!/usr/bin/env perl6
# This script needs a plain-text dictionary of words to work.
# MacOS has one built-in here. May have different location
# or not be present at all on other systems.
constant $DICTIONARY = "/usr/share/dict/words";

subset Str-lc of Str where * ~~ /^<lower>+$/;

sub MAIN(Str-lc $word1,
Str-lc $word2 where {
sprintf("%s", $word1).chars == sprintf("%s", $word2).chars
},
Bool :$list-all = False)
{
  my @ladders = [];
my @words = $DICTIONARY.IO.lines.grep(
{ $_ eq $_.lc && $_.chars == $word1.chars }
);

gen-word-ladder($word1, [ $word1 ], {});

for @ladders.sort({ $^a.elems cmp $^b.elems }).kv -> $i, @ladder {
say @ladder.join(" -> ");
exit if !$list-all && $i == 0;
}

sub gen-word-ladder(Str $word, @ladder is copy, %seen is copy) {
for $word.comb.kv -> $index, $character {
my $r3 = $word.substr(0, $index) ~ "." ~
$word.substr(*-($word.chars - ($index + 1)));
my $r5 = ( '.' x $index ) ~ $word2.substr($index,1) ~
( '.' x $word.chars - 1 - $index) ;
for @words.grep( / <$r3> /).grep( / <$r5> / ) -> $x {
if ! %seen{$x}.defined && $x ne $word {
%seen{$x} = True;
@ladder.push($x);
@ladders.push(@ladder) if $x eq $word2;
gen-word-ladder($x, @ladder, %seen);
}
}
}
}
}

Basically, this is a solution using recursion. I won’t go into detail about what the code does, I’m just going to comment on Perl6-isms that may be interesting for newcomers.

The main sub routine here is MAIN. Subroutines named MAIN is a special kind of subroutine. This routine is automatically called when a script is invoked. Also, the parameters you define in the sub routine are parameters that will be required on the command line when you run the script. This definition says that two words are required. Additionally there’s an optional flag that can be used (--list-all) if you also want to the rest of the possible word ladders too and not only the shortest. (If you want several different signatures to be possible, use the multi keyword and define multiple MAIN’s)

Note the use of subset and where here. They define constraints. Here I define a subset of Str, called Str-lc, that requires the string to be lowercase. You can check for all sorts of things. That all this is built-in saves you from writing lots of error checking code.

The nice thing about this, if you use the subset types in the context of MAIN, is that Perl6 will check your CLI parameters for you. If you’ve made any errors it will exit and print an automatically generated Usage message. Again, less typing and more done for you automatically!

Now, in the declaration of MAIN itself I also use the whereclause. Use that to define constraints that are ad-hoc and not repeated or constraints that can’t be defined as subsets due to a dynamic nature.

You should note my use of sprintf here. You may find it redundant that I use sprintf to convert a string to a string here. Due to an error in the Rakudo Star 2019.03.01 distribution of Perl 6, the comparison $word1.chars == $word2.chars doesn't work. It throws this error:

Cannot call method 'chars' on a null object

The only time I don’t get this error is when the two strings actually are of equal length. A workaround is sprintf. If you run a string through sprintf(“%s”), a brand new Str object is returned. And on them we can run instance methods. So then I also get checks for length equality built into the MAIN declaration. As the above mentioned error isn’t present in earlier versions of Rakudo, it’ll be fixed again in the future so that this absurd conversion round-robin is not necessary.

In any case, with very little code you get lots of fancy functionality. So when you run the script with correct parameters, all runs as expected…

# ./challenge2.p6 --list-all horse lousy
horse -> house -> louse -> lousy
horse -> house -> louse -> housy -> lousy
horse -> house -> horsy -> housy -> lousy

…while a reasonably understandable usage report is printed if not…

# ./challenge2.p6 --list-all horse
Usage:
./challenge2.p6 [--list-all] <word1> <word2>

Other noteworthy stuff…?

Do you see the .kv used in a couple of the for loops? Normally .kv returns the keys and values of a hash interleaved [1]. But used in the context of a list/an array, the key is an integer representing the index while the value is, as you’d expect, the value. It’s as if you’ve got an automatic $counter. As it is. Now, it’s just a little thing, but I’ve programmed enough $counter++ lines in my life to appreciate this.

Another handy shorthand is this: $DICTIONARY.IO — it’s the easiest way to open a file for reading. If your string correspons to a file, adding .IO behind the Str variable name converts it to an IO::Path object which adds lots of stuff, including the .lines method that opens the file and returns the contents line by line [2].

Lastly I’d like to point you to / <$r3> / and / <$r5> /. The < and > surronding a variable tells Perl6 that you want whatever’s in them to be interpolated as a regexp. So that…

my $r5 = "al.ha";
say "alpha" ~~ /$r5/;   # Output: Nil  
say "alpha" ~~ /<$r5>/; # Output: 「alpha」 (match)

This means you can build regexpes dynamically and very simply. It’s a nice function, although — maybe — a function with EVAL like downsides.

NOTES

[1] Over on Reddit /u/liztormato pointed out that my explanation about what the .kv method of an Array/List does, was wrong. I.e. I understood its effects, but misunderstood what it actually did to achieve those effects. So this explanation is Liz’s not mine.

[2] This too has been clarified by Liz on Reddit. I have to say that this is the nice thing about blogging about Perl 6: The community is very welcoming, so it’s no stress to lay out all my misunderstandings. I’ve really learned so much by writing these articles. Thanks to everyone who has pointed out errors and misunderstandings and maybe even suggested improvements.