Bio::LiveSeq::SeqI - Abstract sequence interface class for LiveSeq

  # documentation needed

  bioperl-l@bioperl.org                  - General discussion
  http://bioperl.org/wiki/Mailing_lists  - About the mailing lists

  https://redmine.open-bio.org/projects/bioperl/

       a base is the "value" that an "element" of a "chain" can assume
         (see documentation on the Chain datastructure if interested)

 Title   : seq
 Usage   : $string    = $obj->seq()
 Function: Returns the complete sequence of an object as a string of letters.
           Suggested cases are upper case for proteins and lower case for
           DNA sequence (IUPAC standard),
 Returns : a string

 Title   : all_labels
 Usage   : @labels = $obj->all_labels()
 Function: all the labels of every nucleotide an object is composed of
 Returns : an array of labels
 Args    : none

  Title   : labelsubseq
  Usage   : $dna->labelsubseq();
          : $dna->labelsubseq($startlabel);
          : $dna->labelsubseq($startlabel,$length);
          : $dna->labelsubseq($startlabel,undef,$endlabel);
  e.g.    : $dna->labelsubseq(4,undef,8);
  Function: prints the sequence as string. The difference between labelsubseq
            and normal subseq is that it uses /labels/ as arguments, instead
            than positions. This allows for faster and more efficient lookup,
            skipping the (usually) lengthy conversion of positions into labels.
            This is especially useful for manipulating with high power
            LiveSeq objects, knowing the labels and exploiting their
            usefulness.
  Returns : a string
  Errorcode -1
  Args    : without arguments it returns the entire sequence
            with a startlabel it returns the sequence downstream that label
            if a length is specified, it returns only that number of bases
            if an endlabel is specified, it overrides the length argument
             and prints instead up to that label (included)
  Defaults: $startlabel defaults to the beginning of the entire sequence
            $endlabel defaults to the end of the entire sequence

 Title   : subseq
 Usage   : $substring = $obj->subseq(10,40);
         : $substring = $obj->subseq(10,undef,4);
 Function: returns the subseq from start to end, where the first base
           is 1 and the number is inclusive, ie 1-2 are the first two
           bases of the sequence

           Start cannot be larger than end but can be equal.

           Allows for negative numbers $obj->subseq(-10,-1). By
           definition, there is no 0!
                       -5  -1 1   5
                gctagcgcccaac atggctcgctg

           This allows one to retrieve sequences upstream from given position.

           The precedence is from left to right: if END is given LENGTH is
           ignored.

 Examples: $obj->subseq(-10,undef,10) returns 10 elements before position 1
           $obj->subseq(4,8) returns elements from the 4th to the 8th, inclusive

 Returns : a string
 Errorcode: -1
 Args    : start,  integer, defaults to start of the sequence
           end,    integer, '' or undef, defaults to end of the sequence
           length, integer, '' or undef
           an optional strand (1 or -1) 4th argument
            if strand argument is not given, it will default to the object
            argment. This argument is useful when a call is issued from a child
            of a parent object containing the subseq method

  Title   : length
  Usage   : $seq->length();
  Function: returns the number of nucleotides (or the number of aminoacids)
            in the entire sequence
  Returns : an integer
  Errorcode -1
  Args    : none

 Title   : display_id
 Usage   : $id_string = $obj->display_id();
 Function: returns the display id, alias the common name of the object

           The semantics of this is that it is the most likely string
           to be used as an identifier of the sequence, and likely to
           have "human" readability.  The id is equivalent to the ID
           field of the GenBank/EMBL databanks and the id field of the
           Swissprot/sptrembl database. In fasta format, the >(\S+) is
           presumed to be the id, though some people overload the id
           to embed other information.

 See also: accession_number
 Returns : a string
 Args    : none

 Title   : accession_number
 Usage   : $unique_biological_key = $obj->accession_number;
 Function: Returns the unique biological id for a sequence, commonly
           called the accession_number.
           Notice that primary_id() provides the unique id for the
           implemetation, allowing multiple objects to have the same accession
           number in a particular implementation.

           For objects with no accession_number this method returns "unknown".
 Returns : a string
 Args    : none

 Title   : primary_id
 Usage   : $unique_implementation_key = $obj->primary_id;
 Function: Returns the unique id for this object in this
           implementation. This allows implementations to manage their own
           object ids in a way the implementation can control. Clients can
           expect one id to map to one object.

           For sequences with no primary_id, this method returns
           a stringified memory location.

 Returns : A string
 Args    : None

 Title   : change
 Usage   : $substring = $obj->change('AA', 10);
 Function: changes, modifies, mutates the LiveSequence
 Examples:
        $obj->change('',   10);      delete nucleotide #10
        $obj->change('',   10, 2);   delete two nucleotides starting from #10
        $obj->change('G',  10);      change nuc #10 to 'G'
        $obj->change('GA', 10, 4);   replace #10 and 3 following with 'GA'
        $obj->change('GA', 10, 2));  is same as $obj->change('GA',  10);
        $obj->change('GA', 10, 0 );  insert 'GA' before nucleotide at #10
        $obj->change('GA', 10, 1);   GA inserted before #10, #10 deleted
        $obj->change('GATC', 10, 2); GATC inserted before #10, #10&#11 deleted
        $obj->change('GATC', 10, 6); GATC inserted before #10, #10-#15 deleted




 Returns : a string of deleted bases (if any) or 1 (everything OK)
 Errorcode: -1
 Args    : seq,    string, or '' ('' = undef = 0 = deletion)
           start,  integer
           length, integer (optional)

 Title   : positionchange
 Function: Exactly like change. I.e. change() defaults to positionchange()

 Title   : labelchange
 Function: Exactly like change but uses a /label/ instead than a position
           as second argument. This allows for multiple changes in a LiveSeq
           without the burden of recomputing positions. I.e. for a multiple
           change in two different points of the LiveSeq, the approach would
           be the following: fetch the correct labels out of the two different
           positions (method: label($position)) and then use the labelchange()
           method to modify the sequence using those labels instead than
           relying on the positions (that would have modified after the
           first change).

  Title   : valid
  Usage   : $boolean = $obj->valid($label)
  Function: tests if a label exists inside the object
  Returns : boolean
  Args    : label

  Title   : start
  Usage   : $startlabel=$obj->start()
  Function: returns the label of the first nucleotide of the object (exon, CDS)
  Returns : label
  Args    : none

  Title   : end
  Usage   : $endlabel=$obj->end()
  Function: returns the label of the last nucleotide of the object (exon, CDS)
  Returns : label
  Args    : none

  Title   : strand
  Usage   : $strand=$obj->strand()
            $obj->strand($strand)
  Function: gets or sets strand information, being 1 or -1 (forward or reverse)
  Returns : -1 or 1
  Args    : none OR -1 or 1

 Title   : alphabet
 Usage   : if( $obj->alphabet eq 'dna' ) { /Do Something/ }
 Function: Returns the type of sequence being one of
           'dna', 'rna' or 'protein'. This is case sensitive.

 Returns : a string either 'dna','rna','protein'.
 Args    : none

  Title   : coordinate_start
  Usage   : $coordstartlabel=$obj->coordinate_start()
          : $coordstartlabel=$obj->coordinate_start($label)
  Function: returns and optionally sets the first label of the coordinate
            system used
            For some objects only labels inside the object or in frame (for
            Translation objects) will be allowed to get set as coordinate start

  Returns : label. It returns 0 if label not found.
  Errorcode -1
  Args    : an optional reference $label that is position 1

  Title   : label
  Usage   : $seq->label($position)
          : $seq->label($position,$firstlabel)
  Examples: $nextlabel=$seq->label(2,$label) -> retrieves the following label
          : $prevlabel=$seq->label(-1,$label) -> retrieves the preceding label

  Function: returns the label of the nucleotide at $position from current
            coordinate start
  Returns : a label. It returns 0 if label not found.
  Errorcode -1
  Args    : a position,
            an optional reference $firstlabel that is to be used as position 1
            an optional strand (1 or -1) argument
             if strand argument is not given, it will default to the object
             argument. This argument is useful when a call is issued from a child
             of a parent object containing the subseq method

  Title   : position
  Usage   : $seq->position($label)
          : $seq->position($label,$firstlabel)
  Function: returns the position of nucleotide at $label
  Returns : the position of the label from current coordinate start
  Errorcode 0
  Args    : a label pointing to a certain nucleotide (e.g. start of exon)
            an optional "firstlabel" as reference to count from
            an optional strand (1 or -1) argument
             if strand argument is not given, it will default to the object
             argument. This argument is useful when a call is issued from a child
             of a parent object containing the subseq method

  Title   : follows
  Usage   : $seq->follows($firstlabel,$secondlabel)
          : $seq->follows($firstlabel,$secondlabel,$strand)
  Function: checks if SECONDlabel follows FIRSTlabel, undependent of the strand
            i.e. it checks downstream for forward strand and
            upstream for reverse strand
  Returns : 1 or 0
  Errorcode -1
  Args    : two labels
            an optional strand (1 or -1) argument
             if strand argument is not given, it will default to the object
             argument. This argument is useful when a call is issued from a child
             of a parent object containing the subseq method

 Title   : gene
 Usage   : my $gene=$obj->gene;
 Function: Gets or sets the reference to the LiveSeq::Gene object.
           Objects that are features of a LiveSeq Gene will have this
           attribute set automatically.

 Returns : reference to an object of class Gene
 Note    : if Gene object is not set, this method will return 0;
 Args    : none or reference to object of class Bio::LiveSeq::Gene

 Title   : obj_valid
 Usage   : if ($obj->obj_valid) {do something;}
 Function: Checks if start and end labels are still valid for the ojbect,
           i.e. tests if the LiveSeq object is still valid
 Returns : boolean
 Args    : none

 Title   : name
 Usage   : $name = $obj->name;
         : $name = $obj->name("ABCD");
 Function: Returns or sets the name of the object.
           If there is no name, it will return "unknown";
 Returns : A string
 Args    : None

 Title   : desc
 Usage   : $desc = $obj->desc;
         : $desc = $obj->desc("ABCD");
 Function: Returns or sets the description of the object.
           If there is no description, it will return "unknown";
 Returns : A string
 Args    : None

 Title   : source
 Usage   : $name = $obj->source;
         : $name = $obj->source("Homo sapiens");
 Function: Returns or sets the organism that is source of the object.
           If there is no source, it will return "unknown";
 Returns : A string
 Args    : None

