Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

Re^5: traversing a hash looking for path?

by Limbic~Region (Chancellor)
on Apr 13, 2006 at 23:50 UTC ( #543256=note: print w/replies, xml ) Need Help??


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=>$_"}; } }

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'; }

Cheers - L~R

Replies are listed 'Best First'.
Re^6: traversing a hash looking for path?
by bmann (Priest) on Apr 20, 2006 at 21:43 UTC
    Hi limbic~region,

    I would have done it something like this:

    my %net = ( ... ); my $start = '1.2.3.4'; my $end = '1.2.3.6'; print find_pathr( \%net, $end, $start ) . "\n"; sub find_pathr { my ( $net, $end, @list ) = @_; my $curr; do { $curr = shift @list; } until ( ! @list or exists $$net{ $curr } ); return "No path!" unless exists $$net{$curr}; return $end if $curr eq $end; unshift @list, @{ delete $$net{ $curr } }; return "$curr->" . find_pathr( $net, $end, @list ); }

    Now this quick implementation isn't perfect. It doesn't pretend to find the most efficient path, it finds the first path based on the order of the elements of %net. It is destructive to %net. I don't like the do ... until loop.

    But I do think it is an elegant solution, IMNSHO ;)

    Update: This is a depth-first search, not breadth-first as is limbic~region's.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://543256]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others browsing the Monastery: (1)
As of 2021-11-30 01:18 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?