http://qs321.pair.com?node_id=542697


in reply to traversing a hash looking for path?

Anonymous Monk,
I saw this node just as I was leaving so I thought about it on the way home. This is actually a pretty easy problem if you turn it into a tree and I am not sure it requires Graph
#!/usr/bin/perl use strict; use warnings; my %net = ( '1.2.3.4' => ['1.2.3.5', '1.2.3.7'], '1.2.3.5' => ['1.2.3.4', '1.2.3.6', '1.2.3.7'], '1.2.3.6' => ['1.2.3.5', '1.2.3.7'], '1.2.3.7' => ['1.2.3.6', '1.2.3.4', '1.2.3.5'], ); print find_path('1.2.3.4', '1.2.3.6', %net); sub find_path { my ($beg, $end, %net) = @_; my (%seen, %stop, @work); for (@{$net{$end}}) { return "$beg=>$end" if $_ eq $beg; $stop{$_} = 1; } push @work, {key => $_, path => "$beg=>$_"} for @{$net{$beg}}; while (@work) { my $node = pop @work; next if $seen{$node->{key}}++; return "$node->{path}=>$end" if $stop{$node->{key}}; push @work, {key => $_, path => "$node->{path}=>$_"} for @{$ne +t{$node->{key}}}; } return 'path not found'; }

First thing you do is create a %stop hash that tells you when you have built enough of the tree. It will contain all of the nodes connected to $end. If one of those nodes happens to be your $beg value you return immediately.

Next you create a work queue/stack of all the nodes connected to $beg. You build the path as you go so once you have found the node you are looking for you don't have to walk the tree again.

Finally you take an item from the work queue and check to see if you have seen it before. If not you check to see if we are 1-hop away from $beg (%stop hash). If not, we go through all the nodes connected to this node and add it to our work queue. If we get to the end we know that there is no connection.

Cheers - L~R

Replies are listed 'Best First'.
Re^2: traversing a hash looking for path?
by roboticus (Chancellor) on Apr 11, 2006 at 23:55 UTC
    L~R:

    Since you asked in the ChatterBox for a recursive version, I thought I'd take up the challenge. Here's my take on a recursive solution:

    #!/usr/bin/perl use strict; use warnings; my %net = ( '1.2.3.3' => ['1.2.3.4'], '1.2.3.4' => ['1.2.3.3', '1.2.3.5', '1.2.3.7'], '1.2.3.5' => ['1.2.3.4', '1.2.3.6', '1.2.3.7'], '1.2.3.6' => ['1.2.3.5', '1.2.3.7'], '1.2.3.7' => ['1.2.3.6', '1.2.3.4', '1.2.3.5'], ); my %visited=(); my @stack=(); print find_path('1.2.3.4', '1.2.3.6') || "no solution!"; sub find_path { my ($beg, $end) = @_; return $end if $beg eq $end; $visited{$beg}=1; for my $try (@{$net{$beg}}) { if (!defined($visited{$try})) { push @stack, $beg; my $t = find_path($try, $end); return $beg.'=>'.$t if $t; pop @stack; } } undef; }
    --roboticus
      roboticus,
      Thank you. I have a real hard time thinking recursively for some reason. There are some things that I would want to change. For instance, letting the call stack be handled automatically by the recursion and not relying on lexicals visible at the package level. Here is my take on satisfying those two changes:
      my %net = (...); # shortened for brevity sake print find_path('1.2.3.4', '1.2.3.6', \%net); sub find_path { my ($beg, $end, $net, $seen, $stop, $node, $path) = @_; if (! defined $stop) { ($node, $path) = ($beg, $beg); $stop->{$_} = 1 for @{$net->{$end}}; } return $path if $node eq $end; return "$path=>$end" if $stop->{$node}; return undef if $seen->{$node}++; for (@{$net->{$node}}) { my $found = find_path($beg, $end, $net, $seen, $stop, $_, "$pa +th=>$_"); return $found if $found; } return 'path not found'; }
      I liked the iterative solution better because I could alter the search process by adjusting the shift/unshift and push/pop. I thought recursive solutions were supposed to be more elegant. Perhaps it is just because I don't know what I am doing.

      Cheers - L~R

        L~R:

        For some problems, recursion can be more elegant. For some other problems, it's just another way to do the job. For the remaining few problems, it's just a harder way to do things.

        In fact, for this problem, it may be that recursion could be more elegant. My implementation, however, makes no such claim! Especially as you've made a few improvements! 8^)

        (In Perl, I'm not very skilled (yet), so you'd be agog at how much time I spent debugging it before posting. I was happy enough to get it done! Once there, I was afraid to touch it in persuit of elegance. We need to get a good golfer in here for that...)

        Regarding the altering of the search process: I'd imagine that you may be able to get there with a recursive solution, as well--not that one comes to mind for this task!

        I've been meaning to beat Lisp into my brain, but after learning a few programming languages, I've adopted the policy: No learning a new language until I get paid for it! It's too bad I can't convince my boss to let me write anything in Lisp..... So, I'm trying to learn some Lisp-like Perl idioms, but I've got quite a way to go!

        --roboticus

      Both of these are great examples and have opened a few doors for me.
      Thanks for all the help :)