Bio::PhyloNetwork::TreeFactoryX - Module to sequentially generate

BioPerl documentation Contained in the BioPerl distribution.

Index

Code Index:

NAME

Top

Bio::PhyloNetwork::TreeFactoryX - Module to sequentially generate Phylogenetic Trees

SYNOPSIS

Top

 use strict;
 use warnings;

 use Bio::PhyloNetwork;
 use Bio::PhyloNetwork::TreeFactory;

 # Will generate sequentially all the 15 binary phylogetic
 # trees with 4 leaves

 my $factory=Bio::PhyloNetwork::TreeFactory->new(-numleaves=>4);

 my @nets;

 while (my $net=$factory->next_network()) {
   push @nets,$net;
   print "".(scalar @nets).": ".$net->eNewick()."\n";
 }

DESCRIPTION

Top

Sequentially builds a (binary) phylogenetic tree each time next_network is called.

AUTHOR

Top

Gabriel Cardona, gabriel(dot)cardona(at)uib(dot)es

SEE ALSO

Top

Bio::PhyloNetwork

APPENDIX

Top

The rest of the documentation details each of the object methods.

new

 Title   : new
 Usage   : my $factory = new Bio::PhyloNetwork::TreeFactory();
 Function: Creates a new Bio::PhyloNetwork::TreeFactory
 Returns : Bio::PhyloNetwork::RandomFactory
 Args    : -numleaves => integer
            OR
           -leaves => reference to an array (of leaves names)

Returns a Bio::PhyloNetwork::TreeFactory object. Such an object will sequentially create binary phylogenetic trees each time next_network is called.

If the parameter -leaves=>\@leaves is given, then the set of leaves of these networks will be @leaves. If it is given the parameter -numleaves=>$numleaves, then the set of leaves will be "l1"..."l$numleaves".

next_network

 Title   : next_network
 Usage   : my $net=$factory->next_network()
 Function: returns a tree
 Returns : Bio::PhyloNetwork
 Args    : none
BioPerl documentation Contained in the BioPerl distribution. 
#
# Module for Bio::PhyloNetwork::TreeFactoryX
#
# Please direct questions and support issues to <bioperl-l@bioperl.org> 
#
# Cared for by Gabriel Cardona <gabriel(dot)cardona(at)uib(dot)es>
#
# Copyright Gabriel Cardona
#
# You may distribute this module under the same terms as perl itself

# POD documentation - main docs before the code


package Bio::PhyloNetwork::TreeFactoryX;

use strict;
use warnings;

use base qw(Bio::Root::Root);

use Bio::PhyloNetwork;


sub new {
  my ($pkg,@args)=@_;

  my $self=$pkg->SUPER::new(@args);

  my ($leavesR,$numleaves,$numhybrids)=
    $self->_rearrange([qw(LEAVES
			  NUMLEAVES
			  NUMHYBRIDS)],@args);

  my @leaves;
  if ((! defined $leavesR) && (defined $numleaves)) {
    @leaves=map {"l$_"} (1..$numleaves);
    $leavesR=\@leaves;
  }
  if (! defined $leavesR) {
    $self->throw("No leaves set neither numleaves given");
  }
  @leaves=@$leavesR;
  $self->{leaves}=$leavesR;

  $numleaves=@leaves;
  $self->{numleaves}=$numleaves;
  if ($numleaves > 2) {
    my @leavesparent=@leaves;
    my $newleaf=pop @leavesparent;
    $self->{newleaf}=$newleaf;
    $self->{parent}=
      new($pkg,-leaves=>\@leavesparent);
    my $oldnet=$self->{parent}->next_network_new();
    $self->{oldnet}=$oldnet;
    my @candidates=$oldnet->nodes();
    $self->{candidates}=\@candidates;
  }
  $self->{index}=0;
  $self->{found}=[];
  $self->{thrown}=0;
  bless($self,$pkg);
}


sub next_network_new {
  my ($self)=@_;

  my $n=$self->{numleaves};
  if ($self->{numleaves} == 2) {
    if ($self->{index} == 0) {
      my $graph=Graph::Directed->new();
      $graph->add_edges("t0",$self->{leaves}->[0],"t0",$self->{leaves}->[1]);
      my $net=Bio::PhyloNetwork->new(-graph=>$graph);
      $self->{index}++;
      $self->{found}=[$net];
      return $net;
    }
    else {
      return 0;
    }
  }
  else {
    if ($self->{index} == (scalar @{$self->{candidates}})) {
      my $oldnet=$self->{parent}->next_network_new();
      if (! $oldnet) {
	return 0;
      }
      $self->{oldnet}=$oldnet;
      my @candidates=$oldnet->nodes();
      $self->{candidates}=\@candidates;
      $self->{index}=0;
    }
    my $graph=$self->{oldnet}->{graph}->copy();
    my $u=$self->{candidates}->[$self->{index}];
    foreach my $w ($graph->predecessors($u)) {
      $graph->delete_edge($w,$u);
      $graph->add_edge($w,"t$n");
    }
    $graph->add_edge("t$n",$u);
    $graph->add_edge("t$n",$self->{newleaf});
    my $net=Bio::PhyloNetwork->new(-graph=>$graph);
    $self->{index}++;
    my @found=@{$self->{found}};
    push @found,$net;
    $self->{found}=\@found;
    return $net;
  }
}

sub next_network_repeated {
  my ($self)=@_;

  return 0 if ($self->{thrown} >= (scalar @{$self->{found}}));
  $self->{thrown}=$self->{thrown}+1;
  return $self->{found}->[$self->{thrown}-1];
}

sub next_network {
  my ($self)=@_;
  return $self->next_network_new();
}

1;