Using a sorted array, we can retrieve elements quite fast, by means of a binary search. However, inserting a new element in a large sorted array is an expensive operation.+-------+--------+----------+ | order | insert | retrieve | +------------+-------+--------+----------+ |array | yes | slow | fast | |hash | no | fast | fast | |linked list | yes | fast | slow | |binary tree | yes | fast | fast | |DAG tree | yes | fast | slow | +------------+-------+--------+----------+
pre-order (action: print the node name) company, sales, net, store, R&D, research, development, pers. Useful to print the company organigram, from top to bottom. Had we udes post-order, we would have printed it upside-down.company / | \ sales R&D pers / \ / \ net store | | research development
Here we create a node, the root of our tree. The costructor doesn't need any parameter. You can pass some options through a hash reference although it doesn't currently do anything. It is there for the descending classes benefit. After we create a node, we can assign a name. No need to do it, although for this example we are using names as the only visible attribute of each node.#!/usr/bin/perl -w use strict; use Tree::DAG_Node; my $pm = Tree::DAG_Node->new; $pm->name('PerlMonks');
Create a new node, with the same procedure, and then construct some sub nodes (daughters). The new_daughter method is a constructor that creates an object of the same class as the caller and adds it to the list of its subnodes. Since the result of new_daughter() is an object, we can apply the name() method to it. After the above statements, $tutorials is a new tree.my $tutorials = Tree::DAG_Node->new; $tutorials->name('tutorials'); $tutorials->new_daughter->name('basics'); $tutorials->new_daughter->name('syntax'); $tutorials->new_daughter->name('references'); $tutorials->new_daughter->name('data');
Now $tutorials becomes a daughter of $pm, retaining all its daughters, which become $pm's descendants.$pm->add_daughter($tutorials);
Here we create two more nodes, $reviews with two daughters, and $SOPW, childless. Using add_daughter() we can add them to the root at once. This method accepts either a single node or a list of nodes.my $reviews = Tree::DAG_Node->new; $reviews->name('reviews'); $reviews->new_daughter->name('books'); $reviews->new_daughter->name('modules'); my $SOPW = Tree::DAG_Node->new; $SOPW->name('SOPW'); $pm->add_daughter($reviews, $SOPW);
Prints a ascii art representation of the tree, using the names as identifiers. It might become quite large on complex trees.print map "$_\n", @{$pm->draw_ascii_tree};
One more daughter, using the new_daughter() constructor.$pm->new_daughter->name('Meditations');
This method prints a vertical representation of the tree, improving readability for trees with long lists of daughters. Check the resulting output. The whole representation of PerlMonks structure wouldn't fit in this page.print $pm->dump_names;
| <PerlMonks> /---------------------------+-----------\ | | | <tutorials> <reviews> <SOPW> /--------+----------+---------\ /--------\ | | | | | | <basics> <syntax> <references> <data> <books> <modules> 'PerlMonks' 'tutorials' 'basics' 'syntax' 'references' 'data' 'reviews' 'books' 'modules' 'SOPW' 'Meditations'
In this call, we define an anonymous sub to print each node, with special treatment for the root. The sub is called for each node, with the node as first parameter and an anonymous hash containing '_depth' and 'treename' as second parameter.$pm->walk_down({ callback => sub { my $node = shift; print " " x $_[0]->{_depth}; print "(*) " if $node->name eq $_[0]->{treename}; print $node->name, "\n" }, _depth => 0, treename => 'PerlMonks' });
Changing the name of the sub key to 'callbackback', the result is a post-order traversal. For a more useful example of post-order, see Inheriting the base class below.(*) PerlMonks tutorials basics syntax references data reviews books modules SOPW Meditations
One important caveat. The callback sub will be called as long as it returns a true value. A false value will stop the recursion. Useful when we are searching for something, and we want to avoid unnecessary walking down after the result has been achieved. Remember that a print statement returns always true. If you want to stop a printing walk down, you must return "0", an empty string or undef.basics syntax references data tutorials books modules reviews SOPW Meditations (*) PerlMonks
See Search for nodes below for an explanation of the address() method.sub traverse { my $node = shift; my $depth = scalar $node->ancestors || 0; # a pre-order traversal. First we do something ... print ".." x $depth, $node->name," ", $node->address, "\n"; # ... and then we recurse the subodes traverse($_) for $node->daughters; } PerlMonks 0 ..tutorials 0:0 ....basics 0:0:0 ....syntax 0:0:1 ....references 0:0:2 ....data 0:0:3 ..reviews 0:1 ....books 0:1:0 ....modules 0:1:1 ..SOPW 0:2 ..Meditations 0:3
Of course, the only way to access these attributes is through the attributes() method itself. If we want to use an Object Oriented interface, we need to inherit from Tree::DAG_Node, or to store an object into attributes().$pm->attributes (['The', ['best', 'Perl'],['site']]); $tutorials->attributes ({ useful => 'yes', available => ['day','night'] }); $SOPW->attributes (\&check_if_strict); $reviews->attributes(Tree::DAG_Node->new); $pm->walk_down({callback=>sub{ print $_[0]->name," ", ref $_[0]->attributes,"\n"; }});
Considering the above tree, starting with $root. Its daughters are accessed by calling $root->daughters. They are returned as a list of nodes.| <root> /---------------------------\ | | <a> <b> /---------------\ /---+---+---+---+---\ | | | | | | | | <1> <2> <p> <q> <r> <s> <t> <u> /-------\ /-------\ | | | | <w> <x> <y> <z> /---\ /---\ /---+---\ | | | | | | | <i> <j> <k> <l> <5> <6> <7>
Down among the daughters, we can identify them by their position relative to a given node. Every node can access its parent by calling $node->mother. The complete list of the node ancestors is at our disposal by using the appropriate method. If we access the node named "7", for example, its ancestors will be the nodes named 'z', '2','a','root'.my @daughters = $root->daughters; # <a> and <b> my @b_daughthers = $daughters[1]->daughters; # <b>'s daughters my $third = $b_daughthers[2]; # <r> my $ls = $third->left_sister; # <q> my $rs = $third->right_sister; # <s> my @left = $third->left_sisters; # <p> and <q> my @right = $third->right_sisters; # <s>, <t> <u> my $mama = $third->mother; # <b> my @ancestors = $third->ancestors; # <b> <root>
Check the reference documentation for more methods to move from node to node.my @descnames = map {$_->name} $node1->descendants; # @descnames = qw(w i j x k l);
This new() constructor simply passes the $options hash reference to the internal attributes(). Actually, nothing prevents us from using a different reference, say an object instead of a hash, but it will do for now. It's worth noting that the author of the base class marks this construction as a bad thing. While I agree in principle, my Impatience took me to embracing this shortcut.#!/usr/bin/perl -w use strict; package CompanyTree; use Tree::DAG_Node; our @ISA=qw(Tree::DAG_Node); sub new { my $class = shift; my $options = shift; my $self = bless $class->SUPER::new(); $self->attributes($options); return $self; }
The by_name() method walks down the tree starting at the calling node, and returns a list of all the nodes matching the given name. In scalar context, only the first matching node is returned. If the name was not found, returns undef.sub employees { my $node = shift; my $val = shift; $node->attributes->{employees} = $val if $val; return $node->attributes->{employees}; } sub budget { my $node = shift; my $val = shift; $node->attributes->{budget} = $val if $val; return $node->attributes->{budget}; } sub by_name { my ($self, $name) = @_; my @found =(); my $retvalue = wantarray ? 1 : 0; $self->walk_down({callback=>sub{ if ($_[0]->name eq $name) { push @found, $_[0]; return $retvalue; } 1}}); return wantarray? @found : @found ? $found[0] : undef; }
clear_totals() sets to 0 the values for employees and budget in each node that has subnodes, thus preparing the way for the next method. sum_up() gets the total values for employees and budget from each subnode, recursively, using a post-order traversal. The total value pops up to the root by virtue of this engine. Eventually, print_wealth() shows the amount of employees and budget for each node and for the whole company.sub clear_totals { $_[0]->walk_down({ callback => sub { my $node = shift; if ($node->daughters) { $node->budget(0); $node->employees(0); } }}) } sub sum_up { $_[0]->walk_down({ callbackback=> sub { my $node = shift; return 1 unless $node->mother; $node->mother->attributes->{employees} += $node->attributes->{employees}; $node->mother->attributes->{budget} += $node->attributes->{budget}; }}); } sub print_wealth { $_[0]->walk_down({callback=> sub { my $node = shift; printf "%s%.7s\templ: %2d budget: %8d\n", " " x $_[0]->{_depth}, $node->name, $node->employees, $node->budget }, _depth => 0 }); }
The new company is created using the derived class. Then, the new_daughter() constructor is used, with an anonymous hash as a parameter, that gets passed to the main constructor. Soon we have three departments, two of which have a few sub departments. We initialize to 0 the number of employees in the non-terminal nodes, to prepare for the summing up. The sum_up() method performs a post-order traversal, to collect the totals. Finally, a pre-order traversal with print_wealth() gives us a nice printout of the company strength.package main; my $company = CompanyTree->new({employees=>0, budget=>0}); $company->name('company'); $company->new_daughter( {employees=>0,budget=>0})->name('sales'); $company->by_name('sales')->new_daughter( {employees=>6,budget=>25_000})->name('net'); $company->by_name('sales')->new_daughter( {employees=>8,budget=>65_000})->name('str'); $company->new_daughter( {employees=>4,budget=>10_000})->name('pers'); $company->new_daughter({employees=>0,budget=>0})->name('R&D'); $company->by_name('R&D')->new_daughter( {employees=>10,budget=>100_000})->name('res'); $company->by_name('R&D')->new_daughter( {employees=>15,budget=>90_000})->name('dev'); $company->clear_totals; $company->sum_up; $company->print_wealth; print map "$_\n", @{$company->draw_ascii_tree};
company empl: 43 budget: 290000 sales empl: 14 budget: 90000 net empl: 6 budget: 25000 str empl: 8 budget: 65000 pers empl: 4 budget: 10000 R&D empl: 25 budget: 190000 res empl: 10 budget: 100000 dev empl: 15 budget: 90000
| <company> /--------+---------\ | | | <sales> <pers> <R&D> /-----\ /-----\ | | | | <net> <str> <res> <dev>
However, calling nodes by their address is not always convenient, since humans handle names more easily than numbers, and since the address can change if we insert nodes before the one we are looking for.my $node = $root->address('0:2:1');
In the previous section we have seen a sub to retrieve a node by name. It works fine as long as our name is unique. If not, we should build a more selective method that will find exactly what we need. Let's assume that all our nodes have attributes() set as a hash ref, and each one has a key holding a unique identifier. To search for this unique ID is not so hard.my $node = $root->address('0:2:1'); $node->mother->new_daughter_left; # now $node's address is '0:2:2'
sub by_attribute { my ($self, $key, $id) = @_; my $found = undef; $self->walk_down({callback=>sub{ if (ref $_[0]->attributes eq "HASH" && exists $_[0]->attributes->{$key} && $_[0]->attributes->{$key} eq $id) { $found = $_[0]; return 0; } 1}}); return $found; }
This instruction will return the node with attributes containing { ID => 'nutcracker'}, or undef if not found. For more complex conditions, when your nodes contain objects, remember to check the type of attributes (using ref), to avoid run-time exceptions.my $node = $root->by_attribute( 'ID', 'nutcracker');
#!/usr/bin/perl -w use strict; use Tree::DAG_Node; my $root = Tree::DAG_Node->new; $root->name('root'); $root->new_daughter->name($_) for ('1'..'3'); my @names = qw(abc def ghi); my $count =0; for my $n ($root->daughters) { for (split //, $names[$count++]) { $n->new_daughter->name($_) } } print map "$_\n", @{$root->draw_ascii_tree};
Our first task is to remove the node named '2' and assign its daughters to the root. We identify the node by its address, and then use the method replace_with_daughters(). The effect of this method is to unlink the node from its mother and to add all its daughter in its place, moving to the right all existing right nodes.| <root> /-----------+-----------\ | | | <1> <2> <3> /---+---\ /---+---\ /---+---\ | | | | | | | | | <a> <b> <c> <d> <e> <f> <g> <h> <i>
The result is that node '2' has disappeared, and in its place we have three new daughters for 'root'.my $node = $root->address('0:1'); $node->replace_with_daughters; print map "$_\n", @{$root->draw_ascii_tree};
The next task is to move the subtree starting at node '3' under node named 'e'.| <root> /-------+---+---+-------\ | | | | | <1> <d> <e> <f> <3> /---+---\ /---+---\ | | | | | | <a> <b> <c> <g> <h> <i>
Notice that the address of the node to move, that was '0:2' in the original tree, is now '0:4', due to the insertion of new nodes on its left. Calling add_daughter() with $node as an argument causes the link $node->mother to be cut, and a new one to be created in its stead. If we just want to get rid of that subtree, the method $node->unlink_from_mother will do. We should just take care of the memory still occupied by this subtree, and call $node->delete_tree.$node = $root->address('0:4'); my $dest = $root->address('0:2'); $dest->add_daughter($node); print map "$_\n", @{$root->draw_ascii_tree};
| <root> /-------+-------+-------\ | | | | <1> <d> <e> <f> /---+---\ | | | | <3> <a> <b> <c> /---+---\ | | | <g> <h> <i>
_ _ _ _ (_|| | |(_|>< _|
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re: Introduction to Tree::DAG_Node
by ChemBoy (Priest) on Mar 21, 2002 at 19:51 UTC | |
by gmax (Abbot) on Mar 22, 2002 at 07:36 UTC |