diff variant_effect_predictor/Bio/Cluster/SequenceFamily.pm @ 0:2bc9b66ada89 draft default tip

Uploaded

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/variant_effect_predictor/Bio/Cluster/SequenceFamily.pm	Thu Apr 11 06:29:17 2013 -0400
@@ -0,0 +1,445 @@
+# $Id: SequenceFamily.pm,v 1.4 2002/12/01 00:34:58 jason Exp $
+#
+# BioPerl module for Bio::Cluster::SequenceFamily
+#
+# Cared for by Shawn Hoon <[e-mail]>
+#
+# Copyright Shawn Hoon
+#
+# You may distribute this module under the same terms as perl itself
+
+# POD documentation - main docs before the code
+
+=head1 NAME
+
+Bio::Cluster::SequenceFamily - Sequence Family object 
+
+=head1 SYNOPSIS
+
+  use Bio::Cluster::SequenceFamily
+
+  use Bio::SeqIO;
+  use Bio::Cluster::SequenceFamily;
+
+  my $file =  Bio::Root::IO->catfile('t','data','swiss.dat');
+  my $seqio= new Bio::SeqIO('-format' => 'swiss',
+                          '-file'   => $file);
+  my @mem;
+  while(my $seq = $seqio->next_seq){
+    push @mem, $seq;
+  }
+
+  #create the family
+  my $family = Bio::Cluster::SequenceFamily->new(-family_id=>"Family_1",
+                                                 -description=>"Family Description Here",
+                                                 -annotation_score=>"100",
+                                               -members=>\@mem);
+
+  #access the family
+
+  foreach my $mem ($family->get_members){
+    print $mem->display_id."\t".$mem->desc."\n";
+  }
+
+  #select members if members have a Bio::Species Object
+
+  my @mem = $family->get_members(-binomial=>"Homo sapiens");
+  @mem = $family->get_members(-ncbi_taxid => 9606);
+  @mem = $family->get_members(-common_name=>"Human");
+  @mem = $family->get_members(-species=>"sapiens");
+  @mem = $family->get_members(-genus=>"Homo");
+
+
+
+=head1 DESCRIPTION
+
+This is a simple Family object that may hold any group of object. For more
+specific families, one should derive from FamilyI.
+
+=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 - Shawn Hoon 
+
+Email [e-mail] 
+
+
+=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::Cluster::SequenceFamily;
+
+use strict;
+use vars qw(@ISA);
+
+
+use Bio::Root::Root;
+use Bio::Cluster::FamilyI;
+
+@ISA = qw(Bio::Root::Root Bio::Cluster::FamilyI);
+
+
+=head2 new
+
+ Title   : new
+ Usage   : my $family = Bio::Cluster::SequenceFamily->new(-family_id=>"Family_1",
+                                       -description=>"Family Description Here",
+                                       -annotation_score=>"100",
+                                       -members=>\@mem);
+ Function: Constructor for SequenceFamily object
+ Returns : L<Bio::Cluster::SequenceFamily> object
+
+=cut
+
+sub new {
+	my ($class,@args) = @_;
+  my $self = $class->SUPER::new(@args);
+  my ($id,$description,$version,$annot_score,
+  $family_score,$members) = $self->_rearrange([qw(FAMILY_ID DESCRIPTION VERSION 
+                                                   ANNOTATION_SCORE 
+                                                   FAMILY_SCORE MEMBERS)],@args);
+  $self->{'_members'} = [];
+  $id && $self->family_id($id);
+  $description && $self->description($description);
+  $version && $self->version($version);
+  $annot_score && $self->annotation_score($annot_score);
+  $family_score && $self->family_score($family_score);
+  $members && $self->add_members($members);
+
+  return $self;
+
+}
+
+=head2 version
+
+ Title   : version
+ Usage   : $family->version("1.0");
+ Function: get/set for version
+ Returns : a string version of the family generated. 
+
+=cut
+
+sub version{
+  my ($self,$value) = @_;
+  if($value){
+    $self->{'_version'} =$value;
+  }
+  return $self->{'_version'};
+}
+
+=head2 annotation_score
+
+ Title   : annotation_score
+ Usage   : $family->annotation_score(100);
+ Function: get/set for annotation_score which
+           represent the confidence in which the 
+           consensus description has been assigned
+           to the family.
+ Returns : L<Bio::SimpleAlign> 
+
+=cut
+
+sub annotation_score{
+  my ($self,$score) = @_;
+  if($score){
+    $self->{'_annotation_score'} = $score;
+  }
+  return $self->{'_annotation_score'};
+}
+
+=head2 alignment
+
+ Title   : alignment
+ Usage   : $family->alignment($align);
+ Function: get/set for an alignment object representing
+           the multiple alignment of the members of the family.
+ Returns : L<Bio::SimpleAlign>
+
+=cut
+
+sub alignment {
+	my ($self,$align) = @_;
+  if($align){
+    $self->{'_alignment'} = $align;
+  }
+    return $self->{'_alignment'};
+}
+
+=head2 tree
+
+ Title   : tree
+ Usage   : $family->tree($tree);
+ Function: get/set for an tree object representing
+           the phylogenetic tree of the family. 
+ Returns : L<Bio::Tree> 
+
+=cut
+
+sub tree {
+  my ($self,$tree) = @_;
+  if($tree) {
+    $self->{'_tree'} = $tree;
+  }
+  return $self->{'_tree'};
+}
+
+=head1 L<Bio::Cluster::FamilyI> methods
+
+=cut
+
+=head2 family_score
+
+ Title   : family_score
+ Usage   : Bio::Cluster::FamilyI->family_score(95);
+ Function: get/set for the score of algorithm used to generate
+           the family if present
+
+           This is aliased to cluster_score().
+
+ Returns : the score
+ Args    : the score
+
+=cut
+
+sub family_score {
+    return shift->cluster_score(@_);
+}
+
+
+=head2 family_id
+
+ Title   : family_id
+ Usage   : $family->family_id("Family_1"); 
+ Function: get/set for family id 
+
+           This is aliased to display_id().
+
+ Returns : a string specifying identifier of the family 
+
+=cut
+
+sub family_id{
+    return shift->display_id(@_);
+}
+
+=head1 L<Bio::ClusterI> methods
+
+=cut
+
+=head2 display_id
+
+ Title   : display_id
+ Usage   : 
+ Function: Get/set the display name or identifier for the cluster
+ Returns : a string
+ Args    : optional, on set the display ID ( a string)
+
+=cut
+
+sub display_id{
+    my ($self,$id) = @_;
+    if($id){
+	$self->{'_cluster_id'} = $id;
+    }
+    return $self->{'_cluster_id'};
+}
+
+=head2 description
+
+ Title   : description
+ Usage   : $fam->description("POLYUBIQUITIN")
+ Function: get/set for the consensus description of the cluster
+ Returns : the description string 
+ Args    : Optional the description string 
+
+=cut
+
+sub description{
+  my ($self,$desc) = @_;
+  if($desc){
+    $self->{'_description'} = $desc;
+  }
+  return $self->{'_description'};
+}
+
+=head2 get_members
+
+ Title   : get_members
+ Usage   : Valid criteria:
+           -common_name
+           -binomial
+           -ncbi_taxid
+           -organelle
+           -genus
+           $family->get_members(-common_name =>"human");
+           $family->get_members(-species     =>"homo sapiens");
+           $family->get_members(-ncbi_taxid  => 9606);
+           For now, multiple critieria are ORed.
+
+           Will return all members if no criteria are provided.
+
+ Function: get members using methods from L<Bio::Species>
+           the phylogenetic tree of the family.
+ Returns : an array of objects that are member of this family. 
+
+=cut
+
+sub get_members {
+    my $self = shift;
+    my @ret;
+    
+    if(@_) {
+	my %hash = @_;
+	foreach my $mem ( @{$self->{'_members'}} ) {
+	    foreach my $key ( keys %hash){
+		my $method = $key;
+		$method=~s/-//g;
+		if($mem->can('species')){
+		    my $species = $mem->species;
+		    $species->can($method) ||
+			$self->throw("$method is an invalid criteria");
+		    if($species->$method() eq $hash{$key} ){
+			push @ret, $mem;
+		    }
+		}
+	    }
+	}
+	return @ret;
+    }
+    return @{$self->{'_members'}};    
+}
+
+=head2 size
+
+ Title   : size
+ Usage   : $fam->size();
+ Function: get/set for the size of the family, 
+           calculated from the number of members
+ Returns : the size of the family 
+ Args    : 
+
+=cut
+
+sub size {
+  my ($self) = @_;
+
+  return scalar(@{$self->{'_members'}});
+
+}
+
+=head2 cluster_score
+
+ Title   : cluster_score
+ Usage   : $fam->cluster_score(100);
+ Function: get/set for cluster_score which
+           represent the score in which the clustering
+           algorithm assigns to this cluster.
+ Returns : a number
+
+=cut
+
+sub cluster_score{
+  my ($self,$score) = @_;
+  if($score){
+    $self->{'_cluster_score'} = $score;
+  }
+  return $self->{'_cluster_score'};
+}
+
+
+=head1 Implementation specific methods
+
+  These are mostly for adding/removing/changing.
+
+=cut
+
+=head2 add_members
+
+ Title   : add_members
+ Usage   : $fam->add_member([$seq1,$seq1]);
+ Function: add members to a family
+ Returns : 
+ Args    : the member(s) to add, as an array or arrayref
+
+=cut
+
+sub add_members{
+    my ($self,@mems) = @_;
+
+    my $mem = shift(@mems);
+    if(ref($mem) eq "ARRAY"){
+	push @{$self->{'_members'}},@{$mem};
+    } else {
+	push @{$self->{'_members'}},$mem;
+    }
+    push @{$self->{'_members'}}, @mems;
+
+    return 1;
+}
+
+=head2 remove_members
+
+ Title   : remove_members
+ Usage   : $fam->remove_members();
+ Function: remove all members from a family 
+ Returns : the previous array of members
+ Args    : none
+
+=cut
+
+sub remove_members{
+    my ($self) =  @_;
+    my $mems = $self->{'_members'};
+    $self->{'_members'} = [];
+    return @$mems;
+}
+
+#####################################################################
+# aliases for naming consistency or other reasons                   #
+#####################################################################
+
+*flush_members = \&remove_members;
+*add_member = \&add_members;
+
+sub members{
+    my $self = shift;
+    if(@_) {
+	# this is in set mode
+	$self->warn("setting members() in ".ref($self)." is deprecated.\n".
+		    "Use add_members() instead.");
+	return $self->add_members(@_);
+    } else {
+	# get mode
+	$self->warn("members() in ".ref($self)." is deprecated.\n".
+		    "Use get_members() instead.");
+	return $self->get_members();
+    }
+}
+
+1;