Raw content of Bio::EnsEMBL::Compara::DBSQL::ConstrainedElementAdaptor
<![CDATA[package Bio::EnsEMBL::Compara::DBSQL::ConstrainedElementAdaptor;
use vars qw(@ISA);
use strict;
use Bio::EnsEMBL::DBSQL::BaseAdaptor;
use Bio::EnsEMBL::Compara::ConstrainedElement;
use Bio::EnsEMBL::Compara::DnaFrag;
use Bio::EnsEMBL::Utils::Exception;
use Data::Dumper;
@ISA = qw(Bio::EnsEMBL::DBSQL::BaseAdaptor);
sub new {
my $class = shift;
my $self = $class->SUPER::new(@_);
$self->{_use_autoincrement} = 0;
return $self;
}
=head2 store
Arg 1 : Bio::EnsEMBL::Compara::MethodLinkSpeciesSet object
Arg 2 : listref of Bio::EnsEMBL::Compara::ConstrainedElement ($constrained_element) objects
The things you want to store
Example : none
Description: It stores the given ConstrainedElements in the database.
Returntype : none
Exceptions : throw if Arg-1 is not a Bio::EnsEMBL::Compara::MethodLinkSpeciesSet object
throw if Arg-2 is not a Bio::EnsEMBL::Compara::ConstrainedElement
Caller : called by the Bio::EnsEMBL::Compara::Production::GenomicAlignBlock::Gerp module
=cut
sub store {
my ( $self, $mlss_obj, $constrained_elements ) = @_;
if (defined($mlss_obj)) {
throw("$mlss_obj is not a Bio::EnsEMBL::Compara::MethodLinkSpeciesSet object")
unless ($mlss_obj->isa("Bio::EnsEMBL::Compara::MethodLinkSpeciesSet"));
} else {
throw("undefined Bio::EnsEMBL::Compara::MethodLinkSpeciesSet object");
}
my $mlssid = $mlss_obj->dbID;
my $mlssid_sql =
"SELECT MAX(constrained_element_id) FROM constrained_element WHERE" .
" constrained_element_id > " . $mlssid .
"0000000000 AND constrained_element_id < " .
($mlssid + 1) . "0000000000";
my $mlssid_sth = $self->prepare($mlssid_sql);
my $constrained_element_sql = qq{INSERT INTO constrained_element (
constrained_element_id,
dnafrag_id,
dnafrag_start,
dnafrag_end,
score,
method_link_species_set_id,
p_value,
taxonomic_level
) VALUES (?,?,?,?,?,?,?,?)};
my $constrained_element_sth = $self->prepare($constrained_element_sql) or die;
##lock table
$self->dbc->do(qq{ LOCK TABLES constrained_element WRITE });
foreach my $constrained_element_group (@$constrained_elements) {
$mlssid_sth->execute();
my $constrained_element_id = ($mlssid_sth->fetchrow_array() or
($mlssid * 10000000000)) + 1;
foreach my $constrained_element (@{$constrained_element_group}) {
throw("$constrained_element is not a Bio::EnsEMBL::Compara::ConstrainedElement object")
unless ($constrained_element->isa("Bio::EnsEMBL::Compara::ConstrainedElement"));
$constrained_element_sth->execute(
$constrained_element_id,
$constrained_element->reference_dnafrag_id,
$constrained_element->start,
$constrained_element->end,
$constrained_element->score,
$mlssid,
($constrained_element->p_value or undef),
($constrained_element->taxonomic_level or undef)
);
}
}
## Unlock tables
$self->dbc->do("UNLOCK TABLES");
}
=head2 delete_by_MethodLinkSpeciesSet
Arg 1 : method_link_species_set object $mlss
Example : $constrained_element_adaptor->delete_by_MethodLinkSpeciesSet($mlss);
Description: It removes constrained elements with the specified method_link_species_set_id from the database
Returntype : none
Exceptions : throw if passed parameter is not a Bio::EnsEMBL::Compara::MethodLinkSpeciesSet object
Caller : general
=cut
sub delete_by_MethodLinkSpeciesSet {
my ($self, $mlss_obj) = @_;
if (defined($mlss_obj)) {
throw("$mlss_obj is not a Bio::EnsEMBL::Compara::MethodLinkSpeciesSet object")
unless ($mlss_obj->isa("Bio::EnsEMBL::Compara::MethodLinkSpeciesSet"));
} else {
throw("undefined Bio::EnsEMBL::Compara::MethodLinkSpeciesSet object");
}
my $cons_ele_sql =
qq{DELETE FROM constrained_element WHERE method_link_species_set_id = ?};
# Delete constrtained element entries by mlss_id
my $sth = $self->prepare($cons_ele_sql);
$sth->execute($mlss_obj->dbID);
}
=head2 fetch_all_by_MethodLinkSpeciesSet_Slice
Arg 1 : Bio::EnsEMBL::Compara::MethodLinkSpeciesSet $mlss_obj
Arg 2 : Bio::EnsEMBL::Slice $slice_obj
Example : my $listref_of_constrained_elements = $constrained_element_adaptor->
fetch_all_by_MethodLinkSpeciesSet_Slice($mlss_obj, $slice_obj);
Description: Retrieve the corresponding
Bio::EnsEMBL::Compara::ConstrainedElement object listref
Returntype : listref of Bio::EnsEMBL::Compara::ConstrainedElement objects
Exceptions : throw if Arg-1 is not a Bio::EnsEMBL::Compara::MethodLinkSpeciesSet object
throw if Arg-2 is not a Bio::EnsEMBL::Slice object
Caller : object::methodname
=cut
sub fetch_all_by_MethodLinkSpeciesSet_Slice {
my ($self, $mlss_obj, $slice_obj) = @_;
if (defined($mlss_obj)) {
throw("$mlss_obj is not a Bio::EnsEMBL::Compara::MethodLinkSpeciesSet object")
unless ($mlss_obj->isa("Bio::EnsEMBL::Compara::MethodLinkSpeciesSet"));
} else {
throw("undefined Bio::EnsEMBL::Compara::MethodLinkSpeciesSet object");
}
if (defined($slice_obj)) {
throw("$slice_obj is not a Bio::EnsEMBL::Slice object")
unless ($slice_obj->isa("Bio::EnsEMBL::Slice"));
} else {
throw("undefined Bio::EnsEMBL::Slice object");
}
my $dnafrag_adp = $self->db->get_DnaFragAdaptor;
my $dnafrag = $dnafrag_adp->fetch_by_Slice($slice_obj);
my $sql = qq{
WHERE
method_link_species_set_id = ?
AND
dnafrag_id = ?
};
my (@constrained_elements, $lower_bound);
if(defined($slice_obj->start) && defined($slice_obj->end) &&
($slice_obj->start <= $slice_obj->end)) {
my $max_alignment_length = $mlss_obj->max_alignment_length;
$lower_bound = $slice_obj->start - $max_alignment_length;
$sql .= qq{
AND
dnafrag_end >= ?
AND
dnafrag_start <= ?
AND
dnafrag_start >= ?
};
}
$self->_fetch_all_ConstrainedElements($sql, \@constrained_elements,
$mlss_obj->dbID, $dnafrag->dbID, $slice_obj->start, $slice_obj->end, $lower_bound, $slice_obj);
return \@constrained_elements;
}
=head2 fetch_all_by_MethodLinkSpeciesSet_Dnafrag
Arg 1 : Bio::EnsEMBL::Compara::MethodLinkSpeciesSet mlss_obj
Arg 2 : Bio::EnsEMBL::Compara::DnaFrag dnafrag_obj
Example : my $listref_of_constrained_elements = $constrained_element_adaptor->
fetch_all_by_MethodLinkSpeciesSet_Dnafrag($mlss_obj, $dnafrag_obj);
Description: Retrieve the corresponding
Bio::EnsEMBL::Compara::ConstrainedElement object listref
Returntype : listref of Bio::EnsEMBL::Compara::ConstrainedElement objects
Exceptions : throw if Arg-1 is not a Bio::EnsEMBL::Compara::MethodLinkSpeciesSet mlss_obj object
throw if Arg-2 is not a Bio::EnsEMBL::Compara::DnaFrag object
Caller : object::methodname
=cut
sub fetch_all_by_MethodLinkSpeciesSet_Dnafrag {
my ($self, $mlss_obj, $dnafrag_obj, $dnafrag_start, $dnafrag_end) = @_;
if (defined($mlss_obj)) {
throw("$mlss_obj is not a Bio::EnsEMBL::Compara::MethodLinkSpeciesSet object")
unless ($mlss_obj->isa("Bio::EnsEMBL::Compara::MethodLinkSpeciesSet"));
} else {
throw("undefined Bio::EnsEMBL::Compara::MethodLinkSpeciesSet object");
}
if(defined($dnafrag_obj)) {
throw("$dnafrag_obj is not a Bio::EnsEMBL::Compara::DnaFrag object")
unless ($dnafrag_obj->isa("Bio::EnsEMBL::Compara::DnaFrag"));
} else {
throw("undefined Bio::EnsEMBL::Compara::DnaFrag object");
}
my (@constrained_elements, $lower_bound);
my $sql = qq{
WHERE
method_link_species_set_id = ?
AND
dnafrag_id = ?
};
if (defined($dnafrag_start) && defined($dnafrag_end) && ($dnafrag_start <= $dnafrag_end)) {
my $max_alignment_length = $mlss_obj->max_alignment_length;
$lower_bound = $dnafrag_start - $max_alignment_length;
} else {
$dnafrag_start = 1;
$dnafrag_end = $dnafrag_obj->length;
$lower_bound = $dnafrag_start;
}
$sql .= qq{
AND
dnafrag_end >= ?
AND
dnafrag_start <= ?
AND
dnafrag_start >= ?
};
$self->_fetch_all_ConstrainedElements($sql, \@constrained_elements,
$mlss_obj->dbID, $dnafrag_obj->dbID, $dnafrag_start, $dnafrag_end, $lower_bound);
return \@constrained_elements;
}
sub _fetch_all_ConstrainedElements {#used when getting constrained elements by slice or dnafrag
my ($self) = shift;
my ($sql, $constrained_elements, $mlss_id, $dnafrag_id, $start, $end, $lower_bound, $slice) = @_;
$sql = qq{
SELECT
constrained_element_id,
dnafrag_start,
dnafrag_end,
score,
p_value,
taxonomic_level
FROM
constrained_element} . $sql;
my $sth = $self->prepare($sql);
$sth->execute($mlss_id, $dnafrag_id, $start, $end, $lower_bound);
my ($dbID, $ce_start, $ce_end, $score, $p_value, $tax_level);
$sth->bind_columns(\$dbID, \$ce_start, \$ce_end, \$score, \$p_value, \$tax_level);
while ($sth->fetch()) {
my $constrained_element = Bio::EnsEMBL::Compara::ConstrainedElement->new_fast (
{
'adaptor' => $self,
'dbID' => $dbID,
'slice' => $slice,
'start' => ($ce_start - $start + 1),
'end' => ($ce_end - $start + 1),
'method_link_species_set_id' => $mlss_id,
'score' => $score,
'p_value' => $p_value,
'taxonomic_level' => $tax_level,
'reference_dnafrag_id' => $dnafrag_id,
}
);
push(@$constrained_elements, $constrained_element);
}
}
=head2 fetch_all_by_dbID
Arg 1 : listref of constrained_element_ids
Example : my $listref_of_constrained_elements = $constrained_element_adaptor->fetch_all_by_dbID($list_ref_of_constrained_element_ids);
Description: Retrieve the corresponding constrained_elements from a given list of constrained_element_ids
Returntype : listref of Bio::EnsEMBL::Compara::ConstrainedElement constrained_elements
Exceptions : throw if Arg-1 is not a listref
Caller : object::methodname
=cut
sub fetch_all_by_dbID {
my ($self, $constrained_element_ids) = @_;
if(defined($constrained_element_ids)) {
throw("Arg-1 needs to be a listref of dbIDs") unless (
ref($constrained_element_ids) eq "ARRAY");
}
my @constrained_elements;
my $sql = qq{
WHERE
ce.constrained_element_id = ?
};
$self->_fetch_all_ConstrainedElements_by_dbID($sql, \@constrained_elements, $constrained_element_ids);
return \@constrained_elements;
}
=head2 fetch_by_dbID
Arg 1 : int constrained_element_id
Example : my $constrained_element = $constrained_element_adaptor->
fetch_by_dbID($constrained_element_id);
Description: Retrieve the corresponding constrained_element.
Returntype : Bio::EnsEMBL::Compara::ConstrainedElement object
Exceptions : -none-
Caller : object::methodname
=cut
sub fetch_by_dbID {
my ($self, $constrained_element_id) = @_;
return ($self->fetch_all_by_dbID([$constrained_element_id]))->[0];
}
sub _fetch_all_ConstrainedElements_by_dbID {#used when getting constrained elements by constrained_element_id
my ($self) = shift;
my ($sql, $constrained_elements, $dbIDs) = @_;
$sql = qq{
SELECT
ce.constrained_element_id,
ce.dnafrag_id,
ce.dnafrag_start,
ce.dnafrag_end,
ce.method_link_species_set_id,
ce.score,
ce.p_value,
ce.taxonomic_level,
gdb.name,
df.name
FROM
constrained_element ce
INNER JOIN
dnafrag df
ON
df.dnafrag_id = ce.dnafrag_id
INNER JOIN
genome_db gdb
ON
gdb.genome_db_id = df.genome_db_id} . $sql;
my $sth = $self->prepare($sql);
foreach my $constrained_element_id (@{ $dbIDs }) {
my (%general_attributes, @alignment_segments);
$sth->execute( $constrained_element_id );
my ($dbID, $dnafrag_id, $ce_start, $ce_end, $mlssid, $score, $p_value, $tax_level, $species_name, $dnafrag_name);
$sth->bind_columns(\$dbID, \$dnafrag_id, \$ce_start, \$ce_end, \$mlssid,
\$score, \$p_value, \$tax_level, \$species_name, \$dnafrag_name);
while ($sth->fetch()) {
$general_attributes{dbID} = $dbID;
$general_attributes{mlssid} = $mlssid;
$general_attributes{score} = $score;
$general_attributes{p_value} = $p_value;
$general_attributes{taxonomic_level} = $tax_level;
push(@alignment_segments, [ $dnafrag_id, $ce_start, $ce_end, $species_name, $dnafrag_name ]);
}
my $constrained_element = Bio::EnsEMBL::Compara::ConstrainedElement->new_fast (
{
'adaptor' => $self,
'dbID' => $general_attributes{dbID},
'alignment_segments' => \@alignment_segments,
'method_link_species_set_id' => $general_attributes{mlssid},
'score' => $general_attributes{score},
'p_value' => $general_attributes{p_value},
'taxonomic_level' => $general_attributes{taxonomic_level},
}
);
push(@$constrained_elements, $constrained_element);
}
}
1;
]]>