Wear a Wig to Play the Goldbach Variations!

Wherein we search the texts for hidden meaning, adding up the indivisible holes in the master pattern. Wish us luck.

THE WEEKLY CHALLENGE – PERL & RAKU #76

---

episode 1
“The Goldbach Variations”

---

TASK #1 › Prime Sum

Submitted by: Mohammad S Anwar
Reviewed by: Ryan Thompson

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.

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.

ANALYSIS

How many prime numbers are required to create any given positive integer? Before really thinking about it very much my initial feeling said “two or three”, but I wasn’t at all sure why I thought that.

How can you generalize about numbers that defy predictability? There is no pattern to the prime numbers, there are only an infinite number of patterns for numbers that are not prime. By applying the Sieve of Eratosthenes, we can view the patterns behind the excluded numbers; the primes are just the holes left afterwords, their very existence defined by the absence of pattern.

Goldbach’s Conjecture (not to be confused with the Goldberg Variations), states that any even integer can be reduced to the sum of two primes. While remaining one of the great unproven problems in mathematics, it has been verified for all numbers up to to 4 × 10¹⁸. Thus although it still retains the most minute chance to render any algorithm using it to be flawed, by constricting our data space to values less than that very, very large number we should be safe. In any case with that caveat, there’s no reason not to let the conjecture guide our analysis.

So that’s half the field, even numbers, right there. For those, the answer is two. What about the odd numbers, though?

One quality about prime numbers is that they are, save 2, odd. So the sum of any two primes will always be even, the sum of any three, odd. Ok, yes, there is an edge case where when one of the primes is 2; an odd number can be created by adding an odd prime and the sole even prime 2. We’ll have to watch for that. But by subtracting any smaller odd prime from an odd integer we will end up with a even integer, and as assumed by the Conjecture, any even integer can be constructed from two primes.

Which leads to the conclusion that any integer can, if even, be constructed by the sum of two primes, and if odd, by a maximum of three primes.

There’s one more loose end out there, though, which is what if the number given is itself prime? Can it be said to be “constructed” from one prime, itself? Concluding “no” immediately leads to an existential crisis of identity, so I am disinclined to pursue that line of reasoning. One is already commonly accepted to be the loneliest number, and the primes in their pride stand alone, so I see no need to further the primal Weltschmerz. They have enough problems. Look around — there’s no shortage of prime problems. In Number Theory they’re everywhere.

So in an absolute sense, we have answered the challenge right here: if a number is prime itself the answer is one, any even integer results in two primes, and for odd integers we can, by subtracting 2 and checking the result for primeness, determine whether the edge case applies and report either two or three primes for those. The challenge never actually asks what those primes are, only how many are required. The examples, however, suggest that last step might be a better interpretation of the task, to provide at least one example, so we’ll do that. Even if, perchance, no one actually cares.

Perl Solution

To find our primes, we’ll start with a list of every prime less than the target number. To do that we’ll bring in our trusty make_prime_list() routine, which does exactly what we need by dividing out up to the square root. Once we have an array of primes, we can make a parallel hash structure from to allow quick and easy verification of the elements.

Armed with these, we can take the largest prime less than the target, subtract it and then do a hash lookup to see whether the difference is also prime. If not, the next largest prime is tried, then the next, until a hit is found; as per the Goldbach Conjecture it will eventually be so. This is an easy way to determine sum pairs.

For the triplets, the action is quite similar, only first we remove the value of the largest prime, then proceed to the summing pair for the remaining even number. By subtracting the largest prime we reduce the difference as much as we can, leaving the smallest number remaining to find a prime pair for. The only reason we choose to do it this way is that smaller numbers are just simpler numbers to work with, having fewer ways to decompose them.

To facilitate these actions we will park the prime pair sums over in their own routine, to be available for computing either pairs or triplets. Further, a little effort is made to avoid having to replicate the prime list, being the most computationally expensive aspect of the task. If we hand in a precomputed reference that is used, but if we don’t, as when we partition the smaller difference in a triplet, a new prime list is created.

[colincrain:~/PWC]$  perl 76_1_goldbach_variations.pl 222227
222227 = ( 222199 + 23 + 5 )

use warnings;
use strict;
use feature ":5.26";
use DDP;

## ## ## ## ## MAIN:

my $num = shift @ARGV // 57;
my ($primes, $lookup, $result);

$primes = make_prime_list($num);
$lookup = { map { $_ => 1 } $primes->@* };

