This module is just a collection of subroutines, not an object.
sub _adjust_contigs
{ my ($seqType, $hsp, $start, $stop, $contigs_ref,
$max_overlap, $frame, $strand) = @_;
my $overlap = 0;
my ($numID, $numCons);
foreach ( @$contigs_ref) {
next unless ($_->{'frame'} == $frame and $_->{'strand'} == $strand);
if($start >= $_->{'start'} and $stop <= $_->{'stop'}) {
$overlap = 1;
next;
}
if($start < $_->{'start'} and $stop > ($_->{'start'} + $max_overlap)) {
eval {
($numID, $numCons) = $hsp->matches(-SEQ =>$seqType,
-START =>$start,
-STOP =>$_->{'start'}-1);
};
if($@) { warn "\a\n$@\n"; }
else {
$_->{'start'} = $start; $_->{'iden'} += $numID; $_->{'cons'} += $numCons;
$overlap = 1;
}
}
if($stop > $_->{'stop'} and
$start < ($_->{'stop'} - $max_overlap)) {
eval {
($numID,$numCons) = $hsp->matches(-SEQ =>$seqType,
-START =>$_->{'stop'},
-STOP =>$stop);
};
if($@) { warn "\a\n$@\n"; }
else {
$_->{'stop'} = $stop; $_->{'iden'} += $numID; $_->{'cons'} += $numCons;
$overlap = 1;
}
}
$overlap && do {
last;
};
}
!$overlap && do {
($numID,$numCons) = $hsp->matches(-SEQ=>$seqType);
push @$contigs_ref, {'start'=>$start, 'stop'=>$stop,
'iden'=>$numID, 'cons'=>$numCons,
'strand'=>$strand, 'frame'=>$frame};
};
$overlap; } |
sub collapse_nums
{
my @a = @_;
my ($from, $to, $i, @ca, $consec);
$consec = 0;
for($i=0; $i < @a; $i++) {
not $from and do{ $from = $a[$i]; next; };
if($a[$i] == $a[$i-1]+1) {
$to = $a[$i];
$consec++;
} else {
if($consec == 1) { $from .= ",$to"; }
else { $from .= $consec>1 ? "\-$to" : ""; }
push @ca, split(',', $from);
$from = $a[$i];
$consec = 0;
$to = undef;
}
}
if(defined $to) {
if($consec == 1) { $from .= ",$to"; }
else { $from .= $consec>1 ? "\-$to" : ""; }
}
push @ca, split(',', $from) if $from;
@ca; } |
sub tile_hsps
{ my $sbjct = shift;
$sbjct->tiled_hsps(1);
$sbjct->gaps('query', 0);
$sbjct->gaps('hit', 0);
if( $sbjct->n == 1 or $sbjct->num_hsps == 1) {
my $hsp = $sbjct->hsp;
$sbjct->length_aln('query', $hsp->length('query'));
$sbjct->length_aln('hit', $hsp->length('sbjct'));
$sbjct->length_aln('total', $hsp->length('total'));
$sbjct->matches( $hsp->matches() );
$sbjct->gaps('query', $hsp->gaps('query'));
$sbjct->gaps('sbjct', $hsp->gaps('sbjct'));
return;
} else {
$sbjct->length_aln('query', 0);
$sbjct->length_aln('sbjct', 0);
$sbjct->length_aln('total', 0);
$sbjct->matches( 0, 0);
}
my($hsp, $qstart, $qstop, $sstart, $sstop);
my($frame, $strand, $qstrand, $sstrand);
my(@qcontigs, @scontigs);
my $qoverlap = 0;
my $soverlap = 0;
my $max_overlap = $sbjct->overlap;
my $hit_qgaps = 0;
my $hit_sgaps = 0;
my $hit_len_aln = 0;
my %start_stop;
foreach $hsp ($sbjct->hsps()) {
($qstart, $qstop) = $hsp->range('query');
($sstart, $sstop) = $hsp->range('sbjct');
$frame = $hsp->frame;
$frame = -1 unless defined $frame;
($qstrand, $sstrand) = ($hsp->query->strand,
$hsp->hit->strand);
my ($qgaps, $sgaps) = ($hsp->gaps('query'), $hsp->gaps('hit'));
$hit_qgaps += $qgaps;
$hit_sgaps += $sgaps;
$hit_len_aln += $hsp->length;
$qoverlap = &_adjust_contigs('query', $hsp, $qstart, $qstop,\@
qcontigs, $max_overlap, $frame,
$qstrand);
$soverlap = &_adjust_contigs('sbjct', $hsp, $sstart, $sstop,\@
scontigs, $max_overlap, $frame,
$sstrand);
if(not defined $start_stop{'qstart'}) {
$start_stop{'qstart'} = $qstart;
$start_stop{'qstop'} = $qstop;
$start_stop{'sstart'} = $sstart;
$start_stop{'sstop'} = $sstop;
} else {
$start_stop{'qstart'} = ($qstart < $start_stop{'qstart'} ?
$qstart : $start_stop{'qstart'} );
$start_stop{'qstop'} = ($qstop > $start_stop{'qstop'} ?
$qstop : $start_stop{'qstop'} );
$start_stop{'sstart'} = ($sstart < $start_stop{'sstart'} ?
$sstart : $start_stop{'sstart'} );
$start_stop{'sstop'} = ($sstop > $start_stop{'sstop'} ?
$sstop : $start_stop{'sstop'} );
}
}
$sbjct->gaps('query', $hit_qgaps);
$sbjct->gaps('hit', $hit_sgaps);
$sbjct->length_aln('total', $hit_len_aln);
$sbjct->start('query',$start_stop{'qstart'});
$sbjct->end('query', $start_stop{'qstop'});
$sbjct->start('hit', $start_stop{'sstart'});
$sbjct->end('hit', $start_stop{'sstop'});
my (%qctg_dat);
foreach(@qcontigs) {
($frame, $strand) = ($_->{'frame'}, $_->{'strand'});
$qctg_dat{ "$frame$strand" }->{'length_aln_query'} += $_->{'stop'} - $_->{'start'} + 1;
$qctg_dat{ "$frame$strand" }->{'totalIdentical'} += $_->{'iden'};
$qctg_dat{ "$frame$strand" }->{'totalConserved'} += $_->{'cons'};
$qctg_dat{ "$frame$strand" }->{'qstrand'} = $strand;
}
my @sortedkeys = reverse sort { $qctg_dat{ $a }->{'length_aln_query'} <=> $qctg_dat{ $b }->{'length_aln_query'} } keys %qctg_dat;
my $longest = $sortedkeys[0];
$sbjct->length_aln('query', $qctg_dat{ $longest }->{'length_aln_query'});
$sbjct->matches($qctg_dat{ $longest }->{'totalIdentical'},
$qctg_dat{ $longest }->{'totalConserved'});
$sbjct->strand('query', $qctg_dat{ $longest }->{'qstrand'});
my (%sctg_dat);
foreach(@scontigs) {
($frame, $strand) = ($_->{'frame'}, $_->{'strand'});
$sctg_dat{ "$frame$strand" }->{'length_aln_sbjct'} += $_->{'stop'} - $_->{'start'} + 1;
$sctg_dat{ "$frame$strand" }->{'frame'} = $frame;
$sctg_dat{ "$frame$strand" }->{'sstrand'} = $strand;
}
@sortedkeys = reverse sort { $sctg_dat{ $a }->{'length_aln_sbjct'} <=> $sctg_dat{ $b }->{'length_aln_sbjct'} } keys %sctg_dat;
$longest = $sortedkeys[0];
$sbjct->length_aln('sbjct', $sctg_dat{ $longest }->{'length_aln_sbjct'});
$sbjct->frame( $sctg_dat{ $longest }->{'frame'} );
$sbjct->strand('hit', $sctg_dat{ $longest }->{'sstrand'});
if($qoverlap) {
if($soverlap) { $sbjct->ambiguous_aln('qs');
}
else { $sbjct->ambiguous_aln('q');
}
} elsif($soverlap) {
$sbjct->ambiguous_aln('s');
}
my $prog = $sbjct->algorithm;
if($prog eq 'TBLASTN') {
$sbjct->length_aln('sbjct', $sbjct->length_aln('sbjct')/3); } elsif($prog eq 'BLASTX' ) {
$sbjct->length_aln('query', $sbjct->length_aln('query')/3); } elsif($prog eq 'TBLASTX') {
$sbjct->length_aln('query', $sbjct->length_aln('query')/3); $sbjct->length_aln('sbjct', $sbjct->length_aln('sbjct')/3); } } |