#
# bioperl module for Bio::LiveSeq::SeqI
#
# Please direct questions and support issues to <bioperl-l@bioperl.org>
#
# Cared for by Joseph Insana <insana@ebi.ac.uk> <jinsana@gmx.net>
#
# Copyright Joseph Insana
#
# You may distribute this module under the same terms as perl itself
#
# POD documentation - main docs before the code

#'
# Let the code begin...

package Bio::LiveSeq::SeqI;
use strict;
use Bio::Tools::CodonTable; # for the translate() function

use base qw(Bio::Root::Root Bio::LiveSeq::ChainI Bio::PrimarySeqI);

sub seq {
  my $self = shift;
  my ($start,$end) = ($self->start(),$self->end());
  if ($self->strand() == 1) {
    return $self->{'seq'}->down_chain2string($start,undef,$end);
  } else { # reverse strand
    my $str = $self->{'seq'}->up_chain2string($start,undef,$end);
    $str =~ tr/acgtrymkswhbvdnxACGTRYMKSWHBVDNX/tgcayrkmswdvbhnxTGCAYRKMSWDVBHNX/;
    return $str;
  }
}

sub all_labels {
  my $self = shift;
  my ($start,$end) = ($self->start(),$self->end());
  my $labels;
  if ($self->strand() == 1) {
    $labels=$self->{'seq'}->down_labels($start,$end);
  } else {
    $labels=$self->{'seq'}->up_labels($start,$end);
  }
  return (@{$labels});
}

