[Bioperl-guts-l] bioperl-live/Bio/Matrix/PSM InstanceSite.pm, 1.14, 1.14.4.1 SiteMatrix.pm, 1.31.4.1, 1.31.4.2

Senduran Balasubramaniam sendu at dev.open-bio.org
Sun Sep 17 11:26:35 EDT 2006


Update of /home/repository/bioperl/bioperl-live/Bio/Matrix/PSM
In directory dev.open-bio.org:/tmp/cvs-serv25335/Bio/Matrix/PSM

Modified Files:
      Tag: branch-1-5-2
	InstanceSite.pm SiteMatrix.pm 
Log Message:
merge from HEAD

Index: SiteMatrix.pm
===================================================================
RCS file: /home/repository/bioperl/bioperl-live/Bio/Matrix/PSM/SiteMatrix.pm,v
retrieving revision 1.31.4.1
retrieving revision 1.31.4.2
diff -C2 -d -r1.31.4.1 -r1.31.4.2
*** SiteMatrix.pm	2 Sep 2006 13:26:03 -0000	1.31.4.1
--- SiteMatrix.pm	17 Sep 2006 15:26:33 -0000	1.31.4.2
***************
*** 483,492 ****
  }
  
- 
  =head2 width
  
   Title   : width
   Usage   :
!  Function: Returns the length of the site
   Returns : int
   Args    : none
--- 483,491 ----
  }
  
  =head2 width
  
   Title   : width
   Usage   :
!  Function: Returns the length of the sites in used to make this matrix
   Returns : int
   Args    : none
***************
*** 500,503 ****
--- 499,518 ----
  }
  
+ =head2 sites
+ 
+  Title   : sites
+  Usage   :
+  Function: Get/set the number of sites that were used to make this matrix
+  Returns : int
+  Args    : none to get, int to set
+ 
+ =cut
+ 
+ sub sites {
+     my $self = shift;
+     if (@_) { $self->{sites} = shift }
+     return $self->{sites} || return;
+ }
+ 
  =head2 IUPAC
  
***************
*** 730,750 ****
  		my $reg;
  		LETTER: {
! 			if ($letter eq 'A') { $reg='Aa'; last LETTER; }
! 			if ($letter eq 'C') { $reg='Cc'; last LETTER; }
! 			if ($letter eq 'G') { $reg='Gg'; last LETTER; }
! 			if ($letter eq 'T') { $reg='Tt'; last LETTER; }
! 			if ($letter eq 'M') { $reg='AaCc'; last LETTER; }
! 			if ($letter eq 'R') { $reg='AaGg'; last LETTER; }
! 			if ($letter eq 'W') { $reg='AaTt'; last LETTER; }
! 			if ($letter eq 'S') { $reg='CcGg'; last LETTER; }
! 			if ($letter eq 'Y') { $reg='CcTt'; last LETTER; }
! 			if ($letter eq 'K') { $reg='GgTt'; last LETTER; }
! 			if ($letter eq 'V') { $reg='AaCcGg'; last LETTER; }
! 			if ($letter eq 'H') { $reg='AaCcTt'; last LETTER; }
! 			if ($letter eq 'D') { $reg='AaGgTt'; last LETTER; }
! 			if ($letter eq 'B') { $reg='CcGgTt'; last LETTER; }
! 			$reg="\.";
  		}
! 		$regexp .= "[$reg]";
  	}
      return $regexp;
--- 745,765 ----
  		my $reg;
  		LETTER: {
! 			if ($letter eq 'A') { $reg='[Aa]'; last LETTER; }
! 			if ($letter eq 'C') { $reg='[Cc]'; last LETTER; }
! 			if ($letter eq 'G') { $reg='[Gg]'; last LETTER; }
! 			if ($letter eq 'T') { $reg='[Tt]'; last LETTER; }
! 			if ($letter eq 'M') { $reg='[AaCcMm]'; last LETTER; }
! 			if ($letter eq 'R') { $reg='[AaGgRr]'; last LETTER; }
! 			if ($letter eq 'W') { $reg='[AaTtWw]'; last LETTER; }
! 			if ($letter eq 'S') { $reg='[CcGgSs]'; last LETTER; }
! 			if ($letter eq 'Y') { $reg='[CcTtYy]'; last LETTER; }
! 			if ($letter eq 'K') { $reg='[GgTtKk]'; last LETTER; }
! 			if ($letter eq 'V') { $reg='[AaCcGgVv]'; last LETTER; }
! 			if ($letter eq 'H') { $reg='[AaCcTtHh]'; last LETTER; }
! 			if ($letter eq 'D') { $reg='[AaGgTtDd]'; last LETTER; }
! 			if ($letter eq 'B') { $reg='[CcGgTtBb]'; last LETTER; }
! 			$reg='\S';
  		}
! 		$regexp .= $reg;
  	}
      return $regexp;
***************
*** 770,788 ****
  		my $reg;
  		LETTER: {
! 			if ($letter eq 'A') { $reg='Aa'; last LETTER; }
! 			if ($letter eq 'C') { $reg='Cc'; last LETTER; }
! 			if ($letter eq 'G') { $reg='Gg'; last LETTER; }
! 			if ($letter eq 'T') { $reg='Tt'; last LETTER; }
! 			if ($letter eq 'M') { $reg='AaCc'; last LETTER; }
! 			if ($letter eq 'R') { $reg='AaGg'; last LETTER; }
! 			if ($letter eq 'W') { $reg='AaTt'; last LETTER; }
! 			if ($letter eq 'S') { $reg='CcGg'; last LETTER; }
! 			if ($letter eq 'Y') { $reg='CcTt'; last LETTER; }
! 			if ($letter eq 'K') { $reg='GgTt'; last LETTER; }
! 			if ($letter eq 'V') { $reg='AaCcGg'; last LETTER; }
! 			if ($letter eq 'H') { $reg='AaCcTt'; last LETTER; }
! 			if ($letter eq 'D') { $reg='AaGgTt'; last LETTER; }
! 			if ($letter eq 'B') { $reg='CcGgTt'; last LETTER; }
! 			$reg="\."; 
  		}
  		push @regexp,$reg;
--- 785,803 ----
  		my $reg;
  		LETTER: {
! 			if ($letter eq 'A') { $reg='[Aa]'; last LETTER; }
! 			if ($letter eq 'C') { $reg='[Cc]'; last LETTER; }
! 			if ($letter eq 'G') { $reg='[Gg]'; last LETTER; }
! 			if ($letter eq 'T') { $reg='[Tt]'; last LETTER; }
! 			if ($letter eq 'M') { $reg='[AaCcMm]'; last LETTER; }
! 			if ($letter eq 'R') { $reg='[AaGgRr]'; last LETTER; }
! 			if ($letter eq 'W') { $reg='[AaTtWw]'; last LETTER; }
! 			if ($letter eq 'S') { $reg='[CcGgSs]'; last LETTER; }
! 			if ($letter eq 'Y') { $reg='[CcTtYy]'; last LETTER; }
! 			if ($letter eq 'K') { $reg='[GgTtKk]'; last LETTER; }
! 			if ($letter eq 'V') { $reg='[AaCcGgVv]'; last LETTER; }
! 			if ($letter eq 'H') { $reg='[AaCcTtHh]'; last LETTER; }
! 			if ($letter eq 'D') { $reg='[AaGgTtDd]'; last LETTER; }
! 			if ($letter eq 'B') { $reg='[CcGgTtBb]'; last LETTER; }
! 			$reg='\S';
  		}
  		push @regexp,$reg;
***************
*** 938,947 ****
      my $width=$self->width;
      $self->throw ("I can calculate the score only for sequence which are exactly my size for $seq, my width is $width\n") unless (length($seq)==@{$self->{logA}});
      my @seq=split(//,$seq);
!     my $score;
      my $i=0;
      foreach my $pos (@seq) {
!         my $tv='log' . $pos;
!         $score+=$self->{$tv}->[$i];
          $i++;
      }
--- 953,964 ----
      my $width=$self->width;
      $self->throw ("I can calculate the score only for sequence which are exactly my size for $seq, my width is $width\n") unless (length($seq)==@{$self->{logA}});
+     $seq = uc($seq);
      my @seq=split(//,$seq);
!     my $score = 0;
      my $i=0;
      foreach my $pos (@seq) {
!         my $tv = 'log'.$pos;
!         $self->warn("Position ".($i+1)." of input sequence has unknown (ambiguity?) character '$pos': scores will be wrong") unless defined $self->{$tv};
!         $score += defined $self->{$tv} ? $self->{$tv}->[$i] : 0;
          $i++;
      }

Index: InstanceSite.pm
===================================================================
RCS file: /home/repository/bioperl/bioperl-live/Bio/Matrix/PSM/InstanceSite.pm,v
retrieving revision 1.14
retrieving revision 1.14.4.1
diff -C2 -d -r1.14 -r1.14.4.1
*** InstanceSite.pm	4 Jul 2006 22:23:18 -0000	1.14
--- InstanceSite.pm	17 Sep 2006 15:26:33 -0000	1.14.4.1
***************
*** 125,128 ****
--- 125,129 ----
      $self->{score}=$args{score};
      $self->{relpos}=$args{relpos};
+     $self->{frame}=$args{frame};
      $self->{anchor}=$args{anchor};
      return $self;
***************
*** 292,294 ****
--- 293,315 ----
  
  
+ =head2 frame
+ 
+  Title   : frame
+  Usage   : my $frane=$instance->frame;
+  Function: Get/Set the frame of a DNA instance with respect to a protein motif used.
+             Returns undef if the motif was not protein or the DB is protein.
+  Throws  :
+  Example :
+  Returns : integer
+  Args    : integer (0, 1, 2)
+ 
+ =cut
+ 
+ sub frame {
+     my $self = shift;
+     my $prev = $self->{frame};
+     if (@_) { $self->{frame} = shift; $self->throw("This is not a legitimate frame") unless (grep(/$self->{frame}/,qw[0 1 2])); }
+     return $prev;
+ }
+ 
  1;



More information about the Bioperl-guts-l mailing list