Bio::EnsEMBL::Compara::DBSQL NestedSetAdaptor
SummaryIncluded librariesPackage variablesSynopsisDescriptionGeneral documentationMethods
Toolbar
WebCvsRaw content
Summary
NestedSetAdaptor - DESCRIPTION of Object
Package variables
No package variables defined.
Included modules
Bio::EnsEMBL::Compara::NestedSet
Bio::EnsEMBL::DBSQL::BaseAdaptor
Bio::EnsEMBL::Utils::Exception qw ( throw warning deprecate )
Inherit
Bio::EnsEMBL::DBSQL::BaseAdaptor
Synopsis
Description
Methods
DESTROY
No description
Code
_build_tree_from_nodes
No description
Code
_construct_sql_query
No description
Code
_generic_fetchDescriptionCode
cache_add_object
No description
Code
cache_fetch_by_id
No description
Code
clear_cache
No description
Code
columns
No description
Code
create_instance_from_rowhash
No description
Code
default_where_clause
No description
Code
fetch_all_children_for_node
No description
Code
fetch_all_leaves_indexed
No description
Code
fetch_all_roots
No description
Code
fetch_first_shared_ancestor_indexed
No description
Code
fetch_node_by_node_id
No description
Code
fetch_parent_for_node
No description
Code
fetch_root_by_nodeDescriptionCode
fetch_subroot_by_left_right_index
No description
Code
fetch_subtree_under_node
No description
Code
fetch_tree_at_node_id
No description
Code
final_clause
No description
Code
init_instance_from_rowhash
No description
Code
left_join_clause
No description
Code
new
No description
Code
storeDescriptionCode
sync_tree_leftright_index
No description
Code
tables
No description
Code
update
No description
Code
update_subtree
No description
Code
Methods description
_generic_fetchcode    nextTop
  Arg [1]    : (optional) string $constraint
An SQL query constraint (i.e. part of the WHERE clause)
Arg [2] : (optional) string $logic_name
the logic_name of the analysis of the features to obtain
Example : $fts = $a->_generic_fetch('WHERE contig_id in (1234, 1235)', 'Swall');
Description: Performs a database fetch and returns feature objects in
contig coordinates.
Returntype : listref of Bio::EnsEMBL::SeqFeature in contig coordinates
Exceptions : none
Caller : BaseFeatureAdaptor, ProxyDnaAlignFeatureAdaptor::_generic_fetch
fetch_root_by_nodecodeprevnextTop
  Arg [1]    : Bio::EnsEMBL::Compara::NestedSet $node
Example : $root = $nested_set_adaptor->fetch_root_by_node($node);
Description: Returns the root of the tree for this node
with links to all the intermediate nodes. Sister nodes
are not included in the result. Use fetch_node_by_node_id()
method to get the whole tree (loaded on demand)
Returntype : Bio::EnsEMBL::Compara::NestedSet
Exceptions : thrown if $node is not defined
Status : At-risk
Caller : $nested_set->root
storecodeprevnextTop
  Arg [1]    :
