使用Perl进行分支和绑定

时间:2014-03-25 16:31:10

标签: perl branch-and-bound

我有一个问题,我找不到答案。我正在使用Perl。我的输入是对称的成本矩阵,有点像TSP。

我想知道我的边界下面的所有解决方案,即10。

这是我的矩阵:

-   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  -   

有人知道如何实现分支定界算法来解决这个问题吗?现在,我确实用" - "。

替换矩阵中的每10个

到目前为止我做了什么:

 @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] = "-";
        }
    }
} 

基本上只是改变矩阵,每10个被替换为&#34; - &#34;。现在我想找到10以下的所有解决方案,并包含4个区域,其中两个城市总是连在一起。但不幸的是,我不知道如何继续/开始...

1 个答案:

答案 0 :(得分:1)

您不太可能让某人为您实施Branch and Bound算法。但是,以下stackoverflow帖子TSP - branch and bound包含一些有用资源的链接:

  1. Optimal Solution for TSP using Branch and Bound
  2. B&B Implementations for the TSP - 第1部分:包含部分巡视的节点的解决方案 约束
  3. B&B Implementations for the TSP - 第2部分:具有许多廉价节点的单线程解决方案
  4. 由于您对perl不熟悉,我们可以为您提供一些快速提示

    1. 始终在每个perl脚本的顶部加入use strict;use warnings
    2. 创建递增for循环时使用range operator ..
    3. 您的while循环实际上应该是if语句。
    4. 为了增加样式,请在初始化混合字/数字数组时考虑使用qw(),尤其是因为它可以让您轻松对齐多维数组的元素
    5. 这样的项目的第一个目标应该是创建一个以可读格式输出多维数组的方法,这样您就可以观察并验证您正在进行的更改。
    6. 所有这些都会带来以下变化:

      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";
      }
      

      输出:

       -  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  .  -
      

      请注意,B只有一个城市,它靠近。因此,如果目标是解决TSP,那么就没有一个简单的解决方案。但是,鉴于只有8个城市和(n-1)!循环排列。这给我们只有5,040个排列,因此使用暴力可以完全找到最低成本的解决方案。

      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";
      }
      

      最终,这种设置只有2个成本最低的解决方案,并且它们彼此镜像,这是有道理的,因为我们没有在循环排列中按方向过滤。我故意不说明他们在这里。