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.