Example :
Description:
Returntype :
Exceptions :
Caller :
Methods code
DESTROYdescriptionprevnextTop
sub DESTROY {
  my $self = shift;
  $self->clear_cache;
  $self->SUPER::DESTROY if $self->can("SUPER::DESTROY");
}
_build_tree_from_nodesdescriptionprevnextTop
sub _build_tree_from_nodes {
  my $self = shift;
  my $node_list = shift;

  #first hash all the nodes by id for fast access
my %node_hash; foreach my $node (@{$node_list}) { $node->no_autoload_children; $node_hash{$node->node_id} = $node; } #next add children to their parents
my $root = undef; foreach my $node (@{$node_list}) { my $parent = $node_hash{$node->_parent_id}; if($parent) { $parent->add_child($node); } else { $root = $node; } } return $root; } ###################################
#
# _generic_fetch system
#
#####################################
}
_construct_sql_querydescriptionprevnextTop
sub _construct_sql_query {
  my ($self, $constraint, $join, $final_clause) = @_;

  my @tables = @{$self->tables};
  my $columns = join(', ', @{$self->columns()});
  
  my $default_where = $self->default_where_clause;
  if($default_where) {
    if($constraint) { 
      $constraint .= " AND $default_where ";
    } else {
      $constraint = " WHERE $default_where ";
    }
  }

  if ($join) {
    foreach my $single_join (@{$join}) {
      my ($tablename, $condition, $extracolumns) = @{$single_join};
      if ($tablename && $condition) {
        push @tables, $tablename;
        
        if($constraint) {
          $constraint .= " AND $condition";
        } else {
          $constraint = " WHERE $condition";
        }
      } 
      if ($extracolumns) {
        $columns .= ", " . join(', ', @{$extracolumns});
      }
    }
  }
      
  #construct a nice table string like 'table1 t1, table2 t2'
my $tablenames = join(', ', map({ join(' ', @$_) } @tables)); my $sql = "SELECT $columns FROM $tablenames"; $sql .= " ". $self->left_join_clause; $sql .= " $constraint" if($constraint); #append additional clauses which may have been defined
if (!$final_clause) { $final_clause = $self->final_clause; } $sql .= " $final_clause" if($final_clause); return $sql; } 1;
}
_generic_fetchdescriptionprevnextTop
sub _generic_fetch {
  my ($self, $constraint, $join, $final_clause) = @_;

  my $sql = $self->_construct_sql_query($constraint, $join, $final_clause);

  #print STDERR $sql,"\n";
my $node_list = []; my $sth = $self->prepare($sql); $sth->execute; $node_list = $self->_objs_from_sth($sth); $sth->finish; return $node_list;
}
cache_add_objectdescriptionprevnextTop
sub cache_add_object {
  my $self = shift;
  my $node = shift;

  unshift @{$self->{'_node_cache'}}, $node; #put at front of list 
while(scalar(@{$self->{'_node_cache'}}) > 3000) { my $old = pop @{$self->{'_node_cache'}}; #print("shrinking cache : "); $old->print_node;
} return undef;
}
cache_fetch_by_iddescriptionprevnextTop
sub cache_fetch_by_id {
  my $self = shift;
  my $node_id = shift;
  
  for(my $index=0; $index<scalar(@{$self->{'_node_cache'}}); $index++) {
    my $node = $self->{'_node_cache'}->[$index];
    if($node->node_id == $node_id) {
      splice(@{$self->{'_node_cache'}}, $index, 1); #removes from list
unshift @{$self->{'_node_cache'}}, $node; #put at front of list
return $node; } } return undef;
}
clear_cachedescriptionprevnextTop
sub clear_cache {
  my $self = shift;
  
  $self->{'_node_cache'} = [];
  return undef;
}
columnsdescriptionprevnextTop
sub columns {
  my $self = shift;
  throw("must subclass and provide correct column names");
}
create_instance_from_rowhashdescriptionprevnextTop
sub create_instance_from_rowhash {
  my $self = shift;
  my $rowhash = shift;

  #my $node = $self->cache_fetch_by_id($rowhash->{'node_id'});
#return $node if($node);
my $node = new Bio::EnsEMBL::Compara::NestedSet; $self->init_instance_from_rowhash($node, $rowhash); #$self->cache_add_object($node);
return $node;
}
default_where_clausedescriptionprevnextTop
sub default_where_clause {
  my $self = shift;
  return '';
}
fetch_all_children_for_nodedescriptionprevnextTop
sub fetch_all_children_for_node {
  my ($self, $node) = @_;

  unless($node->isa('Bio::EnsEMBL::Compara::NestedSet')) {
    throw("set arg must be a [Bio::EnsEMBL::Compara::NestedSet] not a $node");
  }

  my $constraint = "WHERE parent_id = " . $node->node_id;
  my $kids = $self->_generic_fetch($constraint);
  foreach my $child (@{$kids}) { $node->add_child($child); }

  return $node;
}
fetch_all_leaves_indexeddescriptionprevnextTop
sub fetch_all_leaves_indexed {
  my ($self, $node) = @_;

  unless($node->isa('Bio::EnsEMBL::Compara::NestedSet')) {
    throw("set arg must be a [Bio::EnsEMBL::Compara::NestedSet] not a $node");
  }

  my $table= $self->tables->[0]->[1];
  my $left_index = $node->left_index;
  my $right_index = $node->right_index;
  my $constraint = "WHERE ($table.right_index - $table.left_index) = 1 AND $table.left_index > $left_index AND $table.right_index < $right_index";
  my @leaves = @{$self->_generic_fetch($constraint)};

  return\@ leaves;
}
fetch_all_rootsdescriptionprevnextTop
sub fetch_all_roots {
  my $self = shift;

  my $constraint = "WHERE root_id = 0";
  return $self->_generic_fetch($constraint);
}
fetch_first_shared_ancestor_indexeddescriptionprevnextTop
sub fetch_first_shared_ancestor_indexed {
  my $self = shift;
  my $node1 = shift;
  my $node2 = shift;

  my $left_node_id1 = $node1->left_index;
  my $left_node_id2 = $node2->left_index;

  my $right_node_id1 = $node1->right_index;
  my $right_node_id2 = $node2->right_index;

  my $min_left;
  $min_left = $left_node_id1 if ($left_node_id1 < $left_node_id2);
  $min_left = $left_node_id2 if ($left_node_id2 < $left_node_id1);

  my $max_right;
  $max_right = $right_node_id1 if ($right_node_id1 > $right_node_id2);
  $max_right = $right_node_id2 if ($right_node_id2 > $right_node_id1);

  my $constraint = "WHERE left_index < $min_left";
  $constraint .= " AND right_index > $max_right";
  $constraint .= " ORDER BY (right_index-left_index) LIMIT 1";

  my $ancestor = $self->_generic_fetch($constraint)->[0];

  return $ancestor;
}
fetch_node_by_node_iddescriptionprevnextTop
sub fetch_node_by_node_id {
  my ($self, $node_id) = @_;

  my $table= $self->tables->[0]->[1];
  my $constraint = "WHERE $table.node_id = $node_id";
  my ($node) = @{$self->_generic_fetch($constraint)};
  return $node;
}
fetch_parent_for_nodedescriptionprevnextTop
sub fetch_parent_for_node {
  my ($self, $node) = @_;

  unless($node->isa('Bio::EnsEMBL::Compara::NestedSet')) {
    throw("set arg must be a [Bio::EnsEMBL::Compara::NestedSet] not a $node");
  }

  my $table= $self->tables->[0]->[1];
  my $constraint = "WHERE $table.node_id = " . $node->_parent_id;
  my ($parent) = @{$self->_generic_fetch($constraint)};
  return $parent;
}
fetch_root_by_nodedescriptionprevnextTop
sub fetch_root_by_node {
  my ($self, $node) = @_;

  unless(UNIVERSAL::isa($node, 'Bio::EnsEMBL::Compara::NestedSet')) {
    throw("set arg must be a [Bio::EnsEMBL::Compara::NestedSet] not a $node");
  }

  my $alias = $self->tables->[0]->[1];

  my $left_index = $node->left_index;
  my $right_index = $node->right_index;

  my $constraint = "WHERE $alias.left_index <= $left_index AND $alias.right_index >= $right_index";
  my $nodes = $self->_generic_fetch($constraint);
  my $root = $self->_build_tree_from_nodes($nodes);

  return $root;
}



