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;
}
Identifiers are given reasonable names, and things are nicely indented.
Thumbs up.
Choosing to store matrix dimensions in a Pair
could perhaps have been
more advertised.
arrangment
should be spelled arrangement
.
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.
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.
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.