File Coverage

Bio/Seq/SeqWithQuality.pm
Criterion Covered Total %
statement 93 180 51.6
branch 51 110 46.3
condition 7 21 33.3
subroutine 16 31 51.6
pod 21 21 100.0
total 188 363 51.7


line stmt bran cond sub pod time code
1             #
2             # BioPerl module for Bio::Seq::QualI
3             #
4             # Please direct questions and support issues to
5             #
6             # Cared for by Chad Matsalla
7             #
8             # Copyright Chad Matsalla
9             #
10             # You may distribute this module under the same terms as perl itself
11              
12             # POD documentation - main docs before the code
13              
14             =head1 NAME
15              
16             Bio::Seq::SeqWithQuality - Bioperl object packaging a sequence with its quality.
17             Deprecated class, use Bio::Seq::Quality instead!
18              
19             =head1 SYNOPSIS
20              
21             use Bio::PrimarySeq;
22             use Bio::Seq::PrimaryQual;
23             use Bio::Seq::SeqWithQuality;
24              
25             # make from memory
26             my $qual = Bio::Seq::SeqWithQuality->new
27             ( -qual => '10 20 30 40 50 50 20 10',
28             -seq => 'ATCGATCG',
29             -id => 'human_id',
30             -accession_number => 'AL000012',
31             );
32              
33             # make from objects
34             # first, make a PrimarySeq object
35             my $seqobj = Bio::PrimarySeq->new
36             ( -seq => 'atcgatcg',
37             -id => 'GeneFragment-12',
38             -accession_number => 'X78121',
39             -alphabet => 'dna'
40             );
41              
42             # now make a PrimaryQual object
43             my $qualobj = Bio::Seq::PrimaryQual->new
44             ( -qual => '10 20 30 40 50 50 20 10',
45             -id => 'GeneFragment-12',
46             -accession_number => 'X78121',
47             -alphabet => 'dna'
48             );
49              
50             # now make the SeqWithQuality object
51             my $swqobj = Bio::Seq::SeqWithQuality->new
52             ( -seq => $seqobj,
53             -qual => $qualobj
54             );
55             # done!
56              
57             $swqobj->id(); # the id of the SeqWithQuality object
58             # may not match the the id of the sequence or
59             # of the quality (check the pod, luke)
60             $swqobj->seq(); # the sequence of the SeqWithQuality object
61             $swqobj->qual(); # the quality of the SeqWithQuality object
62              
63             # to get out parts of the sequence.
64              
65             print "Sequence ", $seqobj->id(), " with accession ",
66             $seqobj->accession, " and desc ", $seqobj->desc, "\n";
67              
68             $string2 = $seqobj->subseq(1,40);
69              
70             =head1 DESCRIPTION
71              
72             This object stores base quality values together with the sequence string.
73              
74             =head1 FEEDBACK
75              
76             =head2 Mailing Lists
77              
78             User feedback is an integral part of the evolution of this and other
79             Bioperl modules. Send your comments and suggestions preferably to one
80             of the Bioperl mailing lists. Your participation is much appreciated.
81              
82             bioperl-l@bioperl.org - General discussion
83             http://bioperl.org/wiki/Mailing_lists - About the mailing lists
84              
85             =head2 Support
86              
87             Please direct usage questions or support issues to the mailing list:
88              
89             I
90              
91             rather than to the module maintainer directly. Many experienced and
92             reponsive experts will be able look at the problem and quickly
93             address it. Please include a thorough description of the problem
94             with code and data examples if at all possible.
95              
96             =head2 Reporting Bugs
97              
98             Report bugs to the Bioperl bug tracking system to help us keep track
99             the bugs and their resolution. Bug reports can be submitted via the
100             web:
101              
102             https://github.com/bioperl/bioperl-live/issues
103              
104             =head1 AUTHOR - Chad Matsalla
105              
106             Email bioinformatics@dieselwurks.com
107              
108             =head1 CONTRIBUTORS
109              
110             Jason Stajich, jason@bioperl.org
111              
112             =head1 APPENDIX
113              
114             The rest of the documentation details each of the object methods.
115             Internal methods are usually preceded with a _
116              
117             =cut
118              
119              
120             package Bio::Seq::SeqWithQuality;
121              
122              
123 1     1   596 use strict;
  1         1  
  1         33  
124 1     1   352 use Bio::PrimarySeq;
  1         3  
  1         28  
