Yaossg/hisat-3n
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
5e601d0401
hisat-3n/scripts/sim/Sim.pm
Yaossg 5e601d0401 initial commit
2025-01-18 21:09:52 +08:00

1053 lines
30 KiB
Perl
Raw Blame History

#!/usr/bin/perl -w
#
# Copyright 2011, Ben Langmead <langmea@cs.jhu.edu>
#
# This file is part of Bowtie 2.
#
# Bowtie 2 is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# Bowtie 2 is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Bowtie 2. If not, see <http://www.gnu.org/licenses/>.
#
package Sim;
use strict;
use Carp;
use FindBin qw($Bin);
use lib $Bin;
use DNA;
use Test;
use RandDNA;
use SampleRead;
use Mutate;
use AlignmentCheck;
use Math::Random;
use List::Util qw(max min);
use POSIX;
##
# Replacement for "die" that additionally writes error message to file so that
# run.pl can read it later.
#
sub mydie($) {
my $fn = ".run.pl.child.$$";
open(EO, ">$fn") || die "Could not open $fn for writing";
print EO "$_[0]\n";
close(EO);
confess $_[0];
}
# Generates random printable strings of a given length
sub randStr($) {
my $len = shift;
my @chars = ('a'..'z', 'A'..'Z', '0'..'9', '_');
my $str = "";
foreach (1..$len) {
$str .= $chars[int(rand(scalar(@chars)))];
}
return $str;
}
##
# Default random generator for number of reference per test case.
#
sub defaultRefNumGen() { return int(Math::Random::random_exponential(1, 8))+1; }
##
# Default random generator for reference length.
#
sub defaultRefLenGen() {
return int(Math::Random::random_exponential(1, 50000))+1;
}
##
# Default random generator for number of reference per test case.
#
sub defaultReadNumGen() {
return int(Math::Random::random_exponential(1, 10000))+1;
}
##
# Default random generator for read length.
#
sub defaultFragLenGen() {
return int(Math::Random::random_normal(1, 200, 40))+1;
}
##
# Default random generator for reference length.
#
sub defaultReadLenGen() {
my $r = int(rand(3));
if($r == 0) {
return int(Math::Random::random_exponential(1, 60))+1;
} elsif($r == 1) {
return int(Math::Random::random_exponential(1, 20))+1;
} else {
return int(Math::Random::random_exponential(1, 150))+1;
}
}
##
# Default random generator for fraction of reference characters = N.
#
sub defaultNGen() {
return Math::Random::random_uniform(1, 0, 0.05);
}
##
# Default random generator for fraction of reference characters = an
# ambiguous IUPAC code.
#
sub defaultIupacGen() {
return Math::Random::random_uniform(1, 0, 0.01);
}
##
# Default random generator for AT/ACGT fraction.
#
sub defaultAtGen() {
return min(max(Math::Random::random_normal(1, 0.5, 0.18), 0), 1);
}
##
# Default random generator for A/AT fraction.
#
sub defaultAGen() {
return min(max(Math::Random::random_normal(1, 0.5, 0.18), 0), 1);
}
##
# Default random generator for C/CG fraction.
#
sub defaultCGen() {
return min(max(Math::Random::random_normal(1, 0.5, 0.18), 0), 1);
}
##
# Default SNP rate generator. Doesn't generate the SNP per se, just
# the rate.
#
sub defaultSNPGen() {
return Math::Random::random_uniform(1, 0, 0.05);
}
##
# Default read gap rate generator. Doesn't generate the gaps or
# lengths, just the rate.
#
sub defaultRdGapGen() {
return Math::Random::random_uniform(1, 0, 0.005);
}
##
# Default reference gap rate generator. Doesn't generate the gaps or
# lengths, just the rate.
#
sub defaultRfGapGen() {
return Math::Random::random_uniform(1, 0, 0.005);
}
##
# Default rearrangement rate generator.
#
sub defaultRearrGen() {
return Math::Random::random_uniform(1, 0, 0.005);
}
##
# Default function for generating gap lengths when introducing a gap.
#
sub defaultGapLenGen($) {
return int(Math::Random::random_exponential(1, 3))+1;
}
##
# Default function for generating random sequence to insert into a gap.
#
sub defaultSeqGen($) {
my $len = shift;
($len == int($len) && $len > 0) ||
mydie("Bad length for sequence generator: $len");
my $ret = "";
for (1..$len) {
$ret .= substr("ACGT", int(rand(4)), 1);
}
return $ret;
}
##
# Default sequencing miscall rate generator.
#
sub defaultSeqMmGen() {
return Math::Random::random_uniform(1, 0, 0.1);
}
##
# Create a new test case simulator
#
sub new {
my (
$class,
$name, # name of simulator
$rfnumgen, # number of reference sequences
$rflengen, # reference length
$rdnumgen, # number of read sequences per run
$rdlengen, # read length generator
$fraglengen, # fragment length generator
$ngen, # N fraction
$iupacgen, # Non-A/C/G/T/N IUPAC fraction (after N fraction removed)
$atgen, # AT fraction (after N/IUPAC fractions removed)
$agen, # A fraction (of AT)
$cgen, # C fraction (of CG)
$snpgen, # SNP rate gen
$rdgapgen, # read gap generator
$rfgapgen, # ref gap generator
$rearrgen, # rearrangement generator
$gaplengen, # gap length generator
$seqgen, # gap filler sequence generator
$seqmm, # sequencing error generator
) = @_;
$rfnumgen = \&defaultRefNumGen unless defined($rfnumgen);
$rflengen = \&defaultRefLenGen unless defined($rflengen);
$rdnumgen = \&defaultReadNumGen unless defined($rdnumgen);
$rdlengen = \&defaultReadLenGen unless defined($rdlengen);
$fraglengen = \&defaultFragLenGen unless defined($fraglengen);
$ngen = \&defaultNGen unless defined($ngen);
$iupacgen = \&defaultIupacGen unless defined($iupacgen);
$atgen = \&defaultAtGen unless defined($atgen);
$agen = \&defaultAGen unless defined($agen);
$cgen = \&defaultCGen unless defined($cgen);
$snpgen = \&defaultSNPGen unless defined($snpgen);
$rdgapgen = \&defaultRdGapGen unless defined($rdgapgen);
$rfgapgen = \&defaultRfGapGen unless defined($rfgapgen);
$rearrgen = \&defaultRearrGen unless defined($rearrgen);
$gaplengen = \&defaultGapLenGen unless defined($gaplengen);
$seqgen = \&defaultSeqGen unless defined($seqgen);
$seqmm = \&defaultSeqMmGen unless defined($seqmm);
$name = "noname" unless defined($name);
return bless {
_name => $name,
_rfnumgen => $rfnumgen,
_rflengen => $rflengen,
_rdnumgen => $rdnumgen,
_rdlengen => $rdlengen,
_fraglengen => $fraglengen,
_ngen => $ngen,
_iupacgen => $iupacgen,
_atgen => $atgen,
_agen => $agen,
_cgen => $cgen,
_snpgen => $snpgen,
_rdgapgen => $rdgapgen,
_rfgapgen => $rfgapgen,
_rearrgen => $rearrgen,
_gaplengen => $gaplengen,
_seqgen => $seqgen,
_seqmm => $seqmm,
}, $class;
}
sub rfnumgen { return $_[0]->{_rfnumgen} }
sub rflengen { return $_[0]->{_rflengen} }
sub rdnumgen { return $_[0]->{_rdnumgen} }
sub rdlengen { return $_[0]->{_rdlengen} }
sub fraglengen { return $_[0]->{_fraglengen} }
sub ngen { return $_[0]->{_ngen} }
sub iupacgen { return $_[0]->{_iupacgen} }
sub atgen { return $_[0]->{_atgen} }
sub agen { return $_[0]->{_agen} }
sub cgen { return $_[0]->{_cgen} }
sub snpgen { return $_[0]->{_snpgen} }
sub rdgapgen { return $_[0]->{_rdgapgen} }
sub rfgapgen { return $_[0]->{_rfgapgen} }
sub rearrgen { return $_[0]->{_rearrgen} }
sub gaplengen { return $_[0]->{_gaplengen} }
sub seqgen { return $_[0]->{_seqgen} }
sub seqmm { return $_[0]->{_seqmm} }
##
# Generate DNA generator.
#
sub genDNAgen {
my $self = shift;
my $nfrac = $self->ngen->();
my $iupacfrac = $self->iupacgen->();
my $atfrac = $self->atgen->();
my $afrac = $self->agen->();
my $cfrac = $self->cgen->();
my $refdnagen = RandDNA->new(
"Sim.pm gen",
$nfrac,
$iupacfrac,
$atfrac,
$afrac,
$cfrac);
printf STDERR "Created DNA generator\n";
printf STDERR " N frac: %0.3f\n", $nfrac;
printf STDERR " IUPAC frac: %0.3f\n", $iupacfrac;
printf STDERR " AT/ACGT frac: %0.3f\n", $atfrac;
printf STDERR " A/AT frac: %0.3f\n", $afrac;
printf STDERR " C/CG frac: %0.3f\n", $cfrac;
return $refdnagen;
}
##
# Generate and print reference sequences to file of given name. Also,
# install reference sequences into hash ref $ref. To allow for
# "overhang" (alignment that hang off the end of the reference), we
# actually write out a little bit less than the full reference sequence
# for each sequence.
#
sub genRef {
my ($self, $ref, $refdnagen, $conf, $tmpfn) = @_;
# Get a generator for reference length
my $reflen = $self->rflengen;
# Generate the number of references
my $refnum = $self->rfnumgen->();
$refnum = sqrt($refnum) if $conf->{small};
$refnum = 1 if $refnum <= 0;
$refnum = sqrt($refnum) if $conf->{small};
$refnum = 1 if $refnum <= 0;
$refnum = ceil($refnum);
$refnum = $conf->{numrefs} if defined($conf->{numrefs});
# Open output file
open (FA, ">$tmpfn") ||
mydie("Could not open temporary fasta file '$tmpfn' for writing");
my %ccnt = ();
print STDERR "Generating $refnum references\n";
for (1..$refnum) {
# Randomly generate length
my $len = $reflen->();
$len = sqrt($len) if $conf->{small};
$len = 1 if $len <= 0;
$len = ceil($len);
my $seq = $refdnagen->nextSeq($len);
length($seq) >= $len || die;
my $name = "Sim.pm.$_";
$ref->{$name} = $seq;
# Select amount to trim from LHS
my $trimleft = int(Math::Random::random_exponential(1, 200));
# Select amount to trim from RHS
my $trimright = int(Math::Random::random_exponential(1, 200));
# Make sure we're leaving some sequence after trimming
while($trimleft + $trimright > $len) {
if(int(rand(2))) {
$trimleft = int($trimleft*0.5);
} else {
$trimright = int($trimright*0.5);
}
}
# Trim the sequence
substr($seq, 0, $trimleft) = "";
$seq = substr($seq, 0, length($seq)-$trimright);
my $trimlen = length($seq);
$trimlen == $len - $trimleft - $trimright ||
mydie("Unexpected trim combo: $len, $trimleft, $trimright, $trimlen");
print STDERR " Generated reference '$name' of untrimmed length $len, trimmed length $trimlen\n";
print FA ">$name\n";
my $buf = "";
length($seq) >= $trimlen || die;
for my $i (1..$trimlen) {
my $c = substr($seq, $i-1, 1);
defined($c) || die;
$ccnt{$c}++;
$buf .= $c;
$ref->{$name} .= $c;
if($i % 60 == 0) {
print FA "$buf\n";
$buf = "";
}
}
print FA "$buf\n" if $buf ne "";
}
close(FA);
print STDERR "Wrote references to $tmpfn\n";
for my $k (sort keys %ccnt) {
print STDERR " $k: $ccnt{$k}\n";
}
}
##
# Generate a hash of key/value arguments to pass to bowtie2.
#
sub genBuildArgs {
my ($self) = @_;
my %args = ();
my $r1 = int(rand(3));
if($r1 == 0) {
$args{"--bmaxdivn"} = int(Math::Random::random_exponential(1, 4))+1;
} elsif($r1 == 1) {
$args{"--bmax"} = int(Math::Random::random_exponential(1, 10000))+100;
}
my $r2 = int(rand(2));
if($r2 == 0) {
$args{"--dcv"} = 2 ** (int(rand(10))+4);
}
my $r3 = int(rand(5));
if($r3 == 0) {
$args{"--packed"} = "";
}
my $r4 = int(rand(3));
if($r4 == 0) {
$args{"--offrate"} = int(rand(8))+1;
}
return \%args;
}
##
# Given a fasta filename, an index basename, and a path to the
# bowtie2-build executable, build nucleotide-space and colorpace
# indexes for the sequences in the fasta file.
#
sub build {
my ($self, $fa, $idx, $conf, $args) = @_;
my $argstr = "";
for (keys %$args) {
$argstr .= " $_";
if($args->{$_} ne "") {
$argstr .= " ".$args->{$_};
}
}
$argstr .= " --sanity";
# Build nucleotide index
my $cmd = "$conf->{bowtie2_build_debug} $argstr $fa $idx";
print STDERR "$cmd\n";
system($cmd);
$? == 0 || mydie("Error running '$cmd'; exitlevel=$?");
print STDERR "Built nucleotide index '$idx'\n";
# Build colorspace index
unless($conf->{no_color}) {
$cmd = "$conf->{bowtie2_build_debug} $argstr -C $fa ${idx}.c";
print STDERR "$cmd\n";
system($cmd);
$? == 0 || mydie("Error running '$cmd'; exitlevel=$?");
print STDERR "Built colorspace index '$idx'\n";
}
}
##
# Given a hash of sequences, flatten all IUPAC codes into unambiguous
# nucleotides.
#
sub flattenIUPAC() {
my ($self, $h) = @_;
for my $c (keys %$h) {
my $len = length($h->{$c});
for my $i (0..$len-1) {
my $ch = uc substr($h->{$c}, $i, 1);
my $nc = $ch;
if(DNA::isIUPAC($ch) || $ch eq "N") {
if(rand() < $self->snpgen->()) {
$nc = DNA::pickIncompat($ch);
defined($nc) || mydie("Couldn't find incompatible base for $ch");
} else {
$nc = DNA::pickCompat($ch);
defined($nc) || mydie("Couldn't find compatible base for $ch");
}
}
if($ch ne $nc) {
substr($h->{$c}, $i, 1) = $nc;
}
}
}
}
##
# Mutate reference genome into a subject genome.
#
sub mutate() {
my ($self, $refs) = @_;
my %subj = %$refs;
$self->flattenIUPAC(\%subj);
print STDERR "Flattened IUPAC characters\n";
my $mutator = Mutate->new(
"Sim.pm mutator",
$self->snpgen,
$self->rdgapgen,
$self->rfgapgen,
$self->rearrgen,
$self->gaplengen,
$self->seqgen);
my ($nsnp, $nrfgap, $nrdgap, $nrearr) = (0, 0, 0, 0);
for(keys %subj) {
print STDERR " Mutating sequence $_\n";
my ($nsnp_, $nrfgap_, $nrdgap_, $nrearr_) = $mutator->mutateSeq($_, \%subj);
$nsnp += $nsnp_;
$nrfgap += $nrfgap_;
$nrdgap += $nrdgap_;
$nrearr += $nrearr_;
}
print STDERR "Mutated reference genome to subject genome\n";
print STDERR " SNPs introduced: $nsnp\n";
print STDERR " Reference gaps introduced: $nrfgap\n";
print STDERR " Read gaps introduced: $nrdgap\n";
print STDERR " Rearrangements introduced: $nrearr\n";
return \%subj;
}
sub dumpFastq {
my ($self, $input, $fh1, $fh2) = @_;
for (1..scalar(@{$input->{seq1s}})) {
my $seq1 = $input->{seq1s}->[$_-1];
my $qual1 = $input->{qual1s}->[$_-1];
print {$fh1} "\@$_\n";
print {$fh1} "$seq1\n";
print {$fh1} "+$_\n";
print {$fh1} "$qual1\n";
if($input->{paired}) {
my $seq2 = $input->{seq2s}->[$_-1];
my $qual2 = $input->{qual2s}->[$_-1];
print {$fh2} "\@$_\n";
print {$fh2} "$seq2\n";
print {$fh2} "+$_\n";
print {$fh2} "$qual2\n";
}
}
}
sub dumpQseq {
my ($self, $input, $fh1, $fh2) = @_;
for (1..scalar(@{$input->{seq1s}})) {
my $seq1 = $input->{seq1s}->[$_-1];
my $qual1 = $input->{qual1s}->[$_-1];
print {$fh1} "R\t1\t1\t1\t$_\t$_\t1\t1\t$seq1\t$qual1\t1\n";
if($input->{paired}) {
my $seq2 = $input->{seq2s}->[$_-1];
my $qual2 = $input->{qual2s}->[$_-1];
print {$fh2} "R\t1\t1\t1\t$_\t$_\t1\t1\t$seq2\t$qual2\t1\n";
}
}
}
sub dumpFasta {
my ($self, $input, $fh1, $fh2) = @_;
for (1..scalar(@{$input->{seq1s}})) {
my $seq1 = $input->{seq1s}->[$_-1];
print {$fh1} ">$_\n";
print {$fh1} "$seq1\n";
if($input->{paired}) {
my $seq2 = $input->{seq2s}->[$_-1];
print {$fh2} ">$_\n";
print {$fh2} "$seq2\n";
}
}
}
sub dumpRaw {
my ($self, $input, $fh1, $fh2) = @_;
for (1..scalar(@{$input->{seq1s}})) {
my $seq1 = $input->{seq1s}->[$_-1];
print {$fh1} "$seq1\n";
if($input->{paired}) {
my $seq2 = $input->{seq2s}->[$_-1];
print {$fh2} "$seq2\n";
}
}
}
##
# Generate the input (reads plus paired/fragment information)
#
sub genInput {
my ($self, $refs, $conf) = @_;
# Select whether we're doing colorspace
my $color = int(rand(2));
$color = 0 if $conf->{no_color};
# Select whether we're doing unpaired or paired-end.
my $paired = int(rand(2));
$paired = 0 if $conf->{no_paired};
# Select format for read file
my @formats = ("fastq", "qseq", "fasta", "raw");
my @format_arg = ( "-q", "--qseq", "-f", "-r");
my $formati = int(rand(scalar(@formats)));
my $format = $formats[$formati];
my $format_arg = $format_arg[$formati];
my $tmprdfn1 = "$conf->{tempdir}/Sim.pm.$conf->{randstr}_1.$format";
my $tmprdfn2 = "$conf->{tempdir}/Sim.pm.$conf->{randstr}_2.$format";
# Generate reads from the subject genome; no sequencing error yet
my %input = (
seq1s => [],
seq2s => [],
qual1s => [],
qual2s => [],
mate1fw => 1,
mate2fw => 0,
paired => $paired,
color => $color,
format => $format,
format_arg => $format_arg,
file1 => $tmprdfn1,
file2 => $tmprdfn2 );
my $read_sampler = SampleRead->new(
"Sim.pm read sampler",
$self->fraglengen,
$self->rdlengen,
$self->rdlengen);
print STDERR "Created read sampler\n";
my $numreads = $self->rdnumgen->();
$numreads = ceil(sqrt($numreads)) if $conf->{small};
$numreads == int($numreads) || mydie("numreads $numreads not a number");
my $tmp = int(rand(3));
if($tmp == 0) {
$input{mate2fw} = 1;
} elsif($tmp == 1) {
$input{mate1fw} = 0;
$input{mate2fw} = 1;
}
print STDERR "Sampling $numreads reads\n";
ref($refs) eq "HASH" || mydie("Reference input must be hash ref");
if($paired) {
$read_sampler->genReadPairs(
$numreads, # number of reads/fragments to generate
$input{color}, # colorize?
$refs, # hash ref holding reference sequences
$input{mate1fw}, # orientation of mate 1 when fragment comes from Watson strand
$input{mate2fw}, # orientation of mate 2 when fragment comes from Watson strand
$input{seq1s}, # put generated mate1 sequences here
$input{seq2s}, # put generated mate2 sequences here
$input{qual1s}, # put generated mate1 quality sequences here
$input{qual2s}); # put generated mate2 quality sequences here
} else {
$read_sampler->genReads(
$numreads, # number of reads/fragments to generate
$input{color}, # colorize?
$refs, # hash ref holding reference sequences
$input{seq1s}, # put generated sequences here
$input{qual1s}); # put generated quality sequences here
}
# TODO: with some probability, sort the reads
print STDERR "Dumping reads to temporary files $tmprdfn1 & $tmprdfn2\n";
# Dump reads to output file
my ($fh1, $fh2);
open($fh1, ">$tmprdfn1") || mydie("Could not open '$tmprdfn1' for writing");
open($fh2, ">$tmprdfn2") || mydie("Could not open '$tmprdfn2' for writing");
if($format eq "fastq") {
$self->dumpFastq(\%input, $fh1, $fh2);
} elsif($format eq "qseq") {
$self->dumpQseq(\%input, $fh1, $fh2);
} elsif($format eq "fasta") {
$self->dumpFasta(\%input, $fh1, $fh2);
} elsif($format eq "raw") {
$self->dumpRaw(\%input, $fh1, $fh2);
}
close($fh1);
close($fh2);
return \%input;
}
##
# Mutate reads according to sequencing error model.
#
sub mutateSeq {
my ($self, $input) = @_;
return $input;
}
##
# Generate a setting for MA (match bonus).
#
sub genPolicyMA($) {
my $local = shift;
return "" if ($local || int(rand(2)) == 0);
return "MA=".Math::Random::random_uniform(1, 1, 40).";";
}
##
# Generate a setting for MMP (mismatch penalty).
#
sub genPolicyMMP() {
return "" if int(rand(2)) == 0;
my $op = substr("CQR", int(rand(3)), 1);
if($op eq "C") {
$op .= Math::Random::random_uniform(1, 1, 40);
}
return "MMP=$op;";
}
##
# Generate a setting for NP (penalty for a mismatch involving an N).
#
sub genPolicyNP() {
return "" if int(rand(2)) == 0;
my $op = substr("CQR", int(rand(3)), 1);
if($op eq "C") {
$op .= int(Math::Random::random_exponential(1, 3))+1;
}
return "NP=$op;";
}
##
# Generate a setting for RDG (read gap open and extend penalties).
#
sub genPolicyRDG() {
return undef if int(rand(2)) == 0;
my $op = Math::Random::random_uniform(1, 1, 50);
if(int(rand(2)) == 0) {
$op .= ",";
$op .= Math::Random::random_uniform(1, 1, 20);
}
return "$op";
}
##
# Generate a setting for RFG (ref gap open and extend penalties).
#
sub genPolicyRFG() {
return undef if int(rand(2)) == 0;
my $op = Math::Random::random_uniform(1, 1, 50);
if(int(rand(2)) == 0) {
$op .= ",";
$op .= Math::Random::random_uniform(1, 1, 20);
}
return "$op";
}
##
# Generate a setting for MIN (function determining minimum acceptable score).
#
sub genPolicyMIN($) {
my $local = shift;
return undef if ($local || int(rand(2)) == 0);
my $xx = Math::Random::random_uniform(1, 1, 10);
my $yy = Math::Random::random_uniform(1, 1, 10);
if(!$local) {
$xx = -$xx if int(rand(2)) == 0;
$yy = -$yy;
}
return "L,$xx,$yy";
}
##
# Generate a setting for NCEIL (function determining maximum number of Ns
# allowed).
#
sub genPolicyNCEIL() {
return undef if int(rand(2)) == 0;
my $xx = Math::Random::random_uniform(1, 0, 1.5);
my $yy = Math::Random::random_uniform(1, 0, 1.5);
return "$xx,$yy";
}
##
# Generate a setting for SEED (# mismatches, length, interval).
#
sub genPolicySEED() {
return undef if int(rand(2)) == 0;
# Pick a number of mismatches
my $sd = substr("012", int(rand(2)), 1);
if(rand() < 0.9) {
# Length
$sd .= ",".int(Math::Random::random_uniform(1, 12, 32));
}
return $sd;
}
##
# Generate a setting for -D (# DP fails in a row).
#
sub genPolicyFailStreak() {
return undef if int(rand(2)) == 0;
return int(Math::Random::random_uniform(1, 2, 50));
}
##
# Generate a setting for -R (# seeding rounds).
#
sub genPolicySeedRounds() {
return undef if int(rand(2)) == 0;
return int(Math::Random::random_uniform(1, 1, 5));
}
##
# Generate a setting for IVAL. Interval between seeds is a function of the
# read length OR sqaure root of read length OR cube root of read length.
#
sub genPolicyIVAL() {
return "" if int(rand(2)) == 0;
# Pick a number of mismatches
my $iv = substr("LSC", int(rand(3)), 1);
if($iv eq "L") {
if(rand() < 0.9) {
# Multiplier
$iv .= ",".Math::Random::random_uniform(1, 0.0, 0.5);
}
if(rand() < 0.3) {
# Offset
$iv .= ",".Math::Random::random_uniform(1, 0.0, 4.0);
}
} elsif($iv eq "S") {
if(rand() < 0.9) {
# Multiplier
$iv .= ",".Math::Random::random_uniform(1, 0.0, 3.0);
}
if(rand() < 0.3) {
# Offset
$iv .= ",".Math::Random::random_uniform(1, 0.0, 7.0);
}
} elsif($iv eq "C") {
if(rand() < 0.9) {
# Multiplier
$iv .= ",".Math::Random::random_uniform(1, 0.0, 5.0);
}
if(rand() < 0.3) {
# Offset
$iv .= ",".Math::Random::random_uniform(1, 0.0, 14.0);
}
}
return "IVAL=$iv;";
}
##
# Generate a random but meaningful string of policy arguments to specify using
# the -P option.
#
sub genPolicyArg($) {
my $local = shift;
my $args = "";
$args .= genPolicyMA($local);
$args .= genPolicyMMP();
$args .= genPolicyNP();
$args .= genPolicyIVAL();
if($args ne "") {
return substr($args, 0, -1);
} else { return ""; }
}
##
# Generate a hash of key/value arguments to pass to bowtie2.
#
sub genAlignArgs {
my ($self, $input, $color, $conf) = @_;
my %args = ();
my $local = int(rand(2)) == 0;
$args{"-u"} = $conf->{maxreads} if defined($conf->{maxreads});
$args{"--mm"} = "" if int(rand(2)) == 0;
#$args{"--overhang"} = "" if int(rand(2)) == 0;
$args{"--trim3"} = int(rand(10)) if int(rand(2)) == 0;
$args{"--trim5"} = int(rand(10)) if int(rand(2)) == 0;
$args{"--nofw"} = "" if int(rand(4)) == 0;
$args{"--norc"} = "" if int(rand(4)) == 0;
$args{"--col-keepends"} = "" if ($color && int(rand(3)) == 0);
$args{"--gbar"} = int(Math::Random::random_exponential(1, 3))+1 if int(rand(4)) == 0;
$args{"--local"} = "" if $local;
my $rep = int(rand(5));
if($rep == 0) {
$args{"-a"} = "";
} elsif($rep == 1) {
$args{"-k"} = int(Math::Random::random_exponential(1, 3))+2;
} elsif($rep == 2) {
$args{"-M"} = int(Math::Random::random_exponential(1, 3))+2;
}
$args{"--rdg"} = genPolicyRDG();
$args{"--rfg"} = genPolicyRFG();
$args{"--score-min"} = genPolicyMIN($local);
$args{"--n-ceil"} = genPolicyNCEIL();
$args{"-N"} = genPolicySEED();
$args{"-D"} = genPolicyFailStreak();
$args{"-R"} = genPolicySeedRounds();
$args{"--policy"} = ("\"".genPolicyArg($local)."\"") if rand() < 0.9;
$args{"--cp-min"} = int(Math::Random::random_exponential(1, 3)) + 2;
$args{"--cp-ival"} = int(Math::Random::random_exponential(1, 1)) + 1;
return \%args;
}
##
# Align the given input set against the given index using the given
# bowtie2 binary and arguments. Sanity-check the SAM output.
#
sub align {
my ($self, $fa, $idx, $input, $conf, $args) = @_;
my $argstr = "";
for (keys %$args) {
if(defined($args->{$_})) {
$argstr .= " $_";
if($args->{$_} ne "") {
$argstr .= " ".$args->{$_};
}
}
}
$argstr .= " -C" if $input->{color};
$argstr .= " ".$input->{format_arg};
$idx .= ".c" if $input->{color};
my $inputfn;
if($input->{paired}) {
$inputfn = "-1 $input->{file1} -2 $input->{file2}";
} else {
$inputfn = $input->{file1};
}
# Create object that will help us sanity-check alignments
my $ac = AlignmentCheck->new(
"Sim.pm alignment checker", # name
[ $fa ], # fasta
"sam", # SAM-formatted alignments
0, # no bis-C
0 # no bis-CpG
);
$ac->nrefs() > 0 || mydie("No references");
# Run normal (non-debug) Bowtie
defined($conf->{tempdir}) || mydie("No tmp dir");
my $als = "$conf->{tempdir}/Sim.pm.$conf->{randstr}.als";
my $als_debug = "$conf->{tempdir}/Sim.pm.$conf->{randstr}.debug.als";
my $als_px = "$conf->{tempdir}/Sim.pm.$conf->{randstr}.px.als";
my $als_px_reord = "$conf->{tempdir}/Sim.pm.$conf->{randstr}.px.reord.als";
my $cmd = "$conf->{bowtie2_debug} $argstr $idx $inputfn";
print "$cmd\n";
open(ALSDEB, ">$als_debug") || mydie("Could not open '$als_debug' for writing");
open(ALSDEBCMD, "$cmd |") || mydie("Could not open pipe '$cmd |'");
my $ival = 50;
my $nals = 0;
my @lines = ();
while(<ALSDEBCMD>) {
# Remove @PG line because CL: tag can legitimately differ
print ALSDEB $_ unless /^\@PG/;
push @lines, $_;
$nals++;
print STDERR " Read $nals alignments...\n" if ($nals % $ival) == 0;
}
close(ALSDEBCMD);
$ac->checkAlignments(\@lines, 0);
$? == 0 || mydie("bowtie2-align-debug exited with exitlevel $?:\n$cmd\n");
close(ALSDEB);
$ac->printSummary();
# With some probability, also run debug Bowtie and check that
# results are identical
if(int(rand(3)) == 0) {
print STDERR "ALSO checking that bowtie2 and bowtie2-align-debug match up\n";
# Remove @PG line because CL: tag can legitimately differ
$cmd = "$conf->{bowtie2} $argstr $idx $inputfn | grep -v '^\@PG' > $als";
print "$cmd\n";
system($cmd);
$? == 0 ||
mydie("Command '$cmd' failed with exitlevel $?");
$cmd = "diff -uw $als $als_debug";
print "$cmd\n";
system($cmd);
$? == 0 ||
mydie("diff found a difference between bowtie2 and bowtie2-align-debug ".
"output for same input (above)\n");
}
# With some probability, also run debug Bowtie in -p X mode with X > 1 and
# without the --reorder argument and check that results are identical
if(int(rand(3)) == 0) {
print STDERR "ALSO checking that bowtie2 and bowtie2 -p X w/ X > 1 match up\n";
my $p = int(rand(3))+2;
$cmd = "$conf->{bowtie2} $argstr -p $p $idx $inputfn | grep -v '^\@PG' > $als_px";
print "$cmd\n";
system($cmd);
$? == 0 ||
mydie("Command '$cmd' failed with exitlevel $?");
# Sort the $als_px and $als_debug files to guarantee that reads and
# alignments for a given read appear in the same order in both
$cmd = "sort -k 1,1 -n -k 2,2 -k 3,3 -k 4,4 < $als_px | grep -v '^\@PG' > $als_px.sorted";
print "$cmd\n";
system($cmd);
$? == 0 ||
mydie("Failed to sort alignment file $als_px\n");
# Sort the $als_px and $als_debug files to guarantee that reads and
# alignments for a given read appear in the same order in both
$cmd = "sort -k 1,1 -n -k 2,2 -k 3,3 -k 4,4 < $als_debug | grep -v '^\@PG' > $als_debug.sorted";
print "$cmd\n";
system($cmd);
$? == 0 ||
mydie("Failed to sort alignment file $als_debug\n");
$cmd = "diff -uw $als_debug.sorted $als_px.sorted";
print "$cmd\n";
system($cmd);
$? == 0 ||
mydie("diff found a difference between bowtie2-align-debug and bowtie2 ".
"-p output for same input (above)\n");
}
# With some probability, also run debug Bowtie in -p X mode with X > 1 and
# with the --reorder argument and check that results are identical
if(int(rand(3)) == 0) {
print STDERR "ALSO checking that bowtie2 and bowtie2 -p X --reorder w/ X > 1 match up\n";
my $p = int(rand(3))+2;
$cmd = "$conf->{bowtie2} $argstr -p $p $idx --reorder $inputfn | grep -v '^\@PG' > $als_px_reord";
print "$cmd\n";
system($cmd);
$? == 0 || mydie("Command '$cmd' failed with exitlevel $?");
$cmd = "diff -uw $als_debug $als_px_reord";
print "$cmd\n";
system($cmd);
$? == 0 ||
mydie("diff found a difference between bowtie2-align-debug and bowtie2 ".
"-p --reorder output for same input (above)\n");
}
}
##
# Generate a new test case
#
# Possible key/value pairs in $conf hash:
#
# 1. bowtie2_build: path to bowtie2-build binary
# 2. bowtie2: path to bowtie2 binary
# 3. bowtie2_build_debug: path to bowtie2-build-debug binary
# 4. bowtie2_debug: path to bowtie2-debug binary
# 5. tempdir: temporary directory for reference/reads/index
# 6. no_paired: defined & non-0 -> don't generate paired-end datasets
# 7. no_color: defined & non-0 -> don't generate colorspace datasets
# 8. single_thread: defined & non-0 -> don't use -p X where X > 1
#
sub nextCase {
my ($self, $conf) = @_;
$conf->{bowtie2_build} = "bowtie2-build" unless defined($conf->{bowtie2_build});
$conf->{bowtie2} = "bowtie2-align" unless defined($conf->{bowtie2});
$conf->{bowtie2_build_debug} = "bowtie2-build-debug" unless defined($conf->{bowtie2_build_debug});
$conf->{bowtie2_debug} = "bowtie2-align-debug" unless defined($conf->{bowtie2_debug});
$conf->{tempdir} = "/tmp" unless defined($conf->{tempdir});
srand(time ^ $$);
$conf->{randstr} = randStr(8);
print "*** TEST CASE ***\n";
# Generate the references
my $refdnagen = $self->genDNAgen();
# Generate references and write them to a temporary fasta file
my $tmpfn = "$conf->{tempdir}/Sim.pm.$conf->{randstr}.fa";
my %refs = ();
$self->genRef(\%refs, $refdnagen, $conf, $tmpfn);
# Run bowtie2-build
my $tmpidxfn = "$conf->{tempdir}/Sim.pm.$conf->{randstr}";
my $buildArgs = $self->genBuildArgs();
$self->build($tmpfn, $tmpidxfn, $conf, $buildArgs);
my $numruns = 10;
$numruns *= 10 if $conf->{small}; # Lots of short runs
# For each batch of reads / bowtie options
for(1..$numruns) {
print "*** Run $_ of $numruns\n";
# Generate mutated version of the reference as our subject genome
my $subj = $self->mutate(\%refs);
# Generate all the input, including reads, pairedness,
# fragment information, whether it's colorspace, etc
my $input = $self->genInput($subj, $conf);
# Mutate the input
my $mutinput = $self->mutateSeq($input);
# Select Bowtie arguments
my $args = $self->genAlignArgs($mutinput, $input->{color}, $conf);
$self->align($tmpfn, $tmpidxfn, $mutinput, $conf, $args);
# Sanity check output. Possible sanity checks are:
# 1. Check alignments & edits against reference
# 2. Compare bowtie2 and bowtie2-debug
# 3. Compare -p X>1 and -p 1
}
}
if($0 =~ /Sim\.pm$/) {
print "Running unit tests\n";
# Run unit tests
}
1;
Reference in New Issue View Git Blame Copy Permalink