← Back to branch summary

~ubuntu-branches/ubuntu/hoary/bioperl/hoary

« back to all changes in this revision

Viewing changes to Bio/Variation/SeqDiff.pm

  • Committer: Bazaar Package Importer
  • Author(s): Matt Hope
  • Date: 2004-04-18 14:24:11 UTC
  • mfrom: (1.2.1 upstream) (2.1.1 warty)
  • Revision ID: james.westby@ubuntu.com-20040418142411-gr92uexquw4w8liq
Tags: 1.4-1
* New upstream release
* Examples and working code are installed by default to usr/bin,
  this has been moved to usr/share/doc/bioperl/bin

Show diffs side-by-side

added added

removed removed

Lines of Context:
Bio/Variation/SeqDiff.pm
1
 
# $Id: SeqDiff.pm,v 1.13 2002/02/18 17:17:25 bosborne Exp $
 
1
# $Id: SeqDiff.pm,v 1.17 2003/06/04 08:36:44 heikki Exp $
2
2
# bioperl module for Bio::Variation::SeqDiff
3
3
#
4
4
# Cared for by Heikki Lehvaslaiho <heikki@ebi.ac.uk>
72
72
 email or the web:
73
73
 
74
74
  bioperl-bugs@bio.perl.org
75
 
  http://bio.perl.org/bioperl-bugs/
 
75
  http://bugzilla.bioperl.org/
76
76
 
77
77
=head1 AUTHOR - Heikki Lehvaslaiho
78
78
 
83
83
     Wellcome Trust Genome Campus, Hinxton
84
84
     Cambs. CB10 1SD, United Kingdom 
85
85
 
 
86
=head1 CONTRIBUTORS
 
87
 
 
88
Eckhard Lehmann, ecky@e-lehmann.de
 
89
 
86
90
=head1 APPENDIX
87
91
 
88
92
The rest of the documentation details each of the object
93
97
# Let the code begin...
94
98
 
95
99
package Bio::Variation::SeqDiff;
96
 
my $VERSION=1.0;
97
100
 
98
101
use strict;
99
 
use vars qw($VERSION @ISA);
 
102
use vars qw(@ISA);
100
103
use Bio::Root::Root;
101
104
use Bio::Tools::CodonTable;
102
105
use Bio::PrimarySeq;
116
119
 
117
120
sub new {
118
121
    my($class,@args) = @_;
119
 
    my $self;
120
 
    $self = {};
121
 
    bless $self, $class;
 
122
    my $self = $class->SUPER::new(@args);
122
123
 
123
124
    my($id, $sysname, $trivname, $chr, $gene_symbol, 
124
125
       $desc, $alphabet, $numbering, $offset, $rna_offset, $rna_id, $cds_end,
698
699
 
699
700
sub each_Gene{
700
701
   my ($self,@args) = @_;
701
 
   
 
702
 
702
703
   return @{$self->{'genes'}}; 
703
704
}
704
705
 
721
722
sub dna_ori {
722
723
  my ($self,$value) = @_;
723
724
  if (defined $value) {
724
 
    $self->{'dna_ori'} = $value;
 
725
      $self->{'dna_ori'} = $value;
725
726
  }
726
727
  else {
727
728
      return $self->{'dna_ori'};
736
737
 Function: 
737
738
 
738
739
            Sets or returns the mutated DNA sequence of the seqDiff.
 
740
            If sequence has not been set generates it from the
 
741
            original sequence and DNA mutations.
739
742
 
740
743
 Example : 
741
744
 Returns : value of dna_mut, a scalar
747
750
sub dna_mut {
748
751
  my ($self,$value) = @_;
749
752
  if (defined $value) {
750
 
    $self->{'dna_mut'} = $value;
 
753
      $self->{'dna_mut'} = $value;
751
754
  }
752
755
  else {
 
756
      $self->_set_dnamut() unless $self->{'dna_mut'};
753
757
      return $self->{'dna_mut'};
754
758
  }
755
759
}
756
760
 
 
761
sub _set_dnamut {
 
762
    my $self = shift;
 
763
 
 
764
    return undef unless $self->{'dna_ori'}  && $self->each_Variant;
 
765
 
 
766
    $self->{'dna_mut'} = $self->{'dna_ori'};
 
767
    foreach ($self->each_Variant) {
 
768
        next unless $_->isa('Bio::Variation::DNAMutation');
 
769
        next unless $_->isMutation;
 
770
 
 
771
        my ($s, $la, $le);
 
772
        #lies the mutation less than 25 bases after the start of sequence?
 
773
        if ($_->start < 25) {
 
774
            $s = 0; $la = $_->start - 1;
 
775
        } else {
 
776
            $s = $_->start - 25; $la = 25;
 
777
        }
 
778
 
 
779
        #is the mutation an insertion?
 
780
        $_->end($_->start) unless $_->allele_ori->seq;
 
781
 
 
782
        #does the mutation end greater than 25 bases before the end of
 
783
        #sequence?
 
784
        if (($_->end + 25) > length($self->{'dna_mut'})) {
 
785
            $le = length($self->{'dna_mut'}) - $_->end;
 
786
        } else {
 
787
            $le = 25;
 
788
        }
 
789
 
 
790
        $_->dnStreamSeq(substr($self->{'dna_mut'}, $s, $la));
 
791
        $_->upStreamSeq(substr($self->{'dna_mut'}, $_->end, $le));
 
792
 
 
793
        my $s_ori = $_->dnStreamSeq . $_->allele_ori->seq . $_->upStreamSeq;
 
794
        my $s_mut = $_->dnStreamSeq . $_->allele_mut->seq . $_->upStreamSeq;
 
795
 
 
796
        (my $str = $self->{'dna_mut'}) =~ s/$s_ori/$s_mut/;
 
797
        $self->{'dna_mut'} = $str;
 
798
    }
 
799
}
 
800
 
757
801
 
758
802
=head2 rna_ori
759
803