File Coverage

blib/lib/Bio/Tools/DNAGen.pm

Criterion	Covered	Total	%
statement	59	62	95.1
branch	15	24	62.5
condition	11	24	45.8
subroutine	17	17	100.0
pod	9	10	90.0
total	111	137	81.0

package Bio::Tools::DNAGen;
use 5.006;
use strict;

our $VERSION = '0.02';

use XSLoader;
XSLoader::load 'Bio::Tools::DNAGen';

use Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(calc_gcratio calc_mt);

use List::Util qw(shuffle);

# Standalone Functions
sub calc_gcratio { gcratio($_[0]) }
sub calc_mt { mt($_[0]) }

sub subseq {
    map{substr($_, length($_)-1)}grep{!is_selfcplm($_)}map{substr($_[0],1).$_} shuffle qw/a c g t/;
}


sub new {
    my $pkg = shift;
    my $arg = ref($_[0]) ? $_[0] : {@_};
    bless {
	gcratio => $arg->{gcratio},
	mt => $arg->{mt},
	limit => $arg->{limit} || 1,
	prefix => $arg->{prefix} || join(q//, subseq),
	len => $arg->{len} || 10,
	_result => '',
	_seqcnt => 0,
    }, $pkg;
}

sub set_limit   { $_[0]->{limit} = $_[1] || 1 }
sub set_gcratio { $_[0]->{gcratio} = (ref($_[1]) ? $_[1] : [@_[1..$#_]]) || undef }
sub set_mt      { $_[0]->{mt} = (ref($_[1]) ? $_[1] : [@_[1..$#_]]) || undef }
sub set_prefix  { $_[0]->{prefix} = $_[1] || join (q//, subseq) }
sub set_len     { $_[0]->{len} = $_[1] || 10 }


sub genseq($) {
    $_[0]->{_seqcnt} = 0;
    $_[0]->{_result} = undef;
    die "Prefix's length is greater than sequence's length\n" if length($_[0]->{prefix}) > $_[0]->{len};
    _genseq($_[0], $_[0]->{prefix});
    grep{$_}split /\n/, $_[0]->{_result};
}

use subs qw/_genseq/;
sub _genseq {
    my $prefix = $_[1];
    return if length $prefix == $_[0]->{len};
    if(length $prefix == $_[0]->{len}-1){
	for (
	     grep {
		 if(defined $_[0]->{mt} && ref($_[0]->{mt})){
		     if(@{$_[0]->{mt}} >= 2){
			 mt($_) >= $_[0]->{mt}->[0] && mt($_) <= $_[0]->{mt}->[1];
		     }
		     else{
			 mt($_) == $_[0]->{mt}->[0];
		     }
		 }
		 else{
		     $_;
		 }
	     }
	     grep {
		 if(defined $_[0]->{gcratio} && ref($_[0]->{gcratio})){
		     if(@{$_[0]->{gcratio}} >= 2){
			 gcratio($_) >= $_[0]->{gcratio}->[0] && gcratio($_) <= $_[0]->{gcratio}->[1];
		     }
		     else{
			 gcratio($_) == $_[0]->{gcratio}->[0];
		     }
		 }
		 else{
		     gcratio($_);
		 }
	     }
	     map{$prefix.$_} subseq $prefix){

	    if(++$_[0]->{_seqcnt} <= $_[0]->{limit}){
		$_[0]->{_result} .= $_."\n";
	    }
	    else{
		return;
	    }
	}
    }
    return if $_[0]->{_seqcnt} > $_[0]->{limit};
    map { _genseq($_[0], $prefix.$_) } subseq($prefix);
    return;
}

1;
__END__