Raw content of Bio::EnsEMBL::Variation::Individual
# Ensembl module for Bio::EnsEMBL::Variation::Individual
#
# Copyright (c) 2004 Ensembl
#
=head1 NAME
Bio::EnsEMBL::Variation::Individual - A single member of a population.
=head1 SYNOPSIS
$individual = Bio::EnsEMBL::Variation::Individual->new
(-name => 'WI530.07',
-description => 'african',
-gender => 'Male',
-father_individual => $father_ind,
-mother_individual => $mother_ind);
...
print $individual->name(), ' - ', $individual->description(), "\n";
print "Gender: ", $individual->gender(), "\n";
print $individual->mother_Individual->name()
if($individual->mother_Individual());
print $individual->father_Individual->name()
if($individual->father_Individual());
=head1 DESCRIPTION
This is a class representing a single individual. An individual may be part
of one population or several. A pedigree may be constructed using the father_Individual
and mother_Individual attributes.
=head1 CONTACT
Post questions to the Ensembl development list: ensembl-dev@ebi.ac.uk
=head1 METHODS
=cut
use strict;
use warnings;
package Bio::EnsEMBL::Variation::Individual;
use Bio::EnsEMBL::Utils::Exception qw(throw warning);
use Bio::EnsEMBL::Utils::Argument qw(rearrange);
use Bio::EnsEMBL::Variation::Sample;
our @ISA = ('Bio::EnsEMBL::Variation::Sample');
=head2 new
Arg [-dbID] :
int - unique internal identifier
Arg [-ADAPTOR] :
Bio::EnsEMBL::Variation::DBSQL::IndividualAdaptor
Arg [-NAME] :
string - name of this individual
Arg [-DESCRIPTION] :
string description - description of this individual
Arg [-GENDER] :
string - must be one of 'Male', 'Female', 'Unknown'
Arg [-FATHER_INDIVIDUAL] :
Bio::EnsEMBL::Variation::Individual - the father of this individual
Arg [-MOTHER_INDIVIDUAL] :
Bio::EnsEMBL::Variation::Individual - the mother of this individual
Arg [-MOTHER_INDIVIDUAL_SAMPLE_ID] :
int - set the internal id of the mother individual so that the actual
mother Individual object can be retrieved on demand.
Arg [-FATHER_INDIVIDUAL_SAMPLE_ID]:
int - set the internal id of the mother individual so that the actual
mother Individual object can be retrieved on demand.
Arg [-TYPE_INDIVIDUAL]:
int - name for the type of the individual (fully or partly inbred, outbred or mutant
Arg [-TYPE_DESCRIPTION]:
string - description of the type of individual
Example : $individual = Bio::EnsEMBL::Variation::Individual->new
(-name => 'WI530.07',
-description => 'african',
-gender => 'Male',
-father_individual => $father_ind,
-mother_individual => $mother_ind,
-type_individual => 'outbred',
-type_description => 'a single organism which breeds freely');
Description: Constructor Instantiates an Individual object.
Returntype : Bio::EnsEMBL::Variation::Individual
Exceptions : throw if gender arg is provided but not valid
Caller : general
Status : At Risk
=cut
sub new {
my $caller = shift;
my $class = ref($caller) || $caller;
my ($dbID, $adaptor, $name, $desc, $display_flag, $gender, $father, $mother, $type_name, $type_desc,
$father_id, $mother_id) =
rearrange([qw(dbID adaptor name description display gender
father_individual mother_individual
type_individual type_description
father_individual_sample_id mother_individual_sample_id)], @_);
if(defined($gender)) {
$gender = ucfirst(lc($gender));
if($gender ne 'Male' && $gender ne 'Female' && $gender ne 'Unknown') {
throw('Gender must be one of "Male","Female","Unknown"');
}
}
if (defined($type_name)){
$type_name = ucfirst(lc($type_name));
if ($type_name ne 'Fully_inbred' && $type_name ne 'Partly_inbred' && $type_name ne 'Outbred' && $type_name ne 'Mutant'){
throw('Type of individual must of one of: "fully_inbred", "partly_inbred", "outbred", "mutant"');
}
}
return bless {'dbID' => $dbID,
'adaptor' => $adaptor,
'name' => $name,
'description' => $desc,
'display' => $display_flag,
'gender' => $gender,
'father_individual' => $father,
'mother_individual' => $mother,
'type_individual' => $type_name,
'type_description' => $type_desc,
'_mother_individual_sample_id' => $mother_id,
'_father_individual_sample_id' => $father_id}, $class;
}
=head2 type_individual
Arg [1] : int $newval (optional)
The new value to set the type_individual attribute to
Example : $type_individual = $obj->type_individual();
Description : Getter/Setter for the type_individual attribute
Returntype : int
Exceptions : none
Caller : general
Status : At Risk
=cut
sub type_individual{
my $self = shift;
if (@_){
my $new_name = shift;
return $self->{'type_individual'} = $new_name;
}
return $self->{'type_individual'};
}
=head2 type_description
Arg [1] : int $newval (optional)
The new value to set the type_description attribute to
Example : $type_description = $obj->type_description();
Description : Getter/Setter for the type_description attribute
Returntype : int
Exceptions : none
Caller : general
Status : At Risk
=cut
sub type_description{
my $self = shift;
if (@_){
my $new_desc = shift;
return $self->{'type_description'} = $new_desc;
}
return $self->{'type_description'};
}
=head2 gender
Arg [1] : string $newval (optional)
The new value to set the gender attribute to
Example : $gender = $obj->gender()
Description: Getter/Setter for the gender attribute
Returntype : string
Exceptions : none
Caller : general
Status : At Risk
=cut
sub gender{
my $self = shift;
if(@_) {
my $gender = ucfirst(lc(shift));
if($gender ne 'Male' && $gender ne 'Female' && $gender ne 'Unknown') {
throw('Gender must be one of "Male","Female","Unknown"');
}
$self->{'gender'} = $gender;
}
return $self->{'gender'};
}
=head2 display
Arg [1] : string $newval (optional)
The new value to set the display attribute to
Example : $display = $obj->display()
Description: Getter/Setter for the display attribute
Returntype : string
Exceptions : none
Caller : general
Status : At Risk
=cut
sub display{
my $self = shift;
if(@_) {
my $display = uc(shift);
if($display ne 'UNDISPLAYABLE' && $display ne 'REFERENCE' && $display ne 'DISPLAYABLE' && $display ne 'DEFAULT') {
throw('Display flag must be one of "REFERENCE", "DEFAULT", "DISPLAYABLE", "UNDISPLAYABLE"');
}
$self->{'display'} = $display;
}
return $self->{'display'};
}
=head2 get_all_Populations
Args : none
Example : $pops = $ind->get_all_Populations();
Description : Getter for the Populations for this Individual. Returns
empty list if there are none.
ReturnType : listref of Bio::EnsEMBL::Population
Exceptions : none
Caller : general
Status : At Risk
=cut
sub get_all_Populations{
my $self = shift;
if (defined ($self->{'adaptor'})){
my $pop_adaptor = $self->{'adaptor'}->db()->get_PopulationAdaptor();
return $pop_adaptor->fetch_all_by_Individual($self);
}
return [];
}
=head2 father_Individual
Arg [1] : string $newval (optional)
The new value to set the father_Individual attribute to
Example : $father_Individual = $obj->father_Individual()
Description: Getter/Setter for the father of this Individual. If this
has not been set manually and this Individual has an attached
adaptor, an attempt will be made to lazy-load it from the
database.
Returntype : string
Exceptions : none
Caller : general
Status : At Risk
=cut
sub father_Individual{
my $self = shift;
if(@_) {
my $ind = shift;
if(defined($ind) && (!ref($ind) ||
!$ind->isa('Bio::EnsEMBL::Variation::Individual'))) {
throw('Bio::EnsEMBL::Variation::Individual arg expected');
}
if($ind->gender() eq 'Female') {
throw("Father individual may not have gender of Female");
}
return $self->{'father_individual'} = $ind;
}
# lazy-load mother if we can
if(!defined($self->{'father_individual'}) && $self->adaptor() &&
defined($self->{'_father_individual_sample_id'})) {
$self->{'father_individual'} =
$self->adaptor->fetch_by_dbID($self->{'_father_individual_sample_id'});
}
return $self->{'father_individual'};
}
=head2 mother_Individual
Arg [1] : string $newval (optional)
The new value to set the mother_Individual attribute to
Example : $mother_Individual = $obj->mother_Individual()
Description: Getter/Setter for the mother of this individual. If this
has not been set manually and this Individual has an attached
adaptor, an attempt will be made to lazy-load it from the
database.
Returntype : string
Exceptions : none
Caller : general
Status : At Risk
=cut
sub mother_Individual{
my $self = shift;
if(@_) {
my $ind = shift;
if(defined($ind) && (!ref($ind) ||
!$ind->isa('Bio::EnsEMBL::Variation::Individual'))) {
throw('Bio::EnsEMBL::Variation::Individual arg expected');
}
if($ind->gender() eq 'Male') {
throw("Mother individual may not have gender of Male");
}
return $self->{'mother_individual'} = $ind;
}
# lazy-load mother if we can
if(!defined($self->{'mother_individual'}) && $self->adaptor() &&
defined($self->{'_mother_individual_sample_id'})) {
$self->{'mother_individual'} =
$self->adaptor->fetch_by_dbID($self->{'_mother_individual_sample_id'});
}
return $self->{'mother_individual'};
}
=head2 get_all_child_Individuals
Arg [1] : none
Example : foreach my $c (@{$ind->get_all_child_Individuals}) {
print "Child: " $c->name(), "\n";
}
Description: Retrieves all individuals from the database which are children
of this individual. This will only work if this Individual
object has been stored in the database and has an attached
adaptor.
Returntype : reference to list of Bio::EnsEMBL::Variation::Individual objects
Exceptions : warning if this object does not have an attached adaptor
Caller : general
Status : At Risk
=cut
sub get_all_child_Individuals {
my $self = shift;
if(!$self->adaptor()) {
warning("Cannot retrieve child individuals without attached adaptor.");
}
return $self->adaptor()->fetch_all_by_parent_Individual($self);
}
1;