用深度优先算法在 Perl 中返回迷宫路径

Question

我正在尝试在 Perl 中实现深度优先算法来解决这种迷宫问题：

我成功地将迷宫解析为一个名为 %friends 的散列，它给出了每个节点的邻居。算法本身的实现相当简单。但是，我无法获得 return 只有正确路径的节点。我当前的代码如下所示（我包含了从我的解析代码中提取的散列 return）：

#bin/usr/perl

my %friends = (
    1 => [6, 2],
    2 => [1, 3],
    3 => [8, 2],
    4 => [5],
    5 => [10, 4],
    6 => [1, 11],
    7 => [8],
    8 => [3, 7],
    9 => [14, 10],
    10 => [5, 15, 9],
    11 => [6, 12],
    12 => [17, 11],
    13 => [14],
    14 => [9, 19, 13],
    15 => [10, 20],
    16 => [17],
    17 => [12, 16, 18],
    18 => [17, 19],
    19 => [14, 18],
    20 => [15],
);

sub depth_search {
    ($place, $seen, $path) = @_;
    $seen{$place} = "seen";

    if($place eq 5){
        print "@curr_path";
        return;
    }

    for my $friend (@{$friends{$place}}){
        if(!defined($seen{$friend})){
            push(@curr_path, $friend);
            depth_search($friend, %seen, @curr_path);
        }

    }

}

my %seen;
my @path;

depth_search(2, %seen, @path);

我从这段代码得到的输出是：

1 6 11 12 17 16 18 19 14 9 10 5

@curr_path 似乎包含了所有访问过的节点，这在这里转化为 16 节点的错误包含。这可能与 Perl 如何处理传递的数组有关，但我似乎找不到合适的解决方案。

Answer 1

注意 Graph provides Graph::Traversal which is backed by Graph::Traversal::BFS and Graph::Traversal::DFS.

#!/usr/bin/env perl

use strict;
use warnings;

use Graph::Directed;
use Graph::Traversal::BFS;

my $graph = Graph::Directed->new;

# Note: Maze definition corrected to match maze graphic
my %maze = (
    1 => [6, 2],
    2 => [1,3],
    3 => [8, 2],
    4 => [5],
    5 => [10, 4],
    6 => [1, 11],
    7 => [8],
    8 => [3, 7],
    9 => [14, 10],
    10 => [5, 15, 9],
    11 => [6, 12],
    12 => [17, 11],
    13 => [14],
    14 => [9, 19, 13],
    15 => [10, 20],
    16 => [17],
    17 => [12, 16, 18],
    18 => [17, 19],
    19 => [14,18],
    20 => [15],
);

for my $node (keys %maze) {
    $graph->add_edge($node, $_) for @{ $maze{$node} };
}

my $traversal = Graph::Traversal::DFS->new($graph,
    start => 2,
    next_numeric => 1,
    pre => sub {
        my ($v, $self) = @_;
        print "$v\n";
        $self->terminate if $v == 5;
    }
);

$traversal->dfs;

输出：

Answer 2

您有一个 @curr_path 变量。为此，您必须在回溯时从中删除条目。（下面重命名为 @path。）

#!/usr/bin/perl

use strict;
use warnings;
use feature qw( current_sub say );

sub find_all_solutions_dfs {
    my ($passages, $entrance, $exit) = @_;

    my @path = $entrance;
    my %seen = ( $entrance => 1 );

    my $helper = sub {
        my $here = $path[-1];
        if ($here == $exit) {
            say "@path";
            return;
        }

        for my $passage (grep { !$seen{$_} } @{ $passages->{$here} }) {
            push @path, $passage;
            ++$seen{$passage};
            __SUB__->();
            --$seen{$passage};
            pop @path;
        }
    };

    $helper->();
}

{
    my %passages = ( 1 => [6, 2], ..., 20 => [15] );
    my $entrance = 2;
    my $exit = 5;
    find_all_solutions_dfs(\%passages, $entrance, $exit);
}

我们可以复制变量并更改它们，而不是来回更改 %seen 和 @path。然后，返回会自动回溯。（作为优化，@_ 将是 @path。）

#!/usr/bin/perl

use strict;
use warnings;
use feature qw( current_sub say );

sub find_solution_dfs {
    my ($passages, $entrance, $exit) = @_;

    my $helper = sub {
        my $here = $_[-1];
        if ($here == $exit) {
           say "@_";
           return;
        }

        my %seen = map { $_ => 1 } @_;
        __SUB__->(@_, $_)
           for
              grep { !$seen{$_} }
                 @{ $passages->{$here} };
    };

    $helper->($entrance);
}

{
    my %passages = ( 1 => [6, 2], ..., 20 => [15] );
    my $entrance = 2;
    my $exit = 5;
    find_solution_dfs(\%passages, $entrance, $exit);
}

让我们切换到使用堆栈变量而不是递归。快了一点，但主要是对下一步有帮助。我们也让它在第一个解决方案处停止。

#!/usr/bin/perl

use strict;
use warnings;
use feature qw( say );