## descend through the cases, in increasing complexity
if ($num == $primes->[-1]) {
    $result = [$num];
}
elsif ($num % 2 == 0 ) {
    $result = get_prime_pair($num, $primes, $lookup);
}
elsif (exists $lookup->{ $num-2 }) {  ## edge case for odd numbers
        $result = [$num-2, 2];
}
else {
    my $diff = $num - @{$primes}[-1];
    $result = [ $primes->[-1], get_prime_pair($diff)->@* ];
}

say "$num = ( ", (join ' + ', @$result), " )";


## ## ## ## ## SUBS:

sub make_prime_list {
## creates a list of all primes less than or equal to a given number
    my $max = shift;
    my @output = (2);
    CANDIDATE: for(  my $candidate = 3;  $candidate <= $max;  $candidate += 2  ) {
        my $sqrt_candidate = sqrt( $candidate );
        for(  my $test = 3; $test <= $sqrt_candidate; $test += 2  ) {
            next CANDIDATE if $candidate % $test == 0;
        }
        push @output, $candidate;
    }
    return \@output;
}

sub get_prime_pair {
## given an even number returns two primes that sum to it
## if $primes and $lookup are absent, makes new ones for $num
    my ( $num, $primes, $lookup ) = @_;
    if (not defined $primes) {
        $primes = make_prime_list($num);
        $lookup = { map { $_ => 1 } $primes->@* };
    };
   
    my $i = @$primes;
    while (--$i >= 0) {
        my $diff = $num - $primes->[$i];
        if ( exists $lookup->{ $diff } ) {
            return [$primes->[$i], $diff];
            last;
        }
    }
    return undef;
}

Raku Solution

In Raku, we get a prime test out of the box, so constructing a list of prime candidates is quick and easy. The $result assignment is also a fine example to demonstrate the

$result = do given $num { when {} ... }

construct. Which in turn highlights that instead of using a Hash to check for existence of a value in the prime list, we are using a Set, and the set operator “is an element of” that comes with it.

I’m well aware that just comparing with .is-prime is presumably a better way of going about this, but using explicit sets is just cool, so I’m in. Likewise creating the entire list of lesser primes is probably overkill as well; we might just count down from the target and check as we go to find the highest prime, then check the difference for primeness to find a pair. And once we eliminate the prime list, we no longer need a multi, so that’s out too.

Wow. We seem to be losing a lot of the cool Raku tricks here. When this goes into production I’ll have to change that.

But this works, and I’ve not used Set yet, and multi is cool too, so that was all fun and I’m keeping it as it is.

unit sub MAIN (Int $num where $num > 1 = 51) ;

## generate prime list and set
my @primes = (2..$num).grep: { .is-prime };
my $p = @primes.Set;    

## descend through the cases, in increasing complexity
my $result = do given $num {
    when    @primes.tail    { $num.List }  
    when    $_ %% 2         { get_prime_pair($num) }
    when    $_ - 2 ∈ $p     { $num-2, 2 }
    default                 { @primes.tail, |get_prime_pair($num - @primes.tail) }
};

## output
my $quan = $result.elems;
say "$quan\n\n$num can be summed from the $quan primes " ~ $result.join: ' + ';


multi get_prime_pair ($num, @primes) {
## calculates prime pairs that add to make number
## give it a prime list to avoid regenerating it
    my $p = @primes.Set;
    my $i = @primes.end;
    while ($i > -1)  {
        return (@primes[$i], $num - @primes[$i]) if ($num - @primes[$i] ∈ $p);
        $i--;
    }
}

multi get_prime_pair ($num) {
## without a prime list it will make a new one
    my @p = (2..$num).grep: { .is-prime };
    get_prime_pair($num, @p);
}

---

---

episode 2
“Where in the World is Wigged?”

---

TASK #2 › Word Search

Submitted by: Neil Bowers
Reviewed by: Ryan Thompson

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.

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

Output

Found 54 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.

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, socializing, spasm, spasmodic, succor, succors, theorem, theorems, traci, tracie, virus, viruses, wigged

Method

What an interesting puzzle, with what turns out to be a lot of parts and moving pieces. Checking every possible substring against every possible word seems like a tall order. But after examining the problem a little closer its not so bad.

There’s two halves of the word search, traversing the matrix for candidates, suitable and unsuitable, and the cross-referencing to a dictionary of valid words to verify them. Of the two, it seemed the lookup to be the more formidable, as the dictionary on my system has about 279,000 words in it.

