~ubuntu-branches/ubuntu/trusty/bioperl/trusty

« back to all changes in this revision

Viewing changes to Bio/LocatableSeq.pm

  • Committer: Package Import Robot
  • Author(s): Charles Plessy
  • Date: 2013-09-22 13:39:48 UTC
  • mfrom: (3.1.11 sid)
  • Revision ID: package-import@ubuntu.com-20130922133948-c6z62zegjyp7ztou
Tags: 1.6.922-1
* New upstream release.
* Replaces and Breaks grinder (<< 0.5.3-3~) because of overlaping contents.
  Closes: #722910
* Stop Replacing and Breaking bioperl ( << 1.6.9 ): not needed anymore. 

Show diffs side-by-side

added added

removed removed

Lines of Context:
50
50
systems when these sort of objects are used. Some mapping now occurs to deal
51
51
with HSP data, however it can probably be integrated in better and most methods
52
52
do not implement it correctly yet. Also, several PrimarySeqI methods (subseq(),
53
 
trunc(), etc.) do not behave as expected and must be used with care.
 
53
trunc(), etc.) do not behave as expected and must be used with care. Due to this,
 
54
LocatableSeq functionality is to be refactored in a future BioPerl release.
 
55
However, for alignment functionality it works adequately for the time being.
54
56
 
55
 
Due to this, LocatableSeq functionality is to be refactored in a future BioPerl
56
 
release. However, for alignment functionality it works adequately for the time
57
 
being
 
57
If you do not need alignment functionality, L<Bio::SeqfeatureI>-implementing
 
58
modules may be a suitable alternative to L<Bio::LocatableSeq>. For example,
 
59
L<Bio::SeqFeature::Generic> and L<Bio::SeqFeature::Lite> provide methods to
 
60
attach a sequence to a specific region of a parent sequence and to set other
 
61
useful attributes.
58
62
 
59
63
=head1 FEEDBACK
60
64
 
93
97
 
94
98
=cut
95
99
 
96
 
#'
97
 
# Let the code begin...
 
100
 
98
101
 
99
102
package Bio::LocatableSeq;
100
103
use strict;
116
119
 
117
120
use base qw(Bio::PrimarySeq Bio::RangeI);
118
121
 
 
122
 
119
123
sub new {
120
124
    my ($class, @args) = @_;
121
125
    my $self = $class->SUPER::new(@args);
142
146
    return $self; # success - we hope!
143
147
}
144
148
 
 
149
 
145
150
=head2 start
146
151
 
147
152
 Title   : start
153
158
 
154
159
=cut
155
160
 
156
 
sub start{
 
161
sub start {
157
162
    my $self = shift;
158
163
    if( @_ ) {
159
164
        my $value = shift;
164
169
    return;
165
170
}
166
171
 
 
172
 
167
173
=head2 end
168
174
 
169
175
 Title   : end
210
216
    }
211
217
}
212
218
 
 
219
 
