view release on metacpan or  search on metacpan

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

package Bio::Phylo::Forest::Node;
use strict;
use warnings;
use Bio::Phylo::Forest::DrawNodeRole;
use base qw'Bio::Phylo::Forest::DrawNodeRole';
use Bio::Phylo::Util::CONSTANT qw':objecttypes /looks_like/';
use Bio::Phylo::Util::Exceptions 'throw';
use Scalar::Util 'weaken';

# store type constant
my ( $TYPE_CONSTANT, $CONTAINER_CONSTANT ) = ( _NODE_, _TREE_ );

{    

    # @fields array necessary for object destruction
    my @fields = \( my ( %branch_length, %parent, %tree, %rank ) );

=head1 NAME

Bio::Phylo::Forest::Node - Node in a phylogenetic tree

=head1 SYNOPSIS

 # some way to get nodes:
 use Bio::Phylo::IO;
 my $string = '((A,B),C);';
 my $forest = Bio::Phylo::IO->parse(
    -format => 'newick',
    -string => $string
 );

 # prints 'Bio::Phylo::Forest'
 print ref $forest;

 foreach my $tree ( @{ $forest->get_entities } ) {

    # prints 'Bio::Phylo::Forest::Tree'
    print ref $tree;

    foreach my $node ( @{ $tree->get_entities } ) {

       # prints 'Bio::Phylo::Forest::Node'
       print ref $node;

       # node has a parent, i.e. is not root
       if ( $node->get_parent ) {
          $node->set_branch_length(1);
       }

       # node is root
       else {
          $node->set_branch_length(0);
       }
    }
 }

=head1 DESCRIPTION

This module has the getters and setters that alter the state of a 
node object. Useful behaviours (which are also available) are defined
in the L<Bio::Phylo::Forest::NodeRole> package.

=head1 METHODS

=cut

    my $set_raw_parent = sub {
        my ( $self, $parent ) = @_;
        my $id = $self->get_id;
        $parent{$id} = $parent;    # XXX here we modify parent
        weaken $parent{$id} if $parent;
    };
    my $get_parent = sub {
        my $self = shift;
        return $parent{ $self->get_id };
    };
    my $get_children = sub { shift->get_entities };
    my $get_branch_length = sub {
        my $self = shift;
        return $branch_length{ $self->get_id };
    };
    my $set_raw_child = sub {
        my ( $self, $child, $i ) = @_;
        $i = $self->last_index + 1 if not defined $i or $i == -1;
        $self->insert_at_index( $child, $i );    # XXX here we modify children
    };    

=over

=item set_parent()

Sets argument as invocant's parent.

 Type    : Mutator
 Title   : set_parent
 Usage   : $node->set_parent($parent);
 Function: Assigns a node's parent.
 Returns : Modified object.
 Args    : If no argument is given, the current
           parent is set to undefined. A valid
           argument is Bio::Phylo::Forest::Node
           object.

=cut

    sub set_parent : Clonable {
        my ( $self, $parent ) = @_;
        if ( $parent and looks_like_object $parent, $TYPE_CONSTANT ) {
            $parent->set_child($self);
        }
        elsif ( not $parent ) {
            $self->set_raw_parent;
        }
        return $self;
    }

=item set_raw_parent()

Sets argument as invocant's parent. This method does NO 
sanity checks on the rest of the topology. Use with caution.

 Type    : Mutator
 Title   : set_raw_parent
 Usage   : $node->set_raw_parent($parent);
 Function: Assigns a node's parent.
 Returns : Modified object.
 Args    : If no argument is given, the current
           parent is set to undefined. A valid
           argument is Bio::Phylo::Forest::Node
           object.

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

	sub set_raw_child {
		$set_raw_child->(@_);
	}
    
=item set_branch_length()

Sets argument as invocant's branch length.

 Type    : Mutator
 Title   : set_branch_length
 Usage   : $node->set_branch_length(0.423e+2);
 Function: Assigns a node's branch length.
 Returns : Modified object.
 Args    : If no argument is given, the
           current branch length is set
           to undefined. A valid argument
           is a number in any of Perl's formats.

=cut

    sub set_branch_length : Clonable {
        my ( $self, $bl ) = @_;
        my $id = $self->get_id;
        if ( defined $bl && looks_like_number $bl && !ref $bl ) {
            $branch_length{$id} = $bl;
			if ( $bl < 0 ) {
				$self->get_logger->warn("Setting length < 0: $bl");
			}
        }
        elsif ( defined $bl && ( !looks_like_number $bl || ref $bl ) ) {
            throw 'BadNumber' => "Branch length \"$bl\" is a bad number";
        }
        elsif ( !defined $bl ) {
            $branch_length{$id} = undef;
        }
        return $self;
    }

=item set_tree()

Sets what tree invocant belongs to

 Type    : Mutator
 Title   : set_tree
 Usage   : $node->set_tree($tree);
 Function: Sets what tree invocant belongs to
 Returns : Invocant
 Args    : Bio::Phylo::Forest::Tree
 Comments: This method is called automatically 
           when inserting or deleting nodes in
           trees.

=cut

    sub set_tree : Clonable {
        my ( $self, $tree ) = @_;
        my $id = $self->get_id;
        if ($tree) {
            if ( looks_like_object $tree, $CONTAINER_CONSTANT ) {
                $tree{$id} = $tree;
                weaken $tree{$id};
            }
            else {
                throw 'ObjectMismatch' => "$tree is not a tree";
            }
        }
        else {
            $tree{$id} = undef;
        }
        return $self;
    }

=item set_rank()

Sets the taxonomic rank of the node

 Type    : Mutator
 Title   : set_rank
 Usage   : $node->set_rank('genus');
 Function: Sets the taxonomic rank of the node
 Returns : Invocant
 Args    : String
 Comments: Free-form, but highly recommended to use same rank names as in Bio::Taxon

=cut

    
    sub set_rank : Clonable {
    	my ( $self, $rank ) = @_;
    	$rank{$self->get_id} = $rank;
    	return $self;
    }

=item get_parent()

Gets invocant's parent.

 Type    : Accessor
 Title   : get_parent
 Usage   : my $parent = $node->get_parent;
 Function: Retrieves a node's parent.
 Returns : Bio::Phylo::Forest::Node
 Args    : NONE

=cut

    sub get_parent { return $get_parent->(shift) }    

=item get_branch_length()

Gets invocant's branch length.

 Type    : Accessor
 Title   : get_branch_length
 Usage   : my $branch_length = $node->get_branch_length;
 Function: Retrieves a node's branch length.
 Returns : FLOAT
 Args    : NONE
 Comments: Test for "defined($node->get_branch_length)"
           for zero-length (but defined) branches. Testing
           "if ( $node->get_branch_length ) { ... }"