view release on metacpan or  search on metacpan

Bio/PhyloNetwork/FactoryX.pm  view on Meta::CPAN

$numhybrids E<lt> $numleaves.

If the parameter -recurse=E<gt>1 is given, then all networks with number of hybrid
nodes less or equal to $numhybrids will be given; otherwise only those with
exactly $numhybrids hybrid nodes.

=cut

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 (! defined $numhybrids) {
    $numhybrids=$numleaves-1;
  }
  $self->{numhybrids}=$numhybrids;
  if ($numhybrids ==0) {
    return Bio::PhyloNetwork::TreeFactoryX->new(-leaves=>\@leaves);
  }
  my $parent;
  if ($numhybrids > 1) {
    $parent=new($pkg,'-leaves'=>\@leaves,
		'-numhybrids'=>($numhybrids-1)
	       );
    my @subfactories=@{$parent->{subfactories}};
    push @subfactories,$parent;
#    print "$numhybrids : ".(scalar @subfactories);
#    print "\n";
    $self->{subfactories}=\@subfactories;
#    print "$numhybrids: ".(scalar @subfactories)."\n";
  }
  else {
    $parent=Bio::PhyloNetwork::TreeFactoryX->new(-leaves=>\@leaves);
    $self->{subfactories}=[$parent];
  }
  $self->{parent}=$parent;
  $self->update();
  $self->{found}=[];
  $self->{thrown}=0;
  $self->{hybnow}=0;
  bless($self,$pkg);
}

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

  if (defined $self->{oldnet}) {
    my @candidates=$self->{oldnet}->edges();
    $self->{candidates}=\@candidates;
    $self->{numcandidates}=(scalar @candidates);
    $self->{index1}=0;
    $self->{index2}=0;
  } else {
    $self->{candidates}=[];
    $self->{numcandidates}=0;
    $self->{index1}=0;
    $self->{index2}=0;
  }
}

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_new {
  my ($self)=@_;
 START:
#  print $self->{index1}.",".$self->{index2}.":".$self->{numcandidates}."\n";
  if ($self->{index1} >= $self->{numcandidates}) {
    $self->{index2}++;
    $self->{index1}=0;
  }
#  print $self->{index1}.",".$self->{index2}.":".$self->{numcandidates}."\n";
  if ($self->{index2} >= $self->{numcandidates}) {
    my $oldnet=$self->{parent}->next_network_repeated();
    if (! $oldnet) {
#      print "notoldnet\n";
      return 0;
    }
    $self->{oldnet}=$oldnet;
    $self->update();
  }
  my $u1=$self->{candidates}->[$self->{index1}]->[0];
  my $v1=$self->{candidates}->[$self->{index1}]->[1];
  my $u2=$self->{candidates}->[$self->{index2}]->[0];
  my $v2=$self->{candidates}->[$self->{index2}]->[1];
  my $lbl=$self->{numhybrids};
  if ($self->{oldnet}->is_attackable($u1,$v1,$u2,$v2)) {
    my $net=Bio::PhyloNetwork->new(-graph=>$self->{oldnet}->graph);
    $net->do_attack($u1,$v1,$u2,$v2,$lbl);
    $self->{index1}++;
    my @found=@{$self->{found}};
    foreach my $netant (@found) {
      if ($net->is_mu_isomorphic($netant) ) {
	goto START;
      }
    }
    push @found,$net;
    $self->{found}=\@found;
    return $net;