213
220
# changed 08.10.26 to return ungapped length, not the calculated end
214
221
# of the sequence
215
222
sub _ungapped_len {
231
238
#    return CORE::length($string);
232
239
#}
233
240
 
 
241
 
234
242
=head2 strand
235
243
 
236
244
 Title   : strand
241
249
 
242
250
=cut
243
251
 
244
 
sub strand{
 
252
sub strand {
245
253
   my $self = shift;
246
254
   if( @_ ) {
247
255
        my $value = shift;
250
258
    return $self->{'strand'};
251
259
}
252
260
 
 
261
 
253
262
=head2 mapping
254
263
 
255
264
 Title   : mapping
278
287
    return @{ $self->{'_mapping'} };
279
288
}
280
289
 
 
290
 
281
291
=head2 frameshifts
282
292
 
283
293
 Title   : frameshifts
303
313
        return %{$self->{_frameshifts}} : return ();
304
314
}
305
315
 
 
316
 
306
317
=head2 get_nse
307
318
 
308
319
 Title   : get_nse
314
325
 
315
326
=cut
316
327
 
317
 
sub get_nse{
 
328
sub get_nse {
318
329
   my ($self,$char1,$char2) = @_;
319
330
 
320
331
   $char1 ||= "/";
342
353
   return join('',$id, $v, $char1, $st, $char2, $end);
343
354
}
344
355
 
 
356
 
345
357
=head2 force_nse
346
358
 
347
359
 Title   : force_nse
363
375
    return $self->{'_force_nse'};
364
376
}
365
377
 
 
378
 
366
379
=head2 num_gaps
367
380
 
368
381
 Title   : num_gaps
436
449
    unless $resnumber =~ /^\d+$/ and $resnumber > 0;
437
450
 
438
451
    if ($resnumber >= $self->start() and $resnumber <= $self->end()) {
439
 
        my @chunks;
440
 
        my $column_incr;
441
 
        my $current_column;
442
 
        my $current_residue = $self->start - 1;
443
 
        my $seq = $self->seq;
444
 
        my $strand = $self->strand || 0;
445
 
 
446
 
        if ($strand == -1) {
447
 
#           @chunks = reverse $seq =~ m/[^\.\-]+|[\.\-]+/go;
448
 
            @chunks = reverse $seq =~ m/[$RESIDUE_SYMBOLS]+|[$GAP_SYMBOLS]+/go;
449
 
            $column_incr = -1;
450
 
            $current_column = (CORE::length $seq) + 1;
451
 
        }
452
 
        else {
453
 
#           @chunks = $seq =~ m/[^\.\-]+|[\.\-]+/go;
454
 
            @chunks = $seq =~ m/[$RESIDUE_SYMBOLS]+|[$GAP_SYMBOLS]+/go;
455
 
            $column_incr = 1;
456
 
            $current_column = 0;
457
 
        }
458
 
 
459
 
        while (my $chunk = shift @chunks) {
460
 
#           if ($chunk =~ m|^[\.\-]|o) {
461
 
            if ($chunk =~ m|^[$GAP_SYMBOLS]|o) {
462
 
                $current_column += $column_incr * CORE::length($chunk);
463
 
            }
464
 
            else {
465
 
                if ($current_residue + CORE::length($chunk) < $resnumber) {
466
 
                    $current_column += $column_incr * CORE::length($chunk);
467
 
                    $current_residue += CORE::length($chunk);
468
 
                }
469
 
                else {
470
 
                    if ($strand == -1) {
471
 
                        $current_column -= $resnumber - $current_residue;
472
 
                    }
473
 
                    else {
474
 
                        $current_column += $resnumber - $current_residue;
475
 
                    }
476
 
                    return $current_column;
477
 
                }
478
 
            }
479
 
        }
 
452
        my @chunks;
 
453
        my $column_incr;
 
454
        my $current_column;
 
455
        my $current_residue = $self->start - 1;
 
456
        my $seq = $self->seq;
 
457
        my $strand = $self->strand || 0;
 
458
 
 
459
        if ($strand == -1) {
 
460
           #@chunks = reverse $seq =~ m/[^\.\-]+|[\.\-]+/go;
 
461
            @chunks = reverse $seq =~ m/[$RESIDUE_SYMBOLS]+|[$GAP_SYMBOLS]+/go;
 
462
            $column_incr = -1;
 
463
            $current_column = (CORE::length $seq) + 1;
 
464
        }
 
465
        else {
 
466
            #@chunks = $seq =~ m/[^\.\-]+|[\.\-]+/go;
 
467
            @chunks = $seq =~ m/[$RESIDUE_SYMBOLS]+|[$GAP_SYMBOLS]+/go;
 
468
            $column_incr = 1;
 
469
            $current_column = 0;
 
470
        }
 
471
 
 
472
        while (my $chunk = shift @chunks) {
 
473
            #if ($chunk =~ m|^[\.\-]|o) {
 
474
            if ($chunk =~ m|^[$GAP_SYMBOLS]|o) {
 
475
                $current_column += $column_incr * CORE::length($chunk);
 
476
            }
 
477
            else {
 
478
                if ($current_residue + CORE::length($chunk) < $resnumber) {
 
479
                    $current_column += $column_incr * CORE::length($chunk);
 
480
                    $current_residue += CORE::length($chunk);
 
481
                }
 
482
                else {
 
483
                    if ($strand == -1) {
 
484
                        $current_column -= $resnumber - $current_residue;
 
485
                    }
 
486
                    else {
 
487
                        $current_column += $resnumber - $current_residue;
 
488
                    }
 
489
                    return $current_column;
 
490
                }
 
491
            }
 
492
        }
480
493
    }
481
494
 
482
495
    $self->throw("Could not find residue number $resnumber");
483
496
 
484
497
}
485
498
 
 
499
 
486
500
=head2 location_from_column
487
501
 
488
502
 Title   : location_from_column
563
577
    return $loc;
564
578
}
565
579
 
 
580
 
566
581
=head2 revcom
567
582
 
568
583
 Title   : revcom
592
607
    return $new;
593
608
}
594
609
 
 
610
 
595
611
=head2 trunc
596
612
 
597
613
 Title   : trunc
598
614
 Usage   : $subseq = $myseq->trunc(10,100);
599
615
 Function: Provides a truncation of a sequence,
600
 
 
601
 
 Example :
602
616
 Returns : a fresh Bio::PrimarySeqI implementing object
603
617
 Args    : Two integers denoting first and last columns of the
604
618
           sequence to be included into sub-sequence.
605
619
 
606
 
 
607
620
=cut
608
621
 