It seemed like a trie would serve well for a lookup, hashing the words as a linked list of characters. This in itself isn’t too difficult a task or anything, but it does involve a bit of thinking through and a pair of accessor functions to add and verify words in the data structure. Each word check would be reduced to a half to a dozen or so small hash lookups. Sounds fast. Perl hashes are extremely fast, all in all. But when considering speed, it occurred to me that Perl hashes are fast, and also don’t scale. So why, again, do I need a trie? Dumping the entire word list into look-up hash is a trivial operation. In Raku it’s one line from filename to hash. Until we found it to be wanting, that was going to be just fine.

Curious, I ran some benchmarks on hash sizes vs time to fetch, by the way, and found a remarkable lack of linear scaling, with negligible difference overall, over a range of a hundred keys to ten million.

[colincrain:~/PWC]$  perl hash-speedtest-linear.pl 
           Rate tthou hthou thous milli hundr tmill
tthou 1316991/s    --   -1%   -1%   -1%   -2%   -2%
hthou 1323859/s    1%    --   -0%   -1%   -1%   -2%
thous 1325748/s    1%    0%    --   -0%   -1%   -2%
milli 1331858/s    1%    1%    0%    --   -0%   -1%
hundr 1338024/s    2%    1%    1%    0%    --   -1%
tmill 1349578/s    2%    2%    2%    1%    1%    --

A “mere” couple of hundred thousand words is nothing; a lookup takes what a lookup takes, no matter the size of the hash. If you notice, the ten million key hash is fastest for this run, although the actual difference is insignificant.

The other side of the search, finding candidate letter groupings, again became less daunting once it was broken down.

Each letter in the grid is potentially the beginning of a word. Each word can extend in one of eight directions from a starting letter: forwards, backwards, up, down, and diagonally on the four angles between those cardinal points. Each direction will have words of length 5, 6, 7 etc until we run out of grid, and each of those combinations will need to be considered a different word. A little back of the envelope counting led me to conclude that for a starting letter not close to any edge there would be about 37 letter combinations to look at, give or take. The grid given is 16 × 19, comprising 304 letters. Multiplying this by 37 yields only 11248 possible words. I had thought it would be a lot larger. In fact, because proximity to the edges eliminated some possibilities, the real number, for words 5 or more letters long, was only 10340.

All there was left was to determine the letter strings to check.

Not long ago we visited the classic 8-queens chess problem in 3D, in what I called the Spacequeen Problem. Having thought out all that geometry in three dimensions left me well prepared to computing it in an easy two. No triagonal unicorns here to confound us here! The result is a series of interrelated equations that calculate out the letter vectors in eight directions.

Once we have the vectors, we iterate over them from the base letter in increasing lengths to produce candidate words until we run out of vector. Cross-referencing these against the dictionary lookup filters these 10000 or so letter combinations down to the 68 words found.

Perl Solution

In Perl, the individual letter vectors are made by a series of small for loops, iterating over the index values in play and adding the letter found. For the diagonal vectors, we need an additional iterator to shift the other index simultaneously; this iterator is reset back to the starting x value between runs. An additional check must be made as well for the diagonals, this one within the loop to make sure the vector does not run out of bounds.

There’s a temptation to refactor these somewhat repetitive loops, perhaps functionally with a map construct, but Perl maps won’t allow an early exit with loop control statements like next and last. But no mind, this has the benefit of clarity and discrete action. To see how this might work in practice, take a look down at the Raku version in all its first-class functional glory.

[colincrain:~/PWC]$  perl 76_2_where_is_wigged.pl 'wordsearch.txt' '/Users/colincrain/dictionaries/scrabble.txt'
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 68 words of minimum length 5: 

AIMED
ALIGN
ANTES
AROSE
ASHED
BLUNT
  (...)
VIRUS
VIRUSES
WIFIE
WIGGED

use warnings;
use strict;
use feature ":5.26";

## ## ## ## ## MAIN:

my $file     = shift @ARGV // 'wordsearch.txt';
my $dict     = shift @ARGV // '/usr/share/dict/words';
my $MINWORD  = shift @ARGV // 5;

my $matrix = load_search_matrix($file);
print_matrix($matrix);

my $words = build_word_hash($dict);

my @possibles; 

my $height = @$matrix - 1;
my $width  = $matrix->[0]->@* - 1 ;

