2015-03-30 159 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