lib/Bio/DB/BioSQL/Pg/PathAdaptorDriver.pm

   1 # $Id$
   2 #
   3 # BioPerl module for Bio::DB::BioSQL::Pg::PathAdaptorDriver
   4 #
   5 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   6 #
   7 # Cared for by Hilmar Lapp <hlapp at gmx.net>
   8 #
   9 # Copyright Hilmar Lapp
  10 #
  11
  12 #
  13 # (c) Hilmar Lapp, hlapp at gmx.net, 2003.
  14 # (c) GNF, Genomics Institute of the Novartis Research Foundation, 2003.
  15 #
  16 # You may distribute this module under the same terms as perl itself.
  17 # Refer to the Perl Artistic License (see the license accompanying this
  18 # software package, or see http://www.perl.com/language/misc/Artistic.html)
  19 # for the terms under which you may use, modify, and redistribute this module.
  20 #
  21 # THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
  22 # WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
  23 # MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
  24 #
  25
  26 # POD documentation - main docs before the code
  27
  28 =head1 NAME
  29
  30 Bio::DB::BioSQL::Pg::PathAdaptorDriver - DESCRIPTION of Object
  31
  32 =head1 SYNOPSIS
  33
  34 Give standard usage here
  35
  36 =head1 DESCRIPTION
  37
  38 Describe the object here
  39
  40 =head1 FEEDBACK
  41
  42 =head2 Mailing Lists
  43
  44 User feedback is an integral part of the evolution of this and other
  45 Bioperl modules. Send your comments and suggestions preferably to
  46 the Bioperl mailing list.  Your participation is much appreciated.
  47
  48   bioperl-l@bioperl.org                  - General discussion
  49   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  50
  51 =head2 Support
  52
  53 Please direct usage questions or support issues to the mailing list:
  54
  55 I<bioperl-l@bioperl.org>
  56
  57 rather than to the module maintainer directly. Many experienced and
  58 reponsive experts will be able look at the problem and quickly
  59 address it. Please include a thorough description of the problem
  60 with code and data examples if at all possible.
  61
  62 =head2 Reporting Bugs
  63
  64 Report bugs to the Bioperl bug tracking system to help us keep track
  65 of the bugs and their resolution. Bug reports can be submitted via
  66 the web:
  67
  68   http://redmine.open-bio.org/projects/bioperl/
  69
  70 =head1 AUTHOR - Hilmar Lapp
  71
  72 Email hlapp at gmx.net
  73
  74 =head1 CONTRIBUTORS
  75
  76 Additional contributors names and emails here
  77
  78 =head1 APPENDIX
  79
  80 The rest of the documentation details each of the object methods.
  81 Internal methods are usually preceded with a _
  82
  83 =cut
  84
  85
  86 # Let the code begin...
  87
  88
  89 package Bio::DB::BioSQL::Pg::PathAdaptorDriver;
  90 use vars qw(@ISA);
  91 use strict;
  92
  93 # Object preamble - inherits from Bio::Root::Root
  94
  95 use Bio::DB::BioSQL::Pg::BasePersistenceAdaptorDriver;
  96
  97
  98 @ISA = qw(Bio::DB::BioSQL::Pg::BasePersistenceAdaptorDriver);
  99
 100
 101 =head2 compute_transitive_closure
 102
 103  Title   : compute_transitive_closure
 104  Usage   :
 105  Function: Compute the transitive closure over a given ontology
 106            and populate the respective path table in the relational
 107            schema.
 108
 109  Example :
 110  Returns : TRUE on success, and FALSE otherwise
 111  Args    : The calling adaptor.
 112
 113            The ontology to compute the transitive closure over (a
 114            persistent Bio::Ontology::OntologyI compliant object).
 115
 116            The predicate indicating identity between a term and
 117            itself, to be used as the predicate for the paths of
 118            distance zero between a term and itself. If undef the zero
 119            distance paths will not be created.
 120
 121            A scalar that if evaluating to TRUE means truncate the
 122            paths for the respective ontology first (optional;
 123            even though the default is FALSE this parameter should
 124            usually be given as TRUE unless you know what you are
 125            doing).
 126
 127
 128 =cut
 129
 130 sub compute_transitive_closure{
 131     my ($self,$adp,$ont,$idpred,$trunc) = @_;
 132
 133     # if we only got three arguments and the third is not a term then we
 134     # probably got called in the old signature
 135     if ((! ref($idpred)) && (@_ == 4)) {
 136         $trunc = $idpred;
 137         $idpred = undef;
 138     }
 139
 140     # the ontology needs to be persistent (we'll need its primary key)
 141     if(! $ont->isa("Bio::DB::PersistentObjectI")) {
 142         $self->throw("$ont is not a persistent object. Bummer.");
 143     }
 144     # and obviously needs to have a primary key
 145     if(! ($ont->primary_key ||
 146           ($ont = $ont->adaptor->find_by_unique_key($ont)) ||
 147           ($ont = $ont->adaptor->create($ont)))) {
 148         $self->throw("failed to look-up or insert ontology \"".
 149                      $ont->name().", can't continue without the foreign key");
 150     }
 151
 152     # the identity predicate needs to be persistent too, if given
 153     if (ref($idpred)) {
 154         if(! $idpred->isa("Bio::DB::PersistentObjectI")) {
 155             $idpred = $adp->db->create_persistent($idpred);
 156         }
 157         # and obviously needs to have a primary key as well
 158         if(! ($idpred->primary_key ||
 159               ($idpred = ($idpred->adaptor->find_by_unique_key($idpred) ||
 160                           $idpred->adaptor->create($idpred))))) {
 161             $self->throw("failed to look-up or insert ID predicate '".
 162                          $idpred->name()
 163                          ."', can't continue without the foreign key");
 164         }
 165     }
 166
 167     # we'll need the name of the path table, and that of the relationship
 168     # table
 169     my $path_table = $self->table_name($adp);
 170     my $rel_table  = $self->table_name("Bio::Ontology::RelationshipI");
 171     # truncate existing path table content?
 172     if($trunc) {
 173         my $sth = $self->prepare_delete_query_sth($adp, -fkobjs => [$ont]);
 174         $adp->debug("DELETE $path_table: execute, binding column 1 to ".
 175                     $ont->primary_key().
 176                     " (PK to ".ref($ont->obj).")\n");
 177         my $rv = $sth->execute($ont->primary_key());
 178         if(! $rv) {
 179             $self->throw("failed to execute DELETE $path_table statement ".
 180                          "(bound PK ".$ont->primary_key()."): ".
 181                          $sth->errstr);
 182         }
 183         $adp->debug("DELETE $path_table: deleted $rv rows\n");
 184     }
 185     # initialize the path table with all relationships under the ontology.
 186     #
 187     # for this we need to map a number of objects to foreign keys, so gather
 188     # keys, and obtain an attribute map
 189     my $termcl = "Bio::Ontology::TermI";
 190     my @fks = map {
 191         $self->foreign_key_name($_);
 192     } ($termcl."::subject", $termcl."::predicate", $termcl."::object", $ont);
 193     my $colmap = $self->slot_attribute_map($path_table);
 194
 195     # initialize with paths of distance zero between all non-predicate
 196     # terms and themselves if the identity predicate was provided
 197     if (ref($idpred)) {
 198         my $term_table = $self->table_name($termcl);
 199         my $pkname = $self->primary_key_name($term_table);
 200         my $ontfkname = $self->foreign_key_name($ont);
 201         my $sql = "INSERT INTO $path_table ("
 202             . join(", ", @fks, $colmap->{"distance"}).")\n"
 203             . "SELECT $pkname, ".$idpred->primary_key
 204             . ", $pkname, $ontfkname, 0\n"
 205             . "FROM $term_table t WHERE $ontfkname = ?\n"
 206             . "AND NOT EXISTS (\n"
 207             . "SELECT 1 FROM $rel_table ta WHERE ta."
 208             . $self->foreign_key_name($termcl."::predicate")." = t.$pkname "
 209             . "AND ta.$ontfkname = t.$ontfkname)";
 210         $adp->debug("INSERT TC ONTOLOGY #0: preparing: $sql\n");
 211         my $sth = $adp->dbh->prepare($sql);
 212         $self->throw("failed to prepare statement ($sql): ".$adp->dbh->errstr)
 213             unless $sth;
 214         $adp->debug("INSERT TC ONTOLOGY #0: executing: binding column 1 to ",
 215                     $ont->primary_key(),
 216                     " (FK to ".ref($ont->obj).")\n");
 217         my $rv = $sth->execute($ont->primary_key());
 218         if($rv) {
 219             $adp->debug("INSERT TC ONTOLOGY #0: $rv rows inserted\n");
 220         } else {
 221             $self->throw("failed to execute statement ($sql) with parameter ".
 222                          $ont->primary_key()." (FK to ".ref($ont->obj)."): ".
 223                          $sth->errstr);
 224         }
 225     }
 226
 227     # now the distance one paths as the relationships in the
 228     # Term_Relationship table
 229     my $sql = "INSERT INTO $path_table (".
 230         join(", ", @fks, $colmap->{"distance"}).")\n".
 231         "SELECT ".
 232         join(", ", @fks, "1")."\n".
 233         "FROM $rel_table WHERE ".$self->foreign_key_name($ont)." = ?";
 234     $adp->debug("INSERT TC ONTOLOGY #1: preparing: $sql\n");
 235     my $sth = $adp->dbh->prepare($sql);
 236     $self->throw("failed to prepare statement ($sql): ".$adp->dbh->errstr)
 237         unless $sth;
 238     $adp->debug("INSERT TC ONTOLOGY #1: executing: binding column 1 to ",
 239                 $ont->primary_key(),
 240                 " (FK to ".ref($ont->obj).")\n");
 241     my $rv = $sth->execute($ont->primary_key());
 242     if($rv) {
 243         $adp->debug("INSERT TC ONTOLOGY #1: executed, $rv rows inserted\n");
 244     } else {
 245         $self->throw("failed to execute statement ($sql) with parameter ".
 246                      $ont->primary_key()." (FK to ".ref($ont->obj)."): ".
 247                      $sth->errstr);
 248     }
 249     # now build the transitive closure in a loop
 250     $sql = "INSERT INTO $path_table (".
 251         join(", ", @fks, $colmap->{"distance"}).")\n".
 252         "SELECT DISTINCT ".
 253         join(", ",
 254              "tr.".$colmap->{"subject"}, "trp1.".$colmap->{"object"},
 255              "tp.".$colmap->{"object"}, "tr.".$colmap->{"ontology"},
 256              "tp.".$colmap->{"distance"}."+1")."\n".
 257         "FROM ".
 258         join(", ",
 259              "$rel_table tr", "$path_table tp",
 260              "$rel_table trp1", "$rel_table trp2")."\n".
 261         "WHERE ".
 262         join("\nAND ",
 263              "tp.".$colmap->{"ontology"}." = tr.".$colmap->{"ontology"},
 264              "tr.".$colmap->{"object"}." = tp.".$colmap->{"subject"},
 265              "tr.".$colmap->{"ontology"}." = ?",
 266              "tp.".$colmap->{"distance"}." = ?",
 267              "trp1.".$colmap->{"subject"}." = tp.".$colmap->{"predicate"},
 268              "trp2.".$colmap->{"subject"}." = tr.".$colmap->{"predicate"},
 269              "trp1.".$colmap->{"object"}." = trp2.".$colmap->{"object"});
 270     $adp->debug("INSERT TC ONTOLOGY #2: preparing: $sql\n");
 271     $sth = $adp->dbh->prepare($sql);
 272     $self->throw("failed to prepare statement ($sql): ".$adp->dbh->errstr)
 273         unless $sth;
 274     my $dist = 0;
 275     $rv = 1; # dummy value in order to enter the while loop at least once
 276     while($rv && ($rv > 0)) {
 277         $dist++;
 278         if($adp->verbose) {
 279             $adp->debug("INSERT TC ONTOLOGY #2: executing: ".
 280                         "binding columns (".
 281                         join(";", "FK to ".ref($ont->obj), "distance").
 282                         ") to (".
 283                         join(";", $ont->primary_key(), $dist).
 284                         ")\n");
 285         }
 286         $rv = $sth->execute($ont->primary_key(), $dist);
 287         $adp->debug("INSERT TC ONTOLOGY #2: executed, $rv rows inserted\n")
 288             if $rv;
 289     }
 290     if(! $rv) {
 291         $self->throw("failed to execute statement ($sql) with parameters (".
 292                      join(";", $ont->primary_key(), $dist).
 293                      "): ".$sth->errstr);
 294     }
 295     # done.
 296     return $rv;
 297 }
 298
 299 1;