如何使用 perl 处理与图论相关的问题答案

【问题标题】：how to deal with graph theory related problems using perl如何使用 perl 处理与图论相关的问题
【发布时间】：2014-11-05 09:40:40
【问题描述】：

我想学习如何在不使用任何额外模块的情况下在 perl 中解决简单的图论问题。
我可以解释一个简单的问题。

输入格式：
第 1 行 - 图-N 的顶点数。
接下来的 N 行 - 直接连接到索引为 i 的顶点的顶点索引。索引从 1 开始。
起点索引（空间）终点索引，尽可能找到最长的路线。

例子

解决办法：

2 to 4 can be reached in following ways  
- 2-1-4  
- 2-1-3-4  
so longest path is 2-1-3-4

我想学习使用 perl 解决此类问题的基础知识。任何帮助将不胜感激。给我一个提示，我会尝试编码。

【问题讨论】：

可以在路径中重复顶点（但不能重复边）？
边缘不应重复。无论如何，我的目的是不解决这个问题，我想要一种使用 perl 解决此类问题的方法。
你的意思是1-2-3-1-2-4 不允许用于图形1-2, 2-3, 3-1, 2-4，因为1-2 重复了？
查看输入，4表示4个顶点，下一个输入2 3 4表示我们有边1-2 1-3 1-4，下一个输入1表示我们有边2-1，下一个输入1 4 表示我们有边 3-1 3-4，类似地 1 3 表示我们有 4-1 和 4-3。最后输入 2 4 表示，找到从 2 到 4 的最长路径。很明显，我们没有任何边 2-3。
我刚刚列出了边缘（不同的图表），因为无法在 cmets 中显示线条。但如果你坚持：4 / 2 3 / 1 3 4 / 1 2 / 2 / 1 4.

标签： perl graph graph-theory

【解决方案1】：

我会使用散列的散列来表示一个图。如果边 v1-v2 在图中，则 $graph{$v1}{$v2} 存在。您可以通过这种方式表示有向图（因为 $graph{$v2}{$v1} 不必存在）。此外，如果您想要加权边缘，您可以将权重存储为值。

为了解决您的示例问题，我会使用以下内容：

#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };

# Check that vertex can be added to the path.
sub already {
    my ($vertex, @vertices) = @_;
    for my $i (1 .. $#vertices) {
        # last-v or v-last might already be present.
        return 1 if ($vertices[ $i - 1 ] == $vertices[-1] and $vertices[$i] == $vertex)
                 or ($vertices[ $i - 1 ] == $vertex and $vertices[$i] == $vertices[-1])
    }
    return
}

sub path {
    my ($graph, $start, $end, %known) = @_;

    my $count = keys %known;
    for my $path (keys %known) {
        my @vertices = split '-', $path;
        next if $vertices[-1] == $end;

        for my $target (keys %{ $graph->{ $vertices[-1] } }) {
            undef $known{"$path-$target"} unless already($target, @vertices);
        }
    }

    if (keys %known > $count) {
        return path($graph, $start, $end, %known)

    } else {
        return keys %known
    }
}


my %graph;

my $size = <>;
for my $node (1 .. $size) {
    my @targets = split ' ', <>;
    undef $graph{$node}{$_} for @targets;
}
my ($start, $end) = split ' ', <>;

say "$start to $end can be reached in the following ways";
my @paths = grep /-$end$/,
            path(\%graph, $start, $end, map {; "$start-$_" => undef }
                                            keys %{ $graph{$start} });

say for @paths;

my $max = 0;
for my $i (1 .. $#paths) {
    $max = $i if ($paths[$i] =~ tr/-//) > ($paths[$max] =~ tr/-//);
}

say "so longest path is $paths[$max]";

【讨论】：