# NOTE: unsecuremode is to be used /ONLY/ if sure of the start and end labels, especially that they follow each other in the correct order!!!!

sub labelsubseq {
  my ($self,$start,$length,$end,$unsecuremode) = @_;
  if (defined $unsecuremode && $unsecuremode eq "unsecuremoderequested")
  { # to skip security checks (faster)
    unless ($start) {
      $start=$self->start;
    }
    if ($end) {
      if ($end == $start) {
	$length=1;
	undef $end;
      } else {
	undef $length;
      }
    } else {
      unless ($length) {
	$end=$self->end;
      }
    }
  } else {
    if ($start) {
      unless ($self->{'seq'}->valid($start)) {
	$self->warn("Start label not valid"); return (-1);
      }
    }
    if ($end) {
      if ($end == $start) {
	$length=1;
	undef $end;
      } else {
	unless ($self->{'seq'}->valid($end)) {
	  $self->warn("End label not valid"); return (-1);
	}
	unless ($self->follows($start,$end) == 1) {
	  $self->warn("End label does not follow Start label!"); return (-1);
	}
	undef $length;
      }
    }
  }
  if ($self->strand() == 1) {
    return $self->{'seq'}->down_chain2string($start,$length,$end);
  } else { # reverse strand
    my $str = $self->{'seq'}->up_chain2string($start,$length,$end);
    $str =~ tr/acgtrymkswhbvdnxACGTRYMKSWHBVDNX/tgcayrkmswdvbhnxTGCAYRKMSWDVBHNX/;
    return $str;
  }
}

