how to construct tree from parent pointer list

[bfdi533]

I need to generate a node list for some network devices I manage and I need it to be in a hierarchical structure when I am done.

I have the following list that is generated where the fist item it the child and the second item is the parent:

b:a
c:a
d:b
e:c
f:c

And it needs to look like this when I am done:

   +-b--d
a -+
   +   +-e
   +-c-+
       +-f

I can parse out my input and basically generate the first list in an array or hash. But, what I am not sure of is how to generate the final data structure as I need to loop through the original list and come up with the hierarchy relationships. I have no idea how to store this either.

Any help with this would be appreciated.

2006-03-22 Retitled by planetscape, as per Monastery guidelines
Original title: 'a complex data structure'

[ikegami]

Getting you started with the previously mentioned Tree module:

use Tree ();

my %nodes;

while (<>) {
   my ($child, $parent) = split /:/;

   my $parent_node = $nodes{$parent} ||= Tree->new($parent);
   my $child_node  = $nodes{$child}  ||= Tree->new($child);

   $parent_node->add_child($child_node);
}

my @roots = grep { $_->is_root } values %nodes;

die("Invalid data: No roots\n")
   unless @roots;

foreach (@roots) {
   ...
}

If you are only expecting one root, replace the bottom loop with:

die("Invalid data: Multiple roots\n")
   if @roots > 1;

my $root = $roots[0];

...

I didn't check for circular dependancies.

[bryank]

Hi,

How do you output the tree? I tried using the various Tree methods with the keys of the hash, but without success.

[ikegami]

Like any other tree.

sub visit_preorder {
   my ($cb, node, $depth) = @_;
   $depth ||= 0;
   $cb->($node, $depth);
   visit_preorder($cb, $_, $depth+1) for $node->children();
}

sub visit_postorder {
   my ($cb, $node, $depth) = @_;
   $depth ||= 0;
   visit_postorder($cb, $_, $depth+1) for $node->children();
   $cb->($node, $depth);
}

visit_preorder(sub {
   my ($node, $depth) = @_;
   ...
}, $root);

It's odd that the module doesn't provide this for you.

What's wrong with the solutions we've already customised for you?

[xdg]

Looks like you might want to use a Tree.

[Anonymous Monk]

If you don't feel like using the Tree module, you can build your data structure by temporarily storing the references to each hash in a separate hash, as follows.

use strict;
use Data::Dumper;
my %data;

{
  my %temp;

  while (<DATA>) {
    chomp; /^(.*?):(.*?)$/;
    my $key = $2; my $value = $1;

    if (!defined $temp{$key}) { 
      $temp{$key} = {}; 
      $data{$key} = \%{$temp{$key}}; 
    };

    $temp{$key}{$value} = \%{$temp{$value}};

  };

}

print Dumper \%data;

__DATA__
b:a
c:a
d:b
e:c
f:c

This code generates the following dump of %data:

$VAR1 = {
          'a' => {
                   'c' => {
                            'e' => {},
                            'f' => {}
                          },
                   'b' => {
                            'd' => {}
                          }
                 }
        };


I'm not sure what you mean by I have no idea how to store this either. . If your looking for a way to save and load data to disk, you can use Data::Dumper and 'do' as follows.

use strict;
use Data::Dumper;

my %saved = (
  'test1' => {
     'test2' => 'b'
   },
   'b' => [1,2,3,4],
   'test3' => 'x'
);

print "Constructed hash\n";
print Dumper \%saved;

open FILE, ">save.out";
print FILE Dumper \%saved;
close FILE;

my %loaded = %{do 'save.out'};

print "Loaded hash\n";
print Dumper \%loaded;

Be aware though that saving and loading hashes this way can be a security risk if your script and saved file have different read/write permissions for different users. (i.e. If security is set up in such a way that a user is unable to edit the Perl script, but is able to edit save.out, this would introduce a way for that user to execute code in the Perl script.)

[nothingmuch]

The security risk can be avoided with DBM::Deep or Storable.

[BerntB]

The security risk can be avoided with DBM::Deep or Storable.

Has those modules been analyzed fom a security perspective? There are no C-like buffer overruns possible, but...?

[dragonchild]

Tree comes with a persistence layer called Tree::Persist. However, I would consider that deprecated and would recommend persisting with DBM::Deep using the autobless option.

[demerphq]

Just so you know, Data::Dump::Streamer has some new (and IMO pretty sophisticated) support for supporting special serialization of objects. If you need to add persistancy to an object I suggest you look into the DDS_freeze() method.

[artist]

Graph::Easy

[Anonymous Monk]

I have the following list that is generated where the fist item it the child and the second item is the parent: b:a c:a d:b e:c f:c And it needs to look like this when I am done: +-b--d a -+ + +-e +-c-+ +-f Any help with this would be appreciated.

I'd suggest something along these lines...

use Graph::Easy;
my $graph = Graph::Easy->new();
my @nodes=('b:a','c:a','d:b','e:c','f:c');
my ($child,$parent);

# build the graph
foreach my $node (@nodes) {
        ($child,$parent) = split(":",$node);
        $graph->add_edge($parent,$child);
}

# print the graph
print $graph->as_asciii();

I have no idea how to store this either.

Is there any reason you don't want to do this?

