branch-1-6/Bio/Seq/SeqWithQuality.pm

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