###########################
# STORE methods
###########################
}
fetch_subroot_by_left_right_indexdescriptionprevnextTop
sub fetch_subroot_by_left_right_index {
  my ($self,$node) = @_;

  unless ($node->left_index && $node->right_index) {
    warning("fetch_subroot_by_left_right_index subroutine assumes that left and right index has been built and store in the database.\n This does not seem to be the case.\n");
  }
  my $left_index = $node->left_index;
  my $right_index = $node->right_index;

  my $constraint = "WHERE parent_id = root_id";
  $constraint .= " AND left_index<=$left_index";
  $constraint .= " AND right_index>=$right_index";
  return $self->_generic_fetch($constraint)->[0];
}
fetch_subtree_under_nodedescriptionprevnextTop
sub fetch_subtree_under_node {
  my $self = shift;
  my $node = shift;

  unless($node->isa('Bio::EnsEMBL::Compara::NestedSet')) {
    throw("set arg must be a [Bio::EnsEMBL::Compara::NestedSet] not a $node");
  }

  unless ($node->left_index && $node->right_index) {
    warning("fetch_tree_at_node_id subroutine assumes that left and right index has been built and store in the database.\n This does not seem to be the case for node_id=".$node->node_id.". Returning node.\n");
    return $node;
  }

  my $table = $self->tables->[0]->[0];
  my $alias = $self->tables->[0]->[1];

  my $constraint = ", $table AS root_node WHERE $alias.left_index 
                         BETWEEN root_node.left_index AND root_node.right_index
                    AND root_node.node_id=". $node->node_id;

  my $all_nodes = $self->_generic_fetch($constraint);
  push @{$all_nodes}, $node;
  $self->_build_tree_from_nodes($all_nodes);
  return $node;
}
fetch_tree_at_node_iddescriptionprevnextTop
sub fetch_tree_at_node_id {
  my $self = shift;
  my $node_id = shift;

  my $node = $self->fetch_node_by_node_id($node_id);

  unless ($node->left_index && $node->right_index) {
    warning("fetch_tree_at_node_id subroutine assumes that left and right index has been built and store in the database.\n This does not seem to be the case for node_id=$node_id. Using fetch_node_by_node_id instead, and returning node.\n");
    return $node;
  }

  my $table = $self->tables->[0]->[0];
  my $alias = $self->tables->[0]->[1];

  my $constraint = ", $table AS root_node WHERE $alias.left_index 
                         BETWEEN root_node.left_index AND root_node.right_index
                    AND root_node.node_id=". $node_id;

  my $all_nodes = $self->_generic_fetch($constraint);
  my $root = $self->_build_tree_from_nodes($all_nodes);
  return $root;
}
final_clausedescriptionprevnextTop
sub final_clause {
  my $self = shift;
  $self->{'final_clause'} = shift if(@_);
  return $self->{'final_clause'};
}
init_instance_from_rowhashdescriptionprevnextTop
sub init_instance_from_rowhash {
  my $self = shift;
  my $node = shift;
  my $rowhash = shift;

  $node->adaptor($self);
  $node->node_id               ($rowhash->{'node_id'});
  $node->_parent_id            ($rowhash->{'parent_id'});
  $node->_root_id              ($rowhash->{'root_id'});
  $node->left_index            ($rowhash->{'left_index'});
  $node->right_index           ($rowhash->{'right_index'});
  $node->distance_to_parent    ($rowhash->{'distance_to_parent'});
  
  return $node;
}


