I’ve been doing the Perl Weekly
Challenges. The
latest
involved summing primes and performing a word search.
TASK #1 › Prime Sum
You are given a number $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.
Er, yes, well, since literally by definition it isn't…
Anyway, back to the FIFO buffer mine. I assume that one can't re-use a
single prime.
sub psum {
my $n=shift;
Generate a bunch of prime numbers.
my %pr=map {$_ => 1} (2..$n);
foreach my $m (2..$n) {
foreach my $mi (2..$n) {
delete $pr{$m*$mi};
}
}
Give myself forward and reverse mapped lists of them (largest first).
my @p=sort {$b <=> $a} keys %pr;
my %pi=map {$p[$_] => $_} (0..$#p);
Now do the FIFO buffer thing, pushing all the possible candidate
numbers onto the end of the list if we haven't reached the target yet.
my @c=([]);
my @o;
while (my $r=shift @c) {
my $s=$n;
if (@{$r}) {
$s-=sum(map {$p[$_]} @{$r});
}
if ($s>0) {
my %ru=map {$_ => 1} @{$r};
foreach my $ci (grep {!exists $ru{$_}} map {$pi{$_}} grep {$_ <= $s} @p) {
push @c,[@{$r},$ci];
}
The first solution found has the minimum number of values. (There can
be multiple solutions; for example, 20 = 17+3 = 13+7.)
} elsif ($s==0) {
@o=map {$p[$_]} @{$r};
last;
}
}
return scalar @o;
}
I tried implementing this algorithm in Raku, but gave up because of it
ongoing problem with lists of lists. @c
is a list; each element of
it is also a list. I pull a list off it, then want to push onto it a
bunch of new lists, each consisting of a copy of the one I pulled plus
one new element. I have found no formulation that doesn't instead end
up pushing (old-list-object-copy, new-element). I'm sure it's terribly
helpful for whoever Raku's intended users are, but this is one of my
two huge frustrations with the language.
So instead I used combinations
: generate the list of primes,
generate each possible selection of primes from the list, then choose
only the ones that have the right sum. Since I start with the largest
numbers, the shortest lists should come first.
sub psum($n) {
my @p=reverse grep {is-prime($_)}, (2..$n);
my @s=grep {sum(@($_))==$n}, @p.combinations(1..@p.elems);
return @s[0].elems;
}
On to Python. Looks as if its lists are a bit closer to the raw C,
because there's a special object type if you want to pull stuff off
the front of a list with some efficiency. And the prime number
generation uses a set
, because I was frustrated after not being able
to use a SetHash
in Raku. The code is otherwise the same as Perl,
though given that the addition of new elements was the bit in Raku
that didn't work I laid out it out with a temporary variable just to
be sure.
(Python also has a combinations
but I didn't use it.)
from collections import deque
def psum(n):
pr=set(range(2,n+1))
for m in range(2,n+1):
for mi in range(2,n+1):
pr.discard(m*mi)
p=list(pr)
p.sort(reverse=True)
pi=dict()
for i in range(0,len(p)):
pi[p[i]]=i
c=deque()
o=list()
while True:
r=list()
s=n
if len(c)>0:
r=c.popleft()
s-=sum(p[i] for i in r)
if (s>0):
ru=set(r)
ca=set(pi[i] for i in p if i<=s)
ca-=ru
for i in ca:
q=r.copy()
q.append(i)
c.append(q)
elif (s==0):
o=[p[i] for i in r]
break
return len(o)
TASK #2 › Word Search
Write a script that takes two file names. The first file would
contain word search grid as shown below. The second file contains
list of words, one word per line. You could even use local
dictionary file.
Print out a list of all words seen on the grid, looking both
orthogonally and diagonally, backwards as well as forwards.
There's a bit more meat to this one. The approach I took was to break
down the puzzle grid into lists of search strings: horizontal,
vertical, downward-right diagonal, downward-left diagonal, each in
forward and reverse. Then I test each candidate word against each of
those search strings.
use List::Util qw(max);
my $minlen=5;
my $y;
my @grid;
my @searchspaces;
open I,'<',$ARGV[0] or die "Can't open puzzle file\n";
while (<I>) {
chomp;
s/ +//g;
$_=lc($_);
if (defined $y) {
if ($y != length($_)) {
die "Not a rectangular grid\n";
}
} else {
$y = length($_);
}
push @searchspaces,$_;
push @grid,[split '',$_];
push @searchspaces,join('',reverse(@{$grid[-1]}));
}
close I;
my $x=scalar @grid;
@grid
now contains the puzzle as individual letters, and we've added
the horizontal components to the search space. Now the verticals:
foreach my $i (0..$y-1) {
my @q=map {$grid[$_][$i]} (0..$x-1);
push @searchspaces,join('',@q);
push @searchspaces,join('',reverse @q);
}
And the diagonals, down-right and down-left. This is probably more
complicated than it needs to be.
{
my $mxy=max($x,$y)-1;
foreach my $xi (-$y+$minlen-1..$x-$minlen+1) {
my @seq=map {[$xi+$_,$_]} grep {$xi+$_>=0 && $xi+$_<$x && $_<$y} (0..$mxy);
if (scalar @seq >= $minlen) {
my @q=map {$grid[$_->[0]][$_->[1]]} @seq;
push @searchspaces,join('',@q);
push @searchspaces,join('',reverse @q);
}
}
foreach my $xi (-$y+$minlen-1..$x-$minlen+1) {
my @seq=map {[$xi+$_,$y-$_]} grep {$xi+$_>=0 && $y-$_>=0 && $xi+$_<$x} (1..$mxy);
if (scalar @seq >= $minlen) {
my @q=map {$grid[$_->[0]][$_->[1]]} @seq;
push @searchspaces,join('',@q);
push @searchspaces,join('',reverse @q);
}
}
}
Now we just go through the word list looking for each word's presence
in the search space.
my @found;
open I,'<',$ARGV[1] or die "Can't open wordlist file\n";
while (<I>) {
chomp;
if (length($_) >= $minlen) {
my $w=lc($_);
foreach my $ss (@searchspaces) {
if (index($ss,$w) > -1) {
push @found,$w;
last;
}
}
}
}
close I;
print join(', ',sort @found),"\n";
Raku is similar; lists of strings are within its capabilities, and
even (in @grid
) lists of lists that don't change. length
turns to
chars
, and various small details differ, but nothing serious.
In Python I discovered the lovely argparse
library.
import argparse
import sys
minlen=5
grid=list()
searchspaces=list()
y=0
parser = argparse.ArgumentParser(description='Process some integers.')
parser.add_argument('puzzle', type=argparse.FileType('r'),
help='the puzzle file')
parser.add_argument('wordlist', type=argparse.FileType('r'),
help='the wordlist file')
args = parser.parse_args()
And that checks for file existence and gives me back two readable
handles. (Granted, I'm cargo-culting how to read them rather than
looking it up properly.) Rather than squashing all the spaces and
splitting on characters, this time I split on "words" (i.e. spaces).
for lino, line in enumerate(args.puzzle, start=1):
q=line.rstrip().lower().split()
if (y>0):
if (y != len(q)):
sys.exit("Not a rectangular grid")
else:
y=len(q)
grid.append(q)
searchspaces.append(''.join(q))
searchspaces.append(''.join(reversed(q)))
x=len(grid)
Vertical search elements.
for i in range(0,y):
q=[grid[j][i] for j in range(0,x)]
searchspaces.append(''.join(q))
searchspaces.append(''.join(reversed(q)))
Diagonal search elements. As usual, list comprehension replaces Perl's
map
and grep
. (Python has those too, but they don't seem to be
used much.)
mxy=max(x,y)
for xi in range(-y+minlen-1,x-minlen+1):
seq=[[xi+i,i] for i in range(0,mxy) if xi+i>=0 and xi+i<x and i<y]
if (len(seq) >= minlen):
q=[grid[i[0]][i[1]] for i in seq]
searchspaces.append(''.join(q))
searchspaces.append(''.join(reversed(q)))
for xi in range(-y+minlen-1,x-minlen+1):
seq=[[xi+i,y-i] for i in range(1,mxy) if xi+i>=0 and y-i>=0 and xi+i<x]
if (len(seq) >= minlen):
q=[grid[i[0]][i[1]] for i in seq]
searchspaces.append(''.join(q))
searchspaces.append(''.join(reversed(q)))
And check the individual words.
found=list()
for lino, line in enumerate(args.wordlist, start=1):
w=line.rstrip().lower()
if (len(w) >= minlen):
for ss in searchspaces:
if (w in ss):
found.append(w)
break
found.sort()
print(', '.join(found))
All that's left is timing. On the example 16×19 puzzle, with the
SOWPODS word list of 267,751 entries (260,881 of them five or more
characters), running each program twice on an unloaded machine and
timing the second run:
- Perl took 4.069 seconds.
- Python took 4.098 seconds.
- Raku took 25.485 seconds.
Yeah. That's the other huge frustration with Raku.