#'
# check the fact about reverse strand!
# is it feasible? Is it correct? Should we do it? How about exons? Does it
# work when you ask subseq of an exon?
# eliminated now (Mon night)
sub subseq {
  ##my ($self,$pos1,$pos2,$length,$strand) = @_;
  my ($self,$pos1,$pos2,$length,$strand) = @_;
  ##unless (defined ($strand)) { # if optional [strand] argument not given
  ##  $strand=$self->strand;
  ##}
  $strand=$self->strand;
  my ($str,$startlabel,$endlabel);
  if (defined ($length)) {
    if ($length < 1) {
      $self->warn("No sense asking for a subseq of length < 1");
      return (-1);
    }
  }
  unless (defined ($pos1)) {
    #print "\n##### DEBUG pos1 not defined\n";
    $startlabel=$self->start;
  } else {
    if ($pos1 == 0) {  # if position = 0 complain
      $self->warn("Position cannot be 0!"); return (-1);
    }
    ##if ($strand == 1) { # CHECK THIS!
      if ((defined ($pos2))&&($pos1>$pos2)) {
	$self->warn("1st position($pos1) cannot be > 2nd position($pos2)!"); return (-1);
      }
    ##} else { # CHECK THIS!
    ##  if ((defined ($pos2))&&($pos1<$pos2)) {
##	$self->warn("1st position($pos1) cannot be < 2nd position($pos2) on reverse strand!)"; return (-1);
    ##  }
    ##}
    $startlabel=$self->label($pos1);
    if ($startlabel < 1) {
      $self->warn("position $pos1 not valid as start of subseq!"); return (-1);
    }
  }
  unless (defined ($pos2)) {
    #print "\n##### pos2 not defined\n";
    unless (defined ($length)) {
      $endlabel=$self->end;
    }
  } else {
    if ($pos2 == 0) {  # if position = 0 complain
      $self->warn("Position cannot be 0!"); return (-1);
    }
    undef $length;
    ##if ($strand == 1) { # CHECK THIS!
      if ((defined ($pos1))&&($pos1>$pos2)) {
	$self->warn("1st position($pos1) cannot be > 2nd position($pos2)!"); return (-1);
      }
    ##} else { # CHECK THIS!
    ##  if ((defined ($pos1))&&($pos1<$pos2)) {
##	$self->warn("1st position($pos1) cannot be < 2nd position($pos2) on reverse strand!"); return (-1);
    ##  }
    ##}
    $endlabel=$self->label($pos2);
    if ($endlabel < 1) {
      $self->warn("position $pos2 not valid as end of subseq!"); return (-1);
    }
  }
  #print "\n    ####DEBUG: start $startlabel end $endlabel length $length strand $strand\n";

  if ($strand == 1) {
    $str = $self->{'seq'}->down_chain2string($startlabel,$length,$endlabel);
  } else { # reverse strand
    $str = $self->{'seq'}->up_chain2string($startlabel,$length,$endlabel);
    $str =~ tr/acgtrymkswhbvdnxACGTRYMKSWHBVDNX/tgcayrkmswdvbhnxTGCAYRKMSWDVBHNX/;
  }
  return $str;
}

sub length {
  my $self=shift;
  my ($start,$end,$strand)=($self->start(),$self->end(),$self->strand());
  if ($strand == 1) {
    return $self->{'seq'}->down_subchain_length($start,$end);
  } else {
    return $self->{'seq'}->up_subchain_length($start,$end);
  }
}

