t3/timtom-2

Download the raw code.

use v6;

# Problem 3 -- Calculate addition chains.
# The minimum path to a particular target can be found by doing a breadth
# first search through all the possibilities.
# I prune nodes that get to a target value at less than the optimal length. There
# were no differences with the guarunteed optimal non-pruning version out to a depth
# of 13 nodes, which was the farthest I was willing to push my optimized ada program
# (It took 6 GB of memory to get that far).
# Because of the large number of nodes created and the fact that these sequences
# have a lot of shared representation, I implemented the sequences as singly
# linked lists using Pairs.


# Helper method to turn our hand rolled list into the more usable perl6 list.
sub shared-list-to-list($sequence)
{
    my @list;
    sub iterate($sequence)
    {
        unshift(@list, $sequence.key);
        if defined $sequence.value
        {
            return iterate($sequence.value);
        }
    }
    iterate($sequence);
    return @list;
}


die "Target chain argument required." unless @*ARGS;
my $target = @*ARGS[0].Int;

if $target == 1
{
    say "(1)";
    exit 0;
}
elsif $target <= 0 || $target ne @*ARGS[0]
{
    die "Unable to achieve @*ARGS[0]: must be a positive integer.";
}

my %length;

my @queue = ("Marker", 1 => Mu);

my $length = 1;

# Breadth first search
loop
{
    my $sequence = shift @queue;
    # We put a string marker to denote when we've moved to a new depth in our
    # search. This is done so that we don't have to store the length in every
    # sequence or be forced to do a O(n) length lookup.
    if ($sequence ~~ Str) {
        $length = $length + 1;
        say $length;
        push(@queue, "Marker");
        next;
    }
    my $last = $sequence.key;
    loop (my $next = $sequence; defined $next; $next = $next.value)
    {
        my $sum = $last + $next.key;
        if $sum == $target
        {
            my @final-sequence = shared-list-to-list($sum => $sequence);
            say "(@final-sequence.join(', '))";
            exit 0;
        }
        elsif $sum < $target
        {
            # If this is the first time we've seen this sum, mark it.
            if !%length.exists: $sum
            {
                %length{$sum} = $length;
            }
            # Prune sequences that don't arrive within the optimal length.
            elsif %length{$sum} < $length
            {
                next;
            }
            # Push it onto our sequence queue.
            @queue.push($sum => $sequence);
        }
    }
}

Correctness

As noted in the blog post, code which generates Brauer chains will work correctly... up until N = 12509, the shortest chain length at which no Brauer chain is minimal.

Consistency

Inconsistent layout of braces after loop and conditional headers, sometimes there is a newline before the brace, sometimes not.

There is also a use of superstitious parenthesis around an if-condition.

Clarity of intent

The program is longer than the author's first submission. The increased length makes it less easy to take in at once, but it's still straightforward enough to analyze.

You can still distinguish the first algorithm inside the second, which is nice.

The comments are helpful and clear.

Algorithmic efficiency

Since the algorithm is based on the author's first submission, it's also a breadth-first search. The clever use of Pair for Lisp-like lists helps save a bit of memory, but the running speed is about the same.

Idiomatic use of Perl 6

Nice use of a lexically nested sub iterate!

Otherwise, same comments as with the first submission: some manual argument handling instead of MAIN, and some superstitious parentheses around the right-hand side of list assignments.

Brevity

The code is now longer than short.