Summary

Bio::PopGen::Individual - An implementation of an Individual who has
Genotype or Sequence Results

Package variables

Inherit

Bio::PopGen::IndividualI Bio::Root::Root

Synopsis

  use Bio::PopGen::Individual;

  my $ind = new Bio::PopGen::Individual(-unique_id => $id,
                                        -genotypes => \@genotypes);

Description

This object is a container for genotypes.

Methods

Methods description

 Title   : new
 Usage   : my $obj = new Bio::PopGen::Individual();
 Function: Builds a new Bio::PopGen::Individual object 
 Returns : an instance of Bio::PopGen::Individual
 Args    : -unique_id => $id,
           -genotypes => \@genotypes

 Title   : unique_id
 Usage   : my $id = $individual->unique_id
 Function: Unique Identifier
 Returns : string representing unique identifier
 Args    : string

 Title   : num_of_results
 Usage   : my $count = $person->num_results;
 Function: returns the count of the number of Results for a person
 Returns : integer
 Args    : none

 Title   : add_Genotype
 Usage   : $individual->add_Genotype
 Function: add a genotype value
 Returns : count of the number of genotypes associated with this individual
 Args    : @genotypes - Bio::PopGen::GenotypeI object(s) containing 
                        alleles plus a marker name

 Title   : reset_Genotypes
 Usage   : $individual->reset_Genotypes;
 Function: Reset the genotypes stored for this individual
 Returns : none
 Args    : none

 Title   : remove_Genotype
 Usage   : $individual->remove_Genotype(@names)
 Function: Removes the genotypes for the requested markers
 Returns : none
 Args    : Names of markers

 Title   : get_Genotypes
 Usage   : my @genotypes = $ind->get_Genotypes(-marker => $markername);
 Function: Get the genotypes for an individual, based on a criteria
 Returns : Array of genotypes
 Args    : either none (return all genotypes) or 
           -marker => name of marker to return (exact match, case matters)

 Title   : has_Marker
 Usage   : if( $ind->has_Marker($name) ) {}
 Function: Boolean test to see if an Individual has a genotype 
           for a specific marker
 Returns : Boolean (true or false)
 Args    : String representing a marker name

 Title   : get_marker_names
 Usage   : my @names = $individual->get_marker_names;
 Function: Returns the list of known marker names
 Returns : List of strings
 Args    : none

Methods code

BEGIN {

 $UIDCOUNTER = 1

}

sub new {

  my($class,@args) = @_;

  my $self = $class->SUPER::new(@args);
  $self->{'_genotypes'} = {};
  my ($uid,$genotypes) = $self->_rearrange([qw(UNIQUE_ID
					       GENOTYPES)],@args);
  unless( defined $uid ) {
      $uid = $UIDCOUNTER++;
  } 
  $self->unique_id($uid);
  if( defined $genotypes ) {
      if( ref($genotypes) =~ /array/i ) {
	  $self->add_Genotype(@$genotypes);
      } else { 
	  $self->warn("Must provide a valid array reference to set the genotypes value in the contructor");
      }
  }
  return $self;

}

sub unique_id {

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

}

sub num_of_results {

    return scalar keys %{shift->{'_genotypes'}};

}

sub add_Genotype {

   my ($self,@genotypes) = @_;
   
   foreach my $g ( @genotypes ) {
       if( !ref($g) || ! $g->isa('Bio::PopGen::GenotypeI') ) {
	   $self->warn("cannot add $g as a genotype skipping");
	   next;
       }
       my $mname = $g->marker_name;
       if( ! defined $mname || ! length($mname) ) { 
         # can't just say ! name b/c '0' wouldn't be valid 
	   $self->warn("cannot add genotype because marker name is not defined or is an empty string");
	   next;
       }
       if( $self->verbose > 0 && 
	   defined $self->{'_genotypes'}->{$mname} ) {
	   # a warning when we have verbosity cranked up 
	   $self->debug("Overwriting the previous value for $mname for this individual");
       }
       # this will force Genotype individual_id to be set to 
       # the Individual it has been added for
       $g->individual_id($self->unique_id);
       $self->{'_genotypes'}->{$mname} = $g;
   }
   return scalar keys %{$self->{'_genotypes'}};

}

sub reset_Genotypes {

    shift->{'_genotypes'} = {};

}

sub remove_Genotype {

   my ($self,@mkrs) = @_;
   foreach my $m ( @mkrs ) {
       delete($self->{'_genotypes'}->{$m});
   }

}

sub get_Genotypes {

   my ($self,@args) = @_;
   if( @args ) {
       unshift @args, '-marker' if( @args == 1 );  # deal with single args
       
       my ($name) = $self->_rearrange([qw(MARKER)], @args);
       if( ! $name ) {
	   $self->warn("Only know how to process the -marker field currently");
	   return();
       }
       my $v = $self->{'_genotypes'}->{$name};
       return $v;
   }
   return values %{$self->{'_genotypes'} || {}};

}

sub has_Marker {

   my ($self,$name) = @_;
   return 0 if ! defined $name;

   $name = $name->name if ref($name) && $name->isa('Bio::PopGen::MarkerI');
   if( ref($name) ) { 
       $self->warn("Passed in a ".ref($name). " to has_Marker, expecting either a string or a Bio::PopGen::MarkerI");
       return 0;
   }
   return defined $self->{'_genotypes'}->{$name};

}

sub get_marker_names {

   my ($self) = @_;
   return keys %{$self->{'_genotypes'}};

}

General documentation

User feedback is an integral part of the evolution of this and other
Bioperl modules. Send your comments and suggestions preferably to
the Bioperl mailing list. Your participation is much appreciated.

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

Report bugs to the Bioperl bug tracking system to help us keep track
of the bugs and their resolution. Bug reports can be submitted via
the web:

  http://bugzilla.open-bio.org/

Email jason-at-bioperl.org

Matthew Hahn, matthew.hahn-at-duke.edu

The rest of the documentation details each of the object methods.
Internal methods are usually preceded with a _