|
hoffmann has asked for the wisdom of the Perl Monks concerning the following question:
I have the following problem:
Suppose I have a tree of data as follows (Labels represent the branches of the tree, Nodes represent data "leaves" contained in the branches):
Label1
Node1
Node2
Label2
Node3
Label3
Node4
Node5
Label4
Node6.
I want to move every "label" or "branch" of the tree that contains only one "node" or "leaf" into the highest level of the tree and delete that branch. I basically want to remove the branches that contain one leaf and move the data from that leaf into the highest level of the tree. So for the example I have, I would like it to become the following:
Label1
Node1
Node2
Node3
Node6
Label3
Node4
Node5.
What is the best way to code such a problem, and would any one language be suitable for this task? The data I have is in an excel file so I suppose I could do it in there but I'm looking for a more elegant way to do it, preferably in Perl. Thanks! |
Re: Moving data in a tree
by shoness (Friar) on Jul 21, 2008 at 22:08 UTC
|
There are various modules on CPAN that will help you a great deal.
With Tree::DAG_Node for instance you can traverse the tree, running methods or simply and safely pruning and splicing the leaves and branches of your tree as you go along.
Untested...
my @leaves = ();
$root->walk_down('callback' =>
sub {
if (!scalar($_[0]->daughters)) # is it a leaf?
push @leaves, $_[0];
return 1;
}
$root->add_daughters(@leaves);
| [reply]
[d/l] |
Re: Moving data in a tree
by moritz (Cardinal) on Jul 21, 2008 at 20:43 UTC
|
The first step is to get your tree into a data structure. Then you (recursively) traverse it, and for each node that contains one leave you delete that, and attach it to the root node.
And yes, perl is perfectly suitable for that.
If you have more specific questions, ask them. And once you've started to write perl code, show us what you have when you need more help. | [reply] |
|
|
Interesting. I'd have done this a little differently. When you are traversing the tree and you are done processing a node, check to see if it only has one leaf. If so, move the single leaf to its parent node (deleting children that have no leaves). The end result would be the same (i.e., branches with single leaves would get moved to the root) but this would allow nodes that wouldn't make it all the way to the root to be propagated as high as they could be.
Of course, that's not what the OP actually requested so I could be full of...er, um...I could be wrong.
| [reply] |
|
|
Would it be possible to load the excel file as is, then run the perl script on it?
| [reply] |
|
|
|
|
Re: Moving data in a tree
by ikegami (Patriarch) on Jul 21, 2008 at 22:40 UTC
|
You didn't specify anything about your data structure, so I made a guess at it.
use strict;
use warnings;
BEGIN {
package Node;
sub new {
my ($class, $name) = @_;
return bless({
name => $name,
}, $class);
}
sub name { $_[0]{name} }
}
BEGIN {
package Label;
sub new {
my ($class, $name, $nodes, $branches) = @_;
return bless({
name => $name,
nodes => $nodes,
branches => $branches,
}, $class);
}
sub name { $_[0]{name} }
sub nodes { @{ $_[0]{nodes} } }
sub flatten {
my ($self) = @_;
my @orphans;
local *_flatten = sub {
my ($self) = @_;
our @nodes; local *nodes = $self->{nodes};
our @branches; local *branches = $self->{branches};
push @orphans, shift @nodes if @nodes == 1;
@branches = map _flatten($_), @branches;
return @nodes ? $self : @branches;
};
_flatten($self);
push @{ $self->{nodes} }, @orphans;
}
sub visit {
my ($self, $visitor) = @_;
local *_visit = sub {
my ($self, $depth) = @_;
our @branches; local *branches = $self->{branches};
$visitor->($self, $depth);
for my $branch ( @branches ) {
_visit($branch, $depth+1);
}
};
_visit($self, 0);
}
}
{
sub node { return Node->new(@_); }
sub label { return Label->new(@_); }
sub printer {
my ($label, $depth) = @_;
my $indent = ' ' x $depth;
print("$indent+ ", $label->name(), "\n");
for my $node ( $label->nodes() ) {
print("$indent = ", $node->name(), "\n");
}
}
my $tree = (
label('Label1', [ node('Node1'), node('Node2') ], [
label('Label2', [ node('Node3') ], [
label('Label3', [ node('Node4'), node('Node5') ], [
label('Label4', [ node('Node6') ], [
]) ]) ]) ])
);
$tree->visit(\&printer); print("\n");
$tree->flatten();
$tree->visit(\&printer); print("\n");
}
+ Label1
= Node1
= Node2
+ Label2
= Node3
+ Label3
= Node4
= Node5
+ Label4
= Node6
+ Label1
= Node1
= Node2
= Node3
= Node6
+ Label3
= Node4
= Node5
| [reply]
[d/l]
[select] |
|
|
I suppose it would be easiest if the type of structure is an array. In fact, it is approximately 700 rows and 10 columns of data.
| [reply] |
|
|
I suppose it would be easiest if the type of structure is an array. In fact, it is approximately 700 rows and 10 columns of data.
Not at all. Let your data tell you how it wants to be arranged and accessed. If, as you've implied by your original post, the data wants to be a tree, let it be a tree.
In Perl, this can be expressed in various ways. ikegami uses an array called branches at each node and that makes a lot of sense. In his/her code, each branch is an object reference but it could also have been a reference to a hash.
| [reply] |
Re: Moving data in a tree
by GrandFather (Saint) on Jul 22, 2008 at 05:05 UTC
|
use strict;
use warnings;
use Data::Dump::Streamer;
my $branch1 = {
Leaves => [qw(Leaf1 Leaf2)],
Branch2 => {
Leaves => [qw(Leaf3)],
Branch3 => {
Leaves => [qw(Leaf4 Leaf5)],
Branch4 => {
Leaves => [qw(Leaf6)],
}
}
},
Branch5 => {
Leaves => [qw(Leaf7)],
Branch6 => {
Leaves => [qw(Leaf8 Leaf9)],
}
},
};
print "Original Tree:\n";
Dump ($branch1);
removeBranch ($branch1);
print "New Tree:\n";
Dump ($branch1);
sub removeBranch {
my ($root, $branch) = @_;
my $leafKey;
my $keep;
$branch = $root unless $branch;
for my $child (keys %$branch) {
if ('ARRAY' eq ref $branch->{$child}) {
$leafKey = $child;
next;
}
if (removeBranch ($root, $branch->{$child})) {
delete $branch->{$child};
} else {
$keep = 1;
}
}
return ! $keep unless $leafKey;
my $leaves = $branch->{$leafKey};
return undef if @$leaves > 1; # Leave this branch alone
push @{$root->{Leaves}}, @$leaves;
delete $branch->{$leafKey};
return ! $keep;
}
__DATA__
Branch1 (Leaf1 Leaf2)
Branch2 (Leaf3)
Branch3 (Leaf4 Leaf5)
Branch4 (Leaf6)
Branch5 (Leaf7)
Branch6 (Leaf8 Leaf9)
Branch1 (Leaf1 Leaf2 Leaf3 Leaf6 Leaf7)
Branch3 (Leaf4 Leaf5)
Prints:
Original Tree:
$HASH1 = {
Branch2 => {
Branch3 => {
Branch4 => { Leaves => [ 'Leaf6'
+] },
Leaves => [
'Leaf4',
'Leaf5'
]
},
Leaves => [ 'Leaf3' ]
},
Branch5 => {
Branch6 => { Leaves => [
'Leaf8',
'Leaf9'
] },
Leaves => [ 'Leaf7' ]
},
Leaves => [
'Leaf1',
'Leaf2'
]
};
New Tree:
$HASH1 = {
Branch2 => { Branch3 => { Leaves => [
'Leaf4',
'Leaf5'
] } },
Branch5 => { Branch6 => { Leaves => [
'Leaf8',
'Leaf9'
] } },
Leaves => [
'Leaf1',
'Leaf2',
'Leaf6',
'Leaf3',
'Leaf7'
]
};
Perl is environmentally friendly - it saves trees
| [reply]
[d/l]
[select] |
|
|
