view release on metacpan or  search on metacpan

lib/Bio/Phylo/Forest/Tree.pm  view on Meta::CPAN

 # prints "1"

=head1 DESCRIPTION

The package has the getters and setters that alter the
internal state of a tree object. Additional tree-related
behaviours (which are available also) are defined in the
package L<Bio::Phylo::Forest::TreeRole>.

=head1 METHODS

=head2 MUTATORS

=over

=item set_as_unrooted()

Sets tree to be interpreted as unrooted.

 Type    : Mutator
 Title   : set_as_unrooted
 Usage   : $tree->set_as_unrooted;
 Function: Sets tree to be interpreted as unrooted.
 Returns : $tree
 Args    : NONE
 Comments: This is a flag to indicate that the invocant
           is interpreted to be unrooted (regardless of
           topology). The object is otherwise unaltered,
           this method is only here to capture things such
           as the [&U] token in nexus files.

=cut

    sub set_as_unrooted {
        my $self = shift;
        $rooted{ $self->get_id } = 1;
        return $self;
    }

=item set_as_default()

Sets tree to be the default tree in a forest

 Type    : Mutator
 Title   : set_as_default
 Usage   : $tree->set_as_default;
 Function: Sets tree to be default tree in forest
 Returns : $tree
 Args    : NONE
 Comments: This is a flag to indicate that the invocant
           is the default tree in a forest, i.e. to
           capture the '*' token in nexus files.

=cut

    sub set_as_default {
        my $self = shift;
        if ( my $forest = $self->_get_container ) {
            if ( my $tree = $forest->get_default_tree ) {
                $tree->set_not_default;
            }
        }
        $default{ $self->get_id } = 1;
        return $self;
    }

=item set_not_default()

Sets tree to NOT be the default tree in a forest

 Type    : Mutator
 Title   : set_not_default
 Usage   : $tree->set_not_default;
 Function: Sets tree to not be default tree in forest
 Returns : $tree
 Args    : NONE
 Comments: This is a flag to indicate that the invocant
           is the default tree in a forest, i.e. to
           capture the '*' token in nexus files.

=cut

    sub set_not_default {
        my $self = shift;
        $default{ $self->get_id } = 0;
        return $self;
    }

=back

=head2 TESTS

=over

=item is_default()

Test if tree is default tree.

 Type    : Test
 Title   : is_default
 Usage   : if ( $tree->is_default ) {
              # do something
           }
 Function: Tests whether the invocant 
           object is the default tree in the forest.
 Returns : BOOLEAN
 Args    : NONE

=cut

    sub is_default {
        my $self = shift;
        return !!$default{ $self->get_id };
    }

=item is_rooted()

Test if tree is rooted.

 Type    : Test
 Title   : is_rooted
 Usage   : if ( $tree->is_rooted ) {
              # do something
           }
 Function: Tests whether the invocant 
           object is rooted.
 Returns : BOOLEAN
 Args    : NONE
 Comments: A tree is considered unrooted if:
           - set_as_unrooted has been set, or
           - the basal split is a polytomy

=cut

    sub is_rooted {
        my $self = shift;
        my $id   = $self->get_id;
        if ( defined $rooted{$id} ) {
            return ! $rooted{$id};
        }
        if ( my $root = $self->get_root ) {
            if ( my $children = $root->get_children ) {
                return scalar @{$children} <= 2;