175
180
=head2 get_lineage_nodes
177
182
Title : get_lineage_nodes
178
183
Usage : my @nodes = $tree->get_lineage_nodes($node);
179
Function: Get the full lineage of a node (all its ancestors, in the order
180
root->most recent ancestor)
184
Function: Given a node or its ID, get its full lineage, i.e. all its ancestors,
185
from the root to the most recent ancestor. Only use the node ID as
186
input if the nodes have been added to the tree.
181
187
Returns : list of nodes
182
Args : either Bio::Tree::NodeI or string of the node id
188
Args : either Bio::Tree::NodeI (or string of the node id)
186
192
sub get_lineage_nodes {
187
193
my ($self, $input) = @_;
189
unless (ref $input) {
198
if (not $input->isa('Bio::Tree::NodeI')) {
199
$self->throw("Did not provide a valid Bio::Tree::NodeI object or ID string to get_lineage_nodes");
190
203
$node = $self->find_node($input);
192
elsif (! $input->isa('Bio::Tree::NodeI')) {
193
$self->warn("Did not provide either a valid Bio::Tree::NodeI object or id to get_lineage_nodes");
200
# when dealing with Bio::Taxon objects with databases, the root will always
206
# When dealing with Bio::Taxon objects with databases, the root will always
201
207
# be the database's root, ignoring this Tree's set root node; prefer the
202
208
# Tree's idea of root.
203
209
my $root = $self->get_root_node || '';
221
=head2 get_lineage_string
223
Title : get_lineage_string
224
Usage : my $lineage = $tree->get_lineage_string($node);
225
Function: Get the string representation of the full lineage of a node, e.g.
226
for the Enterobacteriales node, return
227
Bacteria;Proteobacteria;Gammaproteobacteria;Enterobacteriales.
228
This method uses get_lineage_nodes internally and therefore inherits
229
of all of its caveats.
231
Args : * either Bio::Tree::NodeI (or string of the node id)
232
* an optional separator (default: ';')
236
sub get_lineage_string {
237
my ($self, $input, $sep) = @_;
240
unless (ref $input) {
241
$node = $self->find_node($input);
243
elsif (! $input->isa('Bio::Tree::NodeI')) {
244
$self->warn("Did not provide either a valid Bio::Tree::NodeI object or id to get_lineage_nodes");
250
my @nodes = ($self->get_lineage_nodes($node), $node);
251
for my $i (0 .. scalar @nodes - 1) {
252
my $node_name = $nodes[$i]->node_name || '';
253
if ($node_name =~ m/$sep/) {
254
$self->warn("Separator '$sep' is not safe to use because the node ".
255
"called '$node_name' contains it. Consider using another separator".
256
" or sanitizing the node name.");
258
$nodes[$i] = $node_name;
260
return join $sep, @nodes;
443
495
my ($self, $thing) = @_;
444
496
$self->throw("Must supply an object reference") unless ref($thing);
446
my ($lineage_tree, $lineage_leaf);
447
499
if ($thing->isa('Bio::Tree::TreeI')) {
448
500
my @leaves = $thing->get_leaf_nodes;
449
501
$self->throw("The supplied Tree can only have one leaf") unless @leaves == 1;
450
$lineage_tree = $thing;
451
502
$lineage_leaf = shift(@leaves);
453
504
elsif ($thing->isa('Bio::Tree::NodeI')) {
454
505
$self->throw("The supplied Node must have an ancestor") unless $thing->ancestor;
455
$lineage_tree = $self->new(-node => $thing);
456
506
$lineage_leaf = $thing;
459
# see if any node in the supplied lineage is in our tree - that will be
460
# our lca and we can merge at the node below
509
# Find the lowest node in the supplied lineage that is in the tree
510
# That will be our lca and we can merge at the node below
461
511
my @lineage = ($lineage_leaf, reverse($self->get_lineage_nodes($lineage_leaf)));
463
for my $i (0..$#lineage) {
464
my $lca = $self->find_node(-internal_id => $lineage[$i]->internal_id) || next;
467
# the supplied thing to merge is already in the tree, nothing to do
515
while ($i <= $#lineage) {
516
$node = $self->find_node(-internal_id => $lineage[$i]->internal_id);
470
# $i is the lca, so the previous node is new to the tree and should
472
$lca->add_Descendent($lineage[$i-1]);
476
$merged || ($self->warn("Couldn't merge the lineage of ".$lineage_leaf->id." with the rest of the tree!\n") && return);
524
$self->warn("Could not merge the lineage of ".$lineage_leaf->id." with the rest of the tree");
527
# Merge descendents, recursively
529
$node->add_Descendent($lineage[$i-1]);
530
$node = $self->find_node(-internal_id => $lineage[$i-1]->internal_id);
479
538
=head2 contract_linear_paths
481
540
Title : contract_linear_paths
947
my $old_root = $self->get_root_node;
948
if( $new_root == $old_root ) {
949
$self->warn("Node requested for reroot is already the root node!");
952
my $anc = $new_root->ancestor;
954
# this is already the root
955
$self->warn("Node requested for reroot is already the root node!"); return 0;
957
my $tmp_node = $new_root->create_node_on_branch(-position=>0,-force=>1);
1011
my $old_root = $self->get_root_node;
1012
if( $new_root == $old_root ) {
1013
$self->warn("Node requested for reroot is already the root node!");
1016
my $anc = $new_root->ancestor;
1018
# this is already the root
1019
$self->warn("Node requested for reroot is already the root node!");
1022
my $tmp_node = $new_root->create_node_on_branch(-position=>0,-force=>1);
958
1023
# reverse the ancestor & children pointers
959
1024
my $former_anc = $tmp_node->ancestor;
960
1025
my @path_from_oldroot = ($self->get_lineage_nodes($tmp_node), $tmp_node);
1064
1130
=head2 add_trait
1066
Example : $key = $tree->add_trait($trait_file, 3);
1067
Description: Add traits to a Bio::Tree:Tree nodes
1068
of a tree from a file.
1069
Returns : trait name
1070
Exceptions : log an error if a node has no value in the file
1071
Args : name of trait file (scalar string),
1072
index of trait file column (scalar int)
1075
The trait file is a tab-delimited text file and needs to have a header
1076
line giving names to traits. The first column contains the leaf node
1077
ids. Subsequent columns contain different trait value sets. Columns
1078
numbering starts from 0. The default trait column is the second
1079
(1). The returned hashref has one special key, my_trait_name, that
1080
holds the trait name. Single or double quotes are removed.
1133
Usage : my $key = $tree->add_trait($trait_file, 3);
1134
Function: Add traits to the leaf nodes of a Bio::Tree:Tree from a file.
1135
The trait file is a tab-delimited text file and needs to have a
1136
header line giving names to traits. The first column contains the
1137
leaf node ids. Subsequent columns contain different trait value sets.
1138
Single or double quotes are removed from the trait values. Traits
1139
are added to leaf nodes as a tag named $key using the add_tag_value()
1140
method. This means that you can retrieve the trait values using the
1141
get_tag_values() method (see the documentation for Bio::Tree::Node).
1142
Returns : Trait name (a scalar) on success, undef on failure (for example, if
1143
the column index requested was too large).
1144
Args : * Name of trait file (scalar string).
1145
* Index of trait file column (scalar int). Note that numbering starts
1146
at 0. Default: 1 (second column).
1147
* Ignore missing values. Typically, if a leaf node has no value in
1148
the trait file, an exception is thrown. If you set this option to
1149
1, then no trait will be given to the node (no exception thrown).
1084
1153
sub _read_trait_file {
1087
my $column = shift || 1;
1154
my ($self, $file, $column) = @_;
1090
open my $TRAIT, "<", $file or $self->("Can't find file $file: $!\n");
1159
open my $TRAIT, '<', $file or $self->throw("Could not open file $file: $!\n");
1092
1161
my $first_line = 1;
1093
1162
while (<$TRAIT>) {
1098
$traits->{'my_trait_name'} = $line[$column];
1103
last unless $line[0];
1104
$traits->{$line[0]} = $line[$column];
1165
my @line = split /\t/;
1168
$trait_name = $line[$column];
1173
last if (not defined $id) or ($id eq '');
1175
# Skip empty trait values
1176
my $value = $line[$column];
1177
next if (not defined $value) or ($value eq '');
1179
$trait_values->{$id} = $value;
1183
return $trait_name, $trait_values;
1109
1186
sub add_trait {
1114
my $traits = $self->_read_trait_file($file, $column); # filename, trait column
1115
my $key = $traits->{'my_trait_name'};
1116
#use YAML; print Dump $traits; exit;
1117
foreach my $node ($self->get_leaf_nodes) {
1118
# strip quotes from the node id
1119
$node->id($1) if $node->id =~ /^['"]+(.*)['"]+$/;
1122
$node->add_tag_value($key, $traits->{ $node->id } );
1124
$self->throw("ERROR: No trait for node [".
1125
$node->id. "/". $node->internal_id. "]")
1187
my ($self, $file, $column, $ignore) = @_;
1188
$ignore = 0 if not defined $ignore;
1190
my ($trait_name, $trait_values) = $self->_read_trait_file($file, $column);
1192
if (defined $trait_name) {
1194
for my $node ($self->get_leaf_nodes) {
1196
# strip quotes from the node id
1197
$node->id($1) if $node->id =~ /^['"]+(.*)['"]+$/;
1199
if ( not exists $trait_values->{$node->id} ) {
1203
$self->throw("No trait for node [".$node->id."/".$node->internal_id."]");
1207
$node->add_tag_value($trait_name, $trait_values->{ $node->id } );
added
removed
Bio/Tree/TreeFunctionsI.pm
