This article has been moved from «perl6.eu» and updated to reflect the language rename in 2019.
This is my response to the Perl Weekly Challenge #7.
|
Print all the niven numbers from 0 to 50 inclusive, each on their own line. A niven number is a non-negative number that is divisible by the sum of its digits. |
.say if $_ %% $_.comb.sum for 0 .. 50;
And that's it. A single line of code.
If you want a longer program (to impress a line counting manager, perhaps?), here it is:
File: niven-long
for 0 .. 50
{
if $_ %% $_.comb.sum # [1]
{
.say; # [2]
}
}
[1] Is the current number («$_») divisible («%%»)
by the by the sum («.sum») of all the digits («.comb»)? If so,
print it.
[2] A method invoked on nothing is actually invoked on «$_».
See
docs.raku.org/routine/%% for more information about the Divisibility operator
«%%».
We can extend it so that the user can specify the upper limit. The default value is (still) 50:
File: niven-main
unit sub MAIN (Int $limit where $limit > 0 = 50);
.say if $_ %% $_.comb.sum for 1 .. $limit;
If you want the first 50 (or whatever number you specify on the commmand line) Niven
numbers, we can use «gather»/«take» to set up a lazy
Sequence (where the values are only computed when actually needed) like this:
unit sub MAIN (Int $limit where $limit > 0 = 50);
my $niven := gather
{
for 0..Inf
{
take $_ if $_ %% $_.comb.sum;
}
}
.say for $niven[^$limit]; # [1]
[1] The «^$limit» construct means every integer from 0 up to the
value of «$limit», but not including it. If the value passed on the command
line is 2, we get 0 and 1, which gives us the two first elements in the
Sequence (which are evaluated when requested only).
See my
Perl 6 gather, I take
article for more information about gather/take.
|
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. For example, for the words cold and warm, the routine might return: However, there’s a shortest ladder: (“cold”, “cord”, “card”, “ward”, “warm”). Givens:
|
I'll start with the framework; a program where the user can either specify the wordlist on the command line, or give a file name. This dummy version doesn't do anything except loading the dictionary:
File: word-ladder-dummy
multi sub MAIN ($first, $second, *@wordlist) # [1]
{
say-output(find_shortest_ladder($first, $second, @wordlist)); # [5]
}
multi sub MAIN ($first, $second, $dictionary # [2]
where $dictionary.IO && $dictionary.IO.r)
{
return unless $first.chars == $second.chars; # [3]
my @wordlist = load-dictionary($dictionary, $first.chars); # [4]
# Only load the words with the correct length.
say-output(find_shortest_ladder($first, $second, @wordlist)); # [5]
sub load-dictionary ($file where $file.IO && $file.IO.r, $word-length)
{
return $file.IO.lines.grep({ .chars == $word-length }).lc.words; # [4]
}
}
sub say-output(@list) # [6]
{
for (@list) -> $curr
{
say $curr;
}
}
sub find_shortest_ladder ($word1, $word2, @wordlist) # [7]
{
return ("W1: $word1", "W2: $word2", "D: @wordlist[]");
}
[1] The first version of «MAIN» takes a word list (as a slurpy argument, as the words come as individual values on the command line.
[2] The second version of «MAIN» takes the name of a dictionary file.
[3] If the two words have different lenght, we abort. This test will be placed in «find_shortest_ladder», but it is a good to have it here before loading the dictionary as well.
[4] Load the dictionary. We pass it the length, and it only reads words with that length. Thw words are converted to lower case.
[5] Call «find_shortest_ladder» to do the job.
[6] In this dummy version all we do is printing the values. The word list is especially useful for debugging when loaded from a file.
Testing it:
$ raku word-ladder-dummy work moon /etc/dictionaries-common/words
W1: work
W2: moon
D: Abby Abel Ac's Acts ....
$ raku word-ladder-dummy aaa bbb aaa aab abb bbb
W1: aaa
W2: bbb
D: aaa aab abb bbb
Then we can start implementing «find_shortest_ladder»:
File: word-ladder (partial)
sub find_shortest_ladder ($word1, $word2, @wordlist)
{
my Set $dict = @wordlist.Set; # [1]
my @letters = "a" .. "z"; # [2]
return unless $dict{$word1}; # [3]
return unless $dict{$word2}; # [4]
return unless $word1.chars == $word2.chars; # [5]
return unless all(@wordlist>>.chars) == $word1.chars; # [6]
say "OK";
}
[1] The dictionary, as a Set. This saves
us some typing compared with a hash: my %dict = @wordslist.map({ $_ => True });
[2] Note that the alphabet means that we will not get words with special characters, such as «é». Or any letters in other languages (as «ß» in German or «Å» in Norwegian). I'll get back to that problem in the next section.
[3] We return (an empty list) if the first word doesn't exist,
[4] and the same for the second word.
[5] We return if the two words don't have the same length.
[6] We return if one or more words in the dictionary have a wrong length.
Staring with the word list, this can be done in at least two ways. And if we can also start with the dictionary:
my @letters = @wordlist.comb.unique.grep({ /<:L>/ });
my @letters = @wordlist.comb.grep({ /<:L>/ }).Set.keys;
my @letters = $dict.keys.comb.unique.grep({ /<:L>/ });
The first one is probably the fastest (based on an unscientific study of my gut feeling), so I'll use that:
File: word-ladder (changes only)
# my @letters = "a" .. "z";
my @letters = @wordlist.comb.unique.grep({ /<:L>/ });
But if you wonder how the code would have looked like; here it is:
my %next; # [1]
check-word($_) for @wordlist; # [2]
sub check-word ($word) # [3]
{
for ^$word.chars -> $index # [4]
{
my $next = $word; # [5]
for @letters -> $letter # [6]
{
$next.substr-rw($index, 1) = $letter; # [7]
next if $word eq $next; # [5]
%next{$word}.push($next) if $dict{$next}; # [8]
}
}
}
say %next; # [9]
}
[1] A hash, with a list of next words for each key.
[2] We check each word in the word list.
[3] «check-word» is placed inside «find_shortest_ladder», so that it have access to «%next» without the need for it to be a global variable.
[4] The «^» symbol in front of an integer (or something that can be
coerced to an integer) gives a range from 0 up to the specified value (but not
including it). If the word has 4 letters, we get the four values 0,1,2 and 3 - which
just happens to be the indices for the individual characters in the string. The loop
is used to iterate through each position in the word.
[5] Do the work on a copy of the original word, so that we can detect if we arrive back at the original word.
[6] Loop through the letters in the alphabet (as taken from the dictionary).
[7]
Swap one letter (at the given position) with a new one.
«substr-rw» is a version of «substr» (substring) that allows
us to write to the substring.
[8] Save the word (as a next word, if it is a legal word (in the dictionary).
[9] Testing that it does what we think it should (and it does).
See docs.raku.org/routine/substr-rw for more information about «substr-rw».
Running it:
$ raku word-ladder aaa bbb aaa aab abb bbb
{aaa => [aab], aab => [abb aaa], abb => [bbb]}
$ raku word-ladder work moon /etc/dictionaries-common/words
{abed => [awed aced abel], abel => [abed abet], abet => [abel abut],
abut => [abet], aced => [abed iced aged], aces => [ices ayes],
ache => [acre ashe], achy => [ashy], acid => [amid arid],
acme => [acne acre], acne => [anne acme], acre => [acme ache],
acts => [arts ants], adam => [adan edam] ...
Just for fun, here it is as a recursive function (without explanation):
File: word-ladder-recursive (partial)
check-path($word1, $word2, List.new, Hash.new);
sub check-path($start, $stop, @path is copy, %seen is copy )
{
%seen{$start} = True;
@path.push: $start;
for @(%next{$start}) -> $candidate
{
next if %seen{$candidate};
if $candidate eq $stop
{
say-output(@path.push: $candidate);
last;
}
else
{
check-path($candidate, $stop, @path, %seen) unless %seen{$candidate};
}
}
}
}
sub say-output (@path)
{
say '("', @path.join('","'), '")';
}
Running it (and I show the first two lines only):
raku word-ladder-recursive let bee /etc/dictionaries-common/words
("let","bet","get","jet","met","net","pet","set","vet","wet","yet","yea","lea",
"pea","sea","tea","tee","bee")
("let","bet","get","jet","met","net","pet","set","vet","wet","yet","yea","lea",
"pea","sea","tea","ten","den","fen","hen","ken","men","pen","wen","yen","yon",
"con","don","eon","ion","non","son","ton","won","wan","ban","can","fan","man",
"pan","ran","tan","van","vat","bat","cat","eat","fat","hat","mat","oat","pat",
"rat","sat","tat","tit","bit","fit","hit","kit","lit","nit","pit","sit","wit",
"zit","zip","dip","hip","lip","nip","pip","rip","sip","tip","yip","yap","cap",
"gap","lap","map","nap","pap","rap","sap","tap","top","bop","cop","fop","hop",
"lop","mop","pop","sop","sup","cup","pup","yup","yep","hep","pep","rep","red",
"bed","fed","led","wed","wad","bad","cad","dad","fad","gad","had","lad","mad",
"pad","sad","tad","tab","cab","dab","gab","jab","lab","nab","nib","bib","fib",
"jib","lib","rib","rob","bob","cob","fob","gob","hob","job","lob","mob","sob",
"sub","cub","dub","hub","nub","pub","rub","tub","tug","bug","dug","hug","jug",
"lug","mug","pug","rug","rag","bag","fag","gag","hag","jag","lag","nag","sag",
"tag","wag","wig","big","dig","fig","gig","jig","pig","rig","rid","aid","bid",
"did","hid","kid","lid","mid","mod","cod","god","hod","nod","pod","rod","sod",
"sol","pol","pal","gal","gel","eel","ell","all","ill","ilk","ink","irk","ark",
"ask","auk","yuk","yak","oak","oaf","off","oft","aft","act","ant","apt","opt",
"out","but","cut","gut","hut","jut","nut","put","rut","rot","cot","dot","got",
"hot","jot","lot","not","pot","sot","tot","wot","woe","doe","foe","hoe","roe",
"toe","tee","bee")
The first one is not so bad, at least compared to the second one. The correct (shortest) answer is either «let lee bee» or «let bet bee».
This is part of «find_shortest_ladder»:
File: word-ladder (partial)
# say "OK";
my @solutions; # [1]
my $solution-found = False; # [2]
my $solution-found-size = 0; # [3]
my @deferred = ($word1); # [4]
loop
{
my $current = @deferred.shift // last; # [5]
check-path($current, $word2); # [6]
}
[1] We store the solutions when we encounter them.
[2] This is set when we have found a solution.
[3] The number of steps taken to find a solution.
[4] We start by adding the start word to the list.
[5] As long as there are items in the list, take the first one
[6] and run «check-path» on it.
This is also part of «find_shortest_ladder»:
File: word-ladder (partial)
sub check-path($path, $stop) # [1]
{
my @path = $path.split(";"); # [2]
my $seen = @path.Set; # [3]
if $solution-found
{
return if $solution-found-size == @path.elems; # [4]
}
my $current = @path[*-1]; # [5]
my $next-word := gather # [6]
{
for ^$current.chars -> $index
{
my $next = $current;
for @letters -> $letter
{
$next.substr-rw($index, 1) = $letter;
next if $current eq $next;
take $next if $dict{$next};
}
}
}
for $next-word -> $candidate # [6]
{
next if $seen{$candidate}; # [7]
if $candidate eq $stop # [8]
{
@solutions.push("$path;$candidate"); # [8a]
$solution-found = True; # [8b]
$solution-found-size = @path.elems + 1; # [8c]
}
else
{
@deferred.push("$path;$candidate"); # [9]
}
}
}
return @solutions;
}
[1] «check-path» gets the current path (on the form «word1» or «word1;word2).
[2] It splits the path on the semicoolons, giving a list of words.
[3] And sets up a Set of words in the path (so that we can avoid repeating them; in [7]).
[4] If we have found a solution, stop processing new ones with size one higher. But continue processing with the same size, so that we get all the ladders with the minimum size.
[5] The current word (the last one in the path).
[6] The next word is set up with «gather»/«take» to make it
easier to use the values.
[7] Avoid repeating words already in the path.
[8] If we have reached the stop word:
[8a] • save the path.
[8b] • Flag that we have found a solution.
[8c] • Set the size.
[9] If not, push the candidate (ending with a legal word that isn't the stop word) to the list.
And finally the output. The challenge stated the format for the output, but I have cheated slightly and done it here instead:
File: word-ladder (partial)
sub say-output(@list)
{
for (@list) -> $curr # [1]
{
say '("', $curr.split(";").join('","'), '")'; # [2]
}
}
[1] The result is a list (with one or more values).
[2] Swap the semicolons by commas, and nicify the output.
Running it:
$ raku word-ladder let bee /etc/dictionaries-common/words
("let","bet","bee")
("let","lee","bee")
$ raku word-ladder work moon /etc/dictionaries-common/words
("work","worn","morn","moon")
$ raku word-ladder cold warm /etc/dictionaries-common/words
("cold","cord","word","ward","warm")
("cold","cord","word","worm","warm")
("cold","cord","card","ward","warm")
("cold","cord","corm","worm","warm")
Note that we get all the solutions with the same number of steps. The challenge asked for one, so I'll fix that (but retain the possibility to get all with the «-all» (or «--all») command line option):
File: word-ladder (changes only)
multi sub MAIN ($first, $second, *@wordlist, :$all)
{
say-output(find_shortest_ladder($first, $second, @wordlist, $all));
}
multi sub MAIN ($first, $second, $dictionary
where $dictionary.IO && $dictionary.IO.r, :$all)
{
...
say-output(find_shortest_ladder($first, $second, @wordlist, $all));
}
loop
{
my $current = @deferred.shift // last;
check-path($current, $word2);
last if $solution-found && !$show-all;
}
Testing it:
$ raku word-ladder let bee /etc/dictionaries-common/words
("let","bet","bee")
$ raku word-ladder --all let bee /etc/dictionaries-common/words
("let","bet","bee")
("let","lee","bee")
$ raku word-ladder cold warm /etc/dictionaries-common/words
("cold","cord","word","ward","warm")
$ raku word-ladder -all cold warm /etc/dictionaries-common/words
("cold","cord","word","ward","warm")
("cold","cord","word","worm","warm")
("cold","cord","card","ward","warm")
("cold","cord","corm","worm","warm")
multi sub MAIN ($first, $second, *@wordlist, :$all)
{
say-output(find_shortest_ladder($first, $second, @wordlist, $all));
}
multi sub MAIN ($first, $second, $dictionary
where $dictionary.IO && $dictionary.IO.r, :$all)
{
return unless $first.chars == $second.chars;
my @wordlist = load-dictionary($dictionary, $first.chars);
# Only load the words with the correct length.
sub load-dictionary ($file where $file.IO && $file.IO.r, $word-length)
{
return $file.IO.lines.grep({ .chars == $word-length }).lc.words;
}
say-output(find_shortest_ladder($first, $second, @wordlist, $all));
}
sub say-output(@list)
{
for (@list) -> $curr
{
say '("', $curr.split(";").join('","'), '")';
}
}
sub find_shortest_ladder ($word1, $word2, @wordlist)
{
my Set $dict := @wordlist.Set;
my @letters = @wordlist.comb.unique.grep({ /<:L>/ });
return unless $dict{$word1};
return unless $dict{$word2};
return unless $word1.chars == $word2.chars;
return unless all(@wordlist>>.chars) == $word1.chars;
my @solutions;
my $solution-found = False;
my $solution-found-size = 0;
my @deferred = ($word1);
loop
{
my $current = @deferred.shift // last;
check-path($current, $word2);
last if $solution-found && !$show-all;
}
sub check-path($path, $stop)
{
my @path = $path.split(";");
my $seen = @path.Set;
if $solution-found
{
return if $solution-found-size == @path.elems;
}
my $current = @path[*-1];
my $next-word := gather
{
for ^$current.chars -> $index
{
my $next = $current;
for @letters -> $letter
{
$next.substr-rw($index, 1) = $letter;
next if $current eq $next;
take $next if $dict{$next};
}
}
}
for $next-word -> $candidate
{
next if $seen{$candidate};
if $candidate eq $stop
{
@solutions.push("$path;$candidate");
$solution-found = True;
$solution-found-size = @path.elems + 1;
}
else
{
@deferred.push("$path;$candidate");
}
}
}
return @solutions;
}
And that's it.