Primal Words with Raku
[90] Published 6. September 2020.This is my response to the Perl Weekly Challenge #076.
Challenge #076.1: Prime Sum
$N. Write a script to find the minimum number of prime numbers
required, whose summation gives you $N.
For the sake of this task, please assume
1 is not a prime number.
Example
Input:
$N = 9
Ouput:
2 as sum of 2 prime numbers i.e. 2 and 7 is same as the input number.
2 + 7 = 9
Onus Primus
Note that 1 is not a prime number at all, as reported by
e.g.
en.wikipedia.org/wiki/Prime_number.
Raku concurs:
> say 1.is-prime; # -> False
> say 2.is-prime; # -> True
File: prime-sum (partial)
#! /usr/bin/env raku
subset IntTwo of Int where * >= 2; # [1]
unit sub MAIN (IntTwo $N, # [2]
:a(:$all), # [3]
:l(:$loquacious), # [4]
:v(:$verbose) = $loquacious || $all); # [5]
my @primes = (2 .. $N).grep( *.is-prime ).reverse; # [6]
say ": Primes (reverse): { @primes.join(", ") }" if $verbose;
[1] A custom type defined with subset to
enforce the argument $N as an integer larger than or equal to 2.
[2] Get $N. Note that I have not added a default value this time,
so the program will fail if run without a (suitable) value on the command line
[3] This mode will compute all the possible combinations, not just the one(s) with the minimum number of prime numbers (as specified in the challenge). This will enable Verbose mode as well, as it would be pointless to get all the values otherwise.
[4] Loquacious mode, or «very verbose mode». This will enable Verbose mode as well (the default value).
[5] Verbose mode, printing the prime numbers and the solutions when we find them
[6]
Get all the primes up to (and including) $N,
by applying is-prime as a filter on all the values. Then reverse
the order (with reverse), so that the highest value comes first.
(This could just as well have been done with
($N ... $N).grep( *.is-prime ). Note the extra period, so that we
get a Sequence (with ...). The original code gave a Range (with
..), working with increasing numbers only.)
See
docs.raku.org/language/typesystem#index-entry-subset-subset for
more information about custom types with subset.
See
docs.raku.org/routine/is-prime
for more information about is-prime.
See
docs.raku.org/routine/reverse
for more information about the general reversing operator
reverse.
Recursion
Now we come to the tricky part, a recursive procedure doing the heavy lifting.
The idea is that we get the list of primes up to and including
$N, in reverse order. Then we add the primes
to the current value, one at a time, and call our selves recursively.
An example: let us use the number 9:
The primes: 7, 5, 3, 2.
We start with 0 as the current value. The first iteration looping through the
primes adds 7. Then we get a recursive call adding 7 again, but this value is
higher than 9 ($N) so this call returns without doing anything.
The next recursive call (in the loop) adds 5. The sum is still too high, so
it dies off as well. Then it tries with 3, with the same result. But the last
prime, 2, works out, so we get the first answer: 7,2. The program
must contine, as it is possible that we can get a shorter result. So we take
note of the number of values in the answer.
The next iteration adds 5 to the initial 0, then it iterated recursively
over the remaining primes 5, 3, 2. (Not 7 again, as 5+7 has
already been considered as 7+5.) 5+5=10, which is to great. 5+3=8 works
as a partial solution, but is stopped as any result from this recursion
will be longer than the one we already have (at two values; 7+2).
The next iteration adds 3 to the initial 0, then it iterated recursively
over the primes 3, 2. This will also fizzle out, as it also
will need ad least three values to arrive at $N.
The same applies for 2. So we got one result only (7,2) with
size 2.
my @result; # [7]
my $shortest = Inf; # [8]
recurse(0, (), @primes); # [9]
sub recurse ($value is copy, @values is copy, @primes is copy) # [9a]
{
return if @values.elems > $shortest && ! $all; # [10]
if $value < $N # [11]
{
while @primes # [12]
{
my $add = @primes[0]; # [13]
if $value + $add <= $N # [14]
{
my $value2 = $value + $add; # [15]
my @values2 = @values.clone.push: $add; # [16]
recurse($value2, @values2, @primes); # [17]
}
@primes.shift; # [18]
}
}
elsif $value == $N # [19]
{
if @values.elems < $shortest # [20]
{
$shortest = @values.elems; # [21]
@result = (); # [22]
say ":: New Solution: [{ @values.join(", ") }]" if $loquacious;
}
else
{
say ":: Added Solution: [{ @values.join(", ") }]" if $loquacious;
}
@result.push: @values; # [23]
}
}
[7] We keep the list of solutions here.
[8] The number of primes in the shortes answer. We set this to Inf initially, so that any result will be smaller (and used).
[9] Off we go, recursively. The first argument is the number so far, the second
is the list of values so far, and the third is the list of available primes to choose from. Note the
is copy so that we get a (writeable) copy of the array.
[10] If we have a (partial or full) solution with more elements than the current best one, we can stop looking at this one - as it will not pan out. «All mode» ignores this check, so that we do get all the combinations.
[11] We haven't reached the target value so far,
[12] • as long as there are more primes to use,
[13] • • get the first prime.
[14] • • if we still have not reached the target,.
[15] • • • add the prime number.
[16] • • • Add the prime to a copy of the list of values. (The clone
is there so that we can avoid the longer my @values2 = @values; @values2.push: $add;.)
[17] • • • Recurse away.
[18] • • Remove the current prime from the list of primes.
[19] We have reached the target value .
[20] Does it have a lower number of elements than the prior one?
[21] • set the number of elements to the new value.
[22] • Get rid of any prior lists of values (with too many elements).
[23] • Add the result to the list of results.
Note the missing else (as in elsif $value > $N).
That is because we have reached a dead end in that case, and doing nothing makes this recursion fizzle out.
See
docs.raku.org/type/Signature#index-entry-trait_is_copy for more
information about the is copy trait.
if $verbose
{
for @result -> @array
{
say ": Result: [{ @array.join(", ") }]"; # [25]
}
}
say @result[0].elems // ""; # [26]
[25] We have a list containing lists, so a loop is the thing.
[26] The result, or an empty string if there were no matches.
Running it:
$ ./prime-sum -v 1
Usage:
./prime-sum [-a|--all=<Any>] [-l|--loquacious=<Any>] \
[-v|--verbose=<Any>] <N>
$ ./prime-sum -v 2
: Primes (reverse): 2
: Result: [2]
1
$ ./prime-sum -v 3
: Primes (reverse): 3, 2
: Result: [3]
1
$ ./prime-sum -v 4
: Primes (reverse): 3, 2
: Result: [2, 2]
2
$ ./prime-sum -v 5
: Primes (reverse): 5, 3, 2
: Result: [5]
1
$ ./prime-sum -v 6
: Primes (reverse): 5, 3, 2
: Result: [3, 3]
2
$ ./prime-sum -v 7
: Primes (reverse): 7, 5, 3, 2
: Result: [7]
1
$ ./prime-sum -v 8
: Primes (reverse): 7, 5, 3, 2
: Result: [5, 3]
2
$ ./prime-sum -v 9
: Primes (reverse): 7, 5, 3, 2
: Result: [7, 2]
2
$ ./prime-sum -v 10
: Primes (reverse): 7, 5, 3, 2
: Result: [7, 3]
: Result: [5, 5]
2
$ ./prime-sum -v 11
: Primes (reverse): 11, 7, 5, 3, 2
: Result: [11]
1
$ ./prime-sum -v 12
: Primes (reverse): 11, 7, 5, 3, 2
: Result: [7, 5]
2
$ ./prime-sum -v 13
: Primes (reverse): 13, 11, 7, 5, 3, 2
: Result: [13]
1
$ ./prime-sum -v 14
: Primes (reverse): 13, 11, 7, 5, 3, 2
: Result: [11, 3]
: Result: [7, 7]
2
«Loquacious mode» does not really add anything, as it seems that the first match will also be the shortest - so that no matches will be disregarded. (But I may be wrong, and the code is there to take care of that possibility.)
«All mode» is more interesting:
$ ./prime-sum -a 10
: Primes (reverse): 7, 5, 3, 2
: Result: [7, 3]
: Result: [5, 5]
: Result: [5, 3, 2]
: Result: [3, 3, 2, 2]
: Result: [2, 2, 2, 2, 2]
2
The // Fail-Safe
The last line in the file has a fail-safe// so that the program can cope with
no matches. But is that really necessary?
- The lowest legal input value is 2, which is a prime.
- The next value is 3, which is also a prime.
- The even numbers 4,6,8,... can all be broken down to a set of
2s. - The odd numbers 5,7,9,... can also be broken down, to a single
4and a set of2s.
So no, we can drop the // part.
An Upto Version
Manually starting the program with the values from 1 to 14, as we did above, is tedious. We can fix that with a command line argument «--upto»: File: prime-sum-upto
#! /usr/bin/env raku
subset IntTwo of Int where * >= 2;
unit sub MAIN (IntTwo $N,
:a(:$all),
:l(:$loquacious),
:v(:$verbose) = $loquacious || $all,
:u(:$upto));
$upto
?? (2..$N).map({ primal-decomposition($_) }) # [1]
!! primal-decomposition($N);
my $input;
my $shortest;
my @result;
sub primal-decomposition ($N)
{
$input = $N;
my @primes = (2 .. $input).grep( *.is-prime ).reverse;
say ": Primes (reverse): { @primes.join(", ") }" if $verbose;
@result = ();
$shortest = Inf;
recurse(0, (), @primes, $input);
if $verbose
{
for @result -> @array
{
say ": Result: [{ @array.join(", ") }]";
}
}
say $upto
?? "$N -> { @result[0].elems }"
!! @result[0].elems;
}
sub recurse ($value is copy, @values is copy, @primes is copy, $input)
{
return if @values.elems > $shortest && ! $all;
if $value < $input
{
while @primes
{
my $add = @primes[0];
if $value + $add <= $input
{
my $value2 = $value + $add;
my @values2 = @values.clone.push: $add;
recurse($value2, @values2, @primes, $input);
}
@primes.shift;
}
}
elsif $value == $input
{
if @values.elems < $shortest
{
$shortest = @values.elems;
@result = ();
say ":: New Solution: [{ @values.join(", ") }]" if $loquacious;
}
else
{
say ":: Added Solution: [{ @values.join(", ") }]" if $loquacious;
}
@result.push: @values;
}
}
[1] Note the fancy (and very compact) conditional (with
?? / !!) and loop (with map).
The rest of the changes are just so that we can wrap the former code inside MAIN into a new procedure «primal-decomposition» in order to get the values correct.
See
docs.raku.org/language/operators#index-entry-operator_ternary for more
information about the ternary operator ?? / !!.
Running it with the values 2 to 1000:
./prime-sum-upto -u 1000
2 -> 1
3 -> 1
4 -> 2
5 -> 1
6 -> 2
7 -> 1
8 -> 2
9 -> 2
10 -> 2
...
991 -> 1
992 -> 2
993 -> 2
994 -> 2
995 -> 3
996 -> 2
997 -> 1
998 -> 2
999 -> 2
1000 -> 2
Note that it takes increasingly longer time to compute higher values. The command above (with 1000 values) took almost 29 minutes to execute on my pc. By comparison, a hundred values takes about three quarter of a second...
It is possible to speed it up quite a bit, as long as we are only interested in the first hit - which will be the lowest number of primes:
File: prime-sum-faster (changes only)
unit sub MAIN (IntTwo $N,
:a(:$all),
:l(:$loquacious),
:v(:$verbose) = $loquacious || $all,
:u(:$upto),
:f(:$first));
sub recurse ($value is copy, @values is copy, @primes is copy, $input)
{
return if @values.elems > $shortest && ! $all;
return if @values.elems == $shortest && $first;
This program takes about 3.5 minutes to calculate the values up to 1000. Quite am impressive gain. But it could be even slightly faster, if we exit the program right after the first match. But that will not pan out with «upto» mode, so I'll refrain from trying.
Challenge #076.2: Word Search
Print out a list of all words seen on the grid, looking both orthogonally and diagonally, backwards as well as forwards.
Search Grid
B I D E M I A T S U C C O R S T
L D E G G I W Q H O D E E H D P
U S E I R U B U T E A S L A G U
N G N I Z I L A I C O S C N U D
T G M I D S T S A R A R E I F G
S R E N M D C H A S I V E E L I
S C S H A E U E B R O A D M T E
H W O V L P E D D L A I U L S S
R Y O N L A S F C S T A O G O T
I G U S S R R U G O V A R Y O C
N R G P A T N A N G I L A M O O
E I H A C E I V I R U S E S E D
S E T S U D T T G A R L I C N H
H V R M X L W I U M S N S O T B
A E A O F I L C H T O D C A E U
Z S C D F E C A A I I R L N R F
A R I I A N Y U T O O O U T P F
R S E C I S N A B O S C N E R A
D R S M P C U U N E L T E S I L
Found 55 words of length 5 or more when checked against the local dictionary. You may or may not get the same result but that is fine.
argos, constitution, margo, patna, traci, tracie, aimed, align, antes, arose, ashed, blunt, blunts, broad, buries, clove, cloven, constitution, constitutions, croon, depart, departed, enter, filch, garlic, goats, grieve, grieves, hazard, liens, malign, malignant, malls, midst, ought, ovary, parted, pudgiest, quash, quashed, raped, ruses, shrine, shrines, social, socializing, spasm, spasmodic, succor, succors, theorem, theorems, virus, viruses, wigged
I'll start with a couple of observations.
Observation 1: Not Quite Sorted
The resulting word list given above is not quite sorted, but we can fix that with a little cut and paste, as it is easier to compare a sorted list with the result from the program (which will be sorted).
> say <argos, constitution, ... , viruses, wigged>.words.sort;
Note that the word «constitution» appears twice. That clearly is an error.
We can check the number of words as well:
> say <argos, constitution, ... , viruses, wigged>.words.elems;
55
There is only one duplicate:
> say <argos, constitution, ... , viruses, wigged>.words.unique.elems;
54
Observation 2: Eight Directions
There are 8 possible directions of travel from any given point, as shown here. (Excluding directions going off the edge, but they can be considered edge cases (literally)...)
Then we just have to go on in each direction, collecting word candidates until we reach the edge. The numbers are offset to the initial value, on the form row, column.
Here we start with the letter «A», which is a word candidate (and indeed a word), then go on with «AN» (also a word), «ANT» (also a word), «ANTW» (not a word) and «ANTWG» (not a word):
(This section is loosely based on The Email Queen with Raku, my answer to Challenge 062 #2 N Queen.)
I have chosen to place the search grid in a text file (unimaginatively named «grid.txt»), on the form given in the challenge. This makes it possible to use other grids.
File: word-search (partial)
#! /usr/bin/env raku
unit sub MAIN ($dict where $dict.IO.f && $dict.IO.r # [1]
= '/usr/share/dict/british-english',
$grid where $grid.IO.f && $grid.IO.r # [2]
= 'grid.txt',
:m(:$min-length) = 1, # [3]
:v(:$verbose));
my @grid = $grid.IO.lines.map( *.lc.words.list ); # [4]
die "Uneven grid row length" unless [==] @(@grid)>>.elems; # [5]
die "Single characters only in the grid" if @(@grid)>>.chars>>.max.max > 1;
# [6]
my %dict = get-dictionary($dict); # [7]
sub get-dictionary ($file where $file.IO.r) # [7]
{
return $file.IO.lines.grep(* !~~ /\W/)>>.lc.Set; # [7]
}
[1]
The first positional argument is the dictionary file,
which defaults to the English dictionary on my Linux box. Note the tests
ensuring that the file is indeed is a file (IO.f) and is
readable by the program(IO.r).
[2] The same, for the grid file.
[3] The challenge does not explicitly state a minimum lenght of the words, but the exanple does (the value 5). So we can specify a limit with «--m» or «-min-length» if we want to. The default value is 1.
[4]
read the whole file with IO.lines, resulting
in an array with the lines. Then we use map to coerce the
lines to lower case, then split into words (on the spaces). The result is
a two-dimentional array, which we can access like
@grid[$row][$col]. The final list coerces the
data structure to a list, instead of a sequence. A sequence can only
be consumed (used) once. The following two lines does it twice, and that
would have caused an exception.
[5] Ensure that all the rows have the same length. !!
[6] Ensure that we only have single characters in the grid. !!
[7] Load the dictionary.
The get-dictionary procedure has been borrowed (and slightly modified)
from Datefinder General, A Raku Wordgame Raku, my
answer to
Challenge
038 #2 Word Game. See the description there for details.
See
docs.raku.org/routine/f and
docs.raku.org/routine/r
for more information about the file tests IO.f and
IO.r.
See
docs.raku.org/routine/list for
more information about list (even if if does not mention sequences).
See
docs.raku.org/routine/lines for
more information about lines (even if if does not mention
IO.lines).
my @candidates; # [8]
my $rows = @grid.elems; # [9]
my $cols = @grid[0].elems; # [10]
for ^$rows -> $row # [9a]
{
for ^$cols -> $col # [10a]
{
say ": [$row,$col]: @grid[$row][$col]" if $verbose;
@candidates.append: get-candidates($row, $col); # [11]
}
}
[8] We are storing the possible words here. Verifying them against the dictionary come later.
[9] Get the number of rows, and iterate over them [9a].
[10] Get the number of columns (in the first row), and iterate over them [10a]. Note that all the rows are of equal length (ensured by ([5]), so this works out.
[11]
Get the list of possible words for the given position,
and add them to the list. We add them with append, so that the new
values are added one at a time (and not as a single element, which is a list,
as would happen if we used push).
See
docs.raku.org/routine/append
for more information about append.
See
docs.raku.org/routine/push
for more information about push.
sub get-candidates ($row, $col) # [11]
{
my @candidates = @grid[$row][$col],; # [12]
for (-1, 0, 1) -> $r # [13]
{
for (-1, 0, 1) -> $c # [13]
{
say ": Pos $r, $c" if $verbose;
@candidates.append: do-get-candidates($row, $col, $r, $c) # [14]
unless $r == $c == 0;
}
}
return @candidates; # [15]
}
[12] Start the list of possible words with the letter found at the position itself. Note the trailing comma, which is List Operator, so that we get a list (with one element).
[13] Iterate over all the directions.
[14] Get the candidate words in that direction, and add them to the list. (Yes, I have indeed factored out the actual code generating the (possible) words a second time), unless we are standing still (both directional deltas are zero).
[15] Return the list of possible words.
See
docs.raku.org/routine/,
for more information about the list operator ,.
sub do-get-candidates ($row is copy, $col is copy, $r, $c) # [14]
{
my $current = @grid[$row][$col]; # [16]
my @candidates; # [17]
loop # [18]
{
$row += $r; # [18a]
$col += $c; # [18b]
last unless @grid[$row][$col].defined; # [19]
# last unless 0 < $row < $rows; # [19x]
# last unless 0 < $col < $cols; # [19x]
$current ~= @grid[$row][$col]; # [20]
@candidates.push: $current; # [21]
}
return @candidates; # [22]
}
[16] Get the letter at the current starting position.
[17] A list of candidate words, initially empty. (The single letter was added in [12].)
[18] Go on in the given direction,
[19] until we have reached the edge of the matrix, in
whatever direction we are travelling. Note the use of defined to
detect the edge. The two lines below it [19x] can be used instead, if you want to.
[20] Add the letter we have arrived at to the current word.
[21] Add the current word to the list. Note that we keep the current word, so we keep on adding letters to it ibn the loop.
[22] Return the candidate words.
See
docs.raku.org/type/Mu#index-entry-method_defined for more information about
defined.
my @words = @candidates # [A]
.unique # [B]
.sort # [C]
.grep({ %dict{$_} }) # [D]
.grep( *.chars >= $min-length); # [E]
say "Found {@words.elems} words of length $min-length or more: \
{ @words.join(', ') }";
Starting with all the possible words [A], we remove any duplicates [B]-
Then we sort the list [C] so that we get a list that we can compare with
others lists. Then we get rid of words that do not exist in the dictionary
(with grep [D]), and finally we remove words shorter than the
minimum word length - if we gave one.
Running it:
$ ./word-search
Found 463 words of length 1 or more: a, ac, ace, act, ad, ada, ag, ah,
aid, aim, aimed, air, al, ali, align, all, am, amd, an, ani, ant, ante,
antes, any, aol, ape, aped, ara, aral, are, argo, argos, arm, arose,
art, as, ash, ashe, ashed, asp, ass, at, ats, au, aug, ay, aye, b, ba,
baa, baas, ban, bans, be, ben, bid, bide, blu, blunt, blunts, broad,
buff, bur, buries, but, c, ca, cad, car, cart, cd, ci, cid, cl, cleo,
clove, cloven, cod, cold, con, cons, constitution, constitutions, cord,
cot, cox, coy, cr, croon, cs, cu, cub, cube, cue, cues, d, db, dec,
dee, depart, departed, di, die, died, dim, dis, do, doc, dot, doth,
dud, dun, duo, dust, e, ear, ebro, eco, ed, edit, eel, egg, eh, eli,
em, emo, ems, enter, era, es, etna, euro, eve, eves, f, fa, fdr, fe,
fed, fee, fey, fie, filch, for, fore, fr, g, gal, gals, garlic, gaul,
gd, ge, gil, gila, gin, go, goa, goat, goats, goo, got, gram, grieve,
grieves, grit, gs, gus, gym, gyms, h, ha, han, has, hat, hay, hays,
hazard, he, heed, hem, hg, hi, hie, hit, ho, hod, hug, i, ian, ice,
ices, id, ids, if, ila, in, ina, ines, ing, ins, ion, ions, ios, ira,
is, iso, it, ito, its, l, la, lag, lam, lara, las, lath, le, lea, lee,
len, leo, li, lie, lien, liens, liz, lo, los, lose, lot, love, ls,
luau, lug, m, ma, mali, malign, malignant, mall, malls, mar, margo, mas,
mci, md, me, meh, mel, mes, mg, mi, mia, mid, midst, mir, mn, mo, mod,
moo, ms, mu, my, n, na, nab, nan, nap, naps, nay, nd, ne, need, neil,
neo, ni, nit, no, not, np, nsa, nu, o, oat, oats, ob, oct, ode, of, oh,
ohm, ohms, ola, old, on, or, ora, orb, orc, ore, os, ought, out, ova,
ovary, oven, ow, ox, p, pa, pan, par, part, parted, pas, pat, patna,
pd, pee, ph, pi, piaf, pt, pu, pudgiest, q, qua, quash, quashed, r,
ra, rae, rag, ram, rap, rape, raped, rare, rca, re, rim, rn, road,
roe, rose, rs, rub, rue, rug, run, ruse, ruses, s, saab, sac, sad,
sal, sap, saps, sara, say, sb, se, see, set, sets, sh, she, shed,
shrine, shrines, si, sic, sid, sin, slag, slug, sn, so, sob, social,
sol, sot, sow, sows, soy, soya, spa, span, spas, spasm, spasmodic,
sun, t, tall, tao, tap, tat, tb, tea, teas, ted, tee, tees, th, the,
theorem, theorems, ti, tia, tic, tide, tin, tit, tits, to, tod, tog,
togo, tom, tome, ton, too, traci, tracie, trap, ts, tsar, tub, tut,
u, ugh, uh, um, up, ur, us, use, uses, ute, uzi, v, vary, vie, virus,
viruses, visa, vow, w, wifi, wig, wigged, wu, x, y, ye, yo, yon, yup,
z, zing, zr
The challenge listed words with 5 or more letters only, so we should do just that:
$ ./word-search -m=5
Found 51 words of length 5 or more: aimed, align, antes, argos, arose,
ashed, blunt, blunts, broad, buries, clove, cloven, constitution,
constitutions, croon, depart, departed, enter, filch, garlic, goats,
grieve, grieves, hazard, liens, malign, malignant, malls, margo, midst,
ought, ovary, parted, patna, pudgiest, quash, quashed, raped, ruses,
shrine, shrines, social, spasm, spasmodic, theorem, theorems, traci,
tracie, virus, viruses, wigged
The challenge gave a list of 55 words (with one duplicate). The follwing words did not show up in my dictionary lookup: «socializing», «succor» «succors».
And that's it.