2015-03-30 213 views
0

我正在嘗試生成將從不同節點之間的連接列表(兩個節點之間可能有多個直接連接)構建路徑的腳本。此外,我不想找到最短的路徑,但他們都是。雖然每個連接只能在計算中使用一次。 如果您想象計算機網絡中的節點(例如a1:1 = router a1, interface 1等),這將更容易解釋。
例如,讓說,我們有以下2條路徑(第二與每個節點2間之間的連接):從節點對生成節點路徑

a1:1 to b1:1| b1:2 to b2:1| b2:4 to a6:1 
a1:5 to b5:1| b5:6 to a2:1 
a1:7 to b5:2| b5:7 to a2:2 

a節點永遠是結束點,但可以有在中間的任何數B節點的。

,所以我希望得到看起來像輸出:

a1-b1-b2-a6 
a1-b5-a2 (in this case there are 2 connections between each of the nodes) 

以下是我想出了這麼遠,但它不工作真不錯:

#!/usr/local/bin/perl 
use strict; 
use warnings; 
my %paths; 
my %connections =(
'a1:1' => 'b1:1', 
'b1:2' => 'b2:1', 
'b2:4' => 'a6:1', 
'a1:5' => 'b5:1', 
'a1:7' => 'b5:2', 
'b5:6' => 'a2:1', 
'b5:7' => 'a2:2' 
); 

my %nodes; 
for my $key (sort keys %connections){ 
    my $n1=(split(/:/,$key))[0]; 
    my $c1=(split(/:/,$key))[1];  
    my $n2=(split(/:/,$nodes{$key}))[0]; 
    my $c2=(split(/:/,$nodes{$key}))[1]; 
    $nodes{$n1}{$n2}{n_of_connections}[0]+=1; 
    $nodes{$n2}{$n1}{n_of_connections}[0]+=1; 
} 
my $n=0; 
foreach my $node (sort keys %nodes){ 
    $n++; 
    foreach my $rnode (keys %{$nodes{$node}}) { # $rnode = "remote node" 
     unless ($nodes{$node}{$rnode}{used}==1){ 
     $paths{$n}[0]=$node."-".$rnode; 

    $nodes{$node}{$rnode}{used}[0]=1; #mark that it was used 
    $nodes{$rnode}{$node}{used}[0]=1; #mark that it was used 
    my $thisnode=$rnode; 
    my $nextnode=""; 
    until ($nextnode =~ /a/){ 
     foreach my $x (keys %{$nodes{$thisnode}}) { 
      unless ($nodes{$thisnode}{$x}{used}==1){ 
       $nextnode=$x; 
       $paths{$n}[0].="-".$x; 
       $nodes{$thisnode}{$x}{used}[0]=1; 
       $nodes{$x}{$thisnode}{used}[0]=1; 
       $thisnode=$nextnode; 
      } 
     } 

    } 
} 
} 

回答

0

以下應從a1生成所有可能的路徑。它使用遞歸子程序path,它只是走過所有可能的連接。

我還使用了圖表的不同表示,即%graph散列。在致電path之前,我從您的%connections創建了它。

#!/usr/bin/perl 
use warnings; 
use strict; 

sub path { 
    my ($start, $graph, $path) = @_; 
    my @next = keys %{ $graph->{$start} }; 
    my $found; 
    for my $n (@next) { 
     for my $from_i (keys %{ $graph->{$start}{$n} }) { 
      for my $to_i (keys %{ $graph->{$start}{$n}{$from_i} }) { 
       delete $graph->{$start}{$n}{$from_i}{$to_i}; 
       path($n, $graph, [ @$path, "$start:$from_i $n:$to_i" ]); 
       $found = 1; 
       undef $graph->{$start}{$n}{$from_i}{$to_i}; 
      } 
     } 
    } 
    print "@$path\n" unless $found; 
} 


my %connections = (
        'a1:1' => 'b1:1', 
        'b1:2' => 'b2:1', 
        'b2:4' => 'a6:1', 
        'a1:5' => 'b5:1', 
        'a1:7' => 'b5:2', 
        'b5:6' => 'a2:1', 
        'b5:7' => 'a2:2', 
       ); 

my %graph; 
while (my ($from, $to) = each %connections) { 
    my ($from_r, $from_i) = split /:/, $from; 
    my ($to_r, $to_i)  = split /:/, $to; 
    undef $graph{$from_r}{$to_r}{$from_i}{$to_i}; 
} 
path('a1', \%graph, []); 
+0

謝謝!太棒了! – 2015-03-31 01:42:30