sub find_solution_dfs {
    my ($passages, $entrance, $exit) = @_;

    my @todo = ( [ $entrance ] );
    while (@todo) {
        my $path = shift(@todo);
        my $here = $path->[-1];
        return @$path if $here == $exit;

        my %seen = map { $_ => 1 } @$path;
        unshift @todo,
            map { [ @$path, $_ ] } 
                grep { !$seen{$_} }
                    @{ $passages->{$here} };
    }

    return;
}

{
    my %passages = ( 1 => [6, 2], ..., 20 => [15] );
    my $entrance = 2;
    my $exit = 5;
    if ( my @solution = find_solution_dfs(\%passages, $entrance, $exit)) {
        say "@solution";
    } else {
        say "No solution.";
    }
}

虽然深度优先搜索会找到解决方案，但不一定是最短的。使用广度优先搜索将找到最短的。这不仅更好，在某些情况下还会大大加快速度。

获得这些好处实际上是从以前的版本（unshift ⇒ push）到 @todo 从堆栈到队列的更改

#!/usr/bin/perl

use strict;
use warnings;
use feature qw( say );

sub find_solution_bfs {
    my ($passages, $entrance, $exit) = @_;

    my @todo = ( [ $entrance ] );
    while (@todo) {
        my $path = shift(@todo);
        my $here = $path->[-1];
        return @$path if $here == $exit;

        my %seen = map { $_ => 1 } @$path;
        push @todo,
            map { [ @$path, $_ ] } 
                grep { !$seen{$_} }
                    @{ $passages->{$here} };
    }

    return;
}

{
    my %passages = ( 1 => [6, 2], ..., 20 => [15] );
    my $entrance = 2;
    my $exit = 5;
    if ( my @solution = find_solution_bfs(\%passages, $entrance, $exit)) {
        say "@solution";
    } else {
        say "No solution.";
    }
}

最后，由于我们使用的是 BFS，并且我们只找到第一个解决方案，因此我们可以通过使用单个 %seen 来优化上述内容。事实上，我们甚至不需要 %seen 因为我们可以从 %$passages 中移除！

#!/usr/bin/perl

use strict;
use warnings;
use feature qw( say );

sub find_solution_bfs {
    my ($passages, $entrance, $exit) = @_;
    $passages = { %$passages };  # Make a copy so we don't clobber caller's.

    my @todo = ( [ $entrance ] );
    while (@todo) {
        my $path = shift(@todo);
        my $here = $path->[-1];
        return @$path if $here == $exit;

        my $passages_from_here = delete($passages->{$here});
        push @todo,
            map { [ @$path, $_ ] } 
               grep { $passages->{$_} }  # Keep only the unvisited.
                    @$passages_from_here;
    }

    return;
}


{
    my %passages = ( 1 => [6, 2], ..., 20 => [15] );
    my $entrance = 2;
    my $exit = 5;
    if ( my @solution = find_solution_bfs(\%passages, $entrance, $exit)) {
        say "@solution";
    } else {
        say "No solution.";
    }
}

Answer 3

你的主要问题是，当你遇到死胡同然后回溯时，你的 %seen 和 @path 变量保持不变，仍然填充死胡同空间。

（此外，如果您将 "use strict;" 和 "use warnings;" 放入您的程序中，您将发现一些您没有意识到正在发生的错误。）

主要修复是创建一个新的路径列表（与旧的@path 相同，但带有新节点）并使用它传递给递归调用。这样，当您的算法回溯时，它不会采用旧的死胡同路径。

事实上，由于您可以很容易地从@path 数组构造一个 %seen 集，因此在每次调用 depth_search() 时都将其传入是没有意义的。由于 depth_search() 采用 @path 变量，从技术上讲，您甚至不需要 $place 变量，因为您可以从 @path 数组的最后一个元素中找到它。

这是我推荐的代码：

#!/usr/bin/perl
# From:  

use strict;
use warnings;

my %friends = (
    1 => [6, 2],
    2 => [1, 3],
    3 => [8, 2],
    4 => [5],
    5 => [10, 4],
    6 => [1, 11],
    7 => [8],
    8 => [3, 7],
    9 => [14, 10],
    10 => [5, 15, 9],
    11 => [6, 12],
    12 => [17, 11],
    13 => [14],
    14 => [9, 19, 13],
    15 => [10, 20],
    16 => [17],
    17 => [12, 16, 18],
    18 => [17, 19],
    19 => [14, 18],
    20 => [15],
);


sub depth_search
{
    my @path = @_;

    if ($path[-1] == 5)  # end at node 5
    {
        print "@path\n";
        return;
    }

    # Put all the places we've been to in a "seen" set,
    # to make sure not to revisit the ones we've already seen:
    my %seen;  @seen{@path} = ();

    foreach my $friend (@{$friends{$path[-1]}})
    {
        # Don't process nodes we've already seen:
        next  if exists $seen{$friend};

        # Recurse using the passed-in @path with 
        # the $friend as an additional node:
        depth_search(@path, $friend);
    }
}


depth_search(2);  # start at node 2

__END__

它的输出是：

2 1 6 11 12 17 18 19 14 9 10 5

用深度优先算法在 Perl 中返回迷宫路径

Returning path of maze in Perl with Depth First Algorithm

algorithm

perl

depth-first-search