Question

我试图在Perl中实现Depth First Algoritmn来解决这种迷宫：

我成功地将迷宫解析为一个名为%friends的哈希，它给出了每个节点的邻居。实现算法本身相当简单。但是，我无法返回仅正确路径的节点。我当前的代码看起来像这样（我包括从我的解析代码返回的哈希）：

#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

您有一个@curr_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 %seen = map { $_ => 1 } @_;
        my $here = $_[-1];
        if ($here == $exit) {
           say "@_";
           return;
        }

        __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 %seen = map { $_ => 1 } @$path;
        my $here = $path->[-1];
        return @$path if $here == $exit;

        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 %seen = map { $_ => 1 } @$path;
        my $here = $path->[-1];

        return @$path if $here == $exit;

        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})
            or next;  # We've been here before.

        push @todo,
            map { [ @$path, $_ ] } 
                @$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 2

你的主要问题是，当你遇到一个死胡同然后回溯时，你的％see和@path变量保持不变，仍然填充了死端空格。

（另外，如果你在程序中加上“use strict;”和“use warnings;”，你会发现一些你没有意识到的错误。）

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

事实上，既然你可以很容易地从@path数组构造一个％see set，那么在每次调用deep_search（）时都没有意义。因为depth_search（）采用@path变量，所以从技术上来说甚至不需要$ place变量，因为你可以从@path数组的最后一个元素中找到它。

以下是我推荐的代码：

#!/usr/bin/perl
# From:  https://stackoverflow.com/questions/45921739/returning-path-of-maze-in-perl-with-depth-first-algorithm

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

Answer 3

请注意，Graph提供了由Graph::Traversal和Graph::Traversal::BFS支持的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;

输出：

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

3 个答案: