Bio::Tree RandomFactory
SummaryIncluded librariesPackage variablesSynopsisDescriptionGeneral documentationMethods
Toolbar
WebCvsRaw content
Summary
Bio::Tree::RandomFactory - TreeFactory for generating Random Trees
Package variables
No package variables defined.
Included modules
Bio::Factory::TreeFactoryI
Bio::Root::Root
Bio::Tree::AlleleNode
Bio::TreeIO::TreeEventBuilder
Inherit
Bio::Factory::TreeFactoryI Bio::Root::Root
Synopsis
  use Bio::Tree::RandomFactory
my $factory = new Bio::Tree::RandomFactory( -samples => \@taxonnames,
-maxcount => 10);
# or for anonymous samples my $factory = new Bio::Tree::RandomFactory( -sample_size => 6, -maxcount = 50);
Description
Builds a random tree every time next_tree is called or up to -maxcount times.
This algorithm is based on the make_tree algorithm from Richard Hudson 1990.
Hudson, R. R. 1990. Gene genealogies and the coalescent
process. Pp. 1-44 in D. Futuyma and J. Antonovics, eds. Oxford
surveys in evolutionary biology. Vol. 7. Oxford University
Press, New York
Methods
BEGIN Code
_eventHandlerDescriptionCode
add_MutationsDescriptionCode
attach_EventHandlerDescriptionCode
maxcountDescriptionCode
newDescriptionCode
next_treeDescriptionCode
randomDescriptionCode
sample_sizeDescriptionCode
samplesDescriptionCode
Methods description
_eventHandlercode    nextTop
 Title   : _eventHandler
Usage : private
Function: Get the EventHandler
Returns : Bio::Event::EventHandlerI
Args : none
add_MutationscodeprevnextTop
 Title   : add_Mutations
Usage : $factory->add_Mutations($tree, $mutcount);
Function: Adds mutations to a tree via a random process weighted by
branch length (it is a poisson distribution
as part of a coalescent process)
Returns : none
Args : $tree - Bio::Tree::TreeI
$nummut - number of mutations
attach_EventHandlercodeprevnextTop
 Title   : attach_EventHandler
Usage : $parser->attatch_EventHandler($handler)
Function: Adds an event handler to listen for events
Returns : none
Args : Bio::Event::EventHandlerI
maxcountcodeprevnextTop
 Title   : maxcount
Usage : $obj->maxcount($newval)
Function:
Example :
Returns : value of maxcount
Args : newvalue (optional)
newcodeprevnextTop
 Title   : new
Usage : my $factory = new Bio::Tree::RandomFactory(-samples => \@samples,
-maxcount=> $N);
Function: Initializes a Bio::Tree::RandomFactory object
Returns : Bio::Tree::RandomFactory
Args :
next_treecodeprevnextTop
 Title   : next_tree
Usage : my $tree = $factory->next_tree
Function: Returns a random tree based on the initialized number of nodes
NOTE: if maxcount is not specified on initialization or
set to a valid integer, subsequent calls to next_tree will
continue to return random trees and never return undef
Returns : Bio::Tree::TreeI object Args : none
randomcodeprevnextTop
 Title   : random
Usage : my $rfloat = $node->random($size)
Function: Generates a random number between 0 and $size
This is abstracted so that someone can override and provide their
own special RNG. This is expected to be a uniform RNG.
Returns : Floating point random
Args : $maximum size for random number (defaults to 1)
sample_sizecodeprevnextTop
 Title   : sample_size
Usage : $obj->sample_size($newval)
Function:
Example :
Returns : value of sample_size
Args : newvalue (optional)
samplescodeprevnextTop
 Title   : samples