##################################
#
# INTERNAL METHODS
#
##################################
}
left_join_clausedescriptionprevnextTop
sub left_join_clause {
  return "";
}
newdescriptionprevnextTop
sub new {
  my $class = shift;

  my $self = $class->SUPER::new(@_);
  
  $self->{'_node_cache'} = [];
  return $self;
}
storedescriptionprevnextTop
sub store {
  my ($self, $node) = @_;

  throw("must subclass and provide correct table names");

  unless($node->isa('Bio::EnsEMBL::Compara::NestedSet')) {
    throw("set arg must be a [Bio::EnsEMBL::Compara::NestedSet] not a $node");
  }

  my $sth = $self->prepare("INSERT INTO tree_node (parent_id, name) VALUES (?,?)");
  if(defined($node->parent_node)) {
    $sth->execute($node->parent_node->dbID, $node->name);
  } else {
    $sth->execute(0, $node->name);
  }
  $node->dbID( $sth->{'mysql_insertid'} );
  $node->adaptor($self);
  $sth->finish;

  #
#now recursively do all the children
#
my $children = $node->children_nodes; foreach my $child_node (@$children) { $self->store($child_node); } return $node->dbID;
}
sync_tree_leftright_indexdescriptionprevnextTop
sub sync_tree_leftright_index {
  my $self= shift;
  my $tree_root = shift;

  my $table = $self->tables->[0]->[0];
  
  my $dc = $self->dbc->disconnect_when_inactive;
  $self->dbc->disconnect_when_inactive(0);

  $self->dbc->do("LOCK TABLES $table WRITE");

  my $sql = "SELECT max(right_index) FROM $table;";
  my $sth = $self->dbc->prepare($sql);
  $sth->execute();
  my ($max_counter) = $sth->fetchrow_array();
  $sth->finish;
  
  $tree_root->build_leftright_indexing($max_counter+1);

  $sql = "UPDATE $table SET ".
            "left_index=" . $tree_root->left_index .
            ",right_index=" . $tree_root->right_index .
         " WHERE $table.node_id=". $tree_root->node_id;
  $self->dbc->do($sql);

  $self->dbc->do("UNLOCK TABLES");
  $self->dbc->disconnect_when_inactive($dc);

  return undef;
}


##################################
#
# Database related methods, sublcass overrides/inherits
#
##################################
}
tablesdescriptionprevnextTop
sub tables {
  my $self = shift;
  throw("must subclass and provide correct table names");
}
updatedescriptionprevnextTop
sub update {
  my ($self, $node) = @_;

  unless(UNIVERSAL::isa($node, 'Bio::EnsEMBL::Compara::NestedSet')) {
    throw("set arg must be a [Bio::EnsEMBL::Compara::NestedSet] not a $node");
  }

  my $parent_id = 0;
  if($node->parent) {
    $parent_id = $node->parent->node_id ;
  }
  my $root_id = $node->root->node_id;

 my $table= $self->tables->[0]->[0];
  my $sql = "UPDATE $table SET ".
               "parent_id=$parent_id".
               ",root_id=$root_id".
               ",left_index=" . $node->left_index .
               ",right_index=" . $node->right_index .
               ",distance_to_parent=" . $node->distance_to_parent .
             " WHERE $table.node_id=". $node->node_id;

  $self->dbc->do($sql);
}
update_subtreedescriptionprevnextTop
sub update_subtree {
  my $self = shift;
  my $node = shift;

  $self->update($node);

  foreach my $child (@{$node->children}) {
    $self->update_subtree($child);
  }
}
General documentation
CONTACTTop
  Contact Jessica Severin on implemetation/design detail: jessica@ebi.ac.uk
Contact Ewan Birney on EnsEMBL in general: birney@sanger.ac.uk
APPENDIXTop
The rest of the documentation details each of the object methods. Internal methods are usually preceded with a _