This object handles the High Scoring Pair data for a Blast report.
This is where the percent identity, query and hit sequence length,
P value, etc are stored and where most of the necessary information is located when building logic around parsing a Blast report.
See
Bio::Tools::BPlite for more detailed information on the entire
BPlite Blast parsing system.
sub P
{ my ($self, @args) = @_;
my $float = $self->significance(@args);
my $match = '([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?'; if ($float =~ /^$match$/) {
return $float;
} elsif ("1$float" =~ /^$match$/) {
return "1$float";
} else {
$self->warn("[HSP::P()] '$float' is not a known number format. Returning zero (0) instead.");
return 0;
} } |
sub frame
{ my ($self, $qframe, $sframe) = @_;
if( defined $qframe ) {
if( $qframe == 0 ) {
$qframe = undef;
} elsif( $qframe !~ /^([+-])?([1-3])/ ) {
$self->warn("Specifying an invalid query frame ($qframe)");
$qframe = undef;
} else {
if( ($1 eq '-' && $self->query->strand >= 0) ||
($1 eq '+' && $self->query->strand <= 0) ) {
$self->warn("Query frame ($qframe) did not match strand of query (". $self->query->strand() . ")");
}
$qframe = $2 - 1;
}
$self->{'QFRAME'} = $qframe;
}
if( defined $sframe ) {
if( $sframe == 0 ) {
$sframe = undef;
} elsif( $sframe !~ /^([+-])?([1-3])/ ) {
$self->warn("Specifying an invalid hit frame ($sframe)");
$sframe = undef;
} else {
if( ($1 eq '-' && $self->hit->strand >= 0) ||
($1 eq '+' && $self->hit->strand <= 0) )
{
$self->warn("Hit frame ($sframe) did not match strand of hit (". $self->hit->strand() . ")");
}
$sframe = $2 - 1;
}
$self->{'SFRAME'} = $sframe;
}
(defined $qframe && $self->SUPER::frame($qframe) &&
($self->{'FRAME'} = $qframe)) ||
(defined $sframe && $self->SUPER::frame($sframe) &&
($self->{'FRAME'} = $sframe));
if (wantarray() &&
$self->{'BLAST_TYPE'} eq 'TBLASTX')
{
return ($self->{'QFRAME'}, $self->{'SFRAME'});
} elsif (wantarray()) {
(defined $self->{'QFRAME'} &&
return ($self->{'QFRAME'}, undef)) ||
(defined $self->{'SFRAME'} &&
return (undef, $self->{'SFRAME'}));
} else {
(defined $self->{'QFRAME'} &&
return $self->{'QFRAME'}) ||
(defined $self->{'SFRAME'} &&
return $self->{'SFRAME'});
}
}
1; } |
sub new
{ my ($class, @args) = @_;
my %newargs = @args;
foreach ( keys %newargs ) {
if( /frame$/i ) {
delete $newargs{$_};
}
}
my $self = $class->SUPER::new(%newargs);
my ($score,$bits,$match,$hsplength,$positive,$gaps,$p,$exp,$qb,$qe,$sb,
$se,$qs,$ss,$hs,$qname,$sname,$qlength,$slength,$qframe,$sframe,
$blasttype) =
$self->_rearrange([qw(SCORE
BITS
MATCH
HSPLENGTH
POSITIVE
GAPS
P
EXP
QUERYBEGIN
QUERYEND
SBJCTBEGIN
SBJCTEND
QUERYSEQ
SBJCTSEQ
HOMOLOGYSEQ
QUERYNAME
SBJCTNAME
QUERYLENGTH
SBJCTLENGTH
QUERYFRAME
SBJCTFRAME
BLASTTYPE
)],@args);
$blasttype = 'UNKNOWN' unless $blasttype;
$self->report_type($blasttype);
my ($queryfactor, $sbjctfactor) = (1,0); if ($blasttype eq 'BLASTP' || $blasttype eq 'TBLASTN' ) {
$queryfactor = 0;
}
if ($blasttype eq 'TBLASTN' || $blasttype eq 'TBLASTX' ||
$blasttype eq 'BLASTN' ) {
$sbjctfactor = 1;
}
$self->{'BLAST_TYPE'} = $blasttype;
my $strand;
if ($qe > $qb) { if ($queryfactor) { $strand = 1; } else { $strand = undef; }
$self->query( Bio::SeqFeature::Similarity->new
(-start=>$qb, -end=>$qe, -strand=>$strand,
-source=>"BLAST" ) ) }
else { if ($queryfactor) { $strand = -1; } else { $strand = undef; }
$self->query( Bio::SeqFeature::Similarity->new
(-start=>$qe, -end=>$qb, -strand=>$strand,
-source=>"BLAST" ) ) }
if ($se > $sb) { if ($sbjctfactor) { $strand = 1; } else { $strand = undef; }
$self->hit( Bio::SeqFeature::Similarity->new
(-start=>$sb, -end=>$se, -strand=>$strand,
-source=>"BLAST" ) ) }
else { if ($sbjctfactor) { $strand = -1; } else { $strand = undef; }
$self->hit( Bio::SeqFeature::Similarity->new
(-start=>$se, -end=>$sb, -strand=>$strand,
-source=>"BLAST" ) ) }
$self->query->seq_id($qname); $self->hit->seq_id($sname);
$self->query->seqlength($qlength); $self->hit->seqlength($slength);
$self->score($score);
$self->bits($bits);
$self->significance($p);
$self->{'EXP'} = $exp;
$self->query->frac_identical($match);
$self->hit->frac_identical($match);
$self->{'HSPLENGTH'} = $hsplength;
$self->{'PERCENT'} = int((1000 * $match)/$hsplength)/10;
$self->{'POSITIVE'} = $positive;
$self->{'GAPS'} = $gaps;
$self->{'QS'} = $qs;
$self->{'SS'} = $ss;
$self->{'HS'} = $hs;
$self->frame($qframe, $sframe);
return $self; }
} |
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/MailList.shtml - About the mailing lists
The rest of the documentation details each of the object methods.
Internal methods are usually preceded with a _