diff options
| -rw-r--r-- | challenge-121/mark-anderson/raku/ch-2.raku | 158 |
1 files changed, 106 insertions, 52 deletions
diff --git a/challenge-121/mark-anderson/raku/ch-2.raku b/challenge-121/mark-anderson/raku/ch-2.raku index c492deba65..0b872a9dad 100644 --- a/challenge-121/mark-anderson/raku/ch-2.raku +++ b/challenge-121/mark-anderson/raku/ch-2.raku @@ -1,78 +1,132 @@ #!/usr/bin/env raku -my @matrix = [ ∞, 5, 2, 7 ], - [ 5, ∞, 5, 3 ], - [ 3, 1, ∞, 6 ], - [ 4, 5, 4, ∞ ]; +use Test; +plan 4; -my ($cost, @reduced) = get-cost-and-reduced(@matrix); +is branch-and-bound([ ∞, 5, 2, 7 ], + [ 5, ∞, 5, 3 ], + [ 3, 1, ∞, 6 ], + [ 4, 5, 4, ∞ ]), 10, + 'Example 1'; + +is branch-and-bound([ ∞, 15, 30, 4 ], + [ 6, ∞, 4, 1 ], + [ 10, 15, ∞, 16 ], + [ 7, 18, 13, ∞ ]), 36, + 'https://www.youtube.com/watch?v=cSY82XtVqYg&t=761s'; -say branch-and-bound([1], @reduced); +is branch-and-bound([ ∞, 20, 30, 10, 11 ], + [ 15, ∞, 16, 4, 2 ], + [ 3, 5, ∞, 2, 4 ], + [ 19, 6, 18, ∞, 3 ], + [ 16, 4, 7, 16, ∞ ]), 28, + 'https://www.youtube.com/watch?v=1FEP_sNb62k'; -sub branch-and-bound(@path, @matrix) -{ - return $cost if @path.elems == @matrix.elems; +is branch-and-bound([ ∞, 14, 4, 10, 20 ], + [ 14, ∞, 7, 8, 7 ], + [ 4, 5, ∞, 4, 16 ], + [ 11, 7, 9, ∞, 2 ], + [ 18, 7, 17, 4, ∞ ]), 30, + 'https://www.youtube.com/watch?v=HjSbaKF8Gi0'; - my %h = Empty; - - for get-paths(@path) -> @p - { - my @m = prepare(@p, @matrix.duckmap(*.clone)); - (my $c, @m) = get-cost-and-reduced(@m); - my $total = [+] $cost, @matrix[@p[*-2]-1;@p[*-1]-1] + $c; - - %h{$total}<path> = @p; - %h{$total}<matrix> = @m; - } +say branch-and-bound(random-matrix(15)); +say branch-and-bound(random-matrix(20)); - $cost = .key with min %h; - branch-and-bound(.value<path>, .value<matrix>) with min %h; -} - -sub get-cost-and-reduced(@matrix) +class Node { - my @cost; - my @m = @matrix.duckmap(*.clone); + has $.cost is rw; + has @.path; + has @.matrix; - for ^2 + method Reduce { - for @m -> @r + my @cost; + + for ^2 { - my $min = @r.min; - $min = 0 if $min == ∞; - @cost.push: $min; - - for @r -> $n is rw + for @.matrix -> @r { - $n -= $min; - $n = ∞ if $n ~~ NaN; + my $min = @r.min; + $min = 0 if $min == ∞; + @cost.push($min); + + for @r -> $n is rw + { + $n -= $min; + $n = ∞ if $n ~~ NaN; + } } + + @.matrix = [Z] @.matrix; + @.matrix .= map(*.Array); } + + $.cost = @cost.sum; + } - @m = [Z] @m; - @m .= map(*.Array); + method paths + { + my @rest = ((1..@.matrix) ∖ @.path).keys; + my @p = @.path xx @rest; + + @p.map({ $_ = [ |$_, @rest.pop ] }).Array; } - @cost.sum, |@m; + method set-Infs + { + my $r = @.path[*-2]-1; + my $c = @.path[*-1]-1; + + @.matrix[$r].map({ $_ = ∞ }); + @.matrix.map({ .[$c] = ∞ }); + @.matrix[$c;@.path[0]-1] = ∞; + } } -sub get-paths(@a) +multi branch-and-bound(+@matrix) { - my @nodes = 1..@matrix.elems; - my @copy = (@nodes (-) @a).keys; - my @p = @a xx @copy; - - @p.map({ $_ = [ |$_, @copy.pop ] }).Array; + my $node = Node.new(:path([1]), :matrix(@matrix)) andthen .Reduce; + branch-and-bound($node, []); } -sub prepare(@path, @matrix) +multi branch-and-bound($n, @leaves) { - my @m = @matrix.duckmap(*.clone); - my $r = @path[*-2]-1; - my $c = @path[*-1]-1; + return $n.cost if $n.path == $n.matrix; + + my $node; + my @nodes = Empty; + + for $n.paths -> @p + { + $node = Node.new(:path(@p)); + $node.matrix = $n.matrix.duckmap(*.clone); + $node.set-Infs; + $node.Reduce; + $node.cost += sum $n.cost, $n.matrix[@p[*-2]-1;@p[*-1]-1]; + @nodes.push($node); + } + + my $min = @nodes.map(*.cost).min; + my $k = @leaves.first(*.cost < $min, :k); + + if $k.defined + { + $node = @leaves.splice($k, 1).head; + } + + else + { + $k = @nodes.first(*.cost == $min, :k); + $node = @nodes.splice($k, 1).head; + } + + @leaves.append(@nodes); + branch-and-bound($node, @leaves); +} - @m[$r].map({ $_ = ∞ }); - @m.map({ .[$c] = ∞ }); - @m[$c;@path[0]-1] = ∞; +sub random-matrix($n) +{ + my @m = ([ roll $n, (1..$n*2) ] xx $n); + @m.map({ .[$++] = ∞ }); @m; } |