sub display_id {
  my ($self,$value) = @_;
  if(defined $value) {
    $self->{'display_id'} = $value;
  }
  return $self->{'display_id'};
}

sub accession_number {
  my ($self,$value) = @_;
  if (defined $value) {
    $self->{'accession_number'} = $value;
  }
  unless (exists $self->{'accession_number'}) {
    return "unknown";
  } else {
    return $self->{'accession_number'};
  }
}

sub primary_id {
  my ($self,$value) = @_;
  if(defined $value) {
    $self->{'primary_id'} = $value;
  }
  unless (exists $self->{'primary_id'}) {
    return "$self";
  } else {
    return $self->{'primary_id'};
  }
}

sub change {
  &positionchange;
}

sub positionchange {
  my ($self,$newseq,$position,$length)=@_;
  unless ($position) {
    $self->warn("Position not given or position 0");
    return (-1);
  }
  my $label=$self->label($position);
  unless ($label > 0) { # label not found or error
    $self->warn("No valid label found at that position!");
    return (-1);
  }
  return ($self->labelchange($newseq,$label,$length));
}

sub labelchange {
  my ($self,$newseq,$label,$length)=@_;
  unless ($self->valid($label)) {
    if ($self->{'seq'}->valid($label)) {
       #$self->warn("Label \'$label\' not valid for executing a LiveSeq change for the object asked but it's ok for DNAlevel change, reverting to that");
      shift @_;
      return($self->{'seq'}->labelchange(@_));
    } else {
      $self->warn("Label \'$label\' not valid for executing a LiveSeq change");
      return (-1);
    }
  }
  unless ($newseq) { # it means this is a simple deletion
    if (defined($length)) {
      unless ($length >= 0) {
	$self->warn("No sense having length < 0 in a deletion");
	return (-1);
      }
    } else {
      $self->warn("Length not defined for deletion!");
      return (-1);
    }
    return $self->_delete($label,$length);
  }
  my $newseqlength=CORE::length($newseq);
  if (defined($length)) {
    unless ($length >= 0) {
      $self->warn("No sense having length < 0 in a change()");
      return (-1);
    }
  } else {
    $length=$newseqlength; # defaults to pointmutation(s)
  }
  if ($length == 0) { # it means this is a simple insertion, length def&==0
    my ($insertbegin,$insertend)=$self->_praeinsert($label,$newseq);
    if ($insertbegin == -1) {
      return (-1);
    } else {
      return (1);
    }
  }
  if ($newseqlength == $length) { # it means this is simple pointmutation(s)
    return $self->_mutate($label,$newseq,$length);
  }
  # if we arrived here then change is complex mixture
  my $strand=$self->strand();
  my $afterendlabel=$self->label($length+1,$label,$strand); # get the label at $length+1 positions after $label
  unless ($afterendlabel > 0) { # label not found or error
    $self->warn("No valid afterendlabel found for executing the complex mutation!");
    return (-1);
  }
  my $deleted=$self->_delete($label,$length); # first delete length nucs
  if ($deleted == -1) { # if errors
    return (-1);
  } else { # then insert the newsequence
    my ($insertbegin,$insertend)=$self->_praeinsert($afterendlabel,$newseq);
    if ($insertbegin == -1) {
      return (-1);
    } else {
      return (1);
    }
  }
}

# internal methods for change()

# arguments: label for beginning of deletion, new sequence to insert
# returns: labels of beginning and end of the inserted sequence
# errorcode: -1
sub _praeinsert {
  my ($self,$label,$newseq)=@_;
  my ($insertbegin,$insertend);
  my $strand=$self->strand();
  if ($strand == 1) {
    ($insertbegin,$insertend)=($self->{'seq'}->praeinsert_string($newseq,$label));
  } else { # since it's reverse strand and we insert in forward direction....
    $newseq=reverse($newseq);
    $newseq =~ tr/acgtrymkswhbvdnxACGTRYMKSWHBVDNX/tgcayrkmswdvbhnxTGCAYRKMSWDVBHNX/; # since it's reverse strand we get the complementary bases
    ($insertend,$insertbegin)=($self->{'seq'}->postinsert_string($newseq,$label));
  }
  if (($insertbegin==0)||($insertend==0)) {
    $self->warn("Some error occurred while inserting!");
    return (-1);
  } else {
    return ($insertbegin,$insertend);
  }
}

