Bio/PhyloNetwork/TreeFactoryMulti.pm

   1 #
   2 # Module for Bio::PhyloNetwork::TreeFactoryMulti
   3 #
   4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   5 #
   6 # Cared for by Gabriel Cardona <gabriel(dot)cardona(at)uib(dot)es>
   7 #
   8 # Copyright Gabriel Cardona
   9 #
  10 # You may distribute this module under the same terms as perl itself
  11
  12 # POD documentation - main docs before the code
  13
  14 =head1 NAME
  15
  16 Bio::PhyloNetwork::TreeFactoryMulti - Module to sequentially generate
  17 Phylogenetic Trees
  18
  19 =head1 SYNOPSIS
  20
  21  use strict;
  22  use warnings;
  23
  24  use Bio::PhyloNetwork;
  25  use Bio::PhyloNetwork::TreeFactory;
  26
  27  # Will generate sequentially all the 15 binary phylogetic
  28  # trees with 4 leaves
  29
  30  my $factory=Bio::PhyloNetwork::TreeFactory->new(-numleaves=>4);
  31
  32  my @nets;
  33
  34  while (my $net=$factory->next_network()) {
  35    push @nets,$net;
  36    print "".(scalar @nets).": ".$net->eNewick()."\n";
  37  }
  38
  39 =head1 DESCRIPTION
  40
  41 Sequentially builds a (binary) phylogenetic tree each time
  42 next_network is called.
  43
  44 =head1 AUTHOR
  45
  46 Gabriel Cardona, gabriel(dot)cardona(at)uib(dot)es
  47
  48 =head1 SEE ALSO
  49
  50 L<Bio::PhyloNetwork>
  51
  52 =head1 APPENDIX
  53
  54 The rest of the documentation details each of the object methods.
  55
  56 =cut
  57
  58 package Bio::PhyloNetwork::TreeFactoryMulti;
  59
  60 use strict;
  61 use warnings;
  62
  63 use base qw(Bio::Root::Root);
  64
  65 use Bio::PhyloNetwork;
  66
  67 =head2 new
  68
  69  Title   : new
  70  Usage   : my $factory = new Bio::PhyloNetwork::TreeFactory();
  71  Function: Creates a new Bio::PhyloNetwork::TreeFactory
  72  Returns : Bio::PhyloNetwork::RandomFactory
  73  Args    : -numleaves => integer
  74             OR
  75            -leaves => reference to an array (of leaves names)
  76
  77 Returns a Bio::PhyloNetwork::TreeFactory object. Such an object will
  78 sequentially create binary phylogenetic trees
  79 each time next_network is called.
  80
  81 If the parameter -leaves=E<gt>\@leaves is given, then the set of leaves of
  82 these networks will be @leaves. If it is given the parameter
  83 -numleaves=E<gt>$numleaves, then the set of leaves will be "l1"..."l$numleaves".
  84
  85 =cut
  86
  87 sub new {
  88   my ($pkg,@args)=@_;
  89
  90   my $self=$pkg->SUPER::new(@args);
  91
  92   my ($leavesR,$numleaves,$numhybrids)=
  93     $self->_rearrange([qw(LEAVES
  94                           NUMLEAVES
  95                           NUMHYBRIDS)],@args);
  96
  97   my @leaves;
  98   if ((! defined $leavesR) && (defined $numleaves)) {
  99     @leaves=map {"l$_"} (1..$numleaves);
 100     $leavesR=\@leaves;
 101   }
 102   if (! defined $leavesR) {
 103     $self->throw("No leaves set neither numleaves given");
 104   }
 105   @leaves=@$leavesR;
 106   $self->{leaves}=$leavesR;
 107
 108   $numleaves=@leaves;
 109   $self->{numleaves}=$numleaves;
 110   if ($numleaves > 2) {
 111     my @leavesparent=@leaves;
 112     my $newleaf=pop @leavesparent;
 113     $self->{newleaf}=$newleaf;
 114     $self->{parent}=
 115       new($pkg,-leaves=>\@leavesparent);
 116     my $oldnet=$self->{parent}->next_network();
 117     $self->{oldnet}=$oldnet;
 118     my @candidates=$oldnet->nodes();
 119     $self->{candidates}=\@candidates;
 120     my @candidatesbis=$oldnet->internal_nodes();
 121     $self->{candidatesbis}=\@candidatesbis;
 122     $self->{processbis}=0;
 123   }
 124   $self->{index}=0;
 125
 126   bless($self,$pkg);
 127 }
 128
 129 =head2 next_network
 130
 131  Title   : next_network
 132  Usage   : my $net=$factory->next_network()
 133  Function: returns a tree
 134  Returns : Bio::PhyloNetwork
 135  Args    : none
 136
 137 =cut
 138
 139 sub next_network {
 140   my ($self)=@_;
 141
 142   my $n=$self->{numleaves};
 143   if ($self->{numleaves} == 2) {
 144     if ($self->{index} == 0) {
 145       my $graph=Graph::Directed->new();
 146       $graph->add_edges("t0",$self->{leaves}->[0],"t0",$self->{leaves}->[1]);
 147       my $net=Bio::PhyloNetwork->new(-graph=>$graph);
 148       $self->{index}++;
 149       return $net;
 150     }
 151     else {
 152       return 0;
 153     }
 154   }
 155   else {
 156     if (($self->{index} == (scalar @{$self->{candidatesbis}})) && $self->{processbis}
 157        ) {
 158       my $oldnet=$self->{parent}->next_network();
 159         if (! $oldnet) {
 160         return 0;
 161       }
 162       $self->{oldnet}=$oldnet;
 163       my @candidates=$oldnet->nodes();
 164       $self->{candidates}=\@candidates;
 165       my @candidatesbis=$oldnet->internal_nodes();
 166       $self->{candidatesbis}=\@candidatesbis;
 167       $self->{processbis}=0;
 168       $self->{index}=0;
 169       my $n1=scalar @candidates;
 170       my $n2=scalar @candidatesbis;
 171       print $oldnet->eNewick()."(".$self->{numleaves}.")($n1,$n2):\n";
 172     }
 173     if (($self->{index} == (scalar @{$self->{candidates}})) && $self->{processbis}==0
 174        ) {
 175       $self->{processbis}=1;
 176       $self->{index}=0;
 177       print "--\n";
 178     }
 179     if ($self->{processbis}==0) {
 180       my $graph=$self->{oldnet}->{graph}->copy();
 181       my $u=$self->{candidates}->[$self->{index}];
 182       foreach my $w ($graph->predecessors($u)) {
 183         $graph->delete_edge($w,$u);
 184         $graph->add_edge($w,"t$n");
 185       }
 186       $graph->add_edge("t$n",$u);
 187       $graph->add_edge("t$n",$self->{newleaf});
 188       my $net=Bio::PhyloNetwork->new(-graph=>$graph);
 189       $self->{index}++;
 190       return $net;
 191     } else {
 192       my $graph=$self->{oldnet}->{graph}->copy();
 193       my $u=$self->{candidatesbis}->[$self->{index}];
 194 #      print "<<$u\n";
 195       $graph->add_edge($u,$self->{newleaf});
 196       my $net=Bio::PhyloNetwork->new(-graph=>$graph);
 197       $self->{index}++;
 198       return $net;
 199     }
 200   }
 201 }
 202
 203 1;