for my $y (0..$height) {
    for my $x (0..$width) {
        push @possibles,  word_vectors( $x, $y, $matrix)->@*;
    }
}

my @output = grep { exists $words->{$_} } @possibles;
say '';
say "found ", scalar @output, " words of minimum length $MINWORD: \n";
say for sort @output;

## ## ## ## ## SUBS:

sub word_vectors {
    my ($x, $y, $matrix) = @_;
    my $height = @$matrix - 1;
    my $width  = $matrix->[0]->@* - 1 ;
    my @words;
    my @vec ;
    my $i;
    
    ## horz forward
    push $vec[0]->@*, $matrix->[$y][$_] for ($x..$width);
    
    ## horz back
    push $vec[1]->@*, $matrix->[$y][$_] for reverse (0..$x);
    
    ## vert down
    push $vec[2]->@*, $matrix->[$_][$x] for ($y..$height);
    
    ## vert up
    push $vec[3]->@*, $matrix->[$_][$x] for reverse (0..$y);

    ## diag down forward
    $i = $x;
    for ($y..$height) {         ## y to height index
        last if $i > $width;
        push $vec[4]->@*, $matrix->[$_][$i++];
    } 

    ## diag down back
    $i = $x;
    for ($y..$height) {         ## y to height index
        last if $i < 0;
        push $vec[5]->@*, $matrix->[$_][$i--];
    }
 
    ## diag up forward
    $i = $x;
    for (reverse (0..$y)) {         ## 0 to y 
        last if $i > $width;
        push $vec[6]->@*, $matrix->[$_][$i++];
    }

    ## diag up back
    $i = $x;
    for (reverse (0..$y)) {         ## 0 to y 
        last if $i < 0;
        push $vec[7]->@*, $matrix->[$_][$i--];
    }

    ## turn vectors into strings $MINWORD letters or longer
    for my $v (@vec) {
        next if @$v < $MINWORD;
        my $stem = join '', @$v[0..$MINWORD-2];
        push @words, map { $stem .= $_ } @$v[$MINWORD-1..@$v-1];
    }

    return \@words;
}

sub load_search_matrix {
    my $file = shift;
    open my $fh, '<', $file 
        or die "cannot open file $file: $!\n";
    my @search;
    
    while (my $line = <$fh>) {
        push @search, [split /\s/, $line];    
    }
    close $fh;
    return \@search;
}

sub print_matrix {
    my $matrix = shift;
    for (@$matrix) {
        say join ' ', @$_;
    }
}

sub build_word_hash {
    my $dict = shift;
    my %hash;
    open my $fh, "<",  $dict
        or die "can't open $dict to read: $!";
        
    while (my $word = <$fh>) {
        $word =~ s/[\n\r]//g;  
        $word = uc($word);
        $hash{$word} = 1;
    } 
    return \%hash;
}

Raku Solution

In Raku, everything is a first-class citizen, and every loop block, including those in map and grep, allows control statements like next and last. As such, the vector definitions can be rewritten as mappings that can be exited should they stray out of bounds. But why stop there? Assignment to a master list of vectors is another repetitive task, and the eight functions that create the vectors can be collected in a list and processed all at once with

@vectors.push( $_() ) for { block }, { block }, ...

which looks very clean to me. Sweet.

Bughunt

One aspect of all this functional looping, one that caught me several times in this challenge, is how map does not produce a list or array after processing, but rather a sequence, or Seq.

This has caught me before, but I think I worked around it without a thorough understanding of why what I did worked. In short, the difference being that a Seq has lazy evaluation, so in a sense doesn’t exist until you look at it. When I first refactored the Perl for loops as mapped functions, several of them broke. Not completely, mind you, but the x axis was way off on the down-back and up-back diagonals. I explicitly reset the iterator variables between runs, but it made no difference, it wouldn’t stick. As it was, I determined the extra iterator was only being manipulated within the maps, not from the surrounding code. The iterator was incrementing in one map, then going down again in the next. As blocks are closures, this should not be the case, and in fact as we’re handing in the $i variable at the first of the diagonals, it obviously isn’t. So what on Earth was happening?

One thing I noticed was that when debugging, the print statements I was interspersing to peek at the values for $i were coming out out-of-order. Adding a few more to nail down exactly when the code was being executed finally gave me what I needed to know, and it dawned on me. The @vectors were not a list of lists, a very perlish thing to think, but rather they were an array of sequences, and the individual vectors were only evaluated when they were looked at a half-dozen lines lower, when they were iterated through to produce word candidates. By placing the $i = $x reset code there, everything worked as expected.

