view variant_effect_predictor/Bio/EnsEMBL/IdentityXref.pm @ 3:d30fa12e4cc5 default tip

Merge heads 2:a5976b2dce6f and 1:09613ce8151e which were created as a result of a recently fixed bug.

=head1 LICENSE

  Copyright (c) 1999-2012 The European Bioinformatics Institute and
  Genome Research Limited.  All rights reserved.

  This software is distributed under a modified Apache license.
  For license details, please see

    http://www.ensembl.org/info/about/code_licence.html

=head1 CONTACT

  Please email comments or questions to the public Ensembl
  developers list at <[e-mail]>.

  Questions may also be sent to the Ensembl help desk at
  <[e-mail]>.

=cut

=head1 NAME

Bio::EnsEMBL::IdentityXref

=head1 SYNOPSIS

  my $xref = Bio::EnsEMBL::IdentityXref->new(
    -XREF_IDENTITY    => 80.4,
    -ENSEMBL_IDENTITY => 90.1,
    -SCORE            => 90,
    -EVALUE           => 12,
    -CIGAR_LINE       => '23MD3M2I40M',
    -XREF_START       => 1,
    -XREF_END         => 68,
    -ENSEMBL_START    => 10,
    -ENSEMBL_END      => 77,
    -ADAPTOR          => $adaptor,
    -PRIMARY_ID       => $primary_id,
    -DBNAME           => 'SwissProt'
  );

=head1 METHODS

=cut

package Bio::EnsEMBL::IdentityXref;
use vars qw(@ISA $AUTOLOAD);
use strict;
use Bio::EnsEMBL::Utils::Argument qw( rearrange );
use Bio::EnsEMBL::Utils::Exception qw( deprecate );

@ISA = qw( Bio::EnsEMBL::DBEntry );


=head2 new

  Arg [...]  : XREF_IDENTITY ENSEMBL_IDENTITY SCORE EVALUE CIGAR_LINE
             : XREF_START XREF_END ENSEMBL_START ENSEMBL_END
             : ANALYSIS pairs
  Example    : see synopsis 
  Description: Create a new Bio::EnsEMBL::IdentityXref object
  Returntype : Bio::EnsEMBL::IdentityXref
  Exceptions : none
  Caller     : general
  Status     : Stable

=cut

my $error_shown = 0;

sub new {
    my ($class, @args) = @_;
    my $self = $class->SUPER::new(@args);
    my ($query_identity, $target_identity, $score, $evalue, 
        $cigar_line, $query_start, $query_end, $translation_start,
        $translation_end, $analysis, $xref_identity, $ensembl_identity, 
        $xref_start, $xref_end, $ensembl_start, $ensembl_end) = rearrange(
        [qw(QUERY_IDENTITY TARGET_IDENTITY SCORE EVALUE CIGAR_LINE 
            QUERY_START QUERY_END TRANSLATION_START TRANSLATION_END
            ANALYSIS XREF_IDENTITY ENSEMBL_IDENTITY XREF_START XREF_END ENSEMBL_START ENSEMBL_END)], @args);

    if((defined($query_identity) or defined($target_identity) or defined($query_start) or defined ($query_end) or
       defined($translation_start) or defined($translation_end)) and !$error_shown){
      print STDERR "Arguments have now been changed to stop confusion so please replace the following\n";
      print STDERR "\tQUERY_IDENTITY\t->\tXREF_IDENTITY\n";
      print STDERR "\tTARGET_IDENTITY\t->\tENSEMBL_IDENTITY\n";
      print STDERR "\tQUERY_START\t->\tXREF_START\n";
      print STDERR "\tQUERY_END\t->\tXREF_END\n";
      print STDERR "\tTRANSLATION_START\t->\tENSEMBL_START\n";
      print STDERR "\tTRANSLATION_END\t->\tENSEMBL_END\n";
      print STDERR "The old arguments will be removed in a futute release so please change your code to the new names\n";
      $error_shown = 1;
    }
    $self->{'xref_identity'} = $query_identity || $xref_identity;
    $self->{'ensembl_identity'} = $target_identity || $ensembl_identity;
    $self->{'score'} = $score;
    $self->{'evalue'} = $evalue;
    $self->{'cigar_line'} = $cigar_line;
    $self->{'xref_start'} = $query_start || $xref_start;
    $self->{'xref_end'} = $query_end || $xref_start;
    $self->{'ensembl_start'} = $translation_start || $ensembl_start;
    $self->{'ensembl_end'} = $translation_end || $ensembl_end;
    $self->{'analysis'} = $analysis;

    return $self;
}

