p1-colomon

Download the raw code.

use v6;
use Test;

# borrowed from List::Utils
sub sliding-window(@a, $n) is export(:DEFAULT) {
    my $a-list = @a.iterator.list;
    my @values;
    gather while defined(my $a = $a-list.shift) {
        @values.push($a);
        @values.shift if +@values > $n;
        take @values if +@values == $n;
    }
}

sub multiply(Pair $a, Pair $b) {
    die "{ $a.key } x { $a.value } cannot be multiplied with { $b.key } x { $b.value }" 
        unless $a.value == $b.key;
    ($a.key * $a.value * $b.value, $a.key => $b.value);
}

class Ordering {
    has @.ops is rw;

    method Str() {
        my @stack;
        for @.ops {
            when "*" { 
                my $a = @stack.pop; 
                my $b = @stack.pop;
                @stack.push("($a$b)");
            }
            when Int {
                @stack.push("A{$_ + 1}");
            }
        }

        @stack[*-1];
    }

    method calculate-multiplications(@matrices) {
        my @stack;
        my $total-multiplications = 0;
        for @.ops {
            when "*" { 
                my $a = @stack.pop; 
                my $b = @stack.pop;
                my ($multiplications, $matrix) = multiply($a, $b);
                $total-multiplications += $multiplications;
                @stack.push($matrix);
            }
            when Int {
                @stack.push(@matrices[$_]);
            }
        }

        $total-multiplications;
    }
}

# Based on the List::Utils permute routine, itself based on 
# permutation code from HOP.

sub generate-orderings($num) {
    sub pattern-to-ordering(@pattern is copy) {
        my $i = $num;
        my $ordering = Ordering.new;
        $ordering.ops.push(--$i);
        for ^+@pattern -> $j {
            $ordering.ops.push(--$i);
            for 0..$j -> $k {
                next unless @pattern[$k].defined;
                if @pattern[$k] == 0 {
                    $ordering.ops.push("*");
                    @pattern[$k] = Any;
                } else {
                    @pattern[$k]--;
                }
            }
        }
        $ordering;
    }

    sub n-to-pat($n is copy, $length) {
        my @odometer;
        for 1 .. $length -> $i {
            unshift @odometer, $n % $i;
            $n div= $i;
        }
        return $n ?? () !! @odometer;
    }

    if $num == 1 {
        Ordering.new(ops => (0));
    } else {
        my $n = 0;
        gather loop {
            my @pattern = n-to-pat($n++, $num - 1);
            last unless ?@pattern;
            take pattern-to-ordering(@pattern).item;
        }
    }
}

sub best-arrangment(@matrices) {
    generate-orderings(+@matrices).min(*.calculate-multiplications(@matrices));
}

multi MAIN() {
    my @input = $*IN.get.comb(/\S+/)>>.Int;
    unless +@input > 1 && @input.all > 0 {
        say "Input must consist of at least two integers.";
        return;
    }
    my @matrices = sliding-window(@input, 2).flat.map(-> $a, $b { $a => $b });
    say best-arrangment(@matrices);
}

multi MAIN("test") {
    plan *;

    is multiply(10 => 20, 20 => 30)[0], 6000, "10x20 * 20x30 takes 6000 multiplications...";
    is multiply(10 => 20, 20 => 30)[1], 10 => 30, "...and results in 10x30 matrix";
    is multiply(10 => 30, 30 => 15)[0], 4500, "10x30 * 30x15 takes 4500 multiplications...";
    is multiply(10 => 30, 30 => 15)[1], 10 => 15, "...and results in 10x15 matrix";

    my @matrices = 10 => 30, 30 => 15, 15 => 10;
    is Ordering.new(ops => (2, 1, 0, "*", "*")).calculate-multiplications(@matrices), 
       6000, "((A1A2)A3) takes 6000 multiplications";
    is Ordering.new(ops => (2, 1, "*", 0, "*")).calculate-multiplications(@matrices), 
       7500, "((A1A2)A3) takes 6000 multiplications";

    is Ordering.new(ops => (2, 1, 0, "*", "*")), "((A1A2)A3)", 
       "((A1A2)A3) stringifies correctly";
    is Ordering.new(ops => (2, 1, "*", 0, "*")), "(A1(A2A3))", 
       "(A1(A2A3)) stringifies correctly";

    {
        my @strings = ~<<generate-orderings(1);
        ok ?@strings.grep("A1"), "A1 is present in the 1 matrix case";
        is +@strings, 1, "nothing else is present in the 1 matrix case";
    }

    {
        my @strings = ~<<generate-orderings(2);
        ok ?@strings.grep("(A1A2)"), "(A1A2) is present in the 2 matrix case";
        is +@strings, 1, "nothing else is present in the 2 matrix case";
    }

    {
        my @strings = ~<<generate-orderings(3);
        ok ?@strings.grep("((A1A2)A3)"), "((A1A2)A3) is one in the 3 matrix case";
        ok ?@strings.grep("(A1(A2A3))"), "(A1(A2A3)) is one in the 3 matrix case";
    }

    {
        my @strings = ~<<generate-orderings(4);
        ok ?@strings.grep("(((A1A2)A3)A4)"), "(((A1A2)A3)A4) is one in the 4 matrix case";
        ok ?@strings.grep("((A1A2)(A3A4))"), "((A1A2)(A3A4)) is one in the 4 matrix case";
        ok ?@strings.grep("(A1(A2(A3A4)))"), "(A1(A2(A3A4))) is one in the 4 matrix case";
    }

    is best-arrangment([10 => 30, 30 => 15, 15 => 10]), "((A1A2)A3)", "Masak's example works";
    is best-arrangment([10 => 15, 15 => 30, 30 => 10]), "(A1(A2A3))", "Masak's example backwards works";

    done;
}

Readability

Identifiers are given reasonable names, and things are nicely indented.

Consistency

Thumbs up.

Clarity of intent

Choosing to store matrix dimensions in a Pair could perhaps have been more advertised.

arrangment should be spelled arrangement.

Algorithmic efficiency

This one is the real killer for the submission. The code generates all permutations of N matrices; for a large enough N, using this code to find the best way to multiply the matrices would be a net loss of computing time.

Idiomatic use of Perl 6

I see a gather loop { ... } in there, that's not every day someone writes that. Nice.

Lots of unnecessary castings, though, like if +@input > 1 and last unless ?@pattern. I know it's a matter of taste, but I like it better without the castings... feels more like playing to Perl's strengths.

Brevity

For what it does, the code is not overly long. Ironically, though, a solution using dynamic programming can be written in fewer lines of code than this, as evidenced by the submissions that went that route.