But sequences weren’t done with me. When I had first read in the letter grid file, I printed it out to make sure I had gotten things right. I had, and it was handy see it there for quick reference as I worked out the rest, so I left it. Fast-forward to the end of the story; I want the output all gathered together at the end and move the line. And everything breaks.

The iterator of this Seq is already in use/consumed by another Seq
(you might solve this by adding .cache on usages of the Seq, or
by assigning the Seq into an array)
  in sub word_vectors at /Users/colincrain/Code/PWC/76-2-where-is-wigged.raku line 47
  in block  at /Users/colincrain/Code/PWC/76-2-where-is-wigged.raku line 32
  in sub MAIN at /Users/colincrain/Code/PWC/76-2-where-is-wigged.raku line 30
  in block <unit> at /Users/colincrain/Code/PWC/76-2-where-is-wigged.raku line 1

All from just moving the line

.put for @matrix;

which prints the sub-arrays. What?

After a bit of hair-pulling, failure and drama, after searching the web for the error message, I ended up on PerlMonks with a nearly identical problem broached by Athanasius. Why would a print statement fix this error? It turns out that the print requires evaluation of the Seq, of course, but also assumes you want to keep those values for later, so it calls .cache on the Seq. A Seq by default is expected to be evaluated once and moved on from, so it comes with an iterator that moves forward and is expended. Calling .cache works around this by caching the results so they can be reviewed, as this behavior isn’t on by default. Before I had fixed this by casting to an Array, which also works, but now I have a deeper understanding of what’s really going on. Having scores of built-in data structures is nice, but takes a bit of getting used to shifting over from only three.

Like most problems, its impossible until you know the answer, then its trivial. Oh, that little thing? Of course it’s a sequence. Pshaw.

unit sub MAIN (Str $file = 'wordsearch.txt', Str $dict = '/usr/share/dict/words') ;


## cfg
my $MINWORD = 5;        ## val > 1 

## in 
my @matrix = $file.IO.lines 
                  .map( { .comb(/\w/).cache; } ); ## <-- need to cache the internal Seqs
my %lookup = $dict.IO.lines
                  .map( { my $copy = $_; $copy.=uc; $copy => 1} );

## work   
my @possibles;
for 0..@matrix.end -> $y {            ## height
    for 0..@matrix.head.end -> $x {   ## width
        @possibles.append: |word_vectors( $x, $y, @matrix);
    }
}
my @output = @possibles.grep:{ %lookup{$_}:exists }                 

## out
.put for @matrix;
say '';
say "found ", @output.elems, " words of minimum length $MINWORD: \n";
.say for sort @output;
     
# + + + + + + + + + + + + + + + + + + + + + +    

sub word_vectors ($x, $y, @mat)  {
    my $height = @mat.end;
    my $width  = @mat.head.end;
    my @words;
    my @vectors ;
    my $i = $x;
    
    ## formulae for the 8 vectors
    @vectors.push( $_() ) for 
        { ($x..$width).map:    { @mat[$y][$_]} },                          ## horz forward
        { (0..$x).reverse.map: { @mat[$y][$_]} },                          ## horz back
        { ($y..$height).map:   { @mat[$_][$x]} },                          ## vert down
        { (0..$y).reverse.map: { @mat[$_][$x]} },                          ## vert up
        { ($y..$height).map:   { last if $i > $width; @mat[$_][$i++] } },  ## diag down forward
        { ($y..$height).map:   { last if $i < 0;      @mat[$_][$i--] } },  ## diag down back
        { (0..$y).reverse.map: { last if $i > $width; @mat[$_][$i++] } },  ## diag up forward
        { (0..$y).reverse.map: { last if $i < 0;      @mat[$_][$i--] } } ; ## diag up back  
    
    ## turn vectors into strings $MINWORD letters or longer
    for @vectors -> @v {
        $i = $x;       ## <-- lazy evaluation in map Seqs above need the reset to be here!
        next if @v.elems < $MINWORD;
        my $stem      = ( @v[0..$MINWORD-2] ).join;
        my @vec_words = ( @v[$MINWORD-1..@v.end] ).map: { $stem ~= $_ } ;
        @words.push: |@vec_words;
    }
    return @words;
}