=head2 xref_identity

  Arg [1]    : (optional) string $value
  Example    : $xref_identity = $id_xref->xref_identity;
  Description: Getter/Setter for xref identity
  Returntype : string
  Exceptions : none
  Caller     : general
  Status     : Stable

=cut

sub xref_identity{
   my $obj = shift;
   if( @_ ) {
       my $value = shift;
       $obj->{'xref_identity'} = $value;
   }
   return $obj->{'xref_identity'};

}


=head2 ensembl_identity

  Arg [1]    : (optional) string $value
  Example    : $ensembl_identity = $id_xref->ensembl_identity;
  Description: Getter/Setter for ensembl identity
  Returntype : string
  Exceptions : none
  Caller     : general
  Status     : Stable

=cut

sub ensembl_identity{
   my $obj = shift;
   if( @_ ) {
      my $value = shift;
      $obj->{'ensembl_identity'} = $value;
    }
    return $obj->{'ensembl_identity'};

}



=head2 cigar_line

  Arg [1]    : string $cigar_line
  Example    : none
  Description: get/set for attribute cigar_line
  Returntype : string
  Exceptions : none
  Caller     : general
  Status     : Stable

=cut

sub cigar_line {
  my $self = shift;
  $self->{'cigar_line'} = shift if( @_ );
  return $self->{'cigar_line'};
}


=head2 ensembl_start

  Arg [1]    : string $ensembl_start
  Example    : none
  Description: get/set for attribute ensembl_start
  Returntype : string
  Exceptions : none
  Caller     : general
  Status     : Stable

=cut

sub ensembl_start {
   my $self = shift;
  $self->{'ensembl_start'} = shift if( @_ );
  return $self->{'ensembl_start'};
}


=head2 ensembl_end

  Arg [1]    : string $ensembl_end
  Example    : none
  Description: get/set for attribute ensembl_end
  Returntype : string
  Exceptions : none
  Caller     : general
  Status     : Stable

=cut

sub ensembl_end {
   my $self = shift;
  $self->{'ensembl_end'} = shift if( @_ );
  return $self->{'ensembl_end'};
}


=head2 xref_start

  Arg [1]    : string $xref_start
  Example    : none
  Description: get/set for attribute xref_start
  Returntype : string
  Exceptions : none
  Caller     : general
  Status     : Stable

=cut

sub xref_start {
   my $self = shift;
  $self->{'xref_start'} = shift if( @_ );
  return $self->{'xref_start'};
}


=head2 xref_end

  Arg [1]    : string $xref_end
  Example    : none
  Description: get/set for attribute xref_end
  Returntype : string
  Exceptions : none
  Caller     : general
  Status     : Stable

=cut

sub xref_end {
   my $self = shift;
  $self->{'xref_end'} = shift if( @_ );
  return $self->{'xref_end'};
}


=head2 score

  Arg [1]    : string $score
  Example    : none
  Description: get/set for attribute score
  Returntype : string
  Exceptions : none
  Caller     : general
  Status     : Stable

=cut

sub score {
   my $self = shift;
  $self->{'score'} = shift if( @_ );
  return $self->{'score'};
}


=head2 evalue

  Arg [1]    : string $evalue
  Example    : none
  Description: get/set for attribute evalue
  Returntype : string
  Exceptions : none
  Caller     : general
  Status     : Stable

=cut

sub evalue {
   my $self = shift;
  $self->{'evalue'} = shift if( @_ );
  return $self->{'evalue'};
}




=head2 get_mapper

  Args       : none
  Example    : none
  Description: produces a mapper object that takes coordinates from one side 
               of the alignment to the other side. "ensembl" and "external" 
               are the two coordinate systems contained.
  Returntype : Bio::EnsEMBL::Mapper
  Exceptions : none
  Caller     : general, ProteinDAS subsystem
  Status     : Stable

=cut


