PERL Miscellaneous - display in a tree structure

Author

display in a tree structure

Vakayil Thobias

2008-03-26, 8:10 am

Hello,

I have to display the data from a file in tree structure(perl).
The file format is as follows(first field parent, second field child) :

PM01 PM02
PM01 PM1A
PM02 PM03
PM03 PM04
PM04 PM05
PM04 PM06
PM1A PM1B
PM1A PM1C

The output should be like this :
PM01 -- PM02 -- PM03 -- PM04 -- PM05
PM06
PM01 PM1A -- PM1B
PM1C

Anybody have idea ?

Regards,
Thobias

Sandy

2008-03-26, 7:32 pm

On 26 Mar, 04:07, "Vakayil Thobias" <vakayil.thob...@alcatel-
lucent.com> wrote:
>
> I have to display the data from a file in tree structure(perl).
> The file format is as follows(first field parent, second field child) :
>
> PM01 PM02
> PM01 PM1A
> PM02 PM03
> PM03 PM04
> PM04 PM05
> PM04 PM06
> PM1A PM1B
> PM1A PM1C
>
> The output should be like this :
> PM01 -- PM02 -- PM03 -- PM04 -- PM05
> PM01 PM1A -- PM1B

There is a very nice package: http://search.cpan.org/~jhi/Graph-0.84/lib/Graph.pod

use Graph;
my $g = Graph->new();
$g->add_edge('a', 'b');
$g->add_edge('a', 'c');
$g->add_edge('b', 'd');
$g->add_edge('c', 'e');

There are additional packages for traversal:
http://search.cpan.org/~jhi/Graph-0...ph/Traversal.pm
http://search.cpan.org/~jhi/Graph-0...raversal/BFS.pm -
Breadth first
http://search.cpan.org/~jhi/Graph-0...raversal/DFS.pm -
Depth first

Or you can traverse it yourself by starting at the root and calling
$root->successors() and then call the same method for every element in
the returned list and print edges in the format you want.

Good luck

/sandy
http://myperlquiz.com/

Martijn Lievaart

2008-03-26, 7:32 pm

On Wed, 26 Mar 2008 16:37:32 +0530, Vakayil Thobias wrote:

> Hello,
>
> I have to display the data from a file in tree structure(perl). The file
> format is as follows(first field parent, second field child) :
>
> PM01 PM02
> PM01 PM1A
> PM02 PM03
> PM03 PM04
> PM04 PM05
> PM04 PM06
> PM1A PM1B
> PM1A PM1C
>
> The output should be like this :
> PM01 -- PM02 -- PM03 -- PM04 -- PM05
> PM06
> PM01 PM1A -- PM1B
> PM1C
>
> Anybody have idea ?

Something like (got a bit more complicated than I thought at first,
someone is bound to come up with a better/shorter solution):

#!/usr/bin/perl

use strict;
use warnings;

# Note all the commented out debug code!
#use Data::Dumper;

# read in the file
# remember both parent -> children and
# child -> parent

# Need to remember all children to print the tree
my %children;

# Need to remember all parents to find all roots
my %parent;

while (<DATA> ) {
my ($parent, $child) = split;
die if exists $parent{$child};
$parent{$child} = $parent;
push @{$children{$parent}}, $child;
}

#print Data::Dumper->Dump([\%parent], ["*parent"]), "\n";
#print Data::Dumper->Dump([\%children], ["*children"]), "\n";

# Get all nodes without a parent, those are the roots
my @roots = grep { not exists $parent{$_} } keys %children;
#print Data::Dumper->Dump(\@roots, ["*roots"]), "\n";

# Print the tree
for (@roots) {
print "$_";
print_children(1, $children{$_} );
}

# Print all children of the current node
#
# Parameters:
# - $indent: The amount of nodes to indent
# - $children_ref: reference to an array containing all children
# or undef if there are no children.
#
sub print_children {
my ($indent, $children_ref) = @_;

# No children? Print a newline and quit this branch.
unless ($children_ref) {
print "\n";
return;
}

# There are children, print each one on a new line,
# with the proper indent. Use "+-" if more than one child,
# use "--" if only one. That way we get a nice tree look.
my @children = @$children_ref;
my $sep = @children==1 ? "--" : "+-";
my $first = 1;
for (@children) {
my $spaces = $first ? 0 : $indent*8-4;
$first = 0;
print " "x$spaces, " $sep ", $_;
print_children($indent+1, $children{$_});
}
}

__DATA__
PM01 PM02
PM01 PM1A
PM02 PM03
PM03 PM04
PM04 PM05
PM04 PM06
PM1A PM1B
PM1A PM1C

HTH,
M4

Vakayil Thobias

2008-03-27, 4:49 am

"Martijn Lievaart" <m@rtij.nl.invlalid> wrote in message
news:pan.2008.03.26.23.19.48@rtij.nl.invlalid...
> On Wed, 26 Mar 2008 16:37:32 +0530, Vakayil Thobias wrote:
>
>
> Something like (got a bit more complicated than I thought at first,
> someone is bound to come up with a better/shorter solution):
>
> #!/usr/bin/perl
>
> use strict;
> use warnings;
>
> # Note all the commented out debug code!
> #use Data::Dumper;
>
> # read in the file
> # remember both parent -> children and
> # child -> parent
>
> # Need to remember all children to print the tree
> my %children;
>
> # Need to remember all parents to find all roots
> my %parent;
>
> while (<DATA> ) {
> my ($parent, $child) = split;
> die if exists $parent{$child};
> $parent{$child} = $parent;
> push @{$children{$parent}}, $child;
> }
>
> #print Data::Dumper->Dump([\%parent], ["*parent"]), "\n";
> #print Data::Dumper->Dump([\%children], ["*children"]), "\n";
>
> # Get all nodes without a parent, those are the roots
> my @roots = grep { not exists $parent{$_} } keys %children;
> #print Data::Dumper->Dump(\@roots, ["*roots"]), "\n";
>
> # Print the tree
> for (@roots) {
> print "$_";
> print_children(1, $children{$_} );
> }
>
> # Print all children of the current node
> #
> # Parameters:
> # - $indent: The amount of nodes to indent
> # - $children_ref: reference to an array containing all children
> # or undef if there are no children.
> #
> sub print_children {
> my ($indent, $children_ref) = @_;
>
> # No children? Print a newline and quit this branch.
> unless ($children_ref) {
> print "\n";
> return;
> }
>
> # There are children, print each one on a new line,
> # with the proper indent. Use "+-" if more than one child,
> # use "--" if only one. That way we get a nice tree look.
> my @children = @$children_ref;
> my $sep = @children==1 ? "--" : "+-";
> my $first = 1;
> for (@children) {
> my $spaces = $first ? 0 : $indent*8-4;
> $first = 0;
> print " "x$spaces, " $sep ", $_;
> print_children($indent+1, $children{$_});
> }
> }
>
> __DATA__
> PM01 PM02
> PM01 PM1A
> PM02 PM03
> PM03 PM04
> PM04 PM05
> PM04 PM06
> PM1A PM1B
> PM1A PM1C
>
> HTH,
> M4

Hello Martijn Lievaart,
Excellent solution.
It's really workign fine.
Thank you very much.
Regards,
Thobias

Sponsored Links