125 1     1   281 use Bio::Seq::PrimaryQual;
  1         1  
  1         27  
126              
127 1     1   4 use base qw(Bio::Root::Root Bio::PrimarySeqI Bio::Seq::QualI);
  1         1  
  1         1499  
128              
129             =head2 new()
130              
131             Title : new()
132             Usage : $qual = Bio::Seq::SeqWithQuality ->new
133             ( -qual => '10 20 30 40 50 50 20 10',
134             -seq => 'ATCGATCG',
135             -id => 'human_id',
136             -accession_number => 'AL000012',
137             -trace_indices => '0 5 10 15 20 25 30 35'
138             );
139             Function: Returns a new Bio::Seq::SeqWithQual object from basic
140             constructors.
141             Returns : a new Bio::Seq::PrimaryQual object
142             Args : -qual can be a quality string (see Bio::Seq::PrimaryQual for more
143             information on this) or a reference to a Bio::Seq::PrimaryQual
144             object.
145             -seq can be a sequence string (see Bio::PrimarySeq for more
146             information on this) or a reference to a Bio::PrimaryQual object.
147             -seq, -id, -accession_number, -primary_id, -desc, -id behave like
148             this:
149             1. if they are provided on construction of the
150             Bio::Seq::SeqWithQuality they will be set as the descriptors for
151             the object unless changed by one of the following mechanisms:
152             a) $obj->set_common_descriptors() is used and both the -seq and
153             the -qual object have the same descriptors. These common
154             descriptors will then become the descriptors for the
155             Bio::Seq::SeqWithQual object.
156             b) the descriptors are manually set using the seq(), id(),
157             desc(), or accession_number(), primary_id(),
158             2. if no descriptors are provided, the new() constructor will see
159             if the descriptor used in the PrimarySeq and in the
160             PrimaryQual objects match. If they do, they will become
161             the descriptors for the SeqWithQuality object.
162             To eliminate ambiguity, I strongly suggest you set the
163             descriptors manually on construction of the object. Really.
164             -trace_indices : a space_delimited list of trace indices
165             (where would the peaks be drawn if this list of qualities
166             was to be plotted?)
167              
168             =cut
169              
170             sub new {
171 10     10 1 555 my ($class, @args) = @_;
172 10         25 my $self = $class->SUPER::new(@args);
173             # default: turn OFF the warnings
174 10         11 $self->{supress_warnings} = 1;
175 10         30 my($qual,$seq,$id,$acc,$pid,$desc,$given_id,$alphabet,$trace_indices) =
176             $self->_rearrange([qw( QUAL SEQ DISPLAY_ID ACCESSION_NUMBER PRIMARY_ID DESC
177             ID ALPHABET TRACE_INDICES )], @args);
178             # Deal with the ID
179 10 50 33     33 if ( defined $id && defined $given_id ) {
180 0 0       0 if( $id ne $given_id ) {
181 0         0 $self->throw("Provided both id and display_id constructor functions. [$id] [$given_id]");
182             }
183             }
184 10 100       13 if( defined $given_id ) {
185 1         3 $self->display_id($given_id);
186 1         1 $id = $given_id;
187             }
188             # Import sequence first
189 10 100 66     72 if (!$seq) {
    100          
    50          
190 4         4 my $id;
191 4 50       7 unless ($self->{supress_warnings} == 1) {
192 0         0 $self->warn("You did not provide sequence information during the ".
193             "construction of a Bio::Seq::SeqWithQuality object. Sequence ".
194             "components for this object will be empty.");
195             }
196 4 100       8 if (!$alphabet) {
197 1         7 $self->throw("If you want me to create a PrimarySeq object for your ".
198             "empty sequence you must specify a -alphabet to satisfy ".
199             "the constructor requirements for a Bio::PrimarySeq object with no ".
200             "sequence. Read the POD for it, luke.");
201             }
202 3         13 $self->{seq_ref} = Bio::PrimarySeq->new( -seq => "",
203             -accession_number => $acc,
204             -primary_id => $pid,
205             -desc => $desc,
206             -display_id => $id,
207             -alphabet => $alphabet );
208             } elsif ($seq->isa('Bio::PrimarySeqI') || $seq->isa('Bio::SeqI')) {
209 2         4 $self->{seq_ref} = $seq;
210             } elsif (ref($seq)) {
211 0         0 $self->throw("You passed a seq argument into a SeqWithQUality object and".
212             " it was a reference ($seq) which did not inherit from Bio::SeqI or ".
213             "Bio::PrimarySeqI. I don't know what to do with this!");
214             } else {
215 4         21 my $seqobj = Bio::PrimarySeq->new( -seq => $seq,
216             -accession_number => $acc,
217             -primary_id => $pid,
218             -desc => $desc,
219             -display_id => $id );
220 4         7 $self->{seq_ref} = $seqobj;
221             }
222             # Then import the quality scores
223 9 50       22 if (!defined($qual)) {
    100          
224 0         0 $self->{qual_ref} = Bio::Seq::PrimaryQual->new( -qual => "",
225             -accession_number => $acc,
226             -primary_id => $pid,
227             -desc => $desc,
228             -display_id => $id, );
229             } elsif (ref($qual) eq "Bio::Seq::PrimaryQual") {
230 2         4 $self->{qual_ref} = $qual;
231             } else {
232 7         30 my $qualobj = Bio::Seq::PrimaryQual->new( -qual => $qual,
233             -accession_number => $acc,
234             -primary_id => $pid,
235             -desc => $desc,
236             -display_id => $id,
237             -trace_indices => $trace_indices );
238 7         10 $self->{qual_ref} = $qualobj;
239             }
240             # Now try to set the descriptors for this object
241 9         21 $self->_set_descriptors($qual,$seq,$id,$acc,$pid,$desc,$given_id,$alphabet);
242 9         12 $self->length();
243 9         24 $self->deprecated("deprecated class - use Bio::Seq::Quality instead");
244              
245 9         22 return $self;
246             }
247              
248             =head2 _common_id()
249              
250             Title : _common_id()
251             Usage : $common_id = $self->_common_id();
252             Function: Compare the display_id of {qual_ref} and {seq_ref}.
253             Returns : Nothing if they don't match. If they do return {seq_ref}->display_id()
254             Args : None.
255              
256             =cut
257              
258             #'
259             sub _common_id {
260 8     8   7 my $self = shift;
261 8 50 33     25 return if (!$self->{seq_ref} || !$self->{qual_ref});
262 8         17 my $sid = $self->{seq_ref}->display_id();
263 8 100       21 return if (!$sid);
264 2 100       5 return if (!$self->{qual_ref}->display_id());
265 1 50       10 return $sid if ($sid eq $self->{qual_ref}->display_id());
266             # should this become a warning?
267             # print("ids $sid and $self->{qual_ref}->display_id() do not match. Bummer.\n");
268             }
269              
270             =head2 _common_display_id()
271              
272             Title : _common_id()
273             Usage : $common_id = $self->_common_display_id();
274             Function: Compare the display_id of {qual_ref} and {seq_ref}.
275             Returns : Nothing if they don't match. If they do return {seq_ref}->display_id()
276             Args : None.
277              
278             =cut
279              
280             #'
281             sub _common_display_id {
282 0     0   0 my $self = shift;
283 0         0 $self->common_id();
284             }
285              
286             =head2 _common_accession_number()
287              
288             Title : _common_accession_number()
289             Usage : $common_id = $self->_common_accession_number();
290             Function: Compare the accession_number() of {qual_ref} and {seq_ref}.
291             Returns : Nothing if they don't match. If they do return {seq_ref}->accession_number()
292             Args : None.
293              
294             =cut
295              
296             #'
297             sub _common_accession_number {
298 9     9   7 my $self = shift;
299 9 50 33     28 return if ($self->{seq_ref} || $self->{qual_ref});
300 0         0 my $acc = $self->{seq_ref}->accession_number();
301             # if (!$acc) { print("the seqref has no acc.\n"); }
302 0 0       0 return if (!$acc);
303             # if ($acc eq $self->{qual_ref}->accession_number()) { print("$acc matches ".$self->{qual_ref}->accession_number()."\n"); }
304 0 0       0 return $acc if ($acc eq $self->{qual_ref}->accession_number());
305             # should this become a warning?
306             # print("accession numbers $acc and $self->{qual_ref}->accession_number() do not match. Bummer.\n");
307             }
308              
309             =head2 _common_primary_id()
310              
311             Title : _common_primary_id()
312             Usage : $common_primard_id = $self->_common_primary_id();
313             Function: Compare the primary_id of {qual_ref} and {seq_ref}.
314             Returns : Nothing if they don't match. If they do return {seq_ref}->primary_id()
315             Args : None.
316              
317             =cut
318              
319             #'
320             sub _common_primary_id {
321 9     9   8 my $self = shift;
322 9 50 33     26 return if ($self->{seq_ref} || $self->{qual_ref});
323 0         0 my $pid = $self->{seq_ref}->primary_id();
324 0 0       0 return if (!$pid);
325 0 0       0 return $pid if ($pid eq $self->{qual_ref}->primary_id());
326             # should this become a warning?
327             # print("primary_ids $pid and $self->{qual_ref}->primary_id() do not match. Bummer.\n");
328             }
329              
330             =head2 _common_desc()
331              
332             Title : _common_desc()
333             Usage : $common_desc = $self->_common_desc();
334             Function: Compare the desc of {qual_ref} and {seq_ref}.
335             Returns : Nothing if they don't match. If they do return {seq_ref}->desc()
336             Args : None.
337              
338             =cut
339              
340             #'
341             sub _common_desc {
342 9     9   9 my $self = shift;
343 9 50 33     28 return if ($self->{seq_ref} || $self->{qual_ref});
344 0         0 my $des = $self->{seq_ref}->desc();
345 0 0       0 return if (!$des);
346 0 0       0 return $des if ($des eq $self->{qual_ref}->desc());
347             # should this become a warning?
348             # print("descriptions $des and $self->{qual_ref}->desc() do not match. Bummer.\n");
349             }
350              
351             =head2 set_common_descriptors()
352              
353             Title : set_common_descriptors()
354             Usage : $self->set_common_descriptors();
355             Function: Compare the descriptors (id,accession_number,display_id,
356             primary_id, desc) for the PrimarySeq and PrimaryQual objects
357             within the SeqWithQuality object. If they match, make that
358             descriptor the descriptor for the SeqWithQuality object.
359             Returns : Nothing.
360             Args : None.
361              
362             =cut
363              
364             sub set_common_descriptors {
365 0     0 1 0 my $self = shift;
366 0 0 0     0 return if ($self->{seq_ref} || $self->{qual_ref});
367 0         0 &_common_id();
368 0         0 &_common_display_id();
369 0         0 &_common_accession_number();
370 0         0 &_common_primary_id();
371 0         0 &_common_desc();
372             }
373              
374             =head2 alphabet()
375              
376             Title : alphabet();
377             Usage : $molecule_type = $obj->alphabet();
378             Function: Get the molecule type from the PrimarySeq object.
379             Returns : What what PrimarySeq says the type of the sequence is.
380             Args : None.
381              
382             =cut
383              
384             sub alphabet {
385 0     0 1 0 my $self = shift;
386 0         0 return $self->{seq_ref}->alphabet();
387             }
388              
389             =head2 display_id()
390              
391             Title : display_id()
392             Usage : $id_string = $obj->display_id();
393             Function: Returns the display id, aka the common name of the Quality object.
394             The semantics of this is that it is the most likely string to be
395             used as an identifier of the quality sequence, and likely to have
396             "human" readability. The id is equivalent to the ID field of the
397             GenBank/EMBL databanks and the id field of the Swissprot/sptrembl
398             database. In fasta format, the >(\S+) is presumed to be the id,
399             though some people overload the id to embed other information.
400             Bioperl does not use any embedded information in the ID field,
401             and people are encouraged to use other mechanisms (accession
402             field for example, or extending the sequence object) to solve
403             this. Notice that $seq->id() maps to this function, mainly for
404             legacy/convience issues.
405             This method sets the display_id for the SeqWithQuality object.
406             Returns : A string
407             Args : If a scalar is provided, it is set as the new display_id for
408             the SeqWithQuality object.
409             Status : Virtual
410              
411             =cut
412              
413             sub display_id {
414 18     18 1 15 my ($obj,$value) = @_;
415 18 100       23 if( defined $value) {
416 3         4 $obj->{'display_id'} = $value;
417             }
418 18         23 return $obj->{'display_id'};
419              
420             }
421              
422             =head2 accession_number()
423              
424             Title : accession_number()
425             Usage : $unique_biological_key = $obj->accession_number();
426             Function: Returns the unique biological id for a sequence, commonly
427             called the accession_number. For sequences from established
428             databases, the implementors should try to use the correct
429             accession number. Notice that primary_id() provides the unique id
430             for the implemetation, allowing multiple objects to have the same
431             accession number in a particular implementation. For sequences
432             with no accession number, this method should return "unknown".
433             This method sets the accession_number for the SeqWithQuality
434             object.
435             Returns : A string (the value of accession_number)
436             Args : If a scalar is provided, it is set as the new accession_number
437             for the SeqWithQuality object.
438             Status : Virtual
439              
440             =cut
441              
442             sub accession_number {
443 0     0 1 0 my( $obj, $acc ) = @_;
444              
445 0 0       0 if (defined $acc) {
446 0         0 $obj->{'accession_number'} = $acc;
447             } else {
448 0         0 $acc = $obj->{'accession_number'};
449 0 0       0 $acc = 'unknown' unless defined $acc;
450             }
451 0         0 return $acc;
452             }
453              
454             =head2 primary_id()
455              
456             Title : primary_id()
457             Usage : $unique_implementation_key = $obj->primary_id();
458             Function: Returns the unique id for this object in this implementation.
459             This allows implementations to manage their own object ids in a
460             way the implementaiton can control clients can expect one id to
461             map to one object. For sequences with no accession number, this
462             method should return a stringified memory location.
463             This method sets the primary_id for the SeqWithQuality object.
464             Returns : A string. (the value of primary_id)
465             Args : If a scalar is provided, it is set as the new primary_id for
466             the SeqWithQuality object.
467              
468             =cut
469              
470             sub primary_id {
471 0     0 1 0 my ($obj,$value) = @_;
472 0 0       0 if ($value) {
473 0         0 $obj->{'primary_id'} = $value;
474             }
475 0         0 return $obj->{'primary_id'};
476              
477             }
478              
479             =head2 desc()
480              
481             Title : desc()
482             Usage : $qual->desc($newval); _or_
483             $description = $qual->desc();
484             Function: Get/set description text for this SeqWithQuality object.
485             Returns : A string. (the value of desc)
486             Args : If a scalar is provided, it is set as the new desc for the
487             SeqWithQuality object.
488              
489             =cut
490              
491             sub desc {
492             # a mechanism to set the disc for the SeqWithQuality object.
493             # probably will be used most often by set_common_features()
494 0     0 1 0 my ($obj,$value) = @_;
495 0 0       0 if( defined $value) {
496 0         0 $obj->{'desc'} = $value;
497             }
498 0         0 return $obj->{'desc'};
499             }
500              
501             =head2 id()
502              
503             Title : id()
504             Usage : $id = $qual->id();
505             Function: Return the ID of the quality. This should normally be (and
506             actually is in the implementation provided here) just a synonym
507             for display_id().
508             Returns : A string. (the value of id)
509             Args : If a scalar is provided, it is set as the new id for the
510             SeqWithQuality object.
511              
512             =cut
513              
514             sub id {
515 0     0 1 0 my ($self,$value) = @_;
516 0 0       0 if (!$self) { $self->throw("no value for self in $value"); }
  0         0  
517 0 0       0 if( defined $value ) {
518 0         0 return $self->display_id($value);
519             }
520 0         0 return $self->display_id();
521             }
522              
523             =head2 seq
524              
525             Title : seq()
526             Usage : $string = $obj->seq(); _or_ $obj->seq("atctatcatca");
527             Function: Returns the sequence that is contained in the imbedded in the
528             PrimarySeq object within the SeqWithQuality object
529             Returns : A scalar (the seq() value for the imbedded PrimarySeq object.)
530             Args : If a scalar is provided, the SeqWithQuality object will
531             attempt to set that as the sequence for the imbedded PrimarySeq
532             object. Otherwise, the value of seq() for the PrimarySeq object
533             is returned.
534             Notes : This is probably not a good idea because you then should call
535             length() to make sure that the sequence and quality are of the
536             same length. Even then, how can you make sure that this sequence
537             belongs with that quality? I provided this to give you rope to
538             hang yourself with. Tie it to a strong device and use a good
539             knot.
540              
541             =cut
542              
543             sub seq {
544 4     4 1 557 my ($self,$value) = @_;
545 4 100       9 if( defined $value) {
546 2         6 $self->{seq_ref}->seq($value);
547 2         5 $self->length();
548             }
549 4         10 return $self->{seq_ref}->seq();
550             }
551              
552             =head2 qual()
553              
554             Title : qual()
555             Usage : @quality_values = @{$obj->qual()}; _or_
556             $obj->qual("10 10 20 40 50");
557             Function: Returns the quality as imbedded in the PrimaryQual object
558             within the SeqWithQuality object.
559             Returns : A reference to an array containing the quality values in the
560             PrimaryQual object.
561             Args : If a scalar is provided, the SeqWithQuality object will
562             attempt to set that as the quality for the imbedded PrimaryQual
563             object. Otherwise, the value of qual() for the PrimaryQual
564             object is returned.
565             Notes : This is probably not a good idea because you then should call
566             length() to make sure that the sequence and quality are of the
567             same length. Even then, how can you make sure that this sequence
568             belongs with that quality? I provided this to give you a strong
569             board with which to flagellate yourself.
570              
571             =cut
572              
573             sub qual {
574 6     6 1 728 my ($self,$value) = @_;
575              
576 6 100       13 if( defined $value) {
577 4         9 $self->{qual_ref}->qual($value);
578             # update the lengths
579 4         8 $self->length();
580             }
581 6         11 return $self->{qual_ref}->qual();
582             }
583              
584              
585              
586             =head2 trace_indices()
587              
588             Title : trace_indices()
589             Usage : @trace_indice_values = @{$obj->trace_indices()}; _or_
590             $obj->trace_indices("10 10 20 40 50");
591             Function: Returns the trace_indices as imbedded in the Primaryqual object
592             within the SeqWithQualiity object.
593             Returns : A reference to an array containing the trace_indice values in the
594             PrimaryQual object.
595             Args : If a scalar is provided, the SeqWithuQuality object will
596             attempt to set that as the trace_indices for the imbedded PrimaryQual
597             object. Otherwise, the value of trace_indices() for the PrimaryQual
598             object is returned.
599             Notes : This is probably not a good idea because you then should call
600             length() to make sure that the sequence and trace_indices are of the
601             same length. Even then, how can you make sure that this sequence
602             belongs with that trace_indicex? I provided this to give you a strong
603             board with which to flagellate yourself.
604              
605             =cut
606              
607             sub trace_indices {
608 0     0 1 0 my ($self,$value) = @_;
609              
610 0 0       0 if( defined $value) {
611 0         0 $self->{qual_ref}->trace_indices($value);
612             # update the lengths
613 0         0 $self->length();
614             }
615 0         0 return $self->{qual_ref}->trace_indices();
616             }
617              
618              
619              
620              
621             =head2 length()
622              
623             Title : length()
624             Usage : $length = $seqWqual->length();
625             Function: Get the length of the SeqWithQuality sequence/quality.
626             Returns : Returns the length of the sequence and quality if they are
627             both the same. Returns "DIFFERENT" if they differ.
628             Args : None.
629              
630             =cut
631              
632             sub length {
633 21     21 1 24 my $self = shift;
634 21 50       32 if (!$self->{seq_ref}) {
635 0 0       0 unless ($self->{supress_warnings} == 1) {
636 0         0 $self->warn("Can't find {seq_ref} here in length().");
637             }
638 0         0 return;
639             }
640 21 50       30 if (!$self->{qual_ref}) {
641 0 0       0 unless ($self->{supress_warnings} == 1) {
642 0         0 $self->warn("Can't find {qual_ref} here in length().");
643             }
644 0         0 return;
645             }
646 21         38 my $seql = $self->{seq_ref}->length();
647              
648 21 100       38 if ($seql != $self->{qual_ref}->length()) {
649 6 50       11 unless ($self->{supress_warnings} == 1) {
650             $self->warn("Sequence length (".$seql.") is different from quality ".
651 0         0 "length (".$self->{qual_ref}->length().") in the SeqWithQuality ".
652             "object. This can only lead to problems later.");
653             }
654 6         5 $self->{'length'} = "DIFFERENT";
655             } else {
656 15         17 $self->{'length'} = $seql;
657             }
658 21         84 return $self->{'length'};
659             }
660              
661              
662             =head2 qual_obj
663              
664             Title : qual_obj($different_obj)
665             Usage : $qualobj = $seqWqual->qual_obj(); _or_
666             $qualobj = $seqWqual->qual_obj($ref_to_primaryqual_obj);
667             Function: Get the PrimaryQual object that is imbedded in the
668             SeqWithQuality object or if a reference to a PrimaryQual object
669             is provided, set this as the PrimaryQual object imbedded in the
670             SeqWithQuality object.
671             Returns : A reference to a Bio::Seq::SeqWithQuality object.
672              
673             =cut
674              
675             sub qual_obj {
676 2     2 1 219 my ($self,$value) = @_;
677 2 100       5 if (defined($value)) {
678 1 50       4 if (ref($value) eq "Bio::Seq::PrimaryQual") {
679 1         1 $self->{qual_ref} = $value;
680 1         9 $self->debug("You successfully changed the PrimaryQual object within ".
681             "a SeqWithQuality object. ID's for the SeqWithQuality object may ".
682             "now not be what you expect. Use something like ".
683             "set_common_descriptors() to fix them if you care,");
684             } else {
685 0         0 $self->debug("You tried to change the PrimaryQual object within a ".
686             "SeqWithQuality object but you passed a reference to an object that".
687             " was not a Bio::Seq::PrimaryQual object. Thus your change failed. ".
688             "Sorry.\n");
689             }
690             }
691 2         5 return $self->{qual_ref};
692             }
693              
694              
695             =head2 seq_obj
696              
697             Title : seq_obj()
698             Usage : $seqobj = $seqWqual->qual_obj(); _or_
699             $seqobj = $seqWqual->seq_obj($ref_to_primary_seq_obj);
700             Function: Get the PrimarySeq object that is imbedded in the
701             SeqWithQuality object or if a reference to a PrimarySeq object is
702             provided, set this as the PrimarySeq object imbedded in the
703             SeqWithQuality object.
704             Returns : A reference to a Bio::PrimarySeq object.
705              
706             =cut
707              
708             sub seq_obj {
709 2     2 1 194 my ($self,$value) = @_;
710 2 100       5 if( defined $value) {
711 1 50       5 if (ref($value) eq "Bio::PrimarySeq") {
712 1         4 $self->debug("You successfully changed the PrimarySeq object within a".
713             " SeqWithQuality object. ID's for the SeqWithQuality object may now".
714             " not be what you expect. Use something like ".
715             "set_common_descriptors() to fix them if you care,");
716             } else {
717 0         0 $self->debug("You tried to change the PrimarySeq object within a ".
718             "SeqWithQuality object but you passed a reference to an object that".
719             " was not a Bio::PrimarySeq object. Thus your change failed. Sorry.\n");
720             }
721             }
722 2         4 return $self->{seq_ref};
723             }
724              
725             =head2 _set_descriptors
726              
727             Title : _set_descriptors()
728             Usage : $seqWqual->_qual_obj($qual,$seq,$id,$acc,$pid,$desc,$given_id,
729             $alphabet);
730             Function: Set the descriptors for the SeqWithQuality object. Try to
731             match the descriptors in the PrimarySeq object and in the
732             PrimaryQual object if descriptors were not provided with
733             construction.
734             Returns : Nothing.
735             Args : $qual,$seq,$id,$acc,$pid,$desc,$given_id,$alphabet as found
736             in the new() method.
737             Notes : Really only intended to be called by the new() method. If
738             you want to invoke a similar function try set_common_descriptors().
739              
740             =cut
741              
742              
743             sub _set_descriptors {
744 9     9   12 my ($self,$qual,$seq,$id,$acc,$pid,$desc,$given_id,$alphabet) = @_;
745 9         7 my ($c_id,$c_acc,$c_pid,$c_desc);
746 9 100       12 if (!$self->display_id()) {
747 8 100       13 if ($c_id = $self->_common_id() ) { $self->display_id($c_id); }
  1         2  
748             else {
749 7 50       11 if ($self->{seq_ref}) {
    0          
750             # print("Using seq_ref to set id to ".$self->{seq_ref}->display_id()."\n");
751             # ::dumpValue($self->{seq_ref});
752 7         13 $self->display_id($self->{seq_ref}->id());
753             } elsif ($self->{qual_ref}) {
754 0         0 $self->display_id($self->{qual_ref}->id());
755             }
756             }
757             }
758 9 50       23 if ($acc) { $self->accession_number($acc); }
  0 50       0  
759 0         0 elsif ($c_acc = $self->_common_accession_number() ) { $self->accession_number($c_acc); }
760 9 50       16 if ($pid) { $self->primary_id($pid); }
  0 50       0  
761 0         0 elsif ($c_pid = $self->_common_primary_id() ) { $self->primary_id($c_pid); }
762 9 50       16 if ($desc) { $self->desc($desc); }
  0 50          
763 0           elsif ($c_desc = $self->_common_desc() ) { $self->desc($c_desc); }
764             }
765              
766             =head2 subseq($start,$end)
767              
768             Title : subseq($start,$end)
769             Usage : $subsequence = $obj->subseq($start,$end);
770             Function: Returns the subseq from start to end, where the first base
771             is 1 and the number is inclusive, ie 1-2 are the first two
772             bases of the sequence.
773             Returns : A string.
774             Args : Two positions.
775              
776             =cut
777              
778             sub subseq {
779 0     0 1   my ($self,@args) = @_;
780             # does a single value work?
781 0           return $self->{seq_ref}->subseq(@args);
782             }
783              
784             =head2 baseat($position)
785              
786             Title : baseat($position)
787             Usage : $base_at_position_6 = $obj->baseat("6");
788             Function: Returns a single base at the given position, where the first
789             base is 1 and the number is inclusive, ie 1-2 are the first two
790             bases of the sequence.
791             Returns : A scalar.
792             Args : A position.
793              
794             =cut
795              
796             sub baseat {
797 0     0 1   my ($self,$val) = @_;
798 0           return $self->{seq_ref}->subseq($val,$val);
799             }
800              
801             =head2 subqual($start,$end)
802              
803             Title : subqual($start,$end)
804             Usage : @qualities = @{$obj->subqual(10,20);
805             Function: returns the quality values from $start to $end, where the
806             first value is 1 and the number is inclusive, ie 1-2 are the
807             first two bases of the sequence. Start cannot be larger than
808             end but can be equal.
809             Returns : A reference to an array.
810             Args : a start position and an end position
811              
812             =cut
813              
814             sub subqual {
815 0     0 1   my ($self,@args) = @_;
816 0           return $self->{qual_ref}->subqual(@args);
817             }
818              
819             =head2 qualat($position)
820              
821             Title : qualat($position)
822             Usage : $quality = $obj->qualat(10);
823             Function: Return the quality value at the given location, where the
824             first value is 1 and the number is inclusive, ie 1-2 are the
825             first two bases of the sequence. Start cannot be larger than
826             end but can be equal.
827             Returns : A scalar.
828             Args : A position.
829              
830             =cut
831              
832             sub qualat {
833 0     0 1   my ($self,$val) = @_;
834 0           return $self->{qual_ref}->qualat($val);
835             }
836              
837             =head2 sub_trace_index($start,$end)
838              
839             Title : sub_trace_index($start,$end)
840             Usage : @trace_indices = @{$obj->sub_trace_index(10,20);
841             Function: returns the trace index values from $start to $end, where the
842             first value is 1 and the number is inclusive, ie 1-2 are the
843             first two bases of the sequence. Start cannot be larger than
844             end but can be e_trace_index.
845             Returns : A reference to an array.
846             Args : a start position and an end position
847              
848             =cut
849              
850             sub sub_trace_index {
851 0     0 1   my ($self,@args) = @_;
852 0           return $self->{qual_ref}->sub_trace_index(@args);
853             }
854              
855             =head2 trace_index_at($position)
856              
857             Title : trace_index_at($position)
858             Usage : $trace_index = $obj->trace_index_at(10);
859             Function: Return the trace_index value at the given location, where the
860             first value is 1 and the number is inclusive, ie 1-2 are the
861             first two bases of the sequence. Start cannot be larger than
862             end but can be etrace_index_.
863             Returns : A scalar.
864             Args : A position.
865              
866             =cut
867              
868             sub trace_index_at {
869 0     0 1   my ($self,$val) = @_;
870 0           return $self->{qual_ref}->trace_index_at($val);
871             }
872              
873             =head2 to_string()
874              
875             Title : to_string()
876             Usage : $quality = $obj->to_string();
877             Function: Return a textual representation of what the object contains.
878             For this module, this function will return:
879             qual
880             seq
881             display_id
882             accession_number
883             primary_id
884             desc
885             id
886             length_sequence
887             length_quality
888             Returns : A scalar.
889             Args : None.
890              
891             =cut
892              
893             sub to_string {
894 0     0 1   my ($self,$out,$result) = shift;
895 0           $out = "qual: ".join(',',@{$self->qual()})."\n";
  0            
896 0           foreach (qw(seq display_id accession_number primary_id desc id)) {
897 0           $result = $self->$_();
898 0 0         if (!$result) { $result = ""; }
  0            
899 0           $out .= "$_: $result\n";
900             }
901 0           return $out;
902             }
903             1;