#!/usr/local/bin/perl -w
##---------------------------------------------------------------------------##
##  File:
##      @(#) TRFTRFSearchResult.pm
##  Author:
##      Robert M. Hubley   rhubley@systemsbiology.org
##  Description:
##      An object for holding a TRF search result.
##
#******************************************************************************
#* Copyright (C) Institute for Systems Biology 2003-2012 Developed by
#* Arian Smit and Robert Hubley.
#*
#* This work is licensed under the Open Source License v2.1.  To view a copy
#* of this license, visit http://www.opensource.org/licenses/osl-2.1.php or
#* see the license.txt file contained in this distribution.
#*
#******************************************************************************
# Implementation Details:
#
###############################################################################
# ChangeLog
#
#     $Log$
#
###############################################################################
# To Do:
#
#

=head1 NAME

TRFSearchResult

=head1 SYNOPSIS

use TRFSearchResult

Usage: 

    $TRFSearchResultsCollection = TRFSearchResult->new();

  or 

    $TRFSearchResultsCollection = TRFSearchResult->new( 
                                 queryName=>value, subjName=>value,
                                 pctInsert=>value, pctDelete=>value, 
                                 queryStart=>value, queryEnd=>value, 
                                 score=>value, pctDiverge=>value, 
                                 subjRemaining=>value, subjType=>value,
                                 queryRemaining=>value, id=>value,
                                 orientation=>value, queryString=>value,
                                 subjString=>value, matrix=>value,
                                 id=>value, lineageId=>value );

=head1 DESCRIPTION

A class for storing a result from the TRF search engine.

=head1 SEE ALSO

=over 4

TRFSearchResultCollection

=back

=head1 COPYRIGHT

Copyright 2012 Institute for Systems Biology

=head1 AUTHOR

Robert Hubley <rhubley@systemsbiology.org>

=head1 INSTANCE METHODS

=cut 

package TRFSearchResult;
use strict;
use SearchResult;
use Data::Dumper;
use Matrix;
use Carp;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);

require Exporter;

@ISA = qw(SearchResult Exporter);

@EXPORT = qw();

@EXPORT_OK = qw();

%EXPORT_TAGS = ( all => [ @EXPORT_OK ] );

my $CLASS = "TRFSearchResult";
my $DEBUG = 0;

use constant NoAlign           => "trf-1";
use constant AlignWithQuerySeq => "trf-2";

##-------------------------------------------------------------------------##
## Constructor:
##-------------------------------------------------------------------------##
sub new {
  my $class          = shift;
  my %nameValuePairs = @_;

  # Create ourself as a hash
  my $this = $class->SUPER::new( @_ );

  # Bless this hash in the name of the father, the son...
  bless $this, $class;

  ## Allow import of values
#if ( %nameValuePairs ) {
#  while ( my ( $name, $value ) = each( %nameValuePairs ) ) {
#    my $method = "set" . _ucFirst( $name );
#    unless ( $this->can( $method ) ) {
#      croak(
#           "TRFSearchResult::add: Instance variable $name doesn't exist." . "" );
#    }
#    $this->$method( $value );
#  }
#}

  return $this;
}

##-------------------------------------------------------------------------##

=head2 clone()

  Use: my $newObj = $obj->clone();

  Clone a TRFSearchResult *duplicating* all the values of the old
  object in the new one.

=cut

##-------------------------------------------------------------------------##
sub clone {
  my $this = shift;

  my %newHash = %{$this};
  my $newObj  = \%newHash;

  bless $newObj, ref( $this );

  return $newObj;
}

##-------------------------------------------------------------------------##
## Get and Set Methods
##-------------------------------------------------------------------------##

##-------------------------------------------------------------------------##

=head2 get_setConsensus()

  Use: my $value    = getConsensus( );
  Use: my $oldValue = setConsensus( $value );

  Get/Set the TRF consensus sequence.

=cut

##-------------------------------------------------------------------------##
sub getConsensus {
  my $obj = shift;

  my $value = $obj->{'consensus'};

  return $value;
}

