libgo-perl 0.15-1 / usr / share / perl5 / GO / Model / GeneProduct.pm

# $Id: GeneProduct.pm,v 1.11 2007/09/13 12:44:47 girlwithglasses Exp $
#
# This GO module is maintained by Chris Mungall <cjm@fruitfly.org>
#
# see also - http://www.geneontology.org
#          - http://www.godatabase.org/dev
#
# You may distribute this module under the same terms as perl itself

package GO::Model::GeneProduct;

=head1 NAME

  GO::Model::GeneProduct - gene product in a particular species

=head1 DESCRIPTION

represents a gene product in a particular species (this will
effectively always be refered to implicitly by the gene symbol even
though a gene may have >1 product)

=cut


use Carp;
use Exporter;
use GO::Utils qw(rearrange);
use GO::Model::Root;
use strict;
use vars qw(@ISA);
use Data::Dumper;

@ISA = qw(GO::Model::Root Exporter);

sub _valid_params {
    return qw(id acc symbol properties full_name type_id type xref speciesdb synonym_list seq_list species);
}

sub _initialize 
{
    my $self = shift;
    my $paramh = shift;

    my $db;
    if ($paramh->{speciesdb}) {
	$db = $paramh->{speciesdb};
    }
    else {
	$db = $paramh->{xref_dbname};
    }

    my $xref = 
      GO::Model::Xref->new({xref_key=>$paramh->{acc},
			    xref_keytype=>"acc",
                            xref_dbname=>$db});

    $self->xref($xref);
    delete $paramh->{acc};
    delete $paramh->{speciesdb};

    $self->SUPER::_initialize($paramh);
}

=head2 acc

  Usage   -
  Returns -
  Args    -

=cut

sub acc {
    my $self = shift;
    my $acc = shift;
    if ($acc) {
	$self->xref->xref_key($acc);
    }
    return $self->xref->xref_key;
}


=head2 symbol

  Usage   -
  Returns -
  Args    -

=cut

# AUTOGENERATED

=head2 type

  Usage   -
  Returns -
  Args    -

=cut

# AUTOGENERATED

=head2 full_name

  Usage   -
  Returns -
  Args    -

=cut

# AUTOGENERATED

=head2 as_str

  Usage   -
  Returns -
  Args    -

=cut

sub as_str {
    my $self = shift;
    return "GP-".$self->xref->as_str;
}

=head2 add_synonym

=cut

sub add_synonym {
    my $self = shift;
    if (!$self->{synonym_list}) {
	$self->{synonym_list} = [];
    }
    push(@{$self->{synonym_list}}, (shift));
    return $self->{synonym_list};
}


=head2 synonym_list

accessor: gets/set list of synonyms [array reference]

=cut

# AUTOGENERATED

=head2 speciesdb

  Usage   -
  Returns -
  Args    -

=cut

sub speciesdb {
    my $self = shift;
    my $db = shift;
    if ($db) {
	$self->xref->xref_dbname ($db);
    }
    return $self->xref->xref_dbname;
}


=head2 add_seq

  Usage   -
  Returns -
  Args    - GO::Model::Seq

=cut

sub add_seq {
    my $self = shift;
    my $seq = shift;
    
    if ($seq->isa("Bio::SeqI")) {
        my $bpseq = $seq;
        $seq = GO::Model::Seq->new;
        $seq->pseq($bpseq);
    }
    $seq->isa("GO::Model::Seq") or confess ("Not a seq object");
    $self->{seq_list} = [] unless $self->{seq_list};

    push(@{$self->{seq_list}}, $seq);
    $self->{seq_list};
}

#indicate fetching seqs has been done: no need to try even if no seq (see seq_list)
sub _seqs_obtained {
    my $self = shift;
    $self->{_seqs_obtained} = shift if @_;
    return $self->{_seqs_obtained};
}

=head2 seq_list

  Usage   -
  Returns - GO::Model::Seq listref
  Args    -

=cut

sub seq_list {
    my $self = shift;
    if (@_) {
        $self->{seq_list} = shift;
    }
    else {
        if (!defined($self->{seq_list})) {
            $self->{seq_list} =
              $self->apph->get_seqs({product=>$self}) unless ($self->_seqs_obtained);
        }
    }
    return $self->{seq_list};
}


=head2 seq

  Usage   -
  Returns - GO::Model::Seq
  Args    -

returns representative sequence object for this product

=cut

sub seq {
    my $self = shift;
    my $seqs = $self->seq_list;
    my $str = "";
    # longest by default
    my $longest;
    
    foreach my $seq (@$seqs) {
        if (!defined($longest) || $seq->length > $longest->length) {
            $longest = $seq;
        }
    }
    return $longest;
}

=head2 properties

  Usage   -
  Returns - hashref
  Args    - hashref

=cut


