Raw content of Bio::EnsEMBL::Variation::DBSQL::PopulationGenotypeAdaptor
#
# Ensembl module for Bio::EnsEMBL::Variation::DBSQL::PopulationGenotypeAdaptor
#
# Copyright (c) 2004 Ensembl
#
# You may distribute this module under the same terms as perl itself
#
#
=head1 NAME
Bio::EnsEMBL::Variation::DBSQL::PopulationGenotypeAdaptor
=head1 SYNOPSIS
$db = Bio::EnsEMBL::Variation::DBSQL::DBAdaptor->new(...);
$pga = $db->get_PopulationGenotypeAdaptor();
$pa = $db->get_PopulationAdaptor();
# Get a PopulationGenotype by its internal identifier
$pgtype = $ia->fetch_by_dbID(145);
print $pgtype->population->name(), " ",
$pgtype->allele1(), ' ', $pgtype->allele2(), ' ', $pgtype->frequency();
# Get all population genotypes for an population
$pop = $pa->fetch_by_dbID(1219);
foreach $pgtype (@{$pga->fetch_all_by_Population($pop)}) {
print $pgtype->variation()->name(), ' ',
$pgtype->frequency();
$pgtype->allele1(), '/', $pgtype->allele2(), "\n";
}
=head1 DESCRIPTION
This adaptor provides database connectivity for PopulationGenotype objects.
PopulationGenotypes may be retrieved from the Ensembl variation database by
several means using this module.
=head1 AUTHOR - Graham McVicker
=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::DBSQL::PopulationGenotypeAdaptor;
use Bio::EnsEMBL::DBSQL::BaseAdaptor;
use Bio::EnsEMBL::Utils::Exception qw(throw warning);
use Bio::EnsEMBL::Variation::PopulationGenotype;
our @ISA = ('Bio::EnsEMBL::DBSQL::BaseAdaptor');
=head2 fetch_by_dbID
Arg [1] : int $dbID
Example : $pgtype = $pgtype_adaptor->fetch_by_dbID(15767);
Description: Retrieves a population genotype via its unique internal
identifier. undef is returned if no such population genotype
exists.
Returntype : Bio::EnsEMBL::Variation::Variation::PopulationGenotype or undef
Exceptions : throw if no dbID argument is provided
Caller : general
Status : At Risk
=cut
sub fetch_by_dbID {
my $self = shift;
my $dbID = shift;
if (! $dbID){
throw('no dbID argument provided');
}
return shift @{$self->generic_fetch("population_genotype_id = " . $dbID)};
}
=head2 fetch_all_by_Population
Arg [1] : Bio::EnsEMBL::Variation::Population
Example : $pop = $pop_adaptor->fetch_by_dbID(1345);
@gtys = $pgty_adaptor->fetch_all_by_Population($pop);
Description: Retrieves all genotypes which are stored for a specified
population.
Returntype : Bio::EnsEMBL::Variation::PopulationGenotype
Exceptions : throw on incorrect argument
Caller : general
Status : At Risk
=cut
sub fetch_all_by_Population {
my $self = shift;
my $pop = shift;
if(!ref($pop) || !$pop->isa('Bio::EnsEMBL::Variation::Population')) {
throw('Bio::EnsEMBL::Variation::Population argument expected');
}
if(!defined($pop->dbID())) {
warning("Cannot retrieve genotypes for population without set dbID");
return [];
}
return $self->generic_fetch("sample_id = " . $pop->dbID());
}
=head2 fetch_all_by_Variation
Arg [1] : Bio::EnsEMBL::Variation $variation
Example : my $var = $variation_adaptor->fetch_by_name( "rs1121" )
$poptypes = $poptype_adaptor->fetch_all_by_Variation( $var )
Description: Retrieves a list of population genotypes for the given Variation.
If none are available an empty listref is returned.
Returntype : listref Bio::EnsEMBL::Variation::PopulationGenotype
Exceptions : throw on bad argument
Caller : general
Status : At Risk
=cut
sub fetch_all_by_Variation {
my $self = shift;
my $variation = shift;
if(!ref($variation) || !$variation->isa('Bio::EnsEMBL::Variation::Variation')) {
throw('Bio::EnsEMBL::Variation::Variation argument expected');
}
if(!defined($variation->dbID())) {
warning("Cannot retrieve genotypes for variation without set dbID");
return [];
}
return $self->generic_fetch("variation_id = " . $variation->dbID());
}
sub _tables{return ['population_genotype','pg']}
sub _columns{
return qw(pg.population_genotype_id pg.variation_id pg.sample_id pg.allele_1 pg.allele_2 pg.frequency)
}
sub _objs_from_sth{
my $self = shift;
my $sth = shift;
my @results;
my ($dbID, $variation_id, $sample_id, $allele_1, $allele_2, $frequency);
$sth->bind_columns(\$dbID, \$variation_id, \$sample_id, \$allele_1, \$allele_2, \$frequency);
my %population_hash;
my %variation_hash;
while($sth->fetch()){
my $pgtype = Bio::EnsEMBL::Variation::PopulationGenotype->new
(-dbID => $dbID,
-adaptor => $self,
-allele1 => $allele_1,
-allele2 => $allele_2,
-frequency => $frequency);
$population_hash{$sample_id} ||= [];
$variation_hash{$variation_id} ||= [];
push @{$variation_hash{$variation_id}}, $pgtype; #store the variations to get the objects once
push @{$population_hash{$sample_id}}, $pgtype; #store the populations to get the objects once
push @results, $pgtype;
}
# get all variations in one query (faster)
# and add to already created genotypes
my @var_ids = keys %variation_hash;
my $va = $self->db()->get_VariationAdaptor();
my $vars = $va->fetch_all_by_dbID_list(\@var_ids);
foreach my $v (@$vars) {
foreach my $igty (@{$variation_hash{$v->dbID()}}) {
$igty->variation($v);
}
}
# get all populations in one query (faster)
# and add to already created genotypes
my @pop_ids = keys %population_hash;
my $pa = $self->db()->get_PopulationAdaptor();
my $pops = $pa->fetch_all_by_dbID_list(\@pop_ids);
foreach my $p (@$pops) {
foreach my $pgty (@{$population_hash{$p->dbID()}}) {
$pgty->population($p);
}
}
return \@results;
}
1;