diff variant_effect_predictor/Bio/SeqFeature/SimilarityPair.pm @ 0:1f6dce3d34e0

Uploaded

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/variant_effect_predictor/Bio/SeqFeature/SimilarityPair.pm	Thu Apr 11 02:01:53 2013 -0400
@@ -0,0 +1,343 @@
+# $Id: SimilarityPair.pm,v 1.21 2002/12/24 15:15:32 jason Exp $
+#
+# BioPerl module for Bio::SeqFeature::SimilarityPair
+#
+# Cared for by Hilmar Lapp <[e-mail]>
+#
+# Copyright Hilmar Lapp
+#
+# You may distribute this module under the same terms as perl itself
+
+# POD documentation - main docs before the code
+
+=head1 NAME
+
+Bio::SeqFeature::SimilarityPair - Sequence feature based on the similarity
+                  of two sequences.
+
+=head1 SYNOPSIS
+
+  $sim_pair = Bio::SeqFeature::SimilarityPair->from_searchResult($blastHit);
+
+  $sim = $sim_pair->query(); # a Bio::SeqFeature::Similarity object - the query
+  $sim = $sim_pair->hit();   # dto - the hit.
+
+  # some properties for the similarity pair
+  $expect = $sim_pair->significance();
+  $score = $sim_pair->score();
+  $bitscore = $sim_pair->bits();
+
+  # this will not write the description for the sequence (only its name)
+  print $sim_pair->query()->gff_string(), "\n";
+
+=head1 DESCRIPTION
+
+Lightweight similarity search result as a pair of Similarity
+features. This class inherits off Bio::SeqFeature::FeaturePair and
+therefore implements Bio::SeqFeatureI, whereas the two features of the
+pair are descendants of Bio::SeqFeature::Generic, with better support
+for representing similarity search results in a cleaner way.
+
+=head1 FEEDBACK
+
+=head2 Mailing Lists
+
+User feedback is an integral part of the evolution of this and other
+Bioperl modules. Send your comments and suggestions preferably to one
+of the Bioperl mailing lists.  Your participation is much appreciated.
+
+  [e-mail]              - General discussion
+  http://bio.perl.org/MailList.html  - About the mailing lists
+
+=head2 Reporting Bugs
+
+Report bugs to the Bioperl bug tracking system to help us keep track
+ the bugs and their resolution.  Bug reports can be submitted via
+ email or the web:
+
+  [e-mail]
+  http://bugzilla.bioperl.org/
+
+=head1 AUTHOR - Hilmar Lapp
+
+Email [e-mail] or [e-mail]
+
+Describe contact details here
+
+=head1 APPENDIX
+
+The rest of the documentation details each of the object methods. Internal methods are usually preceded with a _
+
+=cut
+
+
+# Let the code begin...
+
+
+package Bio::SeqFeature::SimilarityPair;
+use vars qw(@ISA);
+use strict;
+
+use Bio::SeqFeature::FeaturePair;
+use Bio::SeqFeature::Similarity;
+use Bio::SearchIO;
+
+@ISA = qw(Bio::SeqFeature::FeaturePair);
+
+=head2 new
+
+ Title   : new
+ Usage   : my $similarityPair = new Bio::SeqFeature::SimilarityPair
+                                 (-hit   => $hit,
+				  -query => $query,
+				  -source => 'blastp');
+ Function: Initializes a new SimilarityPair object
+ Returns : Bio::SeqFeature::SimilarityPair
+ Args    : -query => The query in a Feature pair 
+           -hit   => (formerly '-subject') the subject/hit in a Feature pair
+
+
+=cut
+
+sub new {
+    my($class,@args) = @_;
+
+    my $self = $class->SUPER::new(@args);
+
+    # Hack to deal with the fact that SimilarityPair calls strand()
+    # which will lead to an error in Bio::Search::HSP::BlastHSP 
+    # because parsing hasn't yet occurred.
+    # TODO: Remove this when BlastHSP doesn't do lazy parsing.
+    $self->{'_initializing'} = 1;
+
+    my ($primary, $hit, $query, $fea1, $source,$sbjct) =
+	$self->_rearrange([qw(PRIMARY
+			      HIT
+			      QUERY
+			      FEATURE1
+                              SOURCE
+			      SUBJECT
+			      )],@args);
+    
+    if( $sbjct ) { 
+	# undeprecated by Jason before 1.1 release 
+        # $self->deprecated("use of -subject deprecated: SimilarityPair now uses 'hit'");
+	if(! $hit) { $hit = $sbjct } 
+	else { 
+	    $self->warn("-hit and -subject were specified, using -hit and ignoring -subject");
+	}
+    }
+
+    # make sure at least the query feature exists -- this refers to feature1
+    if($query && ! $fea1) { $self->query( $query);  } 
+    else { $self->query('null'); } # call with no args sets a default value for query
+    
+    $hit && $self->hit($hit);
+    # the following refer to feature1, which has been ensured to exist
+    if( defined $primary || ! defined $self->primary_tag) { 
+	$primary = 'similarity' unless defined $primary;
+	$self->primary_tag($primary);
+    } 
+
+    $source && $self->source_tag($source);
+    $self->strand(0) unless( defined $self->strand() );
+
+    $self->{'_initializing'} = 0;  # See "Hack" note above
+    return $self;
+}
+
+#
+# Everything else is just inherited from SeqFeature::FeaturePair.
+#
+
+=head2 query
+
+ Title   : query
+ Usage   : $query_feature = $obj->query();
+           $obj->query($query_feature);
+ Function: The query object for this similarity pair
+ Returns : Bio::SeqFeature::Similarity
+ Args    : [optional] Bio::SeqFeature::Similarity
+
+See L<Bio::SeqFeature::Similarity>, L<Bio::SeqFeature::FeaturePair>
+
+=cut
+
+sub query {
+    my ($self, @args) = @_;
+    my $f = $self->feature1();
+    if( ! @args || ( !ref($args[0]) && $args[0] eq 'null') ) {
+	if( ! defined( $f) ) {
+	    @args = Bio::SeqFeature::Similarity->new();
+	} elsif( ! $f->isa('Bio::SeqFeature::Similarity') && 
+		 $f->isa('Bio::SeqFeatureI') ) {
+	    # a Bio::SeqFeature::Generic was placeholder for feature1	    
+	    my $newf = new 
+	      Bio::SeqFeature::Similarity( -start   => $f->start(),
+					   -end     => $f->end(),
+					   -strand  => $f->strand(),
+					   -primary => $f->primary_tag(),
+					   -source  => $f->source_tag(),
+					   -seq_id  => $f->seq_id(),
+					   -score   => $f->score(),
+					   -frame   => $f->frame(),
+					   );
+	    foreach my $tag ( $newf->all_tags ) {
+		$tag->add_tag($tag, $newf->each_tag($tag));
+	    }
+	    @args = $newf;	   
+	} else {
+	    @args = ();
+	}
+    }
+    return $self->feature1(@args);
+}
+
+
+
+
+=head2 subject
+
+ Title   : subject
+ Usage   : $sbjct_feature = $obj->subject();
+           $obj->subject($sbjct_feature);
+ Function: Get/Set Subject for a SimilarityPair 
+ Returns : Bio::SeqFeature::Similarity
+ Args    : [optional] Bio::SeqFeature::Similarity
+ Notes   : Deprecated.  Use the method 'hit' instead
+
+=cut
+
+sub subject { 
+    my $self = shift;
+#    $self->deprecated("Method subject deprecated: use hit() instead");
+    $self->hit(@_); 
+}
+
+*sbjct = \&subject;
+
+=head2 hit
+
+ Title   : hit
+ Usage   : $sbjct_feature = $obj->hit();
+           $obj->hit($sbjct_feature);
+ Function: Get/Set Hit for a SimilarityPair 
+ Returns : Bio::SeqFeature::Similarity
+ Args    : [optional] Bio::SeqFeature::Similarity
+
+
+=cut
+
+sub hit {
+    my ($self, @args) = @_;
+    my $f = $self->feature2();
+    if(! @args || (!ref($args[0]) && $args[0] eq 'null') ) {
+	if( ! defined( $f) ) {
+	    @args = Bio::SeqFeature::Similarity->new();
+	} elsif( ! $f->isa('Bio::SeqFeature::Similarity') && 
+		 $f->isa('Bio::SeqFeatureI')) {
+	    # a Bio::SeqFeature::Generic was placeholder for feature2	    
+	    my $newf = new 
+	      Bio::SeqFeature::Similarity( -start   => $f->start(),
+					   -end     => $f->end(),
+					   -strand  => $f->strand(),
+					   -primary => $f->primary_tag(),
+					   -source  => $f->source_tag(),
+					   -seq_id  => $f->seq_id(),
+					   -score   => $f->score(),
+					   -frame   => $f->frame(),
+					   );
+	    foreach my $tag ( $newf->all_tags ) {
+		$tag->add_tag($tag, $newf->each_tag($tag));
+	    }
+	    @args = $newf;
+	}
+    }
+    return $self->feature2(@args);
+}
+
+=head2 source_tag
+
+ Title   : source_tag
+ Usage   : $source = $obj->source_tag(); # i.e., program
+           $obj->source_tag($evalue);
+ Function: Gets the source tag (program name typically) for a feature 
+ Returns : string
+ Args    : [optional] string
+
+
+=cut
+
+sub source_tag {
+    my ($self, @args) = @_;
+
+    if(@args) {
+	$self->hit()->source_tag(@args);
+    }
+    return $self->query()->source_tag(@args);
+}
+
+=head2 significance
+
+ Title   : significance
+ Usage   : $evalue = $obj->significance();
+           $obj->significance($evalue);
+ Function: 
+ Returns : 
+ Args    : 
+
+
+=cut
+
+sub significance {
+    my ($self, @args) = @_;
+
+    if(@args) {
+	$self->hit()->significance(@args);
+    }
+    return $self->query()->significance(@args);
+}
+
+=head2 score
+
+ Title   : score
+ Usage   : $score = $obj->score();
+           $obj->score($value);
+ Function: 
+ Returns : 
+ Args    : 
+
+
+=cut
+
+sub score {
+    my ($self, @args) = @_;
+
+    if(@args) {
+	$self->hit()->score(@args);
+    }
+    return $self->query()->score(@args);
+}
+
+=head2 bits
+
+ Title   : bits
+ Usage   : $bits = $obj->bits();
+           $obj->bits($value);
+ Function: 
+ Returns : 
+ Args    : 
+
+
+=cut
+
+sub bits {
+    my ($self, @args) = @_;
+
+    if(@args) {
+	$self->hit()->bits(@args);
+    }
+    return $self->query()->bits(@args);
+}
+
+1;