609
622
sub trunc {
621
634
    return $new;
622
635
}
623
636
 
 
637
 
624
638
=head2 validate_seq
625
639
 
626
640
 Title   : validate_seq
627
 
 Usage   : if(! $seq->validate_seq($seq_str) ) {
 
641
 Usage   : if(! $seqobj->validate_seq($seq_str) ) {
628
642
                print "sequence $seq_str is not valid for an object of
629
 
                alphabet ",$seq->alphabet, "\n";
630
 
            }
631
 
 Function: Validates a given sequence string. A validating sequence string
632
 
           must be accepted by seq(). A string that does not validate will
633
 
           lead to an exception if passed to seq().
634
 
 
635
 
           The implementation provided here does not take alphabet() into
636
 
           account. Allowed are all letters (A-Z), numbers [0-9] 
637
 
           and common symbols used for gaps, stop codons, unknown residues,
638
 
           and frameshifts, including '-','.','*','?','=',and '~'.
639
 
 
640
 
 Example :
641
 
 Returns : 1 if the supplied sequence string is valid for the object, and
642
 
           0 otherwise.
643
 
 Args    : The sequence string to be validated.
 
643
                alphabet ",$seqobj->alphabet, "\n";
 
644
           }
 
645
 Function: Test that the given sequence is valid, i.e. contains only valid
 
646
           characters. The allowed characters are all letters (A-Z) and '-','.',
 
647
           '*','?','=' and '~'. Spaces are not valid. Note that this
 
648
           implementation does not take alphabet() into account.
 
649
 Returns : 1 if the supplied sequence string is valid, 0 otherwise.
 
650
 Args    : - Sequence string to be validated
 
651
           - Boolean to throw an error if the sequence is invalid
644
652
 
645
653
=cut
646
654
 
647
655
sub validate_seq {
648
 
    my ($self,$seqstr) = @_;
649
 
    if( ! defined $seqstr ){ $seqstr = $self->seq(); }
650
 
    return 0 unless( defined $seqstr);
651
 
    
652
 
    if((CORE::length($seqstr) > 0) &&
653
 
       ($seqstr !~ /^([$MATCHPATTERN]+)$/)) {
654
 
        $self->warn("seq doesn't validate with [$MATCHPATTERN], mismatch is " .
655
 
            join(",",($seqstr =~ /([^$MATCHPATTERN]+)/g)));
 
656
    my ($self, $seqstr, $throw) = @_;
 
657
    $seqstr = '' if not defined $seqstr;
 
658
    $throw  = 0  if not defined $throw ; # 0 for backward compatiblity
 
659
    if ( (CORE::length $seqstr > 0         ) &&
 
660
         ($seqstr !~ /^([$MATCHPATTERN]+)$/) ) {
 
661
        if ($throw) {
 
662
            $self->throw("Failed validation of sequence '".(defined($self->id) ||
 
663
            '[unidentified sequence]')."'. Invalid characters were: " .
 
664
            join('',($seqstr =~ /([^$MATCHPATTERN]+)/g)));
 
665
        }
656
666
        return 0;
657
667
    }
658
668
    return 1;
659
669
}
660
670
 
 
671
 
661
672
################## DEPRECATED METHODS ##################
662
673
 
 
674
 
663
675
=head2 no_gap
664
676
 
665
677
 Title     : no_gaps
678
690
=cut
679
691
 
680
692
sub no_gaps {
681
 
        my $self = shift;
682
 
        $self->deprecated(-warn_version => 1.0069,
683
 
                                          -throw_version => 1.0075,
684
 
                      -message => 'Use of method no_gaps() is deprecated, use num_gaps() instead');
685
 
    $self->num_gaps(@_);
 
693
    my $self = shift;
 
694
    $self->deprecated( -warn_version  => 1.0069,
 
695
                       -throw_version => 1.0075,
 
696
                       -message => 'Use of method no_gaps() is deprecated, use num_gaps() instead' );
 
697
    return $self->num_gaps(@_);
686
698
}
687
699
 
 
700
 
688
701
=head2 no_sequences
689
702
 
690
703
 Title     : no_sequences
697
710
=cut
698
711
 
699
712
sub no_sequences {
700
 
        my $self = shift;
701
 
        $self->deprecated(-warn_version => 1.0069,
702
 
                                          -throw_version => 1.0075,
703
 
                      -message => 'Use of method no_sequences() is deprecated, use num_sequences() instead');
704
 
    $self->num_sequences(@_);
 
713
    my $self = shift;
 
714
    $self->deprecated( -warn_version  => 1.0069,
 
715
                       -throw_version => 1.0075,
 
716
                       -message => 'Use of method no_sequences() is deprecated, use num_sequences() instead' );
 
717
    return $self->num_sequences(@_);
705
718
}
706
719
 
707
720
1;