Re^5: traversing a hash looking for path?

in reply to Re^4: traversing a hash looking for path?
in thread traversing a hash looking for path?

roboticus,
The problem with a recursive BFS is that you have to pass forward your nodes. You want to first check all your nodes of a distance of 1, then 2, etc until you find your destination.

It turns out that the only real difference between this and my iterative solution is that you have 2 stacks. The first is the current work load (nodes at current distance) and the second is you future work load (nodes at the next distance) which you pass forward.

While the find_path() sub that follows is quite elegant, the remainder of the code isn't.

use constant SRC  => 0;
use constant TGT  => 1;
use constant NET  => 2;
use constant SEEN => 3;
use constant STOP => 4;
use constant WORK => 5;
use constant PATH => 6;

sub find_path {
    &init if ! defined $_[STOP];
    return $_[PATH] if $_[PATH];
    &next_hop;
    return $_[PATH] if $_[PATH];
    goto &find_path if @{$_[WORK]};
    return 'path not found';
}

sub next_hop {
    my ($tgt, $stop, $net, @work) = (@_[TGT, STOP, NET], @{$_[WORK]});
    $_[WORK] = [];
    for (@work) {
        my ($node, $path) = @{$_}{qw/key path/};
        next if $_[SEEN]->{$node}++;
        $_[PATH] = $path, return if $node eq $tgt;
        $_[PATH] = "$path=>$tgt", return if $stop->{$node};
        push @{$_[WORK]}, map {key => $_, path => "$path=>$_"}, @{$net
+->{$node}};
    }
}

sub init {
    my ($src, $tgt, $net) = @_[SRC, TGT, NET];
    %{$_[STOP]} = map {$_ => 1} @{$net->{$tgt}};
    for (@{$net->{$src}}) {
        $_[PATH] = "$src=>$_", return if $_ eq $tgt;
        push @{$_[WORK]}, {key => $_, path => "$src=>$_"};
    }
}
[download]

This isn't the result of recursive BFS being all that ugly or intention obfu. I was just experimenting. It can be brought back into a single sub that looks quite reasonable (which is what I started with). Since working backwards to clean code is easier, I thought you might enjoy seeing the things I played with.

Update: Since others besides roboticus might be interested, I am providing the relatively clean version as well.

sub find_path {
    my ($beg, $end, $net, $seen, $stop, $work) = @_;
    if (! defined $stop) {
        %$stop = map {$_ => 1} @{$net->{$end}};
        for (@{$net->{$beg}}) {
            return "$beg=>$_" if $_ eq $end; 
            push @$work, {key => $_, path => "$beg=>$_"};
        }
    }
    my $next = [];
    for (@$work) {
        my ($node, $path) = @{$_}{qw/key path/};
        next if $seen->{$node}++;
        return $path if $node eq $end;
        return "$path=>$end" if $stop->{$node};
        push @$next, map {key => $_, path => "$path=>$_"}, @{$net->{$n
+ode}};
    }
    return find_path($beg, $end, $net, $seen, $stop, $next) if @$next;
    return 'path not found';
}
[download]

Cheers - L~R

In Section Seekers of Perl Wisdom