lib/Bio/Seq/SeqWithQuality.pm

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