Mercurial > repos > mahtabm > ensembl
diff variant_effect_predictor/Bio/EnsEMBL/DBSQL/ArchiveStableIdAdaptor.pm @ 0:1f6dce3d34e0
Uploaded
| author | mahtabm |
|---|---|
| date | Thu, 11 Apr 2013 02:01:53 -0400 |
| parents | |
| children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/variant_effect_predictor/Bio/EnsEMBL/DBSQL/ArchiveStableIdAdaptor.pm Thu Apr 11 02:01:53 2013 -0400 @@ -0,0 +1,1513 @@ +=head1 LICENSE + + Copyright (c) 1999-2012 The European Bioinformatics Institute and + Genome Research Limited. All rights reserved. + + This software is distributed under a modified Apache license. + For license details, please see + + http://www.ensembl.org/info/about/code_licence.html + +=head1 CONTACT + + Please email comments or questions to the public Ensembl + developers list at <dev@ensembl.org>. + + Questions may also be sent to the Ensembl help desk at + <helpdesk@ensembl.org>. + +=cut + +=head1 NAME + +Bio::EnsEMBL::ArchiveStableIdAdaptor + +=head1 SYNOPSIS + + my $registry = "Bio::EnsEMBL::Registry"; + + my $archiveStableIdAdaptor = + $registry->get_adaptor( 'Human', 'Core', 'ArchiveStableId' ); + + my $stable_id = 'ENSG00000068990'; + + my $arch_id = $archiveStableIdAdaptor->fetch_by_stable_id($stable_id); + + print("Latest incarnation of this stable ID:\n"); + printf( " Stable ID: %s.%d\n", + $arch_id->stable_id(), $arch_id->version() ); + print(" Release: " + . $arch_id->release() . " (" + . $arch_id->assembly() . ", " + . $arch_id->db_name() + . ")\n" ); + + print "\nStable ID history:\n\n"; + + my $history = + $archiveStableIdAdaptor->fetch_history_tree_by_stable_id( + $stable_id); + + foreach my $a ( @{ $history->get_all_ArchiveStableIds } ) { + printf( " Stable ID: %s.%d\n", $a->stable_id(), $a->version() ); + print(" Release: " + . $a->release() . " (" + . $a->assembly() . ", " + . $a->db_name() + . ")\n\n" ); + } + +=head1 DESCRIPTION + +ArchiveStableIdAdaptor does all SQL to create ArchiveStableIds and works +of + + stable_id_event + mapping_session + peptite_archive + gene_archive + +tables inside the core database. + +This whole module has a status of At Risk as it is under development. + +=head1 METHODS + + fetch_by_stable_id + fetch_by_stable_id_version + fetch_by_stable_id_dbname + fetch_all_by_archive_id + fetch_predecessors_by_archive_id + fetch_successors_by_archive_id + fetch_history_tree_by_stable_id + add_all_current_to_history + list_dbnames + previous_dbname + next_dbname + get_peptide + get_current_release + get_current_assembly + +=head1 RELATED MODULES + + Bio::EnsEMBL::ArchiveStableId + Bio::EnsEMBL::StableIdEvent + Bio::EnsEMBL::StableIdHistoryTree + +=head1 METHODS + +=cut + +package Bio::EnsEMBL::DBSQL::ArchiveStableIdAdaptor; + +use strict; +use warnings; +no warnings qw(uninitialized); + +use Bio::EnsEMBL::DBSQL::BaseAdaptor; +our @ISA = qw(Bio::EnsEMBL::DBSQL::BaseAdaptor); + +use Bio::EnsEMBL::ArchiveStableId; +use Bio::EnsEMBL::StableIdEvent; +use Bio::EnsEMBL::StableIdHistoryTree; +use Bio::EnsEMBL::Utils::Exception qw(deprecate warning throw); + +use constant MAX_ROWS => 30; +use constant NUM_HIGH_SCORERS => 20; + + +=head2 fetch_by_stable_id + + Arg [1] : string $stable_id + Arg [2] : (optional) string $type + Example : none + Description : Retrives an ArchiveStableId that is the latest incarnation of + given stable_id. + Returntype : Bio::EnsEMBL::ArchiveStableId or undef if not in database + Exceptions : none + Caller : general + Status : At Risk + : under development + +=cut + +sub fetch_by_stable_id { + my $self = shift; + my $stable_id = shift; + + my $arch_id = Bio::EnsEMBL::ArchiveStableId->new( + -stable_id => $stable_id, + -adaptor => $self + ); + + @_ ? $arch_id->type(shift) : $self->_resolve_type($arch_id); + + if ($self->lookup_current($arch_id)) { + + # stable ID is in current release + $arch_id->version($arch_id->current_version); + $arch_id->db_name($self->dbc->dbname); + $arch_id->release($self->get_current_release); + $arch_id->assembly($self->get_current_assembly); + + } else { + + # look for latest version of this stable id + my $extra_sql = defined($arch_id->{'type'}) ? + " AND sie.type = '@{[lc($arch_id->{'type'})]}'" : ''; + + my $r = $self->_fetch_archive_id($stable_id, $extra_sql, $extra_sql); + + if ($r->{'new_stable_id'} and $r->{'new_stable_id'} eq $stable_id) { + # latest event is a self event, use new_* data + $arch_id->version($r->{'new_version'}); + $arch_id->release($r->{'new_release'}); + $arch_id->assembly($r->{'new_assembly'}); + $arch_id->db_name($r->{'new_db_name'}); + } else { + # latest event is a deletion event (or mapping to other ID; this clause + # is only used to cope with buggy data where deletion events are + # missing), use old_* data + $arch_id->version($r->{'old_version'}); + $arch_id->release($r->{'old_release'}); + $arch_id->assembly($r->{'old_assembly'}); + $arch_id->db_name($r->{'old_db_name'}); + } + + $arch_id->type(ucfirst(lc($r->{'type'}))); + } + + if (! defined $arch_id->db_name) { + # couldn't find stable ID in archive or current db + return undef; + } + + $arch_id->is_latest(1); + + return $arch_id; +} + + +=head2 fetch_by_stable_id_version + + Arg [1] : string $stable_id + Arg [2] : int $version + Example : none + Description : Retrieve an ArchiveStableId with given version and stable ID. + Returntype : Bio::EnsEMBL::ArchiveStableId + Exceptions : none + Caller : general + Status : At Risk + : under development + +=cut + +sub fetch_by_stable_id_version { + my $self = shift; + my $stable_id = shift; + my $version = shift; + + my $arch_id = Bio::EnsEMBL::ArchiveStableId->new( + -stable_id => $stable_id, + -version => $version, + -adaptor => $self + ); + + @_ ? $arch_id->type(shift) : $self->_resolve_type($arch_id); + + if ($self->lookup_current($arch_id) && $arch_id->is_current) { + + # this version is the current one + $arch_id->db_name($self->dbc->dbname); + $arch_id->release($self->get_current_release); + $arch_id->assembly($self->get_current_assembly); + + } else { + + # find latest release this stable ID version is found in archive + my $extra_sql1 = qq(AND sie.old_version = "$version"); + my $extra_sql2 = qq(AND sie.new_version = "$version"); + my $r = $self->_fetch_archive_id($stable_id, $extra_sql1, $extra_sql2); + + if ($r->{'new_stable_id'} and $r->{'new_stable_id'} eq $stable_id + and $r->{'new_version'} == $version) { + # latest event is a self event, use new_* data + $arch_id->release($r->{'new_release'}); + $arch_id->assembly($r->{'new_assembly'}); + $arch_id->db_name($r->{'new_db_name'}); + } else { + # latest event is a deletion event (or mapping to other ID; this clause + # is only used to cope with buggy data where deletion events are + # missing), use old_* data + $arch_id->release($r->{'old_release'}); + $arch_id->assembly($r->{'old_assembly'}); + $arch_id->db_name($r->{'old_db_name'}); + } + + $arch_id->type(ucfirst(lc($r->{'type'}))); + } + + if (! defined $arch_id->db_name) { + # couldn't find stable ID version in archive or current release + return undef; + } + + return $arch_id; +} + + +=head2 fetch_by_stable_id_dbname + + Arg [1] : string $stable_id + Arg [2] : string $db_name + Example : none + Description : Create an ArchiveStableId from given arguments. + Returntype : Bio::EnsEMBL::ArchiveStableId or undef if not in database + Exceptions : none + Caller : general + Status : At Risk + : under development + +=cut + +sub fetch_by_stable_id_dbname { + my $self = shift; + my $stable_id = shift; + my $db_name = shift; + + my $arch_id = Bio::EnsEMBL::ArchiveStableId->new( + -stable_id => $stable_id, + -db_name => $db_name, + -adaptor => $self + ); + + @_ ? $arch_id->type(shift) : $self->_resolve_type($arch_id); + + if ($self->lookup_current($arch_id) and $db_name eq $self->dbc->dbname) { + + # this version is the current one + $arch_id->version($arch_id->current_version); + $arch_id->release($self->get_current_release); + $arch_id->assembly($self->get_current_assembly); + + } else { + + # find version for this dbname in the stable ID archive + my $extra_sql = defined($arch_id->{'type'}) ? + " AND sie.type = '@{[lc($arch_id->{'type'})]}'" : ''; + my $extra_sql1 = $extra_sql . qq( AND ms.old_db_name = "$db_name"); + my $extra_sql2 = $extra_sql . qq( AND ms.new_db_name = "$db_name"); + my $r = $self->_fetch_archive_id($stable_id, $extra_sql1, $extra_sql2); + + if ($r->{'new_stable_id'} and $r->{'new_stable_id'} eq $stable_id + and $r->{'new_db_name'} eq $db_name) { + + # latest event is a self event, use new_* data + $arch_id->release($r->{'new_release'}); + $arch_id->assembly($r->{'new_assembly'}); + $arch_id->version($r->{'new_version'}); + } else { + # latest event is a deletion event (or mapping to other ID; this clause + # is only used to cope with buggy data where deletion events are + # missing), use old_* data + $arch_id->release($r->{'old_release'}); + $arch_id->assembly($r->{'old_assembly'}); + $arch_id->version($r->{'old_version'}); + } + + $arch_id->type(ucfirst(lc($r->{'type'}))); + } + + if (! defined $arch_id->version ) { + # couldn't find stable ID version in archive or current release + return undef; + } + + return $arch_id; +} + +# +# Helper method to do fetch ArchiveStableId from db. +# Used by fetch_by_stable_id(), fetch_by_stable_id_version() and +# fetch_by_stable_id_dbname(). +# Returns hashref as returned by DBI::sth::fetchrow_hashref +# +sub _fetch_archive_id { + my $self = shift; + my $stable_id = shift; + my $extra_sql1 = shift; + my $extra_sql2 = shift; + + # using a UNION is much faster in this query than somthing like + # "... AND (sie.old_stable_id = ? OR sie.new_stable_id = ?)" + my $sql = qq( + (SELECT * FROM stable_id_event sie, mapping_session ms + WHERE sie.mapping_session_id = ms.mapping_session_id + AND sie.old_stable_id = ? + $extra_sql1) + UNION + (SELECT * FROM stable_id_event sie, mapping_session ms + WHERE sie.mapping_session_id = ms.mapping_session_id + AND sie.new_stable_id = ? + $extra_sql2) + ORDER BY created DESC + LIMIT 1 + ); + + my $sth = $self->prepare($sql); + $sth->execute($stable_id,$stable_id); + my $r = $sth->fetchrow_hashref; + $sth->finish; + + return $r; +} + + +=head2 fetch_all_by_archive_id + + Arg [1] : Bio::EnsEMBL::ArchiveStableId $archive_id + Arg [2] : String $return_type - type of ArchiveStableId to fetch + Example : my $arch_id = $arch_adaptor->fetch_by_stable_id('ENSG0001'); + my @archived_transcripts = + $arch_adaptor->fetch_all_by_archive_id($arch_id, 'Transcript'); + Description : Given a ArchiveStableId it retrieves associated ArchiveStableIds + of specified type (e.g. retrieve transcripts for genes or vice + versa). + + See also fetch_associated_archived() for a different approach to + retrieve this data. + Returntype : listref Bio::EnsEMBL::ArchiveStableId + Exceptions : none + Caller : Bio::EnsEMBL::ArchiveStableId->get_all_gene_archive_ids, + get_all_transcript_archive_ids, get_all_translation_archive_ids + Status : At Risk + : under development + +=cut + +sub fetch_all_by_archive_id { + my $self = shift; + my $archive_id = shift; + my $return_type = shift; + + my @result = (); + my $lc_self_type = lc($archive_id->type); + my $lc_return_type = lc($return_type); + + my $sql = qq( + SELECT + ga.${lc_return_type}_stable_id, + ga.${lc_return_type}_version, + m.old_db_name, + m.old_release, + m.old_assembly + FROM gene_archive ga, mapping_session m + WHERE ga.${lc_self_type}_stable_id = ? + AND ga.${lc_self_type}_version = ? + AND ga.mapping_session_id = m.mapping_session_id + ); + + my $sth = $self->prepare($sql); + $sth->bind_param(1, $archive_id->stable_id, SQL_VARCHAR); + $sth->bind_param(2, $archive_id->version, SQL_SMALLINT); + $sth->execute; + + my ($stable_id, $version, $db_name, $release, $assembly); + $sth->bind_columns(\$stable_id, \$version, \$db_name, \$release, \$assembly); + + while ($sth->fetch) { + my $new_arch_id = Bio::EnsEMBL::ArchiveStableId->new( + -stable_id => $stable_id, + -version => $version, + -db_name => $db_name, + -release => $release, + -assembly => $assembly, + -type => $return_type, + -adaptor => $self + ); + + push( @result, $new_arch_id ); + } + + $sth->finish(); + return \@result; +} + + +=head2 fetch_associated_archived + + Arg[1] : Bio::EnsEMBL::ArchiveStableId $arch_id - + the ArchiveStableId to fetch associated archived IDs for + Example : my ($arch_gene, $arch_tr, $arch_tl, $pep_seq) = + @{ $archive_adaptor->fetch_associated_archived($arch_id) }; + Description : Fetches associated archived stable IDs from the db for a given + ArchiveStableId (version is taken into account). + Return type : Listref of + ArchiveStableId archived gene + ArchiveStableId archived transcript + (optional) ArchiveStableId archived translation + (optional) peptide sequence + Exceptions : thrown on missing or wrong argument + thrown if ArchiveStableID has no type + Caller : Bio::EnsEMBL::ArchiveStableId->get_all_associated_archived() + Status : At Risk + : under development + +=cut + +sub fetch_associated_archived { + my $self = shift; + my $arch_id = shift; + + throw("Need a Bio::EnsEMBL::ArchiveStableId") unless ($arch_id + and ref($arch_id) and $arch_id->isa('Bio::EnsEMBL::ArchiveStableId')); + + my $type = $arch_id->type(); + + if ( !defined($type) ) { + throw("Can't deduce ArchiveStableId type."); + } + + $type = lc($type); + + my $sql = qq( + SELECT ga.gene_stable_id, + ga.gene_version, + ga.transcript_stable_id, + ga.transcript_version, + ga.translation_stable_id, + ga.translation_version, + pa.peptide_seq, + ms.old_release, + ms.old_assembly, + ms.old_db_name + FROM (mapping_session ms, gene_archive ga) + LEFT JOIN peptide_archive pa + ON ga.peptide_archive_id = pa.peptide_archive_id + WHERE ga.mapping_session_id = ms.mapping_session_id + AND ga.${type}_stable_id = ? + AND ga.${type}_version = ? + ); + + my $sth = $self->prepare($sql); + $sth->bind_param(1, $arch_id->stable_id, SQL_VARCHAR); + $sth->bind_param(2, $arch_id->version, SQL_SMALLINT); + $sth->execute; + + my @result = (); + + while (my $r = $sth->fetchrow_hashref) { + + my @row = (); + + # create ArchiveStableIds genes, transcripts and translations + push @row, Bio::EnsEMBL::ArchiveStableId->new( + -stable_id => $r->{'gene_stable_id'}, + -version => $r->{'gene_version'}, + -db_name => $r->{'old_db_name'}, + -release => $r->{'old_release'}, + -assembly => $r->{'old_assembly'}, + -type => 'Gene', + -adaptor => $self + ); + + push @row, Bio::EnsEMBL::ArchiveStableId->new( + -stable_id => $r->{'transcript_stable_id'}, + -version => $r->{'transcript_version'}, + -db_name => $r->{'old_db_name'}, + -release => $r->{'old_release'}, + -assembly => $r->{'old_assembly'}, + -type => 'Transcript', + -adaptor => $self + ); + + if ($r->{'translation_stable_id'}) { + push @row, Bio::EnsEMBL::ArchiveStableId->new( + -stable_id => $r->{'translation_stable_id'}, + -version => $r->{'translation_version'}, + -db_name => $r->{'old_db_name'}, + -release => $r->{'old_release'}, + -assembly => $r->{'old_assembly'}, + -type => 'Translation', + -adaptor => $self + ); + + # push peptide sequence onto result list + push @row, $r->{'peptide_seq'}; + } + + push @result, \@row; + } + + return \@result; +} + + +=head2 fetch_predecessors_by_archive_id + + Arg [1] : Bio::EnsEMBL::ArchiveStableId + Example : none + Description : Retrieve a list of ArchiveStableIds that were mapped to the + given one. This method goes back only one level, to retrieve + a full predecessor history use fetch_predecessor_history, or + ideally fetch_history_tree_by_stable_id for the complete + history network. + Returntype : listref Bio::EnsEMBL::ArchiveStableId + Exceptions : none + Caller : Bio::EnsEMBL::ArchiveStableId->get_all_predecessors + Status : At Risk + : under development + +=cut + +sub fetch_predecessors_by_archive_id { + my $self = shift; + my $arch_id = shift; + + my @result; + + if( ! ( defined $arch_id->stable_id() && + defined $arch_id->db_name() )) { + throw( "Need db_name for predecessor retrieval" ); + } + + my $sql = qq( + SELECT + sie.old_stable_id, + sie.old_version, + sie.type, + m.old_db_name, + m.old_release, + m.old_assembly + FROM mapping_session m, stable_id_event sie + WHERE sie.mapping_session_id = m.mapping_session_id + AND sie.new_stable_id = ? + AND m.new_db_name = ? + ); + + my $sth = $self->prepare($sql); + $sth->bind_param(1, $arch_id->stable_id, SQL_VARCHAR); + $sth->bind_param(2, $arch_id->db_name, SQL_VARCHAR); + $sth->execute(); + + my ($old_stable_id, $old_version, $type, $old_db_name, $old_release, $old_assembly); + $sth->bind_columns(\$old_stable_id, \$old_version, \$type, \$old_db_name, \$old_release, \$old_assembly); + + while ($sth->fetch) { + if (defined $old_stable_id) { + my $old_arch_id = Bio::EnsEMBL::ArchiveStableId->new( + -stable_id => $old_stable_id, + -version => $old_version, + -db_name => $old_db_name, + -release => $old_release, + -assembly => $old_assembly, + -type => $type, + -adaptor => $self + ); + push( @result, $old_arch_id ); + } + } + $sth->finish(); + + # if you didn't find any predecessors, there might be a gap in the + # mapping_session history (i.e. databases in mapping_session don't chain). To + # bridge the gap, look in the previous mapping_session for identical + # stable_id.version + unless (@result) { + + $sql = qq( + SELECT + sie.new_stable_id, + sie.new_version, + sie.type, + m.new_db_name, + m.new_release, + m.new_assembly + FROM mapping_session m, stable_id_event sie + WHERE sie.mapping_session_id = m.mapping_session_id + AND sie.new_stable_id = ? + AND m.new_db_name = ? + ); + + $sth = $self->prepare($sql); + + my $curr_dbname = $arch_id->db_name; + + PREV: + while (my $prev_dbname = $self->previous_dbname($curr_dbname)) { + + $sth->bind_param(1,$arch_id->stable_id, SQL_VARCHAR); + $sth->bind_param(2,$prev_dbname, SQL_VARCHAR); + $sth->execute(); + + $sth->bind_columns(\$old_stable_id, \$old_version, \$type, \$old_db_name, \$old_release, \$old_assembly); + + while( $sth->fetch() ) { + if (defined $old_stable_id) { + my $old_arch_id = Bio::EnsEMBL::ArchiveStableId->new( + -stable_id => $old_stable_id, + -version => $old_version, + -db_name => $old_db_name, + -release => $old_release, + -assembly => $old_assembly, + -type => $type, + -adaptor => $self + ); + push( @result, $old_arch_id ); + + last PREV; + } + } + + $curr_dbname = $prev_dbname; + + } + + $sth->finish(); + } + + return \@result; +} + + +=head2 fetch_successors_by_archive_id + + Arg [1] : Bio::EnsEMBL::ArchiveStableId + Example : none + Description : Retrieve a list of ArchiveStableIds that the given one was + mapped to. This method goes forward only one level, to retrieve + a full successor history use fetch_successor_history, or + ideally fetch_history_tree_by_stable_id for the complete + history network. + Returntype : listref Bio::EnsEMBL::ArchiveStableId + Exceptions : none + Caller : Bio::EnsEMBL::ArchiveStableId->get_all_successors + Status : At Risk + : under development + +=cut + +sub fetch_successors_by_archive_id { + my $self = shift; + my $arch_id = shift; + my @result; + + + if( ! ( defined $arch_id->stable_id() && + defined $arch_id->db_name() )) { + throw( "Need db_name for successor retrieval" ); + } + + my $sql = qq( + SELECT + sie.new_stable_id, + sie.new_version, + sie.type, + m.new_db_name, + m.new_release, + m.new_assembly + FROM mapping_session m, stable_id_event sie + WHERE sie.mapping_session_id = m.mapping_session_id + AND sie.old_stable_id = ? + AND m.old_db_name = ? + ); + + my $sth = $self->prepare( $sql ); + $sth->bind_param(1,$arch_id->stable_id,SQL_VARCHAR); + $sth->bind_param(2,$arch_id->db_name,SQL_VARCHAR); + $sth->execute(); + + my ($new_stable_id, $new_version, $type, $new_db_name, $new_release, $new_assembly); + $sth->bind_columns(\$new_stable_id, \$new_version, \$type, \$new_db_name, \$new_release, \$new_assembly); + + while( $sth->fetch() ) { + if( defined $new_stable_id ) { + my $new_arch_id = Bio::EnsEMBL::ArchiveStableId->new( + -stable_id => $new_stable_id, + -version => $new_version, + -db_name => $new_db_name, + -release => $new_release, + -assembly => $new_assembly, + -type => $type, + -adaptor => $self + ); + + push( @result, $new_arch_id ); + } + } + $sth->finish(); + + # if you didn't find any successors, there might be a gap in the + # mapping_session history (i.e. databases in mapping_session don't chain). To + # bridge the gap, look in the next mapping_session for identical + # stable_id.version + unless (@result) { + + $sql = qq( + SELECT + sie.old_stable_id, + sie.old_version, + sie.type, + m.old_db_name, + m.old_release, + m.old_assembly + FROM mapping_session m, stable_id_event sie + WHERE sie.mapping_session_id = m.mapping_session_id + AND sie.old_stable_id = ? + AND m.old_db_name = ? + ); + + $sth = $self->prepare($sql); + + my $curr_dbname = $arch_id->db_name; + + NEXTDB: + while (my $next_dbname = $self->next_dbname($curr_dbname)) { + + $sth->bind_param(1, $arch_id->stable_id, SQL_VARCHAR); + $sth->bind_param(2, $next_dbname, SQL_VARCHAR); + $sth->execute(); + + $sth->bind_columns(\$new_stable_id, \$new_version, \$type, \$new_db_name, \$new_release, \$new_assembly); + + while( $sth->fetch() ) { + if (defined $new_stable_id) { + my $new_arch_id = Bio::EnsEMBL::ArchiveStableId->new( + -stable_id => $new_stable_id, + -version => $new_version, + -db_name => $new_db_name, + -release => $new_release, + -assembly => $new_assembly, + -type => $type, + -adaptor => $self + ); + + push( @result, $new_arch_id ); + + last NEXTDB; + } + } + + $curr_dbname = $next_dbname; + + } + + $sth->finish(); + } + + return \@result; +} + + + +=head2 fetch_history_tree_by_stable_id + + Arg[1] : String $stable_id - the stable ID to fetch the history tree for + Arg[2] : (optional) Int $num_high_scorers + number of mappings per stable ID allowed when filtering + Arg[3] : (optional) Int $max_rows + maximum number of stable IDs in history tree (used for + filtering) + Example : my $history = $archive_adaptor->fetch_history_tree_by_stable_id( + 'ENSG00023747897'); + Description : Returns the history tree for a given stable ID. This will + include a network of all stable IDs it is related to. The + method will try to return a minimal (sparse) set of nodes + (ArchiveStableIds) and links (StableIdEvents) by removing any + redundant entries and consolidating mapping events so that only + changes are recorded. + Return type : Bio::EnsEMBL::StableIdHistoryTree + Exceptions : thrown on missing argument + Caller : Bio::EnsEMBL::ArchiveStableId::get_history_tree, general + Status : At Risk + : under development + +=cut + +sub fetch_history_tree_by_stable_id { + my ($self, $stable_id, $num_high_scorers, $max_rows) = @_; + + throw("Expecting a stable ID argument.") unless $stable_id; + + $num_high_scorers ||= NUM_HIGH_SCORERS; + $max_rows ||= MAX_ROWS; + + # using a UNION is much faster in this query than somthing like + # "... AND (sie.old_stable_id = ?) OR (sie.new_stable_id = ?)" + my $sql = qq( + SELECT sie.old_stable_id, sie.old_version, + ms.old_db_name, ms.old_release, ms.old_assembly, + sie.new_stable_id, sie.new_version, + ms.new_db_name, ms.new_release, ms.new_assembly, + sie.type, sie.score + FROM stable_id_event sie, mapping_session ms + WHERE sie.mapping_session_id = ms.mapping_session_id + AND sie.old_stable_id = ? + UNION + SELECT sie.old_stable_id, sie.old_version, + ms.old_db_name, ms.old_release, ms.old_assembly, + sie.new_stable_id, sie.new_version, + ms.new_db_name, ms.new_release, ms.new_assembly, + sie.type, sie.score + FROM stable_id_event sie, mapping_session ms + WHERE sie.mapping_session_id = ms.mapping_session_id + AND sie.new_stable_id = ? + ); + + my $sth = $self->prepare($sql); + + my $history = Bio::EnsEMBL::StableIdHistoryTree->new( + -CURRENT_DBNAME => $self->dbc->dbname, + -CURRENT_RELEASE => $self->get_current_release, + -CURRENT_ASSEMBLY => $self->get_current_assembly, + ); + + # remember stable IDs you need to do and those that are done. Initialise the + # former hash with the focus stable ID + my %do = ($stable_id => 1); + my %done; + + # while we got someting to do + while (my ($id) = keys(%do)) { + + # if we already have more than MAX_ROWS stable IDs in this tree, we can't + # build the full tree. Return undef. + if (scalar(keys(%done)) > $max_rows) { + # warning("Too many related stable IDs (".scalar(keys(%done)).") to draw a history tree."); + $history->is_incomplete(1); + $sth->finish; + last; + } + + # mark this stable ID as done + delete $do{$id}; + $done{$id} = 1; + + # fetch all stable IDs related to this one from the database + $sth->bind_param(1, $id, SQL_VARCHAR); + $sth->bind_param(2, $id, SQL_VARCHAR); + $sth->execute; + + my @events; + + while (my $r = $sth->fetchrow_hashref) { + + # + # create old and new ArchiveStableIds and a StableIdEvent to link them + # add all of these to the history tree + # + my ($old_id, $new_id); + + if ($r->{'old_stable_id'}) { + $old_id = Bio::EnsEMBL::ArchiveStableId->new( + -stable_id => $r->{'old_stable_id'}, + -version => $r->{'old_version'}, + -db_name => $r->{'old_db_name'}, + -release => $r->{'old_release'}, + -assembly => $r->{'old_assembly'}, + -type => $r->{'type'}, + -adaptor => $self + ); + } + + if ($r->{'new_stable_id'}) { + $new_id = Bio::EnsEMBL::ArchiveStableId->new( + -stable_id => $r->{'new_stable_id'}, + -version => $r->{'new_version'}, + -db_name => $r->{'new_db_name'}, + -release => $r->{'new_release'}, + -assembly => $r->{'new_assembly'}, + -type => $r->{'type'}, + -adaptor => $self + ); + } + + my $event = Bio::EnsEMBL::StableIdEvent->new( + -old_id => $old_id, + -new_id => $new_id, + -score => $r->{'score'} + ); + + push @events, $event; + + } + + # filter out low-scoring events; the number of highest scoring events + # returned is defined by NUM_HIGH_SCORERS + my @others; + + foreach my $event (@events) { + + my $old_id = $event->old_ArchiveStableId; + my $new_id = $event->new_ArchiveStableId; + + # creation, deletion and mapping-to-self events are added to the history + # tree directly + if (!$old_id || !$new_id || ($old_id->stable_id eq $new_id->stable_id)) { + $history->add_StableIdEvents($event); + } else { + push @others, $event; + } + + } + + #if (scalar(@others) > $num_high_scorers) { + # warn "Filtering ".(scalar(@others) - $num_high_scorers). + # " low-scoring events.\n"; + #} + + my $k = 0; + foreach my $event (sort { $b->score <=> $a->score } @others) { + $history->add_StableIdEvents($event); + + # mark stable IDs as todo if appropriate + $do{$event->old_ArchiveStableId->stable_id} = 1 + unless $done{$event->old_ArchiveStableId->stable_id}; + $do{$event->new_ArchiveStableId->stable_id} = 1 + unless $done{$event->new_ArchiveStableId->stable_id}; + + last if (++$k == $num_high_scorers); + } + + } + + $sth->finish; + + # try to consolidate the tree (remove redundant nodes, bridge gaps) + $history->consolidate_tree; + + # now add ArchiveStableIds for current Ids not found in the archive + $self->add_all_current_to_history($history); + + # calculate grid coordinates for the sorted tree; this will also try to + # untangle the tree + $history->calculate_coords; + + return $history; +} + + +=head2 add_all_current_to_history + + Arg[1] : Bio::EnsEMBL::StableIdHistoryTree $history - + the StableIdHistoryTree object to add the current IDs to + Description : This method adds the current versions of all stable IDs found + in a StableIdHistoryTree object to the tree, by creating + appropriate Events for the stable IDs found in the *_stable_id + tables. This is a helper method for + fetch_history_tree_by_stable_id(), see there for more + documentation. + Return type : none (passed-in object is manipulated) + Exceptions : thrown on missing or wrong argument + Caller : internal + Status : At Risk + : under development + +=cut + +sub add_all_current_to_history { + my $self = shift; + my $history = shift; + + unless ($history and $history->isa('Bio::EnsEMBL::StableIdHistoryTree')) { + throw("Need a Bio::EnsEMBL::StableIdHistoryTree."); + } + + my @ids = @{ $history->get_unique_stable_ids }; + my $id_string = join("', '", @ids); + + my $tmp_id = Bio::EnsEMBL::ArchiveStableId->new(-stable_id => $ids[0]); + my $type = lc($self->_resolve_type($tmp_id)); + return unless ($type); + + # get current stable IDs from db + my $sql = qq( + SELECT stable_id, version FROM ${type} + WHERE stable_id IN ('$id_string') + ); + my $sth = $self->prepare($sql); + $sth->execute; + + while (my ($stable_id, $version) = $sth->fetchrow_array) { + + my $new_id = Bio::EnsEMBL::ArchiveStableId->new( + -stable_id => $stable_id, + -version => $version, + -current_version => $version, + -db_name => $self->dbc->dbname, + -release => $self->get_current_release, + -assembly => $self->get_current_assembly, + -type => $type, + -adaptor => $self + ); + + my $event = $history->get_latest_StableIdEvent($new_id); + next unless ($event); + + if ($event->old_ArchiveStableId and + $event->old_ArchiveStableId->stable_id eq $stable_id) { + + # latest event was a self event + # update it with current stable ID and add to tree + $event->new_ArchiveStableId($new_id); + + } else { + + # latest event was a non-self event + # create a new event where the old_id is the new_id from latest + my $new_event = Bio::EnsEMBL::StableIdEvent->new( + -old_id => $event->new_ArchiveStableId, + -new_id => $new_id, + -score => $event->score, + ); + $history->add_StableIdEvents($new_event); + } + + } + + # refresh node cache + $history->flush_ArchiveStableIds; + $history->add_ArchiveStableIds_for_events; +} + + +=head2 fetch_successor_history + + Arg [1] : Bio::EnsEMBL::ArchiveStableId $arch_id + Example : none + Description : Gives back a list of archive stable ids which are successors in + the stable_id_event tree of the given stable_id. Might well be + empty. + + This method isn't deprecated, but in most cases you will rather + want to use fetch_history_tree_by_stable_id(). + Returntype : listref Bio::EnsEMBL::ArchiveStableId + Since every ArchiveStableId knows about it's successors, this is + a linked tree. + Exceptions : none + Caller : webcode for archive + Status : At Risk + : under development + +=cut + +sub fetch_successor_history { + my $self = shift; + my $arch_id = shift; + + my $current_db_name = $self->list_dbnames->[0]; + my $dbname = $arch_id->db_name; + + if ($dbname eq $current_db_name) { + return [$arch_id]; + } + + my $old = []; + my @result = (); + + push @$old, $arch_id; + + while ($dbname ne $current_db_name) { + my $new = []; + while (my $asi = (shift @$old)) { + push @$new, @{ $asi->get_all_successors }; + } + + if (@$new) { + $dbname = $new->[0]->db_name; + } else { + last; + } + + # filter duplicates + my %unique = map { join(":", $_->stable_id, $_->version, $_->release) => + $_ } @$new; + @$new = values %unique; + + @$old = @$new; + push @result, @$new; + } + + return \@result; +} + + +=head2 fetch_predecessor_history + + Arg [1] : Bio::EnsEMBL::ArchiveStableId $arch_id + Example : none + Description : Gives back a list of archive stable ids which are predecessors + in the stable_id_event tree of the given stable_id. Might well + be empty. + + This method isn't deprecated, but in most cases you will rather + want to use fetch_history_tree_by_stable_id(). + Returntype : listref Bio::EnsEMBL::ArchiveStableId + Since every ArchiveStableId knows about it's successors, this is + a linked tree. + Exceptions : none + Caller : webcode for archive + Status : At Risk + : under development + +=cut + +sub fetch_predecessor_history { + my $self = shift; + my $arch_id = shift; + + my $oldest_db_name = $self->list_dbnames->[-1]; + my $dbname = $arch_id->db_name; + + if ($dbname eq $oldest_db_name) { + return [$arch_id]; + } + + my $old = []; + my @result = (); + + push @$old, $arch_id; + + while ($dbname ne $oldest_db_name) { + my $new = []; + while (my $asi = (shift @$old)) { + push @$new, @{ $asi->get_all_predecessors }; + } + + if( @$new ) { + $dbname = $new->[0]->db_name; + } else { + last; + } + + # filter duplicates + my %unique = map { join(":", $_->stable_id, $_->version, $_->release) => + $_ } @$new; + @$new = values %unique; + + @$old = @$new; + push @result, @$new; + } + + return \@result; +} + + +=head2 list_dbnames + + Args : none + Example : none + Description : A list of available database names from the latest (current) to + the oldest (ordered). + Returntype : listref of strings + Exceptions : none + Caller : general + Status : At Risk + : under development + +=cut + +sub list_dbnames { + my $self = shift; + + if( ! defined $self->{'dbnames'} ) { + + my $sql = qq( + SELECT old_db_name, new_db_name + FROM mapping_session + ORDER BY created DESC + ); + my $sth = $self->prepare( $sql ); + $sth->execute(); + my ( $old_db_name, $new_db_name ); + + my @dbnames = (); + my %seen; + + $sth->bind_columns( \$old_db_name, \$new_db_name ); + + while( $sth->fetch() ) { + # this code now can deal with non-chaining mapping sessions + push(@{ $self->{'dbnames'} }, $new_db_name) unless ($seen{$new_db_name}); + $seen{$new_db_name} = 1; + + push(@{ $self->{'dbnames'} }, $old_db_name) unless ($seen{$old_db_name}); + $seen{$old_db_name} = 1; + } + + $sth->finish(); + + } + + return $self->{'dbnames'}; +} + + +=head2 previous_dbname + + Arg[1] : String $dbname - focus db name + Example : my $prev_db = $self->previous_dbname($curr_db); + Description : Returns the name of the next oldest database which has mapping + session information. + Return type : String (or undef if not available) + Exceptions : none + Caller : general + Status : At Risk + +=cut + +sub previous_dbname { + my $self = shift; + my $dbname = shift; + + my $curr_idx = $self->_dbname_index($dbname); + my @dbnames = @{ $self->list_dbnames }; + + if ($curr_idx == @dbnames) { + # this is the oldest dbname, so no previous one available + return undef; + } else { + return $dbnames[$curr_idx+1]; + } +} + + +=head2 next_dbname + + Arg[1] : String $dbname - focus db name + Example : my $prev_db = $self->next_dbname($curr_db); + Description : Returns the name of the next newest database which has mapping + session information. + Return type : String (or undef if not available) + Exceptions : none + Caller : general + Status : At Risk + +=cut + +sub next_dbname { + my $self = shift; + my $dbname = shift; + + my $curr_idx = $self->_dbname_index($dbname); + my @dbnames = @{ $self->list_dbnames }; + + if ($curr_idx == 0) { + # this is the latest dbname, so no next one available + return undef; + } else { + return $dbnames[$curr_idx-1]; + } +} + + +# +# helper method to return the array index of a database in the ordered list of +# available databases (as returned by list_dbnames() +# +sub _dbname_index { + my $self = shift; + my $dbname = shift; + + my @dbnames = @{ $self->list_dbnames }; + + for (my $i = 0; $i < @dbnames; $i++) { + if ($dbnames[$i] eq $dbname) { + return $i; + } + } +} + + +=head2 get_peptide + + Arg [1] : Bio::EnsEMBL::ArchiveStableId $arch_id + Example : none + Description : Retrieves the peptide string for given ArchiveStableId. If its + not a peptide or not in the database returns undef. + Returntype : string or undef + Exceptions : none + Caller : Bio::EnsEMBL::ArchiveStableId->get_peptide, general + Status : At Risk + : under development + +=cut + +sub get_peptide { + my $self = shift; + my $arch_id = shift; + + if ( lc( $arch_id->type() ) ne 'translation' ) { + return undef; + } + + my $sql = qq( + SELECT pa.peptide_seq + FROM peptide_archive pa, gene_archive ga + WHERE ga.translation_stable_id = ? + AND ga.translation_version = ? + AND ga.peptide_archive_id = pa.peptide_archive_id + ); + + my $sth = $self->prepare($sql); + $sth->bind_param( 1, $arch_id->stable_id, SQL_VARCHAR ); + $sth->bind_param( 2, $arch_id->version, SQL_SMALLINT ); + $sth->execute(); + + my ($peptide_seq) = $sth->fetchrow_array(); + $sth->finish(); + + return $peptide_seq; +} ## end sub get_peptide + + +=head2 get_current_release + + Example : my $current_release = $archive_adaptor->get_current_release; + Description : Returns the current release number (as found in the meta table). + Return type : Int + Exceptions : none + Caller : general + Status : At Risk + : under development + +=cut + +sub get_current_release { + my $self = shift; + + unless ($self->{'current_release'}) { + my $mca = $self->db->get_MetaContainer; + my ($release) = @{ $mca->list_value_by_key('schema_version') }; + $self->{'current_release'} = $release; + } + + return $self->{'current_release'}; +} + + +=head2 get_current_assembly + + Example : my $current_assembly = $archive_adaptor->get_current_assembly; + Description : Returns the current assembly version (as found in the meta + table). + Return type : String + Exceptions : none + Caller : general + Status : At Risk + : under development + +=cut + +sub get_current_assembly { + my $self = shift; + + unless ($self->{'current_assembly'}) { + my $mca = $self->db->get_MetaContainer; + my ($assembly) = @{ $mca->list_value_by_key('assembly.default') }; + $self->{'current_assembly'} = $assembly; + } + + return $self->{'current_assembly'}; +} + + +=head2 lookup_current + + Arg[1] : Bio::EnsEMBL::ArchiveStableId $arch_id - + the stalbe ID to find the current version for + Example : if ($self->lookup_version($arch_id) { + $arch_id->version($arch_id->current_version); + $arch_id->db_name($self->dbc->dbname); + Description : Look in [gene|transcript|translation]_stable_id if you can find + a current version for this stable ID. Set + ArchiveStableId->current_version if found. + Return type : Boolean (TRUE if current version found, else FALSE) + Exceptions : none + Caller : general + Status : At Risk + : under development + +=cut + +sub lookup_current { + my $self = shift; + my $arch_id = shift; + + my $type = lc( $arch_id->type ); + + unless ($type) { + warning("Can't lookup current version without a type."); + return 0; + } + + my $sql = qq( + SELECT version FROM ${type} + WHERE stable_id = ? + ); + my $sth = $self->prepare($sql); + $sth->execute( $arch_id->stable_id ); + my ($version) = $sth->fetchrow_array; + $sth->finish; + + if ($version) { + $arch_id->current_version($version); + return 1; + } + + # didn't find a current version + return 0; +} ## end sub lookup_current + + +# infer type from stable ID format +sub _resolve_type { + my $self = shift; + my $arch_id = shift; + + my $stable_id = $arch_id->stable_id(); + my $id_type; + + # first, try to infer type from stable ID format + # + # Anopheles IDs + if ($stable_id =~ /^AGAP.*/) { + if ($stable_id =~ /.*-RA/) { + $id_type = "Transcript"; + } elsif ($stable_id =~ /.*-PA/) { + $id_type = "Translation"; + } else { + $id_type = "Gene"; + } + + # standard Ensembl IDs + } elsif ($stable_id =~ /.*G\d+$/) { + $id_type = "Gene"; + } elsif ($stable_id =~ /.*T\d+$/) { + $id_type = "Transcript"; + } elsif ($stable_id =~ /.*P\d+$/) { + $id_type = "Translation"; + } elsif ($stable_id =~ /.*E\d+$/) { + $id_type = "Exon"; + + # if guessing fails, look in db + } else { + my $sql = qq( + SELECT type from stable_id_event + WHERE old_stable_id = ? + OR new_stable_id = ? + ); + my $sth = $self->prepare($sql); + $sth->execute($stable_id, $stable_id); + ($id_type) = $sth->fetchrow_array; + $sth->finish; + } + + warning("Couldn't resolve stable ID type.") unless ($id_type); + + $arch_id->type($id_type); +} + + +1; +