Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?

Re: trees and depth-first search

by LanceDeeply (Chaplain)
on Oct 27, 2004 at 14:52 UTC ( #403032=note: print w/replies, xml ) Need Help??

in reply to trees and depth-first search

are you confined to representing your tree that way? i've done some basic relationship traversals using a hash of node objects, each referring to it's parent. you can then just lookup the node you want and do a recursive call up the parent chain like so:
package Node; use strict; use warnings; sub new { my $self = bless( {}, shift ); my $name = shift; $self->name($name); return $self; } sub name { my $self = shift; @_ ? $self->{name} = shift : $self->{name}; } sub parent { my $self = shift; @_ ? $self->{parent} = shift : $self->{parent}; } sub ancestory { my $self = shift; my $decendants = shift || (); my $name = $self->name(); unshift @{$decendants}, $self->name(); my $parent = $self->parent(); $parent ? $parent->ancestory($decendants) : $decendants; } my %Nodes; sub GetNode { my $nodeName = shift; if ( ! $Nodes{$nodeName} ) { $Nodes{$nodeName} = new Node($nodeName); } return $Nodes{$nodeName}; } # # load relationships # while (<DATA>) { chomp; my ($parentName,$childName) = split ",",$_ ; my $parentNode = GetNode($parentName); my $childNode = GetNode($childName); $childNode->parent($parentNode) } # # print path to the node you are looking for # print join " ", @{GetNode("managedApplication")->ancestory()}; print "\n"; print join " ", @{GetNode("personnel")->ancestory()}; print "\n"; __DATA__ top,inetUser top,person top,application person,organizationalPerson application,managedApplication organizationalPerson,managedPerson managedPerson,personnel
top application managedApplication top person organizationalPerson managedPerson personnel

Log In?

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

How do I use this? | Other CB clients
Other Users?
Others rifling through the Monastery: (3)
As of 2021-05-17 23:00 GMT
Find Nodes?
    Voting Booth?
    Perl 7 will be out ...

    Results (170 votes). Check out past polls.