You have a single @curr_path
variable. For that to work, you would have to remove entries from it when you backtrack. (Renamed to @path
below.)
#!/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);
}
Instead of changing %seen
and @path
back and forth, we can make copies of the variables and change those. Then, returning will automatically backtrack. (As an optimization, @_
will be @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);
}
Let's switch to using a stack variable instead of recursion. It's a little faster, but the main reason is that it will help the next step. Let's also make it so it stops at the first solution.
#!/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.";
}
}
While a depth-first search will find a solution, it won't necessarily be the shortest. Using a breadth-first search will find the shortest. Not only is that nicer, it will greatly speed things up in some circumstances.
Gaining these benefits is literally a one-word change from the previous version (unshift
⇒ push
) to changes @todo
from a stack to a queue.
#!/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.";
}
}
Finally, since we're using a BFS and since we're only finding the first solution, we can optimize the above by using a single %seen
. In fact, we don't even need %seen
then since we can just remove from %$passages
instead!
#!/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.";
}
}
strict
andwarnings
?20 => [1,5],
?!13 => [1,4]
?!use strict; use warnings;
at the top of your program.