1######################################################
2# Tree.pm
3######################################################
4# Author:  Weigang Qiu, Chengzhi Liang, Peter Yang, Thomas Hladish
5# $Id: Tree.pm,v 1.62 2007/09/21 23:09:09 rvos Exp $
6
7#################### START POD DOCUMENTATION ##################
8
9=head1 NAME
10
11Bio::NEXUS::Tree - Provides functions for manipulating trees
12
13=head1 SYNOPSIS
14
15new Bio::NEXUS::Tree;
16
17=head1 DESCRIPTION
18
19Provides a few useful functions for trees.
20
21=head1 FEEDBACK
22
23All feedback (bugs, feature enhancements, etc.) are all greatly appreciated. There are no mailing lists at this time for the Bio::NEXUS::Tree module, so send all relevant contributions to Dr. Weigang Qiu (weigang@genectr.hunter.cuny.edu).
24
25=head1 AUTHORS
26
27 Eugene Melamud (melamud@carb.nist.gov)
28 Thomas Hladish (tjhladish at yahoo)
29 Weigang Qiu (weigang@genectr.hunter.cuny.edu)
30 Chengzhi Liang (liangc@umbi.umd.edu)
31 Peter Yang (pyang@rice.edu)
32
33=head1 METHODS
34
35=cut
36
37package Bio::NEXUS::Tree;
38
39use strict;
40use Bio::NEXUS::Functions;
41use Bio::NEXUS::Node;
42#use Data::Dumper; # XXX this is not used, might as well not import it!
43#use Carp;
44use Bio::NEXUS::Util::Exceptions;
45use Bio::NEXUS::Util::Logger;
46use vars qw($VERSION $AUTOLOAD);
47use Bio::NEXUS; $VERSION = $Bio::NEXUS::VERSION;
48
49my $logger = Bio::NEXUS::Util::Logger->new();
50
51=head2 new
52
53 Title   : new
54 Usage   : $tree = new Bio::NEXUS::Tree();
55 Function: Creates a new Bio::NEXUS::Tree object
56 Returns : Bio::NEXUS::Tree object
57 Args    : none
58
59=cut
60
61sub new {
62    my ($class) = @_;
63    my $root_node = new Bio::NEXUS::Node;
64    my $self = { name => undef, root_node => $root_node };
65    bless $self, $class;
66    return $self;
67}
68
69=head2 clone
70
71 Name    : clone
72 Usage   : my $new_tree = $self->clone();
73 Function: clone a Bio::NEXUS::Tree (self) object. All the nodes are also cloned.
74 Returns : new Bio::NEXUS::Tree object
75 Args    : none
76
77=cut
78
79sub clone {
80    my ($self) = @_;
81    my $class = ref($self);
82    my $newtree = bless( { %{$self} }, $class );
83
84    # clone nodes
85    $newtree->set_rootnode( $self->get_rootnode()->clone() );
86    return $newtree;
87}
88
89=head2 set_rootnode
90
91 Title   : set_rootnode
92 Usage   : $tree->set_rootnode($newnode);
93 Function: Sets the root node to a new node
94 Returns : none
95 Args    : root node (Bio::NEXUS::Node object)
96
97=cut
98
99sub set_rootnode {
100    my $self    = shift;
101    my $newroot = shift;
102    $self->{root_node} = $newroot;
103}
104
105=head2 get_rootnode
106
107 Title   : get_rootnode
108 Usage   : $node = $tree->get_rootnode();
109 Function: Returns the tree root node
110 Returns : root node (Bio::NEXUS::Node object)
111 Args    : none
112
113=cut
114
115sub get_rootnode {
116    my $self = shift;
117    if ( defined $self->{'root_node'} ) {
118        return $self->{'root_node'};
119    }
120}
121
122=begin comment
123
124 Title   : _parse_newick
125 Usage   : $tree->_parse_newick($tree_string);
126 Function: Creates a tree out of the existing tree string
127 Returns : none
128 Args    : array ref of NEXUS 'words' (a newick tree string that has been parsed by &_parse_nexus_words)
129
130=end comment
131
132=cut
133
134sub _parse_newick {
135    my ( $self, $tree_words ) = @_;
136
137    my $root = $self->get_rootnode();
138    $root->_parse_newick($tree_words);
139    $self->set_depth();
140    $self->determine_cladogram();
141    return;
142}
143
144=head2 set_name
145
146 Title   : set_name
147 Usage   : $tree->set_name($name);
148 Function: Sets the tree name
149 Returns : none
150 Args    : name (string)
151
152=cut
153
154sub set_name {
155    my ( $self, $name ) = @_;
156    $self->{'name'} = $name;
157}
158
159=head2 get_name
160
161 Title   : get_name
162 Usage   : $name = $tree->get_name();
163 Function: Returns the tree's name
164 Returns : name (string) or undef if name doesn't exist
165 Args    : none
166
167=cut
168
169sub get_name {
170    if ( defined $_[0]->{'name'} ) {
171        return $_[0]->{'name'};
172    }
173    else {
174        return undef;
175    }
176}
177
178=head2 set_as_default
179
180 Title   : set_as_default
181 Usage   : $tree->set_as_default();
182 Function: assigns is_default variable for this object to 1. (default : 0)
183 Returns : none
184 Args    : none
185
186=cut
187
188sub set_as_default {
189    my $self = shift;
190    $self->{'is_default'} = 1;
191}
192
193=head2 is_default
194
195 Title   : is_default
196 Usage   : $is_default_tree = $tree->is_default();
197 Function: check whether the tree is assigned as the default.
198 Returns : 0 (false) or 1 (true)
199 Args    : none
200
201=cut
202
203sub is_default {
204    my $self = shift;
205    return $self->{'is_default'};
206}
207
208=head2 set_as_unrooted
209
210 Title   : set_as_unrooted
211 Usage   : $tree->set_as_unrooted();
212 Function: assigns is_unrooted variable for this object to 1. (default : 0)
213 Returns : none
214 Args    : none
215
216=cut
217
218sub set_as_unrooted {
219    my $self = shift;
220    $self->{'is_unrooted'} = 1;
221}
222
223=head2 is_rooted
224
225 Title   : is_rooted
226 Usage   : $is_rooted_tree = $tree->is_rooted();
227 Function: Check whether the tree is rooted.
228 Returns : 0 (false) or 1 (true)
229 Args    : none
230
231=cut
232
233sub is_rooted {
234    my $self = shift;
235    return !$self->{'is_unrooted'};
236}
237
238=head2 determine_cladogram
239
240 Title   : determine_cladogram
241 Usage   : $tree->determine_cladogram();
242 Function: Determine if a tree is a cladogram or not (that is, whether branch lengths are present)
243 Returns : none
244 Args    : none
245
246=cut
247
248sub determine_cladogram {
249    my $self = shift;
250    my $root = $self->get_rootnode();
251    if ( $root->find_lengths() ) {
252        $self->{'is_cladogram'} = 0;
253    }
254    else {
255        $self->{'is_cladogram'} = 1;
256    }
257}
258
259=head2 set_output_format
260
261 Title   : set_output_format
262 Usage   : $tree->set_output_format('STD');
263 Function: Sets the output format for the Tree, (options : STD or NHX)
264 Returns : none
265 Args    : string: 'STD' or 'NHX'
266
267=cut
268
269sub set_output_format {
270    my ( $self, $format ) = @_;
271    $self->{'_out_format'} = $format;
272}
273
274=head2 get_output_format
275
276 Title   : get_output_format
277 Usage   : $output_format = $tree->get_output_format();
278 Function: Returns the output format for the Tree, (options : STD or NHX)
279 Returns : string: 'STD' or 'NHX'
280 Args    : none
281
282=cut
283
284sub get_output_format {
285    my ($self) = @_;
286    if ( defined $self->{_out_format} ) {
287        return $self->{_out_format};
288    }
289    else {
290        my $format = 'STD';
291        my $nodes  = $self->get_nodes();
292        my @otus;
293        for my $node ( @{$nodes} ) {
294            if ( $node->{is_nhx} ) {
295                $format = 'NHX';
296                last;
297            }
298        }
299        $self->{_out_format} = $format;
300    }
301    return $self->{_out_format};
302}
303
304=head2 is_cladogram
305
306 Title   : is_cladogram
307 Usage   : &dothis() if $tree->is_cladogram();
308 Function: Returns whether tree is a cladogram or not
309 Returns : 0 (no) or 1 (yes)
310 Args    : none
311
312=cut
313
314sub is_cladogram {
315    my $self = shift;
316    return $self->{'is_cladogram'};
317}
318
319=head2 as_string
320
321 Title   : as_string
322 Usage   : $treestring = $tree->as_string();
323 Function: Returns the tree as a string
324 Returns : tree string (string)
325 Args    : none
326
327=cut
328
329sub as_string {
330    my $self = shift;
331    my $root = $self->get_rootnode();
332    my $string;
333    $root->to_string( \$string, 0, $self->get_output_format );
334    $string =~ s/\,$/\;/;
335    return $string;
336}
337
338=head2 as_string_inodes_nameless
339
340 Title   : as_string_inodes_nameless
341 Usage   : $treestring = $tree->as_string_inodes_nameless();
342 Function: Returns the tree as a string without internal node names
343 Returns : tree string (string)
344 Args    : none
345
346=cut
347
348sub as_string_inodes_nameless {
349    my $self = shift;
350    my $root = $self->get_rootnode();
351    my $string;
352    $root->to_string( \$string, 1, $self->get_output_format );
353    $string =~ s/\,$/\;/;
354    return $string;
355}
356
357=head2 get_nodes
358
359 Title   : get_nodes
360 Usage   : @nodes = @{$tree->get_nodes()};
361 Function: Returns the list of ALL nodes in the tree
362 Returns : reference to array of nodes (Bio::NEXUS::Node objects)
363 Args    : none
364
365=cut
366
367sub get_nodes {
368    my $self = shift;
369    my $root = $self->get_rootnode();
370    my @nodes;
371    my $i = 1;
372    $root->walk( \@nodes, \$i );
373    $root->set_name('root')
374        if !$root->get_name() || $root->get_name() =~ /^inode1/;
375    return \@nodes;
376}
377
378=head2 get_node_names
379
380 Title   : get_node_names
381 Usage   : @otu_names = @{$tree->get_node_names()};
382 Function: Returns the list of names of otus (terminal nodes)
383 Returns : array ref of node names
384 Args    : none
385
386=cut
387
388sub get_node_names {
389    my $self  = shift;
390    my $nodes = $self->get_nodes();
391    my @otus;
392    for my $node ( @{$nodes} ) {
393        if ( $node->is_otu() ) {
394            push @otus, $node->get_name();
395        }
396    }
397    return \@otus;
398}
399
400=head2 get_distances
401
402 Title   : get_distances
403 Usage   : %distances = %{$tree->get_distances()};
404 Function: Finds the distances from the root node for all OTUs
405 Returns : reference to a hash of OTU names as keys and distances as values
406 Args    : none
407
408=cut
409
410sub get_distances {
411    my $self  = shift;
412    my $nodes = $self->get_nodes();
413    my $root  = $self->get_rootnode();
414    my %distances;
415    for my $node ( @{$nodes} ) {
416        $distances{ $node->get_name() } = $root->get_distance($node);
417    }
418    return \%distances;
419}
420
421=head2 get_tree_length
422
423 Title   : get_tree_length
424 Usage   : $tre_length  = $self->get_tree_length;
425 Function: Gets the total branch lengths in the tree.
426 Returns : total branch length
427 Args    : none
428
429=cut
430
431sub get_tree_length {
432    my $self = shift;
433    my $root = $self->get_rootnode();
434    return $root->get_total_length();
435}
436
437=head2 get_support_values
438
439 Title   : get_support_values
440 Usage   : %bootstraps = %{$tree->get_support_values()};
441 Function: Finds all branch support values for all OTUs
442 Returns : reference to a hash where OTU names are keys and branch support values are values
443 Args    : none
444
445=cut
446
447sub get_support_values {
448    my $self  = shift;
449    my $nodes = $self->get_nodes();
450    my %bootstraps;
451    for my $node ( @{$nodes} ) {
452        my $boot = $node->get_support_value();
453        $bootstraps{ $node->get_name() } = $boot if $boot;
454    }
455    return \%bootstraps;
456}
457
458=begin comment
459
460 Title   : _set_xcoord
461 Usage   : $tree->_set_xcoord($xpos,$maxx);
462 Function: Determines x coords of OTUs and internal nodes
463 Returns : none
464 Args    : maximum x (number)
465
466=end comment
467
468=cut
469
470sub _set_xcoord {
471    my ( $self, $maxx, $cladogramMethod ) = @_;
472    my $xcoord =
473        [ { 'node' => '', 'xcoord' => '' }, { 'node' => '', 'xcoord' => '' } ];
474    my $root  = $self->get_rootnode();
475    my @nodes = @{ $self->get_nodes() };
476    if ( $self->is_cladogram() || $cladogramMethod ) {
477        $cladogramMethod = 'normal' unless $cladogramMethod;
478        my $maxdepth = $self->max_depth();
479        my $unit     = $maxx / $maxdepth;
480        my @xcoord;
481        if ( $cladogramMethod eq "accelerated" ) {
482            for my $node (@nodes) {
483                if ( $node->is_otu() ) {
484                    $node->_set_xcoord( $maxdepth * $unit );
485                }
486                else {
487                    $node->_set_xcoord( $node->get_depth() * $unit );
488                }
489            }
490        }
491        elsif ( $cladogramMethod eq "normal" ) {
492            my %depth = %{ $self->get_depth() };
493            for my $node (@nodes) {
494                $node->_set_xcoord( $node->get_depth() * $unit );
495            }
496        }
497    }
498    else {
499        for my $node (@nodes) {
500            $node->_set_xcoord( $root->get_distance($node) );
501        }
502    }
503}
504
505=begin comment
506
507 Title   : _set_ycoord
508 Usage   : $tree->_set_ycoord($ypos,$spacing);
509 Function: Determines y coords of OTUs and internal nodes
510 Returns : none
511 Args    : initial y position (number), space between OTUs (number)
512
513=end comment
514
515=cut
516
517sub _set_ycoord {
518    my ( $self, $ypos, $spacing ) = @_;
519    my $root = $self->get_rootnode();
520    $root->_assign_otu_ycoord( \$ypos, \$spacing );
521    $root->_assign_inode_ycoord();
522}
523
524=head2 set_depth
525
526 Title   : set_depth
527 Usage   : $tree->set_depth();
528 Function: Sets depth of root node
529 Returns : none
530 Args    : none
531
532=cut
533
534sub set_depth {
535    my $self = shift;
536    my $root = $self->get_rootnode();
537    $root->set_depth(0);
538}
539
540=head2 get_depth
541
542 Title   : get_depth
543 Usage   : %depth=%{$tree->get_depth()};
544 Function: Get depth in tree of all OTUs and internal nodes
545 Returns : reference to hash with keys = node names and values = depth
546 Args    : none
547
548=cut
549
550sub get_depth {
551    my $self  = shift;
552    my $nodes = $self->get_nodes();
553    my %depth;
554    for my $node ( @{$nodes} ) {
555        my $d = $node->get_depth();
556        $depth{ $node->get_name() } = $d if ( $d || ( $d == 0 ) );
557    }
558    return \%depth;
559}
560
561=head2 max_depth
562
563 Title   : max_depth
564 Usage   : $maxdepth=%{$tree->max_depth()};
565 Function: Get maximum depth of tree
566 Returns : integer indicating maximum depth
567 Args    : none
568
569=cut
570
571sub max_depth {
572    my $self   = shift;
573    my %depth  = %{ $self->get_depth() };
574    my @sorted = sort { $a <=> $b } values %depth;
575    return ( pop @sorted );
576}
577
578=head2 find
579
580 Title   : find
581 Usage   : $node = $tree->find($name);
582 Function: Finds the first occurrence of a node called 'name' in the tree
583 Returns : Bio::NEXUS::Node object
584 Args    : name (string)
585
586=cut
587
588sub find {
589    my ( $self, $name ) = @_;
590    my $rootnode = $self->get_rootnode();
591    my $node     = $rootnode->find($name);
592    return $node;
593}
594
595=head2 find_all
596
597 Title   : find_all
598 Usage   : @nodes = @{ $tree->find_all($name) };
599 Function: find all occurrences of nodes called 'name' in the tree
600 Returns : Bio::NEXUS::Node objects
601 Args    : name (string)
602
603=cut
604
605sub find_all {
606    my $self = shift;
607    my @nodes;
608    my @all_nodes = @{ $self->get_nodes() };
609    my $name      = shift;
610    for my $node (@all_nodes) {
611        if ( $name eq $node->get_name() ) {
612            push( @nodes, $node );
613        }
614    }
615    return \@nodes;
616}
617
618=head2 prune
619
620 Name    : prune
621 Usage   : $tree->prune($OTUlist);
622 Function: Removes everything from the tree except for OTUs specified in $OTUlist
623 Returns : none
624 Args    : list of OTUs (string)
625
626=cut
627
628sub prune {
629    my ( $self, $OTUlist ) = @_;
630    $OTUlist = ' ' . $OTUlist . ' ';
631    my $rootnode = $self->get_rootnode();
632    $rootnode->prune($OTUlist);
633}
634
635=head2 equals
636
637 Name    : equals
638 Usage   : $tree->equals($another_tree);
639 Function: compare if two trees are equivalent in topology
640 Returns : 1 if equal or 0 if not
641 Args    : another Bio::NEXUS::Tree object
642
643=cut
644
645sub equals {
646    my ( $self, $tree ) = @_;
647
648    if ( $self->get_name() ne $tree->get_name() ) { return 0; }
649    return $self->get_rootnode()->equals( $tree->get_rootnode() );
650}
651
652sub _equals_test {
653    my ( $self, $tree ) = @_;
654
655    if ( $self->get_name() ne $tree->get_name() ) { return 0; }
656    return $self->get_rootnode()->_equals_test( $tree->get_rootnode() );
657}
658
659=head2 reroot
660
661 Name    : reroot
662 Usage   : $tree = $tree->reroot($outgroup_name);
663 Function: re-root a tree with a node as outgroup
664 Returns :
665 Args    : the node name to be used as new outgroup
666
667=cut
668
669sub reroot {
670    my ( $self, $outgroup_name, $dist_back_to_newroot ) = @_;
671    if ( not defined $outgroup_name ) {
672    	Bio::NEXUS::Util::Exceptions::BadArgs->throw(
673    		'error' => 'An outgroup name must be supplied as an argument in order to reroot'
674    	);
675    }
676
677    my $tree = $self->clone();
678
679    # find the current root of the tree
680    my $oldroot = $tree->get_rootnode();
681
682    # rename it, since nexplot relies on all nodes having unique names
683    &_rename_oldroot( $tree, $oldroot );
684
685    # get the outgroup node
686    my $outgroup = $tree->find($outgroup_name);
687
688    # create & name a new node that will become the new root
689    my $newroot = new Bio::NEXUS::Node();
690
691    if (   $dist_back_to_newroot
692        && $dist_back_to_newroot == $outgroup->get_length() )
693    {
694        $newroot = $outgroup->get_parent();
695        $outgroup->set_length($dist_back_to_newroot);
696        $newroot->get_parent()->_rearrange($newroot);
697    }
698    else {
699
700        # find the node that will (temporarily) become the newroot's parent
701        my $outgroup_old_parent = $outgroup->get_parent();
702
703        # get the siblings of the outgroup
704        my $newroot_siblings = $outgroup->get_siblings();
705
706        # get the correct branch lengths for newroot and outgroup
707        &_position_newroot( $outgroup, $newroot, $dist_back_to_newroot );
708
709        # make outgroup the newroot's child and newroot the outgroup's parent
710        $newroot->adopt( $outgroup, 1 );
711
712        # remove the outgroup from the old parent's children
713        $outgroup_old_parent->set_children($newroot_siblings);
714
715        # add the newroot as a child
716        $outgroup_old_parent->adopt( $newroot, 0 );
717
718# recursively reverse the parent-child relationships between newroot and oldroot
719        $outgroup_old_parent->_rearrange($newroot);
720    }
721
722    # set newroot's values to make it root
723    $newroot->set_name('root');
724    $newroot->set_parent_node();
725    $newroot->set_support_value();
726    $newroot->set_length();
727    $newroot->set_depth(0);
728    $tree->set_rootnode($newroot);
729
730    # remove oldroot if the tree was bifurcating
731    &_remove_oldroot_if_superfluous($oldroot);
732
733    return $tree;
734}
735
736sub _rename_oldroot {
737    my ( $tree, $oldroot ) = @_;
738    my $i               = 0;
739    my $renamed_oldroot = 0;
740    my $oldroot_name    = 'oldroot';
741    while ( $renamed_oldroot == 0 ) {
742        if ( !$tree->find("$oldroot_name") ) {
743            $oldroot->set_name("$oldroot_name");
744            $renamed_oldroot = 1;
745        }
746        else {
747            $oldroot_name = "oldroot" . "$i";
748            $i++;
749        }
750    }
751}
752
753sub _position_newroot {
754    my ( $outgroup, $newroot, $dist_back_to_newroot ) = @_;
755    if ( $outgroup->get_length() ) {
756        my $outgroup_length = $outgroup->get_length();
757        if ($dist_back_to_newroot) {
758            if (   $dist_back_to_newroot < $outgroup_length
759                && $dist_back_to_newroot > 0 )
760            {
761                ## $dist_back_to_newroot should already be negative
762                $newroot->set_length(
763                    $outgroup_length - $dist_back_to_newroot );
764                $outgroup->set_length($dist_back_to_newroot);
765            }
766            else {
767                Bio::NEXUS::Util::Exceptions::BadNumber->throw(
768                	'error' => "Branch length error: The new root's position\n"
769                			. "up the tree from the outgroup must be a positive\n"
770                			. "number less than or equal to the outgroup's branch length.\n"
771                );
772            }
773        }
774        else {
775            $newroot->set_length( $outgroup_length / 2 );
776            $outgroup->set_length( $outgroup_length / 2 );
777        }
778    }
779    else {
780        if ($dist_back_to_newroot) {
781        	Bio::NEXUS::Util::Exceptions::BadArgs->throw(
782        		'error' => "You provided a position for the new root on the\n"
783        				. "outgroup's branch length, but the outgroup does\n"
784        				. "not have a branch length.\n"
785        	);
786        }
787    }
788}
789
790sub _remove_oldroot_if_superfluous {
791    my ($oldroot) = @_;
792    if ( @{ $oldroot->get_children() } == 1 ) {
793        my $oldroot_child = ${ $oldroot->get_children() }[0];
794        if (   defined $oldroot->get_length()
795            || defined $oldroot_child->get_length() )
796        {
797            $oldroot_child->set_length(
798                $oldroot->get_length() + $oldroot_child->get_length() );
799        }
800        my $oldroot_parent = $oldroot->get_parent();
801        $oldroot_parent->set_children( $oldroot->get_siblings() );
802        $oldroot_parent->adopt( $oldroot_child, 0 );
803    }
804}
805
806=head2 select_subtree
807
808 Name    : select_subtree
809 Usage   : $new_tree_obj = $self->select_subtree($node_name);
810 Function: selects the subtree (the given node and all its children) from the tree object.
811 Returns : new Bio::NEXUS::Tree object
812 Args    : Node name
813
814=cut
815
816sub select_subtree {
817    my ( $self, $nodename ) = @_;
818    my $newroot  = $self->find($nodename);
819    my $treename = $self->get_name();
820    if ( not $newroot ) {
821    	Bio::NEXUS::Util::Exceptions::BadArgs->throw(
822    		'error' => "Node $nodename not found in $treename"
823    	);
824    }
825    $newroot = $newroot->clone();    # need to clone subtree
826    $newroot->set_parent_node();     # make it as root
827    $newroot->set_support_value();
828    $newroot->set_length();
829    my $tree = new Bio::NEXUS::Tree();
830    $tree->set_name( $self->get_name() );
831    $tree->set_rootnode($newroot);
832    return $tree;
833}
834
835=head2 exclude_subtree
836
837 Name    : exclude_subtree
838 Usage   : $new_tree_obj = $self->exclude_subtree($node_name);
839 Function: removes the given node and all its children from the tree object.
840 Returns : new Bio::NEXUS::Tree object
841 Args    : Node name
842
843=cut
844
845sub exclude_subtree {
846    my ( $self, $nodename ) = @_;
847    my $treename   = $self->get_name();
848    my $tree       = $self->clone();
849    my $removenode = $tree->find($nodename);
850
851    if ( not $removenode ) {
852    	Bio::NEXUS::Util::Exceptions::BadArgs->throw(
853    		'error' => "Node $nodename not found in $treename"
854    	);
855    }
856
857    my $parent   = $removenode->get_parent();
858    my @children = @{ $parent->get_children() };
859    $parent->set_children();
860    for my $child (@children) {
861        if ( $child->get_name() ne $removenode->get_name() ) {
862            $parent->add_child($child);
863        }
864    }
865    if ( @{ $parent->get_children() } == 1 ) {
866        my $sibling = $parent->get_children()->[0];
867        $parent->combine($sibling);
868    }
869
870    return $tree;
871}
872
873=head2 get_mrca_of_otus
874
875 Name    : get_mrca_of_otus
876 Usage   : $node = $self->get_mrca_of_otus($otus);
877 Function: gets the most recent common ancestor for the input $otus
878 Returns : Bio::NEXUS::Node object
879 Args    : $otus : Array reference of the OTUs
880
881=cut
882
883sub get_mrca_of_otus {
884    my ( $self, $otus) = @_;
885    my $root_node = $self->get_rootnode;
886   return $root_node->get_mrca_of_otus($otus);
887}
888
889sub AUTOLOAD {
890    return if $AUTOLOAD =~ /DESTROY$/;
891    my $package_name = __PACKAGE__ . '::';
892
893    # The following methods are deprecated and are temporarily supported
894    # via a warning and a redirection
895    my %synonym_for = (
896        "${package_name}node_list"  => "${package_name}get_nodes",
897        "${package_name}otu_list"   => "${package_name}get_node_names",
898        "${package_name}set_xcoord" => "${package_name}_set_xcoord",
899        "${package_name}set_ycoord" => "${package_name}_set_ycoord",
900        "${package_name}name"       => "${package_name}get_name",
901        "${package_name}set_tree"   => "${package_name}_parse_newick",
902    );
903
904    if ( defined $synonym_for{$AUTOLOAD} ) {
905        $logger->warn("$AUTOLOAD() is deprecated; use $synonym_for{$AUTOLOAD}() instead");
906        goto &{ $synonym_for{$AUTOLOAD} };
907    }
908    else {
909        Bio::NEXUS::Util::Exceptions::UnknownMethod->throw(
910        	'error' => "ERROR: Unknown method $AUTOLOAD called"
911        );
912    }
913    return;
914}
915
9161;
917