Archive Ensembl HomeArchive Ensembl Home
IndividualSliceFactory.pm
Go to the documentation of this file.
00001 =head1 LICENSE
00002 
00003   Copyright (c) 1999-2012 The European Bioinformatics Institute and
00004   Genome Research Limited.  All rights reserved.
00005 
00006   This software is distributed under a modified Apache license.
00007   For license details, please see
00008 
00009     http://www.ensembl.org/info/about/code_licence.html
00010 
00011 =head1 CONTACT
00012 
00013   Please email comments or questions to the public Ensembl
00014   developers list at <dev@ensembl.org>.
00015 
00016   Questions may also be sent to the Ensembl help desk at
00017   <helpdesk@ensembl.org>.
00018 
00019 =cut
00020 
00021 package Bio::EnsEMBL::IndividualSliceFactory;
00022 
00023 use strict;
00024 use Bio::EnsEMBL::Utils::Argument qw(rearrange);
00025 use Bio::EnsEMBL::Utils::Sequence qw(reverse_comp);
00026 use Bio::EnsEMBL::Slice;
00027 use Bio::EnsEMBL::Mapper;
00028 use Bio::EnsEMBL::Utils::Exception qw(throw deprecate warning);
00029 use Scalar::Util qw(weaken);
00030 
00031 =head2 new
00032 =cut
00033 
00034 sub new{
00035     my $caller = shift;
00036     my $class = ref($caller) || $caller;
00037 
00038     #creates many IndividualSlice objects from the Population
00039 
00040     my ($population_name, $coord_system, $start, $end, $strand, $seq_region_name, $seq_region_length, $adaptor) = rearrange(['POPULATION', 'COORD_SYSTEM','START','END','STRAND','SEQ_REGION_NAME','SEQ_REGION_LENGTH', 'ADAPTOR'],@_);
00041 
00042     my $self = bless {
00043     population_name => $population_name,
00044     coord_system => $coord_system,
00045     start => $start,
00046     end => $end,
00047     strand => $strand,
00048     seq_region_name => $seq_region_name,
00049     seq_region_length => $seq_region_length},$class;
00050 
00051     $self->adaptor($adaptor);
00052     return $self;
00053 }
00054 
00055 sub adaptor {
00056   my $self = shift;
00057 
00058   if(@_) {
00059     my $ad = shift;
00060     if($ad && (!ref($ad) || !$ad->isa('Bio::EnsEMBL::DBSQL::BaseAdaptor'))) {
00061       throw('Adaptor argument must be a Bio::EnsEMBL::DBSQL::BaseAdaptor');
00062     }
00063     weaken($self->{'adaptor'} = $ad);
00064   }
00065 
00066   return $self->{'adaptor'}
00067 }
00068 
00069 sub get_all_IndividualSlice{
00070     my $self = shift;
00071 
00072     my $slice;
00073     if(!$self->adaptor) {
00074     warning('Cannot get IndividualSlice features without attached adaptor');
00075     return '';
00076     }
00077     my $variation_db = $self->adaptor->db->get_db_adaptor('variation');
00078 
00079     unless($variation_db) {
00080     warning("Variation database must be attached to core database to " .
00081         "retrieve variation information" );
00082     return '';
00083     }
00084     #get the AlleleFeatures in the Population
00085     my $af_adaptor = $variation_db->get_AlleleFeatureAdaptor;
00086     
00087     if( $af_adaptor ) {
00088     #set the adaptor to retrieve data from genotype table
00089     $af_adaptor->from_IndividualSlice(1);
00090     #get the Individual for the given strain
00091     my $population_adaptor = $variation_db->get_PopulationAdaptor;
00092     my $individual_adaptor = $variation_db->get_IndividualAdaptor;
00093     if ($population_adaptor && $individual_adaptor){
00094         $slice = Bio::EnsEMBL::Slice->new(-coord_system => $self->{'coord_system'},
00095                           -start => $self->{'start'},
00096                           -end => $self->{'end'},
00097                           -strand => $self->{'strand'},
00098                           -seq_region_name => $self->{'seq_region_name'},
00099                           -seq_region_length => $self->{'seq_region_length'},
00100                           -adaptor => $self->adaptor
00101                           );
00102         my $population = $population_adaptor->fetch_by_name($self->{'population_name'}); 
00103         #check that there is such population in the database
00104         if (defined $population){
00105         #get all the AlleleFeatures in the $population and the Slice given
00106         my $allele_features = $af_adaptor->fetch_all_by_Slice($slice,$population);
00107         #get Individuals in the Population
00108         my $individuals = $individual_adaptor->fetch_all_by_Population($population);        
00109         return $self->_rearrange_Individuals_Alleles($individuals,$allele_features);
00110         }
00111         else{ 
00112         warning("Population not in the database");
00113         return '';
00114  
00115         }
00116     }
00117     else{
00118         warning("Not possible to retrieve PopulationAdaptor from the variation database");
00119         return '';
00120     }   
00121     }
00122     
00123     else{
00124     warning("Not possible to retrieve AlleleFeatureAdaptor from variation database");
00125     return '';
00126     }
00127 }
00128 
00129 sub _rearrange_Individuals_Alleles{
00130     my $self = shift;
00131     my $individuals = shift;
00132     my $allele_features;
00133     my $individual_slice;
00134     #create the hash with all the individuals
00135     my %individuals_ids;
00136     #foreach of the individual, create the IndividualSlice object and add it to the mapping hash
00137     foreach my $individual (@{$individuals}){
00138     $individual_slice = Bio::EnsEMBL::Variation::IndividualSlice->new(
00139         -coord_system => $self->{'coord_system'},
00140         -start => $self->{'$start'},
00141         -end  => $self->{'end'},
00142         -strand => $self->{'strand'},
00143         -seq_region_name => $self->{'seq_region_name'},
00144         -seq_region_length => $self->{'seq_region_length'},
00145         -individual => $individual->name);
00146     
00147     $individuals_ids{$individual->dbID} = $individual_slice;
00148     }
00149 
00150     #and rearrange all the AlleleFeatures to the individuals
00151     foreach my $allele_feature (@{$allele_features}){
00152     $individuals_ids{$allele_feature->{'_sample_id'}}->add_AlleleFeature($allele_feature);
00153     }
00154     my @result = values %individuals_ids;
00155     return \@result;
00156 }
00157 
00158 
00159 1;