#
# BioPerl module for Bio::DB::Qual
#
# You may distribute this module under the same terms as perl itself
#
=head1 NAME
Bio::DB::Qual - Fast indexed access to quality files
=head1 SYNOPSIS
use Bio::DB::Qual;
# create database from directory of qual files
my $db = Bio::DB::Qual->new('/path/to/qual/files/');
my @ids = $db->get_all_primary_ids;
# Simple access
my @qualarr = @{$db->qual('CHROMOSOME_I',4_000_000 => 4_100_000)};
my @revqual = @{$db->qual('CHROMOSOME_I',4_100_000 => 4_000_000)};
my $length = $db->length('CHROMOSOME_I');
my $header = $db->header('CHROMOSOME_I');
# Access to sequence objects. See Bio::PrimarySeqI.
my $obj = $db->get_Qual_by_id('CHROMOSOME_I');
my @qual = @{$obj->qual};
my @subqual = @{$obj->subqual(4_000_000 => 4_100_000)};
my $length = $obj->length;
# Loop through sequence objects
my $stream = $db->get_PrimarySeq_stream;
while (my $qual = $stream->next_seq) {
# Bio::Seq::PrimaryQual operations
}
# Filehandle access
my $fh = Bio::DB::Qual->newFh('/path/to/qual/files/');
while (my $qual = <$fh>) {
# Bio::Seq::PrimaryQual operations
}
# Tied hash access
tie %qualities,'Bio::DB::Qual','/path/to/qual/files/';
print $qualities{'CHROMOSOME_I:1,20000'};
=head1 DESCRIPTION
Bio::DB::Qual provides indexed access to a single Fasta file, several files,
or a directory of files. It provides random access to each quality score entry
without having to read the file from the beginning. Access to subqualities
(portions of a quality score) is provided, although contrary to Bio::DB::Fasta,
the full quality score has to be brought in memory. Bio::DB::Qual is based on
Bio::DB::IndexedBase. See this module's documentation for details.
The qual files should contain decimal quality scores. Entries may have any line
length up to 65,536 characters, and different line lengths are allowed in the
same file. However, within a quality score entry, all lines must be the same
length except for the last. An error will be thrown if this is not the case.
The module uses /^E<gt>(\S+)/ to extract the primary ID of each quality score
from the qual header. See -makeid in Bio::DB::IndexedBase to pass a callback
routine to reversibly modify this primary ID, e.g. if you wish to extract a
specific portion of the gi|gb|abc|xyz GenBank IDs.
=head1 DATABASE CREATION AND INDEXING
The object-oriented constructor is new(), the filehandle constructor is newFh()
and the tied hash constructor is tie(). They all allow to index a single Fasta
file, several files, or a directory of files. See Bio::DB::IndexedBase.
=head1 SEE ALSO
L<Bio::DB::IndexedBase>
L<Bio::DB::Fasta>
L<Bio::Seq::PrimaryQual>
=head1 LIMITATIONS
When a quality score is deleted from one of the qual files, this deletion is not
detected by the module and removed from the index. As a result, a "ghost" entry
will remain in the index and will return garbage results if accessed. Currently,
the only way to accommodate deletions is to rebuild the entire index, either by
deleting it manually, or by passing -reindex=E<gt>1 to new() when
initializing the module.
All quality score lines for a given quality score must have the same length
except for the last (not sure why there is this limitation). This is not
problematic for sequences but could be annoying for quality scores. A workaround
is to make sure that your quality scores fit on no more than 2 lines. Another
solution could be to padd them with blank spaces so that each line has the same
number of characters (maybe this padding should be implemented in
Bio::SeqIO::qual?).
=head1 AUTHOR
Florent E Angly E<lt>florent . angly @ gmail-dot-comE<gt>.
Module largely based on and adapted from Bio::DB::Fasta by Lincoln Stein.
Copyright (c) 2007 Florent E Angly.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=head1 APPENDIX
The rest of the documentation details each of the object
methods. Internal methods are usually preceded with a _
For BioPerl-style access, the following methods are provided:
=head2 get_Seq_by_id
Title : get_Seq_by_id, get_Seq_by_acc, get_Seq_by_version, get_Seq_by_primary_id,
get_Qual_by_id, get_qual_by_acc, get_qual_by_version, get_qual_by_primary_id,
Usage : my $seq = $db->get_Seq_by_id($id);
Function: Given an ID, fetch the corresponding sequence from the database.
Returns : A Bio::PrimarySeq::Fasta object (Bio::PrimarySeqI compliant)
Note that to save resource, Bio::PrimarySeq::Fasta sequence objects
only load the sequence string into memory when requested using seq().
See L<Bio::PrimarySeqI> for methods provided by the sequence objects
returned from get_Seq_by_id() and get_PrimarySeq_stream().
Args : ID
=head2 get_PrimarySeq_stream
Title : get_Seq_stream, get_PrimarySeq_stream
Usage : my $stream = $db->get_Seq_stream();
Function: Get a stream of Bio::PrimarySeq::Fasta objects. The stream supports a
single method, next_seq(). Each call to next_seq() returns a new
Bio::PrimarySeq::Fasta sequence object, until no more sequences remain.
Returns : A Bio::DB::Indexed::Stream object
Args : None
=head1
For simple access, the following methods are provided:
=cut
package Bio::DB::Qual;
use strict;
use IO::File;
use File::Spec;
use base qw(Bio::DB::IndexedBase);
our $obj_class = 'Bio::Seq::PrimaryQual::Qual';
our $file_glob = '*.{qual,QUAL,qa,QA}';
=head2 new
Title : new
Usage : my $db = Bio::DB::Qual->new( $path, %options);
Function: Initialize a new database object. When indexing a directory, files
ending in .qual,qa are indexed by default.
Returns : A new Bio::DB::Qual object
Args : A single file, or path to dir, or arrayref of files
Optional arguments: see Bio::DB::IndexedBase
=cut
sub _calculate_offsets {
# Bio::DB::IndexedBase calls this to calculate offsets
my ($self, $fileno, $file, $offsets) = @_;
my $fh = IO::File->new($file) or $self->throw("Could not open $file: $!");
binmode $fh;
warn "Indexing $file\n" if $self->{debug};
my ($offset, @ids, $linelen, $headerlen, $count, $qual_lines, $last_line,
$numres, %offsets);
my ($l3_len, $l2_len, $l_len, $blank_lines) = (0, 0, 0, 0);
my $termination_length = $self->{termination_length};
while (my $line = <$fh>) {
# Account for crlf-terminated Windows files
if (index($line, '>') == 0) {
if ($line =~ /^>(\S+)/) {
print STDERR "Indexed $count quality scores...\n"
if $self->{debug} && (++$count%1000) == 0;
$self->_check_linelength($linelen);
my $pos = tell($fh);
if (@ids) {
my $strlen = $pos - $offset - length($line);
$strlen -= $termination_length * $qual_lines;
my $ppos = &{$self->{packmeth}}($offset, $strlen, $numres,
$linelen, $headerlen, Bio::DB::IndexedBase::NA, $fileno);
for my $id (@ids) {
$offsets->{$id} = $ppos;
}
$numres = 0;
}
@ids = $self->_makeid($line);
($offset, $headerlen, $linelen, $qual_lines) = ($pos, length $line, 0, 0);
($l3_len, $l2_len, $l_len, $blank_lines) = (0, 0, 0, 0);
} else {
# Catch bad header lines, bug 3172
$self->throw("FASTA header doesn't match '>(\\S+)': $line");
}
} elsif ($line !~ /\S/) {
# Skip blank line
$blank_lines++;
next;
} else {
# Need to check every line :(
$l3_len = $l2_len;
$l2_len = $l_len;
$l_len = length $line;
if (Bio::DB::IndexedBase::DIE_ON_MISSMATCHED_LINES) {
if ( ($l3_len > 0) && ($l2_len > 0) && ($l3_len != $l2_len) ) {
my $fap = substr($line, 0, 20)."..";
$self->throw("Each line of the qual entry must be the same ".
"length except the last. Line above #$. '$fap' is $l2_len".
" != $l3_len chars.");
}
if ($blank_lines) {
# Blank lines not allowed in entry
$self->throw("Blank lines can only precede header lines, ".
"found preceding line #$.");
}
}
$linelen ||= length $line;
$qual_lines++;
$numres += scalar(split /\s+/, $line);
}
$last_line = $line;
}
# Process last entry
$self->_check_linelength($linelen);
my $pos = tell($fh);
if (@ids) {
my $strlen = $pos - $offset;
if ($linelen == 0) {
$strlen = 0;
} else {
if ($last_line !~ /\s$/) {
$qual_lines--;
}
$strlen -= $termination_length * $qual_lines;
}
my $ppos = &{$self->{packmeth}}($offset, $strlen, $numres, $linelen,
$headerlen, Bio::DB::IndexedBase::NA, $fileno);
for my $id (@ids) {
$offsets->{$id} = $ppos;
}
}
return \%offsets;
}
# for backward compatibility
sub get_PrimaryQual_stream {
my $self = shift;
return $self->get_PrimarySeq_stream;
}
# for backward compatibility
sub get_Qual_by_id {
my ($self, $id) = @_;
return $self->get_Seq_by_id($id);
}
*get_qual_by_version = *get_qual_by_primary_id = *get_qual_by_acc = \&get_Qual_by_id;
=head2 qual
Title : qual, quality, subqual
Usage : # All quality scores
my @qualarr = @{$qualdb->subqual($id)};
# Subset of the quality scores
my @subqualarr = @{$qualdb->subqual($id, $start, $stop, $strand)};
# or...
my @subqualarr = @{$qualdb->subqual($compound_id)};
Function: Get a subqual of an entry in the database. For your convenience,
the sequence to extract can be specified with any of the following
compound IDs:
$db->qual("$id:$start,$stop")
$db->qual("$id:$start..$stop")
$db->qual("$id:$start-$stop")
$db->qual("$id:$start,$stop/$strand")
$db->qual("$id:$start..$stop/$strand")
$db->qual("$id:$start-$stop/$strand")
$db->qual("$id/$strand")
If $stop is less than $start, then the reverse complement of the
sequence is returned. Avoid using it if possible since this goes
against Bio::Seq conventions.
Returns : Reference to an array of quality scores
Args : Compound ID of entry to retrieve
or
ID, optional start (defaults to 1), optional end (defaults to the
number of quality scores for this sequence), and strand (defaults to
1).
=cut
sub subqual {
my ($self, $id, $start, $stop, $strand) = @_;
# Quality values in a quality score can have 1 or 2 digits and are separated
# by one (or several?) spaces. Thus contrary to Bio::DB::Fasta, here there
# is no easy way match the position of a quality value to its position in
# the quality string.
# As a consequence, if a subqual of the quality is requested, we still need
# to grab the full quality string first - performance penalty for big
# quality scores :(
# I think there is no way around starting at the begining of the quality
# score but maybe there is a resource-efficient way of starting at the
# begining of the quality score and stopping when the the position of the
# last quality value requested is reached??
$self->throw('Need to provide a sequence ID') if not defined $id;
($id, $start, $stop, $strand) = $self->_parse_compound_id($id, $start, $stop, $strand);
# Position in quality string
my $string_start = 1;
my $string_stop = $self->strlen($id);
# Fetch full quality string
my $fh = $self->_fh($id) or return;
my $filestart = $self->_calc_offset($id, $string_start);
my $filestop = $self->_calc_offset($id, $string_stop );
seek($fh, $filestart,0);
my $data;
read($fh, $data, $filestop-$filestart+1);
# Process quality score
Bio::DB::IndexedBase::_strip_crnl($data);
my $subqual = 0;
$subqual = 1 if ( $start || $stop );
my @data;
if ( $subqual || ($strand == -1) ) {
@data = split / /, $data, $stop+1;
my $length = scalar(@data);
$start = 1 if $start < 1;
$stop = $length if $stop > $length;
pop @data if ($stop != $length);
splice @data, 0, $start-1;
@data = reverse(@data) if $strand == -1;
$data = join ' ', @data;
} else {
@data = split / /, $data;
}
return \@data;
}
*qual = *quality = \&subqual;
=head2 header
Title : header
Usage : my $header = $db->header($id);
Function: Get the header line (ID and description fields) of the specified entry.
Returns : String
Args : ID of entry
=cut
sub header {
my ($self, $id) = @_;
$self->throw('Need to provide a sequence ID') if not defined $id;
my ($offset, $headerlen) = (&{$self->{unpackmeth}}($self->{offsets}{$id}))[0,4];
$offset -= $headerlen;
my $data;
my $fh = $self->_fh($id) or return;
seek($fh, $offset, 0);
read($fh, $data, $headerlen);
# On Windows chomp remove '\n' but leaves '\r'
# when reading '\r\n' in binary mode,
# _strip_crnl removes both
$data = Bio::DB::IndexedBase::_strip_crnl($data);
substr($data, 0, 1) = '';
return $data;
}
#-------------------------------------------------------------
# Tied hash overrides
#
sub FETCH {
return shift->subqual(@_);
}
#-------------------------------------------------------------
# Bio::Seq::PrimaryQual compatibility
#
# Usage is the same as in Bio::Seq::PrimaryQual
package Bio::Seq::PrimaryQual::Qual;
use overload '""' => 'display_id';
use base qw(Bio::Root::Root Bio::Seq::PrimaryQual);
sub new {
my ($class, @args) = @_;
my $self = $class->SUPER::new(@args);
my ($db, $id, $start, $stop) = $self->_rearrange(
[qw(DATABASE ID START STOP)],
@args);
$self->{db} = $db;
$self->{id} = $id;
$self->{stop} = $stop || $db->length($id);
$self->{start} = $start || ($self->{stop} > 0 ? 1 : 0); # handle 0-length seqs
return $self;
}
sub qual {
my $self = shift;
my $qual = $self->{db}->qual($self->{id}, $self->{start}, $self->{stop});
return $qual;
}
sub subqual {
my ($self, $start, $stop) = @_;
return $self->trunc($start, $stop)->qual;
}
sub trunc {
# Override Bio::Seq::QualI trunc() method. This way, we create an object
# that does not store the quality array in memory.
my ($self, $start, $stop) = @_;
$self->throw(
"$stop is smaller than $stop. If you want to truncate and reverse ".
"complement, you must call trunc followed by revcom."
) if $start > $stop;
if ($self->{start} <= $self->{stop}) {
$start = $self->{start}+$start-1;
$stop = $self->{start}+$stop-1;
} else {
$start = $self->{start}-($start-1);
$stop = $self->{start}-($stop-1);
}
my $obj = $self->new( -database => $self->{db},
-id => $self->{id},
-start => $start,
-stop => $stop
);
return $obj;
}
sub display_id {
my $self = shift;
return $self->{id};
}
sub primary_id {
my $self = shift;
return overload::StrVal($self);
}
sub revcom {
# Override Bio::QualI revcom() with optimized method.
my $self = shift;
return $self->new(@{$self}{'db', 'id', 'stop', 'start'});
}
sub length {
# Get length from quality location, not the quality array (too expensive)
my $self = shift;
return $self->{start} < $self->{stop} ?
$self->{stop} - $self->{start} + 1 :
$self->{start} - $self->{stop} + 1 ;
}
sub description {
my $self = shift;
my $header = $self->{'db'}->header($self->{id});
# remove the id from the header
$header = (split(/\s+/, $header, 2))[2];
return $header;
}
*desc = \&description;
1;