sub setConsensus {
  my $obj      = shift;
  my $value    = shift;
  my $oldValue = undef;

  $oldValue = $obj->{'consensus'};
  $obj->{'consensus'} = $value;

  return $oldValue;
}

##-------------------------------------------------------------------------##

=head2 get_setPeriod()

  Use: my $value    = getPeriod( );
  Use: my $oldValue = setPeriod( $value );

  Get/Set the TRF repeat period.

=cut

##-------------------------------------------------------------------------##
sub getPeriod {
  my $obj = shift;

  my $value = $obj->{'period'};

  return $value;
}

sub setPeriod {
  my $obj      = shift;
  my $value    = shift;
  my $oldValue = undef;

  $oldValue = $obj->{'period'};
  $obj->{'period'} = $value;

  return $oldValue;
}

##-------------------------------------------------------------------------##

=head2 get_setCopyNumber()

  Use: my $value    = getCopyNumber();
  Use: my $oldValue = setCopyNumber( $value );

  Get/Set the TRF copy number for the repeat instance.

=cut

##-------------------------------------------------------------------------##
sub getCopyNumber {
  my $obj = shift;

  my $value = $obj->{'copyNumber'};

  return $value;
}

sub setCopyNumber {
  my $obj      = shift;
  my $value    = shift;
  my $oldValue = undef;

  $oldValue = $obj->{'copyNumber'};
  $obj->{'copyNumber'} = $value;

  return $oldValue;
}

##-------------------------------------------------------------------------##

=head2 get_setConsensusSize()

  Use: my $value    = getConsensusSize();
  Use: my $oldValue = setConsensusSize( $value );

  Get/Set the length of the TRF consensus.

=cut

##-------------------------------------------------------------------------##
sub getConsensusSize {
  my $obj = shift;

  my $value = $obj->{'consensusSize'};

  return $value;
}

sub setConsensusSize {
  my $obj      = shift;
  my $value    = shift;
  my $oldValue = undef;

  $oldValue = $obj->{'consensusSize'};
  $obj->{'consensusSize'} = $value;

  return $oldValue;
}

##-------------------------------------------------------------------------##
## General Object Methods
##-------------------------------------------------------------------------##

##-------------------------------------------------------------------------##
## Private Methods
##-------------------------------------------------------------------------##

##-------------------------------------------------------------------------##
## Use: my $cmString = $obj->_toLocalFormat();
##
##   TODO: Document
##
##-------------------------------------------------------------------------##
sub _toLocalFormat {
  my $obj           = shift;
  my $alignmentMode = shift;

  $alignmentMode = TRFSearchResult::NoAlign
      if ( !defined $alignmentMode );
  croak $CLASS
      . "::toStringFormatted: Unknown alignment mode "
      . "( $alignmentMode )\n"
      if (    $alignmentMode != TRFSearchResult::NoAlign
           && $alignmentMode != TRFSearchResult::AlignWithQuerySeq );

  my $retStr = "";
  my $sbjDir;
  my $sbjDirStr;
  my $alignIndex = 0;
  my $alignCol;

  my ( $qryName ) = ( $obj->{qryName} =~ /(\S+).*/ );
  $retStr .=
        "$obj->{score} $obj->{percDiv} $obj->{percDel} "
      . "$obj->{percIns} $qryName $obj->{qryBegin} "
      . "$obj->{qryEnd} ($obj->{qryLeft}) ";
  my ( $sbjName ) = ( $obj->{sbjName} =~ /(\S+).*/ );
  if ( $obj->{sbjOrient} eq "C" ) {
    $retStr .=
        "C $sbjName ($obj->{sbjLeft}) " . "$obj->{sbjEnd} $obj->{sbjBegin}";
  }
  else {
    $retStr .=
        "$sbjName $obj->{sbjBegin} $obj->{sbjEnd} " . "($obj->{sbjLeft})";
  }
  if ( defined $obj->{id} ) {
    $retStr .= " $obj->{id}";
  }
  if ( defined $obj->{lineageId} ) {
    $retStr .= " $obj->{lineageId}";
  }
  if ( defined $obj->{overlap} ) {
    $retStr .= " $obj->{overlap}";
  }
  $retStr .= "\n";

  if (    $alignmentMode != TRFSearchResult::NoAlign
       && defined $obj->{querySeq}
       && $obj->{querySeq} ne "" )
  {
    my $qMasked;
    my $sMasked;
    my $insertions = 0;
    my $deletions  = 0;

    my $query   = $obj->{querySeq};
    my $subject = $obj->{subjSeq};

    $retStr .= "\n";

    #    if (    $obj->{sbjOrient} eq "C"
    #         && $alignmentMode == TRFSearchResult::AlignWithSubjSeq )
    #    {
    #      $query = reverse $query;
    #      $query =~ tr/ACGTYRMKHBVD/TGCARYKMDVBH/;    # complement
    #      $subject = reverse $subject;
    #      $subject =~ tr/ACGTYRMKHBVD/TGCARYKMDVBH/;    # complement
    #    }

    my $qStart = $obj->{qryBegin};

    #    if (    $obj->{sbjOrient} eq "C"
    #         && $alignmentMode == TRFSearchResult::AlignWithSubjSeq )
    #    {
    #      $qStart = $obj->{qryEnd};
    #    }
    my $qEnd   = 0;
    my $sStart = $obj->{sbjBegin};
    if (    $obj->{sbjOrient} eq "C"
         && $alignmentMode == TRFSearchResult::AlignWithQuerySeq )
    {
      $sStart = $obj->{sbjEnd};
    }
    my $sEnd = 0;
    while ( $query ) {
      $query =~ s/^(.{1,50})//;
      my $qSeq = $1;
      $subject =~ s/^(.{1,50})//;
      my $sSeq = $1;

      $insertions = ( $qSeq =~ tr/-/-/ );
      $deletions  = ( $sSeq =~ tr/-/-/ );

      if ( $sEnd > 0 ) {
        my $qIncr = 0;
        my $sIncr = 0;
        $qIncr = 1 if ( length( $qSeq ) > $insertions );
        $sIncr = 1 if ( length( $sSeq ) > $deletions );
        if ( $obj->{sbjOrient} eq "C" ) {

         #          if ( $alignmentMode == TRFSearchResult::AlignWithSubjSeq ) {
         #            $qStart = $qEnd - $qIncr;
         #            $sStart = $sEnd + $sIncr;
         #          }
         #          else {
          $qStart = $qEnd + $qIncr;
          $sStart = $sEnd - $sIncr;

          #          }
        }
        else {
          $qStart = $qEnd + $qIncr;
          $sStart = $sEnd + $sIncr;
        }
      }

      # Indicate orientation in alignment data by placing a "C" in front
      # of sequences which have been reverse complemented
      #      if (    $obj->{'sbjOrient'} eq "C"
      #           && $alignmentMode == TRFSearchResult::AlignWithSubjSeq )
      #      {
      #        $qEnd = $qStart - length( $qSeq ) + 1 + $insertions;
      #        $retStr .= "C ";
      #      }
      #      else {
      $qEnd = $qStart + length( $qSeq ) - 1 - $insertions;
      $retStr .= "  ";

      #      }
      $qEnd = $qStart if ( length( $qSeq ) == $insertions );

      # Up to 13 characters are allowed from the QueryName/SubjName
      $retStr .= substr( $obj->{'qryName'}, 0, 13 )
          . " " x (
           13 - (
             length( $obj->{'qryName'} ) < 13 ? length( $obj->{'qryName'} ) : 13
           )
          );

      # Up to 9 characters for the position, followed by the sequence and
      # end positions
      $retStr .= " " x ( 9 - length( $qStart ) ) . $qStart . " $qSeq $qEnd\n";

      # The modification codes
      $retStr .= " " x 25;
      for ( my $j = 0 ; $j < length( $qSeq ) ; $j++ ) {
        my $qChar = substr( $qSeq, $j, 1 );
        my $sChar = substr( $sSeq, $j, 1 );
        if ( $qChar eq $sChar ) {
          $retStr .= " ";
        }
        elsif ( $qChar eq "-" || $sChar eq "-" ) {
          $retStr .= "-";
        }
        elsif (    $qChar . $sChar eq "CT"
                || $qChar . $sChar eq "TC"
                || $qChar . $sChar eq "AG"
                || $qChar . $sChar eq "GA" )
        {
          $retStr .= "i";
        }
        elsif (    $qChar . $sChar eq "GT"
                || $qChar . $sChar eq "TG"
                || $qChar . $sChar eq "GC"
                || $qChar . $sChar eq "CG"
                || $qChar . $sChar eq "CA"
                || $qChar . $sChar eq "AC"
                || $qChar . $sChar eq "AT"
                || $qChar . $sChar eq "TA" )
        {
          $retStr .= "v";
        }
        elsif (    ( $qChar =~ /[BDHVRYKMSWNX]/ )
                || ( $sChar =~ /[BDHVRYKMSWNX]/ ) )
        {
          $retStr .= "?";
        }
        else {
          $retStr .= " ";
        }
      }
      $retStr .= "\n";

      # Subject orientation/name
      if (    $obj->{'sbjOrient'} eq "C"
           && $alignmentMode == TRFSearchResult::AlignWithQuerySeq )
      {
        $retStr .= "C ";
        $sEnd = $sStart - length( $sSeq ) + 1 + $deletions;
      }
      else {
        $retStr .= "  ";
        $sEnd = $sStart + length( $sSeq ) - 1 - $deletions;
      }
      $retStr .= substr( $obj->{'sbjName'}, 0, 13 )
          . " " x (
           13 - (
             length( $obj->{'sbjName'} ) < 13 ? length( $obj->{'sbjName'} ) : 13
           )
          );
      $retStr .= " " x ( 9 - length( $sStart ) ) . $sStart . " $sSeq $sEnd\n";
      $retStr .= "\n";

    }    # while ( $query )

    if ( defined $obj->getMatrixName() ) {
      $retStr .= "Matrix = " . $obj->getMatrixName() . "\n";
    }
    else {
      $retStr .= "Matrix = Unknown\n";
    }
    $retStr .= "Transitions / transversions = ";
    my ( $mismatches, $transitions, $transversions, $numGaps, $totGapLen ) =
        $obj->_getAlignmentStats();
    if ( defined $transitions ) {
      if ( $transversions > 0 ) {
        $retStr .= sprintf( "%0.2f", ( $transitions / $transversions ) );
      }
      else {
        $retStr .= "0.0";
      }
      $retStr .= " ($transitions / $transversions)\n";
      if ( ( $obj->getQueryEnd() - $obj->getQueryStart() ) > 0 ) {
        $retStr .= "Gap_init rate = "
            . sprintf( "%0.2f",
                       $numGaps /
                           ( $obj->getQueryEnd() - $obj->getQueryStart() ) )
            . " ($numGaps / "
            . ( $obj->getQueryEnd() - $obj->getQueryStart() ) . ")";
      }
      else {
        $retStr .= "Gap_init rate = 0.0 ( $numGaps / 0 )";
      }
      if ( $numGaps > 0 ) {
        $retStr .=
              ", avg. gap size = "
            . sprintf( "%0.2f", ( $totGapLen / $numGaps ) )
            . " ($totGapLen / $numGaps)\n\n";
      }
      else {
        $retStr .= ", avg. gap size = 0.0 (0 / 0)\n\n";
      }

    }
    else {
      $retStr .= "Transitions / transversions = Unknown\n";
      $retStr .= "Gap_init rate = Unknown, avg. gap size = Unknown\n\n";
    }
  }

  return $retStr;
}

1;