sub get_mapper {
  my ( $self ) = @_;
  # parse the cigar_line and create a mapper ...
  if( exists $self->{'_cached_mapper'} ) {
    return $self->{'_cached_mapper'};
  }

  my ( @lens, @chars );

  # if there is no cigar line, nothing is going to be loaded
  if( $self->cigar_line() ) {
    my @pre_lens = split( '[DMI]', $self->cigar_line() );
    @lens = map { if( ! $_ ) { 1 } else { $_ }} @pre_lens;
    @chars = grep { /[DMI]/ } split( //, $self->cigar_line() );
  }
  my $translation_start = $self->ensembl_start();
  my $translation_end = $self->ensembl_end();
  my $query_start = $self->xref_start();
  my $query_end = $self->xref_end();

  #  my $hit_id = $self->display_id();
  my $ensembl_id = "ensembl_id";
  my $external_id = "external_id";
  # now build the mapper
  my $mapper = Bio::EnsEMBL::Mapper->new( "external", "ensembl" );


  for( my $i=0; $i<=$#lens; $i++ ) {
    my $length = $lens[$i];
    my $char = $chars[$i];
    if( $char eq "M" ) {
      $mapper->add_map_coordinates( $external_id, $query_start,
                                    $query_start + $length - 1, 1,
                                    $ensembl_id, $translation_start,
                                    $translation_start + $length - 1);
      $query_start += $length;
      $translation_start += $length;

    } elsif( $char eq "D" ) {
      $translation_start += $length;
    } elsif( $char eq "I" ) {
      $query_start += $length;
    }
  }

  $self->{'_cached_mapper'} = $mapper;

  return $mapper;
}



=head2 transform_feature

  Arg [1]    : a feature type with start and end $feature
               This doesnt need to be a Bio::EnsEMBL::Feature as it doesnt
               need an attached slice. We may have to introduce an appropriate
               object type.
  Example    : my $ens_prot_feature_list = 
                    $ident_xref->transform_feature( $swiss_prot_feature );
  Description: a list of potential partial features which represent all 
               mappable places
               of the original feature in ensembl translation coordinates.
  Returntype : listref of whatever was put in
  Exceptions : none
  Caller     : general, ProteinDAS subsystem
  Status     : Stable

=cut


sub transform_feature {
  my $self= shift;
  my $feature = shift;

  my $fstart = $feature->start();
  my $fend = $feature->end();

  my $mapper = $self->get_mapper();
  my @result;

  my @coords = $mapper->map_coordinates( "external_id", $fstart, $fend, 
                                           1, "external" );

  for my $coord ( @coords ) {
    if( $coord->isa( "Bio::EnsEMBL::Mapper::Coordinate" )) {
      my $new_feature;
      %{$new_feature} = %$feature;
      bless $new_feature, ref( $feature );
      $new_feature->start( $coord->start() );
      $new_feature->end( $coord->end() );

      push( @result, $new_feature );
    }
  }

  return \@result;
}



=head2 map_feature

  Arg [1]    : a start,end capable feature object
  Example    : none
  Description: 
  Returntype : list of Coordinates/Gaps which represents the mapping
  Exceptions : none
  Caller     : another way of doing ProteinDAS
  Status     : Stable

=cut

sub map_feature {
  my $self = shift;
  my $feature = shift;


  my $fstart = $feature->start();
  my $fend = $feature->end();

  my $mapper = $self->get_mapper();
  my @coords = $mapper->map_coordinates( "external_id", $fstart, $fend, 1,
                                         "external" );

  return @coords;
}


###########################
# DEPRECATED METHODS FOLLOW
###########################

=head2 query_identity

  Description: DEPRECATED. Use xref_identity() instead.
  Status     : At Risk

=cut

sub query_identity{
  deprecate("Use xref_identity instead");
  xref_identity(@_);
}


=head2 target_identity

  Description: DEPRECATED. Use ensembl_identity() instead.
  Status     : At Risk

=cut

sub target_identity{
  deprecate("Use ensembl_identity instead");
  ensembl_identity(@_);
}



=head2 translation_start

  Description: DEPRECATED. Use ensembl_start() instead.
  Status     : At Risk

=cut

sub translation_start {
  deprecate("Use ensembl_start instead");
  ensembl_start(@_);

}


=head2 translation_end

  Description: DEPRECATED. Use ensembl_end() instead.
  Status     : At Risk

=cut

sub translation_end {
  deprecate("Use ensembl_end instead");
  ensembl_end(@_);
}



=head2 query_start

  Description: DEPRECATED. Use xref_start() instead.
  Status     : At Risk

=cut

sub query_start {
  deprecate("Use xref_start instead");
  xref_start(@_);

}



=head2 query_end

  Description: DEPRECATED. Use xref_end() instead.
  Status     : At Risk

=cut

sub query_end {
  deprecate("Use xref_end instead");
  xref_end(@_);

}


1;