Archive Ensembl HomeArchive Ensembl Home
HomologyAdaptor.pm
Go to the documentation of this file.
00001 package Bio::EnsEMBL::Compara::DBSQL::HomologyAdaptor;
00002 
00003 use strict;
00004 use Bio::EnsEMBL::Compara::Homology;
00005 use Bio::EnsEMBL::Compara::DBSQL::BaseRelationAdaptor;
00006 use Bio::EnsEMBL::Utils::Exception;
00007 
00008 our @ISA = qw(Bio::EnsEMBL::Compara::DBSQL::BaseRelationAdaptor);
00009 
00010 
00011 =head2 fetch_all_by_Member
00012 
00013  Arg [1]    : Bio::EnsEMBL::Compara::Member $member
00014  Example    : $homologies = $HomologyAdaptor->fetch_all_by_Member($member);
00015  Description: fetch the homology relationships where the given member is implicated
00016  Returntype : an array reference of Bio::EnsEMBL::Compara::Homology objects
00017  Exceptions : none
00018  Caller     : general
00019 
00020 =cut
00021 
00022 sub fetch_all_by_Member {
00023   my ($self, $member) = @_;
00024 
00025   my $join = [[['homology_member', 'hm'], 'h.homology_id = hm.homology_id']];
00026   my $constraint = "hm.member_id = " .$member->dbID;
00027 
00028   # This internal variable is used by add_Member_Attribute method 
00029   # in Bio::EnsEMBL::Compara::BaseRelation to make sure that the first element
00030   # of the member array is the one that has been used by the user to fetch the
00031   # homology object
00032   $self->{'_this_one_first'} = $member->stable_id;
00033 
00034   return $self->generic_fetch($constraint, $join);
00035 }
00036 
00037 
00038 =head2 fetch_all_by_Member_paired_species
00039 
00040   Arg [1]    : Bio::EnsEMBL::Compara::Member $member
00041   Arg [2]    : string $species
00042                e.g. "Mus_musculus" or "Mus musculus"
00043   Arg [3]    : (optional) an arrayref of method_link types
00044                e.g. ['ENSEMBL_ORTHOLOGUES']. Default is ['ENSEMBL_ORTHOLOGUES','ENSEMBL_PARALOGUES']
00045   Example    : $homologies = $HomologyAdaptor->fetch_all_by_Member_paired_species($member, "Mus_musculus");
00046   Description: fetch the homology relationships where the given member is implicated
00047                in pair with another member from the paired species. Member species and
00048                paired species should be different.
00049                
00050                When you give the species name the method attempts to find
00051                the species without _ subsitution and then replacing them
00052                for spaces. This is to help support GenomeDB objects which
00053                have _ in their names.
00054   Returntype : an array reference of Bio::EnsEMBL::Compara::Homology objects
00055   Exceptions : If a GenomeDB cannot be found for the given species name
00056   Caller     : 
00057 
00058 =cut
00059 
00060 sub fetch_all_by_Member_paired_species {
00061   my ($self, $member, $species, $method_link_types) = @_;
00062 
00063     my $gdb_a = $self->db->get_GenomeDBAdaptor();
00064   my $gdb1 = $member->genome_db;
00065   my $gdb2 = eval {$gdb_a->fetch_by_name_assembly($species)};
00066   if(!defined $gdb2) {
00067     my $species_no_underscores = $species;
00068     $species_no_underscores =~ tr/_/ /;
00069     $gdb2 = eval {$gdb_a->fetch_by_name_assembly($species_no_underscores)};
00070     if(!defined $gdb2) {
00071         throw("No GenomeDB found with names [$species | $species_no_underscores]");
00072     }
00073   }
00074 
00075   unless (defined $method_link_types) {
00076     $method_link_types = ['ENSEMBL_ORTHOLOGUES','ENSEMBL_PARALOGUES'];
00077   }
00078   my $mlssa = $self->db->get_MethodLinkSpeciesSetAdaptor;
00079 
00080   my $all_homologies = [];
00081   foreach my $ml (@{$method_link_types}) {
00082     my $mlss;
00083     if ($gdb1->dbID == $gdb2->dbID) {
00084       next if ($ml eq 'ENSEMBL_ORTHOLOGUES');
00085       $mlss = $mlssa->fetch_by_method_link_type_GenomeDBs($ml, [$gdb1]);
00086     } else {
00087       $mlss = $mlssa->fetch_by_method_link_type_GenomeDBs($ml, [$gdb1, $gdb2]);
00088     }
00089     if (defined $mlss) {
00090       my $homologies = $self->fetch_all_by_Member_MethodLinkSpeciesSet($member, $mlss);
00091       push @{$all_homologies}, @{$homologies} if (defined $homologies);
00092     }
00093   }
00094   return $all_homologies;
00095 }
00096 
00097 
00098 =head2 fetch_all_by_Member_method_link_type
00099 
00100   Arg [1]    : Bio::EnsEMBL::Compara::Member $member
00101   Arg [2]    : string $method_link_type
00102   Example    : $homologies = $HomologyAdaptor->fetch_all_by_Member_method_link_type(
00103                    $member, "ENSEMBL_ORTHOLOGUES");
00104   Description: fetch the homology relationships where the given member is implicated
00105                in a relationship of the type defined by $method_link_type.
00106   Returntype : an array reference of Bio::EnsEMBL::Compara::Homology objects
00107   Exceptions : none
00108   Caller     : 
00109 
00110 =cut
00111 
00112 sub fetch_all_by_Member_method_link_type {
00113   my ($self, $member, $method_link_type) = @_;
00114 
00115   unless ($member->isa('Bio::EnsEMBL::Compara::Member')) {
00116     throw("The argument must be a Bio::EnsEMBL::Compara::Member object, not $member");
00117   }
00118 
00119   unless ($member->genome_db_id) {
00120     warning("Cannot get Homologues for a Bio::EnsEMBL::Compara::Member (".$member->source_name.
00121         "::".$member->stable_id.") with no GenomeDB");
00122     return [];
00123   }
00124 
00125   throw("method_link_type arg is required\n")
00126     unless ($method_link_type);
00127 
00128   my $mlssa = $self->db->get_MethodLinkSpeciesSetAdaptor;
00129   my $mlss_arrayref = $mlssa->fetch_all_by_method_link_type_GenomeDB($method_link_type,$member->genome_db);
00130 
00131   unless (scalar @{$mlss_arrayref}) {
00132     warning("There is no $method_link_type data stored in the database for " . $member->genome_db->name . "\n");
00133     return [];
00134   }
00135 
00136   my $join = [[['homology_member', 'hm'], 'h.homology_id = hm.homology_id']];
00137   my $constraint =  " h.method_link_species_set_id in (". join (",", (map {$_->dbID} @{$mlss_arrayref})) . ")";
00138 
00139   $constraint .= " AND hm.member_id = " . $member->dbID;
00140 
00141   # See in fetch_all_by_Member what is this internal variable for
00142   $self->{'_this_one_first'} = $member->stable_id;
00143 
00144   return $self->generic_fetch($constraint, $join);
00145 }
00146 
00147 =head2 fetch_all_by_Member_MethodLinkSpeciesSet
00148 
00149   Arg [1]    : Bio::EnsEMBL::Compara::Member $member
00150   Arg [2]    : Bio::EnsEMBL::Compara::MethodLinkSpeciesSet $mlss
00151   Example    : $homologies = $HomologyAdaptor->fetch_all_by_Member_MethodLinkSpeciesSet($member, $mlsss);
00152   Description: fetch the homology relationships for a given $member and $mlss.
00153   Returntype : an array reference of Bio::EnsEMBL::Compara::Homology objects
00154   Exceptions : none
00155   Caller     : 
00156 
00157 =cut
00158 
00159 sub fetch_all_by_Member_MethodLinkSpeciesSet {
00160   my ($self, $member, $method_link_species_set) = @_;
00161 
00162   unless ($member->isa('Bio::EnsEMBL::Compara::Member')) {
00163     throw("The argument must be a Bio::EnsEMBL::Compara::Member object, not $member");
00164   }
00165 
00166   throw("method_link_species_set arg is required\n")
00167     unless ($method_link_species_set);
00168 
00169 #  my $mlssa = $self->db->get_MethodLinkSpeciesSetAdaptor;
00170 #  my $mlss_arrayref = $mlssa->fetch_all_by_method_link_type_genome_db_id($method_link_type,$member->genome_db_id);
00171   
00172 #  unless (scalar @{$mlss_arrayref}) {
00173 #    warning("There is no $method_link_type data stored in the database for " . $member->genome_db->name . "\n");
00174 #    return [];
00175 #  }
00176 
00177   my $join = [[['homology_member', 'hm'], 'h.homology_id = hm.homology_id']];
00178   my $constraint =  " h.method_link_species_set_id =" . $method_link_species_set->dbID;
00179 
00180   $constraint .= " AND hm.member_id = " . $member->dbID;
00181 
00182   # See in fetch_all_by_Member what is this internal variable for
00183   $self->{'_this_one_first'} = $member->stable_id;
00184 
00185   return $self->generic_fetch($constraint, $join);
00186 }
00187 
00188 
00189 =head2 fetch_by_Member_Member_method_link_type
00190 
00191   Arg [1]    : Bio::EnsEMBL::Compara::Member $member
00192   Arg [2]    : Bio::EnsEMBL::Compara::Member $member
00193   Arg [3]    : string $method_link_type
00194   Example    : $homologies = $HomologyAdaptor->fetch_by_Member_Member_method_link_type(
00195                    $member1->gene_member, $member2->gene_member, "ENSEMBL_ORTHOLOGUES");
00196   Description: fetch the homology relationships where the given member pair is implicated
00197                in a relationship of the type defined by $method_link_type.
00198   Returntype : an array reference of Bio::EnsEMBL::Compara::Homology objects
00199   Exceptions : none
00200   Caller     : 
00201 
00202 =cut
00203 
00204 sub fetch_by_Member_Member_method_link_type {
00205   my ($self, $member1, $member2, $method_link_type) = @_;
00206 
00207   unless ($member1->stable_id ne $member2->stable_id) {
00208     throw("The members should be different");
00209   }
00210   unless ($member1->isa('Bio::EnsEMBL::Compara::Member')) {
00211     throw("The argument must be a Bio::EnsEMBL::Compara::Member object, not $member1");
00212   }
00213   unless ($member2->isa('Bio::EnsEMBL::Compara::Member')) {
00214     throw("The argument must be a Bio::EnsEMBL::Compara::Member object, not $member2");
00215   }
00216 
00217   $method_link_type = 'ENSEMBL_ORTHOLOGUES' unless (defined($method_link_type));
00218   my $genome_dbs = [$member1->genome_db, $member2->genome_db];
00219   if ($member1->genome_db_id == $member2->genome_db_id) {
00220     $method_link_type = 'ENSEMBL_PARALOGUES';
00221     $genome_dbs = [$member1->genome_db];
00222   }
00223   my $mlssa = $self->db->get_MethodLinkSpeciesSetAdaptor;
00224   my $mlss = $mlssa->fetch_by_method_link_type_GenomeDBs($method_link_type,$genome_dbs);
00225 
00226   unless (defined($mlss)) {
00227     warning("There is no $method_link_type data stored in the database for " . $member1->genome_db->name . " and " . $member2->genome_db->name . "\n");
00228     return [];
00229   }
00230 
00231   #  my $join = [[['homology_member', 'hm'], 'h.homology_id = hm.homology_id']];
00232   my $join = [[['homology_member', 'hm1'], 'h.homology_id = hm1.homology_id'],[['homology_member', 'hm2'], 'h.homology_id = hm2.homology_id']];
00233   my $constraint =  " h.method_link_species_set_id =" . $mlss->dbID;
00234 
00235   $constraint .= " AND hm1.member_id = " . $member1->dbID;
00236   $constraint .= " AND hm2.member_id = " . $member2->dbID;
00237 #  $constraint .= " AND hm1.member_id<hm2.member_id ";
00238 
00239   # See in fetch_all_by_Member what is this internal variable for
00240   $self->{'_this_one_first'} = $member1->stable_id;
00241 
00242   return $self->generic_fetch($constraint, $join);
00243 }
00244 
00245 =head2 fetch_by_Member_id_Member_id
00246 
00247   Arg [1]    : int $member_id1
00248   Arg [2]    : int $member_id2
00249   Example    : $homologies = $HomologyAdaptor->fetch_by_Member_id_Member_id(
00250                    $member_id1, $member_id2);
00251   Description: fetch the homology relationships for a given member_id pair
00252   Returntype : a Bio::EnsEMBL::Compara::Homology object
00253   Exceptions : none
00254   Caller     : 
00255 
00256 =cut
00257 
00258 sub fetch_by_Member_id_Member_id {
00259   my ($self, $member_id1, $member_id2,$allow_duplicates) = @_;
00260 
00261   unless ($member_id1 ne $member_id2) {
00262     throw("The members should be different");
00263   }
00264   my $join = [[['homology_member', 'hm1'], 'h.homology_id = hm1.homology_id'],[['homology_member', 'hm2'], 'h.homology_id = hm2.homology_id']];
00265 
00266   my $constraint .= " hm1.member_id = " . $member_id1;
00267   $constraint .= " AND hm2.member_id = " . $member_id2;
00268 
00269   # See in fetch_all_by_Member what is this internal variable for
00270   $self->{'_this_one_first'} = $member_id1;
00271 
00272   my $homology = $self->generic_fetch($constraint, $join);
00273 
00274   return undef unless (defined $homology || 0 == scalar @$homology);
00275 
00276   # At production time, we may have more than one entry due to the
00277   # OtherParalogs code, so we allow fetching with the extra parameter,
00278   # but the duplicity is cleaned up afterwards
00279   if (1 < scalar @$homology && !defined($allow_duplicates)) {
00280     throw("Returns more than one element");
00281   }
00282 
00283   return shift @{$homology};
00284 }
00285 
00286 =head2 fetch_by_PMember_id_PMember_id
00287 
00288   Arg [1]    : int $member_id1
00289   Arg [2]    : int $member_id2
00290   Example    : $homologies = $HomologyAdaptor->fetch_by_Member_id_Member_id(
00291                    $member_id1, $member_id2);
00292   Description: fetch the homology relationships for a given peptide_member_id pair
00293   Returntype : a Bio::EnsEMBL::Compara::Homology object
00294   Exceptions : none
00295   Caller     : 
00296 
00297 =cut
00298 
00299 sub fetch_by_PMember_id_PMember_id {
00300   my ($self, $member_id1, $member_id2,$allow_duplicates) = @_;
00301 
00302   unless ($member_id1 ne $member_id2) {
00303     throw("The members should be different");
00304   }
00305   my $join = [[['homology_member', 'hm1'], 'h.homology_id = hm1.homology_id'],[['homology_member', 'hm2'], 'h.homology_id = hm2.homology_id']];
00306 
00307   my $constraint .= " hm1.peptide_member_id = " . $member_id1;
00308   $constraint .= " AND hm2.peptide_member_id = " . $member_id2;
00309 
00310   # See in fetch_by_PMember what is this internal variable for
00311   $self->{'_this_one_first'} = $member_id1;
00312 
00313   my $homology = $self->generic_fetch($constraint, $join);
00314 
00315   return undef unless (defined $homology || 0 == scalar @$homology);
00316 
00317   # At production time, we may have more than one entry due to the
00318   # OtherParalogs code, so we allow fetching with the extra parameter,
00319   # but the duplicity is cleaned up afterwards
00320   if (1 < scalar @$homology && !defined($allow_duplicates)) {
00321     throw("Returns more than one element");
00322   }
00323 
00324   return shift @{$homology};
00325 }
00326 
00327 
00328 =head2 fetch_all_by_MethodLinkSpeciesSet
00329 
00330   Arg [1]    : Bio::EnsEMBL::Compara::MethodLinkSpeciesSet $mlss
00331   Example    : $homologies = $HomologyAdaptor->fetch_all_by_MethodLinkSpeciesSet($mlss);
00332   Description: fetch all the homology relationships for the given MethodLinkSpeciesSet
00333                Since each species pair Orthologue analysis is given a unique 
00334            MethodLinkSpeciesSet, this method can be used to grab all the 
00335            orthologues for a species pair.
00336   Returntype : an array reference of Bio::EnsEMBL::Compara::Homology objects
00337   Exceptions : none
00338   Caller     : 
00339 
00340 =cut
00341 
00342 sub fetch_all_by_MethodLinkSpeciesSet {
00343   my ($self, $method_link_species_set) = @_;
00344 
00345   throw("method_link_species_set arg is required\n")
00346     unless ($method_link_species_set);
00347 
00348   my $constraint =  " h.method_link_species_set_id =" . $method_link_species_set->dbID;
00349 
00350   return $self->generic_fetch($constraint);
00351 }
00352 
00353 
00354 =head2 fetch_all_by_tree_node_id
00355 
00356   Arg [1]    : int $tree_node_id
00357   Example    : $homologies = $HomologyAdaptor->fetch_all_by_tree_node_id($tree->node_id);
00358   Description: fetch all the homology relationships for the given tree
00359   Returntype : an array reference of Bio::EnsEMBL::Compara::Homology objects
00360   Exceptions : none
00361   Caller     : 
00362 
00363 =cut
00364 
00365 sub fetch_all_by_tree_node_id {
00366   my ($self, $tree_node_id) = @_;
00367 
00368   throw("tree_node_id arg is required\n")
00369     unless ($tree_node_id);
00370 
00371   my $constraint =  " h.tree_node_id =" . $tree_node_id;
00372 
00373   return $self->generic_fetch($constraint);
00374 }
00375 
00376 
00377 
00378 =head2 fetch_all_by_genome_pair
00379 
00380   Arg [1]    : genome_db_id
00381   Arg [2]    : genome_db_id
00382   Example    : $homologies = $HomologyAdaptor->fetch_all_by_genome_pair(22,3);
00383   Description: fetch all the homology relationships for the a pair of genome_db_ids
00384                This method can be used to grab all the orthologues for a species pair.
00385   Returntype : an array reference of Bio::EnsEMBL::Compara::Homology objects
00386   Exceptions : none
00387   Caller     : 
00388 
00389 =cut
00390 
00391 
00392 sub fetch_all_by_genome_pair {
00393   my ($self, $genome_db_id1, $genome_db_id2) = @_;
00394 
00395   my $join = [ [['homology_member', 'hm1'], 'h.homology_id = hm1.homology_id'],
00396                [['member', 'm1'], 'hm1.member_id = m1.member_id'],
00397                [['homology_member', 'hm2'], 'h.homology_id = hm2.homology_id'],
00398                [['member', 'm2'], 'hm2.member_id = m2.member_id'],
00399              ];
00400 
00401   my $constraint = "m1.genome_db_id= $genome_db_id1";
00402   $constraint .= " AND m2.genome_db_id = $genome_db_id2";
00403 
00404   $self->{'_this_one_first'} = undef; #not relevant
00405 
00406   return $self->generic_fetch($constraint, $join);
00407 }
00408 
00409 
00410 =head2 fetch_all_by_MethodLinkSpeciesSet_orthology_type
00411 
00412   Arg [1]    : method_link_species_set
00413   Arg [2]    : orthology type
00414   Example    : $homologies = $HomologyAdaptor->
00415                   fetch_all_by_MethodLinkSpeciesSet_orthology_type(
00416                   $mlss, 'ortholog_one2one');
00417   Description: fetch all the homology relationships for the given
00418                orthology type and for a mlss (corresponding to one or
00419                a pair of genomes). This method can be used to grab all
00420                the orthologues for one genome paralogues or a species
00421                pair and an orthology type.
00422   Returntype : an array reference of Bio::EnsEMBL::Compara::Homology objects
00423   Exceptions : none
00424   Caller     :
00425 
00426 =cut
00427 
00428 sub fetch_all_by_MethodLinkSpeciesSet_orthology_type {
00429   my ($self, $method_link_species_set, $orthology_type) = @_;
00430 
00431   throw ("method_link_species_set arg is required\n")
00432     unless ($method_link_species_set);
00433   throw ("[$method_link_species_set] must be a Bio::EnsEMBL::Compara::MethodLinkSpeciesSet object\n")
00434     unless (UNIVERSAL::isa($method_link_species_set, "Bio::EnsEMBL::Compara::MethodLinkSpeciesSet"));
00435   throw ("orthology_type arg is required\n")
00436     unless ($orthology_type);
00437 
00438   my $constraint =  " h.method_link_species_set_id =" . $method_link_species_set->dbID;
00439   $constraint .= " AND h.description=\"$orthology_type\"";
00440 
00441   $self->{'_this_one_first'} = undef; #not relevant
00442 
00443   return $self->generic_fetch($constraint);
00444 }
00445 
00446 =head2 fetch_all_by_MethodLinkSpeciesSet_orthology_type_subtype
00447 
00448   Arg [1]    : method_link_species_set
00449   Arg [2]    : orthology type
00450   Arg [3]    : orthology subtype
00451   Example    : $homologies = $HomologyAdaptor->
00452                   fetch_all_by_MethodLinkSpeciesSet_orthology_type_subtype(
00453                   $mlss, 'ortholog_one2one','Mammalia');
00454   Description: fetch all the homology relationships for the given
00455                orthology type, mlss (corresponding to one or
00456                a pair of genomes) and subtype (taxonomy level). This method can be
00457                used to grab all the orthologues for one genome paralogues or a species
00458                pair and an orthology type and taxonomy level.
00459   Returntype : an array reference of Bio::EnsEMBL::Compara::Homology objects
00460   Exceptions : none
00461   Caller     :
00462 
00463 =cut
00464 
00465 
00466 sub fetch_all_by_MethodLinkSpeciesSet_orthology_type_subtype {
00467   my ($self, $method_link_species_set, $orthology_type, $subtype) = @_;
00468 
00469   throw ("method_link_species_set arg is required\n")
00470     unless ($method_link_species_set);
00471   throw ("[$method_link_species_set] must be a Bio::EnsEMBL::Compara::MethodLinkSpeciesSet object\n")
00472     unless (UNIVERSAL::isa($method_link_species_set, "Bio::EnsEMBL::Compara::MethodLinkSpeciesSet"));
00473   throw ("orthology_type arg is required\n")
00474     unless ($orthology_type);
00475 
00476   my $constraint =  " h.method_link_species_set_id =" . $method_link_species_set->dbID;
00477   $constraint .= " AND h.description=\"$orthology_type\"";
00478   $constraint .= " AND h.subtype=\"$subtype\"";
00479 
00480   $self->{'_this_one_first'} = undef; #not relevant
00481 
00482   return $self->generic_fetch($constraint);
00483 }
00484 
00485 
00486 =head2 fetch_orthocluster_with_Member
00487 
00488   Arg [1]    : Bio::EnsEMBL::Compara::Member $gene_member (must be ENSEMBLGENE type)
00489   Example    : my ($homology_list, $gene_list) = 
00490                  $HomologyAdaptor->fetch_orthocluster_with_Member($gene_member);
00491   Description: do a recursive search starting from $gene_member to find the cluster of
00492                all connected genes and homologies via connected components clustering.
00493   Returntype : an array pair of array references.  
00494                First array_ref is the list of Homology objects in the cluster graph
00495            Second array ref is the list of unique gene Members in the cluster
00496   Exceptions : none
00497   Caller     : 
00498 
00499 =cut
00500 
00501 sub fetch_orthocluster_with_Member {
00502   my $self = shift;
00503   my $gene_member = shift;
00504   
00505   my $ortho_set = {};
00506   my $member_set = {};
00507   $self->_recursive_get_orthocluster($gene_member, $ortho_set, $member_set, 0);
00508 
00509   my @homologies = values(%{$ortho_set});
00510   my @genes      = values(%{$member_set});
00511   return (\@homologies, \@genes);
00512 }
00513  
00514 
00515 sub _recursive_get_orthocluster {
00516   my $self = shift;
00517   my $gene = shift;
00518   my $ortho_set = shift;
00519   my $member_set = shift;
00520   my $debug = shift;
00521 
00522   return if($member_set->{$gene->dbID});
00523 
00524   $gene->print_member("query gene\n") if($debug);
00525   $member_set->{$gene->dbID} = $gene;
00526 
00527   my $homologies = $self->fetch_all_by_Member($gene);
00528   printf("fetched %d homologies\n", scalar(@$homologies)) if($debug);
00529 
00530   foreach my $homology (@{$homologies}) {
00531     next if($ortho_set->{$homology->dbID});
00532     
00533     foreach my $member_attribute (@{$homology->get_all_Member_Attribute}) {
00534       my ($member, $attribute) = @{$member_attribute};
00535       next if($member->dbID == $gene->dbID); #skip query gene
00536       $member->print_member if($debug);
00537 
00538       printf("adding homology_id %d to cluster\n", $homology->dbID) if($debug);
00539       $ortho_set->{$homology->dbID} = $homology;
00540       $self->_recursive_get_orthocluster($member, $ortho_set, $member_set, $debug);
00541     }
00542   }
00543   printf("done with search query %s\n", $gene->stable_id) if($debug);
00544 }
00545 
00546 
00547 
00548 #
00549 # internal methods
00550 #
00551 ###################
00552 
00553 # internal methods used in multiple calls above to build homology objects from table data  
00554 
00555 sub _tables {
00556   my $self = shift;
00557 
00558   return (['homology', 'h']);
00559 }
00560 
00561 sub _columns {
00562   my $self = shift;
00563 
00564   return qw (h.homology_id
00565              h.stable_id
00566              h.method_link_species_set_id
00567              h.description
00568              h.subtype
00569              h.dn
00570              h.ds
00571              h.n
00572              h.s
00573              h.lnl
00574              h.threshold_on_ds
00575              h.ancestor_node_id
00576              h.tree_node_id);
00577 }
00578 
00579 sub _objs_from_sth {
00580   my ($self, $sth) = @_;
00581   
00582   my ($homology_id, $stable_id, $description, $dn, $ds, $n, $s, $lnl, $threshold_on_ds,
00583       $method_link_species_set_id, $subtype, $ancestor_node_id, $tree_node_id);
00584 
00585   $sth->bind_columns(\$homology_id, \$stable_id, \$method_link_species_set_id,
00586                      \$description, \$subtype, \$dn, \$ds,
00587                      \$n, \$s, \$lnl, \$threshold_on_ds, \$ancestor_node_id, \$tree_node_id);
00588 
00589   my @homologies = ();
00590   
00591   while ($sth->fetch()) {
00592     push @homologies, Bio::EnsEMBL::Compara::Homology->new_fast
00593       ({'_dbID' => $homology_id,
00594        '_stable_id' => $stable_id,
00595        '_description' => $description,
00596        '_method_link_species_set_id' => $method_link_species_set_id,
00597        '_subtype' => $subtype,
00598        '_dn' => $dn,
00599        '_ds' => $ds,
00600        '_n' => $n,
00601        '_s' => $s,
00602        '_lnl' => $lnl,
00603        '_threshold_on_ds' => $threshold_on_ds,
00604        '_adaptor' => $self,
00605        '_this_one_first' => $self->{'_this_one_first'},
00606        '_ancestor_node_id' => $ancestor_node_id,
00607        '_tree_node_id' => $tree_node_id});
00608   }
00609   
00610   return \@homologies;  
00611 }
00612 
00613 sub _default_where_clause {
00614   my $self = shift;
00615   return '';
00616 }
00617 
00618 #
00619 # STORE METHODS
00620 #
00621 ################
00622 
00623 =head2 store
00624 
00625  Arg [1]    : Bio::EnsEMBL::Compara::Homology $homology
00626  Example    : $HomologyAdaptor->store($homology)
00627  Description: Stores a homology object into a compara database
00628  Returntype : int 
00629               been the database homology identifier, if homology stored correctly
00630  Exceptions : when isa if Arg [1] is not Bio::EnsEMBL::Compara::Homology
00631  Caller     : general
00632 
00633 =cut
00634 
00635 sub store {
00636   my ($self,$hom) = @_;
00637   
00638   $hom->isa('Bio::EnsEMBL::Compara::Homology') ||
00639     throw("You have to store a Bio::EnsEMBL::Compara::Homology object, not a $hom");
00640 
00641   $hom->adaptor($self);
00642 
00643   if ( !defined $hom->method_link_species_set_id && defined $hom->method_link_species_set) {
00644     $self->db->get_MethodLinkSpeciesSetAdaptor->store($hom->method_link_species_set);
00645   }
00646 
00647   if (! defined $hom->method_link_species_set) {
00648     throw("Homology object has no set MethodLinkSpecies object. Can not store Homology object\n");
00649   } else {
00650     $hom->method_link_species_set_id($hom->method_link_species_set->dbID);
00651   }
00652   
00653   unless($hom->dbID) {
00654     my $sql = "INSERT INTO homology (stable_id, method_link_species_set_id, description, subtype, ancestor_node_id, tree_node_id) VALUES (?,?,?,?,?,?)";
00655     my $sth = $self->prepare($sql);
00656     $sth->execute($hom->stable_id,$hom->method_link_species_set_id,$hom->description, $hom->subtype, $hom->ancestor_node_id, $hom->tree_node_id);
00657     $hom->dbID($sth->{'mysql_insertid'});
00658   }
00659 
00660   foreach my $member_attribute (@{$hom->get_all_Member_Attribute}) {   
00661     $self->store_relation($member_attribute, $hom);
00662   }
00663 
00664   return $hom->dbID;
00665 }
00666 
00667 
00668 =head2 update_genetic_distance
00669 
00670  Arg [1]    : Bio::EnsEMBL::Compara::Homology $homology
00671  Example    : $HomologyAdaptor->update_genetic_distance($homology)
00672  Description: updates the n,s,dn,ds,lnl values from a homology object into a compara database
00673  Exceptions : when isa if Arg [1] is not Bio::EnsEMBL::Compara::Homology
00674  Caller     : Bio::EnsEMBL::Compara::Runnable::Homology_dNdS
00675 
00676 =cut
00677 
00678 sub update_genetic_distance {
00679   my $self = shift;
00680   my $hom = shift;
00681 
00682   throw("You have to store a Bio::EnsEMBL::Compara::Homology object, not a $hom")
00683     unless($hom->isa('Bio::EnsEMBL::Compara::Homology'));
00684 
00685   throw("homology object must have dbID")
00686     unless ($hom->dbID);
00687   # We use here internal hash key for _dn and _ds because the dn and ds method call
00688   # do some filtering based on the threshold_on_ds.
00689   unless(defined $hom->{'_dn'} and defined $hom->{'_ds'} and defined $hom->n and defined $hom->lnl and defined $hom->s) {
00690     warn("homology needs valid dn, ds, n, s, and lnl values to store");
00691     return $self;
00692   }
00693 
00694   my $sql = "UPDATE homology SET dn=?, ds=?, n=?, s=?, lnl=?";
00695 
00696   if (defined $hom->threshold_on_ds) {
00697     $sql .= ", threshold_on_ds=?";
00698   }
00699 
00700   $sql .= " WHERE homology_id=?";
00701 
00702   my $sth = $self->prepare($sql);
00703 
00704   if (defined $hom->threshold_on_ds) {
00705     $sth->execute($hom->{'_dn'},$hom->{'_ds'},$hom->n, $hom->s, $hom->lnl, $hom->threshold_on_ds, $hom->dbID);
00706   } else {
00707     $sth->execute($hom->{'_dn'},$hom->{'_ds'},$hom->n, $hom->s, $hom->lnl, $hom->dbID);
00708   }
00709   $sth->finish();
00710 
00711   return $self;
00712 }
00713 
00714 
00715 =head2 fetch_all_orphans_by_GenomeDB
00716 
00717  Arg [1]    : Bio::EnsEMBL::Compara::GenomeDB $genome_db
00718  Example    : $HomologyAdaptor->fetch_all_orphans_by_GenomeDB($genome_db);
00719  Description: fetch the members for a genome_db that have no homologs in the database
00720  Returntype : an array reference of Bio::EnsEMBL::Compara::Member objects
00721  Exceptions : when isa if Arg [1] is not Bio::EnsEMBL::Compara::GenomeDB
00722  Caller     : general
00723 
00724 =cut
00725 
00726 
00727 sub fetch_all_orphans_by_GenomeDB {
00728   my $self = shift;
00729   my $gdb = shift;
00730 
00731   throw("genome_db arg is required\n")
00732     unless ($gdb);
00733 
00734   my $gdb_id = $gdb->dbID;
00735   my $sql = "SELECT m.member_id from member m LEFT JOIN homology_member hm ON m.member_id=hm.member_id WHERE m.source_name='ENSEMBLGENE' AND m.genome_db_id=$gdb_id AND hm.member_id IS NULL";
00736   my $sth = $self->dbc->prepare($sql);
00737   $sth->execute();
00738   my $ma = $self->db->get_MemberAdaptor;
00739   my @members;
00740   while ( my $member_id  = $sth->fetchrow ) {
00741     my $member = $ma->fetch_by_dbID($member_id);
00742     push @members, $member;
00743   }
00744   return \@members;
00745 }
00746 
00747 
00748 1;