use strict; use warnings; # subroutines for walking a node tree # each takes a hash of nodes as the first parameter # and the id of the node to start with # # each $nodes->{$id} is of the form # { # id => $id, # integer # parent => undef, # undef for no parent, otherwise an integer # children => [3,5,6], # undef or a ref to an array of optional children. # } sub dump_nodes { my $nodes=shift; foreach my $node ( sort { $a->{id} <=> $b->{id} } values %$nodes ) { printf "Node %10s Parent: %- 10s Children: %s\n", $node->{id}, defined($node->{parent}) ? $node->{parent} : "undef", join(", ",sort {$a <=>$b } @{$node->{children}||[]}); } } sub dump_nodes_as_tree { my $nodes = shift; my $node_id = shift; my $depth = shift||0; unless (defined $node_id) { my @root_nodes=grep { !defined $_->{parent} } values %$nodes; foreach my $root ( sort { $a->{id} <=> $b->{id} } @root_nodes ) { dump_nodes_as_tree($nodes,$root->{id},0); } } else { my $node=$nodes->{$node_id}; printf "%s%d(%s)[%s]\n", (" " x $depth), $node_id, defined($node->{parent}) ? $node->{parent} : "undef", join(",",sort {$a <=>$b } @{$node->{children}||[]}); foreach my $child_id (sort {$a<=>$b} @{$node->{children}||[]}) { dump_nodes_as_tree($nodes,$child_id,$depth+1); } } } sub ancestors { my $nodes = shift; my $node_id = shift; my @ancestors; while (defined($nodes->{$node_id}{parent})) { push @ancestors,$nodes->{$node_id}{parent}; $node_id=$nodes->{$node_id}{parent}; } return wantarray ? @ancestors : \@ancestors } sub children_eldestline { # perorder traversal of the tree my $nodes = shift; my $node_id = shift; my $children = shift || []; foreach my $child_id (sort {$a<=>$b} @{$nodes->{$node_id}{children}||[]}) { push @$children,$child_id; children_eldestline($nodes,$child_id,$children); } return wantarray ? @$children : $children } sub children_bygen { # breadthfirst traversal of the tree my $nodes = shift; my $parent_id = shift; my @children; my @queue=($parent_id); while (@queue) { my $node_id=shift @queue; foreach my $child_id (sort {$a<=>$b} @{$nodes->{$node_id}{children}||[]}) { push @children,$child_id; push @queue,$child_id; } } return wantarray ? @children : \@children; } my %nodes; #my $data_file="reff.data"; #open my $dat_fh, $data_file or die "Could not open $data_file: $!"); #while (<$dat_fh>) { while () { if (/^\s*(\d+)\s+(\d+)$/) { #print "$2 is parent of $1\n"; $nodes{$1}{id}=$1; $nodes{$1}{parent}=$2; $nodes{$2}{id}=$2; push @{$nodes{$2}{children}},$1; } } print "Nodes:\n"; print dump_nodes(\%nodes),"\n"; print "Nodes as tree:\n"; print dump_nodes_as_tree(\%nodes),"\n"; print "Ancestory of 6 from newest to oldest (parent list):\n"; print join(", ",ancestors(\%nodes,6)),"\n"; print "Children of 0 by the liniage of the oldest child (pre-order):\n"; print join(", ",children_eldestline(\%nodes,0)),"\n"; print "Children of 0 in by generation (breadth-first):\n"; print join(", ",children_bygen(\%nodes,0)),"\n"; # the tree looks like: # 0 # +-+-+ # 1 2 # +-+ +++ # 3 4 5 # +-+-+ # 6 7 8 # # so we should get the following output: # # Nodes: # Node 0 Parent: undef Children: 1, 2 # Node 1 Parent: 0 Children: 3 # Node 2 Parent: 0 Children: 4, 5 # Node 3 Parent: 1 Children: 6, 7, 8 # Node 4 Parent: 2 Children: # Node 5 Parent: 2 Children: # Node 6 Parent: 3 Children: # Node 7 Parent: 3 Children: # Node 8 Parent: 3 Children: # # Nodes as tree: # 0(undef)[1,2] # 1(0)[3] # 3(1)[6,7,8] # 6(3)[] # 7(3)[] # 8(3)[] # 2(0)[4,5] # 4(2)[] # 5(2)[] # # Ancestory of 6 from newest to oldest (parent list): # 3, 1, 0 # Children of 0 by the liniage of the oldest child (pre-order): # 1, 3, 6, 7, 8, 2, 4, 5 # Children of 0 in by generation (breadth-first): # 1, 2, 3, 4, 5, 6, 7, 8 __DATA__ 1 0 2 0 3 1 4 2 5 2 6 3 7 3 8 3