From 03a996500f979243e743c5012e1fad2794b16fd7 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Carn=C3=AB=20Draug?= Date: Tue, 11 Sep 2018 12:23:53 +0100 Subject: [PATCH] Bio/SeqEvolution/*: move to another repo with same name. Remove this into another repo named Bio-SeqEvolution to be released on its own, in a distribution with the same name. --- Bio/SeqEvolution/DNAPoint.pm | 342 ----------------------------- Bio/SeqEvolution/EvolutionI.pm | 140 ------------ Bio/SeqEvolution/Factory.pm | 481 ----------------------------------------- Changes | 2 + t/SeqEvolution.t | 182 ---------------- 5 files changed, 2 insertions(+), 1145 deletions(-) delete mode 100644 Bio/SeqEvolution/DNAPoint.pm delete mode 100644 Bio/SeqEvolution/EvolutionI.pm delete mode 100644 Bio/SeqEvolution/Factory.pm delete mode 100644 t/SeqEvolution.t diff --git a/Bio/SeqEvolution/DNAPoint.pm b/Bio/SeqEvolution/DNAPoint.pm deleted file mode 100644 index 59d063c94..000000000 --- a/Bio/SeqEvolution/DNAPoint.pm +++ /dev/null @@ -1,342 +0,0 @@ -# -# BioPerl module for Bio::SeqEvolution::DNAPoint -# -# Please direct questions and support issues to -# -# Cared for by Heikki Lehvaslaiho -# -# Copyright Heikki Lehvaslaiho -# -# You may distribute this module under the same terms as perl itself - -# POD documentation - main docs before the code - -=head1 NAME - -Bio::SeqEvolution::DNAPoint - evolve a sequence by point mutations - -=head1 SYNOPSIS - - # $seq is a Bio::PrimarySeqI to mutate - $evolve = Bio::SeqEvolution::Factory->new (-rate => 5, - -seq => $seq, - -identity => 50 - ); - $newseq = $evolve->next_seq; - - -=head1 DESCRIPTION - -Bio::SeqEvolution::DNAPoint implements the simplest evolution model: -nucleotides change by point mutations, only. Transition/transversion -rate of the change, rate(), can be set. - -The new sequences are named with the id of the reference sequence -added with a running number. Placing a new sequence into a factory to -be evolved resets that counter. It can also be called directly with -L. - -The default sequence type returned is Bio::PrimarySeq. This can be -changed to any Bio::PrimarySeqI compliant sequence class. - -Internally the probability of the change of one nucleotide is mapped -to scale from 0 to 100. The probability of the transition occupies -range from 0 to some value. The remaining range is divided equally -among the two transversion nucleotides. A random number is then -generated to pick up one change. - -Not that the default transition/transversion rate, 1:1, leads to -observed transition/transversion ratio of 1:2 simply because there is -only one transition nucleotide versus two transversion nucleotides. - -=head1 FEEDBACK - -=head2 Mailing Lists - -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/wiki/Mailing_lists - About the mailing lists - -=head2 Support - -Please direct usage questions or support issues to the mailing list: - -I - -rather than to the module maintainer directly. Many experienced and -reponsive experts will be able look at the problem and quickly -address it. Please include a thorough description of the problem -with code and data examples if at all possible. - -=head2 Reporting Bugs - -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: - - https://github.com/bioperl/bioperl-live/issues - -=head1 AUTHOR - - Heikki Lehvaslaiho Eheikki at bioperl dot orgE - -=head1 CONTRIBUTORS - -Additional contributor's names and emails here - -=head1 APPENDIX - -The rest of the documentation details each of the object methods. -Internal methods are usually preceded with a _ - -=cut - - -# Let the code begin... - - -package Bio::SeqEvolution::DNAPoint; -use strict; -use Bio::Root::Root; -use Bio::SeqEvolution::Factory; - -use Bio::Variation::DNAMutation; -use Bio::Variation::Allele; -use Bio::SimpleAlign; - -use base qw(Bio::SeqEvolution::Factory); - - -sub _initialize { - my($self, @args) = @_; - - $self->SUPER::_initialize(@args); - my %param = @args; - @param{ map { lc $_ } keys %param } = values %param; # lowercase keys - - exists $param{'-rate'} && $self->rate($param{'-rate'}); - - $self->_init_mutation_engine; -} - - -sub _init_mutation_engine { - my $self = shift; - - # arrays of possible changes have transitions as first items - my %changes; - $self->{'_changes'}->{'a'} = ['t', 'c', 'g']; - $self->{'_changes'}->{'t'} = ['a', 'c', 'g']; - $self->{'_changes'}->{'c'} = ['g', 'a', 't']; - $self->{'_changes'}->{'g'} = ['c', 'a', 't']; - - - # given the desired rate, find out where cut off points need to be - # when random numbers are generated from 0 to 100 - # we are ignoring identical mutations (e.g. A->A) to speed things up - my $bin_size = 100/($self->rate + 2); - $self->{'_transition'} = 100 - (2*$bin_size); - $self->{'_first_transversion'} = $self->{'_transition'} + $bin_size; - - $self->_init_alignment; -} - -sub _init_alignment { - my $self = shift; - - # put the initial sequence into the alignment object - $self->{'_align'} = Bio::SimpleAlign->new(-verbose => -1); - return unless $self->seq; - $self->{'_ori_locatableseq'} = Bio::LocatableSeq->new(-id => 'ori', - -seq=> $self->seq->seq); - $self->{'_mut_locatableseq'} = Bio::LocatableSeq->new(-id => 'mut', - -seq=> $self->seq->seq); - $self->{'_align'}->add_seq($self->{'_ori_locatableseq'}); - $self->{'_align'}->add_seq($self->{'_mut_locatableseq'}); -} - -=head2 seq - - Title : seq - Usage : $obj->seq($newval) - Function: Set the sequence object for the original sequence - Returns : The sequence object - Args : newvalue (optional) - -Setting this will reset mutation and generated mutation counters. - -=cut - -sub seq{ - my $self = shift; - - if (@_) { - my $seq = shift; - $self->throw('Need a valid Bio::PrimarySeqI, not [', ref($seq), ']') - unless $seq->isa('Bio::PrimarySeqI'); - - $self->throw('Only nucleotide sequences are supported') - if $seq->alphabet eq 'protein'; - $self->throw('No ambiquos nucleotides allowed in the input sequence') - if $seq->seq =~ m/[^acgt]/; - - $self->{'_seq'} = $seq; - - # unify the look of sequence strings and cache the information - $self->{'_ori_string'} = lc $seq->seq; # lower case - $self->{'_ori_string'} =~ s/u/t/; # simplyfy our life; modules should deal with the change anyway - $self->{'_seq_length'} = $seq->length; - - $self->reset_sequence_counter; - } - return $self->{'_seq'}; -} - -=head2 set_mutated_seq - - Title : seq_mutated_seq - Usage : $obj->set_mutated_seq($newval) - Function: In case of mutating a sequence with multiple evolvers, this - Returns : set_mutated_seq - Args : newvalue (optional) - -=cut - -sub set_mutated_seq { - my $self = shift; - - if (@_) { - my $seq = shift; - $self->throw('Need a valid Bio::PrimarySeqI, not [', ref($seq), ']') - unless $seq->isa('Bio::PrimarySeqI'); - $self->throw('Only nucleotide sequences are supported') - if $seq->alphabet eq 'protein'; - $self->throw('No ambiquos nucleotides allowed in the input sequence') - if $seq->seq =~ m/[^acgt]/; - - $self->{'_seq_mutated'} = $seq; - - # unify the look of sequence strings and cache the information - $self->{'_mut_string'} = lc $seq->seq; # lower case - $self->{'_mut_string'} =~ s/u/t/; # simplyfy our life; modules should deal with the change anyway - - - $self->reset_sequence_counter; - } - #set returned sequence to be the last mutated string - $self->{'_seq'}->seq($self->{'_mut_string'}); - return $self->{'_seq'}; -} - - -=head2 rate - - Title : rate - Usage : $obj->rate($newval) - Function: Set the transition/transversion rate. - Returns : value of rate - Args : newvalue (optional) - -Transition/transversion ratio is an observed attribute of an sequence -comparison. We are dealing here with the transition/transversion rate -that we set for our model of sequence evolution. - -Note that we are using standard nucleotide alphabet and that there can -there is only one transition versus two possible transversions. Rate 2 -is needed to have an observed transition/transversion ratio of 1. - -=cut - -sub rate{ - my $self = shift; - if (@_) { - $self->{'_rate'} = shift @_; - $self->_init_mutation_engine; - } - return $self->{'_rate'} || 1; -} - -=head2 next_seq - - Title : next_seq - Usage : $obj->next_seq - Function: Evolve the reference sequence to desired level - Returns : A new sequence object mutated from the reference sequence - Args : - - -=cut - -sub next_seq { - my $self = shift; - $self->{'_mut_string'} = $self->{'_ori_string'}; - $self->reset_mutation_counter; - - $self->{'_mutations'} = []; - - while (1) { - # find the location in the string to change - my $loc = int (rand length($self->{'_mut_string'})) + 1; - - $self->mutate($loc); # for modularity - - # stop evolving if any of the limit has been reached - last if $self->identity && $self->get_alignment_identity <= $self->identity; - last if $self->pam && 100*$self->get_mutation_counter/$self->{'_seq_length'} >= $self->pam; - last if $self->mutation_count && $self->get_mutation_counter >= $self->mutation_count; - } - $self->_increase_sequence_counter; - - my $type = $self->seq_type; - return $type->new(-id => $self->seq->id. "-". $self->get_sequence_counter, - -description => $self->seq->description, - -seq => $self->{'_mut_string'} - ) -} - -=head2 mutate - - Title : mutate - Usage : $obj->mutate - Function: mutate the sequence at the given location according to the model - Returns : true - Args : integer, start location of the mutation, required argument - -Called from next_seq(). - -=cut - -sub mutate { - my $self = shift; - my $loc = shift; - $self->throw('the first argument is the location of the mutation') unless $loc; - - # nucleotide to change - my $oldnuc = substr $self->{'_mut_string'}, $loc-1, 1; - my $newnuc; - - - # find the nucleotide it is changed to - my $choose = rand(100); # scale is 0-100 - if ($choose < $self->{'_transition'} ) { - $newnuc = $self->{'_changes'}->{$oldnuc}[0]; - } elsif ($choose < $self->{'_first_transversion'} ) { - $newnuc = $self->{'_changes'}->{$oldnuc}[1]; - } else { - $newnuc = $self->{'_changes'}->{$oldnuc}[2]; - } - - # do the change - substr $self->{'_mut_string'}, $loc-1, 1 , $newnuc; - $self->_increase_mutation_counter; - $self->{'_mut_locatableseq'}->seq($self->{'_mut_string'}); - - print STDERR "$loc$oldnuc>$newnuc\n" if $self->verbose > 0; - - push @{$self->{'_mutations'}}, "$loc$oldnuc>$newnuc"; -} - - -1; diff --git a/Bio/SeqEvolution/EvolutionI.pm b/Bio/SeqEvolution/EvolutionI.pm deleted file mode 100644 index a94bfffce..000000000 --- a/Bio/SeqEvolution/EvolutionI.pm +++ /dev/null @@ -1,140 +0,0 @@ -# -# BioPerl module for Bio::SeqEvolution::EvolutionI -# -# Please direct questions and support issues to -# -# Cared for by Heikki Lehvaslaiho -# -# Copyright Heikki Lehvaslaiho -# -# You may distribute this module under the same terms as perl itself - -# POD documentation - main docs before the code - -=head1 NAME - -Bio::SeqEvolution::EvolutionI - the interface for evolving sequences - -=head1 SYNOPSIS - - # not an instantiable class - -=head1 DESCRIPTION - -This is the interface that all classes that mutate sequence objects in -constant fashion must implement. A good example is -Bio::SeqEvolution::DNAPoint. - -=head1 FEEDBACK - -=head2 Mailing Lists - -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/wiki/Mailing_lists - About the mailing lists - -=head2 Support - -Please direct usage questions or support issues to the mailing list: - -I - -rather than to the module maintainer directly. Many experienced and -reponsive experts will be able look at the problem and quickly -address it. Please include a thorough description of the problem -with code and data examples if at all possible. - -=head2 Reporting Bugs - -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: - - https://github.com/bioperl/bioperl-live/issues - -=head1 AUTHOR - - Heikki Lehvaslaiho Eheikki at bioperl dot orgE - -=head1 CONTRIBUTORS - -Additional contributor's names and emails here - -=head1 APPENDIX - -The rest of the documentation details each of the object methods. -Internal methods are usually preceded with a _ - -=cut - - -# Let the code begin... - - -package Bio::SeqEvolution::EvolutionI; -use strict; - -use base qw(Bio::Root::RootI); - -=head2 annotation - - Title : annotation - Usage : $obj->annotation($newval) - Function: Get the annotation collection for this annotatable object. - Example : - Returns : a Bio::AnnotationCollectionI implementing object, or undef - Args : on set, new value (a Bio::AnnotationCollectionI - implementing object, optional) (an implementation may not - support changing the annotation collection) - -See L - -=cut - - -=head2 seq - - Title : seq - Usage : $obj->seq($newval) - Function: Set the sequence object for the original sequence - Returns : The sequence object - Args : newvalue (optional) - -Setting this will reset mutation and generated mutation counters. - -=cut - -sub seq { shift->throw_not_implemented(); } - -=head2 next_seq - - Title : next_seq - Usage : $obj->next_seq - Function: Evolve the reference sequence to desired level - Returns : A new sequence object mutated from the reference sequence - Args : - - -=cut - -sub next_seq{ shift->throw_not_implemented(); } - - -=head2 mutate - - Title : mutate - Usage : $obj->mutate - Function: mutate the sequence at the given location according to the model - Returns : true - Args : integer, start location of the mutation, required argument - -Called from next_seq(). - -=cut - -sub mutate { shift->throw_not_implemented(); } - - -1; diff --git a/Bio/SeqEvolution/Factory.pm b/Bio/SeqEvolution/Factory.pm deleted file mode 100644 index e190a1790..000000000 --- a/Bio/SeqEvolution/Factory.pm +++ /dev/null @@ -1,481 +0,0 @@ -# -# BioPerl module for Bio::SeqEvolution::Factory -# -# Please direct questions and support issues to -# -# Cared for by Heikki Lehvaslaiho -# -# Copyright Heikki Lehvaslaiho -# -# You may distribute this module under the same terms as perl itself - -# POD documentation - main docs before the code - -=head1 NAME - -Bio::SeqEvolution::Factory - Factory object to instantiate sequence evolving classes - -=head1 SYNOPSIS - - # not an instantiable class - -=head1 DESCRIPTION - -This is the factory class that can be used to call for a specific -model to mutate a sequence. - -Bio::SeqEvolution::DNAPoint is the default for nucleotide sequences -and the only implementation at this point. - -=head1 FEEDBACK - -=head2 Mailing Lists - -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/wiki/Mailing_lists - About the mailing lists - -=head2 Support - -Please direct usage questions or support issues to the mailing list: - -I - -rather than to the module maintainer directly. Many experienced and -reponsive experts will be able look at the problem and quickly -address it. Please include a thorough description of the problem -with code and data examples if at all possible. - -=head2 Reporting Bugs - -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: - - https://github.com/bioperl/bioperl-live/issues - -=head1 AUTHOR - - Heikki Lehvaslaiho Eheikki at bioperl dot orgE - -=head1 CONTRIBUTORS - -Additional contributor's names and emails here - -=head1 APPENDIX - -The rest of the documentation details each of the object methods. -Internal methods are usually preceded with a _ - -=cut - - -# Let the code begin... - - -package Bio::SeqEvolution::Factory; -use strict; -use Bio::Root::Root; -use Bio::SeqEvolution::EvolutionI; -use base qw(Bio::Root::Root Bio::SeqEvolution::EvolutionI); - -=head2 new - - Title : new - Usage : my $obj = Bio::SeqEvolution::Factory->new(); - Function: Builds a new Bio:SeqEvolution::EvolutionI object - Returns : Bio:SeqEvolution::EvolutionI object - Args : -type => class name - -See L - -=cut - -sub new { - my($caller,@args) = @_; - my $class = ref($caller) || $caller; - - my %param = @args; - @param{ map { lc $_ } keys %param } = values %param; # lowercase keys - - if ( $class eq 'Bio::SeqEvolution::Factory') { - #my %param = @args; - #@param{ map { lc $_ } keys %param } = values %param; # lowercase keys - - if (exists $param{'-type'}) { -# $self->type($param{'-type'}); - } else { - $param{'-type'} = 'Bio::SeqEvolution::DNAPoint'; - #$self->type('Bio::SeqEvolution::DNAPoint'} unless $seq->alphabet == 'protein' - } - my $type = $param{'-type'}; - return unless( $class->_load_format_module($param{'-type'}) ); - return $type->new(%param); - } else { - my ($self) = $class->SUPER::new(%param); - $self->_initialize(%param); - return $self; - } -} - -sub _initialize { - my($self, @args) = @_; - - $self->SUPER::_initialize(@args); - my %param = @args; - @param{ map { lc $_ } keys %param } = values %param; # lowercase keys - - exists $param{'-seq'} && $self->seq($param{'-seq'}); - exists $param{'-set_mutated_seq'} && $self->set_mutated_seq($param{'-set_mutated_seq'}); - exists $param{'-identity'} && $self->identity($param{'-identity'}); - exists $param{'-pam'} && $self->pam($param{'-pam'}); - exists $param{'-mutation_count'} && $self->mutation_count($param{'-mutation_count'}); - -} - - -=head2 _load_format_module - - Title : _load_format_module - Usage : *INTERNAL SeqIO stuff* - Function: Loads up (like use) a module at run time on demand - Example : - Returns : - Args : - -=cut - -sub _load_format_module { - my ($self, $format) = @_; - my $module = $format; - my $ok; - - eval { - $ok = $self->_load_module($module); - }; - if ( $@ ) { - print STDERR <type($newval) - Function: Set used evolution model. It is set by giving a - valid Bio::SeqEvolution::* class name - Returns : value of type - Args : newvalue (optional) - -Defaults to Bio::SeqEvolution::DNAPoint. - -=cut - -sub type{ - my $self = shift; - if (@_) { - $self->{'_type'} = shift @_; - $self->_load_module($self->{'_type'}); - } - return $self->{'_type'} || 'Bio::SeqEvolution::DNAPoint'; -} - -=head1 mutation counters - -The next three methods set a value to limit the number of mutations -introduced the the input sequence. - -=cut - -=head2 identity - - Title : identity - Usage : $obj->identity($newval) - Function: Set the desired identity between original and mutated sequence - Returns : value of identity - Args : newvalue (optional) - -=cut - -sub identity{ - my $self = shift; - $self->{'_identity'} = shift @_ if @_; - return $self->{'_identity'}; -} - - -=head2 pam - - Title : pam - Usage : $obj->pam($newval) - Function: Set the wanted Percentage of Accepted Mutations, PAM - Returns : value of PAM - Args : newvalue (optional) - -When you are measuring sequence divergence, PAM needs to be -estimated. When you are generating sequences, PAM is simply the count -of mutations introduced to the reference sequence normalised to the -original sequence length. - -=cut - -sub pam{ - my $self = shift; - $self->{'_pam'} = shift @_ if @_; - return $self->{'_pam'}; -} - -=head2 mutation_count - - Title : mutation_count - Usage : $obj->mutation_count($newval) - Function: Set the number of wanted mutations to the sequence - Returns : value of mutation_count - Args : newvalue (optional) - -=cut - -sub mutation_count{ - my $self = shift; - $self->{'_mutation_count'} = shift @_ if @_; - return $self->{'_mutation_count'}; -} - - - -=head2 seq - - Title : seq - Usage : $obj->seq($newval) - Function: Set the sequence object for the original sequence - Returns : The sequence object - Args : newvalue (optional) - -Setting this will reset mutation and generated mutation counters. - -=cut - -sub seq { - my $self = shift; - if (@_) { - $self->{'_seq'} = shift @_ ; - return $self->{'_seq'}; - $self->reset_mutation_counter; - $self->reset_sequence_counter; - } - return $self->{'_seq'}; -} - -=head2 seq_type - - Title : seq_type - Usage : $obj->seq_type($newval) - Function: Set the returned seq_type to one needed - Returns : value of seq_type - Args : newvalue (optional) - -Defaults to Bio::PrimarySeq. - -=cut - -sub seq_type{ - my $self = shift; - if (@_) { - $self->{'_seq_type'} = shift @_; - $self->_load_module($self->{'_seq_type'}); - } - return $self->{'_seq_type'} || 'Bio::PrimarySeq'; -} - - -=head2 get_mutation_counter - - Title : get_mutation_counter - Usage : $obj->get_mutation_counter() - Function: Get the count of sequences created - Returns : value of counter - Args : - - -=cut - -sub get_mutation_counter{ - return shift->{'_mutation_counter'}; -} - - -=head2 reset_mutation_counter - - Title : reset_mutation_counter - Usage : $obj->reset_mutation_counter() - Function: Resert the counter of mutations - Returns : value of counter - Args : - - -=cut - -sub reset_mutation_counter{ - shift->{'_mutation_counter'} = 0; - return 1; -} - - -=head2 get_sequence_counter - - Title : get_sequence_counter - Usage : $obj->get_sequence_counter() - Function: Get the count of sequences created - Returns : value of counter - Args : - - -=cut - -sub get_sequence_counter{ - return shift->{'_sequence_counter'}; -} - -=head2 reset_sequence_counter - - Title : reset_sequence_counter - Usage : $obj->reset_sequence_counter() - Function: Resert the counter of sequences created - Returns : value of counter - Args : - - -This is called when ever mutated sequences are reassigned new values -using methods seq() and mutated_seq(). As a side affect, this method -also recreates the intermal alignment that is used to calculate the -sequence identity. - -=cut - -sub reset_sequence_counter{ - my $self = shift; - $self->{'_sequence_counter'} = 0; - $self->_init_alignment; - return 1; -} - - - -=head2 each_seq - - Title : each_seq - Usage : $obj->each_seq($int) - Function: - Returns : an array of sequences mutated from the reference sequence - according to evolutionary parameters given - Args : - - -=cut - -sub each_seq{ - my $self = shift; - my $number = shift; - - $self->throw("[$number] ". ' should be a positive integer') - unless $number =~ /^[+\d]+$/; - - my @array; - for (my $count=1; $count<$number; $count++) { - push @array, $self->next_seq(); - - } - return @array; -} - - - -=head2 each_mutation - - Title : each_mutation - Usage : $obj->each_mutation - Function: return the mutations leading to the last generated - sequence in objects - Returns : an array of Bio::Variation::DNAMutation objects - Args : optional argument to return an array of stringified names - -=cut - -sub each_mutation { - my $self = shift; - my $string = shift; - - return @{$self->{'_mutations'}} if $string; - - return map { - /(\d+)(\w*)>(\w*)/; -# print; - my $dnamut = Bio::Variation::DNAMutation->new - ('-start' => $1, - '-end' => $1, - '-length' => 1, - '-isMutation' => 1 - ); - $dnamut->allele_ori( Bio::Variation::Allele->new(-seq => $2, - -alphabet => 'dna') ); - $dnamut->add_Allele( Bio::Variation::Allele->new(-seq => $3, - -alphabet => 'dna') ); - $dnamut; - } @{$self->{'_mutations'}} -} - - -sub get_alignment_identity { - my $self = shift; - return $self->{'_align'}->overall_percentage_identity; -} - - -sub get_alignmet { - my $self = shift; - return $self->{'_align'}->remove_gaps('-', 'all-gaps'); -} - - -=head1 Internal methods - -=cut - - -=head2 _increase_mutation_counter - - Title : _increase_mutation_counter - Usage : $obj->_increase_mutation_counter() - Function: Internal method to increase the counter of mutations performed - Returns : value of counter - Args : - - -=cut - -sub _increase_mutation_counter{ - return shift->{'_mutation_counter'}++; -} - - - -=head2 _increase_sequence_counter - - Title : _increase_sequence_counter - Usage : $obj->_increase_sequence_counter() - Function: Internal method to increase the counter of sequences created - Returns : value of counter - Args : - - -=cut - -sub _increase_sequence_counter{ - return shift->{'_sequence_counter'}++; -} - - -1; - diff --git a/Changes b/Changes index d991fcab6..1349f23b1 100644 --- a/Changes +++ b/Changes @@ -93,6 +93,8 @@ be removed. * The entire Bio::Structure namespace has been moved to a separate distribution named Bio-Structure. + * The entire Bio::SeqEvolution namespace has been moved to a + separate distribution named Bio-SeqEvolution. 1.7.2 - "Entebbe" diff --git a/t/SeqEvolution.t b/t/SeqEvolution.t deleted file mode 100644 index 27e89f4ed..000000000 --- a/t/SeqEvolution.t +++ /dev/null @@ -1,182 +0,0 @@ -# -*-Perl-*- Test Harness script for Bioperl -# $Id$ - -use strict; - -BEGIN { - use lib '.'; - use Bio::Root::Test; - - test_begin(-tests => 39); - - use_ok('Bio::SeqEvolution::Factory'); - use_ok('Bio::PrimarySeq'); -} - -# -# point mutations -# - -ok my $evolve = Bio::SeqEvolution::Factory->new (-verbose => 1); -isa_ok $evolve, 'Bio::SeqEvolution::DNAPoint'; - -ok $evolve = Bio::SeqEvolution::DNAPoint->new (-verbose => 2); -isa_ok $evolve, 'Bio::SeqEvolution::DNAPoint'; - -ok $evolve = Bio::SeqEvolution::Factory->new (-verbose => 3, - -type => 'Bio::SeqEvolution::DNAPoint'); -isa_ok $evolve, 'Bio::SeqEvolution::DNAPoint'; - - -my $seq = Bio::PrimarySeq->new(-id=>'test', - -seq=>'aaacccgggtta' - ); - -ok $evolve = Bio::SeqEvolution::Factory->new (-verbose => 0, - -foo => 'bar', - -rate => 5, - -seq => $seq - ); - -is $evolve->seq->id, 'test'; -is $evolve->rate, 5, 'get rate()'; -is $evolve->rate(2), 2, 'get and set rate()'; - - -is $evolve->identity(80), 80, 'identity()'; -is $evolve->identity(undef), undef, 'identity()'; - -is $evolve->pam, undef, 'pam()'; -is $evolve->pam(80), 80, 'pam()'; - -is $evolve->mutation_count, undef, 'mutation_count()'; -is $evolve->mutation_count(5), 5, , 'mutation_count()'; - - - -is $evolve->seq_type, 'Bio::PrimarySeq', 'seq_type()'; -is $evolve->seq_type('Bio::Seq'), 'Bio::Seq', 'seq_type()'; - -ok my $newseq = $evolve->next_seq, 'next_seq()'; - -foreach ( $evolve->each_mutation('string')) { - ok $_; -} -is $evolve->each_mutation, 5, 'each_mutation()'; - -ok $evolve = Bio::SeqEvolution::Factory->new (-verbose => 0, - -rate => 5, - -seq => $seq, - -identity => 50 ### - ); -ok $newseq = $evolve->next_seq; -cmp_ok $evolve->get_alignment_identity, '<=', 50, "get_alignment_identity()"; - -ok $evolve = Bio::SeqEvolution::Factory->new (-verbose => 0, - -rate => 5, - -seq => $seq, - -pam => 50 ### - ); -ok $newseq = $evolve->next_seq; -is $evolve->get_mutation_counter, 6, 'get_mutation_counter()'; -$newseq = $evolve->next_seq; -is $evolve->get_sequence_counter, 2, 'get_sequence_counter()'; -ok $evolve->reset_sequence_counter(), 'reset_sequence_counter()'; -is $evolve->get_sequence_counter, 0, 'get_sequence_counter() == 0'; - -ok $evolve = Bio::SeqEvolution::Factory->new (-verbose => 0, - -rate => 5, - -seq => $seq, - -pam => 50 - ); - -ok $newseq = $evolve->next_seq; -# ok $evolve->get_alignment_identity <= 50, "get_alignment_identity()"; -isa_ok $evolve->get_alignmet, 'Bio::SimpleAlign'; - - -# -#print "-----------------------------------------\n"; -#print $evolve->{'_ori_locatableseq'}->seq, "\n"; -#print $evolve->{'_mut_locatableseq'}->seq, "\n"; -#print $evolve->{'_align'}->overall_percentage_identity, "\n"; -#print $evolve->get_mutation_counter, "\n"; -#print "-----------------------------------------\n"; -# - - -# -# indels -# - -#use Bio::SeqEvolution::DNAIndel; -#ok $evolve = Bio::SeqEvolution::DNAIndel->new (-verbose => 0, -# -mutation_count => 3, -# -rate => 1, -# -seq => $seq -# ); -# -# -# -#ok $newseq = $evolve->next_seq; -#ok $evolve->get_mutation_counter, 3; -##print Dumper $evolve; -# -#foreach ( $evolve->each_mutation) { -## print Dumper $_; -## print $_->sysname, "\n"; -# ok $_->sysname; -#} -# -# -#ok $evolve = Bio::SeqEvolution::DNAIndel->new (-verbose => 0, -# -duplication => 1, -## -identity =>50, -# -mutation_count => 3, -# -rate => 1, -# -seq => $seq -# ); -##$evolve->{'_mut_string'} = $evolve->{'_ori_string'}; -# -##ok $newseq = $evolve->mutate(12); -#ok $newseq = $evolve->next_seq; -##print Dumper $evolve; -##print $evolve->{'_ori_locatableseq'}->seq, "\n"; -##print $evolve->{'_mut_locatableseq'}->seq, "\n"; -# -#print "-----------------------------------------\n"; -#print $evolve->{'_ori_locatableseq'}->seq, "\n"; -#print $evolve->{'_mut_locatableseq'}->seq, "\n"; -#print $evolve->{'_align'}->overall_percentage_identity, "\n"; -#print "-----------------------------------------\n"; -# -# -## -## mixer, simulation -## -# -# -#ok my $evolve2 = Bio::SeqEvolution::Factory->new (-verbose => 0, -# -rate => 2, -# -seq => $seq, -# -set_mutated_seq => $newseq, -## -identity => 50 -# -mutation_count => 1 ### -# ); -#ok $evolve2->seq_type('Bio::LocatableSeq'); -# -#print "=-----------------------------------------\n"; -#print $evolve2->{'_ori_locatableseq'}->seq, "\n"; -#print $evolve2->{'_mut_locatableseq'}->seq, "\n"; -#print $evolve2->{'_align'}->overall_percentage_identity, "\n"; -#print "-----------------------------------------\n"; -# -#ok $newseq = $evolve2->next_seq; -# -# -#print "-----------------------------------------\n"; -#print $evolve2->{'_ori_locatableseq'}->seq, "\n"; -#print $evolve2->{'_mut_locatableseq'}->seq, "\n"; -#print $evolve2->{'_align'}->overall_percentage_identity, "\n"; -#print "-----------------------------------------\n"; -# -- 2.11.4.GIT