用深度优先算法返回Perl中的迷宫路径
Jen*_*the 3 algorithm perl depth-first-search
我正在尝试在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处理传递数组的方式有关,但我似乎找不到合适的解决方案.
ike*_*ami 10
你有一个@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);
}
我们可以复制变量并改变变量,而不是改变@path和%seen来回变换.然后,返回将自动回溯.(作为优化,@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.";
}
}
虽然深度优先搜索将找到解决方案,但它不一定是最短的.使用广度优先搜索将找到最短的搜索.这不仅更好,而且在某些情况下会大大加快速度.
获得这些好处实际上是从先前版本(@path⇒ unshift)到push从堆栈更改为队列的单词更改.
#!/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,因为我们只找到第一个解决方案,我们可以通过使用单个来优化上述解决方案@todo.事实上,我们甚至不需要,%seen因为我们可以从中删除%seen!
#!/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.";
}
}
请注意，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;
输出：
#!/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;
您的主要问题是，当您遇到死胡同然后回溯时，您的 %seen 和 @path 变量保持不变，仍然充满死胡同。
（另外，如果你在你的程序中加上“use strict;”和“use warnings;”，你会发现一些你没有意识到发生的错误。）
主要的修复方法是创建一个新的路径列表（与旧的 @path 相同，但使用新节点）并使用它传递到递归调用中。这样，当您的算法回溯时，它不会采用旧的、死胡同的路径。
事实上，由于您可以轻松地从@path 数组构造一个 %seen 集，因此在每次调用 depth_search() 时都将其传入是没有意义的。由于 depth_search() 接受一个 @path 变量，从技术上讲，您甚至不需要 $place 变量，因为您可以从 @path 数组的最后一个元素中找到它。
这是我推荐的代码：
#!/usr/bin/perl
# From: /sf/ask/3214521761/
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