Branch and bound using Perl - perl

Question

I have a problem, I cannot find an answer to. I am using Perl. My input is a symmetric cost-matrix, kind of like the TSP.
I want to know all solutions that lie beneath my boundary, which is 10.
This is my matrix:
- B E G I K L P S
B - 10 10 2 10 10 10 10
E 10 - 2 10 10 10 1 10
G 10 2 - 10 2 3 3 3
I 2 10 10 - 4 10 10 2
K 10 10 2 4 - 10 10 3
L 10 10 3 10 10 - 2 2
P 10 1 3 10 10 2 - 10
S 10 10 3 2 3 2 10 -
Does anybody know how to implement the branch and bound algorithm to solve this? For now, I did replace every 10 in the matrix with "-".
What I did so far:
#verwbez = ( ["-", B, E, G, I, K, L, P, S],
[B,"-", 10, 10, 2, 10, 10, 10, 10],
[E, 10, "-", 2, 10, 10, 10, 1, 10],
[G, 10, 2, "-", 10, 2, 3, 3, 3],
[I, 2, 10, 10, "-", 4, 10, 10, 2],
[K, 10, 10, 2, 4, "-", 10, 10, 3],
[L, 10, 10, 3, 10, 10, "-", 2, 2],
[P, 10, 1, 3, 10, 10, 2, "-", 10],
[S, 10, 10, 3, 2, 3, 2, 10, "-"]);
for ($i=0;$i<=$#verwbez;$i++) {
for ($j=0; $j<=$#{$verwbez[$i]};$j++) {
while ($verwbez[$i][$j] >=7) {
$verwbez[$i][$j] = "-";
}
}
}
Basically just altering the matrix, every 10 is replaced with a "-". Now I want to find all solutions that are beneath 10 and contain 4 districts where always two cities are linked together. But unfortunately, I do not know how to proceed/start...

Answer 1

You're unlikely to get someone to implement the Branch and Bound algorithm for you. However, the following stackoverflow post, TSP - branch and bound, has some links to some helpful resources:
Optimal Solution for TSP using Branch and Bound
B&B Implementations for the TSP -
Part 1: A solution with nodes containing partial tours with
constraints
B&B Implementations for the TSP - Part 2: Single threaded solution with many inexpensive nodes
Since you appear new to perl, we can give you some quick tips
Always include use strict; and use warnings at the top of each and every perl script
Use the range operator .. when creating an incrementing for loop.
Your while loop should actually be an if statement.
For increased style, consider using qw() when initializing a mixed word/number array, especially since it will allow you to easily align a multidimensional array's elements
Your first goal for a project like this should be to create a method to output your multidimensional array in a readable format, so you can observe and verify the changes that you're making.
All of that gives the following changes:
use strict;
use warnings;
my #verwbez = (
[qw(- B E G I K L P S )],
[qw(B - 10 10 2 10 10 10 10)],
[qw(E 10 - 2 10 10 10 1 10)],
[qw(G 10 2 - 10 2 3 3 3 )],
[qw(I 2 10 10 - 4 10 10 2 )],
[qw(K 10 10 2 4 - 10 10 3 )],
[qw(L 10 10 3 10 10 - 2 2 )],
[qw(P 10 1 3 10 10 2 - 10)],
[qw(S 10 10 3 2 3 2 10 - )],
);
for my $i (0 .. $#verwbez) {
for my $j (0 .. $#{$verwbez[$i]}) {
if ($verwbez[$i][$j] =~ /\d/ && $verwbez[$i][$j] >= 7) {
$verwbez[$i][$j] = ".";
}
}
}
for (#verwbez) {
for (#$_) {
printf "%2s ", $_;
}
print "\n";
}
Outputs:
- B E G I K L P S
B - . . 2 . . . .
E . - 2 . . . 1 .
G . 2 - . 2 3 3 3
I 2 . . - 4 . . 2
K . . 2 4 - . . 3
L . . 3 . . - 2 2
P . 1 3 . . 2 - .
S . . 3 2 3 2 . -
Note that B has only 1 city it's near to. So if the goal was solving the TSP, then there isn't a trivial solution. However, given there are only 8 cities and (n-1)! circular permutations. That gives us just 5,040 permutations, so using brute force would totally work for finding a lowest cost solution.
use strict;
use warnings;
use Algorithm::Combinatorics qw(circular_permutations);
my #verwbez = ( ... already defined ... );
# Create a cost between two cities hash:
my %cost;
for my $i (1..$#verwbez) {
for my $j (1..$#{$verwbez[$i]}) {
$cost{ $verwbez[$i][0] }{ $verwbez[0][$j] } = $verwbez[$i][$j] if $i != $j;
}
}
# Determine all Routes and their cost (sorted)
my #cities = keys %cost;
my #perms = circular_permutations(\#cities);
my #cost_with_perm = sort {$a->[0] <=> $b->[0]} map {
my $perm = $_;
my $prev = $perm->[-1];
my $cost = 0;
for (#$perm) {
$cost += $cost{$_}{$prev};
$prev = $_
}
[$cost, $perm]
} #perms;
# Print out lowest cost routes:
print "Lowest cost is: " . $cost_with_perm[0][0] . "\n";
for (#cost_with_perm) {
last if $_->[0] > $cost_with_perm[0][0];
print join(' ', #{$_->[1]}), "\n";
}
It ends up there are only 2 lowest cost solutions to this setup, and they're mirror images of each other, which makes sense since we didn't filter by direction in our circular permutations. Am intentionally not stating what they are here.