# save the graph by saving the list of original nodes
open($filehandle,"<","nodes.dat") or die("Can't open file 'nodes.dat' 
+for writing: $!\n");
print $filehandle join("\n",@nodes);

--
Ytrew

[Anonymous Monk]

Ack! The arrow is wrong on the open statement. It should go the other direction. :-(

[eXile]

or yet another alternative: Tree::Simple

[nothingmuch]

Anonymous Monk's code can be slightly beautified:

use strict;
use Data::Dumper;
my %deep;

{
  my %flat;

  while (<DATA>) {
    chomp;

    my ( $child, $parent ) = /^(.*?):(.*?)$/;

    # if the parent is new then it's possibly at the root of the struc
+ture
    # like 'a' is
    unless ( exists $flat{$parent} ) {
        $flat{parent} = $deep{parent} = {};
    }

    # find the parent, and mark this node as a child of it
    $flat{$parent}{$child} = ($flat{child} ||= {})

    # since $child is a child of $parent it can't be at the root, so d
+elete it if it's there
    delete $deep{$child};
  };
}

[demerphq]

This is an algorithm that IMO every programmer should be familiar with. Its good that you are taking the time to learn.

#perl -e;
use Data::Dumper;
my %nodes;
my @children;

while (<DATA>) {
    chomp;
    my ($c,$p)=split/:/,$_;
    push @children,$c unless $nodes{$c};
    $nodes{$_}{name}||=$_
        for $c,$p;
    $nodes{$p}{kids}{$c}=$nodes{$c};
}
delete $nodes{$_}
    for @children;
my @roots=keys %nodes;

print Dumper($nodes{$_}) for @roots;


__END__
b:a
c:a
d:b
e:c
f:c

This version of the algorithm is flexible, it doesnt expect the nodes to be inorder as some of the solutions posted do. It will also identify mixed heirarchies (ie two distinct trees in the same list), and is fairly simple. It has the disadvantage that it must store a list of the nodes which are children until the end of the data input. Here is the output:

$VAR1 = {
          'name' => 'a',
          'kids' => {
                      'c' => {
                               'name' => 'c',
                               'kids' => {
                                           'e' => {
                                                    'name' => 'e'
                                                  },
                                           'f' => {
                                                    'name' => 'f'
                                                  }
                                         }
                             },
                      'b' => {
                               'name' => 'b',
                               'kids' => {
                                           'd' => {
                                                    'name' => 'd'
                                                  }
                                         }
                             }
                    }
        };

[bryank]

Hi Perl monks.

I am in search of wisdom!

I was wondering if you could explain a couple things for me from your example:

$nodes{$_}{name}||=$_
        for $c,$p;

-- I'm not use to putting '$_' as a key for a hash. I am also not sure what '||=$_' means/does. Can you explain?

I'm also not sure why you are deleting children...

delete $nodes{$_}
    for @children;

Sorry for the newbie questions -- I've been dabbling in Perl for years, and I use hashes a lot but my syntax is still on the simple side.

I have another question. Any tips on printing nested hashes? I use Data::Dumper all the time, but I usually just use the default output. What I am looking for is the "full path". For example, in the above example, we have this:

 'name' => 'a',
          'kids' => {
                      'c' => {
                               'name' => 'c',
                               'kids' => {
                                           'e' => {
                                                    'name' => 'e'
                                                  },
                                           'f' => {
                                                    'name' => 'f'

-- I'd like to print out something like this:

a
a:c
a:c:e
a:c:f

I usually just print each piece of the hash, which isn't too hard if I created the hash. For example, if I had a hash ref that had name/address information, I'd do something like:

print $hash->{$key}->{'name'} . "\t";
print $hash->{$key}->{'addres'} . "\n";

But if the hash is created via autovivification (for example, let's say I am constructing a complex node tree from a parent-child list of several thousand nodes) I get stumped on how I'd be able to print the full path of each element in the hash.

Does that make any sense? I am waking up and keeping two little kids from killing each other. ;)

Any tips much appreciated!!

Thanks.

--Bryan

[demerphq]

-- I'm not use to putting '$_' as a key for a hash. I am also not sure what '||=$_' means/does. Can you explain

My code uses a for modifier to alias $c and $p to $_ for the duration of the statement. This is done to eliminate duplicated code. The ||= $_ means "or-equal's $_". Its easiest to exlain by just defining ||= properly, which is that $x ||= $y; does exactly the same thing that $x = $x || $y; which in turn is effectively the same as $x=$y if not $x;

I'm also not sure why you are deleting children...

My algorithm is meant to be order insensitive. That is that you should build the same tree regardless of the order that each parent/child tuple is processed. It does this by putting each node in the root tree, and then basically merging the trees together. However every tree that is a child shouldnt be in the root hash at the end of processing. However we dont know if a node is a true root (the tuples may represent a forest of trees) until we have processed the full list.

-- I'd like to print out something like this

Basically you would write a recursive routine that recursively inorder traverse the tree. Such a routine would look something like the following:

sub print_inorder {
   my $node= shift;
   print $node->{name}, "\n";
   print_inorder($_)
      for sort { $a->{name} cmp $b->{name} } 
          values %{ $node->{kids} || {} };
}

And before you ask... %{ $node->{kids} || {} } is a "trick" to make the code relatively simple yet also able to deal with nodes that have no children (as it dereferences an empty hash if there are no kids defined).