=head2 set_property

  Usage   - $sf->set_property("wibble", "on");
  Returns -
  Args    - property key, property scalar

note: the property is assumed to be multivalued, therefore
  $sf->set_property($k, $scalar) will add to the array, and
  $sf->set_property($k, $arrayref) will set the array

=cut

sub set_property {
    my $self = shift;
    my $p = shift;
    my $v = shift;
    if (!$self->properties) {
        $self->properties({});
    }
    if (ref($v) eq 'ARRAY') {
        confess("@$v is not all scalar") if grep {ref($_)} @$v;
        $self->properties->{$p} = $v;
    }
    else {
        push(@{$self->properties->{$p}}, $v);
    }
    # uniqify
    my @vals = @{$self->properties->{$p}};
    my %h = ();
    my @nu_vals = ();
    foreach (@vals) {
        next if $h{$_};
        $h{$_} = 1;
        push(@nu_vals, $_);
    }
    $self->properties->{$p} = \@nu_vals;
    $v;
}

=head2 get_property

  Usage   -
  Returns - first element of the property
  Args    - property key

=cut

sub get_property {
    my $self = shift;
    my $p = shift;
    if (!$self->properties) {
        $self->properties({});
    }
    my $val = $self->properties->{$p};
    if ($val) {
        $val = $val->[0];
    }
    return $val;
}

=head2 get_property_list

  Usage   -
  Returns - the property arrayref
  Args    - property key

=cut

sub get_property_list {
    my $self = shift;
    my $p = shift;
    if (!$self->properties) {
        $self->properties({});
    }
    $self->properties->{$p};
}


=head2 to_fasta

  Usage   -
  Returns -
  Args    -

returns the longest seq by default

=cut

sub to_fasta {
    my $self = shift;
    my ($fullhdr, $hdrinfo, $gethdr) = 
      rearrange([qw(fullheader headerinfo getheader)], @_);
    $hdrinfo = " " . ($hdrinfo || "");
    my $seqs = $self->seq_list;
    my $str = "";
    # longest by default
    my $longest;
    
    return "" unless @{$seqs || []};

    foreach my $seq (@$seqs) {
        if (!defined($longest) || $seq->length > $longest->length) {
            $longest = $seq;
        } 
    }
    $seqs = [$longest];
    if ($gethdr) {
      my $apph = $self->get_apph;
      my $terms = $apph->get_terms({product=>$self});
      my @h_elts = ();
      foreach my $term (@$terms) {
	my $al = $term->selected_association_list;
	my %codes = ();
	map { $codes{$_->code} = 1 } map { @{$_->evidence_list} } @$al;
	push(@h_elts,
	     sprintf("%s evidence=%s",
		     $term->public_acc,
		     join(";", keys %codes),
		    )
	    );
      }
      $hdrinfo = join(", ", @h_elts);
    }
    foreach my $seq (@$seqs) {
        my $desc;
        if ($fullhdr) {
            $desc = $fullhdr;
        }
        else {
            $desc =
              sprintf("%s|%s symbol:%s %s %s %s",
                      uc($self->xref->xref_dbname),
                      $self->xref->xref_key,
                      $self->symbol,
                      $self->species ? sprintf("species:%s \"%s\"", $self->species->ncbi_taxa_id, $self->species->binomial) : '-',                      
                      $hdrinfo,
                      join(" ",
                           map {$_->as_str} @{$seq->xref_list || []})
                     );
        }
        $seq->description($desc);
        $str.= $seq->to_fasta;
    }
    return $str;
}

sub to_idl_struct {
    my $self = shift;
    return 
      {
	  "symbol"=>$self->symbol,
	  "full_name"=>$self->full_name,
	  "acc"=>$self->xref->xref_key,
	  "speciesdb"=>$self->xref->xref_dbname,
      };
}

sub to_ptuples {
    my $self = shift;
    my ($th) =
      rearrange([qw(tuples)], @_);
    my @s = ();
    push(@s,
         ["product",
          $self->xref->as_str,
          $self->symbol,
          $self->full_name,
          ]);
    push(@s, $self->xref->to_ptuples(-tuples=>$th));
    @s;
}

# **** EXPERIMENTAL CODE ****
# the idea is to be homogeneous and use graphs for
# everything; eg gene products are nodes in a graph,
# associations are arcs
# cf rdf, daml+oil etc

# args - optional graph to add to
sub graphify {
    my $self = shift;
    my ($ref, $subg, $opts) =
      rearrange([qw(ref graph opts)], @_);

    $opts = {} unless $opts;
    $subg = $self->apph->create_graph_obj unless $subg;

    my $t =
      $self->apph->create_term_obj({name=>$self->as_str,
                                    acc=>$self->as_str});
    $subg->add_node($t);
    $subg->add_arc($t, $ref, "hasProduct");
    return $subg;
}

1;