我的dijkstra算法在perl中具有相等权重的非定向图有什么问题.它不会停止迭代

Mic*_*l.Z 1 arrays perl hash graph dijkstra

我有蛋白质节点的加权图.我正在编写一个Perl程序,使用Dijkstra算法找到给定节点的最短路径.每种蛋白质(顶点)具有相同的重量.我的程序不会停止迭代,也不会给我任何输出.我不知道造成这个问题的原因.

我的想法是从用户那里获取蛋白质节点的名称,并通过使用给定的蛋白质作为根节点开始搜索最短路径.

%graph = (
  'A' => {'B' => 1, 'C' => 5},
  'B' => {'C' => 4, 'D' => 2},
  'C' => {'A' => 1, 'B' => 3},
  'D' => {'C' => 2, 'B' => 3}
);

sub dijkstra {
    print "Enter a node\n";
    my $root= <>;
    my $infinity = "inf";
    my %graph= %graph;
    my %dist;
    my %prev;
    ############################ the algorithm ####
    # first, set all distances to infinity
    foreach $n (keys %graph) { $dist{$n} = $infinity; $prev{$n}=$n; }
    # .. except the source
    $dist{$root} = 0;
    # loop while we have unsolved nodes
    # sort unsolved by distance from root
    foreach my $n1 (sort keys %graph) {
        foreach my $n2 (keys %{$graph{$n1}}) {
            if (($dist{$n2} eq $infinity) ||
                ($dist{$n2} > ($dist{$n1} + $graph{$n1}{$n2}) )) {
                $dist{$n2} = $dist{$n} + $graph{$n1}{$n2};
                $prev{$n2} = $n1;
            }
        }
    }
    ##### print the solutions ######
    my $path;
    foreach $n(keys %graph) {
        my $t = $n;
        $path = $t;
        while ($t ne $root) { $t = $prev{$t}; $path = "$t -> " . $path; }
        print "$n\t$dist{$n}\t$path\n";
    }
}
dijkstra();
Run Code Online (Sandbox Code Playgroud)

out*_*tis 7

当您使用读取输入时<>,它包括尾随换行符.结果,它不等于任何键%graph(可能没有换行符).快速修复是chomp根目录.

...
my $root = <>;
chomp $root;
Run Code Online (Sandbox Code Playgroud)

完整的解决方法是检查这$root是一个有效的顶点,如果没有则输出错误.请注意,您不应在同一函数中处理用户输入和应用程序逻辑.分开关注以减少耦合.

另外,全局变量很糟糕.包变量并不是那么糟糕,如果你正在做的事情,但%group应该传递给dijkstra(作为参考),因此实现不是与图形紧密相关.将图形作为参数传递可以收紧代码.

请注意,您无需定义自己的无穷大.Perl有inf(和-inf).

sub dijkstra {
    my ($graph, $root) = @_;
    my (%dist, %prev);

    ############################ the algorithm ####
    # first, set all distances to infinity
    foreach $n (keys %{$graph}) { $dist{$n} = inf; $prev{$n}=$n; }
    # .. except the source
    $dist{$root} = 0;

    # loop while we have unsolved nodes
    # sort unsolved by distance from root
    foreach my $n1 (sort keys %{$graph}) {
        foreach my $n2 (keys %{$graph->{$n1}}) {
            if (($dist{$n2} eq inf) ||
                ($dist{$n2} > ($dist{$n1} + $graph->{$n1}{$n2}) )) {
                $dist{$n2} = $dist{$n} + $graph->{$n1}{$n2};
                $prev{$n2} = $n1;
            }
        }
    }
    return (\%prev, \%dist);
}

sub getNode {
    my $graph = shift;
    print "Enter a node\n";
    my $root= <>;
    chomp $root;
    if (! exists $graph->{$root}) {
        die("'$root' isn't a valid node.\n");
    }
    return $root;
}

sub printPaths {
    my ($graph, $prev, $dist) = @_;
    my $path;

    foreach $n (keys %{$graph}) {
        my $t = $n;
        $path = $t;
        while ($t ne $root) {
            $t = $prev->{$t}; $path = "$t -> " . $path;
        }
        print "$n\t$dist->{$n}\t$path\n";
    }
}

$graph = {
  'A' => {'B' => 1, 'C' => 5},
  'B' => {'C' => 4, 'D' => 2},
  'C' => {'A' => 1, 'B' => 3},
  'D' => {'C' => 2, 'B' => 3}
};
$root = getNode($graph);
#($prev, $dist) = dijkstra(\%graph, $root);
#printPaths($graph, $prev, $dist);
# or, for obfuscation:
printPaths($graph, dijkstra($graph, $root));
Run Code Online (Sandbox Code Playgroud)

要调试这样的东西,你可以使用scaffolding(在代码中的各个点打印调试消息; Data :: Dumper对此很有用).更好的是,学会使用交互式调试器.