Usage : $obj->samples($newval)
Function:
Example :
Returns : value of samples
Args : newvalue (optional)
Methods code
BEGINTop
BEGIN {
     $PRECISION_DIGITS = 3; # Precision for the branchlength
}
_eventHandlerdescriptionprevnextTop
sub _eventHandler {
   my ($self) = @_;
   return $self->{'_handler'};
}
add_MutationsdescriptionprevnextTop
sub add_Mutations {
   my ($self,$tree, $nummut) = @_;
   my @branches;
   my @lens;
   my $branchlen = 0;
   my $last = 0;
   my @nodes = $tree->get_nodes();
   my $precision = 10**$PRECISION_DIGITS;
   my $i = 0;

   # Jason's somewhat simplistics way of doing a poission
# distribution for a fixed number of mutations
# build an array and put the node number in a slot
# representing the branch to put a mutation on
# but weight the number of slots per branch by the
# length of the branch ( ancestor's time - node time)
foreach my $node ( @nodes ) { if( $node->ancestor ) { my $len = int ( ($node->ancestor->branch_length - $node->branch_length) * $precision); if ( $len > 0 ) { for( my $j =0;$j < $len;$j++) { push @branches, $i; } $last += $len; } $branchlen += $len; } if( ! $node->isa('Bio::Tree::AlleleNode') ) { bless $node, 'Bio::Tree::AlleleNode'; # rebless it to the right node
} $node->purge_markers; $i++; } # sanity check
die("branch len is $branchlen arraylen is $last") unless ( $branchlen == $last ); for( my $j = 0; $j < $nummut; $j++) { my $index = int(rand($branchlen)); my $branch = $branches[$index]; $nodes[$branch]->add_alleles("Mutation$j", [1]); }
}
attach_EventHandlerdescriptionprevnextTop
sub attach_EventHandler {
    my ($self,$handler) = @_;
    return if( ! $handler );
    if( ! $handler->isa('Bio::Event::EventHandlerI') ) {
	$self->warn("Ignoring request to attatch handler ".ref($handler). ' because it is not a Bio::Event::EventHandlerI');
    }
    $self->{'_handler'} = $handler;
    return;
}
maxcountdescriptionprevnextTop
sub maxcount {
   my ($self,$value) = @_;
   if( defined $value) {
       if( $value =~ /^(\d+)/ ) { 
	   $self->{'maxcount'} = $1;
       } else { 
	   $self->warn("Must specify a valid Positive integer to maxcount");
	   $self->{'maxcount'} = 0;
       }
  }
   return $self->{'_maxcount'};
}
newdescriptionprevnextTop
sub new {
   my ($class,@args) = @_;
   my $self = $class->SUPER::new(@args);
   
   $self->{'_eventbuilder'} = new Bio::TreeIO::TreeEventBuilder();
   $self->{'_treecounter'} = 0;
   $self->{'_maxcount'} = 0;
   my ($maxcount, $samps,$samplesize ) = $self->_rearrange([qw(MAXCOUNT
							       SAMPLES
							       SAMPLE_SIZE)],
							   @args);
   my @samples;
   
   if( ! defined $samps ) { 
       if( ! defined $samplesize || $samplesize <= 0 ) { 
	   $self->throw("Must specify a valid samplesize if parameter -SAMPLE is not specified");
       }
       foreach ( 1..$samplesize ) { push @samples, "Samp$_"; }      
   } else { 
       if( ref($samps) =~ /ARRAY/i ) { 
	   $self->throw("Must specify a valid ARRAY reference to the parameter -SAMPLES, did you forget a leading '\\'?");
       }
       @samples = @$samps;
   }
   
   $self->samples(\@samples);
   $self->sample_size(scalar @samples);
   if( defined $maxcount ) { 
       $self->maxcount($maxcount);
   }
   return $self;
}
next_treedescriptionprevnextTop
sub next_tree {
   my ($self) = @_;
   # If maxcount is set to something non-zero then next tree will
# continue to return valid trees until maxcount is reached
# otherwise will always return trees
return undef if( $self->maxcount && $self->{'_treecounter'}++ >= $self->maxcount ); my $size = $self->sample_size; my $in; my @tree = (); my @list = (); for($in=0;$in < 2*$size -1; $in++ ) { push @tree, { 'nodenum' => "Node$in" }; } # in C we would have 2 arrays
# an array of nodes (tree)
# and array of pointers to these nodes (list)
# and we just shuffle the list items to do the
# tree topology generation
# instead in perl, we will have a list of hashes (nodes) called @tree
# and a list of integers representing the indexes in tree called @list
for($in=0;$in < $size;$in++) { $tree[$in]->{'time'} = 0; $tree[$in]->{'desc1'} = undef; $tree[$in]->{'desc2'} = undef; push @list, $in; } my $t=0; # generate times for the nodes
for($in = $size; $in > 1; $in-- ) { $t+= -2.0 * log(1 - $self->random(1)) / ( $in * ($in-1) );
$tree[2 * $size - $in]->{'time'} =$t; } # topology generation
for ($in = $size; $in > 1; $in-- ) { my $pick = int $self->random($in); my $nodeindex = $list[$pick]; my $swap = 2 * $size - $in; $tree[$swap]->{'desc1'} = $nodeindex; $list[$pick] = $list[$in-1]; $pick = int rand($in - 1); $nodeindex = $list[$pick]; $tree[$swap]->{'desc2'} = $nodeindex; $list[$pick] = $swap; } # Let's convert the hashes into nodes
my @nodes = (); foreach my $n ( @tree ) { push @nodes, new Bio::Tree::AlleleNode(-id => $n->{'nodenum'}, -branch_length => $n->{'time'}); } my $ct = 0; foreach my $node ( @nodes ) { my $n = $tree[$ct++]; if( defined $n->{'desc1'} ) { $node->add_Descendent($nodes[$n->{'desc1'}]); } if( defined $n->{'desc2'} ) { $node->add_Descendent($nodes[$n->{'desc2'}]); } } my $T = new Bio::Tree::Tree(-root => pop @nodes ); return $T;
}
randomdescriptionprevnextTop
sub random {
   my ($self,$max) = @_;
   return rand($max);
}

1;
}
sample_sizedescriptionprevnextTop
sub sample_size {
   my ($self,$value) = @_;
   if( defined $value) {
      $self->{'sample_size'} = $value;
    }
    return $self->{'sample_size'};
}
samplesdescriptionprevnextTop
sub samples {
   my ($self,$value) = @_;
   if( defined $value) {
       if( ref($value) !~ /ARRAY/i ) { 
	   $self->warn("Must specify a valid array ref to the method 'samples'");
	   $value = [];
       } 
      $self->{'samples'} = $value;
    }
    return $self->{'samples'};
}
General documentation
FEEDBACKTop
Mailing ListsTop
User feedback is an integral part of the evolution of this and other
Bioperl modules. Send your comments and suggestions preferably to
the Bioperl mailing list. Your participation is much appreciated.
  bioperl-l@bioperl.org              - General discussion
http://bioperl.org/MailList.shtml - About the mailing lists
Reporting BugsTop
Report bugs to the Bioperl bug tracking system to help us keep track
of the bugs and their resolution. Bug reports can be submitted via
the web:
  http://bugzilla.bioperl.org/
AUTHOR - Jason StajichTop
Email jason@bioperl.org
CONTRIBUTORSTop
Matthew Hahn, <matthew.hahn@duke.edu>
APPENDIXTop
The rest of the documentation details each of the object methods.
Internal methods are usually preceded with a _