# arguments: label for beginning of deletion, length of deletion
# returns: string of deleted bases
# errorcode: -1
sub _delete {
  my ($self,$label,$length)=@_;
  my $strand=$self->strand();
  my $endlabel=$self->label($length,$label,$strand); # get the label at $length positions after $label
  unless ($endlabel > 0) { # label not found or error
    $self->warn("No valid endlabel found for executing the deletion!");
    return (-1);
  }
  # this is important in Transcript to fix exon structure
  $self->_deletecheck($label,$endlabel);
  my $deletedseq;
  if ($strand == 1) {
    $deletedseq=$self->{'seq'}->splice_chain($label,undef,$endlabel);
  } else {
    $deletedseq=$self->{'seq'}->splice_chain($endlabel,undef,$label);
    $deletedseq=reverse($deletedseq); # because we are on reverse strand and we cut anyway
                         # in forward direction
    $deletedseq =~ tr/acgtrymkswhbvdnxACGTRYMKSWHBVDNX/tgcayrkmswdvbhnxTGCAYRKMSWDVBHNX/; # since it's reverse strand we get the complementary bases
  }
  return ($deletedseq);
}

# empty function, overridden in Transcript, not useful here
sub _deletecheck {
}

# arguments: label for beginning of mutation, newsequence, number of mutations
# returns: 1 all OK
# errorcode: -1
sub _mutate {
  my ($self,$label,$newseq,$length)=@_; # length is equal to length(newseq)
  my ($i,$base,$nextlabel);
  my @labels; # array of labels
  my $strand=$self->strand();
  if ($length == 1) { # special cases first
    @labels=($label);
  } else {
    my $endlabel=$self->label($length,$label,$strand); # get the label at $length positions after $label
    unless ($endlabel > 0) { # label not found or error
      $self->warn("No valid endlabel found for executing the mutation!");
      return (-1);
    }
    if ($length == 2) { # another special case
      @labels=($label,$endlabel);
    } else { # more than 3 bases changed
      # this wouldn't work for Transcript
      #my $labelsarrayref;
      #if ($strand == 1) {
	#$labelsarrayref=$self->{'seq'}->down_labels($label,$endlabel);
      #} else {
	#$labelsarrayref=$self->{'seq'}->up_labels($label,$endlabel);
      #}
      #@labels=@{$labelsarrayref};
      #if ($length != scalar(@labels)) { # not enough labels returned
	#$self->warn("Not enough valid labels found for executing the mutation!");
	#return (-1);
      #}

      # this should be more general
      @labels=($label); # put the first one
      while ($label != $endlabel) {
	$nextlabel=$self->label(2,$label,$strand); # retrieve the next label
	push (@labels,$nextlabel);
	$label=$nextlabel; # move on reference
      }
    }
  }
  if ($strand == -1) { # only for reverse strand
    $newseq =~ tr/acgtrymkswhbvdnxACGTRYMKSWHBVDNX/tgcayrkmswdvbhnxTGCAYRKMSWDVBHNX/; # since it's reverse strand we get the complementary bases
  }
  my $errorcheck; # if not equal to $length after summing for all changes, error did occurr
  $i = 0;
  foreach $base (split(//,$newseq)) {
    $errorcheck += $self->{'seq'}->set_value_at_label($base,$labels[$i]);
    $i++;
  }
  if ($errorcheck != $length) {
    $self->warn("Some error occurred while mutating!");
    return (-1);
  } else {
    return (1);
  }
}

# argument: label
# returns: 1 YES 0 NO
sub valid {
  my ($self,$label)=@_;
  my $checkme;
  my @labels=$self->all_labels;
  foreach $checkme (@labels) {
    if ($label == $checkme) {
      return (1); # found
    }
  }
  return (0); # not found
}

sub start {
  my ($self) = @_;
  return $self->{'start'}; # common for all classes BUT DNA (which redefines it) and Transcript (that takes the information from the Exons)
}

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

sub strand {
  my ($self,$strand) = @_;
  if ($strand) {
    if (($strand != 1)&&($strand != -1)) {
      $self->warn("strand information not changed because strand identifier not valid");
    } else {
      $self->{'strand'} = $strand;
    }
  }
  return $self->{'strand'};
}

sub alphabet {
  my %valid_type = map {$_, 1} qw( dna rna protein );
  my ($self,$value) = @_;
  if (defined $value) {
    $value = 'dna' if $value =~ /dna/i;
    $value = 'rna' if $value =~ /rna/i;
    unless ( $valid_type{$value} ) {
      $self->warn("Molecular type '$value' is not a valid type");
    }
    $self->{'alphabet'} = $value;
  }
  return $self->{'alphabet'};
}

sub coordinate_start {
  my ($self,$label) = @_;
  if ($label) {
    if ($self->valid($label)) {
      $self->{'coordinate_start'} = $label;
    } else {
      $self->warn("The label you are trying to set as coordinate_start is not valid for this object");
    }
  }
  my $coord_start = $self->{'coordinate_start'};
  if ($coord_start) {
    return $coord_start;
  } else {
    return $self->start();
  }
}

sub label {
  my ($self,$position,$firstlabel,$strand)=@_;
  my $label;
  unless (defined ($firstlabel)) {
    $firstlabel=$self->coordinate_start;
  }
  unless ($position) {  # if position = 0 complain ?
    $self->warn("Position not given or position 0");
    return (-1);
  }
  unless (defined ($strand)) { # if optional [strand] argument not given
    $strand=$self->strand;
  }
  if ($strand == 1) {
    if ($position > 0) {
      $label=$self->{'seq'}->down_get_label_at_pos($position,$firstlabel)
    } else { # if < 0
      $label=$self->{'seq'}->up_get_label_at_pos(1 - $position,$firstlabel)
    }
  } else {
    if ($position > 0) {
      $label=$self->{'seq'}->up_get_label_at_pos($position,$firstlabel)
    } else { # if < 0
      $label=$self->{'seq'}->down_get_label_at_pos(1 - $position,$firstlabel)
    }
  }
  return $label;
}

sub position {
  my ($self,$label,$firstlabel,$strand)=@_;
  unless (defined ($strand)) { # if optional [strand] argument not given
    $strand=$self->strand;
  }
  unless (defined ($firstlabel)) {
    $firstlabel=$self->coordinate_start;
  }
  unless ($self->valid($label)) {
    $self->warn("label not valid");
    return (0);
  }
  if ($firstlabel == $label) {
    return (1);
  }
  my ($coordpos,$position0,$position);
  $position0=$self->{'seq'}->down_get_pos_of_label($label);
  $coordpos=$self->{'seq'}->down_get_pos_of_label($firstlabel);
  $position=$position0-$coordpos+1;
  if ($position <= 0) {
    $position--;
  }
  if ($strand == -1) {
    #print "\n----------DEBUGSEQPOS label $label firstlabel $firstlabel strand $strand: position=",1-$position;
    return (1-$position);
  } else {
    #print "\n----------DEBUGSEQPOS label $label firstlabel $firstlabel strand $strand: position=",$position;
    return ($position);
  }
}

#'
# wraparound to is_downstream and is_upstream that chooses the correct one
# depending on the strand
sub follows {
  my ($self,$firstlabel,$secondlabel,$strand)=@_;
  unless (defined ($strand)) { # if optional [strand] argument not given
    $strand=$self->strand;
  }
  if ($strand == 1) {
    return ($self->{'seq'}->is_downstream($firstlabel,$secondlabel));
  } else {
    return ($self->{'seq'}->is_upstream($firstlabel,$secondlabel));
  }
}
#
#=head2 translate
#
# Title   : translate
# Usage   : $protein_seq = $obj->translate
# Function: Provides the translation of the DNA sequence
#	    using full IUPAC ambiguities in DNA/RNA and amino acid codes.
#
#	    The resulting translation is identical to EMBL/TREMBL database
#	    translations.
#
# Returns : a string
# Args    : character for terminator (optional) defaults to '*'
#	    character for unknown amino acid (optional) defaults to 'X'
#	    frame (optional) valid values 0, 1, 3, defaults to 0
#	    codon table id (optional) defaults to 1
#
#=cut
#
#sub translate {
#  my ($self) = shift;
#  return ($self->translate_string($self->seq,@_));
#}
#
#=head2 translate_string
#
# Title   : translate_string
# Usage   : $protein_seq = $obj->translate_string("attcgtgttgatcgatta");
# Function: Like translate, but can be used to translate subsequences after
#	    having retrieved them as string.
# Args    : 1st argument is a string. Optional following arguments: like in
#	    the translate method
#
#=cut
#
#
#sub translate_string {
#  my($self) = shift;
#  my($seq) = shift;
#  my($stop, $unknown, $frame, $tableid) = @_;
#  my($i, $len, $output) = (0,0,'');
#  my($codon)   = "";
#  my $aa;
#
#
#  ## User can pass in symbol for stop and unknown codons
#  unless(defined($stop) and $stop ne '')    { $stop = "*"; }
#  unless(defined($unknown) and $unknown ne '') { $unknown = "X"; }
#  unless(defined($frame) and $frame ne '') { $frame = 0; }
#
#  ## the codon table ID
#  if ($self->translation_table) {
#    $tableid = $self->translation_table;
#  }
#  unless(defined($tableid) and $tableid ne '')    { $tableid = 1; }
#
#  ##Error if monomer is "Amino"
#  $self->warn("Can't translate an amino acid sequence.")
#      if (defined $self->alphabet && $self->alphabet eq 'protein');
#
#  ##Error if frame is not 0, 1 or 2
#  $self->warn("Valid values for frame are 0, 1, 2, not [$frame].")
#      unless ($frame == 0 or $frame == 1 or $frame == 2);
#
#  #thows a warning if ID is invalid
#  my $codonTable = Bio::Tools::CodonTable->new( -id => $tableid);
#
#  # deal with frame offset.
#  if( $frame ) {
#      $seq = substr ($seq,$frame);
#  }
#
#  for $codon ( grep { CORE::length == 3 } split(/(.{3})/, $seq) ) {
#      my $aa = $codonTable->translate($codon);
#      if ($aa eq '*') {
#	    $output .= $stop;
#      }
#      elsif ($aa eq 'X') {
#	    $output .= $unknown;
#      }
#      else {
#	   $output .= $aa ;
#      }
#  }
#  #if( substr($output,-1,1) eq $stop ) {
#  #    chop $output;
#  #}
#
#  return ($output);
#}

sub gene {
  my ($self,$value) = @_;
  if (defined $value) {
    $self->{'gene'} = $value;
  }
  unless (exists $self->{'gene'}) {
    return (0);
  } else {
    return $self->{'gene'};
  }
}

sub obj_valid {
  my $self=shift;
  unless (($self->{'seq'}->valid($self->start()))&&($self->{'seq'}->valid($self->end()))) {
    return (0);
  }
  return (1);
}

sub name {
  my ($self,$value) = @_;
  if (defined $value) {
    $self->{'name'} = $value;
  }
  unless (exists $self->{'name'}) {
    return "unknown";
  } else {
    return $self->{'name'};
  }
}

sub desc {
  my ($self,$value) = @_;
  if (defined $value) {
    $self->{'desc'} = $value;
  }
  unless (exists $self->{'desc'}) {
    return "unknown";
  } else {
    return $self->{'desc'};
  }
}

sub source {
  my ($self,$value) = @_;
  if (defined $value) {
    $self->{'source'} = $value;
  }
  unless (exists $self->{'source'}) {
    return "unknown";
  } else {
    return $self->{'source'};
  }
}

sub delete_Obj {
  my $self = shift;
  my @values= values %{$self};
  my @keys= keys %{$self};

  foreach my $key ( @keys ) {
    delete $self->{$key};
  }
  foreach my $value ( @values ) {
    if (index(ref($value),"LiveSeq") != -1) { # object case
      eval {
	# delete $self->{$value};
	$value->delete_Obj;
      };
    } elsif (index(ref($value),"ARRAY") != -1) { # array case
      my @array=@{$value};
      my $element;
      foreach $element (@array) {
	eval {
	  $element->delete_Obj;
	};
      }
    } elsif (index(ref($value),"HASH") != -1) { # object case
      my %hash=%{$value};
      my $element;
      foreach $element (%hash) {
	eval {
	  $element->delete_Obj;
	};
      }
    }
  }
  return(1);
}

1;